CBL SERVICE('CEH49 T00001 2023-10-21 16:23:23 J070188') sqi IDENTIFICATION DIVISION. sqi PROGRAM-ID. S9TL1B. ****************************************************************** * Programme : S9TL1B * Workspace : ceab3-environn-outinfr-central * * Test avec ressources Db2 * ****************************************************************** sqivc * Variables globales pour la compilation conditionnelle sqivc * copy AGAVBATC. *CONTROL NOSOURCE AGAVBATC *>****************************************************************AGAVBATC *> Déclaration des variables de compilation conditionnelle pour AGAVBATC *> un programme batch. AGAVBATC *> Ce COPYBOOK fait référence aux COPYBOOKs suivants : AGAVBATC *> - AGAVINIT : variables d'architecture générale AGAVBATC *> - AAAVACCE : variables associées aux accès aux ressources AGAVBATC ******************************************************************AGAVBATC *CONTROL SOURCE AGAVBATC * copy AGAVINIT. AGAVBATC *CONTROL NOSOURCE AGAVINIT *>****************************************************************AGAVINIT *> Initialisation des variables de compilation conditionnelle AGAVINIT *> d'Architecture Générale. AGAVINIT *> ---------------------------------------------------------------AGAVINIT *> - AA-G-BATCH : programme Batch AGAVINIT *> - AA-G-CICS : programme TP CICS AGAVINIT *> - AA-G-EXCI : programme Batch avec interface EXCI AGAVINIT *> - AA-G-MIXED : programme mixte Batch et TP CICS AGAVINIT *> - AA-G-PACBASE : programme migré depuis Pacbase AGAVINIT *> - AA-G-VARPACBASE : utilisation des variables standard Pacbase AGAVINIT *> - IGY-ADV : valeur de l'option de compilation AGAVINIT *> ADV/NOADV AGAVINIT *>****************************************************************AGAVINIT *CONTROL SOURCE AGAVINIT *> --- Variables calculées automatiquement (ne pas modifier) AGAVINIT *>>define AA-G-BATCH as b'0' AGAVINIT *>>define AA-G-CICS as b'0' AGAVINIT *>>define AA-G-EXCI as b'0' AGAVINIT *>>define AA-G-MIXED as b'0' AGAVINIT *>>if AA-G-PACBASE not defined AGAVINIT *>>define AA-G-PACBASE as b'0' AGAVINIT *>>end-if AGAVINIT *>>define AA-G-VARPACBASE as b'0' AGAVINIT *>>define IGY-ADV as parameter AGAVINIT *>>if IGY-ADV not defined AGAVINIT *>>end-if AGAVINIT *>>define AA-G-BATCH as b'1' override AGAVBATC * copy AAAVACCE. AGAVBATC *CONTROL NOSOURCE AAAVACCE *>****************************************************************AAAVACCE *> Initialisation des variables de compilation conditionne pour AAAVACCE *> la gestion des accès aux ressources et de la cinématique AAAVACCE *> programme. AAAVACCE *>----------------------------------------------------------------AAAVACCE *> - AA-A-CONTROLES : présence lectures avec contrôles AAAVACCE *> - AA-A-DB2 : présence accès Db2 AAAVACCE *> - AA-A-DB2-TRACE : trace Db2 AAAVACCE *> - AA-A-ECRITURES : présence écritures automatiques AAAVACCE *> - AA-A-EDITIONS : présence éditions AAAVACCE *> - AA-A-EDITIONS-AUTO : présence éditions automatiques AAAVACCE *> - AA-A-LECTURES : présence lectures automatiques AAAVACCE *> - AA-A-LECTURES-AVEC-RUPT : présence lectures avec ruptures AAAVACCE *> - AA-A-LECTURES-AVEC-SYNC : présence lectures avec synchro AAAVACCE *> - AA-A-LECTURES-SANS-RUPT : présence lectures sans ruptures AAAVACCE *> - AA-A-MAJ : présence mise à jour automatiques AAAVACCE *> - AA-A-MAXNR : niveau rupture maximum AAAVACCE *> - AA-A-MAXNS : niveau synchronisation maximum AAAVACCE *> - AA-A-VSAM : présence accès VSAM AAAVACCE *>****************************************************************AAAVACCE *CONTROL SOURCE AAAVACCE *> --- Variables calculées automatiquement (ne pas modifier) AAAVACCE *>>define AA-A-CONTROLES as b'0' AAAVACCE *>>define AA-A-DB2 as b'0' AAAVACCE *>>define AA-A-DB2-TRACE as b'0' AAAVACCE *>>define AA-A-ECRITURES as b'0' AAAVACCE *>>define AA-A-EDITIONS as b'0' AAAVACCE *>>define AA-A-EDITIONS-AUTO as b'0' AAAVACCE *>>define AA-A-LECTURES as b'0' AAAVACCE *>>define AA-A-LECTURES-AVEC-RUPT as b'0' AAAVACCE *>>define AA-A-LECTURES-AVEC-SYNC as b'0' AAAVACCE *>>define AA-A-LECTURES-SANS-RUPT as b'0' AAAVACCE *>>define AA-A-MAJ as b'0' AAAVACCE *>>define AA-A-MAXNR as 0 AAAVACCE *>>define AA-A-MAXNS as 0 AAAVACCE *>>define AA-A-VSAM as b'0' AAAVACCE sqisqa****************************************************************** sqisqa*> * * Squelette : SB2 - Squelette Batch <* <* sqisqa*> * * Version : SB2 - V5.0.0 - B <* <* sqisqd*> * * Squelette : Tag trace Injection <* <* cdAP00*Inj*|dd:AP|noseg:00|repl:APP|copy:SG2DAPP|ddname:APP|recfm:F|nrup cdAP00*Inj*t:2|nsync:1|org:2|mode:S|acces:LSA|cles:COSGDP;LCSGAP|picts:X cdAP00*Inj*(1);X(1) cdDM00*Inj*|dd:DM|noseg:00|repl:ADM|copy:SG2DADM|ddname:ADM|recfm:F|nrup cdDM00*Inj*t:0|nsync:1|org:2|mode:S|acces:LSA|cles:COSGDP|picts:X(1) cdS100*Inj*|dd:S1|noseg:00|repl:I902|copy:S9FDI902|ddname:SI902|recfm:F| cdS100*Inj*nrupt:0|org:F|mode:S|acces:ESA cdS200*Inj*|dd:S2|noseg:00|repl:I903|copy:S9FDI903|ddname:SI903|recfm:F| cdS200*Inj*nrupt:0|org:F|mode:S|acces:ESA sqisqf*> * * Squelette : Tag trace Injection <* <* sqid DATE-COMPILED. sqe ENVIRONMENT DIVISION. sqec CONFIGURATION SECTION. sqec SOURCE-COMPUTER. IBM-370. sqec OBJECT-COMPUTER. IBM-370. sqes SPECIAL-NAMES. DECIMAL-POINT IS COMMA . sqei INPUT-OUTPUT SECTION. sqeif FILE-CONTROL. sqeifd*> *> zone injection debut <* <* cdS100 select S1-FICHIER assign to UT-S-SI902. cdS200 select S2-FICHIER assign to UT-S-SI903. sqeiff*> *> zone injection fin <* <* sqeiff sqsd /***************************************************************** sqsd * DDDD AAA TTTTT AAA DDDD IIIII V V sqsd * D D A A T A A D D I V V sqsd * D D AAAAA T AAAAA D D I V V ... sqsd * D D A A T A A D D I V V ..... sqsd * DDDD A A T A A DDDD IIIII V ... sqsd ****************************************************************** sqsd DATA DIVISION. sqsd sqsdf *================================================================= sqsdf * FFFFF IIIII L EEEEE SSSS EEEEE CCC TTTTT sqsdf * F I L E S E C C T sqsdf * FFFF I L EEEE SSS EEEE C T sqsdf * F I L E S E C C T sqsdf * F IIIII LLLLL EEEEE SSSS EEEEE CCC T sqsdf *================================================================= sqsdf FILE SECTION. sqsdfd*> *> zone injection debut <* <* cdS100 FD S1-FICHIER cdS100 block contains 0 records cdS100 recording mode is F. cdS100* copy S9FDI902 replacing cdS100*^^repl1 * compléter les lignes ci-dessous * cdS100* ==REDEFINES I900.== by ==.== cdS100* leading ==I902== by ==S100== cdS100* . ******************************************************************S9FDI902 * Fichier I902 : Liste des Applications actives S9FDI902 *-----------------------------------------------------------------S9FDI902 * Utilisation : S9FDI902 * COPY S9FDI902 REPLACING LEADING ==I902=== BY ==prefix==. S9FDI902 ******************************************************************S9FDI902 *-- 16/10/2021 19:50:48 BIB: S9T SESSION: USER: J070188 S9FDI902 01 S100. S9FDI902 *Code domaine *00001 10 S100-COSGDM PIC X(8). *00001 *Libellé domaine *00009 10 S100-LNSGDM PIC X(45). *00009 *Code application Cartographie *00054 10 S100-COSGA1 PIC X(8). *00054 *Libellé application *00062 10 S100-LNSGAP PIC X(44). *00062 cdS200 FD S2-FICHIER cdS200 block contains 0 records cdS200 recording mode is F. cdS200* copy S9FDI903 replacing cdS200*^^repl1 * compléter les lignes ci-dessous * cdS200* ==REDEFINES I900.== by ==.== cdS200* leading ==I903== by ==S200== cdS200* . ****************************************************************** * Fichier I903 : Nombre d'Applications actives *----------------------------------------------------------------- * Utilisation : * COPY S9FSI903 REPLACING LEADING ==I903=== BY ==prefix==. ****************************************************************** *-- 16/10/2021 19:50:48 BIB: S9T SESSION: USER: J070188 01 S200. *Code domaine *00001 10 S200-COSGDM PIC X(8). *00001 *Libellé domaine *00009 10 S200-LNSGDM PIC X(45). *00009 *Numérique Entier Banalisé 04 *00054 10 S200-W9040 PIC 9(4). *00054 sqsdff*> *> zone injection fin <* <* sqsdff* sqsw *================================================================= sqsw * W W SSSS SSSS EEEEE CCC TTTTT sqsw * W W S S E C C T sqsw * W W W === SSS SSS EEEE C T sqsw * W W W S S E C C T sqsw * W W SSSS SSSS EEEEE CCC T sqsw *================================================================= sqsw WORKING-STORAGE SECTION. sqsw *--- Marqueur pour faciliter l'analyse des dumps ----------------- sqsw 01 DEBUT-WSS VOLATILE. sqsw 05 FILLER PIC X(7) VALUE 'WORKING'. sqswp *--- Horodatage code source -------------------------------------- sqswp * copy AGADHORO replacing sqswp *--- informations à mettre à jour à la création du programme ----- * =='COBASE'== by =='H49 '== * =='APPLI'== by =='AB3'== * =='PROGR'== by =='S9TL1B'== * =='PROGE'== by =='S9TL1B '== *--- informations variables à mettre à jour ---------------------- * =='NUGNA'== by =='00001'== * =='DATGN'== by =='21/10/23'== * =='DATGNC'== by =='21/10/2023'== * =='TIMGN'== by =='16:23:23'== * =='CODUTI'== by =='J070188 '== sqswpf* . *CONTROL NOSOURCE AGADHORO *>****************************************************************AGADHORO *> Horodatage des programmes. AGADHORO *> Ce copybook reproduit les constantes de génération Pacbase AGADHORO *> qui sont utilisées dans certaines fonctions du framework et AGADHORO *> par des outillages historiques. AGADHORO *> Chaque programme COBOL doit appeler ce copybook avec une AGADHORO *> clause replacing pour la majorité des variables présentes. AGADHORO *> Une extension VS Code maintient automatiquement certaines AGADHORO *> valeurs au moment de la sauvegarde du fichier sur disque. AGADHORO *>----------------------------------------------------------------AGADHORO *> NUGNA : à valoriser avec les 5 derniers caractères du Code AGADHORO *> Changement AGADHORO *> APPLI : à valoriser soit avec l'ancien code bibliothèque AGADHORO *> Pacbase pour les programmes migrés, soit avec les 3 AGADHORO *> derniers caractères du code CIA du Bloc Applicatif AGADHORO *> pour les nouveaux programmes COBOL natif, (cette AGADHORO *> information est utilisée par le framework en AGADHORO *> particulier pour accéder aux libellés d'erreur et AGADHORO *> aide en ligne) AGADHORO *> DATGN : date du jour format JJ/MM/AA AGADHORO *> PROGR : nom interne du programme, limité à 6 caractères AGADHORO *> CODUTI : code utilisateur ayant modifié le programme en AGADHORO *> dernier AGADHORO *> TIMGN : heure courante au format HH:MM:SS AGADHORO *> PROGE : nom externe du programme, égal au PROGRAM-ID AGADHORO *> COBASE : 3 derniers caractères du code CIA Application AGADHORO *> DATGNC : date du jour format JJ/MM/AAAA AGADHORO *> RELEAS : constante 'CBL NAT' AGADHORO *> DATGE : date de mise à jour de l'Assistant codage COBOL AGADHORO *> DATSQ : date du mise à jour du squelette AGADHORO *>****************************************************************AGADHORO *CONTROL SOURCE AGADHORO 01 CONSTANTES-PAC. AGADHORO 05 PAC-CONSTANTES. AGADHORO 10 NUGNA PIC X(5) VALUE '00001'. AGADHORO 10 APPLI PIC X(3) VALUE 'AB3'. AGADHORO 10 DATGN PIC X(8) VALUE '21/10/23'. AGADHORO 10 PROGR PIC X(6) VALUE 'S9TL1B'. AGADHORO 10 CODUTI PIC X(8) VALUE 'J070188 '. AGADHORO 10 TIMGN PIC X(8) VALUE '16:23:23'. AGADHORO 10 PROGE PIC X(8) VALUE 'S9TL1B '. AGADHORO 10 COBASE PIC X(4) VALUE 'H49 '. AGADHORO 10 DATGNC PIC X(10) VALUE '21/10/2023'. AGADHORO 10 RELEAS PIC X(7) VALUE 'CBL NAT'. AGADHORO 10 DATGE PIC X(10) VALUE '01/01/2022'. AGADHORO 10 DATSQ PIC X(10) VALUE '01/01/2022'. AGADHORO sqswpf* sqw2 *----------------------------------------------------------------- sqw2 * H H OOO SSSS TTTTT V V DDDD BBBB 222 sqw2 * H H O O S T V V D D B B 2 2 sqw2 * HHHHH O O SSS T V V D D BBBB 2 sqw2 * H H O O S T V V D D B B 22 sqw2 * H H OOO SSSS T V DDDD BBBB 22222 sqw2 *----------------------------------------------------------------- sqw2d *> *> zone injection debut <* <* cdAP00*--- Ressource AP00 - Table APP cdAP00*^^hstavcp * compléter les lignes ci-dessous * cdAP00* copy SG2DAPP replacing cdAP00*^^repl1 * compléter les lignes ci-dessous * cdAP00* leading ==APP== by ==AP00== cdAP00* leading ==V-APP== by ==V-AP00== cdAP00* . ******************************************************************SG2DAPP * TABLE DB2 APP : Applications Cartographie $AGL APP SG2DAPP *-----------------------------------------------------------------SG2DAPP * Sous décomposition d'un Domaine de Gestion. SG2DAPP * L'application correspond à une unité de portage (ou de rem- SG2DAPP * placement) du Système d'Information. SG2DAPP * L'application correspond à une entité propriétaire de ses SG2DAPP * données (c-à-d que les autres applications ne peuvent pas y SG2DAPP * accéder directement aussi bien en MAJ qu'en Lecture, en TP SG2DAPP * qu'en Batch mais exclusivement utiliser les services SG2DAPP * proposés par l'application). SG2DAPP * SG2DAPP * Sous-schéma de sélection SG2DAPP * ------------------------ SG2DAPP * 1 : recherche Application par codes Domaine/Application SG2DAPP * SG2DAPP * ------------------------------------------------------------ SG2DAPP * Auteur : BELLIER Olivier SG2DAPP * Date de Création : 29/08/02 SG2DAPP * Origine Création : Mise aux normes des tables AGL SG2DAPP * SG2DAPP * Modifié par : FALLAI Denis SG2DAPP * Modifié le : 08/10/15 SG2DAPP * Motif de Modif. : Ajout clés et sous-schémas SG2DAPP * SG2DAPP * Modifié par : FALLAI Denis SG2DAPP * Modifié le : 26/11/18 SG2DAPP * Motif de Modif. : Regroupement Lettres Domaine et SG2DAPP * Application SG2DAPP *-----------------------------------------------------------------SG2DAPP * Utilisation : SG2DAPP * COPY SG2DAPP REPLACING LEADING ==APP== BY ==prefix== SG2DAPP * LEADING ==V-APP== BY ==V-prefix==. SG2DAPP ******************************************************************SG2DAPP *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DAPP *-----------------------------------------------------------------SG2DAPP * Applications Cartographie $AGL APP SG2DAPP 01 AP00. SG2DAPP * Code application Cartographie *00001 10 AP00-COSGA1 PIC X(8). *00001 * Libellé application *00009 10 AP00-LNSGAP PIC X(44). *00009 * Groupe Lettres Domaine-Application *00053 10 AP00-GISGDA. *00053 * Code Lettre Domaine PACBASE *00053 11 AP00-COSGDP PIC X. *00053 * Lettre préfixe application *00054 11 AP00-LCSGAP PIC X. *00054 * date de creation d'une application *00055 10 AP00-DISGCA PIC X(8). *00055 * date suppression d'une application *00063 10 AP00-DISGSU PIC X(8). *00063 * date mise a jour d'une application *00071 10 AP00-DISGMJ PIC X(8). *00071 * Code Synonyme *00079 10 AP00-COSGSN PIC X(8). *00079 * Code secteur *00087 10 AP00-COSGSE PIC X(8). *00087 * SG2DAPP *>>if AA-A-DB2NOIND not defined SG2DAPP 01 V-AP00. SG2DAPP 10 V-AP00-COSGA1 PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-LNSGAP PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-COSGDP PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-LCSGAP PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-DISGCA PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-DISGSU PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-DISGMJ PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-COSGSN PIC S9(4) COMP-5. SG2DAPP 10 V-AP00-COSGSE PIC S9(4) COMP-5. SG2DAPP 01 V-AP00-R REDEFINES V-AP00. SG2DAPP 10 V-AP00-A PIC S9(4) COMP-5 SG2DAPP OCCURS 00009. SG2DAPP *>>end-if SG2DAPP *>>define AA-A-DB2NOIND off SG2DAPP cdAP00* cdDM00*--- Ressource DM00 - Table ADM cdDM00*^^hstavcp * compléter les lignes ci-dessous * cdDM00* copy SG2DADM replacing cdDM00*^^repl1 * compléter les lignes ci-dessous * cdDM00* leading ==ADM== by ==DM00== cdDM00* leading ==V-ADM== by ==V-DM00== cdDM00* . ******************************************************************SG2DADM * TABLE DB2 ADM : Domaines Cartographie $AGL ADM SG2DADM *-----------------------------------------------------------------SG2DADM * Modifié par : AM Surault SG2DADM * Modifié le : 24/12/04 SG2DADM * Motif de Modif. : Remontée à partir de SGL pour pouvoir SG2DADM * etre utilisée dans STE SG2DADM * Table contenant les domaines SIRIS tel que définis dans SG2DADM * la base "cartographie SIRIS". SG2DADM *-----------------------------------------------------------------SG2DADM * Utilisation : SG2DADM * COPY SG2DADM REPLACING LEADING ==ADM== BY ==prefix== SG2DADM * LEADING ==V-ADM== BY ==V-prefix==. SG2DADM ******************************************************************SG2DADM *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DADM *-----------------------------------------------------------------SG2DADM * Domaines Cartographie $AGL ADM SG2DADM 01 DM00. SG2DADM * Code domaine *00001 10 DM00-COSGDM PIC X(8). *00001 * Libellé domaine *00009 10 DM00-LNSGDM PIC X(45). *00009 * Code Lettre Domaine PACBASE *00054 10 DM00-COSGDP PIC X. *00054 * date de creation d'une application *00055 10 DM00-DISGCA PIC X(8). *00055 * date suppression d'une application *00063 10 DM00-DISGSU PIC X(8). *00063 * SG2DADM *>>if AA-A-DB2NOIND not defined SG2DADM 01 V-DM00. SG2DADM 10 V-DM00-COSGDM PIC S9(4) COMP-5. SG2DADM 10 V-DM00-LNSGDM PIC S9(4) COMP-5. SG2DADM 10 V-DM00-COSGDP PIC S9(4) COMP-5. SG2DADM 10 V-DM00-DISGCA PIC S9(4) COMP-5. SG2DADM 10 V-DM00-DISGSU PIC S9(4) COMP-5. SG2DADM 01 V-DM00-R REDEFINES V-DM00. SG2DADM 10 V-DM00-A PIC S9(4) COMP-5 SG2DADM OCCURS 00005. SG2DADM *>>end-if SG2DADM *>>define AA-A-DB2NOIND off SG2DADM cdDM00* sqw2f *> *> zone injection fin <* <* sqw2f * sqwa *----------------------------------------------------------------- sqwa * W W RRRR K K AAA CCC CCC EEEEE SSSS sqwa * W W R R K KK A A C C C C E S sqwa * W W W RRRR KK AAAAA C C EEEE SSS sqwa * W W W R R K KK A A C C C C E S sqwa * W W R R K K A A CCC CCC EEEEE SSSS sqwa *----------------------------------------------------------------- sqwad *> *> zone injection debut <* <* cdAP00* cdAP00*--- Gestion Accès AP -------------------------------------------- cdAP00*>>define AA-A-ACCES as 'L' cdAP00*>>define AA-A-MODE as 'S' cdAP00*>>define AA-A-ORG as '2' cdAP00*>>define AA-A-NR as 2 cdAP00*>>define AA-A-NS as 1 cdAP00*>>if AA-A-NR > 0 cdAP00*^^accavcp * compléter les lignes ci-dessous * cdAP00* copy SG2DAPP replacing cdAP00*^^repl2 * compléter les lignes ci-dessous * cdAP00* leading ==APP== by ==1-AP00== cdAP00* leading ==V-APP== by ==V-1-AP00== cdAP00* . ******************************************************************SG2DAPP * TABLE DB2 APP : Applications Cartographie $AGL APP SG2DAPP *-----------------------------------------------------------------SG2DAPP * Sous décomposition d'un Domaine de Gestion. SG2DAPP * L'application correspond à une unité de portage (ou de rem- SG2DAPP * placement) du Système d'Information. SG2DAPP * L'application correspond à une entité propriétaire de ses SG2DAPP * données (c-à-d que les autres applications ne peuvent pas y SG2DAPP * accéder directement aussi bien en MAJ qu'en Lecture, en TP SG2DAPP * qu'en Batch mais exclusivement utiliser les services SG2DAPP * proposés par l'application). SG2DAPP * SG2DAPP * Sous-schéma de sélection SG2DAPP * ------------------------ SG2DAPP * 1 : recherche Application par codes Domaine/Application SG2DAPP * SG2DAPP * ------------------------------------------------------------ SG2DAPP * Auteur : BELLIER Olivier SG2DAPP * Date de Création : 29/08/02 SG2DAPP * Origine Création : Mise aux normes des tables AGL SG2DAPP * SG2DAPP * Modifié par : FALLAI Denis SG2DAPP * Modifié le : 08/10/15 SG2DAPP * Motif de Modif. : Ajout clés et sous-schémas SG2DAPP * SG2DAPP * Modifié par : FALLAI Denis SG2DAPP * Modifié le : 26/11/18 SG2DAPP * Motif de Modif. : Regroupement Lettres Domaine et SG2DAPP * Application SG2DAPP *-----------------------------------------------------------------SG2DAPP * Utilisation : SG2DAPP * COPY SG2DAPP REPLACING LEADING ==APP== BY ==prefix== SG2DAPP * LEADING ==V-APP== BY ==V-prefix==. SG2DAPP ******************************************************************SG2DAPP *-- 16/08/2022 22:26:30 BIB: SGL SESSION: USER: J070188 SG2DAPP *-----------------------------------------------------------------SG2DAPP * Applications Cartographie $AGL APP SG2DAPP 01 1-AP00. SG2DAPP * Code application Cartographie *00001 10 1-AP00-COSGA1 PIC X(8). *00001 * Libellé application *00009 10 1-AP00-LNSGAP PIC X(44). *00009 * Groupe Lettres Domaine-Application *00053 10 1-AP00-GISGDA. *00053 * Code Lettre Domaine PACBASE *00053 11 1-AP00-COSGDP PIC X. *00053 * Lettre préfixe application *00054 11 1-AP00-LCSGAP PIC X. *00054 * date de creation d'une application *00055 10 1-AP00-DISGCA PIC X(8). *00055 * date suppression d'une application *00063 10 1-AP00-DISGSU PIC X(8). *00063 * date mise a jour d'une application *00071 10 1-AP00-DISGMJ PIC X(8). *00071 * Code Synonyme *00079 10 1-AP00-COSGSN PIC X(8). *00079 * Code secteur *00087 10 1-AP00-COSGSE PIC X(8). *00087 * SG2DAPP *>>if AA-A-DB2NOIND not defined SG2DAPP 01 V-1-AP00. SG2DAPP 10 V-1-AP00-COSGA1 PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-LNSGAP PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-COSGDP PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-LCSGAP PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-DISGCA PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-DISGSU PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-DISGMJ PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-COSGSN PIC S9(4) COMP-5. SG2DAPP 10 V-1-AP00-COSGSE PIC S9(4) COMP-5. SG2DAPP 01 V-1-AP00-R REDEFINES V-1-AP00. SG2DAPP 10 V-1-AP00-A PIC S9(4) COMP-5 SG2DAPP OCCURS 00009. SG2DAPP *>>end-if SG2DAPP *>>define AA-A-DB2NOIND off SG2DAPP cdAP00*>>end-if cdAP00*^^accavad * compléter les lignes ci-dessous * cdAP00* copy AAADACCE replacing cdAP00* ==:DD:== by ==AP== cdAP00* ==:K1:== by ==COSGDP== cdAP00* ==:P1:== by ==X(1)== cdAP00* ==:K2:== by ==LCSGAP== cdAP00* ==:P2:== by ==X(1)== cdAP00* . *CONTROL NOSOURCE AAADACCE *>****************************************************************AAADACCE *> Accès ressource externe. AAADACCE *> Déclaration des variables de gestion de la ressource. AAADACCE *> Cette COPY doit être appelée en Working-Storage Section pour AAADACCE *> chaque accès à une ressource externe. AAADACCE *>----------------------------------------------------------------AAADACCE *> Paramètres REPLACING obligatoires : AAADACCE *> - :DD: : code logigue ressource, 2 caractères AAADACCE *> Paramètres facultatifs (selon contexte) : AAADACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAADACCE *> - :P: : picture(s) clé(s) de rupture / synchro au rang n AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilation locales : AAADACCE *> - AA-A-ACCES : type d'accès, obligatoire AAADACCE *> - 'L' : Lecture (défaut) AAADACCE *> - 'E' : Ecriture (un seul type d'écriture) AAADACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAADACCE *> - 'X' : Lecture (L) et Modification (M) AAADACCE *> - 'T' : Chargement en table mémoire AAADACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAADACCE *> - AA-A-MODE : mode d'accès, facultatif AAADACCE *> - 'S' : Séquentiel (défaut) AAADACCE *> - 'R' : Direct AAADACCE *> - 'D' : Dynamique (réservé aux fichiers VSAM) AAADACCE *> - AA-A-ORG : type d'organisation, facultatif AAADACCE *> - 'F' : Fichier Séquentiel (défaut) AAADACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAADACCE *> - 'R' : Fichier VSAM Random (RRDS) AAADACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAADACCE *> - '2' : Accès Db2 AAADACCE *> - 'I' : Document formaté (Mode Séquentiel) AAADACCE *> - 'X' : Document XML (Mode Séquentiel) AAADACCE *> - 'J' : Document JSON (Mode Séquentiel) AAADACCE *> - 'P' : Procédure interne (Impressions) AAADACCE *> - 'S' : Spooleur externe (Impressions) AAADACCE *> - AA-A-NR : niveau de Rupture, facultatif AAADACCE *> - 0 : pas de Rupture (défaut) AAADACCE *> - 1 à 9 : nombre de niveaux de Rupture AAADACCE *> - < 0 : hors itération AAADACCE *> - AA-A-NS : niveau de Synchronisation AAADACCE *> - 0 : pas de Synchronisation AAADACCE *> - 1 à 9 : nombre de niveaux de Synchronisation AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilations globales impactées : AAADACCE *> - AA-A-MAXNR : niveau maximum de Ruptures AAADACCE *> - AA-A-MAXNS : niveau maximum de Synchronisation AAADACCE *> - AA-A-LECTURES-SANS-RUPT : traitement lectures sans Rupture AAADACCE *> - AA-A-LECTURES-AVEC-RUPT : traitement lectures avec Ruptures AAADACCE *> - AA-A-ECRITURES : traitement écritures AAADACCE *> - AA-A-DB2 : présence d'accès DB2 AAADACCE *> - AA-A-VSAM : présence de fichiers VSAM AAADACCE *>****************************************************************AAADACCE *> --- Valeurs par défaut des variables conditionnelles AAADACCE *>>if AA-A-ACCES is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-MODE is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NR is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NS is not defined AAADACCE *>>end-if AAADACCE *CONTROL SOURCE AAADACCE *> --- Validation du contexte AAADACCE *>>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG = '2' AAADACCE * copy AAA00020. AAADACCE *>>define AA-A-DB2 as b'1' override AAA00020 *>>end-if AAADACCE *>>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE *>>end-if AAADACCE *>>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE *> Compteur d'accès AAADACCE 01 5-AP00-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE *>>end-if AAADACCE *>>evaluate AA-A-ACCES AAADACCE * >>when 'L' *> Lecture seule AAADACCE * copy AAA0L000. AAADACCE *> Indicateur accès nouvel enregistrement lu AAA0L000 01 PIC X VALUE '0'. AAA0L000 88 AP-LU VALUE '1' AAA0L000 FALSE '0'. AAA0L000 *>>evaluate AA-A-MODE AAA0L000 * >>when 'S' *> Lecture séquentielle AAA0L000 * copy AAA0LS00. AAA0L000 *>>if AA-A-ORG = '2' AAA0LS00 * copy AAA0LS20. AAA0LS00 *> Témoins état curseur Db2 AAA0LS20 01 W-AP00-CESBCU PIC X VALUE 'C'. AAA0LS20 88 AP-OUVERT VALUE 'O' AAA0LS20 FALSE 'C'. AAA0LS20 *>>end-if AAA0LS00 *>>evaluate true AAA0LS00 * >>when AA-A-NR < 0 *> Accès séquentiel hors itération AAA0LS00 * >>when other *> Accès séquentiel avec Rupture AAA0LS00 * >>define AA-A-LECTURES as b'1' override AAA0LS00 * copy AAA0LSRU. AAA0LS00 *>>define AA-A-LECTURES-AVEC-RUPT as b'1' override AAA0LSRU *>>if AA-A-MAXNR < AA-A-NR AAA0LSRU * >>define AA-A-MAXNR as AA-A-NR override AAA0LSRU *>>end-if AAA0LSRU *> Niveau Rupture Première AAA0LSRU 01 AP-NRP PIC 9(4) COMP-5 VALUE 1. AAA0LSRU *> Ruptures Premières AAA0LSRU 01 AP-PE. AAA0LSRU 05 AP-PE1 PIC X VALUE '1'. AAA0LSRU *>>if AA-A-NR > 1 AAA0LSRU 05 AP-PE2 PIC X VALUE '1'. AAA0LSRU * >>if AA-A-NR > 2 AAA0LSRU * >>end-if AAA0LSRU *>>end-if AAA0LSRU *> Niveau Rupture Dernière AAA0LSRU 01 AP-NRD PIC 9(4) COMP-5 VALUE 1. AAA0LSRU *> Ruptures Dernières AAA0LSRU 01 AP-DE. AAA0LSRU 05 AP-DE1 PIC X VALUE '1'. AAA0LSRU *>>if AA-A-NR > 1 AAA0LSRU 05 AP-DE2 PIC X VALUE '1'. AAA0LSRU * >>if AA-A-NR > 2 AAA0LSRU * >>end-if AAA0LSRU *>>end-if AAA0LSRU *>>end-evaluate AAA0LS00 *>>if AA-A-NS > 0 *> Accès séquentiel avec Synchro AAA0LS00 * copy AAA0LSSY. AAA0LS00 *>>define AA-A-LECTURES-AVEC-SYNC as b'1' override AAA0LSSY *>>if AA-A-MAXNS < AA-A-NS AAA0LSSY * >>define AA-A-MAXNS as AA-A-NS override AAA0LSSY *>>end-if AAA0LSSY *> Niveau maximum de Configuration (Synchronisation) AAA0LSSY 01 AP-NCF PIC 9(4) COMP-5. AAA0LSSY *> Indicateurs de Configuration (Synchronisation) AAA0LSSY 01 AP-CF. AAA0LSSY 05 AP-CF1 PIC X VALUE '1'. AAA0LSSY *>>if AA-A-NS > 1 AAA0LSSY *>>end-if AAA0LSSY *> Clés de Configuration (Synchronisation) AAA0LSSY 01 APIND. AAA0LSSY 05 APIND1. AAA0LSSY 10 AP-IN-COSGDP PIC X(1). AAA0LSSY *>>if AA-A-NS > 1 AAA0LSSY *>>end-if AAA0LSSY *>>end-if AAA0LS00 * >>when 'R' *> Lecture directe AAA0L000 *>>end-evaluate AAA0L000 * >>when 'E' *> Ecriture seule AAADACCE *>>end-evaluate AAADACCE *CONTROL NOSOURCE AAADACCE *> --- Effacement des variables conditionnelles locales AAADACCE *>>define AA-A-ACCES off AAADACCE *>>define AA-A-MODE off AAADACCE *>>define AA-A-ORG off AAADACCE *>>define AA-A-NR off AAADACCE *>>define AA-A-NS off AAADACCE *CONTROL SOURCE AAADACCE cdDM00* cdDM00*--- Gestion Accès DM -------------------------------------------- cdDM00*>>define AA-A-ACCES as 'L' cdDM00*>>define AA-A-MODE as 'S' cdDM00*>>define AA-A-ORG as '2' cdDM00*>>define AA-A-NR as 0 cdDM00*>>define AA-A-NS as 1 cdDM00*>>if AA-A-NR > 0 cdDM00*>>end-if cdDM00*^^accavad * compléter les lignes ci-dessous * cdDM00* copy AAADACCE replacing cdDM00* ==:DD:== by ==DM== cdDM00* ==:K1:== by ==COSGDP== cdDM00* ==:P1:== by ==X(1)== cdDM00* . *CONTROL NOSOURCE AAADACCE *>****************************************************************AAADACCE *> Accès ressource externe. AAADACCE *> Déclaration des variables de gestion de la ressource. AAADACCE *> Cette COPY doit être appelée en Working-Storage Section pour AAADACCE *> chaque accès à une ressource externe. AAADACCE *>----------------------------------------------------------------AAADACCE *> Paramètres REPLACING obligatoires : AAADACCE *> - :DD: : code logigue ressource, 2 caractères AAADACCE *> Paramètres facultatifs (selon contexte) : AAADACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAADACCE *> - :P: : picture(s) clé(s) de rupture / synchro au rang n AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilation locales : AAADACCE *> - AA-A-ACCES : type d'accès, obligatoire AAADACCE *> - 'L' : Lecture (défaut) AAADACCE *> - 'E' : Ecriture (un seul type d'écriture) AAADACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAADACCE *> - 'X' : Lecture (L) et Modification (M) AAADACCE *> - 'T' : Chargement en table mémoire AAADACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAADACCE *> - AA-A-MODE : mode d'accès, facultatif AAADACCE *> - 'S' : Séquentiel (défaut) AAADACCE *> - 'R' : Direct AAADACCE *> - 'D' : Dynamique (réservé aux fichiers VSAM) AAADACCE *> - AA-A-ORG : type d'organisation, facultatif AAADACCE *> - 'F' : Fichier Séquentiel (défaut) AAADACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAADACCE *> - 'R' : Fichier VSAM Random (RRDS) AAADACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAADACCE *> - '2' : Accès Db2 AAADACCE *> - 'I' : Document formaté (Mode Séquentiel) AAADACCE *> - 'X' : Document XML (Mode Séquentiel) AAADACCE *> - 'J' : Document JSON (Mode Séquentiel) AAADACCE *> - 'P' : Procédure interne (Impressions) AAADACCE *> - 'S' : Spooleur externe (Impressions) AAADACCE *> - AA-A-NR : niveau de Rupture, facultatif AAADACCE *> - 0 : pas de Rupture (défaut) AAADACCE *> - 1 à 9 : nombre de niveaux de Rupture AAADACCE *> - < 0 : hors itération AAADACCE *> - AA-A-NS : niveau de Synchronisation AAADACCE *> - 0 : pas de Synchronisation AAADACCE *> - 1 à 9 : nombre de niveaux de Synchronisation AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilations globales impactées : AAADACCE *> - AA-A-MAXNR : niveau maximum de Ruptures AAADACCE *> - AA-A-MAXNS : niveau maximum de Synchronisation AAADACCE *> - AA-A-LECTURES-SANS-RUPT : traitement lectures sans Rupture AAADACCE *> - AA-A-LECTURES-AVEC-RUPT : traitement lectures avec Ruptures AAADACCE *> - AA-A-ECRITURES : traitement écritures AAADACCE *> - AA-A-DB2 : présence d'accès DB2 AAADACCE *> - AA-A-VSAM : présence de fichiers VSAM AAADACCE *>****************************************************************AAADACCE *> --- Valeurs par défaut des variables conditionnelles AAADACCE *>>if AA-A-ACCES is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-MODE is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NR is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NS is not defined AAADACCE *>>end-if AAADACCE *CONTROL SOURCE AAADACCE *> --- Validation du contexte AAADACCE *>>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG = '2' AAADACCE * copy AAA00020. AAADACCE *>>define AA-A-DB2 as b'1' override AAA00020 *>>end-if AAADACCE *>>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE *>>end-if AAADACCE *>>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE *> Compteur d'accès AAADACCE 01 5-DM00-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE *>>end-if AAADACCE *>>evaluate AA-A-ACCES AAADACCE * >>when 'L' *> Lecture seule AAADACCE * copy AAA0L000. AAADACCE *> Indicateur accès nouvel enregistrement lu AAA0L000 01 PIC X VALUE '0'. AAA0L000 88 DM-LU VALUE '1' AAA0L000 FALSE '0'. AAA0L000 *>>evaluate AA-A-MODE AAA0L000 * >>when 'S' *> Lecture séquentielle AAA0L000 * copy AAA0LS00. AAA0L000 *>>if AA-A-ORG = '2' AAA0LS00 * copy AAA0LS20. AAA0LS00 *> Témoins état curseur Db2 AAA0LS20 01 W-DM00-CESBCU PIC X VALUE 'C'. AAA0LS20 88 DM-OUVERT VALUE 'O' AAA0LS20 FALSE 'C'. AAA0LS20 *>>end-if AAA0LS00 *>>evaluate true AAA0LS00 * >>when AA-A-NR < 0 *> Accès séquentiel hors itération AAA0LS00 * >>when AA-A-NR = 0 *> Accès séquentiel sans Rupture AAA0LS00 * >>define AA-A-LECTURES as b'1' override AAA0LS00 * >>define AA-A-LECTURES-SANS-RUPT as b'1' override AAA0LS00 * >>when other *> Accès séquentiel avec Rupture AAA0LS00 *>>end-evaluate AAA0LS00 *>>if AA-A-NS > 0 *> Accès séquentiel avec Synchro AAA0LS00 * copy AAA0LSSY. AAA0LS00 *>>define AA-A-LECTURES-AVEC-SYNC as b'1' override AAA0LSSY *>>if AA-A-MAXNS < AA-A-NS AAA0LSSY *>>end-if AAA0LSSY *> Niveau maximum de Configuration (Synchronisation) AAA0LSSY 01 DM-NCF PIC 9(4) COMP-5. AAA0LSSY *> Indicateurs de Configuration (Synchronisation) AAA0LSSY 01 DM-CF. AAA0LSSY 05 DM-CF1 PIC X VALUE '1'. AAA0LSSY *>>if AA-A-NS > 1 AAA0LSSY *>>end-if AAA0LSSY *> Clés de Configuration (Synchronisation) AAA0LSSY 01 DMIND. AAA0LSSY 05 DMIND1. AAA0LSSY 10 DM-IN-COSGDP PIC X(1). AAA0LSSY *>>if AA-A-NS > 1 AAA0LSSY *>>end-if AAA0LSSY *>>end-if AAA0LS00 * >>when 'R' *> Lecture directe AAA0L000 *>>end-evaluate AAA0L000 * >>when 'E' *> Ecriture seule AAADACCE *>>end-evaluate AAADACCE *CONTROL NOSOURCE AAADACCE *> --- Effacement des variables conditionnelles locales AAADACCE *>>define AA-A-ACCES off AAADACCE *>>define AA-A-MODE off AAADACCE *>>define AA-A-ORG off AAADACCE *>>define AA-A-NR off AAADACCE *>>define AA-A-NS off AAADACCE *CONTROL SOURCE AAADACCE cdS100* cdS100*--- Gestion Accès S1 -------------------------------------------- cdS100*>>define AA-A-ACCES as 'E' cdS100*>>define AA-A-MODE as 'S' cdS100*>>define AA-A-ORG as 'F' cdS100*>>define AA-A-NR as 0 cdS100*>>define AA-A-NS as 0 cdS100*>>if AA-A-NR > 0 cdS100*>>end-if cdS100*^^accavad * compléter les lignes ci-dessous * cdS100* copy AAADACCE replacing cdS100* ==:DD:== by ==S1== cdS100* . *CONTROL NOSOURCE AAADACCE *>****************************************************************AAADACCE *> Accès ressource externe. AAADACCE *> Déclaration des variables de gestion de la ressource. AAADACCE *> Cette COPY doit être appelée en Working-Storage Section pour AAADACCE *> chaque accès à une ressource externe. AAADACCE *>----------------------------------------------------------------AAADACCE *> Paramètres REPLACING obligatoires : AAADACCE *> - :DD: : code logigue ressource, 2 caractères AAADACCE *> Paramètres facultatifs (selon contexte) : AAADACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAADACCE *> - :P: : picture(s) clé(s) de rupture / synchro au rang n AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilation locales : AAADACCE *> - AA-A-ACCES : type d'accès, obligatoire AAADACCE *> - 'L' : Lecture (défaut) AAADACCE *> - 'E' : Ecriture (un seul type d'écriture) AAADACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAADACCE *> - 'X' : Lecture (L) et Modification (M) AAADACCE *> - 'T' : Chargement en table mémoire AAADACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAADACCE *> - AA-A-MODE : mode d'accès, facultatif AAADACCE *> - 'S' : Séquentiel (défaut) AAADACCE *> - 'R' : Direct AAADACCE *> - 'D' : Dynamique (réservé aux fichiers VSAM) AAADACCE *> - AA-A-ORG : type d'organisation, facultatif AAADACCE *> - 'F' : Fichier Séquentiel (défaut) AAADACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAADACCE *> - 'R' : Fichier VSAM Random (RRDS) AAADACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAADACCE *> - '2' : Accès Db2 AAADACCE *> - 'I' : Document formaté (Mode Séquentiel) AAADACCE *> - 'X' : Document XML (Mode Séquentiel) AAADACCE *> - 'J' : Document JSON (Mode Séquentiel) AAADACCE *> - 'P' : Procédure interne (Impressions) AAADACCE *> - 'S' : Spooleur externe (Impressions) AAADACCE *> - AA-A-NR : niveau de Rupture, facultatif AAADACCE *> - 0 : pas de Rupture (défaut) AAADACCE *> - 1 à 9 : nombre de niveaux de Rupture AAADACCE *> - < 0 : hors itération AAADACCE *> - AA-A-NS : niveau de Synchronisation AAADACCE *> - 0 : pas de Synchronisation AAADACCE *> - 1 à 9 : nombre de niveaux de Synchronisation AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilations globales impactées : AAADACCE *> - AA-A-MAXNR : niveau maximum de Ruptures AAADACCE *> - AA-A-MAXNS : niveau maximum de Synchronisation AAADACCE *> - AA-A-LECTURES-SANS-RUPT : traitement lectures sans Rupture AAADACCE *> - AA-A-LECTURES-AVEC-RUPT : traitement lectures avec Ruptures AAADACCE *> - AA-A-ECRITURES : traitement écritures AAADACCE *> - AA-A-DB2 : présence d'accès DB2 AAADACCE *> - AA-A-VSAM : présence de fichiers VSAM AAADACCE *>****************************************************************AAADACCE *> --- Valeurs par défaut des variables conditionnelles AAADACCE *>>if AA-A-ACCES is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-MODE is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NR is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NS is not defined AAADACCE *>>end-if AAADACCE *CONTROL SOURCE AAADACCE *> --- Validation du contexte AAADACCE *>>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG = '2' AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE *>>end-if AAADACCE *>>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE *> Compteur d'accès AAADACCE 01 5-S100-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE *>>end-if AAADACCE *>>evaluate AA-A-ACCES AAADACCE * >>when 'L' *> Lecture seule AAADACCE * >>when 'E' *> Ecriture seule AAADACCE * copy AAA0E000. AAADACCE *>>evaluate AA-A-MODE AAA0E000 * >>when 'S' *> Ecriture séquentielle AAA0E000 * copy AAA0ES00. AAA0E000 *>>if AA-A-NR >= 0 AAA0ES00 * >>define AA-A-ECRITURES as b'1' override AAA0ES00 *>>end-if AAA0ES00 *>>evaluate AA-A-ORG AAA0ES00 * >>when 'X' *> Document XML AAA5ES00 *>>end-evaluate AAA0ES00 * >>when 'R' *> Ecriture directe AAA0E000 *>>end-evaluate AAA0E000 * >>when 'M' *> Modification seule AAADACCE *>>end-evaluate AAADACCE *CONTROL NOSOURCE AAADACCE *> --- Effacement des variables conditionnelles locales AAADACCE *>>define AA-A-ACCES off AAADACCE *>>define AA-A-MODE off AAADACCE *>>define AA-A-ORG off AAADACCE *>>define AA-A-NR off AAADACCE *>>define AA-A-NS off AAADACCE *CONTROL SOURCE AAADACCE cdS200* cdS200*--- Gestion Accès S2 -------------------------------------------- cdS200*>>define AA-A-ACCES as 'E' cdS200*>>define AA-A-MODE as 'S' cdS200*>>define AA-A-ORG as 'F' cdS200*>>define AA-A-NR as 0 cdS200*>>define AA-A-NS as 0 cdS200*>>if AA-A-NR > 0 cdS200*>>end-if cdS200*^^accavad * compléter les lignes ci-dessous * cdS200* copy AAADACCE replacing cdS200* ==:DD:== by ==S2== cdS200* . *CONTROL NOSOURCE AAADACCE *>****************************************************************AAADACCE *> Accès ressource externe. AAADACCE *> Déclaration des variables de gestion de la ressource. AAADACCE *> Cette COPY doit être appelée en Working-Storage Section pour AAADACCE *> chaque accès à une ressource externe. AAADACCE *>----------------------------------------------------------------AAADACCE *> Paramètres REPLACING obligatoires : AAADACCE *> - :DD: : code logigue ressource, 2 caractères AAADACCE *> Paramètres facultatifs (selon contexte) : AAADACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAADACCE *> - :P: : picture(s) clé(s) de rupture / synchro au rang n AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilation locales : AAADACCE *> - AA-A-ACCES : type d'accès, obligatoire AAADACCE *> - 'L' : Lecture (défaut) AAADACCE *> - 'E' : Ecriture (un seul type d'écriture) AAADACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAADACCE *> - 'X' : Lecture (L) et Modification (M) AAADACCE *> - 'T' : Chargement en table mémoire AAADACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAADACCE *> - AA-A-MODE : mode d'accès, facultatif AAADACCE *> - 'S' : Séquentiel (défaut) AAADACCE *> - 'R' : Direct AAADACCE *> - 'D' : Dynamique (réservé aux fichiers VSAM) AAADACCE *> - AA-A-ORG : type d'organisation, facultatif AAADACCE *> - 'F' : Fichier Séquentiel (défaut) AAADACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAADACCE *> - 'R' : Fichier VSAM Random (RRDS) AAADACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAADACCE *> - '2' : Accès Db2 AAADACCE *> - 'I' : Document formaté (Mode Séquentiel) AAADACCE *> - 'X' : Document XML (Mode Séquentiel) AAADACCE *> - 'J' : Document JSON (Mode Séquentiel) AAADACCE *> - 'P' : Procédure interne (Impressions) AAADACCE *> - 'S' : Spooleur externe (Impressions) AAADACCE *> - AA-A-NR : niveau de Rupture, facultatif AAADACCE *> - 0 : pas de Rupture (défaut) AAADACCE *> - 1 à 9 : nombre de niveaux de Rupture AAADACCE *> - < 0 : hors itération AAADACCE *> - AA-A-NS : niveau de Synchronisation AAADACCE *> - 0 : pas de Synchronisation AAADACCE *> - 1 à 9 : nombre de niveaux de Synchronisation AAADACCE *>----------------------------------------------------------------AAADACCE *> Variables de compilations globales impactées : AAADACCE *> - AA-A-MAXNR : niveau maximum de Ruptures AAADACCE *> - AA-A-MAXNS : niveau maximum de Synchronisation AAADACCE *> - AA-A-LECTURES-SANS-RUPT : traitement lectures sans Rupture AAADACCE *> - AA-A-LECTURES-AVEC-RUPT : traitement lectures avec Ruptures AAADACCE *> - AA-A-ECRITURES : traitement écritures AAADACCE *> - AA-A-DB2 : présence d'accès DB2 AAADACCE *> - AA-A-VSAM : présence de fichiers VSAM AAADACCE *>****************************************************************AAADACCE *> --- Valeurs par défaut des variables conditionnelles AAADACCE *>>if AA-A-ACCES is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-MODE is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NR is not defined AAADACCE *>>end-if AAADACCE *>>if AA-A-NS is not defined AAADACCE *>>end-if AAADACCE *CONTROL SOURCE AAADACCE *> --- Validation du contexte AAADACCE *>>if AA-A-NR < 0 and AA-A-NS > 0 AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG = '2' AAADACCE *>>end-if AAADACCE *>>if AA-A-ORG = 'K' or AA-A-ORG = 'R' or AA-A-ORG = 'E' AAADACCE *>>end-if AAADACCE *>>if AA-A-ACCES not = 'I' or AA-A-MODE not = 'E' AAADACCE *> Compteur d'accès AAADACCE 01 5-S200-CPTENR PIC S9(9) BINARY VALUE 0. AAADACCE *>>end-if AAADACCE *>>evaluate AA-A-ACCES AAADACCE * >>when 'L' *> Lecture seule AAADACCE * >>when 'E' *> Ecriture seule AAADACCE * copy AAA0E000. AAADACCE *>>evaluate AA-A-MODE AAA0E000 * >>when 'S' *> Ecriture séquentielle AAA0E000 * copy AAA0ES00. AAA0E000 *>>if AA-A-NR >= 0 AAA0ES00 * >>define AA-A-ECRITURES as b'1' override AAA0ES00 *>>end-if AAA0ES00 *>>evaluate AA-A-ORG AAA0ES00 * >>when 'X' *> Document XML AAA5ES00 *>>end-evaluate AAA0ES00 * >>when 'R' *> Ecriture directe AAA0E000 *>>end-evaluate AAA0E000 * >>when 'M' *> Modification seule AAADACCE *>>end-evaluate AAADACCE *CONTROL NOSOURCE AAADACCE *> --- Effacement des variables conditionnelles locales AAADACCE *>>define AA-A-ACCES off AAADACCE *>>define AA-A-MODE off AAADACCE *>>define AA-A-ORG off AAADACCE *>>define AA-A-NR off AAADACCE *>>define AA-A-NS off AAADACCE *CONTROL SOURCE AAADACCE sqwaf *> *> zone injection fin <* <* sqwaf * sqwa2 *--- Interface accès Db2 ----------------------------------------- sqwa2 *>>if AA-A-DB2 sqwa2 * exec sql include SQLCA end-exec. 01 SQLCA GLOBAL VOLATILE. 05 SQLCAID PIC X(8). 05 SQLCABC PIC S9(9) COMP-5. 05 SQLCODE PIC S9(9) COMP-5. 05 SQLERRM. 49 SQLERRML PIC S9(4) COMP-5. 49 SQLERRMC PIC X(70). 05 SQLERRP PIC X(8). 05 SQLERRD PIC S9(9) COMP-5 OCCURS 6 TIMES. 05 SQLWARN. 10 SQLWARN0 PIC X. 10 SQLWARN1 PIC X. 10 SQLWARN2 PIC X. 10 SQLWARN3 PIC X. 10 SQLWARN4 PIC X. 10 SQLWARN5 PIC X. 10 SQLWARN6 PIC X. 10 SQLWARN7 PIC X. 05 SQLEXT. 10 SQLWARN8 PIC X. 10 SQLWARN9 PIC X. 10 SQLWARNA PIC X. 10 SQLSTATE PIC X(5). sqwa2 *>>end-if sqwa2 * sqwa3 *--- Interface accès VSAM ---------------------------------------- sqwa3 *>>if AA-A-VSAM sqwa3 *>>end-if sqwa3 * sqwac * --- Ruptures Globales ------------------------------------------ sqwac *>>if AA-A-LECTURES-AVEC-RUPT sqwac * copy AAADGRUP. *CONTROL NOSOURCE AAADGRUP *>****************************************************************AAADGRUP *> Gestion des ruptures au niveau global AAADGRUP *>----------------------------------------------------------------AAADGRUP *> Conditions d'utilisation : AAADGRUP *> L'ensemble des ressources avec ruptures doivent avoir été AAADGRUP *> déclarées au moyen du COPYBOOK "AAADACCE" avant appel au AAADGRUP *> COPYBOOK "AAADGRUP". AAADGRUP *>----------------------------------------------------------------AAADGRUP *> Paramètres obligatoires : AAADGRUP *> - Néant AAADGRUP *> Paramètres facultatifs (selon contexte) : AAADGRUP *> - Néant AAADGRUP *> Variables de compilation : AAADGRUP *> - AA-A-MAXNR : calculée, niveau de rupture maximum toutes AAADGRUP *> ressources AAADGRUP *>****************************************************************AAADGRUP *CONTROL SOURCE AAADGRUP *>>if AA-A-MAXNR > 0 AAADGRUP *> AAADGRUP *> Niveau Rupture Première AAADGRUP 01 NRP PIC 9 VALUE 0. AAADGRUP *> Ruptures Totales Premières AAADGRUP 01 RTP. AAADGRUP 05 RTP1 PIC X VALUE '1'. AAADGRUP *>>if AA-A-MAXNR > 1 AAADGRUP 05 RTP2 PIC X VALUE '1'. AAADGRUP * >>if AA-A-MAXNR > 2 AAADGRUP * >>end-if AAADGRUP *>>end-if AAADGRUP *> Niveau Rupture Dernière AAADGRUP 01 NRD PIC 9 VALUE 1. AAADGRUP *> Ruptures Totales Dernières AAADGRUP 01 RTD. AAADGRUP 05 RTD1 PIC X VALUE '1'. AAADGRUP *>>if AA-A-MAXNR > 1 AAADGRUP 05 RTD2 PIC X VALUE '1'. AAADGRUP * >>if AA-A-MAXNR > 2 AAADGRUP * >>end-if AAADGRUP *>>end-if AAADGRUP *> Zones de travail AAADGRUP 01 NRD2 PIC 9(4) COMP-5. AAADGRUP 01 IRTD PIC 9(4) COMP-5. AAADGRUP *>>end-if AAADGRUP sqwac *>>end-if sqwac *--- Configurations Globales ------------------------------------- sqwac *>>if AA-A-LECTURES-AVEC-SYNC sqwac * copy AAADGSYN sqwacd*> *> zone injection debut <* <* cd***** replacing cd***** ==:P1:== by ==X(1)== cd**** sqwacf*> *> zone injection fin <* <* sqwacf* . *CONTROL NOSOURCE AAADGSYN *>****************************************************************AAADGSYN *> Gestion des Configurations au niveau global AAADGSYN *>----------------------------------------------------------------AAADGSYN *> Conditions d'utilisation : AAADGSYN *> L'ensemble des ressources avec synchronisation doivent avoir AAADGSYN *> été déclarées au moyen du COPYBOOK "AAADACCE" avant appel au AAADGSYN *> COPYBOOK "AAADGSYN". AAADGSYN *>----------------------------------------------------------------AAADGSYN *> Paramètres obligatoires : AAADGSYN *> - Néant AAADGSYN *> Paramètres facultatifs (selon contexte) : AAADGSYN *> - Pn : PICture clé rang n, n de 1 à 9 AAADGSYN *> Variables de compilation : AAADGSYN *> - AA-A-MAXNS : calculée, niveau de synchro maximum toutes AAADGSYN *> ressources AAADGSYN *>****************************************************************AAADGSYN *CONTROL SOURCE AAADGSYN *>>if AA-A-MAXNS > 0 AAADGSYN *> AAADGSYN *> Clés de Synchronisation AAADGSYN 01 IND. AAADGSYN 05 IND1. AAADGSYN 10 PIC X(1). AAADGSYN *>>if AA-A-MAXNS > 1 AAADGSYN *>>end-if AAADGSYN 66 TIND1 RENAMES IND1. AAADGSYN *>>if AA-A-MAXNS > 1 AAADGSYN *>>end-if AAADGSYN *> AAADGSYN *> Niveau de Configuration maximum de l'itération courante AAADGSYN 01 MAX-CF PIC 9(4) COMP-5. AAADGSYN *>>end-if AAADGSYN sqwacf*>>end-if sqwacf* sqwft *--- Indicateurs de fin de lecture ------------------------------- sqwft 01 FT. sqwft 88 FIN-LECTURES VALUE ALL '1' sqwft FALSE ALL '0'. sqwftd*> *> zone injection debut <* <* cdAP00 05 AP-FT PIC X VALUE '0'. cdAP00 88 FIN-LECTURE-AP VALUE '1' cdAP00 FALSE '0'. cdDM00 05 DM-FT PIC X VALUE '0'. cdDM00 88 FIN-LECTURE-DM VALUE '1' cdDM00 FALSE '0'. sqwftf*> *> zone injection fin <* <* sqwftf*>>if not AA-A-LECTURES sqwftf*>>end-if sqwftf* sqwfi *>>if AA-A-LECTURES-AVEC-RUPT sqwfi *--- Indicateurs de dernier enregistrement avec rupture----------- sqwfi 01 FI. sqwfi 88 DERNIERE-ITERATION VALUE ALL '1' sqwfi FALSE ALL '0'. sqwfid*> *> zone injection debut <* <* cdAP00 05 AP-FI PIC X VALUE '0'. cdAP00 88 DERNIERE-LECTURE-AP VALUE '1' cdAP00 FALSE '0'. sqwfif*> *> zone injection fin <* <* sqwfif*>>end-if sqwfif* sqwsv *----------------------------------------------------------------- sqwsv * W W RRRR K K SSSS EEEEE RRRR V V sqwsv * W W R R K KK S E R R V V sqwsv * W W W RRRR KK SSS EEEE RRRR V V sqwsv * W W W R R K KK S E R R V V .. sqwsv * W W R R K K SSSS EEEEE R R V .. sqwsv *----------------------------------------------------------------- sqwsv *--- Variables de travail du framework compatible Pacbase -------- sqwsv * copy AGADPAC0. *CONTROL NOSOURCE AGADPAC0 *>****************************************************************AGADPAC0 *> Variables standard Pacbase AGADPAC0 *> Ce copybook reproduit les variables de travail qui sont AGADPAC0 *> utilisées dans certaines fonctions du framework. AGADPAC0 *> Chaque programme COBOL doit appeler ce copybook. AGADPAC0 *-----------------------------------------------------------------AGADPAC0 *> BLANC : constante 1 caractère initialisée à SPACE AGADPAC0 *> IK : résultat d'un accès, (Invalid Key) : '0'=OK, '1'=KO AGADPAC0 *> TALLI : variable pour comptages (COBOL déclare TALLY) AGADPAC0 *> EN-PRE : indicateur présence ou état AGADPAC0 *>****************************************************************AGADPAC0 *CONTROL SOURCE AGADPAC0 *>>define AA-G-VARPACBASE as b'1' override AGADPAC0 *> --- Variables Pacbase (pour compatibilité) AGADPAC0 01 BLANC PIC X VALUE SPACE. AGADPAC0 01 IK PIC X. AGADPAC0 88 IK-OK VALUE '0' AGADPAC0 FALSE '1'. AGADPAC0 88 IK-KO VALUE '1' AGADPAC0 FALSE '0'. AGADPAC0 01 TALLI PIC S9(4) BINARY VALUE 0. AGADPAC0 01 EN-PRE PIC X. AGADPAC0 *> Contrôles de validité / invalidité sur date AGADPAC0 88 5-DATE-VALIDE VALUE '1'. AGADPAC0 88 5-DATE-INVALIDE VALUE '5'. AGADPAC0 sqwsv *--- Gestion des opérations sur Dates et Heures ------------------ sqwsv * copy ADADDATE. *CONTROL NOSOURCE ADADDATE *>****************************************************************ADADDATE *> Variable de traitements de Date et Heure. ADADDATE *> Cette COPY doit être appelée en Working-Storage Section une ADADDATE *> fois en cas de traitement de Dates ou Heures. ADADDATE *>----------------------------------------------------------------ADADDATE *> Paramètres obligatoires : ADADDATE *> Néant. ADADDATE *>----------------------------------------------------------------ADADDATE *> Variables de compilation : ADADDATE *> Néant. ADADDATE *>----------------------------------------------------------------ADADDATE *> Compatibilité Pacbase : ADADDATE *> Les noms de certaines variables ne suivent pas le plan de ADADDATE *> nommage de Pacbase. Les noms Pacbase sont indiqués en ADADDATE *> commentaires flottant sur chaque variable. ADADDATE *> Si nécessaire, certains noms de variables peuvent être ADADDATE *> modifiés lors de l'appel du COPYBOOK ADADDATE ; dans ce cas ADADDATE *> les mêmes modifications doivent être appliquées à l'appel du ADADDATE *> COPYBOOK de procédure AAAPDATE. ADADDATE *>****************************************************************ADADDATE *CONTROL SOURCE ADADDATE *> ADADDATE *> --- Variables compatibles Pacbase ADADDATE *> ADADDATE *> DATE DU JOUR COMPLETE ADADDATE 01 FULL-CURRENT-DATE. ADADDATE *> DATE DU JOUR ADADDATE 05 DATCE. ADADDATE 10 CENTUR. ADADDATE 15 CC PIC XX VALUE '20'. ADADDATE 10 DATOR. ADADDATE 15 DATOA. ADADDATE 20 YY PIC XX. ADADDATE 15 DATOM. ADADDATE 20 MM PIC XX. ADADDATE 15 DATOJ. ADADDATE 20 DD PIC XX. ADADDATE *> HEURE COURANTE HHMMSSCC ADADDATE 05 TIMCO. ADADDATE 10 TIMCOH. ADADDATE 15 HH PIC XX. ADADDATE 10 TIMCOM. ADADDATE 15 MM PIC XX. ADADDATE 10 TIMCOS. ADADDATE 15 SS PIC XX. ADADDATE 10 TIMOC. ADADDATE 15 TIMCOC. ADADDATE 20 CC PIC XX. ADADDATE *> TIME-ZONE ADADDATE 05 TZ. ADADDATE 10 TZ-GMT PIC X. ADADDATE 88 TZ-BEHIND-GMT VALUE '-'. ADADDATE 88 TZ-AHEAD-GMT VALUE '+'. ADADDATE 10 TZ-HH PIC XX. ADADDATE 10 TZ-MM PIC XX. ADADDATE *> HEURE FORMAT HH:MM:SS ADADDATE 01 TIMDAY. ADADDATE 05 TIMHOU. ADADDATE 10 HH PIC XX. ADADDATE 05 TIMS1. ADADDATE 10 S1 PIC X VALUE ':'. ADADDATE 05 TIMMIN. ADADDATE 10 MM PIC XX. ADADDATE 05 TIMS2. ADADDATE 10 S2 PIC X VALUE ':'. ADADDATE 05 TIMSEC. ADADDATE 10 SS PIC XX. ADADDATE *> SEPARATEUR DATE PAR DEFAUT ADADDATE 01 DATSEP PIC X VALUE '/'. ADADDATE *> SEPARATEUR DATE FORMAT G ADADDATE 01 DATSET PIC X VALUE '-'. ADADDATE *> SEPARATEUR DATE DE TRAVAIL (non utilisé dans version COBOL) ADADDATE 01 DATSEW PIC X. ADADDATE *> SEPARATEUR HEURE PAR DEFAUT ADADDATE 01 TIMSEP PIC X VALUE ':'. ADADDATE *> NOMBRE DE JOURS DANS CALCULS SUR DATE ADADDATE 01 NUM-DAYS PIC S9(9). ADADDATE *> ADADDATE *> --- Variables de communication avec les routines ADADDATE *> ADADDATE *> DATE FORMAT C : JJMMSSAA ADADDATE 01 5-DATE-C. *> DAT7C ADADDATE 05 DD PIC XX. *> DAT71C ADADDATE 05 MM PIC XX. *> DAT72C ADADDATE 05 YYYY. ADADDATE 10 CC PIC XX. *> DAT73C ADADDATE 10 YY PIC XX. *> DAT74C ADADDATE *> DATE FORMAT D : JJMMAA ADADDATE 01 5-DATE-D. *> DAT7 ADADDATE 05 DD PIC XX. *> DAT71 ADADDATE 05 MM PIC XX. *> DAT72 ADADDATE 05 YY PIC XX. *> DAT73 ADADDATE *> DATE FORMAT E : JJ/MM/AA ADADDATE 01 5-DATE-E. *> DAT8 ADADDATE 05 DD PIC XX. *> DAT81 ADADDATE 05 S1 PIC X. *> DAT8S1 ADADDATE 05 MM PIC XX. *> DAT82 ADADDATE 05 S2 PIC X. *> DAT8S2 ADADDATE 05 YY PIC XX. *> DAT83 ADADDATE *> DATE FORMAT G : SSAA-MM-JJ ADADDATE 01 5-DATE-G. *> DAT8G ADADDATE 05 YYYY. ADADDATE 10 CC PIC XX. *> DAT81G ADADDATE 10 YY PIC XX. *> DAT82G ADADDATE 05 S1 PIC X VALUE '-'. *> DAT8S1G ADADDATE 05 MM PIC XX. *> DAT83G ADADDATE 05 S2 PIC X VALUE '-'. *> DATS2G ADADDATE 05 DD PIC XX. *> DAT84G ADADDATE *> DATE FORMAT I : AAMMJJ ADADDATE 01 5-DATE-I. *> DAT6 ADADDATE 05 YY PIC XX. *> DAT61 ADADDATE 05 MM PIC XX. *> DAT62 ADADDATE 05 DD PIC XX. *> DAT63 ADADDATE *> DATE FORMAT M : JJ/MM/SSAA ADADDATE 01 5-DATE-M. *> DAT8C ADADDATE 05 DD PIC XX. *> DAT81C ADADDATE 05 S1 PIC X VALUE '/'. *> DATS1C ADADDATE 05 MM PIC XX. *> DAT82C ADADDATE 05 S2 PIC X VALUE '/'. *> DATS2C ADADDATE 05 YYYY. *> DAT83C ADADDATE 10 CC PIC XX. *> DAT83CC ADADDATE 10 YY PIC XX. *> DAT84C ADADDATE *> DATE FORMAT S : SSAAMMJJ ADADDATE 01 5-DATE-S. *> DAT6C ADADDATE 05 YYYY. ADADDATE 10 CC. *> DAT61C ADADDATE 15 CC9 PIC 99. ADADDATE 10 YY. *> DAT62C ADADDATE 15 YY9 PIC 99. ADADDATE 05 MM PIC XX. *> DAT63CC ADADDATE 05 DD PIC XX. *> DAT64C ADADDATE *> HEURE FORMAT HHMMSS ADADDATE 01 5-TIME. ADADDATE 05 HH PIC X(2). ADADDATE 05 MM PIC X(2). ADADDATE 05 SS PIC X(2). ADADDATE *> FENETRAGE DU SIECLE ADADDATE 01 5-DATE-PIVOT PIC XX VALUE '61'. *> DAT-CTYT ADADDATE 01 5-DATE-SIECLE PIC XX VALUE '19'. *> DAT-CTY ADADDATE 01 5-DATE-ADO PIC X VALUE SPACE. *> DAT-ADO ADADDATE 88 5-DATE-SIECLE-DEF VALUE '0'. ADADDATE 88 5-DATE-1900-AVANT VALUE '1'. ADADDATE 88 5-DATE-2000-AVANT VALUE '2'. ADADDATE *> DATES FORMAT SSAAMMJJ POUR CALCULS ADADDATE 01 5-DATE-D1 PIC 9(8). *> DATE81 ADADDATE 01 5-DATE-D2 PIC 9(8). *> DATE82 ADADDATE *>>if AA-G-CICS ADADDATE *>>end-if ADADDATE *> ADADDATE *> --- Variables de travail internes (ne pas utiliser) ADADDATE *> ADADDATE *> CALCUL ANNEE BISSECTILE ADADDATE 01 5-DATE-M4 PIC 99 BINARY. *> LEAP-REM ADADDATE *>>if not AA-G-VARPACBASE ADADDATE *>>end-if ADADDATE *>>if AA-G-PACBASE ADADDATE *>>end-if ADADDATE sqwvsd*--- insertion working par l'assistant --------------------------- sqwvsd*> *> zone injection debut <* <* sqwvsf*> *> zone injection fin <* <* sqwvsf* sqwvv *----------------------------------------------------------------- sqwvv * W W RRRR K K CCC TTTTT RRRR L sqwvv * W W R R K KK C C T R R L sqwvv * W W W RRRR KK C T RRRR L sqwvv * W W W R R K KK C C T R R L .. sqwvv * W W R R K K CCC T R R LLLLL .. sqwvv *----------------------------------------------------------------- sqwvv *--- Variables pour contrôles automatiques ----------------------- sqwvvd*> *> zone injection début <* <* sqwvvf*> *> zone injection fin <* <* sqwvvf* sqwsva*--- Traçabilité programme (reco audit) -------------------------- sqwsva* copy AGADAUDT. *CONTROL NOSOURCE AGADAUDT *>****************************************************************AGADAUDT *> Tracabilité programme - Reco "Audit Archivage 2010" #5 AGADAUDT *-----------------------------------------------------------------AGADAUDT *> Paramètres obligatoires : AGADAUDT *> - Néant AGADAUDT *> Paramètres facultatifs (selon contexte) : AGADAUDT *> - Néant AGADAUDT *> Variables de compilation : AGADAUDT *> - Néant AGADAUDT *>****************************************************************AGADAUDT *CONTROL SOURCE AGADAUDT *> AGADAUDT *> Tracabilité programme - Reco "Audit Archivage 2010" #5 AGADAUDT *> Date système format JJMMSSAA (C) AGADAUDT 01 W-BA0C-DASDSY PIC X(8). AGADAUDT *> Date système format SSAA-MM-JJ (G) AGADAUDT 01 W-BA0G-DASDSY PIC X(10). AGADAUDT *> Date système format JJ/MM/SSAA (M) AGADAUDT 01 W-BA0M-DASDSY PIC X(10). AGADAUDT *> Indicateur d'exécution : 0=jamais, 1=1ère fois, 2=après 1ère AGADAUDT 01 PIC X VALUE '0'. AGADAUDT 88 RECO-ARCH-2010-5-notRUN VALUE '0' AGADAUDT FALSE '1'. AGADAUDT 88 RECO-ARCH-2010-5-wasRUN VALUE '2'. AGADAUDT sqwsv2*--- Erreur Db2 -------------------------------------------------- sqwsv2*>>if AA-A-DB2 sqwsv2* copy A2ADTIAR. *CONTROL NOSOURCE A2ADTIAR *>****************************************************************A2ADTIAR *> Zone message interface DSNTIAR A2ADTIAR *> - DSNTIAR-LINE-LENGTH : longueur logique d'une ligne du A2ADTIAR *> message formaté par le module DSNTIAR A2ADTIAR *> - DSNTIAR-MESSAGE : zone contenant le messsage formaté par le A2ADTIAR *> module DSNTIAR A2ADTIAR *> - DSNTIAR-MESSAGE-LENGTH : longueur de la zone message A2ADTIAR *> - DSNTIAR-MESSAGE-LINE : ligne de message ; la première ligne A2ADTIAR *> entièrement à space indique la fin du message A2ADTIAR *> - DSNTIAR-RC : code retour appel à DSNTIAR A2ADTIAR *> - DSNTIAR-ABEND : preparation du code abend avec valeur A2ADTIAR *> SQLCODE A2ADTIAR *>****************************************************************A2ADTIAR *CONTROL SOURCE A2ADTIAR *> --- Interface DSNTIAR A2ADTIAR 01 DSNTIAR-RC PIC 9(2). A2ADTIAR 88 DSNTIAR-OK VALUE 00 THRU 04. A2ADTIAR 01 DSNTIAR-ABEND PIC 9(8) COMP-5. A2ADTIAR 01 DSNTIAR-LINE-LENGTH PIC 9(8) COMP-5 A2ADTIAR VALUE 72. A2ADTIAR 01 DSNTIAR-MESSAGE. A2ADTIAR 05 DSNTIAR-MESSAGE-LENGTH PIC 9(4) COMP-5 A2ADTIAR VALUE 720. A2ADTIAR 05 DSNTIAR-LINES. A2ADTIAR 10 DSNTIAR-LINE PIC X(72) OCCURS 10 A2ADTIAR INDEXED BY XDSNTIAR. A2ADTIAR 88 DSNTIAR-END VALUE SPACES. A2ADTIAR sqwsv2*>>end-if sqwsvb*--- Erreur abend volontaire (U4000 par défaut) ----------------- sqwsvb 01 CODE-ABEND PIC 9(8) COMP-5 VALUE 4000. sqwk *----------------------------------------------------------------- sqwk * W W RRRR K K SSSS PPPP EEEEE CCC sqwk * W W R R K KK S P P E C C sqwk * W W W RRRR KK SSS PPPP EEEE C sqwk * W W W R R K KK S P E C C .. sqwk * W W R R K K SSSS P EEEEE CCC .. sqwk *----------------------------------------------------------------- sqwk * Insérer ci-dessous les variables spécifiques du programme sqwk * 01 W-WB00-W9040 PIC S9(4) BINARY. sqwkd *> *> zone injection debut <* <* sqwkf *> *> zone injection fin <* <* sqwkf 01 PIC X(1) VALUE '0'. sqwkf 88 WORKING-INITIALISEES VALUE '1' sqwkf FALSE '0'. sqlk LINKAGE SECTION. sqlk *================================================================= sqlk * L N N K K SSSS EEEEE CCC TTTTT sqlk * L NN N K KK S E C C T sqlk * L N N N KK SSS EEEE C T sqlk * L N NN K KK S E C C T sqlk * LLLLL N N K K SSSS EEEEE CCC T sqlk *================================================================= sqlkd *> *> zone injection debut <* <* sqlkf *> *> zone injection fin <* <* sqlkf * Insérer ci-dessous les variables spécifiques du programme sqlkf * sqp /***************************************************************** sqp * PPPP RRRR OOO CCC EEEEE DDDD U U RRRR EEEEE sqp * P P R R O O C C E D D U U R R E sqp * PPPP RRRR O O C EEE D D U U RRRR EEEE sqp * P R R O O C C E D D U U R R E sqp * P R R OOO CCC EEEEE DDDD UUU R R EEEEE sqp ****************************************************************** sqp PROCEDURE DIVISION. * USING ... . sqpp *=== Cinematique principale ====================================== sqpp PRINCIPAL SECTION. sqpp *--- Gestion des erreurs Db2 ------------------------------------- sqpp * >>if AA-A-DB2 exec sql whenever NOT FOUND continue end-exec. exec sql whenever SQLWARNING continue end-exec. exec sql whenever SQLERROR goto ERREUR-DB2 end-exec. sqppa * >>end-if sqppa *--- Initialisations --------------------------------------------- sqppa perform INITIALISATIONS-WORKING sqppa with test before until WORKING-INITIALISEES sqppa perform S-DEBUT sqppa perform INITIALISATIONS sqppa perform S-AVANT-OUVERTURES sqppa perform OUVERTURES sqppa perform S-AVANT-ITERATION sqppa *--- Boucle principale ------------------------------------------- sqppa perform ITERATION until FIN-LECTURES. sqppa *--- Abandon du traitment (GFT) ---------------------------------- sqppa FIN-TRAITEMENT. sqppa *--- Finalisations ----------------------------------------------- sqppa perform S-AVANT-FERMETURES sqppa perform FERMETURES sqppa perform S-AVANT-FINALISATION sqppa perform FINALISATION sqppaz*--- Sortie du programme ----------------------------------------- sqppaz goback sqppaz . sqppi *=== Décomposition de la boucle principale ======================= sqppi ITERATION SECTION. sqppi perform S-AVANT-LECTURES sqppi * >>if AA-A-LECTURES sqppi perform LECTURES sqppi * >>end-if sqppi if not FIN-LECTURES sqppi perform S-APRES-LECTURES sqppir*--- Cinématique ressources lues --------------------------------- sqppir* >>if AA-A-LECTURES-AVEC-RUPT or AA-A-LECTURES-AVEC-SYNC sqppir perform RUPTURES-SYNCHROS sqppir* >>end-if sqppir* >>if AA-A-CONTROLES sqppir* >>end-if sqppir* >>if AA-A-MAJ sqppir* >>end-if sqppit*--- Taitement applicatif principal ------------------------------ sqppit perform S-TRAITEMENT sqppie*--- Editions ---------------------------------------------------- sqppie* >>if AA-A-EDITIONS sqppie* >>end-if sqppiw*--- Ressources en écritures ------------------------------------- sqppiw* >>if AA-A-ECRITURES sqppiw perform ECRITURES sqppiw* >>end-if sqppiw end-if. sqppif*--- Retour en début d'itération (GDI) --------------------------- sqppif ITERATION-SUIVANTE. sqppif continue. sqppif ITERATION-FN. sqppif exit section. sqppif sqpz /================================================================= sqpz * CCC OOO DDDD EEEEE SSSS PPPP EEEEE sqpz * C C O O D D E S P P E sqpz * C O O D D EEEE SSS PPPP EEEE sqpz * C C O O D D E S P E sqpz * CCC OOO DDDD EEEEE SSSS P EEEEE sqpz *================================================================= sqpz0a* sqpz0a*================================================================= sqpz0a* Début de programme, avant tout autre traitement sqpz0a*================================================================= sqpz0a S-DEBUT SECTION. sqpz0a* Insérer ci-dessous le code spécifiques du programme sqpz0z*--- Fin début de programme -------------------------------------- sqpz0z continue. sqpz0z S-DEBUT-FN. sqpz0z exit section. sqpz0z* sqpz0z*--- Routines performées depuis S-DEBUT -------------------------- sqpz0z* Insérer ci-dessous le code spécifiques du programme sqpz1a* sqpz1a*================================================================= sqpz1a* Avant ouvertures des ressources sqpz1a*================================================================= sqpz1a S-AVANT-OUVERTURES SECTION. sqpz1a* Insérer ci-dessous le code spécifiques du programme sqpz1z*--- Fin avant ouverture des ressources -------------------------- sqpz1z continue. sqpz1z S-AVANT-OUVERTURES-FN. sqpz1z exit section. sqpz1z* sqpz1z*--- Routines performées depuis S-AVANT-OUVERTURES --------------- sqpz1z* Insérer ci-dessous le code spécifiques du programme sqpz2a* sqpz2a*================================================================= sqpz2a* Avant itération principale sqpz2a*================================================================= sqpz2a S-AVANT-ITERATION SECTION. sqpz2a* Insérer ci-dessous le code spécifiques du programme sqpz2z*--- Fin avant itération principale ------------------------------ sqpz2z continue. sqpz2z S-AVANT-ITERATION-FN. sqpz2z exit section. sqpz2z* sqpz2z*--- Routines performées depuis S-AVANT-ITERATION ---------------- sqpz2z* Insérer ci-dessous le code spécifiques du programme sqpz3a* sqpz3a*================================================================= sqpz3a* Avant lectures des ressources sqpz3a*================================================================= sqpz3a S-AVANT-LECTURES SECTION. sqpz3a* Insérer ci-dessous le code spécifiques du programme sqpz3z*--- Fin avant lectures des ressources --------------------------- sqpz3z continue. sqpz3z S-AVANT-LECTURES-FN. sqpz3z exit section. sqpz3z* sqpz3z*--- Routines performées depuis S-AVANT-LECTURES ----------------- sqpz3z* Insérer ci-dessous le code spécifiques du programme sqpz4a* sqpz4a*================================================================= sqpz4a* Après lectures des ressources sqpz4a*================================================================= sqpz4a S-APRES-LECTURES SECTION. sqpz4a* Insérer ci-dessous le code spécifiques du programme sqpz4z*--- Fin après lectures des ressources --------------------------- sqpz4z continue. sqpz4z S-APRES-LECTURES-FN. sqpz4z exit section. sqpz4z* sqpz4z*--- Routines performées depuis S-APRES-LECTURES ----------------- sqpz4z* Insérer ci-dessous le code spécifiques du programme sqpz5a* sqpz5a*================================================================= sqpz5a* Traitement applicatif principal sqpz5a*================================================================= sqpz5a S-TRAITEMENT SECTION. sqpz5a* Insérer ci-dessous le code spécifiques du programme if RTP1 = 1 move 0 to W-WB00-W9040 end-if if 1-AP00-DISGSU = spaces add 1 to W-WB00-W9040 end-if sqpz5z*--- Fin traitement applicatif principal ------------------------- sqpz5z continue. sqpz5z S-TRAITEMENT-FN. sqpz5z exit section. sqpz5z* sqpz5z*--- Routines performées depuis S-TRAITEMENT --------------------- sqpz5z* Insérer ci-dessous le code spécifiques du programme sqpz6a* sqpz6a*================================================================= sqpz6a* Avant fermeture des ressources sqpz6a*================================================================= sqpz6a S-AVANT-FERMETURES SECTION. sqpz6a* Insérer ci-dessous le code spécifiques du programme sqpz6z*--- Fin avant fermeture des ressources -------------------------- sqpz6z continue. sqpz6z S-AVANT-FERMETURES-FN. sqpz6z exit section. sqpz6z* sqpz6z*--- Routines performées depuis S-AVANT-FERMETURES --------------- sqpz6z* Insérer ci-dessous le code spécifiques du programme sqpz7a* sqpz7a*================================================================= sqpz7a* Avant sortie du programme sqpz7a*================================================================= sqpz7a S-AVANT-FINALISATION SECTION. sqpz7a* Insérer ci-dessous le code spécifiques du programme sqpz7z*--- Fin avant sortie du programme ------------------------------- sqpz7z continue. sqpz7z S-AVANT-FINALISATION-FN. sqpz7z exit section. sqpz7z* sqpz7z*--- Routines performées depuis S-AVANT-FINALISATION ------------- sqpz7z* Insérer ci-dessous le code spécifiques du programme sqpz9a* sqpz9a/================================================================= sqpz9a* RRRR OOO U U TTTTT IIIII N N EEEEE SSS sqpz9a* R R O O U u T I NN N E S sqpz9a* RRRR O O U U T I N N N EEE SSS sqpz9a* R R O O U U T I N NN E S sqpz9a* R R OOO UUU T IIIII N N EEEEE SSS sqpz9a*================================================================= sqpz9a*--- Routines internes performées -------------------------------- sqpz9a S-ROUTINES-INTERNES SECTION. sqpz9a continue. sqpz9a* Insérer ci-dessous le code spécifiques du programme sqpz9z*--- Fin routines internes performées ---------------------------- sqpz9z S-ROUTINES-INTERNES-FN. sqpz9z exit section. sqpz9z sqpa /================================================================= sqpa * AAA CCC CCC EEEEE SSSS sqpa * A A C C C C E S sqpa * AAAAA C C EEEE SSS sqpa * A A C C C C E S sqpa * A A CCC CCC EEEEE SSSS sqpa *================================================================= sqpa ACCESS-RESSOURCES SECTION. sqpa continue. sqpad *> *> zone injection debut <* <* cdAP00* cdAP00*--- Gestion Accès AP -------------------------------------------- cdAP00*>>define AA-A-ACCES as 'L' cdAP00*>>define AA-A-MODE as 'S' cdAP00*>>define AA-A-ORG as '2' cdAP00*>>define AA-A-NR as 2 cdAP00*>>define AA-A-NS as 1 cdAP00*^^accavap * compléter les lignes ci-dessous * cdAP00* copy AAAPACCE replacing cdAP00* ==:DD:== by ==AP== cdAP00* ==:PREF:== by ==AP00== cdAP00* ==:NS:== by ==1== cdAP00* ==:K1:== by ==COSGDP== cdAP00* ==:K2:== by ==LCSGAP== cdAP00* . *CONTROL NOSOURCE AAAPACCE *>****************************************************************AAAPACCE *> Accès ressource externe. AAAPACCE *> Déclaration des accès à la ressource. AAAPACCE *> Cette COPY doit être appelée en Procedure Division pour chaque AAAPACCE *> accès à une ressource externe. AAAPACCE *> Les accès sont des Sections à appeler par PERFORM depuis le AAAPACCE *> corps du programme. AAAPACCE *> L'emplacement normal pour appeler cette COPY est en fin de AAAPACCE *> programme, dans une section "ACCES SECTION". AAAPACCE *> AAAPACCE *> Pour écrire dans un fichier multi-enregistrements, ajouter une AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> write dd01 AAAPACCE *> when 'r2' AAAPACCE *> write dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS DEPENDING ON AAAPACCE *> et l'utiliser pour l'écriture : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==write dd-ENREG-VAR== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> AAAPACCE *> Pour lire un fichier multi-enregistrements, avec gestion de AAAPACCE *> ruptures, ajouter une clause replacing comme : AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> move dd01 to 1-dd01 AAAPACCE *> when 'r2' AAAPACCE *> move dd02 to 1-dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS AAAPACCE DEPENDING ON AAAPACCE *> et l'utiliser pour le move entre la zone enregistrement lu et AAAPACCE *> la zone de travail "1-" : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==move dd-ENREG-VAR to 1-:PREF:== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Paramètres obligatoires : AAAPACCE *> - :DD: : code logigue ressource AAAPACCE *> - :PREF: : prefixe zones et nom niveau 01 principal AAAPACCE *> Paramètres facultatifs (selon contexte) : AAAPACCE *> - :NS: : niveau de synchronisation AAAPACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAAPACCE *> - :KEYPOS: : expression de positionnement pour Fichiers VSAM AAAPACCE *> en accès Direct ou Dynamique AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Variables de compilation : AAAPACCE *> - AA-A-ACCES : type d'accès AAAPACCE *> - 'L' : Lecture (défaut) AAAPACCE *> - 'E' : Ecriture (un seul type d'écriture) AAAPACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAAPACCE *> - 'X' : Lecture (L) et Modification (M) AAAPACCE *> - 'T' : Chargement en table mémoire AAAPACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAAPACCE *> - AA-A-MODE : AA-A-MODE d'accès AAAPACCE *> - 'S' : Séquentiel (défaut) AAAPACCE *> - 'R' : Direct AAAPACCE *> - 'D' : Dynamique (réservé au fichiers VSAM) AAAPACCE *> - AA-A-ORG : type d'organisation AAAPACCE *> - 'F' : Fichier Séquentiel (défaut) AAAPACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAAPACCE *> - 'R' : Fichier VSAM Random (RRDS) AAAPACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAAPACCE *> - '2' : Accès Db2 AAAPACCE *> - 'I' : Document formaté (Mode Séquentiel) AAAPACCE *> - 'X' : Document XML (Mode Séquentiel) AAAPACCE *> - 'J' : Document JSON (Mode Séquentiel) AAAPACCE *> - 'P' : Procédure interne (Impressions) AAAPACCE *> - 'S' : Spooleur externe (Impressions) AAAPACCE *> - AA-A-NR : niveau de rupture, entier, 0 à 9, < 0 hors iter AAAPACCE *> - AA-A-NS : niveau de synchronisation, entier, 0 à 9 AAAPACCE *>****************************************************************AAAPACCE *> --- Valeurs par défaut des variables conditionnelles AAAPACCE *>>if AA-A-ACCES is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-MODE is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-ORG is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NR is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NS is not defined AAAPACCE *>>end-if AAAPACCE *CONTROL SOURCE AAAPACCE *>>evaluate AA-A-ACCES AAAPACCE * >>when 'L' *> Lecture seule AAAPACCE * copy AAA5L000. AAAPACCE *>>evaluate AA-A-MODE AAA5L000 * >>when 'S' *> Lecture séquentielle AAA5L000 * copy AAA5LS00. AAA5L000 *>>evaluate true AAA5LS00 * >>when AA-A-NR <= 0 and AA-A-NS = 0 *> sans Rupt ni Sync AAA5LS00 * >>when other *> avec Rupt et Sync AAA5LS00 * copy AAA5LSRS. AAA5LS00 *>****************************************************************AAA5LSRS *> Accès logiques Lecture Séquentielle avec Ruptures et Synchros AAA5LSRS *>****************************************************************AAA5LSRS *> AAA5LSRS OUVRIR-AP SECTION. AAA5LSRS perform OUVRIR-AP-PHYSIQUE AAA5LSRS perform LIRE-AP-PHYSIQUE. AAA5LSRS OUVRIR-AP-FN. AAA5LSRS exit section. AAA5LSRS *> AAA5LSRS LIRE-AP SECTION. AAA5LSRS set AP-LU to false AAA5LSRS *>>define L_ as b'1' AAA5LSRS *>>evaluate true AAA5LSRS * >>when AA-A-MAXNR <= 0 AAA5LSRS * >>when AA-A-NR >= AA-A-NS AAA5LSRS * >>define L_ as b'0' override AAA5LSRS *>>end-evaluate AAA5LSRS *>>if maxNR > 0 and NS <= maxNR and NR < NS AAA5LSRS *>>if L_ AAA5LSRS *>>else AAA5LSRS if AP-CF1 not = '1' AAA5LSRS *>>end-if AAA5LSRS *>>define L_ off AAA5LSRS exit section AAA5LSRS end-if AAA5LSRS *> Alimentation anticipée des indicateurs "Rupture Première" AAA5LSRS move AP-DE to AP-PE AAA5LSRS move AP-NRD to AP-NRP AAA5LSRS if AP-FI = '1' AAA5LSRS move high-value to APIND AAA5LSRS move '1' to AP-FT AAA5LSRS exit section AAA5LSRS end-if AAA5LSRS move AP00 to 1-AP00 AAA5LSRS perform ALIMENTER-CLE-AP AAA5LSRS add 1 to 5-AP00-CPTENR AAA5LSRS perform LIRE-AP-PHYSIQUE. AAA5LSRS LIRE-AP-FN. AAA5LSRS exit section. AAA5LSRS *> AAA5LSRS FERMER-AP SECTION. AAA5LSRS perform FERMER-AP-PHYSIQUE. AAA5LSRS FERMER-AP-FN. AAA5LSRS exit section. AAA5LSRS * copy AAA5L0RS. AAA5LSRS *> AAA5L0RS CALCULER-RUPT-AP SECTION. AAA5L0RS *> Calcul des indicateurs "Ruptures Dernières" AAA5L0RS move all '0' to AP-DE AAA5L0RS move 0 to AP-NRD AAA5L0RS evaluate true AAA5L0RS when AP-FI = '1' AAA5L0RS when AP00-COSGDP not = 1-AP00-COSGDP AAA5L0RS move 1 to AP-NRD AAA5L0RS move all '1' to AP-DE AAA5L0RS *>>if AA-A-NR > 1 AAA5L0RS when AP00-LCSGAP not = 1-AP00-LCSGAP AAA5L0RS move 2 to AP-NRD AAA5L0RS move all '1' to AP-DE(2:) AAA5L0RS * >>if AA-A-NR > 2 AAA5L0RS * >>end-if AAA5L0RS *>>end-if AAA5L0RS end-evaluate. AAA5L0RS CALCULER-RUPT-AP-FN. AAA5L0RS exit section. AAA5L0RS *> AAA5L0RS CALCULER-RTD-AP SECTION. AAA5L0RS if NRD2 > 0 AAA5L0RS perform varying IRTD from NRD2 by 1 AAA5L0RS until IRTD > length of AP-DE AAA5L0RS if IRTD <= 1 AAA5L0RS and AP-CF (IRTD:1) = '1' AAA5L0RS and (AP-DE (IRTD:1) = '0' AAA5L0RS or AP-CF1 = '0') AAA5L0RS move '0' to RTD (IRTD:1) AAA5L0RS if RTD = all '0' AAA5L0RS move 0 to NRD2 NRD AAA5L0RS else AAA5L0RS add 1 to IRTD giving NRD2 NRD AAA5L0RS end-if AAA5L0RS else AAA5L0RS if IRTD > 1 AAA5L0RS and AP-CF1 = '1' AAA5L0RS and AP-DE (IRTD:1) = '0' AAA5L0RS move '0' to RTD (IRTD:1) AAA5L0RS if RTD = all '0' AAA5L0RS move 0 to NRD2 NRD AAA5L0RS else AAA5L0RS add 1 to IRTD giving NRD2 NRD AAA5L0RS end-if AAA5L0RS end-if AAA5L0RS end-if AAA5L0RS end-perform AAA5L0RS end-if. AAA5L0RS CALCULER-RTD-AP-FN. AAA5L0RS exit section. AAA5L0RS *> --- Routines de calcul des Synchros AAA5L0RS * copy AAA5L0SY. AAA5L0RS *copy AAA5L0IN. AAA5L0SY *> AAA5L0IN ALIMENTER-CLE-AP SECTION. AAA5L0IN move AP00-COSGDP to AP-IN-COSGDP AAA5L0IN *>>if AA-A-NS > 1 AAA5L0IN *>>end-if AAA5L0IN . AAA5L0IN ALIMENTER-CLE-AP-FN. AAA5L0IN exit section. AAA5L0IN *> AAA5L0SY CALCULER-CLE-AP SECTION. AAA5L0SY if APIND < TIND1 AAA5L0SY move high-value to IND AAA5L0SY move APIND to TIND1 AAA5L0SY end-if. AAA5L0SY CALCULER-CLE-AP-FN. AAA5L0SY exit section. AAA5L0SY *> AAA5L0SY CALCULER-CONF-AP SECTION. AAA5L0SY move all '0' to AP-CF AAA5L0SY move 0 to AP-NCF AAA5L0SY if APIND1 = IND1 AAA5L0SY move '1' to AP-CF1 AAA5L0SY move 1 to AP-NCF AAA5L0SY *>>if AA-A-NS > 1 AAA5L0SY *>>end-if AAA5L0SY end-if AAA5L0SY if AP-NCF > MAX-CF AAA5L0SY move AP-NCF to MAX-CF AAA5L0SY end-if. AAA5L0SY CALCULER-CONF-AP-FN. AAA5L0SY exit section. AAA5L0SY *>>end-evaluate AAA5LS00 *>>evaluate AA-A-ORG AAA5LS00 * >>when 'F' *> Fichier Séquentiel AAA5LS00 * >>when '2' *> Accès Db2 AAA5LS00 * copy AAA5LS20. AAA5LS00 *>****************************************************************AAA5LS20 *> Accès physiques Lecture Séquentielle (curseur) Db2. AAA5LS20 *> Les ordres SQL doivent être codés directement dans le AAA5LS20 *> programme : AAA5LS20 *> - OUVRIR-
-SQL : ordre OPEN CURSOR AAA5LS20 *> - LIRE-
-SQL : ordre FETCH CURSOR AAA5LS20 *> - FERMER-
-SQL : ordre CLOSE CURSOR AAA5LS20 *>****************************************************************AAA5LS20 *> AAA5LS20 OUVRIR-AP-PHYSIQUE SECTION. AAA5LS20 move '1' to IK AAA5LS20 perform OUVRIR-AP-SQL AAA5LS20 move '0' to IK AAA5LS20 set AP-OUVERT to true AAA5LS20 *>>evaluate true AAA5LS20 * >>when AA-A-NR = 0 AAA5LS20 * >>when AA-A-NR > 0 AAA5LS20 move '0' to AP-FI AP-FT. AAA5LS20 * >>when other AAA5LS20 *>>end-evaluate AAA5LS20 OUVRIR-AP-PHYSIQUE-FN. AAA5LS20 exit section. AAA5LS20 *> AAA5LS20 LIRE-AP-PHYSIQUE SECTION. AAA5LS20 move '1' to IK AAA5LS20 perform LIRE-AP-SQL AAA5LS20 evaluate true AAA5LS20 when SQLCODE = +100 AAA5LS20 *>>evaluate true AAA5LS20 * >>when AA-A-NR = 0 AAA5LS20 * >>when AA-A-NR > 0 AAA5LS20 move '1' to AP-FI AAA5LS20 * >>when other AAA5LS20 *>>end-evaluate AAA5LS20 when SQLCODE >= 0 AAA5LS20 set AP-LU to true AAA5LS20 move '0' to IK AAA5LS20 end-evaluate. AAA5LS20 LIRE-AP-PHYSIQUE-FN. AAA5LS20 exit section. AAA5LS20 *> AAA5LS20 FERMER-AP-PHYSIQUE SECTION. AAA5LS20 perform FERMER-AP-SQL AAA5LS20 set AP-OUVERT to false AAA5LS20 *>>evaluate true AAA5LS20 * >>when AA-A-NR = 0 AAA5LS20 * >>when AA-A-NR > 0 AAA5LS20 move '1' to AP-FI. AAA5LS20 * >>when other AAA5LS20 *>>end-evaluate AAA5LS20 FERMER-AP-PHYSIQUE-FN. AAA5LS20 exit section. AAA5LS20 * >>when 'K' *> Fichier VSAM KSDS AAA5LS00 *>>end-evaluate AAA5LS00 * >>when 'R' *> Lecture directe AAA5L000 *>>end-evaluate AAA5L000 * >>when 'E' *> Ecriture seule AAAPACCE *>>end-evaluate AAAPACCE *CONTROL NOSOURCE AAAPACCE *> --- Effacement des variables conditionnelles locales AAAPACCE *>>define AA-A-ACCES off AAAPACCE *>>define AA-A-MODE off AAAPACCE *>>define AA-A-ORG off AAAPACCE *>>define AA-A-NR off AAAPACCE *>>define AA-A-NS off AAAPACCE *CONTROL SOURCE AAAPACCE cdAP00* cdAP00*--- Lecture séquentielle Table APP - Ressource AP cdAP00* cdAP00 exec sql cdAP00 DECLARE AP-CURSOR cdAP00 --^^cursor * compléter les lignes ci-dessous * CURSOR FOR SELECT -- liste des colonnes OAPPL , APPDESC , APPCDOM , APPCAPP , APPDCREA , APPDDELE , APPUCREA , APPSYNON , APPSECTEUR FROM APP ORDER BY APPCDOM , APPCAPP cdAP00 end-exec. cdAP00* cdAP00*<<< Ne pas accéder directement à ce code, utiliser OUVRIR-AP >>> cdAP00 OUVRIR-AP-SQL SECTION. cdAP00*^^sqlavouv * compléter les lignes ci-dessous * cdAP00 exec sql cdAP00 OPEN AP-CURSOR cdAP00 end-exec cdAP00*^^sqlapouv * compléter les lignes ci-dessous * cdAP00 continue. cdAP00 OUVRIR-AP-SQL-FN. cdAP00 exit section. cdAP00* cdAP00*<<< Ne pas accéder directement à ce code, utiliser LIRE-AP >>> cdAP00 LIRE-AP-SQL SECTION. cdAP00*^^sqlavlec * compléter les lignes ci-dessous * cdAP00 exec sql cdAP00 FETCH cdAP00 --^^fetch * compléter les lignes ci-dessous * cdAP00 FROM AP-CURSOR cdAP00 --^^into * compléter les lignes ci-dessous * INTO -- liste des hosts-variables :AP00-COSGA1 :V-AP00-COSGA1 , :AP00-LNSGAP :V-AP00-LNSGAP , :AP00-COSGDP :V-AP00-COSGDP , :AP00-LCSGAP :V-AP00-LCSGAP , :AP00-DISGCA :V-AP00-DISGCA , :AP00-DISGSU :V-AP00-DISGSU , :AP00-DISGMJ :V-AP00-DISGMJ , :AP00-COSGSN :V-AP00-COSGSN , :AP00-COSGSE :V-AP00-COSGSE cdAP00 end-exec cdAP00*^^sqlaplec * compléter les lignes ci-dessous * cdAP00 continue. cdAP00 LIRE-AP-SQL-FN. cdAP00 exit section. cdAP00* cdAP00*<<< Ne pas accéder directement à ce code, utiliser FERMER-AP >>> cdAP00 FERMER-AP-SQL SECTION. cdAP00*^^sqlavfer * compléter les lignes ci-dessous * cdAP00 exec sql cdAP00 CLOSE AP-CURSOR cdAP00 end-exec cdAP00*^^sqlapfer * compléter les lignes ci-dessous * cdAP00 continue. cdAP00 FERMER-AP-SQL-FN. cdAP00 exit section. cdDM00* cdDM00*--- Gestion Accès DM -------------------------------------------- cdDM00*>>define AA-A-ACCES as 'L' cdDM00*>>define AA-A-MODE as 'S' cdDM00*>>define AA-A-ORG as '2' cdDM00*>>define AA-A-NR as 0 cdDM00*>>define AA-A-NS as 1 cdDM00*^^accavap * compléter les lignes ci-dessous * cdDM00* copy AAAPACCE replacing cdDM00* ==:DD:== by ==DM== cdDM00* ==:PREF:== by ==DM00== cdDM00* ==:NS:== by ==1== cdDM00* ==:K1:== by ==COSGDP== cdDM00* . *CONTROL NOSOURCE AAAPACCE *>****************************************************************AAAPACCE *> Accès ressource externe. AAAPACCE *> Déclaration des accès à la ressource. AAAPACCE *> Cette COPY doit être appelée en Procedure Division pour chaque AAAPACCE *> accès à une ressource externe. AAAPACCE *> Les accès sont des Sections à appeler par PERFORM depuis le AAAPACCE *> corps du programme. AAAPACCE *> L'emplacement normal pour appeler cette COPY est en fin de AAAPACCE *> programme, dans une section "ACCES SECTION". AAAPACCE *> AAAPACCE *> Pour écrire dans un fichier multi-enregistrements, ajouter une AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> write dd01 AAAPACCE *> when 'r2' AAAPACCE *> write dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS DEPENDING ON AAAPACCE *> et l'utiliser pour l'écriture : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==write dd-ENREG-VAR== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> AAAPACCE *> Pour lire un fichier multi-enregistrements, avec gestion de AAAPACCE *> ruptures, ajouter une clause replacing comme : AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> move dd01 to 1-dd01 AAAPACCE *> when 'r2' AAAPACCE *> move dd02 to 1-dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS AAAPACCE DEPENDING ON AAAPACCE *> et l'utiliser pour le move entre la zone enregistrement lu et AAAPACCE *> la zone de travail "1-" : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==move dd-ENREG-VAR to 1-:PREF:== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Paramètres obligatoires : AAAPACCE *> - :DD: : code logigue ressource AAAPACCE *> - :PREF: : prefixe zones et nom niveau 01 principal AAAPACCE *> Paramètres facultatifs (selon contexte) : AAAPACCE *> - :NS: : niveau de synchronisation AAAPACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAAPACCE *> - :KEYPOS: : expression de positionnement pour Fichiers VSAM AAAPACCE *> en accès Direct ou Dynamique AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Variables de compilation : AAAPACCE *> - AA-A-ACCES : type d'accès AAAPACCE *> - 'L' : Lecture (défaut) AAAPACCE *> - 'E' : Ecriture (un seul type d'écriture) AAAPACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAAPACCE *> - 'X' : Lecture (L) et Modification (M) AAAPACCE *> - 'T' : Chargement en table mémoire AAAPACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAAPACCE *> - AA-A-MODE : AA-A-MODE d'accès AAAPACCE *> - 'S' : Séquentiel (défaut) AAAPACCE *> - 'R' : Direct AAAPACCE *> - 'D' : Dynamique (réservé au fichiers VSAM) AAAPACCE *> - AA-A-ORG : type d'organisation AAAPACCE *> - 'F' : Fichier Séquentiel (défaut) AAAPACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAAPACCE *> - 'R' : Fichier VSAM Random (RRDS) AAAPACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAAPACCE *> - '2' : Accès Db2 AAAPACCE *> - 'I' : Document formaté (Mode Séquentiel) AAAPACCE *> - 'X' : Document XML (Mode Séquentiel) AAAPACCE *> - 'J' : Document JSON (Mode Séquentiel) AAAPACCE *> - 'P' : Procédure interne (Impressions) AAAPACCE *> - 'S' : Spooleur externe (Impressions) AAAPACCE *> - AA-A-NR : niveau de rupture, entier, 0 à 9, < 0 hors iter AAAPACCE *> - AA-A-NS : niveau de synchronisation, entier, 0 à 9 AAAPACCE *>****************************************************************AAAPACCE *> --- Valeurs par défaut des variables conditionnelles AAAPACCE *>>if AA-A-ACCES is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-MODE is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-ORG is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NR is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NS is not defined AAAPACCE *>>end-if AAAPACCE *CONTROL SOURCE AAAPACCE *>>evaluate AA-A-ACCES AAAPACCE * >>when 'L' *> Lecture seule AAAPACCE * copy AAA5L000. AAAPACCE *>>evaluate AA-A-MODE AAA5L000 * >>when 'S' *> Lecture séquentielle AAA5L000 * copy AAA5LS00. AAA5L000 *>>evaluate true AAA5LS00 * >>when AA-A-NR <= 0 and AA-A-NS = 0 *> sans Rupt ni Sync AAA5LS00 * >>when AA-A-NR = 0 and AA-A-NS > 0 *> sans Rupt avec Sync AAA5LS00 * copy AAA5LSSY. AAA5LS00 *>****************************************************************AAA5LSSY *> Accès logiques Lecture Séquentielle sans Rupture avec Synchro AAA5LSSY *>****************************************************************AAA5LSSY *> AAA5LSSY OUVRIR-DM SECTION. AAA5LSSY perform OUVRIR-DM-PHYSIQUE. AAA5LSSY OUVRIR-DM-FN. AAA5LSSY exit section. AAA5LSSY *> AAA5LSSY LIRE-DM SECTION. AAA5LSSY set DM-LU to false AAA5LSSY *>>define L_ as b'1' AAA5LSSY *>>evaluate true AAA5LSSY * >>when AA-A-MAXNR <= 0 AAA5LSSY *>>end-evaluate AAA5LSSY *>>if maxNR > 0 and NS <= maxNR and NR < NS AAA5LSSY *>>if L_ AAA5LSSY if RTD1 not = '1' or DM-CF1 not = '1' AAA5LSSY *>>else AAA5LSSY *>>end-if AAA5LSSY *>>define L_ off AAA5LSSY exit section AAA5LSSY end-if AAA5LSSY perform LIRE-DM-PHYSIQUE AAA5LSSY if DM-FT = '1' AAA5LSSY move high-value to DMIND AAA5LSSY exit section AAA5LSSY end-if AAA5LSSY perform ALIMENTER-CLE-DM AAA5LSSY add 1 to 5-DM00-CPTENR. AAA5LSSY LIRE-DM-FN. AAA5LSSY exit section. AAA5LSSY *> AAA5LSSY FERMER-DM SECTION. AAA5LSSY perform FERMER-DM-PHYSIQUE. AAA5LSSY FERMER-DM-FN. AAA5LSSY exit section. AAA5LSSY * copy AAA5L0SY. AAA5LSSY *copy AAA5L0IN. AAA5L0SY *> AAA5L0IN ALIMENTER-CLE-DM SECTION. AAA5L0IN move DM00-COSGDP to DM-IN-COSGDP AAA5L0IN *>>if AA-A-NS > 1 AAA5L0IN *>>end-if AAA5L0IN . AAA5L0IN ALIMENTER-CLE-DM-FN. AAA5L0IN exit section. AAA5L0IN *> AAA5L0SY CALCULER-CLE-DM SECTION. AAA5L0SY if DMIND < TIND1 AAA5L0SY move high-value to IND AAA5L0SY move DMIND to TIND1 AAA5L0SY end-if. AAA5L0SY CALCULER-CLE-DM-FN. AAA5L0SY exit section. AAA5L0SY *> AAA5L0SY CALCULER-CONF-DM SECTION. AAA5L0SY move all '0' to DM-CF AAA5L0SY move 0 to DM-NCF AAA5L0SY if DMIND1 = IND1 AAA5L0SY move '1' to DM-CF1 AAA5L0SY move 1 to DM-NCF AAA5L0SY *>>if AA-A-NS > 1 AAA5L0SY *>>end-if AAA5L0SY end-if AAA5L0SY if DM-NCF > MAX-CF AAA5L0SY move DM-NCF to MAX-CF AAA5L0SY end-if. AAA5L0SY CALCULER-CONF-DM-FN. AAA5L0SY exit section. AAA5L0SY * >>when other *> avec Rupt et Sync AAA5LS00 *>>end-evaluate AAA5LS00 *>>evaluate AA-A-ORG AAA5LS00 * >>when 'F' *> Fichier Séquentiel AAA5LS00 * >>when '2' *> Accès Db2 AAA5LS00 * copy AAA5LS20. AAA5LS00 *>****************************************************************AAA5LS20 *> Accès physiques Lecture Séquentielle (curseur) Db2. AAA5LS20 *> Les ordres SQL doivent être codés directement dans le AAA5LS20 *> programme : AAA5LS20 *> - OUVRIR-
-SQL : ordre OPEN CURSOR AAA5LS20 *> - LIRE-
-SQL : ordre FETCH CURSOR AAA5LS20 *> - FERMER-
-SQL : ordre CLOSE CURSOR AAA5LS20 *>****************************************************************AAA5LS20 *> AAA5LS20 OUVRIR-DM-PHYSIQUE SECTION. AAA5LS20 move '1' to IK AAA5LS20 perform OUVRIR-DM-SQL AAA5LS20 move '0' to IK AAA5LS20 set DM-OUVERT to true AAA5LS20 *>>evaluate true AAA5LS20 * >>when AA-A-NR = 0 AAA5LS20 move '0' to DM-FT. AAA5LS20 * >>when AA-A-NR > 0 AAA5LS20 *>>end-evaluate AAA5LS20 OUVRIR-DM-PHYSIQUE-FN. AAA5LS20 exit section. AAA5LS20 *> AAA5LS20 LIRE-DM-PHYSIQUE SECTION. AAA5LS20 move '1' to IK AAA5LS20 perform LIRE-DM-SQL AAA5LS20 evaluate true AAA5LS20 when SQLCODE = +100 AAA5LS20 *>>evaluate true AAA5LS20 * >>when AA-A-NR = 0 AAA5LS20 move '1' to DM-FT AAA5LS20 * >>when AA-A-NR > 0 AAA5LS20 *>>end-evaluate AAA5LS20 when SQLCODE >= 0 AAA5LS20 set DM-LU to true AAA5LS20 move '0' to IK AAA5LS20 end-evaluate. AAA5LS20 LIRE-DM-PHYSIQUE-FN. AAA5LS20 exit section. AAA5LS20 *> AAA5LS20 FERMER-DM-PHYSIQUE SECTION. AAA5LS20 perform FERMER-DM-SQL AAA5LS20 set DM-OUVERT to false AAA5LS20 *>>evaluate true AAA5LS20 * >>when AA-A-NR = 0 AAA5LS20 move '1' to DM-FT. AAA5LS20 * >>when AA-A-NR > 0 AAA5LS20 *>>end-evaluate AAA5LS20 FERMER-DM-PHYSIQUE-FN. AAA5LS20 exit section. AAA5LS20 * >>when 'K' *> Fichier VSAM KSDS AAA5LS00 *>>end-evaluate AAA5LS00 * >>when 'R' *> Lecture directe AAA5L000 *>>end-evaluate AAA5L000 * >>when 'E' *> Ecriture seule AAAPACCE *>>end-evaluate AAAPACCE *CONTROL NOSOURCE AAAPACCE *> --- Effacement des variables conditionnelles locales AAAPACCE *>>define AA-A-ACCES off AAAPACCE *>>define AA-A-MODE off AAAPACCE *>>define AA-A-ORG off AAAPACCE *>>define AA-A-NR off AAAPACCE *>>define AA-A-NS off AAAPACCE *CONTROL SOURCE AAAPACCE cdDM00* cdDM00*--- Lecture séquentielle Table ADM - Ressource DM cdDM00* cdDM00 exec sql cdDM00 DECLARE DM-CURSOR cdDM00 --^^cursor * compléter les lignes ci-dessous * CURSOR FOR SELECT -- liste des colonnes ADMNAME , ADMDESC , ADMCODE , ADMCREA , ADMDELE FROM ADM ORDER BY ADMCODE cdDM00 end-exec. cdDM00* cdDM00*<<< Ne pas accéder directement à ce code, utiliser OUVRIR-DM >>> cdDM00 OUVRIR-DM-SQL SECTION. cdDM00*^^sqlavouv * compléter les lignes ci-dessous * cdDM00 exec sql cdDM00 OPEN DM-CURSOR cdDM00 end-exec cdDM00*^^sqlapouv * compléter les lignes ci-dessous * cdDM00 continue. cdDM00 OUVRIR-DM-SQL-FN. cdDM00 exit section. cdDM00* cdDM00*<<< Ne pas accéder directement à ce code, utiliser LIRE-DM >>> cdDM00 LIRE-DM-SQL SECTION. cdDM00*^^sqlavlec * compléter les lignes ci-dessous * cdDM00 exec sql cdDM00 FETCH cdDM00 --^^fetch * compléter les lignes ci-dessous * cdDM00 FROM DM-CURSOR cdDM00 --^^into * compléter les lignes ci-dessous * INTO -- liste des hosts-variables :DM00-COSGDM :V-DM00-COSGDM , :DM00-LNSGDM :V-DM00-LNSGDM , :DM00-COSGDP :V-DM00-COSGDP , :DM00-DISGCA :V-DM00-DISGCA , :DM00-DISGSU :V-DM00-DISGSU cdDM00 end-exec cdDM00*^^sqlaplec * compléter les lignes ci-dessous * cdDM00 continue. cdDM00 LIRE-DM-SQL-FN. cdDM00 exit section. cdDM00* cdDM00*<<< Ne pas accéder directement à ce code, utiliser FERMER-DM >>> cdDM00 FERMER-DM-SQL SECTION. cdDM00*^^sqlavfer * compléter les lignes ci-dessous * cdDM00 exec sql cdDM00 CLOSE DM-CURSOR cdDM00 end-exec cdDM00*^^sqlapfer * compléter les lignes ci-dessous * cdDM00 continue. cdDM00 FERMER-DM-SQL-FN. cdDM00 exit section. cdS100* cdS100*--- Gestion Accès S1 -------------------------------------------- cdS100*>>define AA-A-ACCES as 'E' cdS100*>>define AA-A-MODE as 'S' cdS100*>>define AA-A-ORG as 'F' cdS100*>>define AA-A-NR as 0 cdS100*>>define AA-A-NS as 0 cdS100*^^accavap * compléter les lignes ci-dessous * cdS100* copy AAAPACCE replacing cdS100* ==:DD:== by ==S1== cdS100* ==:PREF:== by ==S100== cdS100* ==:NS:== by ==0== cdS100* . *CONTROL NOSOURCE AAAPACCE *>****************************************************************AAAPACCE *> Accès ressource externe. AAAPACCE *> Déclaration des accès à la ressource. AAAPACCE *> Cette COPY doit être appelée en Procedure Division pour chaque AAAPACCE *> accès à une ressource externe. AAAPACCE *> Les accès sont des Sections à appeler par PERFORM depuis le AAAPACCE *> corps du programme. AAAPACCE *> L'emplacement normal pour appeler cette COPY est en fin de AAAPACCE *> programme, dans une section "ACCES SECTION". AAAPACCE *> AAAPACCE *> Pour écrire dans un fichier multi-enregistrements, ajouter une AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> write dd01 AAAPACCE *> when 'r2' AAAPACCE *> write dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS DEPENDING ON AAAPACCE *> et l'utiliser pour l'écriture : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==write dd-ENREG-VAR== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> AAAPACCE *> Pour lire un fichier multi-enregistrements, avec gestion de AAAPACCE *> ruptures, ajouter une clause replacing comme : AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> move dd01 to 1-dd01 AAAPACCE *> when 'r2' AAAPACCE *> move dd02 to 1-dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS AAAPACCE DEPENDING ON AAAPACCE *> et l'utiliser pour le move entre la zone enregistrement lu et AAAPACCE *> la zone de travail "1-" : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==move dd-ENREG-VAR to 1-:PREF:== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Paramètres obligatoires : AAAPACCE *> - :DD: : code logigue ressource AAAPACCE *> - :PREF: : prefixe zones et nom niveau 01 principal AAAPACCE *> Paramètres facultatifs (selon contexte) : AAAPACCE *> - :NS: : niveau de synchronisation AAAPACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAAPACCE *> - :KEYPOS: : expression de positionnement pour Fichiers VSAM AAAPACCE *> en accès Direct ou Dynamique AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Variables de compilation : AAAPACCE *> - AA-A-ACCES : type d'accès AAAPACCE *> - 'L' : Lecture (défaut) AAAPACCE *> - 'E' : Ecriture (un seul type d'écriture) AAAPACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAAPACCE *> - 'X' : Lecture (L) et Modification (M) AAAPACCE *> - 'T' : Chargement en table mémoire AAAPACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAAPACCE *> - AA-A-MODE : AA-A-MODE d'accès AAAPACCE *> - 'S' : Séquentiel (défaut) AAAPACCE *> - 'R' : Direct AAAPACCE *> - 'D' : Dynamique (réservé au fichiers VSAM) AAAPACCE *> - AA-A-ORG : type d'organisation AAAPACCE *> - 'F' : Fichier Séquentiel (défaut) AAAPACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAAPACCE *> - 'R' : Fichier VSAM Random (RRDS) AAAPACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAAPACCE *> - '2' : Accès Db2 AAAPACCE *> - 'I' : Document formaté (Mode Séquentiel) AAAPACCE *> - 'X' : Document XML (Mode Séquentiel) AAAPACCE *> - 'J' : Document JSON (Mode Séquentiel) AAAPACCE *> - 'P' : Procédure interne (Impressions) AAAPACCE *> - 'S' : Spooleur externe (Impressions) AAAPACCE *> - AA-A-NR : niveau de rupture, entier, 0 à 9, < 0 hors iter AAAPACCE *> - AA-A-NS : niveau de synchronisation, entier, 0 à 9 AAAPACCE *>****************************************************************AAAPACCE *> --- Valeurs par défaut des variables conditionnelles AAAPACCE *>>if AA-A-ACCES is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-MODE is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-ORG is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NR is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NS is not defined AAAPACCE *>>end-if AAAPACCE *CONTROL SOURCE AAAPACCE *>>evaluate AA-A-ACCES AAAPACCE * >>when 'L' *> Lecture seule AAAPACCE * >>when 'E' *> Ecriture seule AAAPACCE * copy AAA5E000. AAAPACCE *>>evaluate AA-A-MODE AAA5E000 * >>when 'S' *> Ecriture séquentielle AAA5E000 * copy AAA5ES00. AAA5E000 * copy AAA5ESNN. AAA5ES00 *>****************************************************************AAA5ESNN *> Accès logiques Ecriture Séquentielle AAA5ESNN *>****************************************************************AAA5ESNN *> AAA5ESNN OUVRIR-S1 SECTION. AAA5ESNN perform OUVRIR-S1-PHYSIQUE. AAA5ESNN OUVRIR-S1-FN. AAA5ESNN exit section. AAA5ESNN *> AAA5ESNN ECRIRE-S1 SECTION. AAA5ESNN perform ECRIRE-S1-PHYSIQUE. AAA5ESNN ECRIRE-S1-FN. AAA5ESNN exit section. AAA5ESNN *> AAA5ESNN FERMER-S1 SECTION. AAA5ESNN perform FERMER-S1-PHYSIQUE. AAA5ESNN FERMER-S1-FN. AAA5ESNN exit section. AAA5ESNN *>>evaluate AA-A-ORG AAA5ES00 * >>when 'F' *> Fichier Séquentiel AAA5ES00 * copy AAA5ESF0. AAA5ES00 *CONTROL NOSOURCE AAA5ESF0 *>****************************************************************AAA5ESF0 *> Pour écrire dans un fichier multi-enregistrement, ajouter une AAA5ESF0 *> clause replacing comme : AAA5ESF0 *> COPY AAAPACCE REPLACING AAA5ESF0 *> ==write :PREF:== by == AAA5ESF0 *> ==evaluate dd00-code-structure AAA5ESF0 *> when 'r1' AAA5ESF0 *> write dd01 AAA5ESF0 *> when 'r2' AAA5ESF0 *> write dd02 AAA5ESF0 *> ... AAA5ESF0 *> when other AAA5ESF0 *> ... AAA5ESF0 *> end-evalate== AAA5ESF0 *> ==:DD:== by ==FI== AAA5ESF0 *> . AAA5ESF0 *> Le replacing de l'ordre write doit être placé avant le AAA5ESF0 *> replacing des paramètres. AAA5ESF0 *CONTROL SOURCE AAA5ESF0 *>****************************************************************AAA5ESF0 *> Accès physiques Ecriture Séquentielle Fichier Séquentiel AAA5ESF0 *>****************************************************************AAA5ESF0 *> AAA5ESF0 OUVRIR-S1-PHYSIQUE SECTION. AAA5ESF0 open output S1-FICHIER. AAA5ESF0 OUVRIR-S1-PHYSIQUE-FN. AAA5ESF0 exit section. AAA5ESF0 *> AAA5ESF0 ECRIRE-S1-PHYSIQUE SECTION. AAA5ESF0 write S100 AAA5ESF0 add 1 to 5-S100-CPTENR. AAA5ESF0 ECRIRE-S1-PHYSIQUE-FN. AAA5ESF0 exit section. AAA5ESF0 *> AAA5ESF0 FERMER-S1-PHYSIQUE SECTION. AAA5ESF0 close S1-FICHIER. AAA5ESF0 FERMER-S1-PHYSIQUE-FN. AAA5ESF0 exit section. AAA5ESF0 * >>when '2' *> Accès Db2 AAA5ES00 *>>end-evaluate AAA5ES00 * >>when 'R' *> Ecriture directe AAA5E000 *>>end-evaluate AAA5E000 * >>when 'M' *> Création Modification Suppression AAAPACCE *>>end-evaluate AAAPACCE *CONTROL NOSOURCE AAAPACCE *> --- Effacement des variables conditionnelles locales AAAPACCE *>>define AA-A-ACCES off AAAPACCE *>>define AA-A-MODE off AAAPACCE *>>define AA-A-ORG off AAAPACCE *>>define AA-A-NR off AAAPACCE *>>define AA-A-NS off AAAPACCE *CONTROL SOURCE AAAPACCE cdS200* cdS200*--- Gestion Accès S2 -------------------------------------------- cdS200*>>define AA-A-ACCES as 'E' cdS200*>>define AA-A-MODE as 'S' cdS200*>>define AA-A-ORG as 'F' cdS200*>>define AA-A-NR as 0 cdS200*>>define AA-A-NS as 0 cdS200*^^accavap * compléter les lignes ci-dessous * cdS200* copy AAAPACCE replacing cdS200* ==:DD:== by ==S2== cdS200* ==:PREF:== by ==S200== cdS200* ==:NS:== by ==0== cdS200* . *CONTROL NOSOURCE AAAPACCE *>****************************************************************AAAPACCE *> Accès ressource externe. AAAPACCE *> Déclaration des accès à la ressource. AAAPACCE *> Cette COPY doit être appelée en Procedure Division pour chaque AAAPACCE *> accès à une ressource externe. AAAPACCE *> Les accès sont des Sections à appeler par PERFORM depuis le AAAPACCE *> corps du programme. AAAPACCE *> L'emplacement normal pour appeler cette COPY est en fin de AAAPACCE *> programme, dans une section "ACCES SECTION". AAAPACCE *> AAAPACCE *> Pour écrire dans un fichier multi-enregistrements, ajouter une AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> write dd01 AAAPACCE *> when 'r2' AAAPACCE *> write dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS DEPENDING ON AAAPACCE *> et l'utiliser pour l'écriture : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==write :PREF:== by AAAPACCE *> ==write dd-ENREG-VAR== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> AAAPACCE *> Pour lire un fichier multi-enregistrements, avec gestion de AAAPACCE *> ruptures, ajouter une clause replacing comme : AAAPACCE *> clause replacing comme : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==evaluate pref-code-structure AAAPACCE *> when 'r1' AAAPACCE *> move dd01 to 1-dd01 AAAPACCE *> when 'r2' AAAPACCE *> move dd02 to 1-dd02 AAAPACCE *> ... AAAPACCE *> end-evalate== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *> Si le fichier ne dispose pas d'un code structure, il faut AAAPACCE *> déclarer un enregistrement banalisé constitué d'un AAAPACCE *> PIC X OCCURS AAAPACCE DEPENDING ON AAAPACCE *> et l'utiliser pour le move entre la zone enregistrement lu et AAAPACCE *> la zone de travail "1-" : AAAPACCE *> COPY AAAPACCE REPLACING ... AAAPACCE *> ==move :PREF: to 1-:PREF:== by AAAPACCE *> ==move dd-ENREG-VAR to 1-:PREF:== AAAPACCE *> ... autres paramètres ... AAAPACCE *> . AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Paramètres obligatoires : AAAPACCE *> - :DD: : code logigue ressource AAAPACCE *> - :PREF: : prefixe zones et nom niveau 01 principal AAAPACCE *> Paramètres facultatifs (selon contexte) : AAAPACCE *> - :NS: : niveau de synchronisation AAAPACCE *> - :K: : variable(s) clé(s) de rupture / synchro au rang n AAAPACCE *> - :KEYPOS: : expression de positionnement pour Fichiers VSAM AAAPACCE *> en accès Direct ou Dynamique AAAPACCE *>----------------------------------------------------------------AAAPACCE *> Variables de compilation : AAAPACCE *> - AA-A-ACCES : type d'accès AAAPACCE *> - 'L' : Lecture (défaut) AAAPACCE *> - 'E' : Ecriture (un seul type d'écriture) AAAPACCE *> - 'M' : Modification (tous types d'écriture sans lecture) AAAPACCE *> - 'X' : Lecture (L) et Modification (M) AAAPACCE *> - 'T' : Chargement en table mémoire AAAPACCE *> - 'I' : Impression (Edition) AAAPACCE *> - 'U' : Géré par l'Utilisateur AAAPACCE *> - AA-A-MODE : AA-A-MODE d'accès AAAPACCE *> - 'S' : Séquentiel (défaut) AAAPACCE *> - 'R' : Direct AAAPACCE *> - 'D' : Dynamique (réservé au fichiers VSAM) AAAPACCE *> - AA-A-ORG : type d'organisation AAAPACCE *> - 'F' : Fichier Séquentiel (défaut) AAAPACCE *> - 'K' : Fichier VSAM Indexé (KSDS) AAAPACCE *> - 'R' : Fichier VSAM Random (RRDS) AAAPACCE *> - 'E' : Fichier VSAM Entry (ESDS) AAAPACCE *> - '2' : Accès Db2 AAAPACCE *> - 'I' : Document formaté (Mode Séquentiel) AAAPACCE *> - 'X' : Document XML (Mode Séquentiel) AAAPACCE *> - 'J' : Document JSON (Mode Séquentiel) AAAPACCE *> - 'P' : Procédure interne (Impressions) AAAPACCE *> - 'S' : Spooleur externe (Impressions) AAAPACCE *> - AA-A-NR : niveau de rupture, entier, 0 à 9, < 0 hors iter AAAPACCE *> - AA-A-NS : niveau de synchronisation, entier, 0 à 9 AAAPACCE *>****************************************************************AAAPACCE *> --- Valeurs par défaut des variables conditionnelles AAAPACCE *>>if AA-A-ACCES is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-MODE is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-ORG is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NR is not defined AAAPACCE *>>end-if AAAPACCE *>>if AA-A-NS is not defined AAAPACCE *>>end-if AAAPACCE *CONTROL SOURCE AAAPACCE *>>evaluate AA-A-ACCES AAAPACCE * >>when 'L' *> Lecture seule AAAPACCE * >>when 'E' *> Ecriture seule AAAPACCE * copy AAA5E000. AAAPACCE *>>evaluate AA-A-MODE AAA5E000 * >>when 'S' *> Ecriture séquentielle AAA5E000 * copy AAA5ES00. AAA5E000 * copy AAA5ESNN. AAA5ES00 *>****************************************************************AAA5ESNN *> Accès logiques Ecriture Séquentielle AAA5ESNN *>****************************************************************AAA5ESNN *> AAA5ESNN OUVRIR-S2 SECTION. AAA5ESNN perform OUVRIR-S2-PHYSIQUE. AAA5ESNN OUVRIR-S2-FN. AAA5ESNN exit section. AAA5ESNN *> AAA5ESNN ECRIRE-S2 SECTION. AAA5ESNN perform ECRIRE-S2-PHYSIQUE. AAA5ESNN ECRIRE-S2-FN. AAA5ESNN exit section. AAA5ESNN *> AAA5ESNN FERMER-S2 SECTION. AAA5ESNN perform FERMER-S2-PHYSIQUE. AAA5ESNN FERMER-S2-FN. AAA5ESNN exit section. AAA5ESNN *>>evaluate AA-A-ORG AAA5ES00 * >>when 'F' *> Fichier Séquentiel AAA5ES00 * copy AAA5ESF0. AAA5ES00 *CONTROL NOSOURCE AAA5ESF0 *>****************************************************************AAA5ESF0 *> Pour écrire dans un fichier multi-enregistrement, ajouter une AAA5ESF0 *> clause replacing comme : AAA5ESF0 *> COPY AAAPACCE REPLACING AAA5ESF0 *> ==write :PREF:== by == AAA5ESF0 *> ==evaluate dd00-code-structure AAA5ESF0 *> when 'r1' AAA5ESF0 *> write dd01 AAA5ESF0 *> when 'r2' AAA5ESF0 *> write dd02 AAA5ESF0 *> ... AAA5ESF0 *> when other AAA5ESF0 *> ... AAA5ESF0 *> end-evalate== AAA5ESF0 *> ==:DD:== by ==FI== AAA5ESF0 *> . AAA5ESF0 *> Le replacing de l'ordre write doit être placé avant le AAA5ESF0 *> replacing des paramètres. AAA5ESF0 *CONTROL SOURCE AAA5ESF0 *>****************************************************************AAA5ESF0 *> Accès physiques Ecriture Séquentielle Fichier Séquentiel AAA5ESF0 *>****************************************************************AAA5ESF0 *> AAA5ESF0 OUVRIR-S2-PHYSIQUE SECTION. AAA5ESF0 open output S2-FICHIER. AAA5ESF0 OUVRIR-S2-PHYSIQUE-FN. AAA5ESF0 exit section. AAA5ESF0 *> AAA5ESF0 ECRIRE-S2-PHYSIQUE SECTION. AAA5ESF0 write S200 AAA5ESF0 add 1 to 5-S200-CPTENR. AAA5ESF0 ECRIRE-S2-PHYSIQUE-FN. AAA5ESF0 exit section. AAA5ESF0 *> AAA5ESF0 FERMER-S2-PHYSIQUE SECTION. AAA5ESF0 close S2-FICHIER. AAA5ESF0 FERMER-S2-PHYSIQUE-FN. AAA5ESF0 exit section. AAA5ESF0 * >>when '2' *> Accès Db2 AAA5ES00 *>>end-evaluate AAA5ES00 * >>when 'R' *> Ecriture directe AAA5E000 *>>end-evaluate AAA5E000 * >>when 'M' *> Création Modification Suppression AAAPACCE *>>end-evaluate AAAPACCE *CONTROL NOSOURCE AAAPACCE *> --- Effacement des variables conditionnelles locales AAAPACCE *>>define AA-A-ACCES off AAAPACCE *>>define AA-A-MODE off AAAPACCE *>>define AA-A-ORG off AAAPACCE *>>define AA-A-NR off AAAPACCE *>>define AA-A-NS off AAAPACCE *CONTROL SOURCE AAAPACCE sqpaf *> *> zone injection fin <* <* sqpaf *--- Fin accès ressources ---------------------------------------- sqpaq ACCESS-RESSOURCES-FN. sqpaq exit section. sqpaq sqpv /================================================================= sqpv * SSSS EEEEE RRRR V V IIIII CCC EEEEE SSSS sqpv * S E R R V V I C C E S sqpv * SSS EEEE RRRR V V I C EEEE SSS sqpv * S E R R V V I C C E S sqpv * SSSS EEEEE R R V IIIII CCC EEEEE SSSS sqpv *================================================================= sqpv SERVICES-FRAMEWORK SECTION. sqpv continue. sqpv *--- Gestion des opérations sur dates et heures ------------------ sqpv * copy ADAPDATE. *CONTROL NOSOURCE ADAPDATE *>****************************************************************ADAPDATE *> Routine de traitements de Date et Heure. ADAPDATE *> Cette COPY doit être appelée en Procedure Division une fois en ADAPDATE *> cas de traitement de Dates ou Heures. ADAPDATE *>----------------------------------------------------------------ADAPDATE *> Transformation du format d'une Date : ADAPDATE *> - alimenter la variable 5-DATE- correspondant au format ADAPDATE *> source (C, D, E, G, I, M, S) ADAPDATE *> - pour une conversion d'une date sans siècle vers une date ADAPDATE *> avec siècle, alimenter l'indicateur DAT-ADO avec l'une des ADAPDATE *> valeurs : ADAPDATE *> - '0' ou "set 5-DATE-SIECLE-DEF to true" : utilisation du ADAPDATE *> siècle par défaut 5-DATE-SIECLE ADAPDATE *> - '1' ou "set 5-DATE-1900-AVANT to true" : siècle '19' si ADAPDATE *> année < pivot, sinon '20' ADAPDATE *> - '2' ou "set 5-DATE-2000-AVANT to true" : siècle '20' si ADAPDATE *> année < pivot, sinon '19' ADAPDATE *> - appeler par PERFORM la routine CONVERTIR-DE-DATE- ADAPDATE *> correspondant au format source ADAPDATE *> - appeler par PERFORM la routine CONVERTIR-VERS-DATE- ADAPDATE *> correspondant au format cible ADAPDATE *> - récupérer la date transformée dans la variable 5-DATE- ADAPDATE *> correspondant au format cible ADAPDATE *> Les fonctions de transformations utilisent la zone 5-DATE-S ADAPDATE *> comme zone de travail entre une fonction CONVERTIR-DE-DATE- ADAPDATE *> et une fonction CONVERTIR-VERS-DATE-. ADAPDATE *>----------------------------------------------------------------ADAPDATE *> Toutes les transformations standards sont prévues. ADAPDATE *> L'optimiseur du compilateur COBOL éliminera le code superflus. ADAPDATE *>----------------------------------------------------------------ADAPDATE *> Paramètres obligatoires : ADAPDATE *> Néant. ADAPDATE *>----------------------------------------------------------------ADAPDATE *> Variables de compilation : ADAPDATE *> Néant. ADAPDATE *>****************************************************************ADAPDATE *CONTROL SOURCE ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT C : JJMMSSAA ADAPDATE CONVERTIR-DE-DATE-C SECTION. ADAPDATE move DD of 5-DATE-C to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-C to MM of 5-DATE-S ADAPDATE move YYYY of 5-DATE-C to YYYY of 5-DATE-S. ADAPDATE CONVERTIR-DE-DATE-C-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-C SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-C ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-C ADAPDATE move YYYY of 5-DATE-S to YYYY of 5-DATE-C. ADAPDATE CONVERTIR-VERS-DATE-C-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT D : JJMMAA ADAPDATE CONVERTIR-DE-DATE-D SECTION. ADAPDATE move DD of 5-DATE-D to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-D to MM of 5-DATE-S ADAPDATE move YY of 5-DATE-D to YY of 5-DATE-S ADAPDATE perform DEFINIR-SIECLE. ADAPDATE CONVERTIR-DE-DATE-D-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-D SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-D ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-D ADAPDATE move YY of 5-DATE-S to YY of 5-DATE-D. ADAPDATE CONVERTIR-VERS-DATE-D-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT E : JJ/MM/AA ADAPDATE CONVERTIR-DE-DATE-E SECTION. ADAPDATE move DD of 5-DATE-E to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-E to MM of 5-DATE-S ADAPDATE move YY of 5-DATE-E to YY of 5-DATE-S ADAPDATE perform DEFINIR-SIECLE. ADAPDATE CONVERTIR-DE-DATE-E-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-E SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-E ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-E ADAPDATE move YY of 5-DATE-S to YY of 5-DATE-E ADAPDATE move DATSEP to S1 of 5-DATE-E ADAPDATE S2 of 5-DATE-E. ADAPDATE CONVERTIR-VERS-DATE-E-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT G : SSAA-MM-JJ ADAPDATE CONVERTIR-DE-DATE-G SECTION. ADAPDATE move DD of 5-DATE-G to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-G to MM of 5-DATE-S ADAPDATE move YYYY of 5-DATE-G to YYYY of 5-DATE-S. ADAPDATE CONVERTIR-DE-DATE-G-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-G SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-G ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-G ADAPDATE move YYYY of 5-DATE-S to YYYY of 5-DATE-G ADAPDATE move DATSET to S1 of 5-DATE-G ADAPDATE S2 of 5-DATE-G. ADAPDATE CONVERTIR-VERS-DATE-G-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT I : AAMMJJ ADAPDATE CONVERTIR-DE-DATE-I SECTION. ADAPDATE move DD of 5-DATE-I to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-I to MM of 5-DATE-S ADAPDATE move YY of 5-DATE-I to YY of 5-DATE-S ADAPDATE perform DEFINIR-SIECLE. ADAPDATE CONVERTIR-DE-DATE-I-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-I SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-I ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-I ADAPDATE move YY of 5-DATE-S to YY of 5-DATE-I. ADAPDATE CONVERTIR-VERS-DATE-I-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT M : JJ/MM/SSAA ADAPDATE CONVERTIR-DE-DATE-M SECTION. ADAPDATE move DD of 5-DATE-M to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-M to MM of 5-DATE-S ADAPDATE move YYYY of 5-DATE-M to YYYY of 5-DATE-S. ADAPDATE CONVERTIR-DE-DATE-M-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-M SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-M ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-M ADAPDATE move YYYY of 5-DATE-S to YYYY of 5-DATE-M ADAPDATE move DATSEP to S1 of 5-DATE-M ADAPDATE S2 of 5-DATE-M. ADAPDATE CONVERTIR-VERS-DATE-M-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> TRANSFORMATION DATE FORMAT S : SSAAMMJJ ADAPDATE CONVERTIR-DE-DATE-S SECTION. ADAPDATE continue. ADAPDATE CONVERTIR-DE-DATE-S-FN. ADAPDATE exit section. ADAPDATE CONVERTIR-VERS-DATE-S SECTION. ADAPDATE continue. ADAPDATE CONVERTIR-VERS-DATE-S-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> ALIMENTATION DU SIECLE SUR DATE SANS SIECLE ADAPDATE DEFINIR-SIECLE SECTION. ADAPDATE evaluate true also true ADAPDATE when not 5-DATE-1900-AVANT and not 5-DATE-2000-AVANT ADAPDATE also any ADAPDATE move 5-DATE-SIECLE to CC of 5-DATE-S ADAPDATE when 5-DATE-1900-AVANT also YY in 5-DATE-S < 5-DATE-PIVOT ADAPDATE when 5-DATE-2000-AVANT also YY in 5-DATE-S >= 5-DATE-PIVOT ADAPDATE move '19' to CC of 5-DATE-S ADAPDATE when other ADAPDATE move '20' to CC of 5-DATE-S ADAPDATE end-evaluate. ADAPDATE DEFINIR-SIECLE-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> VALIDATION D'UNE DATE ADAPDATE VALIDER-DATE SECTION. ADAPDATE *> --- par défaut, date invalide ADAPDATE set 5-DATE-INVALIDE to true ADAPDATE evaluate true ADAPDATE *> --- conditions invalidité de la date ADAPDATE when 5-DATE-S not numeric ADAPDATE when MM in 5-DATE-S < '01' or > '12' ADAPDATE when DD in 5-DATE-S < '01' or > '31' ADAPDATE when DD in 5-DATE-S > '30' and (MM in 5-DATE-S = '04' ADAPDATE or '06' ADAPDATE or '09' ADAPDATE or '11') ADAPDATE when DD in 5-DATE-S > '29' and MM in 5-DATE-S = '02' ADAPDATE exit section ADAPDATE *> --- calcul année bissextile sur 29/02 ADAPDATE when MM in 5-DATE-S = '02' and DD in 5-DATE-S = '29' ADAPDATE *> --- siecle mutiple de 400 bissextile ADAPDATE if YY in 5-DATE-S = '00' ADAPDATE compute 5-DATE-M4 = CC9 in 5-DATE-S / 4 ADAPDATE compute 5-DATE-M4 = CC9 in 5-DATE-S - 5-DATE-M4 * 4 ADAPDATE *> --- année multiple de 4 bissextile ADAPDATE else ADAPDATE compute 5-DATE-M4 = YY9 in 5-DATE-S / 4 ADAPDATE compute 5-DATE-M4 = YY9 in 5-DATE-S - 5-DATE-M4 * 4 ADAPDATE end-if ADAPDATE if 5-DATE-M4 not = 0 ADAPDATE exit section ADAPDATE end-if ADAPDATE end-evaluate ADAPDATE *> --- si aucune anomalie alors date valide ADAPDATE set 5-DATE-VALIDE to true. ADAPDATE VALIDER-DATE-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT I VERS D (ADI : AAMMJJ --> JJMMAA) ADAPDATE INVERSER-DATE-I SECTION. ADAPDATE move DD of 5-DATE-I to DD of 5-DATE-D ADAPDATE move MM of 5-DATE-I to MM of 5-DATE-D ADAPDATE move YY of 5-DATE-I to YY of 5-DATE-D. ADAPDATE INVERSER-DATE-I-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT D VERS I (sans équivalent : JJMMAA --> AAMMJJ) ADAPDATE INVERSER-DATE-D SECTION. ADAPDATE move DD of 5-DATE-D to DD of 5-DATE-I ADAPDATE move MM of 5-DATE-D to MM of 5-DATE-I ADAPDATE move YY of 5-DATE-D to YY of 5-DATE-I. ADAPDATE INVERSER-DATE-D-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT C VERS S (sans équivalent : JJMMSSAA --> SSAAMMJJ) ADAPDATE INVERSER-DATE-C SECTION. ADAPDATE move DD of 5-DATE-C to DD of 5-DATE-S ADAPDATE move MM of 5-DATE-C to MM of 5-DATE-S ADAPDATE move YYYY of 5-DATE-C to YYYY of 5-DATE-S. ADAPDATE INVERSER-DATE-C-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT S VERS C (ADS : SSAAMMJJ --> JJMMSSAA) ADAPDATE INVERSER-DATE-S SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-C ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-C ADAPDATE move YYYY of 5-DATE-S to YYYY of 5-DATE-C. ADAPDATE INVERSER-DATE-S-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT D VERS E (ADE : JJMMAA --> JJ/MM/AA) ADAPDATE EDITER-DATE-D SECTION. ADAPDATE move DD of 5-DATE-D to DD of 5-DATE-E ADAPDATE move MM of 5-DATE-D to MM of 5-DATE-E ADAPDATE move YY of 5-DATE-D to YY of 5-DATE-E ADAPDATE move DATSEP to S1 of 5-DATE-E ADAPDATE S2 of 5-DATE-E. ADAPDATE EDITER-DATE-D-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT I VERS E (ADF : AAMMJJ --> JJ/MM/AA) ADAPDATE EDITER-DATE-I SECTION. ADAPDATE move DD of 5-DATE-I to DD of 5-DATE-E ADAPDATE move MM of 5-DATE-I to MM of 5-DATE-E ADAPDATE move YY of 5-DATE-I to YY of 5-DATE-E ADAPDATE move DATSEP to S1 of 5-DATE-E ADAPDATE S2 of 5-DATE-E. ADAPDATE EDITER-DATE-I-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT C VERS M (ADM : JJMMSSAA --> JJ/MM/SSAA) ADAPDATE EDITER-DATE-C SECTION. ADAPDATE move DD of 5-DATE-C to DD of 5-DATE-M ADAPDATE move MM of 5-DATE-C to MM of 5-DATE-M ADAPDATE move YYYY of 5-DATE-C to YYYY of 5-DATE-M ADAPDATE move DATSEP to S1 of 5-DATE-M ADAPDATE S2 of 5-DATE-M. ADAPDATE EDITER-DATE-C-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT S VERS M (sans équivalent : SSAAMMJJ --> ADAPDATE *> JJ/MM/SSAA) ADAPDATE EDITER-DATE-S SECTION. ADAPDATE move DD of 5-DATE-S to DD of 5-DATE-M ADAPDATE move MM of 5-DATE-S to MM of 5-DATE-M ADAPDATE move YYYY of 5-DATE-S to YYYY of 5-DATE-M ADAPDATE move DATSEP to S1 of 5-DATE-M ADAPDATE S2 of 5-DATE-M. ADAPDATE EDITER-DATE-S-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> HEURE FORMAT EDITION (TIF : HHMMSS --> HH:MM:SS) ADAPDATE EDITER-HEURE SECTION. ADAPDATE move HH in 5-TIME to HH in TIMDAY ADAPDATE move MM in 5-TIME to MM in TIMDAY ADAPDATE move SS in 5-TIME to SS in TIMDAY ADAPDATE move TIMSEP to S1 in TIMDAY ADAPDATE S2 in TIMDAY. ADAPDATE EDITER-HEURE-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> NOMBRE DE JOURS ENTRE DEUX DATES FORMAT S SSAAMMJJ ADAPDATE SOUSTRAIRE-DATE SECTION. ADAPDATE compute NUM-DAYS = function integer-of-date (5-DATE-D1) ADAPDATE - function integer-of-date (5-DATE-D2). ADAPDATE SOUSTRAIRE-DATE-FN. ADAPDATE exit section. ADAPDATE *> ADAPDATE *> DATE FORMAT S +/- N JOURS (DAO S NUM-DAYS 5-DATE-S) ADAPDATE DECALER-DATE SECTION. ADAPDATE compute 5-DATE-D1 = ADAPDATE function date-of-integer ( ADAPDATE function integer-of-date (5-DATE-D1) + NUM-DAYS). ADAPDATE DECALER-DATE-FN. ADAPDATE exit section. ADAPDATE *>>if AA-G-CICS ADAPDATE *>>end-if ADAPDATE *>>if AA-G-PACBASE ADAPDATE *>>end-if ADAPDATE sqpvd *> *> zone injection debut <* <* sqpvf *> *> zone injection fin <* <* sqpvq *--- Fin services framework -------------------------------------- sqpvq SERVICES-FRAMEWORK-FN. sqpvq exit section. sqpvq sqpi /================================================================= sqpi * IIIII N N IIIII TTTTT IIIII AAA L IIIII SSS sqpi * I NN N I T I A A L I S sqpi * I N N N I T I AAAAA L I SSS sqpi * I N NN I T I A A L I S sqpi * IIIII N N IIIII T IIIII A A LLLLL IIIII SSS sqpi *================================================================= sqpi INITIALISATIONS SECTION. sqpi *--- Trace reco audit -------------------------------------------- sqpi * copy AGAPAUD1. *CONTROL NOSOURCE AGAPAUD1 *>****************************************************************AGAPAUD1 *> Tracabilité programme - Reco "Audit Archivage 2010" #5 AGAPAUD1 *> Début d'exécution AGAPAUD1 *>----------------------------------------------------------------AGAPAUD1 *> Paramètres obligatoires : AGAPAUD1 *> - Néant AGAPAUD1 *> Paramètres facultatifs (selon contexte) : AGAPAUD1 *> - Néant AGAPAUD1 *> Variables de compilation : AGAPAUD1 *> - Néant AGAPAUD1 *>****************************************************************AGAPAUD1 *CONTROL SOURCE AGAPAUD1 *> AGAPAUD1 *> Tracabilité programme - Reco "Audit Archivage 2010" #5 - Début AGAPAUD1 if RECO-ARCH-2010-5-notRUN AGAPAUD1 set RECO-ARCH-2010-5-notRUN to false AGAPAUD1 *> --- Préparation de la date du jour dans différents formats AGAPAUD1 *> DATCE : SSAAMMJJ AGAPAUD1 move function current-date to DATCE AGAPAUD1 *> W-BA0C-DASDSY : JJMMSSAA AGAPAUD1 move DATCE (7:2) to W-BA0C-DASDSY (1:2) AGAPAUD1 move DATCE (5:2) to W-BA0C-DASDSY (3:2) AGAPAUD1 move DATCE (1:4) to W-BA0C-DASDSY (5:4) AGAPAUD1 *> W-BA0G-DASDSY : SSAA-MM-JJ AGAPAUD1 move DATCE (1:4) to W-BA0G-DASDSY (1:4) AGAPAUD1 move DATCE (5:2) to W-BA0G-DASDSY (6:2) AGAPAUD1 move DATCE (7:2) to W-BA0G-DASDSY (9:2) AGAPAUD1 move '-' to W-BA0G-DASDSY (5:1) AGAPAUD1 W-BA0G-DASDSY (8:1) AGAPAUD1 *> W-BA0M-DASDSY : JJ/MM/SSAA AGAPAUD1 move DATCE (7:2) to W-BA0M-DASDSY (1:2) AGAPAUD1 move DATCE (5:2) to W-BA0M-DASDSY (4:2) AGAPAUD1 move DATCE (1:4) to W-BA0M-DASDSY (7:4) AGAPAUD1 move '/' to W-BA0M-DASDSY (3:1) AGAPAUD1 W-BA0M-DASDSY (6:1) AGAPAUD1 *>>if AA-G-MIXED AGAPAUD1 *>>end-if AGAPAUD1 *> --- Message dans la log MVS AGAPAUD1 display 'GCE001I IDENTITE PROGRAMME ' PROGE AGAPAUD1 ' (' PROGR ' ' COBASE ' ' APPLI ' ' NUGNA ' ' AGAPAUD1 DATGNC ' ' TIMGN ')' upon CONSOLE AGAPAUD1 *> --- Message début de programme en SYSOUT AGAPAUD1 display PROGE ' - DEBUT PROGRAMME (' PROGR ' ' COBASE ' ' AGAPAUD1 APPLI ' ' NUGNA ' ' DATGNC ' ' TIMGN '), LE ' AGAPAUD1 W-BA0M-DASDSY AGAPAUD1 *>>if AA-G-MIXED AGAPAUD1 *>>end-if AGAPAUD1 end-if AGAPAUD1 sqpid *> *> zone injection debut <* <* sqpif *> *> zone injection fin <* <* sqpiq *--- Fin initialisations ----------------------------------------- sqpiq continue. sqpiq INITIALISATIONS-FN. sqpiq exit section. sqpiw * sqpiw INITIALISATIONS-WORKING SECTION. sqpiw set WORKING-INITIALISEES to true sqpiwd*> *> zone injection debut <* <* sqpiwf*> *> zone injection fin <* <* sqpiw9*--- Fin initialisations ----------------------------------------- sqpiw9 continue. sqpiw9 INITIALISATIONS-WORKING-FN. sqpiw9 exit section. sqpiw9 sqpo /================================================================= sqpo * OOO U U V V EEEEE RRRR TTTTT U U RRRR EEEEE sqpo * O O U U V V E R R T U U R R E sqpo * O O U U V V EEEE RRRR T U U RRRR EEEE sqpo * O O U U V V E R R T U U R R E sqpo * OOO UUU V EEEEE R R T UUU R R EEEEE sqpo *================================================================= sqpo OUVERTURES SECTION. sqpod *> *> zone injection debut <* <* cdAP00* -- Ouverture ressource AP -- cdAP00*^^ouvavt * compléter les lignes ci-dessous * cdAP00 perform OUVRIR-AP cdAP00*^^ouvapr * compléter les lignes ci-dessous * cdAP00* cdDM00* -- Ouverture ressource DM -- cdDM00*^^ouvavt * compléter les lignes ci-dessous * cdDM00 perform OUVRIR-DM cdDM00*^^ouvapr * compléter les lignes ci-dessous * cdDM00* cdS100* -- Ouverture ressource S1 -- cdS100*^^ouvavt * compléter les lignes ci-dessous * cdS100 perform OUVRIR-S1 cdS100*^^ouvapr * compléter les lignes ci-dessous * cdS100* cdS200* -- Ouverture ressource S2 -- cdS200*^^ouvavt * compléter les lignes ci-dessous * cdS200 perform OUVRIR-S2 cdS200*^^ouvapr * compléter les lignes ci-dessous * cdS200* sqpof *> *> zone injection fin <* <* sqpoq *--- Fin ouvertures ressources ----------------------------------- sqpoq continue. sqpoq OUVERTURES-FN. sqpoq exit section. sqpoq sqpl /================================================================= sqpl * L EEEEE CCC TTTTT U U RRRR EEEEE SSS sqpl * L E C C T U U R R E S sqpl * L EEE C T U U RRRR EEEE SSS sqpl * L E C C T U U R R E S sqpl * LLLLL EEEEE CCC T UUU R R EEEEE SSS sqpl *================================================================= sqpl *>>if AA-A-LECTURES sqpl LECTURES SECTION. sqplsd*> *> zone injection debut <* <* cdDM00* -- Lecture ressource DM sans rupture -- cdDM00*^^liravt * compléter les lignes ci-dessous * cdDM00 perform LIRE-DM cdDM00*^^lirapr * compléter les lignes ci-dessous * cdDM00* sqplsf*> *> zone injection fin <* <* sqplrd*> *> zone injection debut <* <* cdAP00* -- Lecture ressource AP avec ruptures -- cdAP00*^^liravt * compléter les lignes ci-dessous * cdAP00 perform LIRE-AP cdAP00*^^lirapr * compléter les lignes ci-dessous * cdAP00* sqplrf*> *> zone injection fin <* <* sqplq *--- Fin lectures ressources ------------------------------------- sqplq continue. sqplq LECTURES-FN. sqplq exit section. sqplq *>>end-if sqplq sqpf /================================================================= sqpf * FFFFF EEEEE RRRR M M EEEEE TTTTT U U RRRR EEEEE sqpf * F E R R MM MM E T U U R R E sqpf * FFFF EEEE RRRR M M M EEEE T U U RRRR EEEE sqpf * F E R R M M E T U U R R E sqpf * F EEEEE R R M M EEEEE T UUU R R EEEEE sqpf *================================================================= sqpf FERMETURES SECTION. sqpfd *> *> zone injection debut <* <* cdAP00* -- Fermeture ressource AP -- cdAP00*^^feravt * compléter les lignes ci-dessous * cdAP00 perform FERMER-AP cdAP00*^^ferapr * compléter les lignes ci-dessous * cdAP00* cdDM00* -- Fermeture ressource DM -- cdDM00*^^feravt * compléter les lignes ci-dessous * cdDM00 perform FERMER-DM cdDM00*^^ferapr * compléter les lignes ci-dessous * cdDM00* cdS100* -- Fermeture ressource S1 -- cdS100*^^feravt * compléter les lignes ci-dessous * cdS100 perform FERMER-S1 cdS100*^^ferapr * compléter les lignes ci-dessous * cdS100* cdS200* -- Fermeture ressource S2 -- cdS200*^^feravt * compléter les lignes ci-dessous * cdS200 perform FERMER-S2 cdS200*^^ferapr * compléter les lignes ci-dessous * cdS200* sqpff *> *> zone injection fin <* <* sqpfq *--- Fin fermetures ressources ----------------------------------- sqpfq continue. sqpfq FERMETURES-FN. sqpfq exit section. sqpfq sqpq /================================================================= sqpq * FFFFF IIIII N N AAA L IIIII SSSS sqpq * F I NN N A A L I S sqpq * FFFF I N N N AAAAA L I SSS sqpq * F I N NN A A L I S .. sqpq * F IIIII N N A A LLLLL IIIII SSSS .. sqpq *================================================================= sqpq FINALISATION SECTION. sqpqd *> *> zone injection debut <* <* sqpqf *> *> zone injection fin <* <* sqpqt *--- Traçabilité programme (reco audit) -------------------------- sqpqt * copy AGAPAUD2. *CONTROL NOSOURCE AGAPAUD2 *>****************************************************************AGAPAUD2 *> Tracabilité programme - Reco "Audit Archivage 2010" #5 AGAPAUD2 *> Fin d'exécution AGAPAUD2 *>----------------------------------------------------------------AGAPAUD2 *> Paramètres obligatoires : AGAPAUD2 *> - Néant AGAPAUD2 *> Paramètres facultatifs (selon contexte) : AGAPAUD2 *> - Néant AGAPAUD2 *> Variables de compilation : AGAPAUD2 *> - Néant AGAPAUD2 *>****************************************************************AGAPAUD2 *CONTROL SOURCE AGAPAUD2 *> AGAPAUD2 *> Tracabilité programme - Reco "Audit Archivage 2010" #5 - Fin AGAPAUD2 if not RECO-ARCH-2010-5-wasRUN AGAPAUD2 set RECO-ARCH-2010-5-wasRUN to true AGAPAUD2 *> --- Message fin de programme en SYSOUT AGAPAUD2 *>>if AA-G-MIXED AGAPAUD2 *>>end-if AGAPAUD2 display PROGE ' - FIN PROGRAMME' AGAPAUD2 *>>if AA-G-MIXED AGAPAUD2 *>>end-if AGAPAUD2 end-if AGAPAUD2 sqpqq *--- Fin finalisation -------------------------------------------- sqpqq continue. sqpqq FINALISATION-FN. sqpqq exit section. sqpqq sqpr /================================================================= sqpr * RRRR U U PPPP TTTTT SSSS Y Y N N CCC sqpr * R R U U P P T S Y Y NN N C C sqpr * RRRR U U PPPP T SSS Y N N N C sqpr * R R U U P T S Y N NN C C sqpr * R R UUU P T SSSS Y N N CCC sqpr *================================================================= sqpr RUPTURES-SYNCHROS SECTION. sqpr2d*>>if AA-A-LECTURES-AVEC-RUPT sqpr2d*> *> zone injection debut <* <* cdAP00* -- Ruptures ressource AP -- cdAP00 perform CALCULER-RUPT-AP sqpr2f*> *> zone injection fin <* <* sqpr2f*>>end-if sqpr4 *>>if AA-A-LECTURES-AVEC-SYNC sqpr4 *--- Calcul des Synchronisations --------------------------------- sqpr4 * copy AAAPGSYN. *CONTROL NOSOURCE AAAPGSYN *>****************************************************************AAAPGSYN *> Calcul des Configurations au niveau global AAAPGSYN *>----------------------------------------------------------------AAAPGSYN *> Conditions d'utilisation : AAAPGSYN *> Ce COPYBOOK doit être appelé avant les appels aux routines AAAPGSYN *> "CALCULER-CLE-dd" et CALCULER-CONF-dd" de chacune des AAAPGSYN *> ressources déclarées avec Synchronisation. AAAPGSYN *>----------------------------------------------------------------AAAPGSYN *> Paramètres obligatoires : AAAPGSYN *> - Néant AAAPGSYN *> Paramètres facultatifs (selon contexte) : AAAPGSYN *> - Néant AAAPGSYN *> Variables de compilation : AAAPGSYN *> - AA-A-MAXNS : calculée, niveau de synchronisation maximum AAAPGSYN *> toutes ressources AAAPGSYN *>****************************************************************AAAPGSYN *CONTROL SOURCE AAAPGSYN *>>if AA-A-MAXNS > 0 AAAPGSYN move high-value to IND AAAPGSYN move 0 to MAX-CF AAAPGSYN *>>end-if AAAPGSYN sqpr4d*=== Phase 1 - Calcul de la clé de Synchronisation =============== sqpr4d*> *> zone injection debut <* <* cdAP00* -- Calcul des configurations ressource AP -- cdAP00 perform CALCULER-CLE-AP cdDM00* -- Calcul des configurations ressource DM -- cdDM00 perform CALCULER-CLE-DM sqpr4f*> *> zone injection fin <* <* sqpr5d*=== Phase 2 - Calcul des configurations ========================= sqpr5d*> *> zone injection debut <* <* cdAP00* -- Calcul des configurations ressource AP -- cdAP00 perform CALCULER-CONF-AP cdDM00* -- Calcul des configurations ressource DM -- cdDM00 perform CALCULER-CONF-DM sqpr5f*> *> zone injection fin <* <* sqpr5f*>>end-if sqpr6 *>>if AA-A-LECTURES-AVEC-RUPT and AA-A-LECTURES-AVEC-SYNC sqpr6 *--- Calcul des Ruptures totales --------------------------------- sqpr6 * copy AAAPGRTD. *CONTROL NOSOURCE AAAPGRTD *>****************************************************************AAAPGRTD *> Calcul des Ruptures Totales Dernières au niveau global AAAPGRTD *>----------------------------------------------------------------AAAPGRTD *> Conditions d'utilisation : AAAPGRTD *> Ce COPYBOOK doit être appelé après le calcul des Ruptures et AAAPGRTD *> Synchronisations (Configuration) de chacune des ressources, et AAAPGRTD *> doit être suivi d'un appel à la routine "CALCULER-RTD-dd" de AAAPGRTD *> chacune des ressources déclarées avec Ruptures et avec AAAPGRTD *> Synchronisation. AAAPGRTD *>----------------------------------------------------------------AAAPGRTD *> Paramètres obligatoires : AAAPGRTD *> - Néant AAAPGRTD *> Paramètres facultatifs (selon contexte) : AAAPGRTD *> - Néant AAAPGRTD *> Variables de compilation : AAAPGRTD *> - AA-A-MAXNR : calculée, niveau de rupture maximum toutes AAAPGRTD *> ressources AAAPGRTD *> - AA-A-MAXNS : calculée, niveau de synchronisation maximum AAAPGRTD *> toutes ressources AAAPGRTD *>****************************************************************AAAPGRTD *CONTROL SOURCE AAAPGRTD *>>if AA-A-MAXNR > 0 and AA-A-MAXNS > 0 AAAPGRTD move RTD to RTP AAAPGRTD move all '1' to RTD AAAPGRTD move NRD to NRP AAAPGRTD move 1 to NRD2 NRD AAAPGRTD *>>end-if AAAPGRTD sqpr6d*> *> zone injection debut <* <* cdAP00* -- Calcul des Ruptures Totales AP -- cdAP00 perform CALCULER-RTD-AP sqpr6f*> *> zone injection fin <* <* sqpr6f*>>end-if sqprq *--- Fin Ruptures et Synchronisations ---------------------------- sqprq continue. sqprq RUPTURES-SYNCHROS-FN. sqprq exit section. sqprq sqpc /================================================================= sqpc * CCC OOO N N TTTTT RRRR OOO L EEEEE SSSS sqpc * C C O O NN N T R R O O L E S sqpc * C O O N N N T RRRR O O L EEEE SSS sqpc * C C O O N NN T R R O O L E S sqpc * CCC OOO N N T R R OOO LLLLL EEEEE SSSS sqpc *================================================================= sqpc *>>if AA-A-CONTROLES sqpcq *>>end-if sqpcq sqpm /================================================================= sqpm * M M AAA JJJJJ AAA U U TTTTT OOO sqpm * MM MM A A J A A U U T O O sqpm * M M M AAAAA J AAAAA U U T O O sqpm * M M A A J J A A U U T O O sqpm * M M A A J A A UUU T OOO sqpm *================================================================= sqpm *>>if AA-A-MAJ sqpmq *>>end-if sqpmq sqpe /================================================================= sqpe * EEEEE DDDD IIIII TTTTT IIIII OOO N N SSSS sqpe * E D D I T I O O NN N S sqpe * EEEE D D I T I O O N N N SSS sqpe * E D D I T I O O N NN S sqpe * EEEEE DDDD IIIII T IIIII OOO N N SSSS sqpe *================================================================= sqpe *>>if AA-A-EDITIONS sqpeq *>>end-if sqpeq sqps /================================================================= sqps * EEEEE CCC RRRR IIIII TTTTT U U RRRR EEEEE SSSS sqps * E C C R R I T U U R R E S sqps * EEEE C RRRR I T U U RRRR EEEE SSS sqps * E C C R R I T U U R R E S sqps * EEEEE CCC R R IIIII T UUU R R EEEEE SSSS sqps *================================================================= sqps *>>if AA-A-ECRITURES sqps ECRITURES SECTION. sqpsd *> *> zone injection debut <* <* cdS100* -- Gestion Ecriture S1 -- cdS100*^^ecravt * compléter les lignes ci-dessous * * Ecriture si date de fin non renseignée if 1-AP00-DISGSU = spaces move DM00-COSGDM to S100-COSGDM move DM00-LNSGDM to S100-LNSGDM move 1-AP00-COSGA1 to S100-COSGA1 move 1-AP00-LNSGAP to S100-LNSGAP cdS100 perform ECRIRE-S1 cdS100*^^ecrapr * compléter les lignes ci-dessous end-if cdS100* cdS200* -- Gestion Ecriture S2 -- cdS200*^^ecravt * compléter les lignes ci-dessous * * Ecriture en rupture dernière niveau 1 if RTD1 = 1 move DM00-COSGDM to S200-COSGDM move DM00-LNSGDM to S200-LNSGDM move W-WB00-W9040 to S200-W9040 cdS200 perform ECRIRE-S2 cdS200*^^ecrapr * compléter les lignes ci-dessous end-if cdS200* sqpsf *> *> zone injection fin <* <* sqpsq *--- Fin écritures ----------------------------------------------- sqpsq continue. sqpsq ECRITURES-FN. sqpsq exit section. sqpsq *>>end-if sqpsq sqpko /================================================================= sqpko * EEEEE RRRR RRRR EEEEE U U RRRR SSSS sqpko * E R R R R E U U R R S sqpko * EEEE RRRR RRRR EEEE U U RRRR SSS sqpko * E R R R R E U U R R S sqpko * EEEEE R R R R EEEEE UUU R R SSSS sqpko *================================================================= sqpko *--- Gestion des erreurs DB2 ------------------------------------- sqpk2 *>>if AA-A-DB2 sqpk2 ERREUR-DB2 SECTION. sqpk2 * copy A2APTIAR. *CONTROL NOSOURCE A2APTIAR *>****************************************************************A2APTIAR *> Appel au module DSNTIAR A2APTIAR *>----------------------------------------------------------------A2APTIAR *> Code retour : A2APTIAR *> - 00 : ok A2APTIAR *> - 04 : zone message trop petite, perte d'informations A2APTIAR *> - 08 : longueur de ligne de dehors de l'intervalle 72 à 240 A2APTIAR *> - 12 : longueur zone message inférieure à 240 A2APTIAR *> - 16 : erreur dans la routine TSO A2APTIAR *> - 20 : module DSNTIA1 non chargeable A2APTIAR *> - 24 : structure SQLCA invalide A2APTIAR ******************************************************************A2APTIAR *CONTROL SOURCE A2APTIAR *> --- Interface DSNTIAR A2APTIAR >>callinterface dynamic A2APTIAR call 'DSNTIAR' using SQLCA A2APTIAR DSNTIAR-MESSAGE A2APTIAR DSNTIAR-LINE-LENGTH A2APTIAR on exception A2APTIAR move 20 to DSNTIAR-RC A2APTIAR not on exception A2APTIAR move return-code to DSNTIAR-RC A2APTIAR end-call A2APTIAR >>callinterface A2APTIAR sqpk2 if DSNTIAR-OK sqpk2 display '*******************************' sqpk2 display '**** E R R E U R D B 2 ****' sqpk2 display '*******************************' sqpk2 perform varying XDSNTIAR from 1 by 1 sqpk2 until XDSNTIAR > 10 sqpk2 or DSNTIAR-END (XDSNTIAR) sqpk2 display DSNTIAR-LINE (XDSNTIAR) sqpk2 end-perform sqpk2 end-if sqpk2 move SQLCODE to DSNTIAR-ABEND sqpk2a call "CEE3ABD" using DSNTIAR-ABEND sqpk2a by content X'00000001' sqpk2q . sqpk2q ERREUR-DB2-FN. sqpk2q exit section. sqpk2q*>>end-if sqpkd *> *> zone injection debut <* <* sqpkf *> *> zone injection fin <* <* sqpka *--- Abend volontaire -------------------------------------------- sqpka ERREUR-ABEND SECTION. sqpka call "CEE3ABD" using CODE-ABEND sqpka by content X'00000001' sqpkaq . sqpkaq ERREUR-ABEND-FN. sqpkaq exit section. sqq sqq *================================================================= sqq *=== That's all folks ! ========================================== sqq *================================================================= sqq End program S9TL1B.