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. 000037C *> --- Variables calculées automatiquement (ne pas modifier) AGAVINIT 000038C >>define AA-G-BATCH as b'0' AGAVINIT 000039C >>define AA-G-CICS as b'0' AGAVINIT 000040C >>define AA-G-EXCI as b'0' AGAVINIT 000041C >>define AA-G-MIXED as b'0' AGAVINIT 000042C >>if AA-G-PACBASE not defined AGAVINIT 000043C >>define AA-G-PACBASE as b'0' AGAVINIT 000044C >>end-if AGAVINIT 000045C >>define AA-G-VARPACBASE as b'0' AGAVINIT 000046C >>define IGY-ADV as parameter AGAVINIT 000047C >>if IGY-ADV not defined AGAVINIT 000049C >>end-if AGAVINIT 000050C >>define AA-G-BATCH as b'1' override AGAVBATC 000051C copy AAAVACCE. AGAVBATC ==000052==> IGYDS0040-I Printing of the source code has been suppressed. 000074C *> --- Variables calculées automatiquement (ne pas modifier) AAAVACCE 000075C >>define AA-A-CONTROLES as b'0' AAAVACCE 000076C >>define AA-A-DB2 as b'0' AAAVACCE 000077C >>define AA-A-DB2-TRACE as b'0' AAAVACCE 000078C >>define AA-A-ECRITURES as b'0' AAAVACCE 000079C >>define AA-A-EDITIONS as b'0' AAAVACCE 000080C >>define AA-A-EDITIONS-AUTO as b'0' AAAVACCE 000081C >>define AA-A-LECTURES as b'0' AAAVACCE 000082C >>define AA-A-LECTURES-AVEC-RUPT as b'0' AAAVACCE 000083C >>define AA-A-LECTURES-AVEC-SYNC as b'0' AAAVACCE 000084C >>define AA-A-LECTURES-SANS-RUPT as b'0' AAAVACCE 000085C >>define AA-A-MAJ as b'0' AAAVACCE 000086C >>define AA-A-MAXNR as 0 AAAVACCE 000087C >>define AA-A-MAXNS as 0 AAAVACCE 000088C >>define AA-A-VSAM as b'0' AAAVACCE 000089 sqisqa****************************************************************** 000090 sqisqa*> * * Squelette : SB2 - Squelette Batch <* <* 000091 sqisqa*> * * Version : SB2 - V5.0.0 - B <* <* 000092 sqisqd*> * * Squelette : Tag trace Injection <* <* 000093 cdAP00*Inj*|dd:AP|noseg:00|repl:APP|copy:SG2DAPP|ddname:APP|recfm:F|nrup 000094 cdAP00*Inj*t:2|nsync:1|org:2|mode:S|acces:LSA|cles:COSGDP;LCSGAP|picts:X 000095 cdAP00*Inj*(1);X(1) 000096 cdDM00*Inj*|dd:DM|noseg:00|repl:ADM|copy:SG2DADM|ddname:ADM|recfm:F|nrup 000097 cdDM00*Inj*t:0|nsync:1|org:2|mode:S|acces:LSA|cles:COSGDP|picts:X(1) 000098 cdS100*Inj*|dd:S1|noseg:00|repl:I902|copy:S9FDI902|ddname:SI902|recfm:F| 000099 cdS100*Inj*nrupt:0|org:F|mode:S|acces:ESA 000100 cdS200*Inj*|dd:S2|noseg:00|repl:I903|copy:S9FDI903|ddname:SI903|recfm:F| 000101 cdS200*Inj*nrupt:0|org:F|mode:S|acces:ESA 000102 sqisqf*> * * Squelette : Tag trace Injection <* <* 000103 sqid DATE-COMPILED. 07/16/24. 000104 sqe ENVIRONMENT DIVISION. 000105 sqec CONFIGURATION SECTION. 000106 sqec SOURCE-COMPUTER. IBM-370. 000107 sqec OBJECT-COMPUTER. IBM-370. 000108 sqes SPECIAL-NAMES. 000109 DECIMAL-POINT IS COMMA 000110 . 000111 sqei INPUT-OUTPUT SECTION. 000112 sqeif FILE-CONTROL. 000113 sqeifd*> *> zone injection debut <* <* 000114 cdS100 select S1-FICHIER assign to UT-S-SI902. 136 000115 cdS200 select S2-FICHIER assign to UT-S-SI903. 160 000116 sqeiff*> *> zone injection fin <* <* 000117 sqeiff 000118 sqsd /***************************************************************** 000119 sqsd * DDDD AAA TTTTT AAA DDDD IIIII V V 000120 sqsd * D D A A T A A D D I V V 000121 sqsd * D D AAAAA T AAAAA D D I V V ... 000122 sqsd * D D A A T A A D D I V V ..... 000123 sqsd * DDDD A A T A A DDDD IIIII V ... 000124 sqsd ****************************************************************** 000125 sqsd DATA DIVISION. 000126 sqsd 000127 sqsdf *================================================================= 000128 sqsdf * FFFFF IIIII L EEEEE SSSS EEEEE CCC TTTTT 000129 sqsdf * F I L E S E C C T 000130 sqsdf * FFFF I L EEEE SSS EEEE C T 000131 sqsdf * F I L E S E C C T 000132 sqsdf * F IIIII LLLLL EEEEE SSSS EEEEE CCC T 000133 sqsdf *================================================================= 000134 sqsdf FILE SECTION. 000135 sqsdfd*> *> zone injection debut <* <* 000136 cdS100 FD S1-FICHIER 000137 cdS100 block contains 0 records 000138 cdS100 recording mode is F. 000139 cdS100 copy S9FDI902 replacing 000140 cdS100*^^repl1 * compléter les lignes ci-dessous * 000141 cdS100 ==REDEFINES I900.== by ==.== 000142 cdS100 leading ==I902== by ==S100== 000143 cdS100 . 000144C ******************************************************************S9FDI902 000145C * Fichier I902 : Liste des Applications actives S9FDI902 000146C *-----------------------------------------------------------------S9FDI902 000147C * Utilisation : S9FDI902 000148C * COPY S9FDI902 REPLACING LEADING ==I902=== BY ==prefix==. S9FDI902 000149C ******************************************************************S9FDI902 000150C *-- 16/10/2021 19:50:48 BIB: S9T SESSION: USER: J070188 S9FDI902 000151C 01 S100. S9FDI902 BLF=00001,000000000 0CL105 000152C *Code domaine *00001 000153C 10 S100-COSGDM PIC X(8). *00001 BLF=00001,000000000 8C 000154C *Libellé domaine *00009 000155C 10 S100-LNSGDM PIC X(45). *00009 BLF=00001,000000008 45C 000156C *Code application Cartographie *00054 000157C 10 S100-COSGA1 PIC X(8). *00054 BLF=00001,000000035 8C 000158C *Libellé application *00062 000159C 10 S100-LNSGAP PIC X(44). *00062 BLF=00001,00000003D 44C 000160 cdS200 FD S2-FICHIER 000161 cdS200 block contains 0 records 000162 cdS200 recording mode is F. 000163 cdS200 copy S9FDI903 replacing 000164 cdS200*^^repl1 * compléter les lignes ci-dessous * 000165 cdS200 ==REDEFINES I900.== by ==.== 000166 cdS200 leading ==I903== by ==S200== 000167 cdS200 . 000168C ****************************************************************** 000169C * Fichier I903 : Nombre d'Applications actives 000170C *----------------------------------------------------------------- 000171C * Utilisation : 000172C * COPY S9FSI903 REPLACING LEADING ==I903=== BY ==prefix==. 000173C ****************************************************************** 000174C *-- 16/10/2021 19:50:48 BIB: S9T SESSION: USER: J070188 000175C 01 S200. BLF=00002,000000000 0CL57 000176C *Code domaine *00001 000177C 10 S200-COSGDM PIC X(8). *00001 BLF=00002,000000000 8C 000178C *Libellé domaine *00009 000179C 10 S200-LNSGDM PIC X(45). *00009 BLF=00002,000000008 45C 000180C *Numérique Entier Banalisé 04 *00054 000181C 10 S200-W9040 PIC 9(4). *00054 BLF=00002,000000035 4C 000182 sqsdff*> *> zone injection fin <* <* 000183 sqsdff* 000184 sqsw *================================================================= 000185 sqsw * W W SSSS SSSS EEEEE CCC TTTTT 000186 sqsw * W W S S E C C T 000187 sqsw * W W W === SSS SSS EEEE C T 000188 sqsw * W W W S S E C C T 000189 sqsw * W W SSSS SSSS EEEEE CCC T 000190 sqsw *================================================================= 000191 sqsw WORKING-STORAGE SECTION. * * 000192 sqsw *--- Marqueur pour faciliter l'analyse des dumps ----------------- 000193 sqsw 01 DEBUT-WSS VOLATILE. 000000000 0CL7 000194 sqsw 05 FILLER PIC X(7) VALUE 'WORKING'. 000000000 7C 000195 sqswp *--- Horodatage code source -------------------------------------- 000196 sqswp copy AGADHORO replacing 000197 sqswp *--- informations à mettre à jour à la création du programme ----- 000198 =='COBASE'== by =='H49 '== 000199 =='APPLI'== by =='AB3'== 000200 =='PROGR'== by =='S9TL1B'== 000201 =='PROGE'== by =='S9TL1B '== 000202 *--- informations variables à mettre à jour ---------------------- 000203 =='NUGNA'== by =='00001'== 000204 =='DATGN'== by =='21/10/23'== 000205 =='DATGNC'== by =='21/10/2023'== 000206 =='TIMGN'== by =='16:23:23'== 000207 =='CODUTI'== by =='J070188 '== 000208 sqswpf . 000242C 01 CONSTANTES-PAC. AGADHORO 000000000 0CL87 000243C 05 PAC-CONSTANTES. AGADHORO 000000000 0CL87 000244C 10 NUGNA PIC X(5) VALUE '00001'. AGADHORO 000000000 5C 000245C 10 APPLI PIC X(3) VALUE 'AB3'. AGADHORO 000000005 3C 000246C 10 DATGN PIC X(8) VALUE '21/10/23'. AGADHORO 000000008 8C 000247C 10 PROGR PIC X(6) VALUE 'S9TL1B'. AGADHORO 000000010 6C 000248C 10 CODUTI PIC X(8) VALUE 'J070188 '. AGADHORO 000000016 8C 000249C 10 TIMGN PIC X(8) VALUE '16:23:23'. AGADHORO 00000001E 8C 000250C 10 PROGE PIC X(8) VALUE 'S9TL1B '. AGADHORO 000000026 8C 000251C 10 COBASE PIC X(4) VALUE 'H49 '. AGADHORO 00000002E 4C 000252C 10 DATGNC PIC X(10) VALUE '21/10/2023'. AGADHORO 000000032 10C 000253C 10 RELEAS PIC X(7) VALUE 'CBL NAT'. AGADHORO 00000003C 7C 000254C 10 DATGE PIC X(10) VALUE '01/01/2022'. AGADHORO 000000043 10C 000255C 10 DATSQ PIC X(10) VALUE '01/01/2022'. AGADHORO 00000004D 10C 000256 sqswpf* 000257 sqw2 *----------------------------------------------------------------- 000258 sqw2 * H H OOO SSSS TTTTT V V DDDD BBBB 222 000259 sqw2 * H H O O S T V V D D B B 2 2 000260 sqw2 * HHHHH O O SSS T V V D D BBBB 2 000261 sqw2 * H H O O S T V V D D B B 22 000262 sqw2 * H H OOO SSSS T V DDDD BBBB 22222 000263 sqw2 *----------------------------------------------------------------- 000264 sqw2d *> *> zone injection debut <* <* 000265 cdAP00*--- Ressource AP00 - Table APP 000266 cdAP00*^^hstavcp * compléter les lignes ci-dessous * 000267 cdAP00 copy SG2DAPP replacing 000268 cdAP00*^^repl1 * compléter les lignes ci-dessous * 000269 cdAP00 leading ==APP== by ==AP00== 000270 cdAP00 leading ==V-APP== by ==V-AP00== 000271 cdAP00 . 000272C ******************************************************************SG2DAPP 000273C * TABLE DB2 APP : Applications Cartographie $AGL APP SG2DAPP 000274C *-----------------------------------------------------------------SG2DAPP 000275C * Sous décomposition d'un Domaine de Gestion. SG2DAPP 000276C * L'application correspond à une unité de portage (ou de rem- SG2DAPP 000277C * placement) du Système d'Information. SG2DAPP 000278C * L'application correspond à une entité propriétaire de ses SG2DAPP 000279C * données (c-à-d que les autres applications ne peuvent pas y SG2DAPP 000280C * accéder directement aussi bien en MAJ qu'en Lecture, en TP SG2DAPP 000281C * qu'en Batch mais exclusivement utiliser les services SG2DAPP 000282C * proposés par l'application). SG2DAPP 000283C * SG2DAPP 000284C * Sous-schéma de sélection SG2DAPP 000285C * ------------------------ SG2DAPP 000286C * 1 : recherche Application par codes Domaine/Application SG2DAPP 000287C * SG2DAPP 000288C * ------------------------------------------------------------ SG2DAPP 000289C * Auteur : BELLIER Olivier SG2DAPP 000290C * Date de Création : 29/08/02 SG2DAPP 000291C * Origine Création : Mise aux normes des tables AGL SG2DAPP 000292C * SG2DAPP 000293C * Modifié par : FALLAI Denis SG2DAPP 000294C * Modifié le : 08/10/15 SG2DAPP 000295C * Motif de Modif. : Ajout clés et sous-schémas SG2DAPP 000296C * SG2DAPP 000297C * Modifié par : FALLAI Denis SG2DAPP 000298C * Modifié le : 26/11/18 SG2DAPP 000299C * Motif de Modif. : Regroupement Lettres Domaine et SG2DAPP 000300C * Application SG2DAPP 000301C *-----------------------------------------------------------------SG2DAPP 000302C * Utilisation : SG2DAPP 000303C * COPY SG2DAPP REPLACING LEADING ==APP== BY ==prefix== SG2DAPP 000304C * LEADING ==V-APP== BY ==V-prefix==. SG2DAPP 000305C ******************************************************************SG2DAPP 000306C *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DAPP 000307C *-----------------------------------------------------------------SG2DAPP 000308C * Applications Cartographie $AGL APP SG2DAPP 000309C 01 AP00. SG2DAPP 000000000 0CL94 000310C * Code application Cartographie *00001 000311C 10 AP00-COSGA1 PIC X(8). *00001 000000000 8C 000312C * Libellé application *00009 000313C 10 AP00-LNSGAP PIC X(44). *00009 000000008 44C 000314C * Groupe Lettres Domaine-Application *00053 000315C 10 AP00-GISGDA. *00053 000000034 0CL2 000316C * Code Lettre Domaine PACBASE *00053 000317C 11 AP00-COSGDP PIC X. *00053 000000034 1C 000318C * Lettre préfixe application *00054 000319C 11 AP00-LCSGAP PIC X. *00054 000000035 1C 000320C * date de creation d'une application *00055 000321C 10 AP00-DISGCA PIC X(8). *00055 000000036 8C 000322C * date suppression d'une application *00063 000323C 10 AP00-DISGSU PIC X(8). *00063 00000003E 8C 000324C * date mise a jour d'une application *00071 000325C 10 AP00-DISGMJ PIC X(8). *00071 000000046 8C 000326C * Code Synonyme *00079 000327C 10 AP00-COSGSN PIC X(8). *00079 00000004E 8C 000328C * Code secteur *00087 000329C 10 AP00-COSGSE PIC X(8). *00087 000000056 8C 000330C * SG2DAPP 000331C >>if AA-A-DB2NOIND not defined SG2DAPP 000332C 01 V-AP00. SG2DAPP 000000000 0CL18 000333C 10 V-AP00-COSGA1 PIC S9(4) COMP-5. SG2DAPP 000000000 2C 000334C 10 V-AP00-LNSGAP PIC S9(4) COMP-5. SG2DAPP 000000002 2C 000335C 10 V-AP00-COSGDP PIC S9(4) COMP-5. SG2DAPP 000000004 2C 000336C 10 V-AP00-LCSGAP PIC S9(4) COMP-5. SG2DAPP 000000006 2C 000337C 10 V-AP00-DISGCA PIC S9(4) COMP-5. SG2DAPP 000000008 2C 000338C 10 V-AP00-DISGSU PIC S9(4) COMP-5. SG2DAPP 00000000A 2C 000339C 10 V-AP00-DISGMJ PIC S9(4) COMP-5. SG2DAPP 00000000C 2C 000340C 10 V-AP00-COSGSN PIC S9(4) COMP-5. SG2DAPP 00000000E 2C 000341C 10 V-AP00-COSGSE PIC S9(4) COMP-5. SG2DAPP 000000010 2C 000342C 01 V-AP00-R REDEFINES V-AP00. SG2DAPP 000000000 0CL18 332 000343C 10 V-AP00-A PIC S9(4) COMP-5 SG2DAPP 000000000 2C 000344C OCCURS 00009. SG2DAPP 000345C >>end-if SG2DAPP 000346C >>define AA-A-DB2NOIND off SG2DAPP 000347 cdAP00* 000348 cdDM00*--- Ressource DM00 - Table ADM 000349 cdDM00*^^hstavcp * compléter les lignes ci-dessous * 000350 cdDM00 copy SG2DADM replacing 000351 cdDM00*^^repl1 * compléter les lignes ci-dessous * 000352 cdDM00 leading ==ADM== by ==DM00== 000353 cdDM00 leading ==V-ADM== by ==V-DM00== 000354 cdDM00 . 000355C ******************************************************************SG2DADM 000356C * TABLE DB2 ADM : Domaines Cartographie $AGL ADM SG2DADM 000357C *-----------------------------------------------------------------SG2DADM 000358C * Modifié par : AM Surault SG2DADM 000359C * Modifié le : 24/12/04 SG2DADM 000360C * Motif de Modif. : Remontée à partir de SGL pour pouvoir SG2DADM 000361C * etre utilisée dans STE SG2DADM 000362C * Table contenant les domaines SIRIS tel que définis dans SG2DADM 000363C * la base "cartographie SIRIS". SG2DADM 000364C *-----------------------------------------------------------------SG2DADM 000365C * Utilisation : SG2DADM 000366C * COPY SG2DADM REPLACING LEADING ==ADM== BY ==prefix== SG2DADM 000367C * LEADING ==V-ADM== BY ==V-prefix==. SG2DADM 000368C ******************************************************************SG2DADM 000369C *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DADM 000370C *-----------------------------------------------------------------SG2DADM 000371C * Domaines Cartographie $AGL ADM SG2DADM 000372C 01 DM00. SG2DADM 000000000 0CL70 000373C * Code domaine *00001 000374C 10 DM00-COSGDM PIC X(8). *00001 000000000 8C 000375C * Libellé domaine *00009 000376C 10 DM00-LNSGDM PIC X(45). *00009 000000008 45C 000377C * Code Lettre Domaine PACBASE *00054 000378C 10 DM00-COSGDP PIC X. *00054 000000035 1C 000379C * date de creation d'une application *00055 000380C 10 DM00-DISGCA PIC X(8). *00055 000000036 8C 000381C * date suppression d'une application *00063 000382C 10 DM00-DISGSU PIC X(8). *00063 00000003E 8C 000383C * SG2DADM 000384C >>if AA-A-DB2NOIND not defined SG2DADM 000385C 01 V-DM00. SG2DADM 000000000 0CL10 000386C 10 V-DM00-COSGDM PIC S9(4) COMP-5. SG2DADM 000000000 2C 000387C 10 V-DM00-LNSGDM PIC S9(4) COMP-5. SG2DADM 000000002 2C 000388C 10 V-DM00-COSGDP PIC S9(4) COMP-5. SG2DADM 000000004 2C 000389C 10 V-DM00-DISGCA PIC S9(4) COMP-5. SG2DADM 000000006 2C 000390C 10 V-DM00-DISGSU PIC S9(4) COMP-5. SG2DADM 000000008 2C 000391C 01 V-DM00-R REDEFINES V-DM00. SG2DADM 000000000 0CL10 385 000392C 10 V-DM00-A PIC S9(4) COMP-5 SG2DADM 000000000 2C 000393C OCCURS 00005. SG2DADM 000394C >>end-if SG2DADM 000395C >>define AA-A-DB2NOIND off SG2DADM 000396 cdDM00* 000397 sqw2f *> *> zone injection fin <* <* 000398 sqw2f * 000399 sqwa *----------------------------------------------------------------- 000400 sqwa * W W RRRR K K AAA CCC CCC EEEEE SSSS 000401 sqwa * W W R R K KK A A C C C C E S 000402 sqwa * W W W RRRR KK AAAAA C C EEEE SSS 000403 sqwa * W W W R R K KK A A C C C C E S 000404 sqwa * W W R R K K A A CCC CCC EEEEE SSSS 000405 sqwa *----------------------------------------------------------------- 000406 sqwad *> *> zone injection debut <* <* 000407 cdAP00* 000408 cdAP00*--- Gestion Accès AP -------------------------------------------- 000409 cdAP00 >>define AA-A-ACCES as 'L' 000410 cdAP00 >>define AA-A-MODE as 'S' 000411 cdAP00 >>define AA-A-ORG as '2' 000412 cdAP00 >>define AA-A-NR as 2 000413 cdAP00 >>define AA-A-NS as 1 000414 cdAP00 >>if AA-A-NR > 0 000415 cdAP00*^^accavcp * compléter les lignes ci-dessous * 000416 cdAP00 copy SG2DAPP replacing 000417 cdAP00*^^repl2 * compléter les lignes ci-dessous * 000418 cdAP00 leading ==APP== by ==1-AP00== 000419 cdAP00 leading ==V-APP== by ==V-1-AP00== 000420 cdAP00 . 000421C ******************************************************************SG2DAPP 000422C * TABLE DB2 APP : Applications Cartographie $AGL APP SG2DAPP 000423C *-----------------------------------------------------------------SG2DAPP 000424C * Sous décomposition d'un Domaine de Gestion. SG2DAPP 000425C * L'application correspond à une unité de portage (ou de rem- SG2DAPP 000426C * placement) du Système d'Information. SG2DAPP 000427C * L'application correspond à une entité propriétaire de ses SG2DAPP 000428C * données (c-à-d que les autres applications ne peuvent pas y SG2DAPP 000429C * accéder directement aussi bien en MAJ qu'en Lecture, en TP SG2DAPP 000430C * qu'en Batch mais exclusivement utiliser les services SG2DAPP 000431C * proposés par l'application). SG2DAPP 000432C * SG2DAPP 000433C * Sous-schéma de sélection SG2DAPP 000434C * ------------------------ SG2DAPP 000435C * 1 : recherche Application par codes Domaine/Application SG2DAPP 000436C * SG2DAPP 000437C * ------------------------------------------------------------ SG2DAPP 000438C * Auteur : BELLIER Olivier SG2DAPP 000439C * Date de Création : 29/08/02 SG2DAPP 000440C * Origine Création : Mise aux normes des tables AGL SG2DAPP 000441C * SG2DAPP 000442C * Modifié par : FALLAI Denis SG2DAPP 000443C * Modifié le : 08/10/15 SG2DAPP 000444C * Motif de Modif. : Ajout clés et sous-schémas SG2DAPP 000445C * SG2DAPP 000446C * Modifié par : FALLAI Denis SG2DAPP 000447C * Modifié le : 26/11/18 SG2DAPP 000448C * Motif de Modif. : Regroupement Lettres Domaine et SG2DAPP 000449C * Application SG2DAPP 000450C *-----------------------------------------------------------------SG2DAPP 000451C * Utilisation : SG2DAPP 000452C * COPY SG2DAPP REPLACING LEADING ==APP== BY ==prefix== SG2DAPP 000453C * LEADING ==V-APP== BY ==V-prefix==. SG2DAPP 000454C ******************************************************************SG2DAPP 000455C *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DAPP 000456C *-----------------------------------------------------------------SG2DAPP 000457C * Applications Cartographie $AGL APP SG2DAPP 000458C 01 1-AP00. SG2DAPP 000000000 0CL94 000459C * Code application Cartographie *00001 000460C 10 1-AP00-COSGA1 PIC X(8). *00001 000000000 8C 000461C * Libellé application *00009 000462C 10 1-AP00-LNSGAP PIC X(44). *00009 000000008 44C 000463C * Groupe Lettres Domaine-Application *00053 000464C 10 1-AP00-GISGDA. *00053 000000034 0CL2 000465C * Code Lettre Domaine PACBASE *00053 000466C 11 1-AP00-COSGDP PIC X. *00053 000000034 1C 000467C * Lettre préfixe application *00054 000468C 11 1-AP00-LCSGAP PIC X. *00054 000000035 1C 000469C * date de creation d'une application *00055 000470C 10 1-AP00-DISGCA PIC X(8). *00055 000000036 8C 000471C * date suppression d'une application *00063 000472C 10 1-AP00-DISGSU PIC X(8). *00063 00000003E 8C 000473C * date mise a jour d'une application *00071 000474C 10 1-AP00-DISGMJ PIC X(8). *00071 000000046 8C 000475C * Code Synonyme *00079 000476C 10 1-AP00-COSGSN PIC X(8). *00079 00000004E 8C 000477C * Code secteur *00087 000478C 10 1-AP00-COSGSE PIC X(8). *00087 000000056 8C 000479C * SG2DAPP 000480C >>if AA-A-DB2NOIND not defined SG2DAPP 000481C 01 V-1-AP00. SG2DAPP 000000000 0CL18 000482C 10 V-1-AP00-COSGA1 PIC S9(4) COMP-5. SG2DAPP 000000000 2C 000483C 10 V-1-AP00-LNSGAP PIC S9(4) COMP-5. SG2DAPP 000000002 2C 000484C 10 V-1-AP00-COSGDP PIC S9(4) COMP-5. SG2DAPP 000000004 2C 000485C 10 V-1-AP00-LCSGAP PIC S9(4) COMP-5. SG2DAPP 000000006 2C 000486C 10 V-1-AP00-DISGCA PIC S9(4) COMP-5. SG2DAPP 000000008 2C 000487C 10 V-1-AP00-DISGSU PIC S9(4) COMP-5. SG2DAPP 00000000A 2C 000488C 10 V-1-AP00-DISGMJ PIC S9(4) COMP-5. SG2DAPP 00000000C 2C 000489C 10 V-1-AP00-COSGSN PIC S9(4) COMP-5. SG2DAPP 00000000E 2C 000490C 10 V-1-AP00-COSGSE PIC S9(4) COMP-5. SG2DAPP 000000010 2C 000491C 01 V-1-AP00-R REDEFINES V-1-AP00. SG2DAPP 000000000 0CL18 481 000492C 10 V-1-AP00-A PIC S9(4) COMP-5 SG2DAPP 000000000 2C 000493C OCCURS 00009. SG2DAPP 000494C >>end-if SG2DAPP 000495C >>define AA-A-DB2NOIND off SG2DAPP 000496 cdAP00 >>end-if 000497 cdAP00*^^accavad * compléter les lignes ci-dessous * 000498 cdAP00 copy AAADACCE replacing 000499 cdAP00 ==:DD:== by ==AP== 000500 cdAP00 ==:K1:== by ==COSGDP== 000501 cdAP00 ==:P1:== by ==X(1)== 000502 cdAP00 ==:K2:== by ==LCSGAP== 000503 cdAP00 ==:P2:== by ==X(1)== 000504 cdAP00 . ==000505==> IGYDS0040-I Printing of the source code has been suppressed. 000576C *> --- Validation du contexte AAADACCE 000577C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 000583C >>end-if AAADACCE 000584C >>if AA-A-ORG = '2' AAADACCE 000585C copy AAA00020. AAADACCE 000586C >>define AA-A-DB2 as b'1' override AAA00020 000587C >>end-if AAADACCE 000588C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 000590C >>end-if AAADACCE 000591C >>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE 000592C *> Compteur d'accès AAADACCE 000593C 01 5-AP00-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 000594C >>end-if AAADACCE 000595C >>evaluate AA-A-ACCES AAADACCE 000596C >>when 'L' *> Lecture seule AAADACCE 000597C copy AAA0L000. AAADACCE 000598C *> Indicateur accès nouvel enregistrement lu AAA0L000 000599C 01 PIC X VALUE '0'. AAA0L000 000000000 1C 000600C 88 AP-LU VALUE '1' AAA0L000 000601C FALSE '0'. AAA0L000 000602C >>evaluate AA-A-MODE AAA0L000 000603C >>when 'S' *> Lecture séquentielle AAA0L000 000604C copy AAA0LS00. AAA0L000 000605C >>if AA-A-ORG = '2' AAA0LS00 000606C copy AAA0LS20. AAA0LS00 000607C *> Témoins état curseur Db2 AAA0LS20 000608C 01 W-AP00-CESBCU PIC X VALUE 'C'. AAA0LS20 000000000 1C 000609C 88 AP-OUVERT VALUE 'O' AAA0LS20 000610C FALSE 'C'. AAA0LS20 000611C >>end-if AAA0LS00 000612C >>evaluate true AAA0LS00 000613C >>when AA-A-NR < 0 *> Accès séquentiel hors itération AAA0LS00 000620C >>when other *> Accès séquentiel avec Rupture AAA0LS00 000621C >>define AA-A-LECTURES as b'1' override AAA0LS00 000622C copy AAA0LSRU. AAA0LS00 000623C >>define AA-A-LECTURES-AVEC-RUPT as b'1' override AAA0LSRU 000624C >>if AA-A-MAXNR < AA-A-NR AAA0LSRU 000625C >>define AA-A-MAXNR as AA-A-NR override AAA0LSRU 000626C >>end-if AAA0LSRU 000627C *> Niveau Rupture Première AAA0LSRU 000628C 01 AP-NRP PIC 9(4) COMP-5 VALUE 1. AAA0LSRU 000000000 2C 000629C *> Ruptures Premières AAA0LSRU 000630C 01 AP-PE. AAA0LSRU 000000000 0CL2 000631C 05 AP-PE1 PIC X VALUE '1'. AAA0LSRU 000000000 1C 000632C >>if AA-A-NR > 1 AAA0LSRU 000633C 05 AP-PE2 PIC X VALUE '1'. AAA0LSRU 000000001 1C 000634C >>if AA-A-NR > 2 AAA0LSRU 000654C >>end-if AAA0LSRU 000655C >>end-if AAA0LSRU 000656C *> Niveau Rupture Dernière AAA0LSRU 000657C 01 AP-NRD PIC 9(4) COMP-5 VALUE 1. AAA0LSRU 000000000 2C 000658C *> Ruptures Dernières AAA0LSRU 000659C 01 AP-DE. AAA0LSRU 000000000 0CL2 000660C 05 AP-DE1 PIC X VALUE '1'. AAA0LSRU 000000000 1C 000661C >>if AA-A-NR > 1 AAA0LSRU 000662C 05 AP-DE2 PIC X VALUE '1'. AAA0LSRU 000000001 1C 000663C >>if AA-A-NR > 2 AAA0LSRU 000683C >>end-if AAA0LSRU 000684C >>end-if AAA0LSRU 000685C >>end-evaluate AAA0LS00 000686C >>if AA-A-NS > 0 *> Accès séquentiel avec Synchro AAA0LS00 000687C copy AAA0LSSY. AAA0LS00 000688C >>define AA-A-LECTURES-AVEC-SYNC as b'1' override AAA0LSSY 000689C >>if AA-A-MAXNS < AA-A-NS AAA0LSSY 000690C >>define AA-A-MAXNS as AA-A-NS override AAA0LSSY 000691C >>end-if AAA0LSSY 000692C *> Niveau maximum de Configuration (Synchronisation) AAA0LSSY 000693C 01 AP-NCF PIC 9(4) COMP-5. AAA0LSSY 000000000 2C 000694C *> Indicateurs de Configuration (Synchronisation) AAA0LSSY 000695C 01 AP-CF. AAA0LSSY 000000000 0CL1 000696C 05 AP-CF1 PIC X VALUE '1'. AAA0LSSY 000000000 1C 000697C >>if AA-A-NS > 1 AAA0LSSY 000720C >>end-if AAA0LSSY 000721C *> Clés de Configuration (Synchronisation) AAA0LSSY 000722C 01 APIND. AAA0LSSY 000000000 0CL1 000723C 05 APIND1. AAA0LSSY 000000000 0CL1 000724C 10 AP-IN-COSGDP PIC X(1). AAA0LSSY 000000000 1C 000725C >>if AA-A-NS > 1 AAA0LSSY 000756C >>end-if AAA0LSSY 000757C >>end-if AAA0LS00 000758C >>when 'R' *> Lecture directe AAA0L000 000769C >>end-evaluate AAA0L000 000770C >>when 'E' *> Ecriture seule AAADACCE 000793C >>end-evaluate AAADACCE ==000794==> IGYDS0040-I Printing of the source code has been suppressed. 000802 cdDM00* 000803 cdDM00*--- Gestion Accès DM -------------------------------------------- 000804 cdDM00 >>define AA-A-ACCES as 'L' 000805 cdDM00 >>define AA-A-MODE as 'S' 000806 cdDM00 >>define AA-A-ORG as '2' 000807 cdDM00 >>define AA-A-NR as 0 000808 cdDM00 >>define AA-A-NS as 1 000809 cdDM00 >>if AA-A-NR > 0 000816 cdDM00 >>end-if 000817 cdDM00*^^accavad * compléter les lignes ci-dessous * 000818 cdDM00 copy AAADACCE replacing 000819 cdDM00 ==:DD:== by ==DM== 000820 cdDM00 ==:K1:== by ==COSGDP== 000821 cdDM00 ==:P1:== by ==X(1)== 000822 cdDM00 . ==000823==> IGYDS0040-I Printing of the source code has been suppressed. 000894C *> --- Validation du contexte AAADACCE 000895C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 000901C >>end-if AAADACCE 000902C >>if AA-A-ORG = '2' AAADACCE 000903C copy AAA00020. AAADACCE 000904C >>define AA-A-DB2 as b'1' override AAA00020 000905C >>end-if AAADACCE 000906C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 000908C >>end-if AAADACCE 000909C >>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE 000910C *> Compteur d'accès AAADACCE 000911C 01 5-DM00-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 000912C >>end-if AAADACCE 000913C >>evaluate AA-A-ACCES AAADACCE 000914C >>when 'L' *> Lecture seule AAADACCE 000915C copy AAA0L000. AAADACCE 000916C *> Indicateur accès nouvel enregistrement lu AAA0L000 000917C 01 PIC X VALUE '0'. AAA0L000 000000000 1C 000918C 88 DM-LU VALUE '1' AAA0L000 000919C FALSE '0'. AAA0L000 000920C >>evaluate AA-A-MODE AAA0L000 000921C >>when 'S' *> Lecture séquentielle AAA0L000 000922C copy AAA0LS00. AAA0L000 000923C >>if AA-A-ORG = '2' AAA0LS00 000924C copy AAA0LS20. AAA0LS00 000925C *> Témoins état curseur Db2 AAA0LS20 000926C 01 W-DM00-CESBCU PIC X VALUE 'C'. AAA0LS20 000000000 1C 000927C 88 DM-OUVERT VALUE 'O' AAA0LS20 000928C FALSE 'C'. AAA0LS20 000929C >>end-if AAA0LS00 000930C >>evaluate true AAA0LS00 000931C >>when AA-A-NR < 0 *> Accès séquentiel hors itération AAA0LS00 000935C >>when AA-A-NR = 0 *> Accès séquentiel sans Rupture AAA0LS00 000936C >>define AA-A-LECTURES as b'1' override AAA0LS00 000937C >>define AA-A-LECTURES-SANS-RUPT as b'1' override AAA0LS00 000938C >>when other *> Accès séquentiel avec Rupture AAA0LS00 000941C >>end-evaluate AAA0LS00 000942C >>if AA-A-NS > 0 *> Accès séquentiel avec Synchro AAA0LS00 000943C copy AAA0LSSY. AAA0LS00 000944C >>define AA-A-LECTURES-AVEC-SYNC as b'1' override AAA0LSSY 000945C >>if AA-A-MAXNS < AA-A-NS AAA0LSSY 000947C >>end-if AAA0LSSY 000948C *> Niveau maximum de Configuration (Synchronisation) AAA0LSSY 000949C 01 DM-NCF PIC 9(4) COMP-5. AAA0LSSY 000000000 2C 000950C *> Indicateurs de Configuration (Synchronisation) AAA0LSSY 000951C 01 DM-CF. AAA0LSSY 000000000 0CL1 000952C 05 DM-CF1 PIC X VALUE '1'. AAA0LSSY 000000000 1C 000953C >>if AA-A-NS > 1 AAA0LSSY 000976C >>end-if AAA0LSSY 000977C *> Clés de Configuration (Synchronisation) AAA0LSSY 000978C 01 DMIND. AAA0LSSY 000000000 0CL1 000979C 05 DMIND1. AAA0LSSY 000000000 0CL1 000980C 10 DM-IN-COSGDP PIC X(1). AAA0LSSY 000000000 1C 000981C >>if AA-A-NS > 1 AAA0LSSY 001012C >>end-if AAA0LSSY 001013C >>end-if AAA0LS00 001014C >>when 'R' *> Lecture directe AAA0L000 001025C >>end-evaluate AAA0L000 001026C >>when 'E' *> Ecriture seule AAADACCE 001049C >>end-evaluate AAADACCE ==001050==> IGYDS0040-I Printing of the source code has been suppressed. 001058 cdS100* 001059 cdS100*--- Gestion Accès S1 -------------------------------------------- 001060 cdS100 >>define AA-A-ACCES as 'E' 001061 cdS100 >>define AA-A-MODE as 'S' 001062 cdS100 >>define AA-A-ORG as 'F' 001063 cdS100 >>define AA-A-NR as 0 001064 cdS100 >>define AA-A-NS as 0 001065 cdS100 >>if AA-A-NR > 0 001071 cdS100 >>end-if 001072 cdS100*^^accavad * compléter les lignes ci-dessous * 001073 cdS100 copy AAADACCE replacing 001074 cdS100 ==:DD:== by ==S1== 001075 cdS100 . ==001076==> IGYDS0040-I Printing of the source code has been suppressed. 001147C *> --- Validation du contexte AAADACCE 001148C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 001154C >>end-if AAADACCE 001155C >>if AA-A-ORG = '2' AAADACCE 001157C >>end-if AAADACCE 001158C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 001160C >>end-if AAADACCE 001161C >>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE 001162C *> Compteur d'accès AAADACCE 001163C 01 5-S100-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 001164C >>end-if AAADACCE 001165C >>evaluate AA-A-ACCES AAADACCE 001166C >>when 'L' *> Lecture seule AAADACCE 001168C >>when 'E' *> Ecriture seule AAADACCE 001169C copy AAA0E000. AAADACCE 001170C >>evaluate AA-A-MODE AAA0E000 001171C >>when 'S' *> Ecriture séquentielle AAA0E000 001172C copy AAA0ES00. AAA0E000 001173C >>if AA-A-NR >= 0 AAA0ES00 001174C >>define AA-A-ECRITURES as b'1' override AAA0ES00 001175C >>end-if AAA0ES00 001176C >>evaluate AA-A-ORG AAA0ES00 001177C >>when 'X' *> Document XML AAA5ES00 001181C >>end-evaluate AAA0ES00 001182C >>when 'R' *> Ecriture directe AAA0E000 001193C >>end-evaluate AAA0E000 001194C >>when 'M' *> Modification seule AAADACCE 001215C >>end-evaluate AAADACCE ==001216==> IGYDS0040-I Printing of the source code has been suppressed. 001224 cdS200* 001225 cdS200*--- Gestion Accès S2 -------------------------------------------- 001226 cdS200 >>define AA-A-ACCES as 'E' 001227 cdS200 >>define AA-A-MODE as 'S' 001228 cdS200 >>define AA-A-ORG as 'F' 001229 cdS200 >>define AA-A-NR as 0 001230 cdS200 >>define AA-A-NS as 0 001231 cdS200 >>if AA-A-NR > 0 001237 cdS200 >>end-if 001238 cdS200*^^accavad * compléter les lignes ci-dessous * 001239 cdS200 copy AAADACCE replacing 001240 cdS200 ==:DD:== by ==S2== 001241 cdS200 . ==001242==> IGYDS0040-I Printing of the source code has been suppressed. 001313C *> --- Validation du contexte AAADACCE 001314C >>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE 001320C >>end-if AAADACCE 001321C >>if AA-A-ORG = '2' AAADACCE 001323C >>end-if AAADACCE 001324C >>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE 001326C >>end-if AAADACCE 001327C >>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE 001328C *> Compteur d'accès AAADACCE 001329C 01 5-S200-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE 000000000 4C 001330C >>end-if AAADACCE 001331C >>evaluate AA-A-ACCES AAADACCE 001332C >>when 'L' *> Lecture seule AAADACCE 001334C >>when 'E' *> Ecriture seule AAADACCE 001335C copy AAA0E000. AAADACCE 001336C >>evaluate AA-A-MODE AAA0E000 001337C >>when 'S' *> Ecriture séquentielle AAA0E000 001338C copy AAA0ES00. AAA0E000 001339C >>if AA-A-NR >= 0 AAA0ES00 001340C >>define AA-A-ECRITURES as b'1' override AAA0ES00 001341C >>end-if AAA0ES00 001342C >>evaluate AA-A-ORG AAA0ES00 001343C >>when 'X' *> Document XML AAA5ES00 001347C >>end-evaluate AAA0ES00 001348C >>when 'R' *> Ecriture directe AAA0E000 001359C >>end-evaluate AAA0E000 001360C >>when 'M' *> Modification seule AAADACCE 001381C >>end-evaluate AAADACCE ==001382==> IGYDS0040-I Printing of the source code has been suppressed. 001390 sqwaf *> *> zone injection fin <* <* 001391 sqwaf * 001392 sqwa2 *--- Interface accès Db2 ----------------------------------------- 001393 sqwa2 >>if AA-A-DB2 001394 sqwa2 exec sql include SQLCA end-exec. 001395C 01 SQLCA GLOBAL VOLATILE. 000000000 0CL136 001396C 05 SQLCAID PIC X(8). 000000000 8C 001397C 05 SQLCABC PIC S9(9) COMP-5. 000000008 4C 001398C 05 SQLCODE PIC S9(9) COMP-5. 00000000C 4C 001399C 05 SQLERRM. 000000010 0CL72 001400C 49 SQLERRML PIC S9(4) COMP-5. 000000010 2C 001401C 49 SQLERRMC PIC X(70). 000000012 70C 001402C 05 SQLERRP PIC X(8). 000000058 8C 001403C 05 SQLERRD PIC S9(9) COMP-5 000000060 4C 001404C OCCURS 6 TIMES. 001405C 05 SQLWARN. 000000078 0CL8 001406C 10 SQLWARN0 PIC X. 000000078 1C 001407C 10 SQLWARN1 PIC X. 000000079 1C 001408C 10 SQLWARN2 PIC X. 00000007A 1C 001409C 10 SQLWARN3 PIC X. 00000007B 1C 001410C 10 SQLWARN4 PIC X. 00000007C 1C 001411C 10 SQLWARN5 PIC X. 00000007D 1C 001412C 10 SQLWARN6 PIC X. 00000007E 1C 001413C 10 SQLWARN7 PIC X. 00000007F 1C 001414C 05 SQLEXT. 000000080 0CL8 001415C 10 SQLWARN8 PIC X. 000000080 1C 001416C 10 SQLWARN9 PIC X. 000000081 1C 001417C 10 SQLWARNA PIC X. 000000082 1C 001418C 10 SQLSTATE PIC X(5). 000000083 5C 001419 sqwa2 >>end-if 001420 sqwa2 * 001421 sqwa3 *--- Interface accès VSAM ---------------------------------------- 001422 sqwa3 >>if AA-A-VSAM 001424 sqwa3 >>end-if 001425 sqwa3 * 001426 sqwac * --- Ruptures Globales ------------------------------------------ 001427 sqwac >>if AA-A-LECTURES-AVEC-RUPT 001428 sqwac copy AAADGRUP. ==001429==> IGYDS0040-I Printing of the source code has been suppressed. 001447C >>if AA-A-MAXNR > 0 AAADGRUP 001448C *> AAADGRUP 001449C *> Niveau Rupture Première AAADGRUP 001450C 01 NRP PIC 9 VALUE 0. AAADGRUP 000000000 1C 001451C *> Ruptures Totales Premières AAADGRUP 001452C 01 RTP. AAADGRUP 000000000 0CL2 001453C 05 RTP1 PIC X VALUE '1'. AAADGRUP 000000000 1C 001454C >>if AA-A-MAXNR > 1 AAADGRUP 001455C 05 RTP2 PIC X VALUE '1'. AAADGRUP 000000001 1C 001456C >>if AA-A-MAXNR > 2 AAADGRUP 001476C >>end-if AAADGRUP 001477C >>end-if AAADGRUP 001478C *> Niveau Rupture Dernière AAADGRUP 001479C 01 NRD PIC 9 VALUE 1. AAADGRUP 000000000 1C 001480C *> Ruptures Totales Dernières AAADGRUP 001481C 01 RTD. AAADGRUP 000000000 0CL2 001482C 05 RTD1 PIC X VALUE '1'. AAADGRUP 000000000 1C 001483C >>if AA-A-MAXNR > 1 AAADGRUP 001484C 05 RTD2 PIC X VALUE '1'. AAADGRUP 000000001 1C 001485C >>if AA-A-MAXNR > 2 AAADGRUP 001505C >>end-if AAADGRUP 001506C >>end-if AAADGRUP 001507C *> Zones de travail AAADGRUP 001508C 01 NRD2 PIC 9(4) COMP-5. AAADGRUP 000000000 2C 001509C 01 IRTD PIC 9(4) COMP-5. AAADGRUP 000000000 2C 001510C >>end-if AAADGRUP 001511 sqwac >>end-if 001512 sqwac *--- Configurations Globales ------------------------------------- 001513 sqwac >>if AA-A-LECTURES-AVEC-SYNC 001514 sqwac copy AAADGSYN 001515 sqwacd*> *> zone injection debut <* <* 001516 cd**** replacing 001517 cd**** ==:P1:== by ==X(1)== 001518 cd**** 001519 sqwacf*> *> zone injection fin <* <* 001520 sqwacf . ==001521==> IGYDS0040-I Printing of the source code has been suppressed. 001539C >>if AA-A-MAXNS > 0 AAADGSYN 001540C *> AAADGSYN 001541C *> Clés de Synchronisation AAADGSYN 001542C 01 IND. AAADGSYN 000000000 0CL1 001543C 05 IND1. AAADGSYN 000000000 0CL1 001544C 10 PIC X(1). AAADGSYN 000000000 1C 001545C >>if AA-A-MAXNS > 1 AAADGSYN 001576C >>end-if AAADGSYN 001577C 66 TIND1 RENAMES IND1. AAADGSYN 000000000 0CL1 1543 001578C >>if AA-A-MAXNS > 1 AAADGSYN 001601C >>end-if AAADGSYN 001602C *> AAADGSYN 001603C *> Niveau de Configuration maximum de l'itération courante AAADGSYN 001604C 01 MAX-CF PIC 9(4) COMP-5. AAADGSYN 000000000 2C 001605C >>end-if AAADGSYN 001606 sqwacf >>end-if 001607 sqwacf* 001608 sqwft *--- Indicateurs de fin de lecture ------------------------------- 001609 sqwft 01 FT. 000000000 0CL2 001610 sqwft 88 FIN-LECTURES VALUE ALL '1' 001611 sqwft FALSE ALL '0'. 001612 sqwftd*> *> zone injection debut <* <* 001613 cdAP00 05 AP-FT PIC X VALUE '0'. 000000000 1C 001614 cdAP00 88 FIN-LECTURE-AP VALUE '1' 001615 cdAP00 FALSE '0'. 001616 cdDM00 05 DM-FT PIC X VALUE '0'. 000000001 1C 001617 cdDM00 88 FIN-LECTURE-DM VALUE '1' 001618 cdDM00 FALSE '0'. 001619 sqwftf*> *> zone injection fin <* <* 001620 sqwftf >>if not AA-A-LECTURES 001622 sqwftf >>end-if 001623 sqwftf* 001624 sqwfi >>if AA-A-LECTURES-AVEC-RUPT 001625 sqwfi *--- Indicateurs de dernier enregistrement avec rupture----------- 001626 sqwfi 01 FI. 000000000 0CL1 001627 sqwfi 88 DERNIERE-ITERATION VALUE ALL '1' 001628 sqwfi FALSE ALL '0'. 001629 sqwfid*> *> zone injection debut <* <* 001630 cdAP00 05 AP-FI PIC X VALUE '0'. 000000000 1C 001631 cdAP00 88 DERNIERE-LECTURE-AP VALUE '1' 001632 cdAP00 FALSE '0'. 001633 sqwfif*> *> zone injection fin <* <* 001634 sqwfif >>end-if 001635 sqwfif* 001636 sqwsv *----------------------------------------------------------------- 001637 sqwsv * W W RRRR K K SSSS EEEEE RRRR V V 001638 sqwsv * W W R R K KK S E R R V V 001639 sqwsv * W W W RRRR KK SSS EEEE RRRR V V 001640 sqwsv * W W W R R K KK S E R R V V .. 001641 sqwsv * W W R R K K SSSS EEEEE R R V .. 001642 sqwsv *----------------------------------------------------------------- 001643 sqwsv *--- Variables de travail du framework compatible Pacbase -------- 001644 sqwsv copy AGADPAC0. ==001645==> IGYDS0040-I Printing of the source code has been suppressed. 001658C >>define AA-G-VARPACBASE as b'1' override AGADPAC0 001659C *> --- Variables Pacbase (pour compatibilité) AGADPAC0 001660C 01 BLANC PIC X VALUE SPACE. AGADPAC0 000000000 1C IMP 001661C 01 IK PIC X. AGADPAC0 000000000 1C 001662C 88 IK-OK VALUE '0' AGADPAC0 001663C FALSE '1'. AGADPAC0 001664C 88 IK-KO VALUE '1' AGADPAC0 001665C FALSE '0'. AGADPAC0 001666C 01 TALLI PIC S9(4) BINARY VALUE 0. AGADPAC0 000000000 2C 001667C 01 EN-PRE PIC X. AGADPAC0 000000000 1C 001668C *> Contrôles de validité / invalidité sur date AGADPAC0 001669C 88 5-DATE-VALIDE VALUE '1'. AGADPAC0 001670C 88 5-DATE-INVALIDE VALUE '5'. AGADPAC0 001671 sqwsv *--- Gestion des opérations sur Dates et Heures ------------------ 001672 sqwsv copy ADADDATE. ==001673==> IGYDS0040-I Printing of the source code has been suppressed. 001695C *> ADADDATE 001696C *> --- Variables compatibles Pacbase ADADDATE 001697C *> ADADDATE 001698C *> DATE DU JOUR COMPLETE ADADDATE 001699C 01 FULL-CURRENT-DATE. ADADDATE 000000000 0CL21 001700C *> DATE DU JOUR ADADDATE 001701C 05 DATCE. ADADDATE 000000000 0CL8 001702C 10 CENTUR. ADADDATE 000000000 0CL2 001703C 15 CC PIC XX VALUE '20'. ADADDATE 000000000 2C 001704C 10 DATOR. ADADDATE 000000002 0CL6 001705C 15 DATOA. ADADDATE 000000002 0CL2 001706C 20 YY PIC XX. ADADDATE 000000002 2C 001707C 15 DATOM. ADADDATE 000000004 0CL2 001708C 20 MM PIC XX. ADADDATE 000000004 2C 001709C 15 DATOJ. ADADDATE 000000006 0CL2 001710C 20 DD PIC XX. ADADDATE 000000006 2C 001711C *> HEURE COURANTE HHMMSSCC ADADDATE 001712C 05 TIMCO. ADADDATE 000000008 0CL8 001713C 10 TIMCOH. ADADDATE 000000008 0CL2 001714C 15 HH PIC XX. ADADDATE 000000008 2C 001715C 10 TIMCOM. ADADDATE 00000000A 0CL2 001716C 15 MM PIC XX. ADADDATE 00000000A 2C 001717C 10 TIMCOS. ADADDATE 00000000C 0CL2 001718C 15 SS PIC XX. ADADDATE 00000000C 2C 001719C 10 TIMOC. ADADDATE 00000000E 0CL2 001720C 15 TIMCOC. ADADDATE 00000000E 0CL2 001721C 20 CC PIC XX. ADADDATE 00000000E 2C 001722C *> TIME-ZONE ADADDATE 001723C 05 TZ. ADADDATE 000000010 0CL5 001724C 10 TZ-GMT PIC X. ADADDATE 000000010 1C 001725C 88 TZ-BEHIND-GMT VALUE '-'. ADADDATE 001726C 88 TZ-AHEAD-GMT VALUE '+'. ADADDATE 001727C 10 TZ-HH PIC XX. ADADDATE 000000011 2C 001728C 10 TZ-MM PIC XX. ADADDATE 000000013 2C 001729C *> HEURE FORMAT HH:MM:SS ADADDATE 001730C 01 TIMDAY. ADADDATE 000000000 0CL8 001731C 05 TIMHOU. ADADDATE 000000000 0CL2 001732C 10 HH PIC XX. ADADDATE 000000000 2C 001733C 05 TIMS1. ADADDATE 000000002 0CL1 001734C 10 S1 PIC X VALUE ':'. ADADDATE 000000002 1C 001735C 05 TIMMIN. ADADDATE 000000003 0CL2 001736C 10 MM PIC XX. ADADDATE 000000003 2C 001737C 05 TIMS2. ADADDATE 000000005 0CL1 001738C 10 S2 PIC X VALUE ':'. ADADDATE 000000005 1C 001739C 05 TIMSEC. ADADDATE 000000006 0CL2 001740C 10 SS PIC XX. ADADDATE 000000006 2C 001741C *> SEPARATEUR DATE PAR DEFAUT ADADDATE 001742C 01 DATSEP PIC X VALUE '/'. ADADDATE 000000000 1C 001743C *> SEPARATEUR DATE FORMAT G ADADDATE 001744C 01 DATSET PIC X VALUE '-'. ADADDATE 000000000 1C 001745C *> SEPARATEUR DATE DE TRAVAIL (non utilisé dans version COBOL) ADADDATE 001746C 01 DATSEW PIC X. ADADDATE 000000000 1C 001747C *> SEPARATEUR HEURE PAR DEFAUT ADADDATE 001748C 01 TIMSEP PIC X VALUE ':'. ADADDATE 000000000 1C 001749C *> NOMBRE DE JOURS DANS CALCULS SUR DATE ADADDATE 001750C 01 NUM-DAYS PIC S9(9). ADADDATE 000000000 9C 001751C *> ADADDATE 001752C *> --- Variables de communication avec les routines ADADDATE 001753C *> ADADDATE 001754C *> DATE FORMAT C : JJMMSSAA ADADDATE 001755C 01 5-DATE-C. *> DAT7C ADADDATE 000000000 0CL8 001756C 05 DD PIC XX. *> DAT71C ADADDATE 000000000 2C 001757C 05 MM PIC XX. *> DAT72C ADADDATE 000000002 2C 001758C 05 YYYY. ADADDATE 000000004 0CL4 001759C 10 CC PIC XX. *> DAT73C ADADDATE 000000004 2C 001760C 10 YY PIC XX. *> DAT74C ADADDATE 000000006 2C 001761C *> DATE FORMAT D : JJMMAA ADADDATE 001762C 01 5-DATE-D. *> DAT7 ADADDATE 000000000 0CL6 001763C 05 DD PIC XX. *> DAT71 ADADDATE 000000000 2C 001764C 05 MM PIC XX. *> DAT72 ADADDATE 000000002 2C 001765C 05 YY PIC XX. *> DAT73 ADADDATE 000000004 2C 001766C *> DATE FORMAT E : JJ/MM/AA ADADDATE 001767C 01 5-DATE-E. *> DAT8 ADADDATE 000000000 0CL8 001768C 05 DD PIC XX. *> DAT81 ADADDATE 000000000 2C 001769C 05 S1 PIC X. *> DAT8S1 ADADDATE 000000002 1C 001770C 05 MM PIC XX. *> DAT82 ADADDATE 000000003 2C 001771C 05 S2 PIC X. *> DAT8S2 ADADDATE 000000005 1C 001772C 05 YY PIC XX. *> DAT83 ADADDATE 000000006 2C 001773C *> DATE FORMAT G : SSAA-MM-JJ ADADDATE 001774C 01 5-DATE-G. *> DAT8G ADADDATE 000000000 0CL10 001775C 05 YYYY. ADADDATE 000000000 0CL4 001776C 10 CC PIC XX. *> DAT81G ADADDATE 000000000 2C 001777C 10 YY PIC XX. *> DAT82G ADADDATE 000000002 2C 001778C 05 S1 PIC X VALUE '-'. *> DAT8S1G ADADDATE 000000004 1C 001779C 05 MM PIC XX. *> DAT83G ADADDATE 000000005 2C 001780C 05 S2 PIC X VALUE '-'. *> DATS2G ADADDATE 000000007 1C 001781C 05 DD PIC XX. *> DAT84G ADADDATE 000000008 2C 001782C *> DATE FORMAT I : AAMMJJ ADADDATE 001783C 01 5-DATE-I. *> DAT6 ADADDATE 000000000 0CL6 001784C 05 YY PIC XX. *> DAT61 ADADDATE 000000000 2C 001785C 05 MM PIC XX. *> DAT62 ADADDATE 000000002 2C 001786C 05 DD PIC XX. *> DAT63 ADADDATE 000000004 2C 001787C *> DATE FORMAT M : JJ/MM/SSAA ADADDATE 001788C 01 5-DATE-M. *> DAT8C ADADDATE 000000000 0CL10 001789C 05 DD PIC XX. *> DAT81C ADADDATE 000000000 2C 001790C 05 S1 PIC X VALUE '/'. *> DATS1C ADADDATE 000000002 1C 001791C 05 MM PIC XX. *> DAT82C ADADDATE 000000003 2C 001792C 05 S2 PIC X VALUE '/'. *> DATS2C ADADDATE 000000005 1C 001793C 05 YYYY. *> DAT83C ADADDATE 000000006 0CL4 001794C 10 CC PIC XX. *> DAT83CC ADADDATE 000000006 2C 001795C 10 YY PIC XX. *> DAT84C ADADDATE 000000008 2C 001796C *> DATE FORMAT S : SSAAMMJJ ADADDATE 001797C 01 5-DATE-S. *> DAT6C ADADDATE 000000000 0CL8 001798C 05 YYYY. ADADDATE 000000000 0CL4 001799C 10 CC. *> DAT61C ADADDATE 000000000 0CL2 001800C 15 CC9 PIC 99. ADADDATE 000000000 2C 001801C 10 YY. *> DAT62C ADADDATE 000000002 0CL2 001802C 15 YY9 PIC 99. ADADDATE 000000002 2C 001803C 05 MM PIC XX. *> DAT63CC ADADDATE 000000004 2C 001804C 05 DD PIC XX. *> DAT64C ADADDATE 000000006 2C 001805C *> HEURE FORMAT HHMMSS ADADDATE 001806C 01 5-TIME. ADADDATE 000000000 0CL6 001807C 05 HH PIC X(2). ADADDATE 000000000 2C 001808C 05 MM PIC X(2). ADADDATE 000000002 2C 001809C 05 SS PIC X(2). ADADDATE 000000004 2C 001810C *> FENETRAGE DU SIECLE ADADDATE 001811C 01 5-DATE-PIVOT PIC XX VALUE '61'. *> DAT-CTYT ADADDATE 000000000 2C 001812C 01 5-DATE-SIECLE PIC XX VALUE '19'. *> DAT-CTY ADADDATE 000000000 2C 001813C 01 5-DATE-ADO PIC X VALUE SPACE. *> DAT-ADO ADADDATE 000000000 1C IMP 001814C 88 5-DATE-SIECLE-DEF VALUE '0'. ADADDATE 001815C 88 5-DATE-1900-AVANT VALUE '1'. ADADDATE 001816C 88 5-DATE-2000-AVANT VALUE '2'. ADADDATE 001817C *> DATES FORMAT SSAAMMJJ POUR CALCULS ADADDATE 001818C 01 5-DATE-D1 PIC 9(8). *> DATE81 ADADDATE 000000000 8C 001819C 01 5-DATE-D2 PIC 9(8). *> DATE82 ADADDATE 000000000 8C 001820C >>if AA-G-CICS ADADDATE 001823C >>end-if ADADDATE 001824C *> ADADDATE 001825C *> --- Variables de travail internes (ne pas utiliser) ADADDATE 001826C *> ADADDATE 001827C *> CALCUL ANNEE BISSECTILE ADADDATE 001828C 01 5-DATE-M4 PIC 99 BINARY. *> LEAP-REM ADADDATE 000000000 2C 001829C >>if not AA-G-VARPACBASE ADADDATE 001834C >>end-if ADADDATE 001835C >>if AA-G-PACBASE ADADDATE 001837C >>end-if ADADDATE 001838 sqwvsd*--- insertion working par l'assistant --------------------------- 001839 sqwvsd*> *> zone injection debut <* <* 001840 sqwvsf*> *> zone injection fin <* <* 001841 sqwvsf* 001842 sqwvv *----------------------------------------------------------------- 001843 sqwvv * W W RRRR K K CCC TTTTT RRRR L 001844 sqwvv * W W R R K KK C C T R R L 001845 sqwvv * W W W RRRR KK C T RRRR L 001846 sqwvv * W W W R R K KK C C T R R L .. 001847 sqwvv * W W R R K K CCC T R R LLLLL .. 001848 sqwvv *----------------------------------------------------------------- 001849 sqwvv *--- Variables pour contrôles automatiques ----------------------- 001850 sqwvvd*> *> zone injection début <* <* 001851 sqwvvf*> *> zone injection fin <* <* 001852 sqwvvf* 001853 sqwsva*--- Traçabilité programme (reco audit) -------------------------- 001854 sqwsva copy AGADAUDT. ==001855==> IGYDS0040-I Printing of the source code has been suppressed. 001867C *> AGADAUDT 001868C *> Tracabilité programme - Reco "Audit Archivage 2010" #5 AGADAUDT 001869C *> Date système format JJMMSSAA (C) AGADAUDT 001870C 01 W-BA0C-DASDSY PIC X(8). AGADAUDT 000000000 8C 001871C *> Date système format SSAA-MM-JJ (G) AGADAUDT 001872C 01 W-BA0G-DASDSY PIC X(10). AGADAUDT 000000000 10C 001873C *> Date système format JJ/MM/SSAA (M) AGADAUDT 001874C 01 W-BA0M-DASDSY PIC X(10). AGADAUDT 000000000 10C 001875C *> Indicateur d'exécution : 0=jamais, 1=1ère fois, 2=après 1ère AGADAUDT 001876C 01 PIC X VALUE '0'. AGADAUDT 000000000 1C 001877C 88 RECO-ARCH-2010-5-notRUN VALUE '0' AGADAUDT 001878C FALSE '1'. AGADAUDT 001879C 88 RECO-ARCH-2010-5-wasRUN VALUE '2'. AGADAUDT 001880 sqwsv2*--- Erreur Db2 -------------------------------------------------- 001881 sqwsv2 >>if AA-A-DB2 001882 sqwsv2 copy A2ADTIAR. ==001883==> IGYDS0040-I Printing of the source code has been suppressed. 001898C *> --- Interface DSNTIAR A2ADTIAR 001899C 01 DSNTIAR-RC PIC 9(2). A2ADTIAR 000000000 2C 001900C 88 DSNTIAR-OK VALUE 00 THRU 04. A2ADTIAR 001901C 01 DSNTIAR-ABEND PIC 9(8) COMP-5. A2ADTIAR 000000000 4C 001902C 01 DSNTIAR-LINE-LENGTH PIC 9(8) COMP-5 A2ADTIAR 000000000 4C 001903C VALUE 72. A2ADTIAR 001904C 01 DSNTIAR-MESSAGE. A2ADTIAR 000000000 0CL722 001905C 05 DSNTIAR-MESSAGE-LENGTH PIC 9(4) COMP-5 A2ADTIAR 000000000 2C 001906C VALUE 720. A2ADTIAR 001907C 05 DSNTIAR-LINES. A2ADTIAR 000000002 0CL720 001908C 10 DSNTIAR-LINE PIC X(72) OCCURS 10 A2ADTIAR 000000002 72C 001909C INDEXED BY XDSNTIAR. A2ADTIAR 001910C 88 DSNTIAR-END VALUE SPACES. A2ADTIAR IMP 001911 sqwsv2 >>end-if 001912 sqwsvb*--- Erreur abend volontaire (U4000 par défaut) ----------------- 001913 sqwsvb 01 CODE-ABEND PIC 9(8) COMP-5 VALUE 4000. 000000000 4C 001914 sqwk *----------------------------------------------------------------- 001915 sqwk * W W RRRR K K SSSS PPPP EEEEE CCC 001916 sqwk * W W R R K KK S P P E C C 001917 sqwk * W W W RRRR KK SSS PPPP EEEE C 001918 sqwk * W W W R R K KK S P E C C .. 001919 sqwk * W W R R K K SSSS P EEEEE CCC .. 001920 sqwk *----------------------------------------------------------------- 001921 sqwk * Insérer ci-dessous les variables spécifiques du programme 001922 sqwk * 001923 01 W-WB00-W9040 PIC S9(4) BINARY. 000000000 2C 001924 sqwkd *> *> zone injection debut <* <* 001925 sqwkf *> *> zone injection fin <* <* 001926 sqwkf 01 PIC X(1) VALUE '0'. 000000000 1C 001927 sqwkf 88 WORKING-INITIALISEES VALUE '1' 001928 sqwkf FALSE '0'. 001929 sqlk LINKAGE SECTION. 001930 sqlk *================================================================= 001931 sqlk * L N N K K SSSS EEEEE CCC TTTTT 001932 sqlk * L NN N K KK S E C C T 001933 sqlk * L N N N KK SSS EEEE C T 001934 sqlk * L N NN K KK S E C C T 001935 sqlk * LLLLL N N K K SSSS EEEEE CCC T 001936 sqlk *================================================================= 001937 sqlkd *> *> zone injection debut <* <* 001938 sqlkf *> *> zone injection fin <* <* 001939 sqlkf * Insérer ci-dessous les variables spécifiques du programme 001940 sqlkf * 001941 sqp /***************************************************************** 001942 sqp * PPPP RRRR OOO CCC EEEEE DDDD U U RRRR EEEEE 001943 sqp * P P R R O O C C E D D U U R R E 001944 sqp * PPPP RRRR O O C EEE D D U U RRRR EEEE 001945 sqp * P R R O O C C E D D U U R R E 001946 sqp * P R R OOO CCC EEEEE DDDD UUU R R EEEEE 001947 sqp ****************************************************************** 001948 sqp PROCEDURE DIVISION. 001949 * USING ... . 001950 sqpp *=== Cinematique principale ====================================== 001951 sqpp PRINCIPAL SECTION. 001952 sqpp *--- Gestion des erreurs Db2 ------------------------------------- 001953 sqpp >>if AA-A-DB2 001954 exec sql whenever NOT FOUND continue end-exec. 001955 exec sql whenever SQLWARNING continue end-exec. 001956 exec sql whenever SQLERROR goto ERREUR-DB2 end-exec. 001957 sqppa >>end-if 001958 sqppa *--- Initialisations --------------------------------------------- 001959 sqppa perform INITIALISATIONS-WORKING 4113 001960 sqppa with test before until WORKING-INITIALISEES 1927 001961 sqppa perform S-DEBUT 2024 001962 sqppa perform INITIALISATIONS 4051 001963 sqppa perform S-AVANT-OUVERTURES 2037 001964 sqppa perform OUVERTURES 4129 001965 sqppa perform S-AVANT-ITERATION 2050 001966 sqppa *--- Boucle principale ------------------------------------------- 001967 sqppa perform ITERATION until FIN-LECTURES. 1979 1610 001968 sqppa *--- Abandon du traitment (GFT) ---------------------------------- 001969 sqppa FIN-TRAITEMENT. 001970 sqppa *--- Finalisations ----------------------------------------------- 001971 sqppa perform S-AVANT-FERMETURES 2108 001972 sqppa perform FERMETURES 4193 001973 sqppa perform S-AVANT-FINALISATION 2121 001974 sqppa perform FINALISATION 4228 001975 sqppaz*--- Sortie du programme ----------------------------------------- 001976 sqppaz goback 001977 sqppaz . 001978 sqppi *=== Décomposition de la boucle principale ======================= 001979 sqppi ITERATION SECTION. 001980 sqppi perform S-AVANT-LECTURES 2063 001981 sqppi >>if AA-A-LECTURES 001982 sqppi perform LECTURES 4165 001983 sqppi >>end-if 001984 sqppi if not FIN-LECTURES 1610 001985 1 sqppi perform S-APRES-LECTURES 2076 001986 sqppir*--- Cinématique ressources lues --------------------------------- 001987 sqppir >>if AA-A-LECTURES-AVEC-RUPT or AA-A-LECTURES-AVEC-SYNC 001988 1 sqppir perform RUPTURES-SYNCHROS 4271 001989 sqppir >>end-if 001990 sqppir >>if AA-A-CONTROLES 001992 sqppir >>end-if 001993 sqppir >>if AA-A-MAJ 001995 sqppir >>end-if 001996 sqppit*--- Taitement applicatif principal ------------------------------ 001997 1 sqppit perform S-TRAITEMENT 2089 001998 sqppie*--- Editions ---------------------------------------------------- 001999 sqppie >>if AA-A-EDITIONS 002001 sqppie >>end-if 002002 sqppiw*--- Ressources en écritures ------------------------------------- 002003 sqppiw >>if AA-A-ECRITURES 002004 1 sqppiw perform ECRITURES 4418 002005 sqppiw >>end-if 002006 sqppiw end-if. 002007 sqppif*--- Retour en début d'itération (GDI) --------------------------- 002008 sqppif ITERATION-SUIVANTE. 002009 sqppif continue. 002010 sqppif ITERATION-FN. 002011 sqppif exit section. 002012 sqppif 002013 sqpz /================================================================= 002014 sqpz * CCC OOO DDDD EEEEE SSSS PPPP EEEEE 002015 sqpz * C C O O D D E S P P E 002016 sqpz * C O O D D EEEE SSS PPPP EEEE 002017 sqpz * C C O O D D E S P E 002018 sqpz * CCC OOO DDDD EEEEE SSSS P EEEEE 002019 sqpz *================================================================= 002020 sqpz0a* 002021 sqpz0a*================================================================= 002022 sqpz0a* Début de programme, avant tout autre traitement 002023 sqpz0a*================================================================= 002024 sqpz0a S-DEBUT SECTION. 002025 sqpz0a* Insérer ci-dessous le code spécifiques du programme 002026 sqpz0z*--- Fin début de programme -------------------------------------- 002027 sqpz0z continue. 002028 sqpz0z S-DEBUT-FN. 002029 sqpz0z exit section. 002030 sqpz0z* 002031 sqpz0z*--- Routines performées depuis S-DEBUT -------------------------- 002032 sqpz0z* Insérer ci-dessous le code spécifiques du programme 002033 sqpz1a* 002034 sqpz1a*================================================================= 002035 sqpz1a* Avant ouvertures des ressources 002036 sqpz1a*================================================================= 002037 sqpz1a S-AVANT-OUVERTURES SECTION. 002038 sqpz1a* Insérer ci-dessous le code spécifiques du programme 002039 sqpz1z*--- Fin avant ouverture des ressources -------------------------- 002040 sqpz1z continue. 002041 sqpz1z S-AVANT-OUVERTURES-FN. 002042 sqpz1z exit section. 002043 sqpz1z* 002044 sqpz1z*--- Routines performées depuis S-AVANT-OUVERTURES --------------- 002045 sqpz1z* Insérer ci-dessous le code spécifiques du programme 002046 sqpz2a* 002047 sqpz2a*================================================================= 002048 sqpz2a* Avant itération principale 002049 sqpz2a*================================================================= 002050 sqpz2a S-AVANT-ITERATION SECTION. 002051 sqpz2a* Insérer ci-dessous le code spécifiques du programme 002052 sqpz2z*--- Fin avant itération principale ------------------------------ 002053 sqpz2z continue. 002054 sqpz2z S-AVANT-ITERATION-FN. 002055 sqpz2z exit section. 002056 sqpz2z* 002057 sqpz2z*--- Routines performées depuis S-AVANT-ITERATION ---------------- 002058 sqpz2z* Insérer ci-dessous le code spécifiques du programme 002059 sqpz3a* 002060 sqpz3a*================================================================= 002061 sqpz3a* Avant lectures des ressources 002062 sqpz3a*================================================================= 002063 sqpz3a S-AVANT-LECTURES SECTION. 002064 sqpz3a* Insérer ci-dessous le code spécifiques du programme 002065 sqpz3z*--- Fin avant lectures des ressources --------------------------- 002066 sqpz3z continue. 002067 sqpz3z S-AVANT-LECTURES-FN. 002068 sqpz3z exit section. 002069 sqpz3z* 002070 sqpz3z*--- Routines performées depuis S-AVANT-LECTURES ----------------- 002071 sqpz3z* Insérer ci-dessous le code spécifiques du programme 002072 sqpz4a* 002073 sqpz4a*================================================================= 002074 sqpz4a* Après lectures des ressources 002075 sqpz4a*================================================================= 002076 sqpz4a S-APRES-LECTURES SECTION. 002077 sqpz4a* Insérer ci-dessous le code spécifiques du programme 002078 sqpz4z*--- Fin après lectures des ressources --------------------------- 002079 sqpz4z continue. 002080 sqpz4z S-APRES-LECTURES-FN. 002081 sqpz4z exit section. 002082 sqpz4z* 002083 sqpz4z*--- Routines performées depuis S-APRES-LECTURES ----------------- 002084 sqpz4z* Insérer ci-dessous le code spécifiques du programme 002085 sqpz5a* 002086 sqpz5a*================================================================= 002087 sqpz5a* Traitement applicatif principal 002088 sqpz5a*================================================================= 002089 sqpz5a S-TRAITEMENT SECTION. 002090 sqpz5a* Insérer ci-dessous le code spécifiques du programme 002091 if RTP1 = 1 1453 002092 1 move 0 to W-WB00-W9040 1923 002093 end-if 002094 if 1-AP00-DISGSU = spaces 472 IMP 002095 1 add 1 to W-WB00-W9040 1923 002096 end-if 002097 sqpz5z*--- Fin traitement applicatif principal ------------------------- 002098 sqpz5z continue. 002099 sqpz5z S-TRAITEMENT-FN. 002100 sqpz5z exit section. 002101 sqpz5z* 002102 sqpz5z*--- Routines performées depuis S-TRAITEMENT --------------------- 002103 sqpz5z* Insérer ci-dessous le code spécifiques du programme 002104 sqpz6a* 002105 sqpz6a*================================================================= 002106 sqpz6a* Avant fermeture des ressources 002107 sqpz6a*================================================================= 002108 sqpz6a S-AVANT-FERMETURES SECTION. 002109 sqpz6a* Insérer ci-dessous le code spécifiques du programme 002110 sqpz6z*--- Fin avant fermeture des ressources -------------------------- 002111 sqpz6z continue. 002112 sqpz6z S-AVANT-FERMETURES-FN. 002113 sqpz6z exit section. 002114 sqpz6z* 002115 sqpz6z*--- Routines performées depuis S-AVANT-FERMETURES --------------- 002116 sqpz6z* Insérer ci-dessous le code spécifiques du programme 002117 sqpz7a* 002118 sqpz7a*================================================================= 002119 sqpz7a* Avant sortie du programme 002120 sqpz7a*================================================================= 002121 sqpz7a S-AVANT-FINALISATION SECTION. 002122 sqpz7a* Insérer ci-dessous le code spécifiques du programme 002123 sqpz7z*--- Fin avant sortie du programme ------------------------------- 002124 sqpz7z continue. 002125 sqpz7z S-AVANT-FINALISATION-FN. 002126 sqpz7z exit section. 002127 sqpz7z* 002128 sqpz7z*--- Routines performées depuis S-AVANT-FINALISATION ------------- 002129 sqpz7z* Insérer ci-dessous le code spécifiques du programme 002130 sqpz9a* 002131 sqpz9a/================================================================= 002132 sqpz9a* RRRR OOO U U TTTTT IIIII N N EEEEE SSS 002133 sqpz9a* R R O O U u T I NN N E S 002134 sqpz9a* RRRR O O U U T I N N N EEE SSS 002135 sqpz9a* R R O O U U T I N NN E S 002136 sqpz9a* R R OOO UUU T IIIII N N EEEEE SSS 002137 sqpz9a*================================================================= 002138 sqpz9a*--- Routines internes performées -------------------------------- 002139 sqpz9a S-ROUTINES-INTERNES SECTION. 002140 sqpz9a continue. 002141 sqpz9a* Insérer ci-dessous le code spécifiques du programme 002142 sqpz9z*--- Fin routines internes performées ---------------------------- 002143 sqpz9z S-ROUTINES-INTERNES-FN. 002144 sqpz9z exit section. 002145 sqpz9z 002146 sqpa /================================================================= 002147 sqpa * AAA CCC CCC EEEEE SSSS 002148 sqpa * A A C C C C E S 002149 sqpa * AAAAA C C EEEE SSS 002150 sqpa * A A C C C C E S 002151 sqpa * A A CCC CCC EEEEE SSSS 002152 sqpa *================================================================= 002153 sqpa ACCESS-RESSOURCES SECTION. 002154 sqpa continue. 002155 sqpad *> *> zone injection debut <* <* 002156 cdAP00* 002157 cdAP00*--- Gestion Accès AP -------------------------------------------- 002158 cdAP00 >>define AA-A-ACCES as 'L' 002159 cdAP00 >>define AA-A-MODE as 'S' 002160 cdAP00 >>define AA-A-ORG as '2' 002161 cdAP00 >>define AA-A-NR as 2 002162 cdAP00 >>define AA-A-NS as 1 002163 cdAP00*^^accavap * compléter les lignes ci-dessous * 002164 cdAP00 copy AAAPACCE replacing 002165 cdAP00 ==:DD:== by ==AP== 002166 cdAP00 ==:PREF:== by ==AP00== 002167 cdAP00 ==:NS:== by ==1== 002168 cdAP00 ==:K1:== by ==COSGDP== 002169 cdAP00 ==:K2:== by ==LCSGAP== 002170 cdAP00 . ==002171==> IGYPS0040-I Printing of the source code has been suppressed. 002283C >>evaluate AA-A-ACCES AAAPACCE 002284C >>when 'L' *> Lecture seule AAAPACCE 002285C copy AAA5L000. AAAPACCE 002286C >>evaluate AA-A-MODE AAA5L000 002287C >>when 'S' *> Lecture séquentielle AAA5L000 002288C copy AAA5LS00. AAA5L000 002289C >>evaluate true AAA5LS00 002290C >>when AA-A-NR <= 0 and AA-A-NS = 0 *> sans Rupt ni Sync AAA5LS00 002296C >>when other *> avec Rupt et Sync AAA5LS00 002297C copy AAA5LSRS. AAA5LS00 002298C *>****************************************************************AAA5LSRS 002299C *> Accès logiques Lecture Séquentielle avec Ruptures et Synchros AAA5LSRS 002300C *>****************************************************************AAA5LSRS 002301C *> AAA5LSRS 002302C OUVRIR-AP SECTION. AAA5LSRS 002303C perform OUVRIR-AP-PHYSIQUE AAA5LSRS 2549 002304C perform LIRE-AP-PHYSIQUE. AAA5LSRS 2565 002305C OUVRIR-AP-FN. AAA5LSRS 002306C exit section. AAA5LSRS 002307C *> AAA5LSRS 002308C LIRE-AP SECTION. AAA5LSRS 002309C set AP-LU to false AAA5LSRS 600 002310C >>define L_ as b'1' AAA5LSRS 002311C >>evaluate true AAA5LSRS 002312C >>when AA-A-MAXNR <= 0 AAA5LSRS 002316C >>when AA-A-NR >= AA-A-NS AAA5LSRS 002317C >>define L_ as b'0' override AAA5LSRS 002318C >>end-evaluate AAA5LSRS 002319C *>>if maxNR > 0 and NS <= maxNR and NR < NS AAA5LSRS 002320C >>if L_ AAA5LSRS 002322C >>else AAA5LSRS 002323C if AP-CF1 not = '1' AAA5LSRS 696 002324C >>end-if AAA5LSRS 002325C >>define L_ off AAA5LSRS 002326C 1 exit section AAA5LSRS 002327C end-if AAA5LSRS 002328C *> Alimentation anticipée des indicateurs "Rupture Première" AAA5LSRS 002329C move AP-DE to AP-PE AAA5LSRS 659 630 002330C move AP-NRD to AP-NRP AAA5LSRS 657 628 002331C if AP-FI = '1' AAA5LSRS 1630 002332C 1 move high-value to APIND AAA5LSRS IMP 722 002333C 1 move '1' to AP-FT AAA5LSRS 1613 002334C 1 exit section AAA5LSRS 002335C end-if AAA5LSRS 002336C move AP00 to 1-AP00 AAA5LSRS 309 458 002337C perform ALIMENTER-CLE-AP AAA5LSRS 2436 002338C add 1 to 5-AP00-CPTENR AAA5LSRS 593 002339C perform LIRE-AP-PHYSIQUE. AAA5LSRS 2565 002340C LIRE-AP-FN. AAA5LSRS 002341C exit section. AAA5LSRS 002342C *> AAA5LSRS 002343C FERMER-AP SECTION. AAA5LSRS 002344C perform FERMER-AP-PHYSIQUE. AAA5LSRS 2585 002345C FERMER-AP-FN. AAA5LSRS 002346C exit section. AAA5LSRS 002347C copy AAA5L0RS. AAA5LSRS 002348C *> AAA5L0RS 002349C CALCULER-RUPT-AP SECTION. AAA5L0RS 002350C *> Calcul des indicateurs "Ruptures Dernières" AAA5L0RS 002351C move all '0' to AP-DE AAA5L0RS 659 002352C move 0 to AP-NRD AAA5L0RS 657 002353C evaluate true AAA5L0RS 002354C when AP-FI = '1' AAA5L0RS 1630 002355C when AP00-COSGDP not = 1-AP00-COSGDP AAA5L0RS 317 466 002356C 1 move 1 to AP-NRD AAA5L0RS 657 002357C 1 move all '1' to AP-DE AAA5L0RS 659 002358C >>if AA-A-NR > 1 AAA5L0RS 002359C when AP00-LCSGAP not = 1-AP00-LCSGAP AAA5L0RS 319 468 002360C 1 move 2 to AP-NRD AAA5L0RS 657 002361C 1 move all '1' to AP-DE(2:) AAA5L0RS 659 002362C >>if AA-A-NR > 2 AAA5L0RS 002396C >>end-if AAA5L0RS 002397C >>end-if AAA5L0RS 002398C end-evaluate. AAA5L0RS 002399C CALCULER-RUPT-AP-FN. AAA5L0RS 002400C exit section. AAA5L0RS 002401C *> AAA5L0RS 002402C CALCULER-RTD-AP SECTION. AAA5L0RS 002403C if NRD2 > 0 AAA5L0RS 1508 002404C 1 perform varying IRTD from NRD2 by 1 AAA5L0RS 1509 1508 002405C 1 until IRTD > length of AP-DE AAA5L0RS 1509 IMP 659 002406C 2 if IRTD <= 1 AAA5L0RS 1509 002407C 2 and AP-CF (IRTD:1) = '1' AAA5L0RS 695 1509 002408C 2 and (AP-DE (IRTD:1) = '0' AAA5L0RS 659 1509 002409C 2 or AP-CF1 = '0') AAA5L0RS 696 002410C 3 move '0' to RTD (IRTD:1) AAA5L0RS 1481 1509 002411C 3 if RTD = all '0' AAA5L0RS 1481 002412C 4 move 0 to NRD2 NRD AAA5L0RS 1508 1479 002413C 3 else AAA5L0RS 002414C 4 add 1 to IRTD giving NRD2 NRD AAA5L0RS 1509 1508 1479 002415C 3 end-if AAA5L0RS 002416C 2 else AAA5L0RS 002417C 3 if IRTD > 1 AAA5L0RS 1509 002418C 3 and AP-CF1 = '1' AAA5L0RS 696 002419C 3 and AP-DE (IRTD:1) = '0' AAA5L0RS 659 1509 002420C 4 move '0' to RTD (IRTD:1) AAA5L0RS 1481 1509 002421C 4 if RTD = all '0' AAA5L0RS 1481 002422C 5 move 0 to NRD2 NRD AAA5L0RS 1508 1479 002423C 4 else AAA5L0RS 002424C 5 add 1 to IRTD giving NRD2 NRD AAA5L0RS 1509 1508 1479 002425C 4 end-if AAA5L0RS 002426C 3 end-if AAA5L0RS 002427C 2 end-if AAA5L0RS 002428C 1 end-perform AAA5L0RS 002429C end-if. AAA5L0RS 002430C CALCULER-RTD-AP-FN. AAA5L0RS 002431C exit section. AAA5L0RS 002432C *> --- Routines de calcul des Synchros AAA5L0RS 002433C copy AAA5L0SY. AAA5L0RS 002434C copy AAA5L0IN. AAA5L0SY 002435C *> AAA5L0IN 002436C ALIMENTER-CLE-AP SECTION. AAA5L0IN 002437C move AP00-COSGDP to AP-IN-COSGDP AAA5L0IN 317 724 002438C >>if AA-A-NS > 1 AAA5L0IN 002461C >>end-if AAA5L0IN 002462C . AAA5L0IN 002463C ALIMENTER-CLE-AP-FN. AAA5L0IN 002464C exit section. AAA5L0IN 002465C *> AAA5L0SY 002466C CALCULER-CLE-AP SECTION. AAA5L0SY 002467C if APIND < TIND1 AAA5L0SY 722 1577 002468C 1 move high-value to IND AAA5L0SY IMP 1542 002469C 1 move APIND to TIND1 AAA5L0SY 722 1577 002470C end-if. AAA5L0SY 002471C CALCULER-CLE-AP-FN. AAA5L0SY 002472C exit section. AAA5L0SY 002473C *> AAA5L0SY 002474C CALCULER-CONF-AP SECTION. AAA5L0SY 002475C move all '0' to AP-CF AAA5L0SY 695 002476C move 0 to AP-NCF AAA5L0SY 693 002477C if APIND1 = IND1 AAA5L0SY 723 1543 002478C 1 move '1' to AP-CF1 AAA5L0SY 696 002479C 1 move 1 to AP-NCF AAA5L0SY 693 002480C >>if AA-A-NS > 1 AAA5L0SY 002527C >>end-if AAA5L0SY 002528C end-if AAA5L0SY 002529C if AP-NCF > MAX-CF AAA5L0SY 693 1604 002530C 1 move AP-NCF to MAX-CF AAA5L0SY 693 1604 002531C end-if. AAA5L0SY 002532C CALCULER-CONF-AP-FN. AAA5L0SY 002533C exit section. AAA5L0SY 002534C >>end-evaluate AAA5LS00 002535C >>evaluate AA-A-ORG AAA5LS00 002536C >>when 'F' *> Fichier Séquentiel AAA5LS00 002538C >>when '2' *> Accès Db2 AAA5LS00 002539C copy AAA5LS20. AAA5LS00 002540C *>****************************************************************AAA5LS20 002541C *> Accès physiques Lecture Séquentielle (curseur) Db2. AAA5LS20 002542C *> Les ordres SQL doivent être codés directement dans le AAA5LS20 002543C *> programme : AAA5LS20 002544C *> - OUVRIR-
-SQL : ordre OPEN CURSOR AAA5LS20 002545C *> - LIRE-
-SQL : ordre FETCH CURSOR AAA5LS20 002546C *> - FERMER-
-SQL : ordre CLOSE CURSOR AAA5LS20 002547C *>****************************************************************AAA5LS20 002548C *> AAA5LS20 002549C OUVRIR-AP-PHYSIQUE SECTION. AAA5LS20 002550C move '1' to IK AAA5LS20 1661 002551C perform OUVRIR-AP-SQL AAA5LS20 2683 002552C move '0' to IK AAA5LS20 1661 002553C set AP-OUVERT to true AAA5LS20 609 002554C >>evaluate true AAA5LS20 002555C >>when AA-A-NR = 0 AAA5LS20 002557C >>when AA-A-NR > 0 AAA5LS20 002558C move '0' to AP-FI AP-FT. AAA5LS20 1630 1613 002559C >>when other AAA5LS20 002561C >>end-evaluate AAA5LS20 002562C OUVRIR-AP-PHYSIQUE-FN. AAA5LS20 002563C exit section. AAA5LS20 002564C *> AAA5LS20 002565C LIRE-AP-PHYSIQUE SECTION. AAA5LS20 002566C move '1' to IK AAA5LS20 1661 002567C perform LIRE-AP-SQL AAA5LS20 2694 002568C evaluate true AAA5LS20 002569C when SQLCODE = +100 AAA5LS20 1398 002570C >>evaluate true AAA5LS20 002571C >>when AA-A-NR = 0 AAA5LS20 002573C >>when AA-A-NR > 0 AAA5LS20 002574C 1 move '1' to AP-FI AAA5LS20 1630 002575C >>when other AAA5LS20 002577C >>end-evaluate AAA5LS20 002578C when SQLCODE >= 0 AAA5LS20 1398 002579C 1 set AP-LU to true AAA5LS20 600 002580C 1 move '0' to IK AAA5LS20 1661 002581C end-evaluate. AAA5LS20 002582C LIRE-AP-PHYSIQUE-FN. AAA5LS20 002583C exit section. AAA5LS20 002584C *> AAA5LS20 002585C FERMER-AP-PHYSIQUE SECTION. AAA5LS20 002586C perform FERMER-AP-SQL AAA5LS20 2718 002587C set AP-OUVERT to false AAA5LS20 609 002588C >>evaluate true AAA5LS20 002589C >>when AA-A-NR = 0 AAA5LS20 002591C >>when AA-A-NR > 0 AAA5LS20 002592C move '1' to AP-FI. AAA5LS20 1630 002593C >>when other AAA5LS20 002595C >>end-evaluate AAA5LS20 002596C FERMER-AP-PHYSIQUE-FN. AAA5LS20 002597C exit section. AAA5LS20 002598C >>when 'K' *> Fichier VSAM KSDS AAA5LS00 002613C >>end-evaluate AAA5LS00 002614C >>when 'R' *> Lecture directe AAA5L000 002625C >>end-evaluate AAA5L000 002626C >>when 'E' *> Ecriture seule AAAPACCE 002649C >>end-evaluate AAAPACCE ==002650==> IGYPS0040-I Printing of the source code has been suppressed. 002658 cdAP00* 002659 cdAP00*--- Lecture séquentielle Table APP - Ressource AP 002660 cdAP00* 002661 cdAP00 exec sql 002662 cdAP00 DECLARE AP-CURSOR 002663 cdAP00 --^^cursor * compléter les lignes ci-dessous * 002664 CURSOR 002665 FOR 002666 SELECT -- liste des colonnes 002667 OAPPL 002668 , APPDESC 002669 , APPCDOM 002670 , APPCAPP 002671 , APPDCREA 002672 , APPDDELE 002673 , APPUCREA 002674 , APPSYNON 002675 , APPSECTEUR 002676 FROM APP 002677 ORDER BY 002678 APPCDOM 002679 , APPCAPP 002680 cdAP00 end-exec. 002681 cdAP00* 002682 cdAP00*<<< Ne pas accéder directement à ce code, utiliser OUVRIR-AP >>> 002683 cdAP00 OUVRIR-AP-SQL SECTION. 002684 cdAP00*^^sqlavouv * compléter les lignes ci-dessous * 002685 cdAP00 exec sql 002686 cdAP00 OPEN AP-CURSOR 002687 cdAP00 end-exec EXT 002688 cdAP00*^^sqlapouv * compléter les lignes ci-dessous * 002689 cdAP00 continue. 002690 cdAP00 OUVRIR-AP-SQL-FN. 002691 cdAP00 exit section. 002692 cdAP00* 002693 cdAP00*<<< Ne pas accéder directement à ce code, utiliser LIRE-AP >>> 002694 cdAP00 LIRE-AP-SQL SECTION. 002695 cdAP00*^^sqlavlec * compléter les lignes ci-dessous * 002696 cdAP00 exec sql 002697 cdAP00 FETCH 002698 cdAP00 --^^fetch * compléter les lignes ci-dessous * 002699 cdAP00 FROM AP-CURSOR 002700 cdAP00 --^^into * compléter les lignes ci-dessous * 002701 INTO -- liste des hosts-variables 002702 :AP00-COSGA1 :V-AP00-COSGA1 311 333 002703 , :AP00-LNSGAP :V-AP00-LNSGAP 313 334 002704 , :AP00-COSGDP :V-AP00-COSGDP 317 335 002705 , :AP00-LCSGAP :V-AP00-LCSGAP 319 336 002706 , :AP00-DISGCA :V-AP00-DISGCA 321 337 002707 , :AP00-DISGSU :V-AP00-DISGSU 323 338 002708 , :AP00-DISGMJ :V-AP00-DISGMJ 325 339 002709 , :AP00-COSGSN :V-AP00-COSGSN 327 340 002710 , :AP00-COSGSE :V-AP00-COSGSE 329 341 002711 cdAP00 end-exec EXT 002712 cdAP00*^^sqlaplec * compléter les lignes ci-dessous * 002713 cdAP00 continue. 002714 cdAP00 LIRE-AP-SQL-FN. 002715 cdAP00 exit section. 002716 cdAP00* 002717 cdAP00*<<< Ne pas accéder directement à ce code, utiliser FERMER-AP >>> 002718 cdAP00 FERMER-AP-SQL SECTION. 002719 cdAP00*^^sqlavfer * compléter les lignes ci-dessous * 002720 cdAP00 exec sql 002721 cdAP00 CLOSE AP-CURSOR 002722 cdAP00 end-exec EXT 002723 cdAP00*^^sqlapfer * compléter les lignes ci-dessous * 002724 cdAP00 continue. 002725 cdAP00 FERMER-AP-SQL-FN. 002726 cdAP00 exit section. 002727 cdDM00* 002728 cdDM00*--- Gestion Accès DM -------------------------------------------- 002729 cdDM00 >>define AA-A-ACCES as 'L' 002730 cdDM00 >>define AA-A-MODE as 'S' 002731 cdDM00 >>define AA-A-ORG as '2' 002732 cdDM00 >>define AA-A-NR as 0 002733 cdDM00 >>define AA-A-NS as 1 002734 cdDM00*^^accavap * compléter les lignes ci-dessous * 002735 cdDM00 copy AAAPACCE replacing 002736 cdDM00 ==:DD:== by ==DM== 002737 cdDM00 ==:PREF:== by ==DM00== 002738 cdDM00 ==:NS:== by ==1== 002739 cdDM00 ==:K1:== by ==COSGDP== 002740 cdDM00 . ==002741==> IGYPS0040-I Printing of the source code has been suppressed. 002853C >>evaluate AA-A-ACCES AAAPACCE 002854C >>when 'L' *> Lecture seule AAAPACCE 002855C copy AAA5L000. AAAPACCE 002856C >>evaluate AA-A-MODE AAA5L000 002857C >>when 'S' *> Lecture séquentielle AAA5L000 002858C copy AAA5LS00. AAA5L000 002859C >>evaluate true AAA5LS00 002860C >>when AA-A-NR <= 0 and AA-A-NS = 0 *> sans Rupt ni Sync AAA5LS00 002864C >>when AA-A-NR = 0 and AA-A-NS > 0 *> sans Rupt avec Sync AAA5LS00 002865C copy AAA5LSSY. AAA5LS00 002866C *>****************************************************************AAA5LSSY 002867C *> Accès logiques Lecture Séquentielle sans Rupture avec Synchro AAA5LSSY 002868C *>****************************************************************AAA5LSSY 002869C *> AAA5LSSY 002870C OUVRIR-DM SECTION. AAA5LSSY 002871C perform OUVRIR-DM-PHYSIQUE. AAA5LSSY 3027 002872C OUVRIR-DM-FN. AAA5LSSY 002873C exit section. AAA5LSSY 002874C *> AAA5LSSY 002875C LIRE-DM SECTION. AAA5LSSY 002876C set DM-LU to false AAA5LSSY 918 002877C >>define L_ as b'1' AAA5LSSY 002878C >>evaluate true AAA5LSSY 002879C >>when AA-A-MAXNR <= 0 AAA5LSSY 002885C >>end-evaluate AAA5LSSY 002886C *>>if maxNR > 0 and NS <= maxNR and NR < NS AAA5LSSY 002887C >>if L_ AAA5LSSY 002888C if RTD1 not = '1' or DM-CF1 not = '1' AAA5LSSY 1482 952 002889C >>else AAA5LSSY 002891C >>end-if AAA5LSSY 002892C >>define L_ off AAA5LSSY 002893C 1 exit section AAA5LSSY 002894C end-if AAA5LSSY 002895C perform LIRE-DM-PHYSIQUE AAA5LSSY 3043 002896C if DM-FT = '1' AAA5LSSY 1616 002897C 1 move high-value to DMIND AAA5LSSY IMP 978 002898C 1 exit section AAA5LSSY 002899C end-if AAA5LSSY 002900C perform ALIMENTER-CLE-DM AAA5LSSY 2912 002901C add 1 to 5-DM00-CPTENR. AAA5LSSY 911 002902C LIRE-DM-FN. AAA5LSSY 002903C exit section. AAA5LSSY 002904C *> AAA5LSSY 002905C FERMER-DM SECTION. AAA5LSSY 002906C perform FERMER-DM-PHYSIQUE. AAA5LSSY 3063 002907C FERMER-DM-FN. AAA5LSSY 002908C exit section. AAA5LSSY 002909C copy AAA5L0SY. AAA5LSSY 002910C copy AAA5L0IN. AAA5L0SY 002911C *> AAA5L0IN 002912C ALIMENTER-CLE-DM SECTION. AAA5L0IN 002913C move DM00-COSGDP to DM-IN-COSGDP AAA5L0IN 378 980 002914C >>if AA-A-NS > 1 AAA5L0IN 002937C >>end-if AAA5L0IN 002938C . AAA5L0IN 002939C ALIMENTER-CLE-DM-FN. AAA5L0IN 002940C exit section. AAA5L0IN 002941C *> AAA5L0SY 002942C CALCULER-CLE-DM SECTION. AAA5L0SY 002943C if DMIND < TIND1 AAA5L0SY 978 1577 002944C 1 move high-value to IND AAA5L0SY IMP 1542 002945C 1 move DMIND to TIND1 AAA5L0SY 978 1577 002946C end-if. AAA5L0SY 002947C CALCULER-CLE-DM-FN. AAA5L0SY 002948C exit section. AAA5L0SY 002949C *> AAA5L0SY 002950C CALCULER-CONF-DM SECTION. AAA5L0SY 002951C move all '0' to DM-CF AAA5L0SY 951 002952C move 0 to DM-NCF AAA5L0SY 949 002953C if DMIND1 = IND1 AAA5L0SY 979 1543 002954C 1 move '1' to DM-CF1 AAA5L0SY 952 002955C 1 move 1 to DM-NCF AAA5L0SY 949 002956C >>if AA-A-NS > 1 AAA5L0SY 003003C >>end-if AAA5L0SY 003004C end-if AAA5L0SY 003005C if DM-NCF > MAX-CF AAA5L0SY 949 1604 003006C 1 move DM-NCF to MAX-CF AAA5L0SY 949 1604 003007C end-if. AAA5L0SY 003008C CALCULER-CONF-DM-FN. AAA5L0SY 003009C exit section. AAA5L0SY 003010C >>when other *> avec Rupt et Sync AAA5LS00 003012C >>end-evaluate AAA5LS00 003013C >>evaluate AA-A-ORG AAA5LS00 003014C >>when 'F' *> Fichier Séquentiel AAA5LS00 003016C >>when '2' *> Accès Db2 AAA5LS00 003017C copy AAA5LS20. AAA5LS00 003018C *>****************************************************************AAA5LS20 003019C *> Accès physiques Lecture Séquentielle (curseur) Db2. AAA5LS20 003020C *> Les ordres SQL doivent être codés directement dans le AAA5LS20 003021C *> programme : AAA5LS20 003022C *> - OUVRIR-
-SQL : ordre OPEN CURSOR AAA5LS20 003023C *> - LIRE-
-SQL : ordre FETCH CURSOR AAA5LS20 003024C *> - FERMER-
-SQL : ordre CLOSE CURSOR AAA5LS20 003025C *>****************************************************************AAA5LS20 003026C *> AAA5LS20 003027C OUVRIR-DM-PHYSIQUE SECTION. AAA5LS20 003028C move '1' to IK AAA5LS20 1661 003029C perform OUVRIR-DM-SQL AAA5LS20 3156 003030C move '0' to IK AAA5LS20 1661 003031C set DM-OUVERT to true AAA5LS20 927 003032C >>evaluate true AAA5LS20 003033C >>when AA-A-NR = 0 AAA5LS20 003034C move '0' to DM-FT. AAA5LS20 1616 003035C >>when AA-A-NR > 0 AAA5LS20 003039C >>end-evaluate AAA5LS20 003040C OUVRIR-DM-PHYSIQUE-FN. AAA5LS20 003041C exit section. AAA5LS20 003042C *> AAA5LS20 003043C LIRE-DM-PHYSIQUE SECTION. AAA5LS20 003044C move '1' to IK AAA5LS20 1661 003045C perform LIRE-DM-SQL AAA5LS20 3167 003046C evaluate true AAA5LS20 003047C when SQLCODE = +100 AAA5LS20 1398 003048C >>evaluate true AAA5LS20 003049C >>when AA-A-NR = 0 AAA5LS20 003050C 1 move '1' to DM-FT AAA5LS20 1616 003051C >>when AA-A-NR > 0 AAA5LS20 003055C >>end-evaluate AAA5LS20 003056C when SQLCODE >= 0 AAA5LS20 1398 003057C 1 set DM-LU to true AAA5LS20 918 003058C 1 move '0' to IK AAA5LS20 1661 003059C end-evaluate. AAA5LS20 003060C LIRE-DM-PHYSIQUE-FN. AAA5LS20 003061C exit section. AAA5LS20 003062C *> AAA5LS20 003063C FERMER-DM-PHYSIQUE SECTION. AAA5LS20 003064C perform FERMER-DM-SQL AAA5LS20 3187 003065C set DM-OUVERT to false AAA5LS20 927 003066C >>evaluate true AAA5LS20 003067C >>when AA-A-NR = 0 AAA5LS20 003068C move '1' to DM-FT. AAA5LS20 1616 003069C >>when AA-A-NR > 0 AAA5LS20 003073C >>end-evaluate AAA5LS20 003074C FERMER-DM-PHYSIQUE-FN. AAA5LS20 003075C exit section. AAA5LS20 003076C >>when 'K' *> Fichier VSAM KSDS AAA5LS00 003091C >>end-evaluate AAA5LS00 003092C >>when 'R' *> Lecture directe AAA5L000 003103C >>end-evaluate AAA5L000 003104C >>when 'E' *> Ecriture seule AAAPACCE 003127C >>end-evaluate AAAPACCE ==003128==> IGYPS0040-I Printing of the source code has been suppressed. 003136 cdDM00* 003137 cdDM00*--- Lecture séquentielle Table ADM - Ressource DM 003138 cdDM00* 003139 cdDM00 exec sql 003140 cdDM00 DECLARE DM-CURSOR 003141 cdDM00 --^^cursor * compléter les lignes ci-dessous * 003142 CURSOR 003143 FOR 003144 SELECT -- liste des colonnes 003145 ADMNAME 003146 , ADMDESC 003147 , ADMCODE 003148 , ADMCREA 003149 , ADMDELE 003150 FROM ADM 003151 ORDER BY 003152 ADMCODE 003153 cdDM00 end-exec. 003154 cdDM00* 003155 cdDM00*<<< Ne pas accéder directement à ce code, utiliser OUVRIR-DM >>> 003156 cdDM00 OUVRIR-DM-SQL SECTION. 003157 cdDM00*^^sqlavouv * compléter les lignes ci-dessous * 003158 cdDM00 exec sql 003159 cdDM00 OPEN DM-CURSOR 003160 cdDM00 end-exec EXT 003161 cdDM00*^^sqlapouv * compléter les lignes ci-dessous * 003162 cdDM00 continue. 003163 cdDM00 OUVRIR-DM-SQL-FN. 003164 cdDM00 exit section. 003165 cdDM00* 003166 cdDM00*<<< Ne pas accéder directement à ce code, utiliser LIRE-DM >>> 003167 cdDM00 LIRE-DM-SQL SECTION. 003168 cdDM00*^^sqlavlec * compléter les lignes ci-dessous * 003169 cdDM00 exec sql 003170 cdDM00 FETCH 003171 cdDM00 --^^fetch * compléter les lignes ci-dessous * 003172 cdDM00 FROM DM-CURSOR 003173 cdDM00 --^^into * compléter les lignes ci-dessous * 003174 INTO -- liste des hosts-variables 003175 :DM00-COSGDM :V-DM00-COSGDM 374 386 003176 , :DM00-LNSGDM :V-DM00-LNSGDM 376 387 003177 , :DM00-COSGDP :V-DM00-COSGDP 378 388 003178 , :DM00-DISGCA :V-DM00-DISGCA 380 389 003179 , :DM00-DISGSU :V-DM00-DISGSU 382 390 003180 cdDM00 end-exec EXT 003181 cdDM00*^^sqlaplec * compléter les lignes ci-dessous * 003182 cdDM00 continue. 003183 cdDM00 LIRE-DM-SQL-FN. 003184 cdDM00 exit section. 003185 cdDM00* 003186 cdDM00*<<< Ne pas accéder directement à ce code, utiliser FERMER-DM >>> 003187 cdDM00 FERMER-DM-SQL SECTION. 003188 cdDM00*^^sqlavfer * compléter les lignes ci-dessous * 003189 cdDM00 exec sql 003190 cdDM00 CLOSE DM-CURSOR 003191 cdDM00 end-exec EXT 003192 cdDM00*^^sqlapfer * compléter les lignes ci-dessous * 003193 cdDM00 continue. 003194 cdDM00 FERMER-DM-SQL-FN. 003195 cdDM00 exit section. 003196 cdS100* 003197 cdS100*--- Gestion Accès S1 -------------------------------------------- 003198 cdS100 >>define AA-A-ACCES as 'E' 003199 cdS100 >>define AA-A-MODE as 'S' 003200 cdS100 >>define AA-A-ORG as 'F' 003201 cdS100 >>define AA-A-NR as 0 003202 cdS100 >>define AA-A-NS as 0 003203 cdS100*^^accavap * compléter les lignes ci-dessous * 003204 cdS100 copy AAAPACCE replacing 003205 cdS100 ==:DD:== by ==S1== 003206 cdS100 ==:PREF:== by ==S100== 003207 cdS100 ==:NS:== by ==0== 003208 cdS100 . ==003209==> IGYPS0040-I Printing of the source code has been suppressed. 003321C >>evaluate AA-A-ACCES AAAPACCE 003322C >>when 'L' *> Lecture seule AAAPACCE 003324C >>when 'E' *> Ecriture seule AAAPACCE 003325C copy AAA5E000. AAAPACCE 003326C >>evaluate AA-A-MODE AAA5E000 003327C >>when 'S' *> Ecriture séquentielle AAA5E000 003328C copy AAA5ES00. AAA5E000 003329C copy AAA5ESNN. AAA5ES00 003330C *>****************************************************************AAA5ESNN 003331C *> Accès logiques Ecriture Séquentielle AAA5ESNN 003332C *>****************************************************************AAA5ESNN 003333C *> AAA5ESNN 003334C OUVRIR-S1 SECTION. AAA5ESNN 003335C perform OUVRIR-S1-PHYSIQUE. AAA5ESNN 3375 003336C OUVRIR-S1-FN. AAA5ESNN 003337C exit section. AAA5ESNN 003338C *> AAA5ESNN 003339C ECRIRE-S1 SECTION. AAA5ESNN 003340C perform ECRIRE-S1-PHYSIQUE. AAA5ESNN 3380 003341C ECRIRE-S1-FN. AAA5ESNN 003342C exit section. AAA5ESNN 003343C *> AAA5ESNN 003344C FERMER-S1 SECTION. AAA5ESNN 003345C perform FERMER-S1-PHYSIQUE. AAA5ESNN 3386 003346C FERMER-S1-FN. AAA5ESNN 003347C exit section. AAA5ESNN 003348C >>evaluate AA-A-ORG AAA5ES00 003349C >>when 'F' *> Fichier Séquentiel AAA5ES00 003350C copy AAA5ESF0. AAA5ES00 ==003351==> IGYPS0040-I Printing of the source code has been suppressed. 003371C *>****************************************************************AAA5ESF0 003372C *> Accès physiques Ecriture Séquentielle Fichier Séquentiel AAA5ESF0 003373C *>****************************************************************AAA5ESF0 003374C *> AAA5ESF0 003375C OUVRIR-S1-PHYSIQUE SECTION. AAA5ESF0 003376C open output S1-FICHIER. AAA5ESF0 136 003377C OUVRIR-S1-PHYSIQUE-FN. AAA5ESF0 003378C exit section. AAA5ESF0 003379C *> AAA5ESF0 003380C ECRIRE-S1-PHYSIQUE SECTION. AAA5ESF0 003381C write S100 AAA5ESF0 151 003382C add 1 to 5-S100-CPTENR. AAA5ESF0 1163 003383C ECRIRE-S1-PHYSIQUE-FN. AAA5ESF0 003384C exit section. AAA5ESF0 003385C *> AAA5ESF0 003386C FERMER-S1-PHYSIQUE SECTION. AAA5ESF0 003387C close S1-FICHIER. AAA5ESF0 136 003388C FERMER-S1-PHYSIQUE-FN. AAA5ESF0 003389C exit section. AAA5ESF0 003390C >>when '2' *> Accès Db2 AAA5ES00 003413C >>end-evaluate AAA5ES00 003414C >>when 'R' *> Ecriture directe AAA5E000 003425C >>end-evaluate AAA5E000 003426C >>when 'M' *> Création Modification Suppression AAAPACCE 003447C >>end-evaluate AAAPACCE ==003448==> IGYPS0040-I Printing of the source code has been suppressed. 003456 cdS200* 003457 cdS200*--- Gestion Accès S2 -------------------------------------------- 003458 cdS200 >>define AA-A-ACCES as 'E' 003459 cdS200 >>define AA-A-MODE as 'S' 003460 cdS200 >>define AA-A-ORG as 'F' 003461 cdS200 >>define AA-A-NR as 0 003462 cdS200 >>define AA-A-NS as 0 003463 cdS200*^^accavap * compléter les lignes ci-dessous * 003464 cdS200 copy AAAPACCE replacing 003465 cdS200 ==:DD:== by ==S2== 003466 cdS200 ==:PREF:== by ==S200== 003467 cdS200 ==:NS:== by ==0== 003468 cdS200 . ==003469==> IGYPS0040-I Printing of the source code has been suppressed. 003581C >>evaluate AA-A-ACCES AAAPACCE 003582C >>when 'L' *> Lecture seule AAAPACCE 003584C >>when 'E' *> Ecriture seule AAAPACCE 003585C copy AAA5E000. AAAPACCE 003586C >>evaluate AA-A-MODE AAA5E000 003587C >>when 'S' *> Ecriture séquentielle AAA5E000 003588C copy AAA5ES00. AAA5E000 003589C copy AAA5ESNN. AAA5ES00 003590C *>****************************************************************AAA5ESNN 003591C *> Accès logiques Ecriture Séquentielle AAA5ESNN 003592C *>****************************************************************AAA5ESNN 003593C *> AAA5ESNN 003594C OUVRIR-S2 SECTION. AAA5ESNN 003595C perform OUVRIR-S2-PHYSIQUE. AAA5ESNN 3635 003596C OUVRIR-S2-FN. AAA5ESNN 003597C exit section. AAA5ESNN 003598C *> AAA5ESNN 003599C ECRIRE-S2 SECTION. AAA5ESNN 003600C perform ECRIRE-S2-PHYSIQUE. AAA5ESNN 3640 003601C ECRIRE-S2-FN. AAA5ESNN 003602C exit section. AAA5ESNN 003603C *> AAA5ESNN 003604C FERMER-S2 SECTION. AAA5ESNN 003605C perform FERMER-S2-PHYSIQUE. AAA5ESNN 3646 003606C FERMER-S2-FN. AAA5ESNN 003607C exit section. AAA5ESNN 003608C >>evaluate AA-A-ORG AAA5ES00 003609C >>when 'F' *> Fichier Séquentiel AAA5ES00 003610C copy AAA5ESF0. AAA5ES00 ==003611==> IGYPS0040-I Printing of the source code has been suppressed. 003631C *>****************************************************************AAA5ESF0 003632C *> Accès physiques Ecriture Séquentielle Fichier Séquentiel AAA5ESF0 003633C *>****************************************************************AAA5ESF0 003634C *> AAA5ESF0 003635C OUVRIR-S2-PHYSIQUE SECTION. AAA5ESF0 003636C open output S2-FICHIER. AAA5ESF0 160 003637C OUVRIR-S2-PHYSIQUE-FN. AAA5ESF0 003638C exit section. AAA5ESF0 003639C *> AAA5ESF0 003640C ECRIRE-S2-PHYSIQUE SECTION. AAA5ESF0 003641C write S200 AAA5ESF0 175 003642C add 1 to 5-S200-CPTENR. AAA5ESF0 1329 003643C ECRIRE-S2-PHYSIQUE-FN. AAA5ESF0 003644C exit section. AAA5ESF0 003645C *> AAA5ESF0 003646C FERMER-S2-PHYSIQUE SECTION. AAA5ESF0 003647C close S2-FICHIER. AAA5ESF0 160 003648C FERMER-S2-PHYSIQUE-FN. AAA5ESF0 003649C exit section. AAA5ESF0 003650C >>when '2' *> Accès Db2 AAA5ES00 003673C >>end-evaluate AAA5ES00 003674C >>when 'R' *> Ecriture directe AAA5E000 003685C >>end-evaluate AAA5E000 003686C >>when 'M' *> Création Modification Suppression AAAPACCE 003707C >>end-evaluate AAAPACCE ==003708==> IGYPS0040-I Printing of the source code has been suppressed. 003716 sqpaf *> *> zone injection fin <* <* 003717 sqpaf *--- Fin accès ressources ---------------------------------------- 003718 sqpaq ACCESS-RESSOURCES-FN. 003719 sqpaq exit section. 003720 sqpaq 003721 sqpv /================================================================= 003722 sqpv * SSSS EEEEE RRRR V V IIIII CCC EEEEE SSSS 003723 sqpv * S E R R V V I C C E S 003724 sqpv * SSS EEEE RRRR V V I C EEEE SSS 003725 sqpv * S E R R V V I C C E S 003726 sqpv * SSSS EEEEE R R V IIIII CCC EEEEE SSSS 003727 sqpv *================================================================= 003728 sqpv SERVICES-FRAMEWORK SECTION. 003729 sqpv continue. 003730 sqpv *--- Gestion des opérations sur dates et heures ------------------ 003731 sqpv copy ADAPDATE. ==003732==> IGYPS0040-I Printing of the source code has been suppressed. 003770C *> ADAPDATE 003771C *> TRANSFORMATION DATE FORMAT C : JJMMSSAA ADAPDATE 003772C CONVERTIR-DE-DATE-C SECTION. ADAPDATE 003773C move DD of 5-DATE-C to DD of 5-DATE-S ADAPDATE 1756 1755 1804 1797 003774C move MM of 5-DATE-C to MM of 5-DATE-S ADAPDATE 1757 1755 1803 1797 003775C move YYYY of 5-DATE-C to YYYY of 5-DATE-S. ADAPDATE 1758 1755 1798 1797 003776C CONVERTIR-DE-DATE-C-FN. ADAPDATE 003777C exit section. ADAPDATE 003778C CONVERTIR-VERS-DATE-C SECTION. ADAPDATE 003779C move DD of 5-DATE-S to DD of 5-DATE-C ADAPDATE 1804 1797 1756 1755 003780C move MM of 5-DATE-S to MM of 5-DATE-C ADAPDATE 1803 1797 1757 1755 003781C move YYYY of 5-DATE-S to YYYY of 5-DATE-C. ADAPDATE 1798 1797 1758 1755 003782C CONVERTIR-VERS-DATE-C-FN. ADAPDATE 003783C exit section. ADAPDATE 003784C *> ADAPDATE 003785C *> TRANSFORMATION DATE FORMAT D : JJMMAA ADAPDATE 003786C CONVERTIR-DE-DATE-D SECTION. ADAPDATE 003787C move DD of 5-DATE-D to DD of 5-DATE-S ADAPDATE 1763 1762 1804 1797 003788C move MM of 5-DATE-D to MM of 5-DATE-S ADAPDATE 1764 1762 1803 1797 003789C move YY of 5-DATE-D to YY of 5-DATE-S ADAPDATE 1765 1762 1801 1797 003790C perform DEFINIR-SIECLE. ADAPDATE 3875 003791C CONVERTIR-DE-DATE-D-FN. ADAPDATE 003792C exit section. ADAPDATE 003793C CONVERTIR-VERS-DATE-D SECTION. ADAPDATE 003794C move DD of 5-DATE-S to DD of 5-DATE-D ADAPDATE 1804 1797 1763 1762 003795C move MM of 5-DATE-S to MM of 5-DATE-D ADAPDATE 1803 1797 1764 1762 003796C move YY of 5-DATE-S to YY of 5-DATE-D. ADAPDATE 1801 1797 1765 1762 003797C CONVERTIR-VERS-DATE-D-FN. ADAPDATE 003798C exit section. ADAPDATE 003799C *> ADAPDATE 003800C *> TRANSFORMATION DATE FORMAT E : JJ/MM/AA ADAPDATE 003801C CONVERTIR-DE-DATE-E SECTION. ADAPDATE 003802C move DD of 5-DATE-E to DD of 5-DATE-S ADAPDATE 1768 1767 1804 1797 003803C move MM of 5-DATE-E to MM of 5-DATE-S ADAPDATE 1770 1767 1803 1797 003804C move YY of 5-DATE-E to YY of 5-DATE-S ADAPDATE 1772 1767 1801 1797 003805C perform DEFINIR-SIECLE. ADAPDATE 3875 003806C CONVERTIR-DE-DATE-E-FN. ADAPDATE 003807C exit section. ADAPDATE 003808C CONVERTIR-VERS-DATE-E SECTION. ADAPDATE 003809C move DD of 5-DATE-S to DD of 5-DATE-E ADAPDATE 1804 1797 1768 1767 003810C move MM of 5-DATE-S to MM of 5-DATE-E ADAPDATE 1803 1797 1770 1767 003811C move YY of 5-DATE-S to YY of 5-DATE-E ADAPDATE 1801 1797 1772 1767 003812C move DATSEP to S1 of 5-DATE-E ADAPDATE 1742 1769 1767 003813C S2 of 5-DATE-E. ADAPDATE 1771 1767 003814C CONVERTIR-VERS-DATE-E-FN. ADAPDATE 003815C exit section. ADAPDATE 003816C *> ADAPDATE 003817C *> TRANSFORMATION DATE FORMAT G : SSAA-MM-JJ ADAPDATE 003818C CONVERTIR-DE-DATE-G SECTION. ADAPDATE 003819C move DD of 5-DATE-G to DD of 5-DATE-S ADAPDATE 1781 1774 1804 1797 003820C move MM of 5-DATE-G to MM of 5-DATE-S ADAPDATE 1779 1774 1803 1797 003821C move YYYY of 5-DATE-G to YYYY of 5-DATE-S. ADAPDATE 1775 1774 1798 1797 003822C CONVERTIR-DE-DATE-G-FN. ADAPDATE 003823C exit section. ADAPDATE 003824C CONVERTIR-VERS-DATE-G SECTION. ADAPDATE 003825C move DD of 5-DATE-S to DD of 5-DATE-G ADAPDATE 1804 1797 1781 1774 003826C move MM of 5-DATE-S to MM of 5-DATE-G ADAPDATE 1803 1797 1779 1774 003827C move YYYY of 5-DATE-S to YYYY of 5-DATE-G ADAPDATE 1798 1797 1775 1774 003828C move DATSET to S1 of 5-DATE-G ADAPDATE 1744 1778 1774 003829C S2 of 5-DATE-G. ADAPDATE 1780 1774 003830C CONVERTIR-VERS-DATE-G-FN. ADAPDATE 003831C exit section. ADAPDATE 003832C *> ADAPDATE 003833C *> TRANSFORMATION DATE FORMAT I : AAMMJJ ADAPDATE 003834C CONVERTIR-DE-DATE-I SECTION. ADAPDATE 003835C move DD of 5-DATE-I to DD of 5-DATE-S ADAPDATE 1786 1783 1804 1797 003836C move MM of 5-DATE-I to MM of 5-DATE-S ADAPDATE 1785 1783 1803 1797 003837C move YY of 5-DATE-I to YY of 5-DATE-S ADAPDATE 1784 1783 1801 1797 003838C perform DEFINIR-SIECLE. ADAPDATE 3875 003839C CONVERTIR-DE-DATE-I-FN. ADAPDATE 003840C exit section. ADAPDATE 003841C CONVERTIR-VERS-DATE-I SECTION. ADAPDATE 003842C move DD of 5-DATE-S to DD of 5-DATE-I ADAPDATE 1804 1797 1786 1783 003843C move MM of 5-DATE-S to MM of 5-DATE-I ADAPDATE 1803 1797 1785 1783 003844C move YY of 5-DATE-S to YY of 5-DATE-I. ADAPDATE 1801 1797 1784 1783 003845C CONVERTIR-VERS-DATE-I-FN. ADAPDATE 003846C exit section. ADAPDATE 003847C *> ADAPDATE 003848C *> TRANSFORMATION DATE FORMAT M : JJ/MM/SSAA ADAPDATE 003849C CONVERTIR-DE-DATE-M SECTION. ADAPDATE 003850C move DD of 5-DATE-M to DD of 5-DATE-S ADAPDATE 1789 1788 1804 1797 003851C move MM of 5-DATE-M to MM of 5-DATE-S ADAPDATE 1791 1788 1803 1797 003852C move YYYY of 5-DATE-M to YYYY of 5-DATE-S. ADAPDATE 1793 1788 1798 1797 003853C CONVERTIR-DE-DATE-M-FN. ADAPDATE 003854C exit section. ADAPDATE 003855C CONVERTIR-VERS-DATE-M SECTION. ADAPDATE 003856C move DD of 5-DATE-S to DD of 5-DATE-M ADAPDATE 1804 1797 1789 1788 003857C move MM of 5-DATE-S to MM of 5-DATE-M ADAPDATE 1803 1797 1791 1788 003858C move YYYY of 5-DATE-S to YYYY of 5-DATE-M ADAPDATE 1798 1797 1793 1788 003859C move DATSEP to S1 of 5-DATE-M ADAPDATE 1742 1790 1788 003860C S2 of 5-DATE-M. ADAPDATE 1792 1788 003861C CONVERTIR-VERS-DATE-M-FN. ADAPDATE 003862C exit section. ADAPDATE 003863C *> ADAPDATE 003864C *> TRANSFORMATION DATE FORMAT S : SSAAMMJJ ADAPDATE 003865C CONVERTIR-DE-DATE-S SECTION. ADAPDATE 003866C continue. ADAPDATE 003867C CONVERTIR-DE-DATE-S-FN. ADAPDATE 003868C exit section. ADAPDATE 003869C CONVERTIR-VERS-DATE-S SECTION. ADAPDATE 003870C continue. ADAPDATE 003871C CONVERTIR-VERS-DATE-S-FN. ADAPDATE 003872C exit section. ADAPDATE 003873C *> ADAPDATE 003874C *> ALIMENTATION DU SIECLE SUR DATE SANS SIECLE ADAPDATE 003875C DEFINIR-SIECLE SECTION. ADAPDATE 003876C evaluate true also true ADAPDATE 003877C when not 5-DATE-1900-AVANT and not 5-DATE-2000-AVANT ADAPDATE 1815 1816 003878C also any ADAPDATE 003879C 1 move 5-DATE-SIECLE to CC of 5-DATE-S ADAPDATE 1812 1799 1797 003880C when 5-DATE-1900-AVANT also YY in 5-DATE-S < 5-DATE-PIVOT ADAPDATE 1815 1801 1797 1811 003881C when 5-DATE-2000-AVANT also YY in 5-DATE-S >= 5-DATE-PIVOT ADAPDATE 1816 1801 1797 1811 003882C 1 move '19' to CC of 5-DATE-S ADAPDATE 1799 1797 003883C when other ADAPDATE 003884C 1 move '20' to CC of 5-DATE-S ADAPDATE 1799 1797 003885C end-evaluate. ADAPDATE 003886C DEFINIR-SIECLE-FN. ADAPDATE 003887C exit section. ADAPDATE 003888C *> ADAPDATE 003889C *> VALIDATION D'UNE DATE ADAPDATE 003890C VALIDER-DATE SECTION. ADAPDATE 003891C *> --- par défaut, date invalide ADAPDATE 003892C set 5-DATE-INVALIDE to true ADAPDATE 1670 003893C evaluate true ADAPDATE 003894C *> --- conditions invalidité de la date ADAPDATE 003895C when 5-DATE-S not numeric ADAPDATE 1797 003896C when MM in 5-DATE-S < '01' or > '12' ADAPDATE 1803 1797 003897C when DD in 5-DATE-S < '01' or > '31' ADAPDATE 1804 1797 003898C when DD in 5-DATE-S > '30' and (MM in 5-DATE-S = '04' ADAPDATE 1804 1797 1803 1797 003899C or '06' ADAPDATE 003900C or '09' ADAPDATE 003901C or '11') ADAPDATE 003902C when DD in 5-DATE-S > '29' and MM in 5-DATE-S = '02' ADAPDATE 1804 1797 1803 1797 003903C 1 exit section ADAPDATE 003904C *> --- calcul année bissextile sur 29/02 ADAPDATE 003905C when MM in 5-DATE-S = '02' and DD in 5-DATE-S = '29' ADAPDATE 1803 1797 1804 1797 003906C *> --- siecle mutiple de 400 bissextile ADAPDATE 003907C 1 if YY in 5-DATE-S = '00' ADAPDATE 1801 1797 003908C 2 compute 5-DATE-M4 = CC9 in 5-DATE-S / 4 ADAPDATE 1828 1800 1797 ==003908==> 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. 003909C 2 compute 5-DATE-M4 = CC9 in 5-DATE-S - 5-DATE-M4 * 4 ADAPDATE 1828 1800 1797 1828 ==003909==> 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. 003910C *> --- année multiple de 4 bissextile ADAPDATE 003911C 1 else ADAPDATE 003912C 2 compute 5-DATE-M4 = YY9 in 5-DATE-S / 4 ADAPDATE 1828 1802 1797 ==003912==> 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. 003913C 2 compute 5-DATE-M4 = YY9 in 5-DATE-S - 5-DATE-M4 * 4 ADAPDATE 1828 1802 1797 1828 ==003913==> 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. 003914C 1 end-if ADAPDATE 003915C 1 if 5-DATE-M4 not = 0 ADAPDATE 1828 003916C 2 exit section ADAPDATE 003917C 1 end-if ADAPDATE 003918C end-evaluate ADAPDATE 003919C *> --- si aucune anomalie alors date valide ADAPDATE 003920C set 5-DATE-VALIDE to true. ADAPDATE 1669 003921C VALIDER-DATE-FN. ADAPDATE 003922C exit section. ADAPDATE 003923C *> ADAPDATE 003924C *> DATE FORMAT I VERS D (ADI : AAMMJJ --> JJMMAA) ADAPDATE 003925C INVERSER-DATE-I SECTION. ADAPDATE 003926C move DD of 5-DATE-I to DD of 5-DATE-D ADAPDATE 1786 1783 1763 1762 003927C move MM of 5-DATE-I to MM of 5-DATE-D ADAPDATE 1785 1783 1764 1762 003928C move YY of 5-DATE-I to YY of 5-DATE-D. ADAPDATE 1784 1783 1765 1762 003929C INVERSER-DATE-I-FN. ADAPDATE 003930C exit section. ADAPDATE 003931C *> ADAPDATE 003932C *> DATE FORMAT D VERS I (sans équivalent : JJMMAA --> AAMMJJ) ADAPDATE 003933C INVERSER-DATE-D SECTION. ADAPDATE 003934C move DD of 5-DATE-D to DD of 5-DATE-I ADAPDATE 1763 1762 1786 1783 003935C move MM of 5-DATE-D to MM of 5-DATE-I ADAPDATE 1764 1762 1785 1783 003936C move YY of 5-DATE-D to YY of 5-DATE-I. ADAPDATE 1765 1762 1784 1783 003937C INVERSER-DATE-D-FN. ADAPDATE 003938C exit section. ADAPDATE 003939C *> ADAPDATE 003940C *> DATE FORMAT C VERS S (sans équivalent : JJMMSSAA --> SSAAMMJJ) ADAPDATE 003941C INVERSER-DATE-C SECTION. ADAPDATE 003942C move DD of 5-DATE-C to DD of 5-DATE-S ADAPDATE 1756 1755 1804 1797 003943C move MM of 5-DATE-C to MM of 5-DATE-S ADAPDATE 1757 1755 1803 1797 003944C move YYYY of 5-DATE-C to YYYY of 5-DATE-S. ADAPDATE 1758 1755 1798 1797 003945C INVERSER-DATE-C-FN. ADAPDATE 003946C exit section. ADAPDATE 003947C *> ADAPDATE 003948C *> DATE FORMAT S VERS C (ADS : SSAAMMJJ --> JJMMSSAA) ADAPDATE 003949C INVERSER-DATE-S SECTION. ADAPDATE 003950C move DD of 5-DATE-S to DD of 5-DATE-C ADAPDATE 1804 1797 1756 1755 003951C move MM of 5-DATE-S to MM of 5-DATE-C ADAPDATE 1803 1797 1757 1755 003952C move YYYY of 5-DATE-S to YYYY of 5-DATE-C. ADAPDATE 1798 1797 1758 1755 003953C INVERSER-DATE-S-FN. ADAPDATE 003954C exit section. ADAPDATE 003955C *> ADAPDATE 003956C *> DATE FORMAT D VERS E (ADE : JJMMAA --> JJ/MM/AA) ADAPDATE 003957C EDITER-DATE-D SECTION. ADAPDATE 003958C move DD of 5-DATE-D to DD of 5-DATE-E ADAPDATE 1763 1762 1768 1767 003959C move MM of 5-DATE-D to MM of 5-DATE-E ADAPDATE 1764 1762 1770 1767 003960C move YY of 5-DATE-D to YY of 5-DATE-E ADAPDATE 1765 1762 1772 1767 003961C move DATSEP to S1 of 5-DATE-E ADAPDATE 1742 1769 1767 003962C S2 of 5-DATE-E. ADAPDATE 1771 1767 003963C EDITER-DATE-D-FN. ADAPDATE 003964C exit section. ADAPDATE 003965C *> ADAPDATE 003966C *> DATE FORMAT I VERS E (ADF : AAMMJJ --> JJ/MM/AA) ADAPDATE 003967C EDITER-DATE-I SECTION. ADAPDATE 003968C move DD of 5-DATE-I to DD of 5-DATE-E ADAPDATE 1786 1783 1768 1767 003969C move MM of 5-DATE-I to MM of 5-DATE-E ADAPDATE 1785 1783 1770 1767 003970C move YY of 5-DATE-I to YY of 5-DATE-E ADAPDATE 1784 1783 1772 1767 003971C move DATSEP to S1 of 5-DATE-E ADAPDATE 1742 1769 1767 003972C S2 of 5-DATE-E. ADAPDATE 1771 1767 003973C EDITER-DATE-I-FN. ADAPDATE 003974C exit section. ADAPDATE 003975C *> ADAPDATE 003976C *> DATE FORMAT C VERS M (ADM : JJMMSSAA --> JJ/MM/SSAA) ADAPDATE 003977C EDITER-DATE-C SECTION. ADAPDATE 003978C move DD of 5-DATE-C to DD of 5-DATE-M ADAPDATE 1756 1755 1789 1788 003979C move MM of 5-DATE-C to MM of 5-DATE-M ADAPDATE 1757 1755 1791 1788 003980C move YYYY of 5-DATE-C to YYYY of 5-DATE-M ADAPDATE 1758 1755 1793 1788 003981C move DATSEP to S1 of 5-DATE-M ADAPDATE 1742 1790 1788 003982C S2 of 5-DATE-M. ADAPDATE 1792 1788 003983C EDITER-DATE-C-FN. ADAPDATE 003984C exit section. ADAPDATE 003985C *> ADAPDATE 003986C *> DATE FORMAT S VERS M (sans équivalent : SSAAMMJJ --> ADAPDATE 003987C *> JJ/MM/SSAA) ADAPDATE 003988C EDITER-DATE-S SECTION. ADAPDATE 003989C move DD of 5-DATE-S to DD of 5-DATE-M ADAPDATE 1804 1797 1789 1788 003990C move MM of 5-DATE-S to MM of 5-DATE-M ADAPDATE 1803 1797 1791 1788 003991C move YYYY of 5-DATE-S to YYYY of 5-DATE-M ADAPDATE 1798 1797 1793 1788 003992C move DATSEP to S1 of 5-DATE-M ADAPDATE 1742 1790 1788 003993C S2 of 5-DATE-M. ADAPDATE 1792 1788 003994C EDITER-DATE-S-FN. ADAPDATE 003995C exit section. ADAPDATE 003996C *> ADAPDATE 003997C *> HEURE FORMAT EDITION (TIF : HHMMSS --> HH:MM:SS) ADAPDATE 003998C EDITER-HEURE SECTION. ADAPDATE 003999C move HH in 5-TIME to HH in TIMDAY ADAPDATE 1807 1806 1732 1730 004000C move MM in 5-TIME to MM in TIMDAY ADAPDATE 1808 1806 1736 1730 004001C move SS in 5-TIME to SS in TIMDAY ADAPDATE 1809 1806 1740 1730 004002C move TIMSEP to S1 in TIMDAY ADAPDATE 1748 1734 1730 004003C S2 in TIMDAY. ADAPDATE 1738 1730 004004C EDITER-HEURE-FN. ADAPDATE 004005C exit section. ADAPDATE 004006C *> ADAPDATE 004007C *> NOMBRE DE JOURS ENTRE DEUX DATES FORMAT S SSAAMMJJ ADAPDATE 004008C SOUSTRAIRE-DATE SECTION. ADAPDATE 004009C compute NUM-DAYS = function integer-of-date (5-DATE-D1) ADAPDATE 1750 IFN 1818 004010C - function integer-of-date (5-DATE-D2). ADAPDATE IFN 1819 004011C SOUSTRAIRE-DATE-FN. ADAPDATE 004012C exit section. ADAPDATE 004013C *> ADAPDATE 004014C *> DATE FORMAT S +/- N JOURS (DAO S NUM-DAYS 5-DATE-S) ADAPDATE 004015C DECALER-DATE SECTION. ADAPDATE 004016C compute 5-DATE-D1 = ADAPDATE 1818 ==004016==> 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. 004017C function date-of-integer ( ADAPDATE IFN 004018C function integer-of-date (5-DATE-D1) + NUM-DAYS). ADAPDATE IFN 1818 1750 004019C DECALER-DATE-FN. ADAPDATE 004020C exit section. ADAPDATE 004021C >>if AA-G-CICS ADAPDATE 004034C >>end-if ADAPDATE 004035C >>if AA-G-PACBASE ADAPDATE 004037C >>end-if ADAPDATE 004038 sqpvd *> *> zone injection debut <* <* 004039 sqpvf *> *> zone injection fin <* <* 004040 sqpvq *--- Fin services framework -------------------------------------- 004041 sqpvq SERVICES-FRAMEWORK-FN. 004042 sqpvq exit section. 004043 sqpvq 004044 sqpi /================================================================= 004045 sqpi * IIIII N N IIIII TTTTT IIIII AAA L IIIII SSS 004046 sqpi * I NN N I T I A A L I S 004047 sqpi * I N N N I T I AAAAA L I SSS 004048 sqpi * I N NN I T I A A L I S 004049 sqpi * IIIII N N IIIII T IIIII A A LLLLL IIIII SSS 004050 sqpi *================================================================= 004051 sqpi INITIALISATIONS SECTION. 004052 sqpi *--- Trace reco audit -------------------------------------------- 004053 sqpi copy AGAPAUD1. ==004054==> IGYPS0040-I Printing of the source code has been suppressed. 004067C *> AGAPAUD1 004068C *> Tracabilité programme - Reco "Audit Archivage 2010" #5 - Début AGAPAUD1 004069C if RECO-ARCH-2010-5-notRUN AGAPAUD1 1877 004070C 1 set RECO-ARCH-2010-5-notRUN to false AGAPAUD1 1877 004071C *> --- Préparation de la date du jour dans différents formats AGAPAUD1 004072C *> DATCE : SSAAMMJJ AGAPAUD1 004073C 1 move function current-date to DATCE AGAPAUD1 IFN 1701 004074C *> W-BA0C-DASDSY : JJMMSSAA AGAPAUD1 004075C 1 move DATCE (7:2) to W-BA0C-DASDSY (1:2) AGAPAUD1 1701 1870 004076C 1 move DATCE (5:2) to W-BA0C-DASDSY (3:2) AGAPAUD1 1701 1870 004077C 1 move DATCE (1:4) to W-BA0C-DASDSY (5:4) AGAPAUD1 1701 1870 004078C *> W-BA0G-DASDSY : SSAA-MM-JJ AGAPAUD1 004079C 1 move DATCE (1:4) to W-BA0G-DASDSY (1:4) AGAPAUD1 1701 1872 004080C 1 move DATCE (5:2) to W-BA0G-DASDSY (6:2) AGAPAUD1 1701 1872 004081C 1 move DATCE (7:2) to W-BA0G-DASDSY (9:2) AGAPAUD1 1701 1872 004082C 1 move '-' to W-BA0G-DASDSY (5:1) AGAPAUD1 1872 004083C 1 W-BA0G-DASDSY (8:1) AGAPAUD1 1872 004084C *> W-BA0M-DASDSY : JJ/MM/SSAA AGAPAUD1 004085C 1 move DATCE (7:2) to W-BA0M-DASDSY (1:2) AGAPAUD1 1701 1874 004086C 1 move DATCE (5:2) to W-BA0M-DASDSY (4:2) AGAPAUD1 1701 1874 004087C 1 move DATCE (1:4) to W-BA0M-DASDSY (7:4) AGAPAUD1 1701 1874 004088C 1 move '/' to W-BA0M-DASDSY (3:1) AGAPAUD1 1874 004089C 1 W-BA0M-DASDSY (6:1) AGAPAUD1 1874 004090C >>if AA-G-MIXED AGAPAUD1 004093C >>end-if AGAPAUD1 004094C *> --- Message dans la log MVS AGAPAUD1 004095C 1 display 'GCE001I IDENTITE PROGRAMME ' PROGE AGAPAUD1 250 004096C 1 ' (' PROGR ' ' COBASE ' ' APPLI ' ' NUGNA ' ' AGAPAUD1 247 251 245 244 004097C 1 DATGNC ' ' TIMGN ')' upon CONSOLE AGAPAUD1 252 249 004098C *> --- Message début de programme en SYSOUT AGAPAUD1 004099C 1 display PROGE ' - DEBUT PROGRAMME (' PROGR ' ' COBASE ' ' AGAPAUD1 250 247 251 004100C 1 APPLI ' ' NUGNA ' ' DATGNC ' ' TIMGN '), LE ' AGAPAUD1 245 244 252 249 004101C 1 W-BA0M-DASDSY AGAPAUD1 1874 004102C >>if AA-G-MIXED AGAPAUD1 004104C >>end-if AGAPAUD1 004105C end-if AGAPAUD1 004106 sqpid *> *> zone injection debut <* <* 004107 sqpif *> *> zone injection fin <* <* 004108 sqpiq *--- Fin initialisations ----------------------------------------- 004109 sqpiq continue. 004110 sqpiq INITIALISATIONS-FN. 004111 sqpiq exit section. 004112 sqpiw * 004113 sqpiw INITIALISATIONS-WORKING SECTION. 004114 sqpiw set WORKING-INITIALISEES to true 1927 004115 sqpiwd*> *> zone injection debut <* <* 004116 sqpiwf*> *> zone injection fin <* <* 004117 sqpiw9*--- Fin initialisations ----------------------------------------- 004118 sqpiw9 continue. 004119 sqpiw9 INITIALISATIONS-WORKING-FN. 004120 sqpiw9 exit section. 004121 sqpiw9 004122 sqpo /================================================================= 004123 sqpo * OOO U U V V EEEEE RRRR TTTTT U U RRRR EEEEE 004124 sqpo * O O U U V V E R R T U U R R E 004125 sqpo * O O U U V V EEEE RRRR T U U RRRR EEEE 004126 sqpo * O O U U V V E R R T U U R R E 004127 sqpo * OOO UUU V EEEEE R R T UUU R R EEEEE 004128 sqpo *================================================================= 004129 sqpo OUVERTURES SECTION. 004130 sqpod *> *> zone injection debut <* <* 004131 cdAP00* -- Ouverture ressource AP -- 004132 cdAP00*^^ouvavt * compléter les lignes ci-dessous * 004133 cdAP00 perform OUVRIR-AP 2302 004134 cdAP00*^^ouvapr * compléter les lignes ci-dessous * 004135 cdAP00* 004136 cdDM00* -- Ouverture ressource DM -- 004137 cdDM00*^^ouvavt * compléter les lignes ci-dessous * 004138 cdDM00 perform OUVRIR-DM 2870 004139 cdDM00*^^ouvapr * compléter les lignes ci-dessous * 004140 cdDM00* 004141 cdS100* -- Ouverture ressource S1 -- 004142 cdS100*^^ouvavt * compléter les lignes ci-dessous * 004143 cdS100 perform OUVRIR-S1 3334 004144 cdS100*^^ouvapr * compléter les lignes ci-dessous * 004145 cdS100* 004146 cdS200* -- Ouverture ressource S2 -- 004147 cdS200*^^ouvavt * compléter les lignes ci-dessous * 004148 cdS200 perform OUVRIR-S2 3594 004149 cdS200*^^ouvapr * compléter les lignes ci-dessous * 004150 cdS200* 004151 sqpof *> *> zone injection fin <* <* 004152 sqpoq *--- Fin ouvertures ressources ----------------------------------- 004153 sqpoq continue. 004154 sqpoq OUVERTURES-FN. 004155 sqpoq exit section. 004156 sqpoq 004157 sqpl /================================================================= 004158 sqpl * L EEEEE CCC TTTTT U U RRRR EEEEE SSS 004159 sqpl * L E C C T U U R R E S 004160 sqpl * L EEE C T U U RRRR EEEE SSS 004161 sqpl * L E C C T U U R R E S 004162 sqpl * LLLLL EEEEE CCC T UUU R R EEEEE SSS 004163 sqpl *================================================================= 004164 sqpl >>if AA-A-LECTURES 004165 sqpl LECTURES SECTION. 004166 sqplsd*> *> zone injection debut <* <* 004167 cdDM00* -- Lecture ressource DM sans rupture -- 004168 cdDM00*^^liravt * compléter les lignes ci-dessous * 004169 cdDM00 perform LIRE-DM 2875 004170 cdDM00*^^lirapr * compléter les lignes ci-dessous * 004171 cdDM00* 004172 sqplsf*> *> zone injection fin <* <* 004173 sqplrd*> *> zone injection debut <* <* 004174 cdAP00* -- Lecture ressource AP avec ruptures -- 004175 cdAP00*^^liravt * compléter les lignes ci-dessous * 004176 cdAP00 perform LIRE-AP 2308 004177 cdAP00*^^lirapr * compléter les lignes ci-dessous * 004178 cdAP00* 004179 sqplrf*> *> zone injection fin <* <* 004180 sqplq *--- Fin lectures ressources ------------------------------------- 004181 sqplq continue. 004182 sqplq LECTURES-FN. 004183 sqplq exit section. 004184 sqplq >>end-if 004185 sqplq 004186 sqpf /================================================================= 004187 sqpf * FFFFF EEEEE RRRR M M EEEEE TTTTT U U RRRR EEEEE 004188 sqpf * F E R R MM MM E T U U R R E 004189 sqpf * FFFF EEEE RRRR M M M EEEE T U U RRRR EEEE 004190 sqpf * F E R R M M E T U U R R E 004191 sqpf * F EEEEE R R M M EEEEE T UUU R R EEEEE 004192 sqpf *================================================================= 004193 sqpf FERMETURES SECTION. 004194 sqpfd *> *> zone injection debut <* <* 004195 cdAP00* -- Fermeture ressource AP -- 004196 cdAP00*^^feravt * compléter les lignes ci-dessous * 004197 cdAP00 perform FERMER-AP 2343 004198 cdAP00*^^ferapr * compléter les lignes ci-dessous * 004199 cdAP00* 004200 cdDM00* -- Fermeture ressource DM -- 004201 cdDM00*^^feravt * compléter les lignes ci-dessous * 004202 cdDM00 perform FERMER-DM 2905 004203 cdDM00*^^ferapr * compléter les lignes ci-dessous * 004204 cdDM00* 004205 cdS100* -- Fermeture ressource S1 -- 004206 cdS100*^^feravt * compléter les lignes ci-dessous * 004207 cdS100 perform FERMER-S1 3344 004208 cdS100*^^ferapr * compléter les lignes ci-dessous * 004209 cdS100* 004210 cdS200* -- Fermeture ressource S2 -- 004211 cdS200*^^feravt * compléter les lignes ci-dessous * 004212 cdS200 perform FERMER-S2 3604 004213 cdS200*^^ferapr * compléter les lignes ci-dessous * 004214 cdS200* 004215 sqpff *> *> zone injection fin <* <* 004216 sqpfq *--- Fin fermetures ressources ----------------------------------- 004217 sqpfq continue. 004218 sqpfq FERMETURES-FN. 004219 sqpfq exit section. 004220 sqpfq 004221 sqpq /================================================================= 004222 sqpq * FFFFF IIIII N N AAA L IIIII SSSS 004223 sqpq * F I NN N A A L I S 004224 sqpq * FFFF I N N N AAAAA L I SSS 004225 sqpq * F I N NN A A L I S .. 004226 sqpq * F IIIII N N A A LLLLL IIIII SSSS .. 004227 sqpq *================================================================= 004228 sqpq FINALISATION SECTION. 004229 sqpqd *> *> zone injection debut <* <* 004230 sqpqf *> *> zone injection fin <* <* 004231 sqpqt *--- Traçabilité programme (reco audit) -------------------------- 004232 sqpqt copy AGAPAUD2. ==004233==> IGYPS0040-I Printing of the source code has been suppressed. 004246C *> AGAPAUD2 004247C *> Tracabilité programme - Reco "Audit Archivage 2010" #5 - Fin AGAPAUD2 004248C if not RECO-ARCH-2010-5-wasRUN AGAPAUD2 1879 004249C 1 set RECO-ARCH-2010-5-wasRUN to true AGAPAUD2 1879 004250C *> --- Message fin de programme en SYSOUT AGAPAUD2 004251C >>if AA-G-MIXED AGAPAUD2 004253C >>end-if AGAPAUD2 004254C 1 display PROGE ' - FIN PROGRAMME' AGAPAUD2 250 004255C >>if AA-G-MIXED AGAPAUD2 004257C >>end-if AGAPAUD2 004258C end-if AGAPAUD2 004259 sqpqq *--- Fin finalisation -------------------------------------------- 004260 sqpqq continue. 004261 sqpqq FINALISATION-FN. 004262 sqpqq exit section. 004263 sqpqq 004264 sqpr /================================================================= 004265 sqpr * RRRR U U PPPP TTTTT SSSS Y Y N N CCC 004266 sqpr * R R U U P P T S Y Y NN N C C 004267 sqpr * RRRR U U PPPP T SSS Y N N N C 004268 sqpr * R R U U P T S Y N NN C C 004269 sqpr * R R UUU P T SSSS Y N N CCC 004270 sqpr *================================================================= 004271 sqpr RUPTURES-SYNCHROS SECTION. 004272 sqpr2d >>if AA-A-LECTURES-AVEC-RUPT 004273 sqpr2d*> *> zone injection debut <* <* 004274 cdAP00* -- Ruptures ressource AP -- 004275 cdAP00 perform CALCULER-RUPT-AP 2349 004276 sqpr2f*> *> zone injection fin <* <* 004277 sqpr2f >>end-if 004278 sqpr4 >>if AA-A-LECTURES-AVEC-SYNC 004279 sqpr4 *--- Calcul des Synchronisations --------------------------------- 004280 sqpr4 copy AAAPGSYN. ==004281==> IGYPS0040-I Printing of the source code has been suppressed. 004299C >>if AA-A-MAXNS > 0 AAAPGSYN 004300C move high-value to IND AAAPGSYN IMP 1542 004301C move 0 to MAX-CF AAAPGSYN 1604 004302C >>end-if AAAPGSYN 004303 sqpr4d*=== Phase 1 - Calcul de la clé de Synchronisation =============== 004304 sqpr4d*> *> zone injection debut <* <* 004305 cdAP00* -- Calcul des configurations ressource AP -- 004306 cdAP00 perform CALCULER-CLE-AP 2466 004307 cdDM00* -- Calcul des configurations ressource DM -- 004308 cdDM00 perform CALCULER-CLE-DM 2942 004309 sqpr4f*> *> zone injection fin <* <* 004310 sqpr5d*=== Phase 2 - Calcul des configurations ========================= 004311 sqpr5d*> *> zone injection debut <* <* 004312 cdAP00* -- Calcul des configurations ressource AP -- 004313 cdAP00 perform CALCULER-CONF-AP 2474 004314 cdDM00* -- Calcul des configurations ressource DM -- 004315 cdDM00 perform CALCULER-CONF-DM 2950 004316 sqpr5f*> *> zone injection fin <* <* 004317 sqpr5f >>end-if 004318 sqpr6 >>if AA-A-LECTURES-AVEC-RUPT and AA-A-LECTURES-AVEC-SYNC 004319 sqpr6 *--- Calcul des Ruptures totales --------------------------------- 004320 sqpr6 copy AAAPGRTD. ==004321==> IGYPS0040-I Printing of the source code has been suppressed. 004343C >>if AA-A-MAXNR > 0 and AA-A-MAXNS > 0 AAAPGRTD 004344C move RTD to RTP AAAPGRTD 1481 1452 004345C move all '1' to RTD AAAPGRTD 1481 004346C move NRD to NRP AAAPGRTD 1479 1450 004347C move 1 to NRD2 NRD AAAPGRTD 1508 1479 004348C >>end-if AAAPGRTD 004349 sqpr6d*> *> zone injection debut <* <* 004350 cdAP00* -- Calcul des Ruptures Totales AP -- 004351 cdAP00 perform CALCULER-RTD-AP 2402 004352 sqpr6f*> *> zone injection fin <* <* 004353 sqpr6f >>end-if 004354 sqprq *--- Fin Ruptures et Synchronisations ---------------------------- 004355 sqprq continue. 004356 sqprq RUPTURES-SYNCHROS-FN. 004357 sqprq exit section. 004358 sqprq 004359 sqpc /================================================================= 004360 sqpc * CCC OOO N N TTTTT RRRR OOO L EEEEE SSSS 004361 sqpc * C C O O NN N T R R O O L E S 004362 sqpc * C O O N N N T RRRR O O L EEEE SSS 004363 sqpc * C C O O N NN T R R O O L E S 004364 sqpc * CCC OOO N N T R R OOO LLLLL EEEEE SSSS 004365 sqpc *================================================================= 004366 sqpc >>if AA-A-CONTROLES 004374 sqpcq >>end-if 004375 sqpcq 004376 sqpm /================================================================= 004377 sqpm * M M AAA JJJJJ AAA U U TTTTT OOO 004378 sqpm * MM MM A A J A A U U T O O 004379 sqpm * M M M AAAAA J AAAAA U U T O O 004380 sqpm * M M A A J J A A U U T O O 004381 sqpm * M M A A J A A UUU T OOO 004382 sqpm *================================================================= 004383 sqpm >>if AA-A-MAJ 004391 sqpmq >>end-if 004392 sqpmq 004393 sqpe /================================================================= 004394 sqpe * EEEEE DDDD IIIII TTTTT IIIII OOO N N SSSS 004395 sqpe * E D D I T I O O NN N S 004396 sqpe * EEEE D D I T I O O N N N SSS 004397 sqpe * E D D I T I O O N NN S 004398 sqpe * EEEEE DDDD IIIII T IIIII OOO N N SSSS 004399 sqpe *================================================================= 004400 sqpe >>if AA-A-EDITIONS 004408 sqpeq >>end-if 004409 sqpeq 004410 sqps /================================================================= 004411 sqps * EEEEE CCC RRRR IIIII TTTTT U U RRRR EEEEE SSSS 004412 sqps * E C C R R I T U U R R E S 004413 sqps * EEEE C RRRR I T U U RRRR EEEE SSS 004414 sqps * E C C R R I T U U R R E S 004415 sqps * EEEEE CCC R R IIIII T UUU R R EEEEE SSSS 004416 sqps *================================================================= 004417 sqps >>if AA-A-ECRITURES 004418 sqps ECRITURES SECTION. 004419 sqpsd *> *> zone injection debut <* <* 004420 cdS100* -- Gestion Ecriture S1 -- 004421 cdS100*^^ecravt * compléter les lignes ci-dessous * 004422 * Ecriture si date de fin non renseignée 004423 if 1-AP00-DISGSU = spaces 472 IMP 004424 1 move DM00-COSGDM to S100-COSGDM 374 153 004425 1 move DM00-LNSGDM to S100-LNSGDM 376 155 004426 1 move 1-AP00-COSGA1 to S100-COSGA1 460 157 004427 1 move 1-AP00-LNSGAP to S100-LNSGAP 462 159 004428 1 cdS100 perform ECRIRE-S1 3339 004429 cdS100*^^ecrapr * compléter les lignes ci-dessous 004430 end-if 004431 cdS100* 004432 cdS200* -- Gestion Ecriture S2 -- 004433 cdS200*^^ecravt * compléter les lignes ci-dessous * 004434 * Ecriture en rupture dernière niveau 1 004435 if RTD1 = 1 1482 004436 1 move DM00-COSGDM to S200-COSGDM 374 177 004437 1 move DM00-LNSGDM to S200-LNSGDM 376 179 004438 1 move W-WB00-W9040 to S200-W9040 1923 181 004439 1 cdS200 perform ECRIRE-S2 3599 004440 cdS200*^^ecrapr * compléter les lignes ci-dessous 004441 end-if 004442 cdS200* 004443 sqpsf *> *> zone injection fin <* <* 004444 sqpsq *--- Fin écritures ----------------------------------------------- 004445 sqpsq continue. 004446 sqpsq ECRITURES-FN. 004447 sqpsq exit section. 004448 sqpsq >>end-if 004449 sqpsq 004450 sqpko /================================================================= 004451 sqpko * EEEEE RRRR RRRR EEEEE U U RRRR SSSS 004452 sqpko * E R R R R E U U R R S 004453 sqpko * EEEE RRRR RRRR EEEE U U RRRR SSS 004454 sqpko * E R R R R E U U R R S 004455 sqpko * EEEEE R R R R EEEEE UUU R R SSSS 004456 sqpko *================================================================= 004457 sqpko *--- Gestion des erreurs DB2 ------------------------------------- 004458 sqpk2 >>if AA-A-DB2 004459 sqpk2 ERREUR-DB2 SECTION. 004460 sqpk2 copy A2APTIAR. ==004461==> IGYPS0040-I Printing of the source code has been suppressed. 004475C *> --- Interface DSNTIAR A2APTIAR 004476C >>callinterface dynamic A2APTIAR 004477C call 'DSNTIAR' using SQLCA A2APTIAR EXT 1395 004478C DSNTIAR-MESSAGE A2APTIAR 1904 004479C DSNTIAR-LINE-LENGTH A2APTIAR 1902 004480C on exception A2APTIAR 004481C 1 move 20 to DSNTIAR-RC A2APTIAR 1899 004482C not on exception A2APTIAR 004483C 1 move return-code to DSNTIAR-RC A2APTIAR IMP IMP 1899 ==004483==> IGYPA3228-W High order digit positions in the sender may be truncated in the move to receiver "DSNTIAR-RC (NUMERIC INTEGER)". 004484C end-call A2APTIAR 004485C >>callinterface A2APTIAR 004486 sqpk2 if DSNTIAR-OK 1900 004487 1 sqpk2 display '*******************************' 004488 1 sqpk2 display '**** E R R E U R D B 2 ****' 004489 1 sqpk2 display '*******************************' 004490 1 sqpk2 perform varying XDSNTIAR from 1 by 1 1909 004491 1 sqpk2 until XDSNTIAR > 10 1909 004492 1 sqpk2 or DSNTIAR-END (XDSNTIAR) 1910 1909 004493 2 sqpk2 display DSNTIAR-LINE (XDSNTIAR) 1908 1909 004494 1 sqpk2 end-perform 004495 sqpk2 end-if 004496 sqpk2 move SQLCODE to DSNTIAR-ABEND 1398 1901 004497 sqpk2a call "CEE3ABD" using DSNTIAR-ABEND EXT 1901 004498 sqpk2a by content X'00000001' 004499 sqpk2q . 004500 sqpk2q ERREUR-DB2-FN. 004501 sqpk2q exit section. 004502 sqpk2q >>end-if 004503 sqpkd *> *> zone injection debut <* <* 004504 sqpkf *> *> zone injection fin <* <* 004505 sqpka *--- Abend volontaire -------------------------------------------- 004506 sqpka ERREUR-ABEND SECTION. 004507 sqpka call "CEE3ABD" using CODE-ABEND EXT 1913 004508 sqpka by content X'00000001' 004509 sqpkaq . 004510 sqpkaq ERREUR-ABEND-FN. 004511 sqpkaq exit section. ==004511==> IGYSC0208-I DSNH050I DSNHPSRV WARNINGS HAVE BEEN SUPPRESSED DUE TO LACK OF TABLE DECLARATIONS 004512 sqq 004513 sqq *================================================================= 004514 sqq *=== That's all folks ! ========================================== 004515 sqq *================================================================= 004516 sqq End program S9TL1B. 2