000001 sqi IDENTIFICATION DIVISION. 000002 sqi PROGRAM-ID. S9TL1B. 000003 ****************************************************************** 000004 * Programme : S9TL1B 000005 * Workspace : ceab3-environn-outinfr-central 000006 * 000007 * Test avec ressources Db2 000008 * 000009 ****************************************************************** 000010 sqivc * Variables globales pour la compilation conditionnelle 000011 sqivc copy AGAVBATC. ==000012==> IGYDS0040-I Printing of the source code has been suppressed. 000021C copy AGAVINIT. AGAVBATC ==000022==> IGYDS0040-I Printing of the source code has been suppressed. 000028C *--- Variables calculées automatiquement (ne pas modifier) -------AGAVINIT 000029C *- Programme batch AGAVINIT 000030C >>define AA-G-BATCH as b'0' AGAVINIT 000031C *- Programme TP CICS AGAVINIT 000032C >>define AA-G-CICS as b'0' AGAVINIT 000033C *- Programme batch CICS AGAVINIT 000034C >>define AA-G-EXCI as b'0' AGAVINIT 000035C *- Programme batch et TP CICS AGAVINIT 000036C >>define AA-G-MIXED as b'0' AGAVINIT 000037C *- Programme d'origine Pacbase (programme migré) AGAVINIT 000038C >>if AA-G-PACBASE not defined AGAVINIT 000039C >>define AA-G-PACBASE as b'0' AGAVINIT 000040C >>end-if AGAVINIT 000041C *- Déclaration des variables standard Pacbase AGAVINIT 000042C >>define AA-G-VARPACBASE as b'0' AGAVINIT 000043C >>define AA-G-BATCH as b'1' override AGAVBATC 000044C copy AAAVACCE. AGAVBATC ==000045==> IGYDS0040-I Printing of the source code has been suppressed. 000052C *--- Variables calculées automatiquement (ne pas modifier) -------AAAVACCE 000053C * - programme avec accès Db2 (vrai: b'1', faux: b'0') AAAVACCE 000054C >>define AA-A-DB2 as b'0' AAAVACCE 000055C * - gestion de la trace Db2 AAAVACCE 000056C >>define AA-A-DB2-TRACE as b'0' AAAVACCE 000057C * - programme avec ressources VSAM (vrai: b'1', faux: b'0') AAAVACCE 000058C >>define AA-A-VSAM as b'0' AAAVACCE 000059C * - ressources lues dans l'itération principales AAAVACCE 000060C >>define AA-A-LECTURES as b'0' AAAVACCE 000061C * - ressources lues dans l'itération principales sans ruptures AAAVACCE 000062C >>define AA-A-LECTURES-SANS-RUPT as b'0' AAAVACCE 000063C * - ressources lues dans l'itération principales avec ruptures AAAVACCE 000064C >>define AA-A-LECTURES-AVEC-RUPT as b'0' AAAVACCE 000065C * - ressources lues dans l'itération principales avec syncros AAAVACCE 000066C >>define AA-A-LECTURES-AVEC-SYNC as b'0' AAAVACCE 000067C * - ressources lues à contrôler dans l'itération principale AAAVACCE 000068C >>define AA-A-CONTROLES as b'0' AAAVACCE 000069C * - ressources lues à mettre à jour dans l'itération principale AAAVACCE 000070C >>define AA-A-MAJ as b'0' AAAVACCE 000071C * - ressources Etats à éditer dans l'itération principale AAAVACCE 000072C >>define AA-A-EDITIONS as b'0' AAAVACCE 000073C * - ressources écrites dans l'itération principale AAAVACCE 000074C >>define AA-A-ECRITURES as b'0' AAAVACCE 000075C * - niveau de Rupture maximum AAAVACCE 000076C >>define AA-A-MAXNR as 0 AAAVACCE 000077C * - niveau de Synchronisation maximum AAAVACCE 000078C >>define AA-A-MAXNS as 0 AAAVACCE 000079 sqisqa****************************************************************** 000080 sqisqa*> * * Squelette : SB2 - Squelette Batch <* <* 000081 sqisqa*> * * Version : SB2 - V5.0.0 - B <* <* 000082 sqisqd*> * * Squelette : Tag trace Injection <* <* 000083 cdAP00*Inj*|dd:AP|noseg:00|repl:APP|copy:SG2DAPP|ddname:APP|recfm:F|nrup 000084 cdAP00*Inj*t:2|nsync:1|org:2|mode:S|acces:LSA|cles:COSGDP;LCSGAP|picts:X 000085 cdAP00*Inj*(1);X(1) 000086 cdDM00*Inj*|dd:DM|noseg:00|repl:ADM|copy:SG2DADM|ddname:ADM|recfm:F|nrup 000087 cdDM00*Inj*t:0|nsync:1|org:2|mode:S|acces:LSA|cles:COSGDP|picts:X(1) 000088 cdS100*Inj*|dd:S1|noseg:00|repl:I902|copy:S9FDI902|ddname:SI902|recfm:F| 000089 cdS100*Inj*nrupt:0|org:F|mode:S|acces:ESA 000090 cdS200*Inj*|dd:S2|noseg:00|repl:I903|copy:S9FDI903|ddname:SI903|recfm:F| 000091 cdS200*Inj*nrupt:0|org:F|mode:S|acces:ESA 000092 sqisqf*> * * Squelette : Tag trace Injection <* <* 000093 sqid DATE-COMPILED. 11/02/23. 000094 sqe ENVIRONMENT DIVISION. 000095 sqec CONFIGURATION SECTION. 000096 sqec SOURCE-COMPUTER. IBM-370. 000097 sqec OBJECT-COMPUTER. IBM-370. 000098 sqes SPECIAL-NAMES. 000099 DECIMAL-POINT IS COMMA 000100 . 000101 sqei INPUT-OUTPUT SECTION. 000102 sqeif FILE-CONTROL. 000103 sqeifd*> *> zone injection debut <* <* 000104 cdS100 select S1-FICHIER assign to UT-S-SI902. 126 000105 cdS200 select S2-FICHIER assign to UT-S-SI903. 150 000106 sqeiff*> *> zone injection fin <* <* 000107 sqeiff 000108 sqsd /***************************************************************** 000109 sqsd * DDDD AAA TTTTT AAA DDDD IIIII V V 000110 sqsd * D D A A T A A D D I V V 000111 sqsd * D D AAAAA T AAAAA D D I V V ... 000112 sqsd * D D A A T A A D D I V V ..... 000113 sqsd * DDDD A A T A A DDDD IIIII V ... 000114 sqsd ****************************************************************** 000115 sqsd DATA DIVISION. 000116 sqsd 000117 sqsdf *================================================================= 000118 sqsdf * FFFFF IIIII L EEEEE SSSS EEEEE CCC TTTTT 000119 sqsdf * F I L E S E C C T 000120 sqsdf * FFFF I L EEEE SSS EEEE C T 000121 sqsdf * F I L E S E C C T 000122 sqsdf * F IIIII LLLLL EEEEE SSSS EEEEE CCC T 000123 sqsdf *================================================================= 000124 sqsdf FILE SECTION. 000125 sqsdfd*> *> zone injection debut <* <* 000126 cdS100 FD S1-FICHIER 000127 cdS100 block contains 0 records 000128 cdS100 recording mode is F. 000129 cdS100 copy S9FDI902 replacing 000130 cdS100*^^repl1 * compléter les lignes ci-dessous * 000131 cdS100 ==REDEFINES I900.== by ==.== 000132 cdS100 leading ==I902== by ==S100== 000133 cdS100 . 000134C ******************************************************************S9FDI902 000135C * Fichier I902 : Liste des Applications actives S9FDI902 000136C *-----------------------------------------------------------------S9FDI902 000137C * Utilisation : S9FDI902 000138C * COPY S9FDI902 REPLACING LEADING ==I902=== BY ==prefix==. S9FDI902 000139C ******************************************************************S9FDI902 000140C *-- 16/10/2021 19:50:48 BIB: S9T SESSION: USER: J070188 S9FDI902 000141C 01 S100. S9FDI902 BLF=00001,000000000 0CL105 000142C *Code domaine *00001 000143C 10 S100-COSGDM PIC X(8). *00001 BLF=00001,000000000 8C 000144C *Libellé domaine *00009 000145C 10 S100-LNSGDM PIC X(45). *00009 BLF=00001,000000008 45C 000146C *Code application Cartographie *00054 000147C 10 S100-COSGA1 PIC X(8). *00054 BLF=00001,000000035 8C 000148C *Libellé application *00062 000149C 10 S100-LNSGAP PIC X(44). *00062 BLF=00001,00000003D 44C 000150 cdS200 FD S2-FICHIER 000151 cdS200 block contains 0 records 000152 cdS200 recording mode is F. 000153 cdS200 copy S9FDI903 replacing 000154 cdS200*^^repl1 * compléter les lignes ci-dessous * 000155 cdS200 ==REDEFINES I900.== by ==.== 000156 cdS200 leading ==I903== by ==S200== 000157 cdS200 . 000158C ****************************************************************** 000159C * Fichier I903 : Nombre d'Applications actives 000160C *----------------------------------------------------------------- 000161C * Utilisation : 000162C * COPY S9FSI903 REPLACING LEADING ==I903=== BY ==prefix==. 000163C ****************************************************************** 000164C *-- 16/10/2021 19:50:48 BIB: S9T SESSION: USER: J070188 000165C 01 S200. BLF=00002,000000000 0CL57 000166C *Code domaine *00001 000167C 10 S200-COSGDM PIC X(8). *00001 BLF=00002,000000000 8C 000168C *Libellé domaine *00009 000169C 10 S200-LNSGDM PIC X(45). *00009 BLF=00002,000000008 45C 000170C *Numérique Entier Banalisé 04 *00054 000171C 10 S200-W9040 PIC 9(4). *00054 BLF=00002,000000035 4C 000172 sqsdff*> *> zone injection fin <* <* 000173 sqsdff* 000174 sqsw *================================================================= 000175 sqsw * W W SSSS SSSS EEEEE CCC TTTTT 000176 sqsw * W W S S E C C T 000177 sqsw * W W W === SSS SSS EEEE C T 000178 sqsw * W W W S S E C C T 000179 sqsw * W W SSSS SSSS EEEEE CCC T 000180 sqsw *================================================================= 000181 sqsw WORKING-STORAGE SECTION. * * 000182 sqsw *--- Marqueur pour faciliter l'analyse des dumps ----------------- 000183 sqsw 01 DEBUT-WSS VOLATILE. 000000000 0CL7 000184 sqsw 05 FILLER PIC X(7) VALUE 'WORKING'. 000000000 7C 000185 sqswp *--- Horodatage code source -------------------------------------- 000186 sqswp copy AGADHORO replacing 000187 sqswp *--- informations à mettre à jour à la création du programme ----- 000188 =='COBASE'== by =='H49 '== 000189 =='APPLI'== by =='AB3'== 000190 =='PROGR'== by =='S9TL1B'== 000191 =='PROGE'== by =='S9TL1B '== 000192 *--- informations variables à mettre à jour ---------------------- 000193 =='NUGNA'== by =='00001'== 000194 =='DATGN'== by =='21/10/23'== 000195 =='DATGNC'== by =='21/10/2023'== 000196 =='TIMGN'== by =='16:23:23'== 000197 =='CODUTI'== by =='J070188 '== 000198 sqswpf . ==000199==> IGYDS0040-I Printing of the source code has been suppressed. 000231C 01 CONSTANTES-PAC. AGADHORO 000000000 0CL87 000232C 05 PAC-CONSTANTES. AGADHORO 000000000 0CL87 000233C 10 NUGNA PIC X(5) VALUE '00001'. AGADHORO 000000000 5C 000234C 10 APPLI PIC X(3) VALUE 'AB3'. AGADHORO 000000005 3C 000235C 10 DATGN PIC X(8) VALUE '21/10/23'. AGADHORO 000000008 8C 000236C 10 PROGR PIC X(6) VALUE 'S9TL1B'. AGADHORO 000000010 6C 000237C 10 CODUTI PIC X(8) VALUE 'J070188 '. AGADHORO 000000016 8C 000238C 10 TIMGN PIC X(8) VALUE '16:23:23'. AGADHORO 00000001E 8C 000239C 10 PROGE PIC X(8) VALUE 'S9TL1B '. AGADHORO 000000026 8C 000240C 10 COBASE PIC X(4) VALUE 'H49 '. AGADHORO 00000002E 4C 000241C 10 DATGNC PIC X(10) VALUE '21/10/2023'. AGADHORO 000000032 10C 000242C 10 RELEAS PIC X(7) VALUE 'CBL NAT'. AGADHORO 00000003C 7C 000243C 10 DATGE PIC X(10) VALUE '01/01/2022'. AGADHORO 000000043 10C 000244C 10 DATSQ PIC X(10) VALUE '01/01/2022'. AGADHORO 00000004D 10C 000245 sqswpf* 000246 sqw2 *----------------------------------------------------------------- 000247 sqw2 * H H OOO SSSS TTTTT V V DDDD BBBB 222 000248 sqw2 * H H O O S T V V D D B B 2 2 000249 sqw2 * HHHHH O O SSS T V V D D BBBB 2 000250 sqw2 * H H O O S T V V D D B B 22 000251 sqw2 * H H OOO SSSS T V DDDD BBBB 22222 000252 sqw2 *----------------------------------------------------------------- 000253 sqw2d *> *> zone injection debut <* <* 000254 cdAP00*--- Ressource AP00 - Table APP 000255 cdAP00*^^hstavcp * compléter les lignes ci-dessous * 000256 cdAP00 copy SG2DAPP replacing 000257 cdAP00*^^repl1 * compléter les lignes ci-dessous * 000258 cdAP00 leading ==APP== by ==AP00== 000259 cdAP00 leading ==V-APP== by ==V-AP00== 000260 cdAP00 . 000261C ******************************************************************SG2DAPP 000262C * TABLE DB2 APP : Applications Cartographie $AGL APP SG2DAPP 000263C *-----------------------------------------------------------------SG2DAPP 000264C * Sous décomposition d'un Domaine de Gestion. SG2DAPP 000265C * L'application correspond à une unité de portage (ou de rem- SG2DAPP 000266C * placement) du Système d'Information. SG2DAPP 000267C * L'application correspond à une entité propriétaire de ses SG2DAPP 000268C * données (c-à-d que les autres applications ne peuvent pas y SG2DAPP 000269C * accéder directement aussi bien en MAJ qu'en Lecture, en TP SG2DAPP 000270C * qu'en Batch mais exclusivement utiliser les services SG2DAPP 000271C * proposés par l'application). SG2DAPP 000272C * SG2DAPP 000273C * Sous-schéma de sélection SG2DAPP 000274C * ------------------------ SG2DAPP 000275C * 1 : recherche Application par codes Domaine/Application SG2DAPP 000276C * SG2DAPP 000277C * ------------------------------------------------------------ SG2DAPP 000278C * Auteur : BELLIER Olivier SG2DAPP 000279C * Date de Création : 29/08/02 SG2DAPP 000280C * Origine Création : Mise aux normes des tables AGL SG2DAPP 000281C * SG2DAPP 000282C * Modifié par : FALLAI Denis SG2DAPP 000283C * Modifié le : 08/10/15 SG2DAPP 000284C * Motif de Modif. : Ajout clés et sous-schémas SG2DAPP 000285C * SG2DAPP 000286C * Modifié par : FALLAI Denis SG2DAPP 000287C * Modifié le : 26/11/18 SG2DAPP 000288C * Motif de Modif. : Regroupement Lettres Domaine et SG2DAPP 000289C * Application SG2DAPP 000290C *-----------------------------------------------------------------SG2DAPP 000291C * Utilisation : SG2DAPP 000292C * COPY SG2DAPP REPLACING LEADING ==APP== BY ==prefix== SG2DAPP 000293C * LEADING ==V-APP== BY ==V-prefix==. SG2DAPP 000294C ******************************************************************SG2DAPP 000295C *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DAPP 000296C *-----------------------------------------------------------------SG2DAPP 000297C * Applications Cartographie $AGL APP SG2DAPP 000298C 01 AP00. SG2DAPP 000000000 0CL94 000299C * Code application Cartographie *00001 000300C 10 AP00-COSGA1 PIC X(8). *00001 000000000 8C 000301C * Libellé application *00009 000302C 10 AP00-LNSGAP PIC X(44). *00009 000000008 44C 000303C * Groupe Lettres Domaine-Application *00053 000304C 10 AP00-GISGDA. *00053 000000034 0CL2 000305C * Code Lettre Domaine PACBASE *00053 000306C 11 AP00-COSGDP PIC X. *00053 000000034 1C 000307C * Lettre préfixe application *00054 000308C 11 AP00-LCSGAP PIC X. *00054 000000035 1C 000309C * date de creation d'une application *00055 000310C 10 AP00-DISGCA PIC X(8). *00055 000000036 8C 000311C * date suppression d'une application *00063 000312C 10 AP00-DISGSU PIC X(8). *00063 00000003E 8C 000313C * date mise a jour d'une application *00071 000314C 10 AP00-DISGMJ PIC X(8). *00071 000000046 8C 000315C * Code Synonyme *00079 000316C 10 AP00-COSGSN PIC X(8). *00079 00000004E 8C 000317C * Code secteur *00087 000318C 10 AP00-COSGSE PIC X(8). *00087 000000056 8C 000319C * SG2DAPP 000320C >>if AA-A-DB2NOIND not defined SG2DAPP 000321C 01 V-AP00. SG2DAPP 000000000 0CL18 000322C 10 V-AP00-COSGA1 PIC S9(4) COMP-5. SG2DAPP 000000000 2C 000323C 10 V-AP00-LNSGAP PIC S9(4) COMP-5. SG2DAPP 000000002 2C 000324C 10 V-AP00-COSGDP PIC S9(4) COMP-5. SG2DAPP 000000004 2C 000325C 10 V-AP00-LCSGAP PIC S9(4) COMP-5. SG2DAPP 000000006 2C 000326C 10 V-AP00-DISGCA PIC S9(4) COMP-5. SG2DAPP 000000008 2C 000327C 10 V-AP00-DISGSU PIC S9(4) COMP-5. SG2DAPP 00000000A 2C 000328C 10 V-AP00-DISGMJ PIC S9(4) COMP-5. SG2DAPP 00000000C 2C 000329C 10 V-AP00-COSGSN PIC S9(4) COMP-5. SG2DAPP 00000000E 2C 000330C 10 V-AP00-COSGSE PIC S9(4) COMP-5. SG2DAPP 000000010 2C 000331C 01 V-AP00-R REDEFINES V-AP00. SG2DAPP 000000000 0CL18 321 000332C 10 V-AP00-A PIC S9(4) COMP-5 SG2DAPP 000000000 2C 000333C OCCURS 00009. SG2DAPP 000334C >>end-if SG2DAPP 000335C >>define AA-A-DB2NOIND off SG2DAPP 000336 cdAP00* 000337 cdDM00*--- Ressource DM00 - Table ADM 000338 cdDM00*^^hstavcp * compléter les lignes ci-dessous * 000339 cdDM00 copy SG2DADM replacing 000340 cdDM00*^^repl1 * compléter les lignes ci-dessous * 000341 cdDM00 leading ==ADM== by ==DM00== 000342 cdDM00 leading ==V-ADM== by ==V-DM00== 000343 cdDM00 . 000344C ******************************************************************SG2DADM 000345C * TABLE DB2 ADM : Domaines Cartographie $AGL ADM SG2DADM 000346C *-----------------------------------------------------------------SG2DADM 000347C * Modifié par : AM Surault SG2DADM 000348C * Modifié le : 24/12/04 SG2DADM 000349C * Motif de Modif. : Remontée à partir de SGL pour pouvoir SG2DADM 000350C * etre utilisée dans STE SG2DADM 000351C * Table contenant les domaines SIRIS tel que définis dans SG2DADM 000352C * la base "cartographie SIRIS". SG2DADM 000353C *-----------------------------------------------------------------SG2DADM 000354C * Utilisation : SG2DADM 000355C * COPY SG2DADM REPLACING LEADING ==ADM== BY ==prefix== SG2DADM 000356C * LEADING ==V-ADM== BY ==V-prefix==. SG2DADM 000357C ******************************************************************SG2DADM 000358C *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DADM 000359C *-----------------------------------------------------------------SG2DADM 000360C * Domaines Cartographie $AGL ADM SG2DADM 000361C 01 DM00. SG2DADM 000000000 0CL70 000362C * Code domaine *00001 000363C 10 DM00-COSGDM PIC X(8). *00001 000000000 8C 000364C * Libellé domaine *00009 000365C 10 DM00-LNSGDM PIC X(45). *00009 000000008 45C 000366C * Code Lettre Domaine PACBASE *00054 000367C 10 DM00-COSGDP PIC X. *00054 000000035 1C 000368C * date de creation d'une application *00055 000369C 10 DM00-DISGCA PIC X(8). *00055 000000036 8C 000370C * date suppression d'une application *00063 000371C 10 DM00-DISGSU PIC X(8). *00063 00000003E 8C 000372C * SG2DADM 000373C >>if AA-A-DB2NOIND not defined SG2DADM 000374C 01 V-DM00. SG2DADM 000000000 0CL10 000375C 10 V-DM00-COSGDM PIC S9(4) COMP-5. SG2DADM 000000000 2C 000376C 10 V-DM00-LNSGDM PIC S9(4) COMP-5. SG2DADM 000000002 2C 000377C 10 V-DM00-COSGDP PIC S9(4) COMP-5. SG2DADM 000000004 2C 000378C 10 V-DM00-DISGCA PIC S9(4) COMP-5. SG2DADM 000000006 2C 000379C 10 V-DM00-DISGSU PIC S9(4) COMP-5. SG2DADM 000000008 2C 000380C 01 V-DM00-R REDEFINES V-DM00. SG2DADM 000000000 0CL10 374 000381C 10 V-DM00-A PIC S9(4) COMP-5 SG2DADM 000000000 2C 000382C OCCURS 00005. SG2DADM 000383C >>end-if SG2DADM 000384C >>define AA-A-DB2NOIND off SG2DADM 000385 cdDM00* 000386 sqw2f *> *> zone injection fin <* <* 000387 sqw2f * 000388 sqwa *----------------------------------------------------------------- 000389 sqwa * W W RRRR K K AAA CCC CCC EEEEE SSSS 000390 sqwa * W W R R K KK A A C C C C E S 000391 sqwa * W W W RRRR KK AAAAA C C EEEE SSS 000392 sqwa * W W W R R K KK A A C C C C E S 000393 sqwa * W W R R K K A A CCC CCC EEEEE SSSS 000394 sqwa *----------------------------------------------------------------- 000395 sqwad *> *> zone injection debut <* <* 000396 cdAP00* 000397 cdAP00*--- Gestion Accès AP -------------------------------------------- 000398 cdAP00 >>define AA-A-ACCES as 'L' 000399 cdAP00 >>define AA-A-MODE as 'S' 000400 cdAP00 >>define AA-A-ORG as '2' 000401 cdAP00 >>define AA-A-NR as 2 000402 cdAP00 >>define AA-A-NS as 1 000403 cdAP00 >>if AA-A-NR > 0 000404 cdAP00*^^accavcp * compléter les lignes ci-dessous * 000405 cdAP00 copy SG2DAPP replacing 000406 cdAP00*^^repl2 * compléter les lignes ci-dessous * 000407 cdAP00 leading ==APP== by ==1-AP00== 000408 cdAP00 leading ==V-APP== by ==V-1-AP00== 000409 cdAP00 . 000410C ******************************************************************SG2DAPP 000411C * TABLE DB2 APP : Applications Cartographie $AGL APP SG2DAPP 000412C *-----------------------------------------------------------------SG2DAPP 000413C * Sous décomposition d'un Domaine de Gestion. SG2DAPP 000414C * L'application correspond à une unité de portage (ou de rem- SG2DAPP 000415C * placement) du Système d'Information. SG2DAPP 000416C * L'application correspond à une entité propriétaire de ses SG2DAPP 000417C * données (c-à-d que les autres applications ne peuvent pas y SG2DAPP 000418C * accéder directement aussi bien en MAJ qu'en Lecture, en TP SG2DAPP 000419C * qu'en Batch mais exclusivement utiliser les services SG2DAPP 000420C * proposés par l'application). SG2DAPP 000421C * SG2DAPP 000422C * Sous-schéma de sélection SG2DAPP 000423C * ------------------------ SG2DAPP 000424C * 1 : recherche Application par codes Domaine/Application SG2DAPP 000425C * SG2DAPP 000426C * ------------------------------------------------------------ SG2DAPP 000427C * Auteur : BELLIER Olivier SG2DAPP 000428C * Date de Création : 29/08/02 SG2DAPP 000429C * Origine Création : Mise aux normes des tables AGL SG2DAPP 000430C * SG2DAPP 000431C * Modifié par : FALLAI Denis SG2DAPP 000432C * Modifié le : 08/10/15 SG2DAPP 000433C * Motif de Modif. : Ajout clés et sous-schémas SG2DAPP 000434C * SG2DAPP 000435C * Modifié par : FALLAI Denis SG2DAPP 000436C * Modifié le : 26/11/18 SG2DAPP 000437C * Motif de Modif. : Regroupement Lettres Domaine et SG2DAPP 000438C * Application SG2DAPP 000439C *-----------------------------------------------------------------SG2DAPP 000440C * Utilisation : SG2DAPP 000441C * COPY SG2DAPP REPLACING LEADING ==APP== BY ==prefix== SG2DAPP 000442C * LEADING ==V-APP== BY ==V-prefix==. SG2DAPP 000443C ******************************************************************SG2DAPP 000444C *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DAPP 000445C *-----------------------------------------------------------------SG2DAPP 000446C * Applications Cartographie $AGL APP SG2DAPP 000447C 01 1-AP00. SG2DAPP 000000000 0CL94 000448C * Code application Cartographie *00001 000449C 10 1-AP00-COSGA1 PIC X(8). *00001 000000000 8C 000450C * Libellé application *00009 000451C 10 1-AP00-LNSGAP PIC X(44). *00009 000000008 44C 000452C * Groupe Lettres Domaine-Application *00053 000453C 10 1-AP00-GISGDA. *00053 000000034 0CL2 000454C * Code Lettre Domaine PACBASE *00053 000455C 11 1-AP00-COSGDP PIC X. *00053 000000034 1C 000456C * Lettre préfixe application *00054 000457C 11 1-AP00-LCSGAP PIC X. *00054 000000035 1C 000458C * date de creation d'une application *00055 000459C 10 1-AP00-DISGCA PIC X(8). *00055 000000036 8C 000460C * date suppression d'une application *00063 000461C 10 1-AP00-DISGSU PIC X(8). *00063 00000003E 8C 000462C * date mise a jour d'une application *00071 000463C 10 1-AP00-DISGMJ PIC X(8). *00071 000000046 8C 000464C * Code Synonyme *00079 000465C 10 1-AP00-COSGSN PIC X(8). *00079 00000004E 8C 000466C * Code secteur *00087 000467C 10 1-AP00-COSGSE PIC X(8). *00087 000000056 8C 000468C * SG2DAPP 000469C >>if AA-A-DB2NOIND not defined SG2DAPP 000470C 01 V-1-AP00. SG2DAPP 000000000 0CL18 000471C 10 V-1-AP00-COSGA1 PIC S9(4) COMP-5. SG2DAPP 000000000 2C 000472C 10 V-1-AP00-LNSGAP PIC S9(4) COMP-5. SG2DAPP 000000002 2C 000473C 10 V-1-AP00-COSGDP PIC S9(4) COMP-5. SG2DAPP 000000004 2C 000474C 10 V-1-AP00-LCSGAP PIC S9(4) COMP-5. SG2DAPP 000000006 2C 000475C 10 V-1-AP00-DISGCA PIC S9(4) COMP-5. SG2DAPP 000000008 2C 000476C 10 V-1-AP00-DISGSU PIC S9(4) COMP-5. SG2DAPP 00000000A 2C 000477C 10 V-1-AP00-DISGMJ PIC S9(4) COMP-5. SG2DAPP 00000000C 2C 000478C 10 V-1-AP00-COSGSN PIC S9(4) COMP-5. SG2DAPP 00000000E 2C 000479C 10 V-1-AP00-COSGSE PIC S9(4) COMP-5. SG2DAPP 000000010 2C 000480C 01 V-1-AP00-R REDEFINES V-1-AP00. SG2DAPP 000000000 0CL18 470 000481C 10 V-1-AP00-A PIC S9(4) COMP-5 SG2DAPP 000000000 2C 000482C OCCURS 00009. SG2DAPP 000483C >>end-if SG2DAPP 000484C >>define AA-A-DB2NOIND off SG2DAPP 000485 cdAP00 >>end-if 000486 cdAP00*^^accavad * compléter les lignes ci-dessous * 000487 cdAP00 copy AAADACCE replacing 000488 cdAP00 ==:DD:== by ==AP== 000489 cdAP00 ==:K1:== by ==COSGDP== 000490 cdAP00 ==:P1:== by ==X(1)== 000491 cdAP00 ==:K2:== by ==LCSGAP== 000492 cdAP00 ==:P2:== by ==X(1)== 000493 cdAP00 . ==000494==> IGYDS0040-I Printing of the source code has been suppressed. 000559C *--- Validation du contexte --------------------------------------AAADACCE 000560C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 000566C >>end-if AAADACCE 000567C >>if AA-A-ORG = '2' AAADACCE 000568C copy AAA00020. AAADACCE 000569C >>define AA-A-DB2 as b'1' override AAA00020 000570C >>end-if AAADACCE 000571C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 000573C >>end-if AAADACCE 000574C * Compteur d'accès AAADACCE 000575C 01 5-AP00-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 000576C >>evaluate AA-A-ACCES AAADACCE 000577C >>when 'L' *> Lecture seule AAADACCE 000578C copy AAA0L000. AAADACCE 000579C >>evaluate AA-A-MODE AAA0L000 000580C >>when 'S' *> Lecture séquentielle AAA0L000 000581C copy AAA0LS00. AAA0L000 000582C >>if AA-A-ORG = '2' AAA0LS00 000583C copy AAA0LS20. AAA0LS00 000584C * Témoins état curseur Db2 AAA0LS20 000585C 01 W-AP00-CESBCU PIC X VALUE 'C'. AAA0LS20 000000000 1C 000586C 88 AP-OUVERT VALUE 'O' AAA0LS20 000587C FALSE 'C'. AAA0LS20 000588C >>end-if AAA0LS00 000589C >>evaluate true AAA0LS00 000590C >>when AA-A-NR < 0 *> Accès séquentiel hors itération AAA0LS00 000597C >>when other *> Accès séquentiel avec Rupture AAA0LS00 000598C >>define AA-A-LECTURES as b'1' override AAA0LS00 000599C copy AAA0LSRU. AAA0LS00 000600C >>define AA-A-LECTURES-AVEC-RUPT as b'1' override AAA0LSRU 000601C >>if AA-A-MAXNR < AA-A-NR AAA0LSRU 000602C >>define AA-A-MAXNR as AA-A-NR override AAA0LSRU 000603C >>end-if AAA0LSRU 000604C * Niveau Rupture Première AAA0LSRU 000605C 01 AP-NRP PIC 9(4) COMP-5 VALUE 1. AAA0LSRU 000000000 2C 000606C * Ruptures Premières AAA0LSRU 000607C 01 AP-PE. AAA0LSRU 000000000 0CL2 000608C 05 AP-PE1 PIC X VALUE '1'. AAA0LSRU 000000000 1C 000609C >>if AA-A-NR > 1 AAA0LSRU 000610C 05 AP-PE2 PIC X VALUE '1'. AAA0LSRU 000000001 1C 000611C >>if AA-A-NR > 2 AAA0LSRU 000631C >>end-if AAA0LSRU 000632C >>end-if AAA0LSRU 000633C * Niveau Rupture Dernière AAA0LSRU 000634C 01 AP-NRD PIC 9(4) COMP-5 VALUE 1. AAA0LSRU 000000000 2C 000635C * Ruptures Dernières AAA0LSRU 000636C 01 AP-DE. AAA0LSRU 000000000 0CL2 000637C 05 AP-DE1 PIC X VALUE '1'. AAA0LSRU 000000000 1C 000638C >>if AA-A-NR > 1 AAA0LSRU 000639C 05 AP-DE2 PIC X VALUE '1'. AAA0LSRU 000000001 1C 000640C >>if AA-A-NR > 2 AAA0LSRU 000660C >>end-if AAA0LSRU 000661C >>end-if AAA0LSRU 000662C >>end-evaluate AAA0LS00 000663C >>if AA-A-NS > 0 *> Accès séquentiel avec Synchro AAA0LS00 000664C copy AAA0LSSY. AAA0LS00 000665C >>define AA-A-LECTURES-AVEC-SYNC as b'1' override AAA0LSSY 000666C >>if AA-A-MAXNS < AA-A-NS AAA0LSSY 000667C >>define AA-A-MAXNS as AA-A-NS override AAA0LSSY 000668C >>end-if AAA0LSSY 000669C * Niveau maximum de Configuration (Synchronisation) AAA0LSSY 000670C 01 AP-NCF PIC 9(4) COMP-5. AAA0LSSY 000000000 2C 000671C * Indicateurs de Configuration (Synchronisation) AAA0LSSY 000672C 01 AP-CF. AAA0LSSY 000000000 0CL1 000673C 05 AP-CF1 PIC X VALUE '1'. AAA0LSSY 000000000 1C 000674C >>if AA-A-NS > 1 AAA0LSSY 000697C >>end-if AAA0LSSY 000698C * Clés de Configuration (Synchronisation) AAA0LSSY 000699C 01 APIND. AAA0LSSY 000000000 0CL1 000700C 05 APIND1. AAA0LSSY 000000000 0CL1 000701C 10 AP-IN-COSGDP PIC X(1). AAA0LSSY 000000000 1C 000702C >>if AA-A-NS > 1 AAA0LSSY 000733C >>end-if AAA0LSSY 000734C >>end-if AAA0LS00 000735C >>when 'R' *> Lecture directe AAA0L000 000743C >>end-evaluate AAA0L000 000744C * Indicateur accès nouvel enregistrement lu AAA0L000 000745C 01 PIC X VALUE '0'. AAA0L000 000000000 1C 000746C 88 AP-LU VALUE '1' AAA0L000 000747C FALSE '0'. AAA0L000 000748C >>when 'E' *> Ecriture seule AAADACCE 000763C >>end-evaluate AAADACCE ==000764==> IGYDS0040-I Printing of the source code has been suppressed. 000772 cdDM00* 000773 cdDM00*--- Gestion Accès DM -------------------------------------------- 000774 cdDM00 >>define AA-A-ACCES as 'L' 000775 cdDM00 >>define AA-A-MODE as 'S' 000776 cdDM00 >>define AA-A-ORG as '2' 000777 cdDM00 >>define AA-A-NR as 0 000778 cdDM00 >>define AA-A-NS as 1 000779 cdDM00 >>if AA-A-NR > 0 000786 cdDM00 >>end-if 000787 cdDM00*^^accavad * compléter les lignes ci-dessous * 000788 cdDM00 copy AAADACCE replacing 000789 cdDM00 ==:DD:== by ==DM== 000790 cdDM00 ==:K1:== by ==COSGDP== 000791 cdDM00 ==:P1:== by ==X(1)== 000792 cdDM00 . ==000793==> IGYDS0040-I Printing of the source code has been suppressed. 000858C *--- Validation du contexte --------------------------------------AAADACCE 000859C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 000865C >>end-if AAADACCE 000866C >>if AA-A-ORG = '2' AAADACCE 000867C copy AAA00020. AAADACCE 000868C >>define AA-A-DB2 as b'1' override AAA00020 000869C >>end-if AAADACCE 000870C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 000872C >>end-if AAADACCE 000873C * Compteur d'accès AAADACCE 000874C 01 5-DM00-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 000875C >>evaluate AA-A-ACCES AAADACCE 000876C >>when 'L' *> Lecture seule AAADACCE 000877C copy AAA0L000. AAADACCE 000878C >>evaluate AA-A-MODE AAA0L000 000879C >>when 'S' *> Lecture séquentielle AAA0L000 000880C copy AAA0LS00. AAA0L000 000881C >>if AA-A-ORG = '2' AAA0LS00 000882C copy AAA0LS20. AAA0LS00 000883C * Témoins état curseur Db2 AAA0LS20 000884C 01 W-DM00-CESBCU PIC X VALUE 'C'. AAA0LS20 000000000 1C 000885C 88 DM-OUVERT VALUE 'O' AAA0LS20 000886C FALSE 'C'. AAA0LS20 000887C >>end-if AAA0LS00 000888C >>evaluate true AAA0LS00 000889C >>when AA-A-NR < 0 *> Accès séquentiel hors itération AAA0LS00 000893C >>when AA-A-NR = 0 *> Accès séquentiel sans Rupture AAA0LS00 000894C >>define AA-A-LECTURES as b'1' override AAA0LS00 000895C >>define AA-A-LECTURES-SANS-RUPT as b'1' override AAA0LS00 000896C >>when other *> Accès séquentiel avec Rupture AAA0LS00 000899C >>end-evaluate AAA0LS00 000900C >>if AA-A-NS > 0 *> Accès séquentiel avec Synchro AAA0LS00 000901C copy AAA0LSSY. AAA0LS00 000902C >>define AA-A-LECTURES-AVEC-SYNC as b'1' override AAA0LSSY 000903C >>if AA-A-MAXNS < AA-A-NS AAA0LSSY 000905C >>end-if AAA0LSSY 000906C * Niveau maximum de Configuration (Synchronisation) AAA0LSSY 000907C 01 DM-NCF PIC 9(4) COMP-5. AAA0LSSY 000000000 2C 000908C * Indicateurs de Configuration (Synchronisation) AAA0LSSY 000909C 01 DM-CF. AAA0LSSY 000000000 0CL1 000910C 05 DM-CF1 PIC X VALUE '1'. AAA0LSSY 000000000 1C 000911C >>if AA-A-NS > 1 AAA0LSSY 000934C >>end-if AAA0LSSY 000935C * Clés de Configuration (Synchronisation) AAA0LSSY 000936C 01 DMIND. AAA0LSSY 000000000 0CL1 000937C 05 DMIND1. AAA0LSSY 000000000 0CL1 000938C 10 DM-IN-COSGDP PIC X(1). AAA0LSSY 000000000 1C 000939C >>if AA-A-NS > 1 AAA0LSSY 000970C >>end-if AAA0LSSY 000971C >>end-if AAA0LS00 000972C >>when 'R' *> Lecture directe AAA0L000 000980C >>end-evaluate AAA0L000 000981C * Indicateur accès nouvel enregistrement lu AAA0L000 000982C 01 PIC X VALUE '0'. AAA0L000 000000000 1C 000983C 88 DM-LU VALUE '1' AAA0L000 000984C FALSE '0'. AAA0L000 000985C >>when 'E' *> Ecriture seule AAADACCE 001000C >>end-evaluate AAADACCE ==001001==> IGYDS0040-I Printing of the source code has been suppressed. 001009 cdS100* 001010 cdS100*--- Gestion Accès S1 -------------------------------------------- 001011 cdS100 >>define AA-A-ACCES as 'E' 001012 cdS100 >>define AA-A-MODE as 'S' 001013 cdS100 >>define AA-A-ORG as 'F' 001014 cdS100 >>define AA-A-NR as 0 001015 cdS100 >>define AA-A-NS as 0 001016 cdS100 >>if AA-A-NR > 0 001022 cdS100 >>end-if 001023 cdS100*^^accavad * compléter les lignes ci-dessous * 001024 cdS100 copy AAADACCE replacing 001025 cdS100 ==:DD:== by ==S1== 001026 cdS100 . ==001027==> IGYDS0040-I Printing of the source code has been suppressed. 001092C *--- Validation du contexte --------------------------------------AAADACCE 001093C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 001099C >>end-if AAADACCE 001100C >>if AA-A-ORG = '2' AAADACCE 001102C >>end-if AAADACCE 001103C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 001105C >>end-if AAADACCE 001106C * Compteur d'accès AAADACCE 001107C 01 5-S100-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 001108C >>evaluate AA-A-ACCES AAADACCE 001109C >>when 'L' *> Lecture seule AAADACCE 001111C >>when 'E' *> Ecriture seule AAADACCE 001112C copy AAA0E000. AAADACCE 001113C >>evaluate AA-A-MODE AAA0E000 001114C >>when 'S' *> Ecriture séquentielle AAA0E000 001115C copy AAA0ES00. AAA0E000 001116C >>if AA-A-NR >= 0 AAA0ES00 001117C >>define AA-A-ECRITURES as b'1' override AAA0ES00 001118C >>end-if AAA0ES00 001119C >>when 'R' *> Ecriture directe AAA0E000 001127C >>end-evaluate AAA0E000 001128C >>when 'M' *> Modification seule AAADACCE 001141C >>end-evaluate AAADACCE ==001142==> IGYDS0040-I Printing of the source code has been suppressed. 001150 cdS200* 001151 cdS200*--- Gestion Accès S2 -------------------------------------------- 001152 cdS200 >>define AA-A-ACCES as 'E' 001153 cdS200 >>define AA-A-MODE as 'S' 001154 cdS200 >>define AA-A-ORG as 'F' 001155 cdS200 >>define AA-A-NR as 0 001156 cdS200 >>define AA-A-NS as 0 001157 cdS200 >>if AA-A-NR > 0 001163 cdS200 >>end-if 001164 cdS200*^^accavad * compléter les lignes ci-dessous * 001165 cdS200 copy AAADACCE replacing 001166 cdS200 ==:DD:== by ==S2== 001167 cdS200 . ==001168==> IGYDS0040-I Printing of the source code has been suppressed. 001233C *--- Validation du contexte --------------------------------------AAADACCE 001234C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 001240C >>end-if AAADACCE 001241C >>if AA-A-ORG = '2' AAADACCE 001243C >>end-if AAADACCE 001244C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 001246C >>end-if AAADACCE 001247C * Compteur d'accès AAADACCE 001248C 01 5-S200-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 001249C >>evaluate AA-A-ACCES AAADACCE 001250C >>when 'L' *> Lecture seule AAADACCE 001252C >>when 'E' *> Ecriture seule AAADACCE 001253C copy AAA0E000. AAADACCE 001254C >>evaluate AA-A-MODE AAA0E000 001255C >>when 'S' *> Ecriture séquentielle AAA0E000 001256C copy AAA0ES00. AAA0E000 001257C >>if AA-A-NR >= 0 AAA0ES00 001258C >>define AA-A-ECRITURES as b'1' override AAA0ES00 001259C >>end-if AAA0ES00 001260C >>when 'R' *> Ecriture directe AAA0E000 001268C >>end-evaluate AAA0E000 001269C >>when 'M' *> Modification seule AAADACCE 001282C >>end-evaluate AAADACCE ==001283==> IGYDS0040-I Printing of the source code has been suppressed. 001291 sqwaf *> *> zone injection fin <* <* 001292 sqwaf * 001293 sqwa2 *--- Interface accès Db2 ----------------------------------------- 001294 sqwa2 >>if AA-A-DB2 001295 sqwa2 exec sql include SQLCA end-exec. 001296C 01 SQLCA GLOBAL VOLATILE. 000000000 0CL136 001297C 05 SQLCAID PIC X(8). 000000000 8C 001298C 05 SQLCABC PIC S9(9) COMP-5. 000000008 4C 001299C 05 SQLCODE PIC S9(9) COMP-5. 00000000C 4C 001300C 05 SQLERRM. 000000010 0CL72 001301C 49 SQLERRML PIC S9(4) COMP-5. 000000010 2C 001302C 49 SQLERRMC PIC X(70). 000000012 70C 001303C 05 SQLERRP PIC X(8). 000000058 8C 001304C 05 SQLERRD PIC S9(9) COMP-5 000000060 4C 001305C OCCURS 6 TIMES. 001306C 05 SQLWARN. 000000078 0CL8 001307C 10 SQLWARN0 PIC X. 000000078 1C 001308C 10 SQLWARN1 PIC X. 000000079 1C 001309C 10 SQLWARN2 PIC X. 00000007A 1C 001310C 10 SQLWARN3 PIC X. 00000007B 1C 001311C 10 SQLWARN4 PIC X. 00000007C 1C 001312C 10 SQLWARN5 PIC X. 00000007D 1C 001313C 10 SQLWARN6 PIC X. 00000007E 1C 001314C 10 SQLWARN7 PIC X. 00000007F 1C 001315C 05 SQLEXT. 000000080 0CL8 001316C 10 SQLWARN8 PIC X. 000000080 1C 001317C 10 SQLWARN9 PIC X. 000000081 1C 001318C 10 SQLWARNA PIC X. 000000082 1C 001319C 10 SQLSTATE PIC X(5). 000000083 5C 001320 sqwa2 >>end-if 001321 sqwa2 * 001322 sqwa3 *--- Interface accès VSAM ---------------------------------------- 001323 sqwa3 >>if AA-A-VSAM 001325 sqwa3 >>end-if 001326 sqwa3 * 001327 sqwac * --- Ruptures Globales ------------------------------------------ 001328 sqwac >>if AA-A-LECTURES-AVEC-RUPT 001329 sqwac copy AAADGRUP. ==001330==> IGYDS0040-I Printing of the source code has been suppressed. 001348C >>if AA-A-MAXNR > 0 AAADGRUP 001349C * AAADGRUP 001350C * Niveau Rupture Première AAADGRUP 001351C 01 NRP PIC 9 VALUE 0. AAADGRUP 000000000 1C 001352C * Ruptures Totales Premières AAADGRUP 001353C 01 RTP. AAADGRUP 000000000 0CL2 001354C 05 RTP1 PIC X VALUE '1'. AAADGRUP 000000000 1C 001355C >>if AA-A-MAXNR > 1 AAADGRUP 001356C 05 RTP2 PIC X VALUE '1'. AAADGRUP 000000001 1C 001357C >>if AA-A-MAXNR > 2 AAADGRUP 001377C >>end-if AAADGRUP 001378C >>end-if AAADGRUP 001379C * Niveau Rupture Dernière AAADGRUP 001380C 01 NRD PIC 9 VALUE 1. AAADGRUP 000000000 1C 001381C * Ruptures Totales Dernières AAADGRUP 001382C 01 RTD. AAADGRUP 000000000 0CL2 001383C 05 RTD1 PIC X VALUE '1'. AAADGRUP 000000000 1C 001384C >>if AA-A-MAXNR > 1 AAADGRUP 001385C 05 RTD2 PIC X VALUE '1'. AAADGRUP 000000001 1C 001386C >>if AA-A-MAXNR > 2 AAADGRUP 001406C >>end-if AAADGRUP 001407C >>end-if AAADGRUP 001408C * Zones de travail AAADGRUP 001409C 01 NRD2 PIC 9(4) COMP-5. AAADGRUP 000000000 2C 001410C 01 IRTD PIC 9(4) COMP-5. AAADGRUP 000000000 2C 001411C >>end-if AAADGRUP 001412 sqwac >>end-if 001413 sqwac *--- Configurations Globales ------------------------------------- 001414 sqwac >>if AA-A-LECTURES-AVEC-SYNC 001415 sqwac copy AAADGSYN 001416 sqwacd*> *> zone injection debut <* <* 001417 cd**** replacing 001418 cd**** ==:P1:== by ==X(1)== 001419 cd**** 001420 sqwacf*> *> zone injection fin <* <* 001421 sqwacf . ==001422==> IGYDS0040-I Printing of the source code has been suppressed. 001440C >>if AA-A-MAXNS > 0 AAADGSYN 001441C * AAADGSYN 001442C * Clés de Synchronisation AAADGSYN 001443C 01 IND. AAADGSYN 000000000 0CL1 001444C 05 IND1 PIC X(1). AAADGSYN 000000000 1C 001445C >>if AA-A-MAXNS > 1 AAADGSYN 001468C >>end-if AAADGSYN 001469C 66 TIND1 RENAMES IND1. AAADGSYN 000000000 1C 1444 001470C >>if AA-A-MAXNS > 1 AAADGSYN 001493C >>end-if AAADGSYN 001494C * AAADGSYN 001495C * Niveau de Configuration maximum de l'itération courante AAADGSYN 001496C 01 MAX-CF PIC 9(4) COMP-5. AAADGSYN 000000000 2C 001497C >>end-if AAADGSYN 001498 sqwacf >>end-if 001499 sqwacf* 001500 sqwft *--- Indicateurs de fin de lecture ------------------------------- 001501 sqwft 01 FT. 000000000 0CL2 001502 sqwft 88 FIN-LECTURES VALUE ALL '1' 001503 sqwft FALSE ALL '0'. 001504 sqwftd*> *> zone injection debut <* <* 001505 cdAP00 05 AP-FT PIC X VALUE '0'. 000000000 1C 001506 cdAP00 88 FIN-LECTURE-AP VALUE '1' 001507 cdAP00 FALSE '0'. 001508 cdDM00 05 DM-FT PIC X VALUE '0'. 000000001 1C 001509 cdDM00 88 FIN-LECTURE-DM VALUE '1' 001510 cdDM00 FALSE '0'. 001511 sqwftf*> *> zone injection fin <* <* 001512 sqwftf >>if not AA-A-LECTURES 001514 sqwftf >>end-if 001515 sqwftf* 001516 sqwfi >>if AA-A-LECTURES-AVEC-RUPT 001517 sqwfi *--- Indicateurs de dernier enregistrement avec rupture----------- 001518 sqwfi 01 FI. 000000000 0CL1 001519 sqwfi 88 DERNIERE-ITERATION VALUE ALL '1' 001520 sqwfi FALSE ALL '0'. 001521 sqwfid*> *> zone injection debut <* <* 001522 cdAP00 05 AP-FI PIC X VALUE '0'. 000000000 1C 001523 cdAP00 88 DERNIERE-LECTURE-AP VALUE '1' 001524 cdAP00 FALSE '0'. 001525 sqwfif*> *> zone injection fin <* <* 001526 sqwfif >>end-if 001527 sqwfif* 001528 sqwsv *----------------------------------------------------------------- 001529 sqwsv * W W RRRR K K SSSS EEEEE RRRR V V 001530 sqwsv * W W R R K KK S E R R V V 001531 sqwsv * W W W RRRR KK SSS EEEE RRRR V V 001532 sqwsv * W W W R R K KK S E R R V V .. 001533 sqwsv * W W R R K K SSSS EEEEE R R V .. 001534 sqwsv *----------------------------------------------------------------- 001535 sqwsv *--- Variables de travail du framework compatible Pacbase -------- 001536 sqwsv copy AGADPAC0. ==001537==> IGYDS0040-I Printing of the source code has been suppressed. 001550C >>define AA-G-VARPACBASE as b'1' override AGADPAC0 001551C *--- Variables Pacbase (pour compatibilité) ----------------------AGADPAC0 001552C 01 BLANC PIC X VALUE SPACE. AGADPAC0 000000000 1C IMP 001553C 01 IK PIC X. AGADPAC0 000000000 1C 001554C 88 IK-OK VALUE '0' AGADPAC0 001555C FALSE '1'. AGADPAC0 001556C 88 IK-KO VALUE '1' AGADPAC0 001557C FALSE '0'. AGADPAC0 001558C 01 TALLI PIC S9(4) BINARY VALUE 0. AGADPAC0 000000000 2C 001559C 01 EN-PRE PIC X. AGADPAC0 000000000 1C 001560C * Contrôles de validité / invalidité sur date AGADPAC0 001561C 88 5-DATE-VALIDE VALUE '1'. AGADPAC0 001562C 88 5-DATE-INVALIDE VALUE '5'. AGADPAC0 001563 sqwsv *--- Gestion des opérations sur Dates et Heures ------------------ 001564 sqwsv copy ADADDATE. ==001565==> IGYDS0040-I Printing of the source code has been suppressed. 001587C * ADADDATE 001588C *--- Variables compatibles Pacbase -------------------------------ADADDATE 001589C * ADADDATE 001590C * DATE DU JOUR COMPLETE ADADDATE 001591C 01 FULL-CURRENT-DATE. ADADDATE 000000000 0CL21 001592C * DATE DU JOUR ADADDATE 001593C 05 DATCE. ADADDATE 000000000 0CL8 001594C 10 CENTUR. ADADDATE 000000000 0CL2 001595C 15 CC PIC XX VALUE '20'. ADADDATE 000000000 2C 001596C 10 DATOR. ADADDATE 000000002 0CL6 001597C 15 DATOA. ADADDATE 000000002 0CL2 001598C 20 YY PIC XX. ADADDATE 000000002 2C 001599C 15 DATOM. ADADDATE 000000004 0CL2 001600C 20 MM PIC XX. ADADDATE 000000004 2C 001601C 15 DATOJ. ADADDATE 000000006 0CL2 001602C 20 DD PIC XX. ADADDATE 000000006 2C 001603C * HEURE COURANTE HHMMSSCC ADADDATE 001604C 05 TIMCO. ADADDATE 000000008 0CL8 001605C 10 TIMCOH. ADADDATE 000000008 0CL2 001606C 15 HH PIC XX. ADADDATE 000000008 2C 001607C 10 TIMCOM. ADADDATE 00000000A 0CL2 001608C 15 MM PIC XX. ADADDATE 00000000A 2C 001609C 10 TIMCOS. ADADDATE 00000000C 0CL2 001610C 15 SS PIC XX. ADADDATE 00000000C 2C 001611C 10 TIMOC. ADADDATE 00000000E 0CL2 001612C 15 TIMCOC. ADADDATE 00000000E 0CL2 001613C 20 CC PIC XX. ADADDATE 00000000E 2C 001614C * TIME-ZONE ADADDATE 001615C 05 TZ. ADADDATE 000000010 0CL5 001616C 10 TZ-GMT PIC X. ADADDATE 000000010 1C 001617C 88 TZ-BEHIND-GMT VALUE '-'. ADADDATE 001618C 88 TZ-AHEAD-GMT VALUE '+'. ADADDATE 001619C 10 TZ-HH PIC XX. ADADDATE 000000011 2C 001620C 10 TZ-MM PIC XX. ADADDATE 000000013 2C 001621C * HEURE FORMAT HH:MM:SS ADADDATE 001622C 01 TIMDAY. ADADDATE 000000000 0CL8 001623C 05 TIMHOU. ADADDATE 000000000 0CL2 001624C 10 HH PIC XX. ADADDATE 000000000 2C 001625C 05 TIMS1. ADADDATE 000000002 0CL1 001626C 10 S1 PIC X VALUE ':'. ADADDATE 000000002 1C 001627C 05 TIMMIN. ADADDATE 000000003 0CL2 001628C 10 MM PIC XX. ADADDATE 000000003 2C 001629C 05 TIMS2. ADADDATE 000000005 0CL1 001630C 10 S2 PIC X VALUE ':'. ADADDATE 000000005 1C 001631C 05 TIMSEC. ADADDATE 000000006 0CL2 001632C 10 SS PIC XX. ADADDATE 000000006 2C 001633C * SEPARATEUR DATE PAR DEFAUT ADADDATE 001634C 01 DATSEP PIC X VALUE '/'. ADADDATE 000000000 1C 001635C * SEPARATEUR DATE FORMAT G ADADDATE 001636C 01 DATSET PIC X VALUE '-'. ADADDATE 000000000 1C 001637C * SEPARATEUR DATE DE TRAVAIL (non utilisé dans version COBOL) ADADDATE 001638C 01 DATSEW PIC X. ADADDATE 000000000 1C 001639C * SEPARATEUR HEURE PAR DEFAUT ADADDATE 001640C 01 TIMSEP PIC X VALUE ':'. ADADDATE 000000000 1C 001641C * NOMBRE DE JOURS DANS CALCULS SUR DATE ADADDATE 001642C 01 NUM-DAYS PIC S9(9). ADADDATE 000000000 9C 001643C * ADADDATE 001644C *--- Variables de communication avec les routines ----------------ADADDATE 001645C * ADADDATE 001646C * DATE FORMAT C : JJMMSSAA ADADDATE 001647C 01 5-DATE-C. *> DAT7C ADADDATE 000000000 0CL8 001648C 05 DD PIC XX. *> DAT71C ADADDATE 000000000 2C 001649C 05 MM PIC XX. *> DAT72C ADADDATE 000000002 2C 001650C 05 YYYY. ADADDATE 000000004 0CL4 001651C 10 CC PIC XX. *> DAT73C ADADDATE 000000004 2C 001652C 10 YY PIC XX. *> DAT74C ADADDATE 000000006 2C 001653C * DATE FORMAT D : JJMMAA ADADDATE 001654C 01 5-DATE-D. *> DAT7 ADADDATE 000000000 0CL6 001655C 05 DD PIC XX. *> DAT71 ADADDATE 000000000 2C 001656C 05 MM PIC XX. *> DAT72 ADADDATE 000000002 2C 001657C 05 YY PIC XX. *> DAT73 ADADDATE 000000004 2C 001658C * DATE FORMAT E : JJ/MM/AA ADADDATE 001659C 01 5-DATE-E. *> DAT8 ADADDATE 000000000 0CL8 001660C 05 DD PIC XX. *> DAT81 ADADDATE 000000000 2C 001661C 05 S1 PIC X. *> DAT8S1 ADADDATE 000000002 1C 001662C 05 MM PIC XX. *> DAT82 ADADDATE 000000003 2C 001663C 05 S2 PIC X. *> DAT8S2 ADADDATE 000000005 1C 001664C 05 YY PIC XX. *> DAT83 ADADDATE 000000006 2C 001665C * DATE FORMAT G : SSAA-MM-JJ ADADDATE 001666C 01 5-DATE-G. *> DAT8G ADADDATE 000000000 0CL10 001667C 05 YYYY. ADADDATE 000000000 0CL4 001668C 10 CC PIC XX. *> DAT81G ADADDATE 000000000 2C 001669C 10 YY PIC XX. *> DAT82G ADADDATE 000000002 2C 001670C 05 S1 PIC X VALUE '-'. *> DAT8S1G ADADDATE 000000004 1C 001671C 05 MM PIC XX. *> DAT83G ADADDATE 000000005 2C 001672C 05 S2 PIC X VALUE '-'. *> DATS2G ADADDATE 000000007 1C 001673C 05 DD PIC XX. *> DAT84G ADADDATE 000000008 2C 001674C * DATE FORMAT I : AAMMJJ ADADDATE 001675C 01 5-DATE-I. *> DAT6 ADADDATE 000000000 0CL6 001676C 05 YY PIC XX. *> DAT61 ADADDATE 000000000 2C 001677C 05 MM PIC XX. *> DAT62 ADADDATE 000000002 2C 001678C 05 DD PIC XX. *> DAT63 ADADDATE 000000004 2C 001679C * DATE FORMAT M : JJ/MM/SSAA ADADDATE 001680C 01 5-DATE-M. *> DAT8C ADADDATE 000000000 0CL10 001681C 05 DD PIC XX. *> DAT81C ADADDATE 000000000 2C 001682C 05 S1 PIC X VALUE '/'. *> DATS1C ADADDATE 000000002 1C 001683C 05 MM PIC XX. *> DAT82C ADADDATE 000000003 2C 001684C 05 S2 PIC X VALUE '/'. *> DATS2C ADADDATE 000000005 1C 001685C 05 YYYY. *> DAT83C ADADDATE 000000006 0CL4 001686C 10 CC PIC XX. *> DAT83CC ADADDATE 000000006 2C 001687C 10 YY PIC XX. *> DAT84C ADADDATE 000000008 2C 001688C * DATE FORMAT S : SSAAMMJJ ADADDATE 001689C 01 5-DATE-S. *> DAT6C ADADDATE 000000000 0CL8 001690C 05 YYYY. ADADDATE 000000000 0CL4 001691C 10 CC. *> DAT61C ADADDATE 000000000 0CL2 001692C 15 CC9 PIC 99. ADADDATE 000000000 2C 001693C 10 YY. *> DAT62C ADADDATE 000000002 0CL2 001694C 15 YY9 PIC 99. ADADDATE 000000002 2C 001695C 05 MM PIC XX. *> DAT63CC ADADDATE 000000004 2C 001696C 05 DD PIC XX. *> DAT64C ADADDATE 000000006 2C 001697C * HEURE FORMAT HHMMSS ADADDATE 001698C 01 5-TIME. ADADDATE 000000000 0CL6 001699C 05 HH PIC X(2). ADADDATE 000000000 2C 001700C 05 MM PIC X(2). ADADDATE 000000002 2C 001701C 05 SS PIC X(2). ADADDATE 000000004 2C 001702C * FENETRAGE DU SIECLE ADADDATE 001703C *01 DAT-CTYD PIC XX VALUE '61'. ADADDATE 001704C 01 5-DATE-PIVOT PIC XX VALUE '61'. *> DAT-CTYT ADADDATE 000000000 2C 001705C 01 5-DATE-SIECLE PIC XX VALUE '19'. *> DAT-CTY ADADDATE 000000000 2C 001706C 01 5-DATE-ADO PIC X VALUE SPACE. *> DAT-ADO ADADDATE 000000000 1C IMP 001707C 88 5-DATE-SIECLE-DEF VALUE '0'. ADADDATE 001708C 88 5-DATE-1900-AVANT VALUE '1'. ADADDATE 001709C 88 5-DATE-2000-AVANT VALUE '2'. ADADDATE 001710C * DATES FORMAT SSAAMMJJ POUR CALCULS ADADDATE 001711C 01 5-DATE-D1 PIC 9(8). *> DATE81 ADADDATE 000000000 8C 001712C 01 5-DATE-D2 PIC 9(8). *> DATE82 ADADDATE 000000000 8C 001713C * ADADDATE 001714C *--- Variables de travail internes aux routines (ne pas utiliser) ADADDATE 001715C * ADADDATE 001716C * CALCUL ANNEE BISSECTILE ADADDATE 001717C 01 5-DATE-M4 PIC 99 BINARY. *> LEAP-REM ADADDATE 000000000 2C 001718C >>if not AA-G-VARPACBASE ADADDATE 001723C >>end-if ADADDATE 001724C >>if AA-G-PACBASE ADADDATE 001726C >>end-if ADADDATE 001727 sqwvsd*--- insertion working par l'assistant --------------------------- 001728 sqwvsd*> *> zone injection debut <* <* 001729 sqwvsf*> *> zone injection fin <* <* 001730 sqwvsf* 001731 sqwvv *----------------------------------------------------------------- 001732 sqwvv * W W RRRR K K CCC TTTTT RRRR L 001733 sqwvv * W W R R K KK C C T R R L 001734 sqwvv * W W W RRRR KK C T RRRR L 001735 sqwvv * W W W R R K KK C C T R R L .. 001736 sqwvv * W W R R K K CCC T R R LLLLL .. 001737 sqwvv *----------------------------------------------------------------- 001738 sqwvv *--- Variables pour contrôles automatiques ----------------------- 001739 sqwvvd*> *> zone injection début <* <* 001740 sqwvvf*> *> zone injection fin <* <* 001741 sqwvvf* 001742 sqwsva*--- Traçabilité programme (reco audit) -------------------------- 001743 sqwsva copy AGADAUDT. ==001744==> IGYDS0040-I Printing of the source code has been suppressed. 001756C *-----------------------------------------------------------------AGADAUDT 001757C * Tracabilité programme - Reco "Audit Archivage 2010" #5 AGADAUDT 001758C * Date système format JJMMSSAA (C) AGADAUDT 001759C 01 W-BA0C-DASDSY PIC X(8). AGADAUDT 000000000 8C 001760C * Date système format SSAA-MM-JJ (G) AGADAUDT 001761C 01 W-BA0G-DASDSY PIC X(10). AGADAUDT 000000000 10C 001762C * Date système format JJ/MM/SSAA (M) AGADAUDT 001763C 01 W-BA0M-DASDSY PIC X(10). AGADAUDT 000000000 10C 001764C * Indicateur d'exécution : 0=jamais, 1=1ère fois, 2=après 1ère AGADAUDT 001765C 01 PIC X VALUE '0'. AGADAUDT 000000000 1C 001766C 88 RECO-ARCH-2010-5-notRUN VALUE '0' AGADAUDT 001767C FALSE '1'. AGADAUDT 001768C 88 RECO-ARCH-2010-5-wasRUN VALUE '2'. AGADAUDT 001769 sqwsv2*--- Erreur Db2 -------------------------------------------------- 001770 sqwsv2 >>if AA-A-DB2 001771 sqwsv2 copy A2ADTIAR. ==001772==> IGYDS0040-I Printing of the source code has been suppressed. 001786C *--- Interface DSNTIAR -------------------------------------------A2ADTIAR 001787C 01 DSNTIAR-RC PIC 9(2). A2ADTIAR 000000000 2C 001788C 88 DSNTIAR-OK VALUE 00 THRU 04. A2ADTIAR 001789C 01 DSNTIAR-ABEND PIC 9(8) COMP-5. A2ADTIAR 000000000 4C 001790C 01 DSNTIAR-LINE-LENGTH PIC 9(8) COMP-5 A2ADTIAR 000000000 4C 001791C VALUE 72. A2ADTIAR 001792C 01 DSNTIAR-MESSAGE. A2ADTIAR 000000000 0CL722 001793C 05 DSNTIAR-MESSAGE-LENGTH PIC 9(4) COMP-5 A2ADTIAR 000000000 2C 001794C VALUE 720. A2ADTIAR 001795C 05 DSNTIAR-LINES. A2ADTIAR 000000002 0CL720 001796C 10 DSNTIAR-LINE PIC X(72) OCCURS 10 A2ADTIAR 000000002 72C 001797C INDEXED BY XDSNTIAR. A2ADTIAR 001798C 88 DSNTIAR-END VALUE SPACES. A2ADTIAR IMP 001799 sqwsv2 >>end-if 001800 sqwsvb*--- Erreur abend volontaire (U4000 par défaut) ----------------- 001801 sqwsvb 01 CODE-ABEND PIC 9(8) COMP-5 VALUE 4000. 000000000 4C 001802 sqwk *----------------------------------------------------------------- 001803 sqwk * W W RRRR K K SSSS PPPP EEEEE CCC 001804 sqwk * W W R R K KK S P P E C C 001805 sqwk * W W W RRRR KK SSS PPPP EEEE C 001806 sqwk * W W W R R K KK S P E C C .. 001807 sqwk * W W R R K K SSSS P EEEEE CCC .. 001808 sqwk *----------------------------------------------------------------- 001809 sqwk * Insérer ci-dessous les variables spécifiques du programme 001810 sqwk * 001811 01 W-WB00-W9040 PIC S9(4) BINARY. 000000000 2C 001812 sqwkd *> *> zone injection debut <* <* 001813 sqwkf *> *> zone injection fin <* <* 001814 sqwkf 01 PIC X(1) VALUE '0'. 000000000 1C 001815 sqwkf 88 WORKING-INITIALISEES VALUE '1' 001816 sqwkf FALSE '0'. 001817 sqlk LINKAGE SECTION. 001818 sqlk *================================================================= 001819 sqlk * L N N K K SSSS EEEEE CCC TTTTT 001820 sqlk * L NN N K KK S E C C T 001821 sqlk * L N N N KK SSS EEEE C T 001822 sqlk * L N NN K KK S E C C T 001823 sqlk * LLLLL N N K K SSSS EEEEE CCC T 001824 sqlk *================================================================= 001825 sqlkd *> *> zone injection debut <* <* 001826 sqlkf *> *> zone injection fin <* <* 001827 sqlkf * Insérer ci-dessous les variables spécifiques du programme 001828 sqlkf * 001829 sqp /***************************************************************** 001830 sqp * PPPP RRRR OOO CCC EEEEE DDDD U U RRRR EEEEE 001831 sqp * P P R R O O C C E D D U U R R E 001832 sqp * PPPP RRRR O O C EEE D D U U RRRR EEEE 001833 sqp * P R R O O C C E D D U U R R E 001834 sqp * P R R OOO CCC EEEEE DDDD UUU R R EEEEE 001835 sqp ****************************************************************** 001836 sqp PROCEDURE DIVISION. 001837 * USING ... . 001838 sqpp *=== Cinematique principale ====================================== 001839 sqpp PRINCIPAL SECTION. 001840 sqpp *--- Gestion des erreurs Db2 ------------------------------------- 001841 sqpp >>if AA-A-DB2 001842 exec sql whenever NOT FOUND continue end-exec. 001843 exec sql whenever SQLWARNING continue end-exec. 001844 exec sql whenever SQLERROR goto ERREUR-DB2 end-exec. 001845 sqppa >>end-if 001846 sqppa *--- Initialisations --------------------------------------------- 001847 sqppa perform INITIALISATIONS-WORKING 4031 001848 sqppa with test before until WORKING-INITIALISEES 1815 001849 sqppa perform S-DEBUT 1912 001850 sqppa perform INITIALISATIONS 3969 001851 sqppa perform S-AVANT-OUVERTURES 1925 001852 sqppa perform OUVERTURES 4047 001853 sqppa perform S-AVANT-ITERATION 1938 001854 sqppa *--- Boucle principale ------------------------------------------- 001855 sqppa perform ITERATION until FIN-LECTURES. 1867 1502 001856 sqppa *--- Abandon du traitment (GFT) ---------------------------------- 001857 sqppa FIN-TRAITEMENT. 001858 sqppa *--- Finalisations ----------------------------------------------- 001859 sqppa perform S-AVANT-FERMETURES 1996 001860 sqppa perform FERMETURES 4111 001861 sqppa perform S-AVANT-FINALISATION 2009 001862 sqppa perform FINALISATION 4146 001863 sqppaz*--- Sortie du programme ----------------------------------------- 001864 sqppaz goback 001865 sqppaz . 001866 sqppi *=== Décomposition de la boucle principale ======================= 001867 sqppi ITERATION SECTION. 001868 sqppi perform S-AVANT-LECTURES 1951 001869 sqppi >>if AA-A-LECTURES 001870 sqppi perform LECTURES 4083 001871 sqppi >>end-if 001872 sqppi if not FIN-LECTURES 1502 001873 1 sqppi perform S-APRES-LECTURES 1964 001874 sqppir*--- Cinématique ressources lues --------------------------------- 001875 sqppir >>if AA-A-LECTURES-AVEC-RUPT or AA-A-LECTURES-AVEC-SYNC 001876 1 sqppir perform RUPTURES-SYNCHROS 4189 001877 sqppir >>end-if 001878 sqppir >>if AA-A-CONTROLES 001880 sqppir >>end-if 001881 sqppir >>if AA-A-MAJ 001883 sqppir >>end-if 001884 sqppit*--- Taitement applicatif principal ------------------------------ 001885 1 sqppit perform S-TRAITEMENT 1977 001886 sqppie*--- Editions ---------------------------------------------------- 001887 sqppie >>if AA-A-EDITIONS 001889 sqppie >>end-if 001890 sqppiw*--- Ressources en écritures ------------------------------------- 001891 sqppiw >>if AA-A-ECRITURES 001892 1 sqppiw perform ECRITURES 4336 001893 sqppiw >>end-if 001894 sqppiw end-if. 001895 sqppif*--- Retour en début d'itération (GDI) --------------------------- 001896 sqppif ITERATION-SUIVANTE. 001897 sqppif continue. 001898 sqppif ITERATION-FN. 001899 sqppif exit section. 001900 sqppif 001901 sqpz /================================================================= 001902 sqpz * CCC OOO DDDD EEEEE SSSS PPPP EEEEE 001903 sqpz * C C O O D D E S P P E 001904 sqpz * C O O D D EEEE SSS PPPP EEEE 001905 sqpz * C C O O D D E S P E 001906 sqpz * CCC OOO DDDD EEEEE SSSS P EEEEE 001907 sqpz *================================================================= 001908 sqpz0a* 001909 sqpz0a*================================================================= 001910 sqpz0a* Début de programme, avant tout autre traitement 001911 sqpz0a*================================================================= 001912 sqpz0a S-DEBUT SECTION. 001913 sqpz0a* Insérer ci-dessous le code spécifiques du programme 001914 sqpz0z*--- Fin début de programme -------------------------------------- 001915 sqpz0z continue. 001916 sqpz0z S-DEBUT-FN. 001917 sqpz0z exit section. 001918 sqpz0z* 001919 sqpz0z*--- Routines performées depuis S-DEBUT -------------------------- 001920 sqpz0z* Insérer ci-dessous le code spécifiques du programme 001921 sqpz1a* 001922 sqpz1a*================================================================= 001923 sqpz1a* Avant ouvertures des ressources 001924 sqpz1a*================================================================= 001925 sqpz1a S-AVANT-OUVERTURES SECTION. 001926 sqpz1a* Insérer ci-dessous le code spécifiques du programme 001927 sqpz1z*--- Fin avant ouverture des ressources -------------------------- 001928 sqpz1z continue. 001929 sqpz1z S-AVANT-OUVERTURES-FN. 001930 sqpz1z exit section. 001931 sqpz1z* 001932 sqpz1z*--- Routines performées depuis S-AVANT-OUVERTURES --------------- 001933 sqpz1z* Insérer ci-dessous le code spécifiques du programme 001934 sqpz2a* 001935 sqpz2a*================================================================= 001936 sqpz2a* Avant itération principale 001937 sqpz2a*================================================================= 001938 sqpz2a S-AVANT-ITERATION SECTION. 001939 sqpz2a* Insérer ci-dessous le code spécifiques du programme 001940 sqpz2z*--- Fin avant itération principale ------------------------------ 001941 sqpz2z continue. 001942 sqpz2z S-AVANT-ITERATION-FN. 001943 sqpz2z exit section. 001944 sqpz2z* 001945 sqpz2z*--- Routines performées depuis S-AVANT-ITERATION ---------------- 001946 sqpz2z* Insérer ci-dessous le code spécifiques du programme 001947 sqpz3a* 001948 sqpz3a*================================================================= 001949 sqpz3a* Avant lectures des ressources 001950 sqpz3a*================================================================= 001951 sqpz3a S-AVANT-LECTURES SECTION. 001952 sqpz3a* Insérer ci-dessous le code spécifiques du programme 001953 sqpz3z*--- Fin avant lectures des ressources --------------------------- 001954 sqpz3z continue. 001955 sqpz3z S-AVANT-LECTURES-FN. 001956 sqpz3z exit section. 001957 sqpz3z* 001958 sqpz3z*--- Routines performées depuis S-AVANT-LECTURES ----------------- 001959 sqpz3z* Insérer ci-dessous le code spécifiques du programme 001960 sqpz4a* 001961 sqpz4a*================================================================= 001962 sqpz4a* Après lectures des ressources 001963 sqpz4a*================================================================= 001964 sqpz4a S-APRES-LECTURES SECTION. 001965 sqpz4a* Insérer ci-dessous le code spécifiques du programme 001966 sqpz4z*--- Fin après lectures des ressources --------------------------- 001967 sqpz4z continue. 001968 sqpz4z S-APRES-LECTURES-FN. 001969 sqpz4z exit section. 001970 sqpz4z* 001971 sqpz4z*--- Routines performées depuis S-APRES-LECTURES ----------------- 001972 sqpz4z* Insérer ci-dessous le code spécifiques du programme 001973 sqpz5a* 001974 sqpz5a*================================================================= 001975 sqpz5a* Traitement applicatif principal 001976 sqpz5a*================================================================= 001977 sqpz5a S-TRAITEMENT SECTION. 001978 sqpz5a* Insérer ci-dessous le code spécifiques du programme 001979 if RTP1 = 1 1354 001980 1 move 0 to W-WB00-W9040 1811 001981 end-if 001982 if 1-AP00-DISGSU = spaces 461 IMP 001983 1 add 1 to W-WB00-W9040 1811 001984 end-if 001985 sqpz5z*--- Fin traitement applicatif principal ------------------------- 001986 sqpz5z continue. 001987 sqpz5z S-TRAITEMENT-FN. 001988 sqpz5z exit section. 001989 sqpz5z* 001990 sqpz5z*--- Routines performées depuis S-TRAITEMENT --------------------- 001991 sqpz5z* Insérer ci-dessous le code spécifiques du programme 001992 sqpz6a* 001993 sqpz6a*================================================================= 001994 sqpz6a* Avant fermeture des ressources 001995 sqpz6a*================================================================= 001996 sqpz6a S-AVANT-FERMETURES SECTION. 001997 sqpz6a* Insérer ci-dessous le code spécifiques du programme 001998 sqpz6z*--- Fin avant fermeture des ressources -------------------------- 001999 sqpz6z continue. 002000 sqpz6z S-AVANT-FERMETURES-FN. 002001 sqpz6z exit section. 002002 sqpz6z* 002003 sqpz6z*--- Routines performées depuis S-AVANT-FERMETURES --------------- 002004 sqpz6z* Insérer ci-dessous le code spécifiques du programme 002005 sqpz7a* 002006 sqpz7a*================================================================= 002007 sqpz7a* Avant sortie du programme 002008 sqpz7a*================================================================= 002009 sqpz7a S-AVANT-FINALISATION SECTION. 002010 sqpz7a* Insérer ci-dessous le code spécifiques du programme 002011 sqpz7z*--- Fin avant sortie du programme ------------------------------- 002012 sqpz7z continue. 002013 sqpz7z S-AVANT-FINALISATION-FN. 002014 sqpz7z exit section. 002015 sqpz7z* 002016 sqpz7z*--- Routines performées depuis S-AVANT-FINALISATION ------------- 002017 sqpz7z* Insérer ci-dessous le code spécifiques du programme 002018 sqpz9a* 002019 sqpz9a/================================================================= 002020 sqpz9a* RRRR OOO U U TTTTT IIIII N N EEEEE SSS 002021 sqpz9a* R R O O U u T I NN N E S 002022 sqpz9a* RRRR O O U U T I N N N EEE SSS 002023 sqpz9a* R R O O U U T I N NN E S 002024 sqpz9a* R R OOO UUU T IIIII N N EEEEE SSS 002025 sqpz9a*================================================================= 002026 sqpz9a*--- Routines internes performées -------------------------------- 002027 sqpz9a S-ROUTINES-INTERNES SECTION. 002028 sqpz9a continue. 002029 sqpz9a* Insérer ci-dessous le code spécifiques du programme 002030 sqpz9z*--- Fin routines internes performées ---------------------------- 002031 sqpz9z S-ROUTINES-INTERNES-FN. 002032 sqpz9z exit section. 002033 sqpz9z 002034 sqpa /================================================================= 002035 sqpa * AAA CCC CCC EEEEE SSSS 002036 sqpa * A A C C C C E S 002037 sqpa * AAAAA C C EEEE SSS 002038 sqpa * A A C C C C E S 002039 sqpa * A A CCC CCC EEEEE SSSS 002040 sqpa *================================================================= 002041 sqpa ACCESS-RESSOURCES SECTION. 002042 sqpa continue. 002043 sqpad *> *> zone injection debut <* <* 002044 cdAP00* 002045 cdAP00*--- Gestion Accès AP -------------------------------------------- 002046 cdAP00 >>define AA-A-ACCES as 'L' 002047 cdAP00 >>define AA-A-MODE as 'S' 002048 cdAP00 >>define AA-A-ORG as '2' 002049 cdAP00 >>define AA-A-NR as 2 002050 cdAP00 >>define AA-A-NS as 1 002051 cdAP00*^^accavap * compléter les lignes ci-dessous * 002052 cdAP00 copy AAAPACCE replacing 002053 cdAP00 ==:DD:== by ==AP== 002054 cdAP00 ==:PREF:== by ==AP00== 002055 cdAP00 ==:NS:== by ==1== 002056 cdAP00 ==:K1:== by ==COSGDP== 002057 cdAP00 ==:K2:== by ==LCSGAP== 002058 cdAP00 . ==002059==> IGYPS0040-I Printing of the source code has been suppressed. 002164C >>evaluate AA-A-ACCES AAAPACCE 002165C >>when 'L' *> Lecture seule AAAPACCE 002166C copy AAA5L000. AAAPACCE 002167C >>evaluate AA-A-MODE AAA5L000 002168C >>when 'S' *> Lecture séquentielle AAA5L000 002169C copy AAA5LS00. AAA5L000 002170C >>evaluate true AAA5LS00 002171C >>when AA-A-NR <= 0 and AA-A-NS = 0 *> sans Rupt ni Sync AAA5LS00 002177C >>when other *> avec Rupt et Sync AAA5LS00 002178C copy AAA5LSRS. AAA5LS00 002179C ******************************************************************AAA5LSRS 002180C * Accès logiques Lecture Séquentielle avec Ruptures et Synchros AAA5LSRS 002181C ******************************************************************AAA5LSRS 002182C * AAA5LSRS 002183C OUVRIR-AP SECTION. AAA5LSRS 002184C perform OUVRIR-AP-PHYSIQUE AAA5LSRS 2503 002185C perform LIRE-AP-PHYSIQUE. AAA5LSRS 2519 002186C OUVRIR-AP-FN. AAA5LSRS 002187C exit section. AAA5LSRS 002188C * AAA5LSRS 002189C LIRE-AP SECTION. AAA5LSRS 002190C set AP-LU to false AAA5LSRS 746 002191C >>define L_ as b'1' AAA5LSRS 002192C >>evaluate true AAA5LSRS 002193C >>when AA-A-MAXNR <= 0 AAA5LSRS 002197C >>when AA-A-NR >= AA-A-NS AAA5LSRS 002198C >>define L_ as b'0' override AAA5LSRS 002199C >>end-evaluate AAA5LSRS 002200C *>>if maxNR > 0 and NS <= maxNR and NR < NS AAA5LSRS 002201C >>if L_ AAA5LSRS 002203C >>else AAA5LSRS 002204C if AP-CF1 not = '1' AAA5LSRS 673 002205C >>end-if AAA5LSRS 002206C >>define L_ off AAA5LSRS 002207C 1 exit section AAA5LSRS 002208C end-if AAA5LSRS 002209C * Alimentation anticipée des indicateurs "Rupture Première" AAA5LSRS 002210C move AP-DE to AP-PE AAA5LSRS 636 607 002211C move AP-NRD to AP-NRP AAA5LSRS 634 605 002212C if AP-FI = '1' AAA5LSRS 1522 002213C 1 move high-value to APIND AAA5LSRS IMP 699 002214C 1 move '1' to AP-FT AAA5LSRS 1505 002215C 1 exit section AAA5LSRS 002216C end-if AAA5LSRS 002217C move AP00 to 1-AP00 AAA5LSRS 298 447 002218C perform ALIMENTER-CLE-AP AAA5LSRS 2317 002219C add 1 to 5-AP00-CPTENR AAA5LSRS 575 002220C perform LIRE-AP-PHYSIQUE. AAA5LSRS 2519 002221C LIRE-AP-FN. AAA5LSRS 002222C exit section. AAA5LSRS 002223C * AAA5LSRS 002224C FERMER-AP SECTION. AAA5LSRS 002225C perform FERMER-AP-PHYSIQUE. AAA5LSRS 2539 002226C FERMER-AP-FN. AAA5LSRS 002227C exit section. AAA5LSRS 002228C copy AAA5L0RS. AAA5LSRS 002229C * AAA5L0RS 002230C CALCULER-RUPT-AP SECTION. AAA5L0RS 002231C * Calcul des indicateurs "Ruptures Dernières" AAA5L0RS 002232C move all '0' to AP-DE AAA5L0RS 636 002233C move 0 to AP-NRD AAA5L0RS 634 002234C evaluate true AAA5L0RS 002235C when AP-FI = '1' AAA5L0RS 1522 002236C when AP00-COSGDP not = 1-AP00-COSGDP AAA5L0RS 306 455 002237C 1 move 1 to AP-NRD AAA5L0RS 634 002238C 1 move all '1' to AP-DE AAA5L0RS 636 002239C >>if AA-A-NR > 1 AAA5L0RS 002240C when AP00-LCSGAP not = 1-AP00-LCSGAP AAA5L0RS 308 457 002241C 1 move 2 to AP-NRD AAA5L0RS 634 002242C 1 move all '1' to AP-DE(2:) AAA5L0RS 636 002243C >>if AA-A-NR > 2 AAA5L0RS 002277C >>end-if AAA5L0RS 002278C >>end-if AAA5L0RS 002279C end-evaluate. AAA5L0RS 002280C CALCULER-RUPT-AP-FN. AAA5L0RS 002281C exit section. AAA5L0RS 002282C * AAA5L0RS 002283C CALCULER-RTD-AP SECTION. AAA5L0RS 002284C if NRD2 > 0 AAA5L0RS 1409 002285C 1 perform varying IRTD from NRD2 by 1 AAA5L0RS 1410 1409 002286C 1 until IRTD > length of AP-DE AAA5L0RS 1410 IMP 636 002287C 2 if IRTD <= 1 AAA5L0RS 1410 002288C 2 and AP-CF (IRTD:1) = '1' AAA5L0RS 672 1410 002289C 2 and (AP-DE (IRTD:1) = '0' AAA5L0RS 636 1410 002290C 2 or AP-CF1 = '0') AAA5L0RS 673 002291C 3 move '0' to RTD (IRTD:1) AAA5L0RS 1382 1410 002292C 3 if RTD = all '0' AAA5L0RS 1382 002293C 4 move 0 to NRD2 NRD AAA5L0RS 1409 1380 002294C 3 else AAA5L0RS 002295C 4 add 1 to IRTD giving NRD2 NRD AAA5L0RS 1410 1409 1380 002296C 3 end-if AAA5L0RS 002297C 2 else AAA5L0RS 002298C 3 if IRTD > 1 AAA5L0RS 1410 002299C 3 and AP-CF1 = '1' AAA5L0RS 673 002300C 3 and AP-DE (IRTD:1) = '0' AAA5L0RS 636 1410 002301C 4 move '0' to RTD (IRTD:1) AAA5L0RS 1382 1410 002302C 4 if RTD = all '0' AAA5L0RS 1382 002303C 5 move 0 to NRD2 NRD AAA5L0RS 1409 1380 002304C 4 else AAA5L0RS 002305C 5 add 1 to IRTD giving NRD2 NRD AAA5L0RS 1410 1409 1380 002306C 4 end-if AAA5L0RS 002307C 3 end-if AAA5L0RS 002308C 2 end-if AAA5L0RS 002309C 1 end-perform AAA5L0RS 002310C end-if. AAA5L0RS 002311C CALCULER-RTD-AP-FN. AAA5L0RS 002312C exit section. AAA5L0RS 002313C *--- Routines de calcul des Synchros -----------------------------AAA5L0RS 002314C copy AAA5L0SY. AAA5L0RS 002315C copy AAA5L0IN. AAA5L0SY 002316C * AAA5L0IN 002317C ALIMENTER-CLE-AP SECTION. AAA5L0IN 002318C move AP00-COSGDP to AP-IN-COSGDP AAA5L0IN 306 701 002319C >>if AA-A-NS > 1 AAA5L0IN 002342C >>end-if AAA5L0IN 002343C . AAA5L0IN 002344C ALIMENTER-CLE-AP-FN. AAA5L0IN 002345C exit section. AAA5L0IN 002346C * AAA5L0SY 002347C CALCULER-CLE-AP SECTION. AAA5L0SY 002348C if IND1(1:) = high-value AAA5L0SY 1444 IMP 002349C or AP-IN-COSGDP < IND1 AAA5L0SY 701 1444 002350C >>if AA-A-NS > 1 AAA5L0SY 002397C >>end-if AAA5L0SY 002398C 1 move high-value to IND AAA5L0SY IMP 1443 002399C 1 move AP-IN-COSGDP to IND1 AAA5L0SY 701 1444 002400C >>if AA-A-NS > 1 AAA5L0SY 002423C >>end-if AAA5L0SY 002424C end-if. AAA5L0SY 002425C CALCULER-CLE-AP-FN. AAA5L0SY 002426C exit section. AAA5L0SY 002427C * AAA5L0SY 002428C CALCULER-CONF-AP SECTION. AAA5L0SY 002429C move all '0' to AP-CF AAA5L0SY 672 002430C move 0 to AP-NCF AAA5L0SY 670 002431C if AP-IN-COSGDP = IND1 AAA5L0SY 701 1444 002432C 1 move '1' to AP-CF1 AAA5L0SY 673 002433C 1 move 1 to AP-NCF AAA5L0SY 670 002434C >>if AA-A-NS > 1 AAA5L0SY 002481C >>end-if AAA5L0SY 002482C end-if AAA5L0SY 002483C if AP-NCF > MAX-CF AAA5L0SY 670 1496 002484C 1 move AP-NCF to MAX-CF AAA5L0SY 670 1496 002485C end-if. AAA5L0SY 002486C CALCULER-CONF-AP-FN. AAA5L0SY 002487C exit section. AAA5L0SY 002488C >>end-evaluate AAA5LS00 002489C >>evaluate AA-A-ORG AAA5LS00 002490C >>when 'F' *> Fichier Séquentiel AAA5LS00 002492C >>when '2' *> Accès Db2 AAA5LS00 002493C copy AAA5LS20. AAA5LS00 002494C ******************************************************************AAA5LS20 002495C * Accès physiques Lecture Séquentielle (curseur) Db2. AAA5LS20 002496C * Les ordres SQL doivent être codés directement dans le AAA5LS20 002497C * programme : AAA5LS20 002498C * - OUVRIR-
-SQL : ordre OPEN CURSOR AAA5LS20 002499C * - LIRE-
-SQL : ordre FETCH CURSOR AAA5LS20 002500C * - FERMER-
-SQL : ordre CLOSE CURSOR AAA5LS20 002501C ******************************************************************AAA5LS20 002502C * AAA5LS20 002503C OUVRIR-AP-PHYSIQUE SECTION. AAA5LS20 002504C move '1' to IK AAA5LS20 1553 002505C perform OUVRIR-AP-SQL AAA5LS20 2622 002506C move '0' to IK AAA5LS20 1553 002507C set AP-OUVERT to true AAA5LS20 586 002508C >>evaluate true AAA5LS20 002509C >>when AA-A-NR = 0 AAA5LS20 002511C >>when AA-A-NR > 0 AAA5LS20 002512C move '0' to AP-FI AP-FT. AAA5LS20 1522 1505 002513C >>when other AAA5LS20 002515C >>end-evaluate AAA5LS20 002516C OUVRIR-AP-PHYSIQUE-FN. AAA5LS20 002517C exit section. AAA5LS20 002518C * AAA5LS20 002519C LIRE-AP-PHYSIQUE SECTION. AAA5LS20 002520C move '1' to IK AAA5LS20 1553 002521C perform LIRE-AP-SQL AAA5LS20 2633 002522C evaluate true AAA5LS20 002523C when SQLCODE = +100 AAA5LS20 1299 002524C >>evaluate true AAA5LS20 002525C >>when AA-A-NR = 0 AAA5LS20 002527C >>when AA-A-NR > 0 AAA5LS20 002528C 1 move '1' to AP-FI AAA5LS20 1522 002529C >>when other AAA5LS20 002531C >>end-evaluate AAA5LS20 002532C when SQLCODE >= 0 AAA5LS20 1299 002533C 1 set AP-LU to true AAA5LS20 746 002534C 1 move '0' to IK AAA5LS20 1553 002535C end-evaluate. AAA5LS20 002536C LIRE-AP-PHYSIQUE-FN. AAA5LS20 002537C exit section. AAA5LS20 002538C * AAA5LS20 002539C FERMER-AP-PHYSIQUE SECTION. AAA5LS20 002540C perform FERMER-AP-SQL AAA5LS20 2657 002541C set AP-OUVERT to false AAA5LS20 586 002542C >>evaluate true AAA5LS20 002543C >>when AA-A-NR = 0 AAA5LS20 002545C >>when AA-A-NR > 0 AAA5LS20 002546C move '1' to AP-FI. AAA5LS20 1522 002547C >>when other AAA5LS20 002549C >>end-evaluate AAA5LS20 002550C FERMER-AP-PHYSIQUE-FN. AAA5LS20 002551C exit section. AAA5LS20 002552C >>when 'K' *> Fichier VSAM KSDS AAA5LS00 002563C >>end-evaluate AAA5LS00 002564C >>when 'R' *> Lecture directe AAA5L000 002572C >>end-evaluate AAA5L000 002573C >>when 'E' *> Ecriture seule AAAPACCE 002588C >>end-evaluate AAAPACCE ==002589==> IGYPS0040-I Printing of the source code has been suppressed. 002597 cdAP00* 002598 cdAP00*--- Lecture séquentielle Table APP - Ressource AP 002599 cdAP00* 002600 cdAP00 exec sql 002601 cdAP00 DECLARE AP-CURSOR 002602 cdAP00 --^^cursor * compléter les lignes ci-dessous * 002603 CURSOR 002604 FOR 002605 SELECT -- liste des colonnes 002606 OAPPL 002607 , APPDESC 002608 , APPCDOM 002609 , APPCAPP 002610 , APPDCREA 002611 , APPDDELE 002612 , APPUCREA 002613 , APPSYNON 002614 , APPSECTEUR 002615 FROM APP 002616 ORDER BY 002617 APPCDOM 002618 , APPCAPP 002619 cdAP00 end-exec. 002620 cdAP00* 002621 cdAP00*<<< Ne pas accéder directement à ce code, utiliser OUVRIR-AP >>> 002622 cdAP00 OUVRIR-AP-SQL SECTION. 002623 cdAP00*^^sqlavouv * compléter les lignes ci-dessous * 002624 cdAP00 exec sql 002625 cdAP00 OPEN AP-CURSOR 002626 cdAP00 end-exec EXT 002627 cdAP00*^^sqlapouv * compléter les lignes ci-dessous * 002628 cdAP00 continue. 002629 cdAP00 OUVRIR-AP-SQL-FN. 002630 cdAP00 exit section. 002631 cdAP00* 002632 cdAP00*<<< Ne pas accéder directement à ce code, utiliser LIRE-AP >>> 002633 cdAP00 LIRE-AP-SQL SECTION. 002634 cdAP00*^^sqlavlec * compléter les lignes ci-dessous * 002635 cdAP00 exec sql 002636 cdAP00 FETCH 002637 cdAP00 --^^fetch * compléter les lignes ci-dessous * 002638 cdAP00 FROM AP-CURSOR 002639 cdAP00 --^^into * compléter les lignes ci-dessous * 002640 INTO -- liste des hosts-variables 002641 :AP00-COSGA1 :V-AP00-COSGA1 300 322 002642 , :AP00-LNSGAP :V-AP00-LNSGAP 302 323 002643 , :AP00-COSGDP :V-AP00-COSGDP 306 324 002644 , :AP00-LCSGAP :V-AP00-LCSGAP 308 325 002645 , :AP00-DISGCA :V-AP00-DISGCA 310 326 002646 , :AP00-DISGSU :V-AP00-DISGSU 312 327 002647 , :AP00-DISGMJ :V-AP00-DISGMJ 314 328 002648 , :AP00-COSGSN :V-AP00-COSGSN 316 329 002649 , :AP00-COSGSE :V-AP00-COSGSE 318 330 002650 cdAP00 end-exec EXT 002651 cdAP00*^^sqlaplec * compléter les lignes ci-dessous * 002652 cdAP00 continue. 002653 cdAP00 LIRE-AP-SQL-FN. 002654 cdAP00 exit section. 002655 cdAP00* 002656 cdAP00*<<< Ne pas accéder directement à ce code, utiliser FERMER-AP >>> 002657 cdAP00 FERMER-AP-SQL SECTION. 002658 cdAP00*^^sqlavfer * compléter les lignes ci-dessous * 002659 cdAP00 exec sql 002660 cdAP00 CLOSE AP-CURSOR 002661 cdAP00 end-exec EXT 002662 cdAP00*^^sqlapfer * compléter les lignes ci-dessous * 002663 cdAP00 continue. 002664 cdAP00 FERMER-AP-SQL-FN. 002665 cdAP00 exit section. 002666 cdDM00* 002667 cdDM00*--- Gestion Accès DM -------------------------------------------- 002668 cdDM00 >>define AA-A-ACCES as 'L' 002669 cdDM00 >>define AA-A-MODE as 'S' 002670 cdDM00 >>define AA-A-ORG as '2' 002671 cdDM00 >>define AA-A-NR as 0 002672 cdDM00 >>define AA-A-NS as 1 002673 cdDM00*^^accavap * compléter les lignes ci-dessous * 002674 cdDM00 copy AAAPACCE replacing 002675 cdDM00 ==:DD:== by ==DM== 002676 cdDM00 ==:PREF:== by ==DM00== 002677 cdDM00 ==:NS:== by ==1== 002678 cdDM00 ==:K1:== by ==COSGDP== 002679 cdDM00 . ==002680==> IGYPS0040-I Printing of the source code has been suppressed. 002785C >>evaluate AA-A-ACCES AAAPACCE 002786C >>when 'L' *> Lecture seule AAAPACCE 002787C copy AAA5L000. AAAPACCE 002788C >>evaluate AA-A-MODE AAA5L000 002789C >>when 'S' *> Lecture séquentielle AAA5L000 002790C copy AAA5LS00. AAA5L000 002791C >>evaluate true AAA5LS00 002792C >>when AA-A-NR <= 0 and AA-A-NS = 0 *> sans Rupt ni Sync AAA5LS00 002796C >>when AA-A-NR = 0 and AA-A-NS > 0 *> sans Rupt avec Sync AAA5LS00 002797C copy AAA5LSSY. AAA5LS00 002798C ******************************************************************AAA5LSSY 002799C * Accès logiques Lecture Séquentielle sans Rupture avec Synchro AAA5LSSY 002800C ******************************************************************AAA5LSSY 002801C * AAA5LSSY 002802C OUVRIR-DM SECTION. AAA5LSSY 002803C perform OUVRIR-DM-PHYSIQUE. AAA5LSSY 3032 002804C OUVRIR-DM-FN. AAA5LSSY 002805C exit section. AAA5LSSY 002806C * AAA5LSSY 002807C LIRE-DM SECTION. AAA5LSSY 002808C set DM-LU to false AAA5LSSY 983 002809C >>define L_ as b'1' AAA5LSSY 002810C >>evaluate true AAA5LSSY 002811C >>when AA-A-MAXNR <= 0 AAA5LSSY 002817C >>end-evaluate AAA5LSSY 002818C *>>if maxNR > 0 and NS <= maxNR and NR < NS AAA5LSSY 002819C >>if L_ AAA5LSSY 002820C if RTD1 not = '1' or DM-CF1 not = '1' AAA5LSSY 1383 910 002821C >>else AAA5LSSY 002823C >>end-if AAA5LSSY 002824C >>define L_ off AAA5LSSY 002825C 1 exit section AAA5LSSY 002826C end-if AAA5LSSY 002827C perform LIRE-DM-PHYSIQUE AAA5LSSY 3048 002828C if DM-FT = '1' AAA5LSSY 1508 002829C 1 move high-value to DMIND AAA5LSSY IMP 936 002830C 1 exit section AAA5LSSY 002831C end-if AAA5LSSY 002832C perform ALIMENTER-CLE-DM AAA5LSSY 2844 002833C add 1 to 5-DM00-CPTENR. AAA5LSSY 874 002834C LIRE-DM-FN. AAA5LSSY 002835C exit section. AAA5LSSY 002836C * AAA5LSSY 002837C FERMER-DM SECTION. AAA5LSSY 002838C perform FERMER-DM-PHYSIQUE. AAA5LSSY 3068 002839C FERMER-DM-FN. AAA5LSSY 002840C exit section. AAA5LSSY 002841C copy AAA5L0SY. AAA5LSSY 002842C copy AAA5L0IN. AAA5L0SY 002843C * AAA5L0IN 002844C ALIMENTER-CLE-DM SECTION. AAA5L0IN 002845C move DM00-COSGDP to DM-IN-COSGDP AAA5L0IN 367 938 002846C >>if AA-A-NS > 1 AAA5L0IN 002869C >>end-if AAA5L0IN 002870C . AAA5L0IN 002871C ALIMENTER-CLE-DM-FN. AAA5L0IN 002872C exit section. AAA5L0IN 002873C * AAA5L0SY 002874C CALCULER-CLE-DM SECTION. AAA5L0SY 002875C if IND1(1:) = high-value AAA5L0SY 1444 IMP 002876C or DM-IN-COSGDP < IND1 AAA5L0SY 938 1444 002877C >>if AA-A-NS > 1 AAA5L0SY 002924C >>end-if AAA5L0SY 002925C 1 move high-value to IND AAA5L0SY IMP 1443 002926C 1 move DM-IN-COSGDP to IND1 AAA5L0SY 938 1444 002927C >>if AA-A-NS > 1 AAA5L0SY 002950C >>end-if AAA5L0SY 002951C end-if. AAA5L0SY 002952C CALCULER-CLE-DM-FN. AAA5L0SY 002953C exit section. AAA5L0SY 002954C * AAA5L0SY 002955C CALCULER-CONF-DM SECTION. AAA5L0SY 002956C move all '0' to DM-CF AAA5L0SY 909 002957C move 0 to DM-NCF AAA5L0SY 907 002958C if DM-IN-COSGDP = IND1 AAA5L0SY 938 1444 002959C 1 move '1' to DM-CF1 AAA5L0SY 910 002960C 1 move 1 to DM-NCF AAA5L0SY 907 002961C >>if AA-A-NS > 1 AAA5L0SY 003008C >>end-if AAA5L0SY 003009C end-if AAA5L0SY 003010C if DM-NCF > MAX-CF AAA5L0SY 907 1496 003011C 1 move DM-NCF to MAX-CF AAA5L0SY 907 1496 003012C end-if. AAA5L0SY 003013C CALCULER-CONF-DM-FN. AAA5L0SY 003014C exit section. AAA5L0SY 003015C >>when other *> avec Rupt et Sync AAA5LS00 003017C >>end-evaluate AAA5LS00 003018C >>evaluate AA-A-ORG AAA5LS00 003019C >>when 'F' *> Fichier Séquentiel AAA5LS00 003021C >>when '2' *> Accès Db2 AAA5LS00 003022C copy AAA5LS20. AAA5LS00 003023C ******************************************************************AAA5LS20 003024C * Accès physiques Lecture Séquentielle (curseur) Db2. AAA5LS20 003025C * Les ordres SQL doivent être codés directement dans le AAA5LS20 003026C * programme : AAA5LS20 003027C * - OUVRIR-
-SQL : ordre OPEN CURSOR AAA5LS20 003028C * - LIRE-
-SQL : ordre FETCH CURSOR AAA5LS20 003029C * - FERMER-
-SQL : ordre CLOSE CURSOR AAA5LS20 003030C ******************************************************************AAA5LS20 003031C * AAA5LS20 003032C OUVRIR-DM-PHYSIQUE SECTION. AAA5LS20 003033C move '1' to IK AAA5LS20 1553 003034C perform OUVRIR-DM-SQL AAA5LS20 3146 003035C move '0' to IK AAA5LS20 1553 003036C set DM-OUVERT to true AAA5LS20 885 003037C >>evaluate true AAA5LS20 003038C >>when AA-A-NR = 0 AAA5LS20 003039C move '0' to DM-FT. AAA5LS20 1508 003040C >>when AA-A-NR > 0 AAA5LS20 003044C >>end-evaluate AAA5LS20 003045C OUVRIR-DM-PHYSIQUE-FN. AAA5LS20 003046C exit section. AAA5LS20 003047C * AAA5LS20 003048C LIRE-DM-PHYSIQUE SECTION. AAA5LS20 003049C move '1' to IK AAA5LS20 1553 003050C perform LIRE-DM-SQL AAA5LS20 3157 003051C evaluate true AAA5LS20 003052C when SQLCODE = +100 AAA5LS20 1299 003053C >>evaluate true AAA5LS20 003054C >>when AA-A-NR = 0 AAA5LS20 003055C 1 move '1' to DM-FT AAA5LS20 1508 003056C >>when AA-A-NR > 0 AAA5LS20 003060C >>end-evaluate AAA5LS20 003061C when SQLCODE >= 0 AAA5LS20 1299 003062C 1 set DM-LU to true AAA5LS20 983 003063C 1 move '0' to IK AAA5LS20 1553 003064C end-evaluate. AAA5LS20 003065C LIRE-DM-PHYSIQUE-FN. AAA5LS20 003066C exit section. AAA5LS20 003067C * AAA5LS20 003068C FERMER-DM-PHYSIQUE SECTION. AAA5LS20 003069C perform FERMER-DM-SQL AAA5LS20 3177 003070C set DM-OUVERT to false AAA5LS20 885 003071C >>evaluate true AAA5LS20 003072C >>when AA-A-NR = 0 AAA5LS20 003073C move '1' to DM-FT. AAA5LS20 1508 003074C >>when AA-A-NR > 0 AAA5LS20 003078C >>end-evaluate AAA5LS20 003079C FERMER-DM-PHYSIQUE-FN. AAA5LS20 003080C exit section. AAA5LS20 003081C >>when 'K' *> Fichier VSAM KSDS AAA5LS00 003092C >>end-evaluate AAA5LS00 003093C >>when 'R' *> Lecture directe AAA5L000 003101C >>end-evaluate AAA5L000 003102C >>when 'E' *> Ecriture seule AAAPACCE 003117C >>end-evaluate AAAPACCE ==003118==> IGYPS0040-I Printing of the source code has been suppressed. 003126 cdDM00* 003127 cdDM00*--- Lecture séquentielle Table ADM - Ressource DM 003128 cdDM00* 003129 cdDM00 exec sql 003130 cdDM00 DECLARE DM-CURSOR 003131 cdDM00 --^^cursor * compléter les lignes ci-dessous * 003132 CURSOR 003133 FOR 003134 SELECT -- liste des colonnes 003135 ADMNAME 003136 , ADMDESC 003137 , ADMCODE 003138 , ADMCREA 003139 , ADMDELE 003140 FROM ADM 003141 ORDER BY 003142 ADMCODE 003143 cdDM00 end-exec. 003144 cdDM00* 003145 cdDM00*<<< Ne pas accéder directement à ce code, utiliser OUVRIR-DM >>> 003146 cdDM00 OUVRIR-DM-SQL SECTION. 003147 cdDM00*^^sqlavouv * compléter les lignes ci-dessous * 003148 cdDM00 exec sql 003149 cdDM00 OPEN DM-CURSOR 003150 cdDM00 end-exec EXT 003151 cdDM00*^^sqlapouv * compléter les lignes ci-dessous * 003152 cdDM00 continue. 003153 cdDM00 OUVRIR-DM-SQL-FN. 003154 cdDM00 exit section. 003155 cdDM00* 003156 cdDM00*<<< Ne pas accéder directement à ce code, utiliser LIRE-DM >>> 003157 cdDM00 LIRE-DM-SQL SECTION. 003158 cdDM00*^^sqlavlec * compléter les lignes ci-dessous * 003159 cdDM00 exec sql 003160 cdDM00 FETCH 003161 cdDM00 --^^fetch * compléter les lignes ci-dessous * 003162 cdDM00 FROM DM-CURSOR 003163 cdDM00 --^^into * compléter les lignes ci-dessous * 003164 INTO -- liste des hosts-variables 003165 :DM00-COSGDM :V-DM00-COSGDM 363 375 003166 , :DM00-LNSGDM :V-DM00-LNSGDM 365 376 003167 , :DM00-COSGDP :V-DM00-COSGDP 367 377 003168 , :DM00-DISGCA :V-DM00-DISGCA 369 378 003169 , :DM00-DISGSU :V-DM00-DISGSU 371 379 003170 cdDM00 end-exec EXT 003171 cdDM00*^^sqlaplec * compléter les lignes ci-dessous * 003172 cdDM00 continue. 003173 cdDM00 LIRE-DM-SQL-FN. 003174 cdDM00 exit section. 003175 cdDM00* 003176 cdDM00*<<< Ne pas accéder directement à ce code, utiliser FERMER-DM >>> 003177 cdDM00 FERMER-DM-SQL SECTION. 003178 cdDM00*^^sqlavfer * compléter les lignes ci-dessous * 003179 cdDM00 exec sql 003180 cdDM00 CLOSE DM-CURSOR 003181 cdDM00 end-exec EXT 003182 cdDM00*^^sqlapfer * compléter les lignes ci-dessous * 003183 cdDM00 continue. 003184 cdDM00 FERMER-DM-SQL-FN. 003185 cdDM00 exit section. 003186 cdS100* 003187 cdS100*--- Gestion Accès S1 -------------------------------------------- 003188 cdS100 >>define AA-A-ACCES as 'E' 003189 cdS100 >>define AA-A-MODE as 'S' 003190 cdS100 >>define AA-A-ORG as 'F' 003191 cdS100 >>define AA-A-NR as 0 003192 cdS100 >>define AA-A-NS as 0 003193 cdS100*^^accavap * compléter les lignes ci-dessous * 003194 cdS100 copy AAAPACCE replacing 003195 cdS100 ==:DD:== by ==S1== 003196 cdS100 ==:PREF:== by ==S100== 003197 cdS100 ==:NS:== by ==0== 003198 cdS100 . ==003199==> IGYPS0040-I Printing of the source code has been suppressed. 003304C >>evaluate AA-A-ACCES AAAPACCE 003305C >>when 'L' *> Lecture seule AAAPACCE 003307C >>when 'E' *> Ecriture seule AAAPACCE 003308C copy AAA5E000. AAAPACCE 003309C >>evaluate AA-A-MODE AAA5E000 003310C >>when 'S' *> Ecriture séquentielle AAA5E000 003311C copy AAA5ES00. AAA5E000 003312C copy AAA5ESNN. AAA5ES00 003313C ******************************************************************AAA5ESNN 003314C * Accès logiques Ecriture Séquentielle AAA5ESNN 003315C ******************************************************************AAA5ESNN 003316C * AAA5ESNN 003317C OUVRIR-S1 SECTION. AAA5ESNN 003318C perform OUVRIR-S1-PHYSIQUE. AAA5ESNN 3358 003319C OUVRIR-S1-FN. AAA5ESNN 003320C exit section. AAA5ESNN 003321C * AAA5ESNN 003322C ECRIRE-S1 SECTION. AAA5ESNN 003323C perform ECRIRE-S1-PHYSIQUE. AAA5ESNN 3363 003324C ECRIRE-S1-FN. AAA5ESNN 003325C exit section. AAA5ESNN 003326C * AAA5ESNN 003327C FERMER-S1 SECTION. AAA5ESNN 003328C perform FERMER-S1-PHYSIQUE. AAA5ESNN 3369 003329C FERMER-S1-FN. AAA5ESNN 003330C exit section. AAA5ESNN 003331C >>evaluate AA-A-ORG AAA5ES00 003332C >>when 'F' *> Fichier Séquentiel AAA5ES00 003333C copy AAA5ESF0. AAA5ES00 ==003334==> IGYPS0040-I Printing of the source code has been suppressed. 003354C ******************************************************************AAA5ESF0 003355C * Accès physiques Ecriture Séquentielle Fichier Séquentiel AAA5ESF0 003356C ******************************************************************AAA5ESF0 003357C * AAA5ESF0 003358C OUVRIR-S1-PHYSIQUE SECTION. AAA5ESF0 003359C open output S1-FICHIER. AAA5ESF0 126 003360C OUVRIR-S1-PHYSIQUE-FN. AAA5ESF0 003361C exit section. AAA5ESF0 003362C * AAA5ESF0 003363C ECRIRE-S1-PHYSIQUE SECTION. AAA5ESF0 003364C write S100 AAA5ESF0 141 003365C add 1 to 5-S100-CPTENR. AAA5ESF0 1107 003366C ECRIRE-S1-PHYSIQUE-FN. AAA5ESF0 003367C exit section. AAA5ESF0 003368C * AAA5ESF0 003369C FERMER-S1-PHYSIQUE SECTION. AAA5ESF0 003370C close S1-FICHIER. AAA5ESF0 126 003371C FERMER-S1-PHYSIQUE-FN. AAA5ESF0 003372C exit section. AAA5ESF0 003373C >>when '2' *> Accès Db2 AAA5ES00 003386C >>end-evaluate AAA5ES00 003387C >>when 'R' *> Ecriture directe AAA5E000 003395C >>end-evaluate AAA5E000 003396C >>when 'M' *> Création Modification Suppression AAAPACCE 003409C >>end-evaluate AAAPACCE ==003410==> IGYPS0040-I Printing of the source code has been suppressed. 003418 cdS200* 003419 cdS200*--- Gestion Accès S2 -------------------------------------------- 003420 cdS200 >>define AA-A-ACCES as 'E' 003421 cdS200 >>define AA-A-MODE as 'S' 003422 cdS200 >>define AA-A-ORG as 'F' 003423 cdS200 >>define AA-A-NR as 0 003424 cdS200 >>define AA-A-NS as 0 003425 cdS200*^^accavap * compléter les lignes ci-dessous * 003426 cdS200 copy AAAPACCE replacing 003427 cdS200 ==:DD:== by ==S2== 003428 cdS200 ==:PREF:== by ==S200== 003429 cdS200 ==:NS:== by ==0== 003430 cdS200 . ==003431==> IGYPS0040-I Printing of the source code has been suppressed. 003536C >>evaluate AA-A-ACCES AAAPACCE 003537C >>when 'L' *> Lecture seule AAAPACCE 003539C >>when 'E' *> Ecriture seule AAAPACCE 003540C copy AAA5E000. AAAPACCE 003541C >>evaluate AA-A-MODE AAA5E000 003542C >>when 'S' *> Ecriture séquentielle AAA5E000 003543C copy AAA5ES00. AAA5E000 003544C copy AAA5ESNN. AAA5ES00 003545C ******************************************************************AAA5ESNN 003546C * Accès logiques Ecriture Séquentielle AAA5ESNN 003547C ******************************************************************AAA5ESNN 003548C * AAA5ESNN 003549C OUVRIR-S2 SECTION. AAA5ESNN 003550C perform OUVRIR-S2-PHYSIQUE. AAA5ESNN 3590 003551C OUVRIR-S2-FN. AAA5ESNN 003552C exit section. AAA5ESNN 003553C * AAA5ESNN 003554C ECRIRE-S2 SECTION. AAA5ESNN 003555C perform ECRIRE-S2-PHYSIQUE. AAA5ESNN 3595 003556C ECRIRE-S2-FN. AAA5ESNN 003557C exit section. AAA5ESNN 003558C * AAA5ESNN 003559C FERMER-S2 SECTION. AAA5ESNN 003560C perform FERMER-S2-PHYSIQUE. AAA5ESNN 3601 003561C FERMER-S2-FN. AAA5ESNN 003562C exit section. AAA5ESNN 003563C >>evaluate AA-A-ORG AAA5ES00 003564C >>when 'F' *> Fichier Séquentiel AAA5ES00 003565C copy AAA5ESF0. AAA5ES00 ==003566==> IGYPS0040-I Printing of the source code has been suppressed. 003586C ******************************************************************AAA5ESF0 003587C * Accès physiques Ecriture Séquentielle Fichier Séquentiel AAA5ESF0 003588C ******************************************************************AAA5ESF0 003589C * AAA5ESF0 003590C OUVRIR-S2-PHYSIQUE SECTION. AAA5ESF0 003591C open output S2-FICHIER. AAA5ESF0 150 003592C OUVRIR-S2-PHYSIQUE-FN. AAA5ESF0 003593C exit section. AAA5ESF0 003594C * AAA5ESF0 003595C ECRIRE-S2-PHYSIQUE SECTION. AAA5ESF0 003596C write S200 AAA5ESF0 165 003597C add 1 to 5-S200-CPTENR. AAA5ESF0 1248 003598C ECRIRE-S2-PHYSIQUE-FN. AAA5ESF0 003599C exit section. AAA5ESF0 003600C * AAA5ESF0 003601C FERMER-S2-PHYSIQUE SECTION. AAA5ESF0 003602C close S2-FICHIER. AAA5ESF0 150 003603C FERMER-S2-PHYSIQUE-FN. AAA5ESF0 003604C exit section. AAA5ESF0 003605C >>when '2' *> Accès Db2 AAA5ES00 003618C >>end-evaluate AAA5ES00 003619C >>when 'R' *> Ecriture directe AAA5E000 003627C >>end-evaluate AAA5E000 003628C >>when 'M' *> Création Modification Suppression AAAPACCE 003641C >>end-evaluate AAAPACCE ==003642==> IGYPS0040-I Printing of the source code has been suppressed. 003650 sqpaf *> *> zone injection fin <* <* 003651 sqpaf *--- Fin accès ressources ---------------------------------------- 003652 sqpaq ACCESS-RESSOURCES-FN. 003653 sqpaq exit section. 003654 sqpaq 003655 sqpv /================================================================= 003656 sqpv * SSSS EEEEE RRRR V V IIIII CCC EEEEE SSSS 003657 sqpv * S E R R V V I C C E S 003658 sqpv * SSS EEEE RRRR V V I C EEEE SSS 003659 sqpv * S E R R V V I C C E S 003660 sqpv * SSSS EEEEE R R V IIIII CCC EEEEE SSSS 003661 sqpv *================================================================= 003662 sqpv SERVICES-FRAMEWORK SECTION. 003663 sqpv continue. 003664 sqpv *--- Gestion des opérations sur dates et heures ------------------ 003665 sqpv copy ADAPDATE. ==003666==> IGYPS0040-I Printing of the source code has been suppressed. 003703C * ADAPDATE 003704C * TRANSFORMATION DATE FORMAT C : JJMMSSAA ADAPDATE 003705C CONVERTIR-DE-DATE-C SECTION. ADAPDATE 003706C move DD of 5-DATE-C to DD of 5-DATE-S ADAPDATE 1648 1647 1696 1689 003707C move MM of 5-DATE-C to MM of 5-DATE-S ADAPDATE 1649 1647 1695 1689 003708C move YYYY of 5-DATE-C to YYYY of 5-DATE-S. ADAPDATE 1650 1647 1690 1689 003709C CONVERTIR-DE-DATE-C-FN. ADAPDATE 003710C exit section. ADAPDATE 003711C CONVERTIR-VERS-DATE-C SECTION. ADAPDATE 003712C move DD of 5-DATE-S to DD of 5-DATE-C ADAPDATE 1696 1689 1648 1647 003713C move MM of 5-DATE-S to MM of 5-DATE-C ADAPDATE 1695 1689 1649 1647 003714C move YYYY of 5-DATE-S to YYYY of 5-DATE-C. ADAPDATE 1690 1689 1650 1647 003715C CONVERTIR-VERS-DATE-C-FN. ADAPDATE 003716C exit section. ADAPDATE 003717C * ADAPDATE 003718C * TRANSFORMATION DATE FORMAT D : JJMMAA ADAPDATE 003719C CONVERTIR-DE-DATE-D SECTION. ADAPDATE 003720C move DD of 5-DATE-D to DD of 5-DATE-S ADAPDATE 1655 1654 1696 1689 003721C move MM of 5-DATE-D to MM of 5-DATE-S ADAPDATE 1656 1654 1695 1689 003722C move YY of 5-DATE-D to YY of 5-DATE-S ADAPDATE 1657 1654 1693 1689 003723C perform DEFINIR-SIECLE. ADAPDATE 3808 003724C CONVERTIR-DE-DATE-D-FN. ADAPDATE 003725C exit section. ADAPDATE 003726C CONVERTIR-VERS-DATE-D SECTION. ADAPDATE 003727C move DD of 5-DATE-S to DD of 5-DATE-D ADAPDATE 1696 1689 1655 1654 003728C move MM of 5-DATE-S to MM of 5-DATE-D ADAPDATE 1695 1689 1656 1654 003729C move YY of 5-DATE-S to YY of 5-DATE-D. ADAPDATE 1693 1689 1657 1654 003730C CONVERTIR-VERS-DATE-D-FN. ADAPDATE 003731C exit section. ADAPDATE 003732C * ADAPDATE 003733C * TRANSFORMATION DATE FORMAT E : JJ/MM/AA ADAPDATE 003734C CONVERTIR-DE-DATE-E SECTION. ADAPDATE 003735C move DD of 5-DATE-E to DD of 5-DATE-S ADAPDATE 1660 1659 1696 1689 003736C move MM of 5-DATE-E to MM of 5-DATE-S ADAPDATE 1662 1659 1695 1689 003737C move YY of 5-DATE-E to YY of 5-DATE-S ADAPDATE 1664 1659 1693 1689 003738C perform DEFINIR-SIECLE. ADAPDATE 3808 003739C CONVERTIR-DE-DATE-E-FN. ADAPDATE 003740C exit section. ADAPDATE 003741C CONVERTIR-VERS-DATE-E SECTION. ADAPDATE 003742C move DD of 5-DATE-S to DD of 5-DATE-E ADAPDATE 1696 1689 1660 1659 003743C move MM of 5-DATE-S to MM of 5-DATE-E ADAPDATE 1695 1689 1662 1659 003744C move YY of 5-DATE-S to YY of 5-DATE-E ADAPDATE 1693 1689 1664 1659 003745C move DATSEP to S1 of 5-DATE-E ADAPDATE 1634 1661 1659 003746C S2 of 5-DATE-E. ADAPDATE 1663 1659 003747C CONVERTIR-VERS-DATE-E-FN. ADAPDATE 003748C exit section. ADAPDATE 003749C * ADAPDATE 003750C * TRANSFORMATION DATE FORMAT G : SSAA-MM-JJ ADAPDATE 003751C CONVERTIR-DE-DATE-G SECTION. ADAPDATE 003752C move DD of 5-DATE-G to DD of 5-DATE-S ADAPDATE 1673 1666 1696 1689 003753C move MM of 5-DATE-G to MM of 5-DATE-S ADAPDATE 1671 1666 1695 1689 003754C move YYYY of 5-DATE-G to YYYY of 5-DATE-S. ADAPDATE 1667 1666 1690 1689 003755C CONVERTIR-DE-DATE-G-FN. ADAPDATE 003756C exit section. ADAPDATE 003757C CONVERTIR-VERS-DATE-G SECTION. ADAPDATE 003758C move DD of 5-DATE-S to DD of 5-DATE-G ADAPDATE 1696 1689 1673 1666 003759C move MM of 5-DATE-S to MM of 5-DATE-G ADAPDATE 1695 1689 1671 1666 003760C move YYYY of 5-DATE-S to YYYY of 5-DATE-G ADAPDATE 1690 1689 1667 1666 003761C move DATSET to S1 of 5-DATE-G ADAPDATE 1636 1670 1666 003762C S2 of 5-DATE-G. ADAPDATE 1672 1666 003763C CONVERTIR-VERS-DATE-G-FN. ADAPDATE 003764C exit section. ADAPDATE 003765C * ADAPDATE 003766C * TRANSFORMATION DATE FORMAT I : AAMMJJ ADAPDATE 003767C CONVERTIR-DE-DATE-I SECTION. ADAPDATE 003768C move DD of 5-DATE-I to DD of 5-DATE-S ADAPDATE 1678 1675 1696 1689 003769C move MM of 5-DATE-I to MM of 5-DATE-S ADAPDATE 1677 1675 1695 1689 003770C move YY of 5-DATE-I to YY of 5-DATE-S ADAPDATE 1676 1675 1693 1689 003771C perform DEFINIR-SIECLE. ADAPDATE 3808 003772C CONVERTIR-DE-DATE-I-FN. ADAPDATE 003773C exit section. ADAPDATE 003774C CONVERTIR-VERS-DATE-I SECTION. ADAPDATE 003775C move DD of 5-DATE-S to DD of 5-DATE-I ADAPDATE 1696 1689 1678 1675 003776C move MM of 5-DATE-S to MM of 5-DATE-I ADAPDATE 1695 1689 1677 1675 003777C move YY of 5-DATE-S to YY of 5-DATE-I. ADAPDATE 1693 1689 1676 1675 003778C CONVERTIR-VERS-DATE-I-FN. ADAPDATE 003779C exit section. ADAPDATE 003780C * ADAPDATE 003781C * TRANSFORMATION DATE FORMAT M : JJ/MM/SSAA ADAPDATE 003782C CONVERTIR-DE-DATE-M SECTION. ADAPDATE 003783C move DD of 5-DATE-M to DD of 5-DATE-S ADAPDATE 1681 1680 1696 1689 003784C move MM of 5-DATE-M to MM of 5-DATE-S ADAPDATE 1683 1680 1695 1689 003785C move YYYY of 5-DATE-M to YYYY of 5-DATE-S. ADAPDATE 1685 1680 1690 1689 003786C CONVERTIR-DE-DATE-M-FN. ADAPDATE 003787C exit section. ADAPDATE 003788C CONVERTIR-VERS-DATE-M SECTION. ADAPDATE 003789C move DD of 5-DATE-S to DD of 5-DATE-M ADAPDATE 1696 1689 1681 1680 003790C move MM of 5-DATE-S to MM of 5-DATE-M ADAPDATE 1695 1689 1683 1680 003791C move YYYY of 5-DATE-S to YYYY of 5-DATE-M ADAPDATE 1690 1689 1685 1680 003792C move DATSEP to S1 of 5-DATE-M ADAPDATE 1634 1682 1680 003793C S2 of 5-DATE-M. ADAPDATE 1684 1680 003794C CONVERTIR-VERS-DATE-M-FN. ADAPDATE 003795C exit section. ADAPDATE 003796C * ADAPDATE 003797C * TRANSFORMATION DATE FORMAT S : SSAAMMJJ ADAPDATE 003798C CONVERTIR-DE-DATE-S SECTION. ADAPDATE 003799C continue. ADAPDATE 003800C CONVERTIR-DE-DATE-S-FN. ADAPDATE 003801C exit section. ADAPDATE 003802C CONVERTIR-VERS-DATE-S SECTION. ADAPDATE 003803C continue. ADAPDATE 003804C CONVERTIR-VERS-DATE-S-FN. ADAPDATE 003805C exit section. ADAPDATE 003806C * ADAPDATE 003807C * ALIMENTATION DU SIECLE SUR DATE SANS SIECLE ADAPDATE 003808C DEFINIR-SIECLE SECTION. ADAPDATE 003809C evaluate true also true ADAPDATE 003810C when not 5-DATE-1900-AVANT and not 5-DATE-2000-AVANT ADAPDATE 1708 1709 003811C also any ADAPDATE 003812C 1 move 5-DATE-SIECLE to CC of 5-DATE-S ADAPDATE 1705 1691 1689 003813C when 5-DATE-1900-AVANT also YY in 5-DATE-S < 5-DATE-PIVOT ADAPDATE 1708 1693 1689 1704 003814C when 5-DATE-2000-AVANT also YY in 5-DATE-S >= 5-DATE-PIVOT ADAPDATE 1709 1693 1689 1704 003815C 1 move '19' to CC of 5-DATE-S ADAPDATE 1691 1689 003816C when other ADAPDATE 003817C 1 move '20' to CC of 5-DATE-S ADAPDATE 1691 1689 003818C end-evaluate. ADAPDATE 003819C DEFINIR-SIECLE-FN. ADAPDATE 003820C exit section. ADAPDATE 003821C * ADAPDATE 003822C * VALIDATION D'UNE DATE ADAPDATE 003823C VALIDER-DATE SECTION. ADAPDATE 003824C * par défaut, date invalide ADAPDATE 003825C set 5-DATE-INVALIDE to true ADAPDATE 1562 003826C evaluate true ADAPDATE 003827C * conditions invalidité de la date ADAPDATE 003828C when 5-DATE-S not numeric ADAPDATE 1689 003829C when MM in 5-DATE-S < '00' or > '12' ADAPDATE 1695 1689 003830C when DD in 5-DATE-S < '00' or > '31' ADAPDATE 1696 1689 003831C when DD in 5-DATE-S > '30' and (MM in 5-DATE-S = '04' ADAPDATE 1696 1689 1695 1689 003832C or '06' ADAPDATE 003833C or '09' ADAPDATE 003834C or '11') ADAPDATE 003835C when DD in 5-DATE-S > '29' and MM in 5-DATE-S = '02' ADAPDATE 1696 1689 1695 1689 003836C 1 exit section ADAPDATE 003837C * calcul année bissextile sur 29/02 ADAPDATE 003838C when MM in 5-DATE-S = '02' and DD in 5-DATE-S = '29' ADAPDATE 1695 1689 1696 1689 003839C * siecle mutiple de 400 bissextile ADAPDATE 003840C 1 if YY in 5-DATE-S = '00' ADAPDATE 1693 1689 003841C 2 compute 5-DATE-M4 = CC9 in 5-DATE-S / 4 ADAPDATE 1717 1692 1689 ==003841==> IGYPA3084-W **RULES(NOLAXPERF)** The sending operand "CC9 (NUMERIC INTEGER)" in an arithmetic expression was an inefficient type. "BINARY" or "PACKED-DECIMAL" would give better run-time performance. 003842C 2 compute 5-DATE-M4 = CC9 in 5-DATE-S - 5-DATE-M4 * 4 ADAPDATE 1717 1692 1689 1717 ==003842==> IGYPA3084-W **RULES(NOLAXPERF)** The sending operand "CC9 (NUMERIC INTEGER)" in an arithmetic expression was an inefficient type. "BINARY" or "PACKED-DECIMAL" would give better run-time performance. 003843C * année multiple de 4 bissextile ADAPDATE 003844C 1 else ADAPDATE 003845C 2 compute 5-DATE-M4 = YY9 in 5-DATE-S / 4 ADAPDATE 1717 1694 1689 ==003845==> IGYPA3084-W **RULES(NOLAXPERF)** The sending operand "YY9 (NUMERIC INTEGER)" in an arithmetic expression was an inefficient type. "BINARY" or "PACKED-DECIMAL" would give better run-time performance. 003846C 2 compute 5-DATE-M4 = YY9 in 5-DATE-S - 5-DATE-M4 * 4 ADAPDATE 1717 1694 1689 1717 ==003846==> IGYPA3084-W **RULES(NOLAXPERF)** The sending operand "YY9 (NUMERIC INTEGER)" in an arithmetic expression was an inefficient type. "BINARY" or "PACKED-DECIMAL" would give better run-time performance. 003847C 1 end-if ADAPDATE 003848C 1 if 5-DATE-M4 not = 0 ADAPDATE 1717 003849C 2 exit section ADAPDATE 003850C 1 end-if ADAPDATE 003851C end-evaluate ADAPDATE 003852C * si aucune anomalie alors date valide ADAPDATE 003853C set 5-DATE-VALIDE to true. ADAPDATE 1561 003854C VALIDER-DATE-FN. ADAPDATE 003855C exit section. ADAPDATE 003856C * ADAPDATE 003857C * DATE FORMAT I VERS D (ADI : AAMMJJ --> JJMMAA) ADAPDATE 003858C INVERSER-DATE-I SECTION. ADAPDATE 003859C move DD of 5-DATE-I to DD of 5-DATE-D ADAPDATE 1678 1675 1655 1654 003860C move MM of 5-DATE-I to MM of 5-DATE-D ADAPDATE 1677 1675 1656 1654 003861C move YY of 5-DATE-I to YY of 5-DATE-D. ADAPDATE 1676 1675 1657 1654 003862C INVERSER-DATE-I-FN. ADAPDATE 003863C exit section. ADAPDATE 003864C * ADAPDATE 003865C * DATE FORMAT D VERS I (sans équivalent : JJMMAA --> AAMMJJ) ADAPDATE 003866C INVERSER-DATE-D SECTION. ADAPDATE 003867C move DD of 5-DATE-D to DD of 5-DATE-I ADAPDATE 1655 1654 1678 1675 003868C move MM of 5-DATE-D to MM of 5-DATE-I ADAPDATE 1656 1654 1677 1675 003869C move YY of 5-DATE-D to YY of 5-DATE-I. ADAPDATE 1657 1654 1676 1675 003870C INVERSER-DATE-D-FN. ADAPDATE 003871C exit section. ADAPDATE 003872C * ADAPDATE 003873C * DATE FORMAT C VERS S (sans équivalent : JJMMSSAA --> SSAAMMJJ) ADAPDATE 003874C INVERSER-DATE-C SECTION. ADAPDATE 003875C move DD of 5-DATE-C to DD of 5-DATE-S ADAPDATE 1648 1647 1696 1689 003876C move MM of 5-DATE-C to MM of 5-DATE-S ADAPDATE 1649 1647 1695 1689 003877C move YYYY of 5-DATE-C to YYYY of 5-DATE-S. ADAPDATE 1650 1647 1690 1689 003878C INVERSER-DATE-C-FN. ADAPDATE 003879C exit section. ADAPDATE 003880C * ADAPDATE 003881C * DATE FORMAT S VERS C (ADS : SSAAMMJJ --> JJMMSSAA) ADAPDATE 003882C INVERSER-DATE-S SECTION. ADAPDATE 003883C move DD of 5-DATE-S to DD of 5-DATE-C ADAPDATE 1696 1689 1648 1647 003884C move MM of 5-DATE-S to MM of 5-DATE-C ADAPDATE 1695 1689 1649 1647 003885C move YYYY of 5-DATE-S to YYYY of 5-DATE-C. ADAPDATE 1690 1689 1650 1647 003886C INVERSER-DATE-S-FN. ADAPDATE 003887C exit section. ADAPDATE 003888C * ADAPDATE 003889C * DATE FORMAT D VERS E (ADE : JJMMAA --> JJ/MM/AA) ADAPDATE 003890C EDITER-DATE-D SECTION. ADAPDATE 003891C move DD of 5-DATE-D to DD of 5-DATE-E ADAPDATE 1655 1654 1660 1659 003892C move MM of 5-DATE-D to MM of 5-DATE-E ADAPDATE 1656 1654 1662 1659 003893C move YY of 5-DATE-D to YY of 5-DATE-E ADAPDATE 1657 1654 1664 1659 003894C move DATSEP to S1 of 5-DATE-E ADAPDATE 1634 1661 1659 003895C S2 of 5-DATE-E. ADAPDATE 1663 1659 003896C EDITER-DATE-D-FN. ADAPDATE 003897C exit section. ADAPDATE 003898C * ADAPDATE 003899C * DATE FORMAT I VERS E (ADF : AAMMJJ --> JJ/MM/AA) ADAPDATE 003900C EDITER-DATE-I SECTION. ADAPDATE 003901C move DD of 5-DATE-I to DD of 5-DATE-E ADAPDATE 1678 1675 1660 1659 003902C move MM of 5-DATE-I to MM of 5-DATE-E ADAPDATE 1677 1675 1662 1659 003903C move YY of 5-DATE-I to YY of 5-DATE-E ADAPDATE 1676 1675 1664 1659 003904C move DATSEP to S1 of 5-DATE-E ADAPDATE 1634 1661 1659 003905C S2 of 5-DATE-E. ADAPDATE 1663 1659 003906C EDITER-DATE-I-FN. ADAPDATE 003907C exit section. ADAPDATE 003908C * ADAPDATE 003909C * DATE FORMAT C VERS M (ADM : JJMMSSAA --> JJ/MM/SSAA) ADAPDATE 003910C EDITER-DATE-C SECTION. ADAPDATE 003911C move DD of 5-DATE-C to DD of 5-DATE-M ADAPDATE 1648 1647 1681 1680 003912C move MM of 5-DATE-C to MM of 5-DATE-M ADAPDATE 1649 1647 1683 1680 003913C move YYYY of 5-DATE-C to YYYY of 5-DATE-M ADAPDATE 1650 1647 1685 1680 003914C move DATSEP to S1 of 5-DATE-M ADAPDATE 1634 1682 1680 003915C S2 of 5-DATE-M. ADAPDATE 1684 1680 003916C EDITER-DATE-C-FN. ADAPDATE 003917C exit section. ADAPDATE 003918C * ADAPDATE 003919C * DATE FORMAT S VERS M (sans équivalent : SSAAMMJJ --> JJ/MM/SSAA)ADAPDATE 003920C EDITER-DATE-S SECTION. ADAPDATE 003921C move DD of 5-DATE-S to DD of 5-DATE-M ADAPDATE 1696 1689 1681 1680 003922C move MM of 5-DATE-S to MM of 5-DATE-M ADAPDATE 1695 1689 1683 1680 003923C move YYYY of 5-DATE-S to YYYY of 5-DATE-M ADAPDATE 1690 1689 1685 1680 003924C move DATSEP to S1 of 5-DATE-M ADAPDATE 1634 1682 1680 003925C S2 of 5-DATE-M. ADAPDATE 1684 1680 003926C EDITER-DATE-S-FN. ADAPDATE 003927C exit section. ADAPDATE 003928C * ADAPDATE 003929C * HEURE FORMAT EDITION (TIF : HHMMSS --> HH:MM:SS) ADAPDATE 003930C EDITER-HEURE SECTION. ADAPDATE 003931C move HH in 5-TIME to HH in TIMDAY ADAPDATE 1699 1698 1624 1622 003932C move MM in 5-TIME to MM in TIMDAY ADAPDATE 1700 1698 1628 1622 003933C move SS in 5-TIME to SS in TIMDAY ADAPDATE 1701 1698 1632 1622 003934C move TIMSEP to S1 in TIMDAY ADAPDATE 1640 1626 1622 003935C S2 in TIMDAY. ADAPDATE 1630 1622 003936C EDITER-HEURE-FN. ADAPDATE 003937C exit section. ADAPDATE 003938C * ADAPDATE 003939C * NOMBRE DE JOURS ENTRE DEUX DATES FORMAT S SSAAMMJJ ADAPDATE 003940C SOUSTRAIRE-DATE SECTION. ADAPDATE 003941C compute NUM-DAYS = function integer-of-date (5-DATE-D1) ADAPDATE 1642 IFN 1711 003942C - function integer-of-date (5-DATE-D2). ADAPDATE IFN 1712 003943C SOUSTRAIRE-DATE-FN. ADAPDATE 003944C exit section. ADAPDATE 003945C * ADAPDATE 003946C * DATE FORMAT S +/- N JOURS (DAO S NUM-DAYS 5-DATE-S) ADAPDATE 003947C DECALER-DATE SECTION. ADAPDATE 003948C compute 5-DATE-D1 = ADAPDATE 1711 ==003948==> IGYPA3084-W **RULES(NOLAXPERF)** The sending operand "NUM-DAYS (NUMERIC INTEGER)" in an arithmetic expression was an inefficient type. "BINARY" or "PACKED-DECIMAL" would give better run-time performance. 003949C function date-of-integer ( ADAPDATE IFN 003950C function integer-of-date (5-DATE-D1) + NUM-DAYS). ADAPDATE IFN 1711 1642 003951C DECALER-DATE-FN. ADAPDATE 003952C exit section. ADAPDATE 003953C >>if AA-G-PACBASE ADAPDATE 003955C >>end-if ADAPDATE 003956 sqpvd *> *> zone injection debut <* <* 003957 sqpvf *> *> zone injection fin <* <* 003958 sqpvq *--- Fin services framework -------------------------------------- 003959 sqpvq SERVICES-FRAMEWORK-FN. 003960 sqpvq exit section. 003961 sqpvq 003962 sqpi /================================================================= 003963 sqpi * IIIII N N IIIII TTTTT IIIII AAA L IIIII SSS 003964 sqpi * I NN N I T I A A L I S 003965 sqpi * I N N N I T I AAAAA L I SSS 003966 sqpi * I N NN I T I A A L I S 003967 sqpi * IIIII N N IIIII T IIIII A A LLLLL IIIII SSS 003968 sqpi *================================================================= 003969 sqpi INITIALISATIONS SECTION. 003970 sqpi *--- Trace reco audit -------------------------------------------- 003971 sqpi copy AGAPAUD1. ==003972==> IGYPS0040-I Printing of the source code has been suppressed. 003985C *-----------------------------------------------------------------AGAPAUD1 003986C * Tracabilité programme - Reco "Audit Archivage 2010" #5 - Début AGAPAUD1 003987C if RECO-ARCH-2010-5-notRUN AGAPAUD1 1766 003988C 1 set RECO-ARCH-2010-5-notRUN to false AGAPAUD1 1766 003989C *--- Préparation de la date du jour dans différents formats ------AGAPAUD1 003990C * DATCE : SSAAMMJJ AGAPAUD1 003991C 1 move function current-date to DATCE AGAPAUD1 IFN 1593 003992C * W-BA0C-DASDSY : JJMMSSAA AGAPAUD1 003993C 1 move DATCE (7:2) to W-BA0C-DASDSY (1:2) AGAPAUD1 1593 1759 003994C 1 move DATCE (5:2) to W-BA0C-DASDSY (3:2) AGAPAUD1 1593 1759 003995C 1 move DATCE (1:4) to W-BA0C-DASDSY (5:4) AGAPAUD1 1593 1759 003996C * W-BA0G-DASDSY : SSAA-MM-JJ AGAPAUD1 003997C 1 move DATCE (1:4) to W-BA0G-DASDSY (1:4) AGAPAUD1 1593 1761 003998C 1 move DATCE (5:2) to W-BA0G-DASDSY (6:2) AGAPAUD1 1593 1761 003999C 1 move DATCE (7:2) to W-BA0G-DASDSY (9:2) AGAPAUD1 1593 1761 004000C 1 move '-' to W-BA0G-DASDSY (5:1) AGAPAUD1 1761 004001C 1 W-BA0G-DASDSY (8:1) AGAPAUD1 1761 004002C * W-BA0M-DASDSY : JJ/MM/SSAA AGAPAUD1 004003C 1 move DATCE (7:2) to W-BA0M-DASDSY (1:2) AGAPAUD1 1593 1763 004004C 1 move DATCE (5:2) to W-BA0M-DASDSY (4:2) AGAPAUD1 1593 1763 004005C 1 move DATCE (1:4) to W-BA0M-DASDSY (7:4) AGAPAUD1 1593 1763 004006C 1 move '/' to W-BA0M-DASDSY (3:1) AGAPAUD1 1763 004007C 1 W-BA0M-DASDSY (6:1) AGAPAUD1 1763 004008C >>if AA-G-MIXED AGAPAUD1 004011C >>end-if AGAPAUD1 004012C *--- Message dans la log MVS -------------------------------------AGAPAUD1 004013C 1 display 'GCE001I IDENTITE PROGRAMME ' PROGE AGAPAUD1 239 004014C 1 ' (' PROGR ' ' COBASE ' ' APPLI ' ' NUGNA ' ' AGAPAUD1 236 240 234 233 004015C 1 DATGNC ' ' TIMGN ')' upon CONSOLE AGAPAUD1 241 238 004016C *--- Message début de programme en SYSOUT ------------------------AGAPAUD1 004017C 1 display PROGE ' - DEBUT PROGRAMME (' PROGR ' ' COBASE ' ' AGAPAUD1 239 236 240 004018C 1 APPLI ' ' NUGNA ' ' DATGNC ' ' TIMGN '), LE ' AGAPAUD1 234 233 241 238 004019C 1 W-BA0M-DASDSY AGAPAUD1 1763 004020C >>if AA-G-MIXED AGAPAUD1 004022C >>end-if AGAPAUD1 004023C end-if AGAPAUD1 004024 sqpid *> *> zone injection debut <* <* 004025 sqpif *> *> zone injection fin <* <* 004026 sqpiq *--- Fin initialisations ----------------------------------------- 004027 sqpiq continue. 004028 sqpiq INITIALISATIONS-FN. 004029 sqpiq exit section. 004030 sqpiw * 004031 sqpiw INITIALISATIONS-WORKING SECTION. 004032 sqpiw set WORKING-INITIALISEES to true 1815 004033 sqpiwd*> *> zone injection debut <* <* 004034 sqpiwf*> *> zone injection fin <* <* 004035 sqpiw9*--- Fin initialisations ----------------------------------------- 004036 sqpiw9 continue. 004037 sqpiw9 INITIALISATIONS-WORKING-FN. 004038 sqpiw9 exit section. 004039 sqpiw9 004040 sqpo /================================================================= 004041 sqpo * OOO U U V V EEEEE RRRR TTTTT U U RRRR EEEEE 004042 sqpo * O O U U V V E R R T U U R R E 004043 sqpo * O O U U V V EEEE RRRR T U U RRRR EEEE 004044 sqpo * O O U U V V E R R T U U R R E 004045 sqpo * OOO UUU V EEEEE R R T UUU R R EEEEE 004046 sqpo *================================================================= 004047 sqpo OUVERTURES SECTION. 004048 sqpod *> *> zone injection debut <* <* 004049 cdAP00* -- Ouverture ressource AP -- 004050 cdAP00*^^ouvavt * compléter les lignes ci-dessous * 004051 cdAP00 perform OUVRIR-AP 2183 004052 cdAP00*^^ouvapr * compléter les lignes ci-dessous * 004053 cdAP00* 004054 cdDM00* -- Ouverture ressource DM -- 004055 cdDM00*^^ouvavt * compléter les lignes ci-dessous * 004056 cdDM00 perform OUVRIR-DM 2802 004057 cdDM00*^^ouvapr * compléter les lignes ci-dessous * 004058 cdDM00* 004059 cdS100* -- Ouverture ressource S1 -- 004060 cdS100*^^ouvavt * compléter les lignes ci-dessous * 004061 cdS100 perform OUVRIR-S1 3317 004062 cdS100*^^ouvapr * compléter les lignes ci-dessous * 004063 cdS100* 004064 cdS200* -- Ouverture ressource S2 -- 004065 cdS200*^^ouvavt * compléter les lignes ci-dessous * 004066 cdS200 perform OUVRIR-S2 3549 004067 cdS200*^^ouvapr * compléter les lignes ci-dessous * 004068 cdS200* 004069 sqpof *> *> zone injection fin <* <* 004070 sqpoq *--- Fin ouvertures ressources ----------------------------------- 004071 sqpoq continue. 004072 sqpoq OUVERTURES-FN. 004073 sqpoq exit section. 004074 sqpoq 004075 sqpl /================================================================= 004076 sqpl * L EEEEE CCC TTTTT U U RRRR EEEEE SSS 004077 sqpl * L E C C T U U R R E S 004078 sqpl * L EEE C T U U RRRR EEEE SSS 004079 sqpl * L E C C T U U R R E S 004080 sqpl * LLLLL EEEEE CCC T UUU R R EEEEE SSS 004081 sqpl *================================================================= 004082 sqpl >>if AA-A-LECTURES 004083 sqpl LECTURES SECTION. 004084 sqplsd*> *> zone injection debut <* <* 004085 cdDM00* -- Lecture ressource DM sans rupture -- 004086 cdDM00*^^liravt * compléter les lignes ci-dessous * 004087 cdDM00 perform LIRE-DM 2807 004088 cdDM00*^^lirapr * compléter les lignes ci-dessous * 004089 cdDM00* 004090 sqplsf*> *> zone injection fin <* <* 004091 sqplrd*> *> zone injection debut <* <* 004092 cdAP00* -- Lecture ressource AP avec ruptures -- 004093 cdAP00*^^liravt * compléter les lignes ci-dessous * 004094 cdAP00 perform LIRE-AP 2189 004095 cdAP00*^^lirapr * compléter les lignes ci-dessous * 004096 cdAP00* 004097 sqplrf*> *> zone injection fin <* <* 004098 sqplq *--- Fin lectures ressources ------------------------------------- 004099 sqplq continue. 004100 sqplq LECTURES-FN. 004101 sqplq exit section. 004102 sqplq >>end-if 004103 sqplq 004104 sqpf /================================================================= 004105 sqpf * FFFFF EEEEE RRRR M M EEEEE TTTTT U U RRRR EEEEE 004106 sqpf * F E R R MM MM E T U U R R E 004107 sqpf * FFFF EEEE RRRR M M M EEEE T U U RRRR EEEE 004108 sqpf * F E R R M M E T U U R R E 004109 sqpf * F EEEEE R R M M EEEEE T UUU R R EEEEE 004110 sqpf *================================================================= 004111 sqpf FERMETURES SECTION. 004112 sqpfd *> *> zone injection debut <* <* 004113 cdAP00* -- Fermeture ressource AP -- 004114 cdAP00*^^feravt * compléter les lignes ci-dessous * 004115 cdAP00 perform FERMER-AP 2224 004116 cdAP00*^^ferapr * compléter les lignes ci-dessous * 004117 cdAP00* 004118 cdDM00* -- Fermeture ressource DM -- 004119 cdDM00*^^feravt * compléter les lignes ci-dessous * 004120 cdDM00 perform FERMER-DM 2837 004121 cdDM00*^^ferapr * compléter les lignes ci-dessous * 004122 cdDM00* 004123 cdS100* -- Fermeture ressource S1 -- 004124 cdS100*^^feravt * compléter les lignes ci-dessous * 004125 cdS100 perform FERMER-S1 3327 004126 cdS100*^^ferapr * compléter les lignes ci-dessous * 004127 cdS100* 004128 cdS200* -- Fermeture ressource S2 -- 004129 cdS200*^^feravt * compléter les lignes ci-dessous * 004130 cdS200 perform FERMER-S2 3559 004131 cdS200*^^ferapr * compléter les lignes ci-dessous * 004132 cdS200* 004133 sqpff *> *> zone injection fin <* <* 004134 sqpfq *--- Fin fermetures ressources ----------------------------------- 004135 sqpfq continue. 004136 sqpfq FERMETURES-FN. 004137 sqpfq exit section. 004138 sqpfq 004139 sqpq /================================================================= 004140 sqpq * FFFFF IIIII N N AAA L IIIII SSSS 004141 sqpq * F I NN N A A L I S 004142 sqpq * FFFF I N N N AAAAA L I SSS 004143 sqpq * F I N NN A A L I S .. 004144 sqpq * F IIIII N N A A LLLLL IIIII SSSS .. 004145 sqpq *================================================================= 004146 sqpq FINALISATION SECTION. 004147 sqpqd *> *> zone injection debut <* <* 004148 sqpqf *> *> zone injection fin <* <* 004149 sqpqt *--- Traçabilité programme (reco audit) -------------------------- 004150 sqpqt copy AGAPAUD2. ==004151==> IGYPS0040-I Printing of the source code has been suppressed. 004164C *-----------------------------------------------------------------AGAPAUD2 004165C * Tracabilité programme - Reco "Audit Archivage 2010" #5 - Fin AGAPAUD2 004166C if not RECO-ARCH-2010-5-wasRUN AGAPAUD2 1768 004167C 1 set RECO-ARCH-2010-5-wasRUN to true AGAPAUD2 1768 004168C *--- Message fin de programme en SYSOUT --------------------------AGAPAUD2 004169C >>if AA-G-MIXED AGAPAUD2 004171C >>end-if AGAPAUD2 004172C 1 display PROGE ' - FIN PROGRAMME' AGAPAUD2 239 004173C >>if AA-G-MIXED AGAPAUD2 004175C >>end-if AGAPAUD2 004176C end-if AGAPAUD2 004177 sqpqq *--- Fin finalisation -------------------------------------------- 004178 sqpqq continue. 004179 sqpqq FINALISATION-FN. 004180 sqpqq exit section. 004181 sqpqq 004182 sqpr /================================================================= 004183 sqpr * RRRR U U PPPP TTTTT SSSS Y Y N N CCC 004184 sqpr * R R U U P P T S Y Y NN N C C 004185 sqpr * RRRR U U PPPP T SSS Y N N N C 004186 sqpr * R R U U P T S Y N NN C C 004187 sqpr * R R UUU P T SSSS Y N N CCC 004188 sqpr *================================================================= 004189 sqpr RUPTURES-SYNCHROS SECTION. 004190 sqpr2d >>if AA-A-LECTURES-AVEC-RUPT 004191 sqpr2d*> *> zone injection debut <* <* 004192 cdAP00* -- Ruptures ressource AP -- 004193 cdAP00 perform CALCULER-RUPT-AP 2230 004194 sqpr2f*> *> zone injection fin <* <* 004195 sqpr2f >>end-if 004196 sqpr4 >>if AA-A-LECTURES-AVEC-SYNC 004197 sqpr4 *--- Calcul des Synchronisations --------------------------------- 004198 sqpr4 copy AAAPGSYN. ==004199==> IGYPS0040-I Printing of the source code has been suppressed. 004217C >>if AA-A-MAXNS > 0 AAAPGSYN 004218C move high-value to IND AAAPGSYN IMP 1443 004219C move 0 to MAX-CF AAAPGSYN 1496 004220C >>end-if AAAPGSYN 004221 sqpr4d*=== Phase 1 - Calcul de la clé de Synchronisation =============== 004222 sqpr4d*> *> zone injection debut <* <* 004223 cdAP00* -- Calcul des configurations ressource AP -- 004224 cdAP00 perform CALCULER-CLE-AP 2347 004225 cdDM00* -- Calcul des configurations ressource DM -- 004226 cdDM00 perform CALCULER-CLE-DM 2874 004227 sqpr4f*> *> zone injection fin <* <* 004228 sqpr5d*=== Phase 2 - Calcul des configurations ========================= 004229 sqpr5d*> *> zone injection debut <* <* 004230 cdAP00* -- Calcul des configurations ressource AP -- 004231 cdAP00 perform CALCULER-CONF-AP 2428 004232 cdDM00* -- Calcul des configurations ressource DM -- 004233 cdDM00 perform CALCULER-CONF-DM 2955 004234 sqpr5f*> *> zone injection fin <* <* 004235 sqpr5f >>end-if 004236 sqpr6 >>if AA-A-LECTURES-AVEC-RUPT and AA-A-LECTURES-AVEC-SYNC 004237 sqpr6 *--- Calcul des Ruptures totales --------------------------------- 004238 sqpr6 copy AAAPGRTD. ==004239==> IGYPS0040-I Printing of the source code has been suppressed. 004261C >>if AA-A-MAXNR > 0 and AA-A-MAXNS > 0 AAAPGRTD 004262C move RTD to RTP AAAPGRTD 1382 1353 004263C move all '1' to RTD AAAPGRTD 1382 004264C move NRD to NRP AAAPGRTD 1380 1351 004265C move 1 to NRD2 NRD AAAPGRTD 1409 1380 004266C >>end-if AAAPGRTD 004267 sqpr6d*> *> zone injection debut <* <* 004268 cdAP00* -- Calcul des Ruptures Totales AP -- 004269 cdAP00 perform CALCULER-RTD-AP 2283 004270 sqpr6f*> *> zone injection fin <* <* 004271 sqpr6f >>end-if 004272 sqprq *--- Fin Ruptures et Synchronisations ---------------------------- 004273 sqprq continue. 004274 sqprq RUPTURES-SYNCHROS-FN. 004275 sqprq exit section. 004276 sqprq 004277 sqpc /================================================================= 004278 sqpc * CCC OOO N N TTTTT RRRR OOO L EEEEE SSSS 004279 sqpc * C C O O NN N T R R O O L E S 004280 sqpc * C O O N N N T RRRR O O L EEEE SSS 004281 sqpc * C C O O N NN T R R O O L E S 004282 sqpc * CCC OOO N N T R R OOO LLLLL EEEEE SSSS 004283 sqpc *================================================================= 004284 sqpc >>if AA-A-CONTROLES 004292 sqpcq >>end-if 004293 sqpcq 004294 sqpm /================================================================= 004295 sqpm * M M AAA JJJJJ AAA U U TTTTT OOO 004296 sqpm * MM MM A A J A A U U T O O 004297 sqpm * M M M AAAAA J AAAAA U U T O O 004298 sqpm * M M A A J J A A U U T O O 004299 sqpm * M M A A J A A UUU T OOO 004300 sqpm *================================================================= 004301 sqpm >>if AA-A-MAJ 004309 sqpmq >>end-if 004310 sqpmq 004311 sqpe /================================================================= 004312 sqpe * EEEEE DDDD IIIII TTTTT IIIII OOO N N SSSS 004313 sqpe * E D D I T I O O NN N S 004314 sqpe * EEEE D D I T I O O N N N SSS 004315 sqpe * E D D I T I O O N NN S 004316 sqpe * EEEEE DDDD IIIII T IIIII OOO N N SSSS 004317 sqpe *================================================================= 004318 sqpe >>if AA-A-EDITIONS 004326 sqpeq >>end-if 004327 sqpeq 004328 sqps /================================================================= 004329 sqps * EEEEE CCC RRRR IIIII TTTTT U U RRRR EEEEE SSSS 004330 sqps * E C C R R I T U U R R E S 004331 sqps * EEEE C RRRR I T U U RRRR EEEE SSS 004332 sqps * E C C R R I T U U R R E S 004333 sqps * EEEEE CCC R R IIIII T UUU R R EEEEE SSSS 004334 sqps *================================================================= 004335 sqps >>if AA-A-ECRITURES 004336 sqps ECRITURES SECTION. 004337 sqpsd *> *> zone injection debut <* <* 004338 cdS100* -- Gestion Ecriture S1 -- 004339 cdS100*^^ecravt * compléter les lignes ci-dessous * 004340 * Ecriture si date de fin non renseignée 004341 if 1-AP00-DISGSU = spaces 461 IMP 004342 1 move DM00-COSGDM to S100-COSGDM 363 143 004343 1 move DM00-LNSGDM to S100-LNSGDM 365 145 004344 1 move 1-AP00-COSGA1 to S100-COSGA1 449 147 004345 1 move 1-AP00-LNSGAP to S100-LNSGAP 451 149 004346 1 cdS100 perform ECRIRE-S1 3322 004347 cdS100*^^ecrapr * compléter les lignes ci-dessous 004348 end-if 004349 cdS100* 004350 cdS200* -- Gestion Ecriture S2 -- 004351 cdS200*^^ecravt * compléter les lignes ci-dessous * 004352 * Ecriture en rupture dernière niveau 1 004353 if RTD1 = 1 1383 004354 1 move DM00-COSGDM to S200-COSGDM 363 167 004355 1 move DM00-LNSGDM to S200-LNSGDM 365 169 004356 1 move W-WB00-W9040 to S200-W9040 1811 171 004357 1 cdS200 perform ECRIRE-S2 3554 004358 cdS200*^^ecrapr * compléter les lignes ci-dessous 004359 end-if 004360 cdS200* 004361 sqpsf *> *> zone injection fin <* <* 004362 sqpsq *--- Fin écritures ----------------------------------------------- 004363 sqpsq continue. 004364 sqpsq ECRITURES-FN. 004365 sqpsq exit section. 004366 sqpsq >>end-if 004367 sqpsq 004368 sqpko /================================================================= 004369 sqpko * EEEEE RRRR RRRR EEEEE U U RRRR SSSS 004370 sqpko * E R R R R E U U R R S 004371 sqpko * EEEE RRRR RRRR EEEE U U RRRR SSS 004372 sqpko * E R R R R E U U R R S 004373 sqpko * EEEEE R R R R EEEEE UUU R R SSSS 004374 sqpko *================================================================= 004375 sqpko *--- Gestion des erreurs DB2 ------------------------------------- 004376 sqpk2 >>if AA-A-DB2 004377 sqpk2 ERREUR-DB2 SECTION. 004378 sqpk2 copy A2APTIAR. ==004379==> IGYPS0040-I Printing of the source code has been suppressed. 004393C *--- Interface DSNTIAR -------------------------------------------A2APTIAR 004394C >>callinterface dynamic A2APTIAR 004395C call 'DSNTIAR' using SQLCA A2APTIAR EXT 1296 004396C DSNTIAR-MESSAGE A2APTIAR 1792 004397C DSNTIAR-LINE-LENGTH A2APTIAR 1790 004398C on exception A2APTIAR 004399C 1 move 20 to DSNTIAR-RC A2APTIAR 1787 004400C not on exception A2APTIAR 004401C 1 move return-code to DSNTIAR-RC A2APTIAR IMP IMP 1787 ==004401==> IGYPA3228-W High order digit positions in the sender may be truncated in the move to receiver "DSNTIAR-RC (NUMERIC INTEGER)". 004402C end-call A2APTIAR 004403C >>callinterface A2APTIAR 004404 sqpk2 if DSNTIAR-OK 1788 004405 1 sqpk2 display '*******************************' 004406 1 sqpk2 display '**** E R R E U R D B 2 ****' 004407 1 sqpk2 display '*******************************' 004408 1 sqpk2 perform varying XDSNTIAR from 1 by 1 1797 004409 1 sqpk2 until XDSNTIAR > 10 1797 004410 1 sqpk2 or DSNTIAR-END (XDSNTIAR) 1798 1797 004411 2 sqpk2 display DSNTIAR-LINE (XDSNTIAR) 1796 1797 004412 1 sqpk2 end-perform 004413 sqpk2 end-if 004414 sqpk2 move SQLCODE to DSNTIAR-ABEND 1299 1789 004415 sqpk2a call "CEE3ABD" using DSNTIAR-ABEND EXT 1789 004416 sqpk2a by content X'00000001' 004417 sqpk2q . 004418 sqpk2q ERREUR-DB2-FN. 004419 sqpk2q exit section. 004420 sqpk2q >>end-if 004421 sqpkd *> *> zone injection debut <* <* 004422 sqpkf *> *> zone injection fin <* <* 004423 sqpka *--- Abend volontaire -------------------------------------------- 004424 sqpka ERREUR-ABEND SECTION. 004425 sqpka call "CEE3ABD" using CODE-ABEND EXT 1801 004426 sqpka by content X'00000001' 004427 sqpkaq . 004428 sqpkaq ERREUR-ABEND-FN. 004429 sqpkaq exit section. ==004429==> IGYSC0208-I DSNH050I DSNHPSRV WARNINGS HAVE BEEN SUPPRESSED DUE TO LACK OF TABLE DECLARATIONS 004430 sqq 004431 sqq *================================================================= 004432 sqq *=== That's all folks ! ========================================== 004433 sqq *================================================================= 004434 sqq End program S9TL1B. 2