MBQE000 DFHMSD TYPE=&SYSPARM, C00010000 MODE=INOUT, C00020000 LANG=COBOL, C00030000 CTRL=(FREEKB,FRSET), C00040000 TIOAPFX=YES 00050000 BQE000 DFHMDI SIZE=(24,80), C00060000 LINE=01, C00070000 COLUMN=01 00080000 * LIGNE 1 00090000 DFHMDF POS=(01,01), C00100000 LENGTH=06, C00110000 ATTRB=(ASKIP,NORM), C00120000 INITIAL='BQE000' 00130000 DFHMDF POS=(01,23), C00140000 LENGTH=03, C00150000 ATTRB=(ASKIP,BRT), C00160000 INITIAL='***' 00170000 DFHMDF POS=(01,31), C00180000 LENGTH=19, C00190000 ATTRB=(ASKIP,BRT), C00200000 INITIAL='GESTION DES COMPTES' 00210000 DFHMDF POS=(01,55), C00220000 LENGTH=03, C00230000 ATTRB=(ASKIP,BRT), C00240000 INITIAL='***' 00250000 DTACSYS DFHMDF POS=(01,71), C00260000 LENGTH=06, C00270000 ATTRB=(PROT,ASKIP,NORM) 00280000 * LIGNE 2 00290000 CTRNSYS DFHMDF POS=(02,01), C00300000 LENGTH=04, C00310000 ATTRB=(PROT,ASKIP,NORM) 00320000 CTRMLOG DFHMDF POS=(02,06), C00330000 LENGTH=04, C00340000 ATTRB=(ASKIP,NORM) 00350000 DFHMDF POS=(02,25), C00360000 LENGTH=03, C00370000 ATTRB=(ASKIP,BRT), C00380000 INITIAL='***' 00390000 DFHMDF POS=(02,34), C00400000 LENGTH=14, C00410000 ATTRB=(ASKIP,BRT), C00420000 INITIAL='MENU PRINCIPAL' 00430000 DFHMDF POS=(02,53), C00440000 LENGTH=03, C00450000 ATTRB=(ASKIP,BRT), C00460000 INITIAL='***' 00470000 HTACSYS DFHMDF POS=(02,71), C00480000 LENGTH=08, C00490000 ATTRB=(ASKIP,NORM) 00500000 * LIGNE 3 00510000 DFHMDF POS=(03,01), C00520000 LENGTH=79, C00530000 ATTRB=(ASKIP,NORM), C00540000 INITIAL='-----------------------------------------------C00550000 --------------------------------' 00560000 * LIGNE 4 00570000 DFHMDF POS=(04,01), C00580000 LENGTH=8, C00590000 ATTRB=(ASKIP,NORM), C00600000 INITIAL='FONCTION' 00610000 DFHMDF POS=(04,16), C00620000 LENGTH=9, C00630000 ATTRB=(ASKIP,NORM), C00640000 INITIAL='PROCEDURE' 00650000 DFHMDF POS=(04,59), C00660000 LENGTH=9, C00670000 ATTRB=(ASKIP,NORM), C00680000 INITIAL='ARGUMENTS' 00690000 * LIGNE 5 00700000 DFHMDF POS=(05,01), C00710000 LENGTH=79, C00720000 ATTRB=(ASKIP,NORM), C00730000 INITIAL='-----------------------------------------------C00740000 --------------------------------' 00750000 * LIGNE 6 00760000 DFHMDF POS=(06,45), C00770000 LENGTH=1, C00780000 ATTRB=(ASKIP,NORM), C00790000 INITIAL='!' 00800000 * LIGNE 7 00810000 DFHMDF POS=(07,03), C00820000 LENGTH=2, C00830000 ATTRB=(ASKIP,NORM), C00840000 INITIAL='01' 00850000 DFHMDF POS=(07,09), C00860000 LENGTH=21, C00870000 ATTRB=(ASKIP,NORM), C00880000 INITIAL='OUVERTURE D''UN COMPTE' 00890000 DFHMDF POS=(07,45), C00900000 LENGTH=1, C00910000 ATTRB=(ASKIP,NORM), C00920000 INITIAL='!' 00930000 DFHMDF POS=(07,48), C00940000 LENGTH=15, C00950000 ATTRB=(ASKIP,NORM), C00960000 INITIAL='CODE FONCTION :' 00970000 CFONMEN DFHMDF POS=(07,64), C00980000 LENGTH=2, C00990000 ATTRB=(NUM,UNPROT,FSET,NORM) 01000000 DFHMDF POS=(07,67), C01001000 LENGTH=0, C01002000 ATTRB=(ASKIP), 01003000 * LIGNE 8 01004000 DFHMDF POS=(08,03), C01005000 LENGTH=2, C01006000 ATTRB=(ASKIP,NORM), C01007000 INITIAL='02' 01008000 DFHMDF POS=(08,09), C01009000 LENGTH=25, C01010000 ATTRB=(ASKIP,NORM), C01020000 INITIAL='VISUALISATION D''UN COMPTE' 01030000 DFHMDF POS=(08,45), C01040000 LENGTH=1, C01050000 ATTRB=(ASKIP,NORM), C01060000 INITIAL='!' 01070000 DFHMDF POS=(08,48), C01080000 LENGTH=15, C01090000 ATTRB=(ASKIP,NORM), C01100000 INITIAL='NUMERO COMPTE :' 01110000 CNUMCPT DFHMDF POS=(08,64), C01120000 LENGTH=11, C01130000 ATTRB=(NUM,UNPROT,FSET,NORM) 01140000 CCLERIB DFHMDF POS=(08,76), C01150000 LENGTH=02, C01160000 ATTRB=(NUM,UNPROT,FSET,NORM) 01170000 DFHMDF POS=(08,79), C01180000 LENGTH=0, C01190000 ATTRB=(ASKIP), 01200000 * LIGNE 9 01210000 DFHMDF POS=(09,03), C01220000 LENGTH=2, C01230000 ATTRB=(ASKIP,NORM), C01240000 INITIAL='03' 01250000 DFHMDF POS=(09,09), C01260000 LENGTH=24, C01270000 ATTRB=(ASKIP,NORM), C01280000 INITIAL='MODIFICATION D''UN COMPTE' 01290000 DFHMDF POS=(09,45), C01300000 LENGTH=1, C01310000 ATTRB=(ASKIP,NORM), C01320000 INITIAL='!' 01330000 DFHMDF POS=(09,48), C01340000 LENGTH=15, C01350000 ATTRB=(ASKIP,NORM), C01360000 INITIAL='CODE IDENTITE :' 01370000 CNUMIDE DFHMDF POS=(09,64), C01380000 LENGTH=06, C01390000 ATTRB=(NUM,UNPROT,FSET,NORM) 01400000 DFHMDF POS=(09,71), C01410000 LENGTH=0, C01420000 ATTRB=(ASKIP), 01430000 * LIGNE 10 01440000 DFHMDF POS=(10,45), C01450000 LENGTH=1, C01460000 ATTRB=(ASKIP,NORM), C01470000 INITIAL='!' 01480000 DFHMDF POS=(10,48), C01490000 LENGTH=15, C01500000 ATTRB=(ASKIP,NORM), C01510000 INITIAL='NOM GENERIQUE :' 01520000 LNOMIDE DFHMDF POS=(10,64), C01530000 LENGTH=16, C01540000 ATTRB=(UNPROT,FSET,NORM) 01550000 DFHMDF POS=(11,01), C01551000 LENGTH=0, C01552000 ATTRB=(ASKIP), 01553000 * LIGNE 11 01554000 DFHMDF POS=(11,03), C01555000 LENGTH=2, C01556000 ATTRB=(ASKIP,NORM), C01557000 INITIAL='04' 01558000 DFHMDF POS=(11,09), C01559000 LENGTH=17, C01560000 ATTRB=(ASKIP,NORM), C01570000 INITIAL='LISTE DES COMPTES' 01580000 DFHMDF POS=(11,45), C01590000 LENGTH=1, C01600000 ATTRB=(ASKIP,NORM), C01610000 INITIAL='!' 01620000 * LIGNE 12 01630000 DFHMDF POS=(12,45), C01640000 LENGTH=1, C01650000 ATTRB=(ASKIP,NORM), C01660000 INITIAL='!' 01670000 * LIGNE 13 01680000 DFHMDF POS=(13,03), C01690000 LENGTH=2, C01700000 ATTRB=(ASKIP,NORM), C01710000 INITIAL='05' 01720000 DFHMDF POS=(13,09), C01730000 LENGTH=33, C01740000 ATTRB=(ASKIP,NORM), C01750000 INITIAL='SAISIE DES OPERATIONS D''UN COMPTE' 01760000 DFHMDF POS=(13,45), C01770000 LENGTH=1, C01780000 ATTRB=(ASKIP,NORM), C01790000 INITIAL='!' 01800000 * LIGNE 14 01810000 DFHMDF POS=(14,03), C01820000 LENGTH=2, C01830000 ATTRB=(ASKIP,NORM), C01840000 INITIAL='06' 01850000 DFHMDF POS=(14,09), C01860000 LENGTH=34, C01870000 ATTRB=(ASKIP,NORM), C01880000 INITIAL='MISE A JOUR DES OPERATIONS PERIODE' 01890000 DFHMDF POS=(14,45), C01900000 LENGTH=1, C01910000 ATTRB=(ASKIP,NORM), C01920000 INITIAL='!' 01930000 * LIGNE 15 01940000 DFHMDF POS=(15,45), C01950000 LENGTH=1, C01960000 ATTRB=(ASKIP,NORM), C01970000 INITIAL='!' 01980000 * LIGNE 16 01990000 DFHMDF POS=(16,03), C02000000 LENGTH=2, C02010000 ATTRB=(ASKIP,NORM), C02020000 INITIAL='10' 02030000 DFHMDF POS=(16,09), C02040000 LENGTH=21, C02050000 ATTRB=(ASKIP,NORM), C02060000 INITIAL='SAISIE D''UNE IDENTITE' 02070000 DFHMDF POS=(16,45), C02080000 LENGTH=1, C02090000 ATTRB=(ASKIP,NORM), C02100000 INITIAL='!' 02110000 * LIGNE 17 02120000 DFHMDF POS=(17,03), C02130000 LENGTH=2, C02140000 ATTRB=(ASKIP,NORM), C02150000 INITIAL='11' 02160000 DFHMDF POS=(17,09), C02170000 LENGTH=27, C02180000 ATTRB=(ASKIP,NORM), C02190000 INITIAL='MODIFICATION D''UNE IDENTITE' 02200000 DFHMDF POS=(17,45), C02210000 LENGTH=1, C02220000 ATTRB=(ASKIP,NORM), C02230000 INITIAL='!' 02240000 * LIGNE 18 02250000 DFHMDF POS=(18,45), C02260000 LENGTH=1, C02270000 ATTRB=(ASKIP,NORM), C02280000 INITIAL='!' 02290000 * LIGNE 19 02300000 DFHMDF POS=(19,03), C02310000 LENGTH=2, C02320000 ATTRB=(ASKIP,NORM), C02330000 INITIAL='12' 02340000 DFHMDF POS=(19,09), C02350000 LENGTH=27, C02360000 ATTRB=(ASKIP,NORM), C02370000 INITIAL='LISTE DES IDENTITES' 02380000 DFHMDF POS=(19,45), C02390000 LENGTH=1, C02400000 ATTRB=(ASKIP,NORM), C02410000 INITIAL='!' 02420000 * LIGNE 20 02430000 DFHMDF POS=(20,45), C02440000 LENGTH=1, C02450000 ATTRB=(ASKIP,NORM), C02460000 INITIAL='!' 02470000 * LIGNE 21 02480000 DFHMDF POS=(21,01), C02490000 LENGTH=79, C02500000 ATTRB=(ASKIP,NORM), C02510000 INITIAL='-----------------------------------------------C02520000 --------------------------------' 02530000 * LIGNE 22 02540000 D2201 DFHMDF POS=(22,01), C02550000 LENGTH=03, C02560000 ATTRB=(ASKIP,BRT) 02570000 D2205 DFHMDF POS=(22,05), C02580000 LENGTH=15, C02590000 ATTRB=(ASKIP,BRT) 02600000 D2221 DFHMDF POS=(22,21), C02610000 LENGTH=03, C02620000 ATTRB=(ASKIP,BRT) 02630000 D2225 DFHMDF POS=(22,25), C02640000 LENGTH=15, C02650000 ATTRB=(ASKIP,BRT) 02660000 D2241 DFHMDF POS=(22,41), C02670000 LENGTH=03, C02680000 ATTRB=(ASKIP,BRT) 02690000 D2245 DFHMDF POS=(22,45), C02700000 LENGTH=15, C02710000 ATTRB=(ASKIP,BRT) 02720000 D2261 DFHMDF POS=(22,61), C02730000 LENGTH=03, C02740000 ATTRB=(ASKIP,BRT) 02750000 D2265 DFHMDF POS=(22,65), C02760000 LENGTH=15, C02770000 ATTRB=(ASKIP,BRT) 02780000 * LIGNE 23 02790000 D2301 DFHMDF POS=(23,01), C02800000 LENGTH=03, C02810000 ATTRB=(ASKIP,BRT) 02820000 D2305 DFHMDF POS=(23,05), C02830000 LENGTH=15, C02840000 ATTRB=(ASKIP,BRT) 02850000 D2321 DFHMDF POS=(23,21), C02860000 LENGTH=03, C02870000 ATTRB=(ASKIP,BRT) 02880000 D2325 DFHMDF POS=(23,25), C02890000 LENGTH=15, C02900000 ATTRB=(ASKIP,BRT) 02910000 D2341 DFHMDF POS=(23,41), C02920000 LENGTH=03, C02930000 ATTRB=(ASKIP,BRT) 02940000 D2345 DFHMDF POS=(23,45), C02950000 LENGTH=15, C02960000 ATTRB=(ASKIP,BRT) 02970000 D2361 DFHMDF POS=(23,61), C02980000 LENGTH=03, C02990000 ATTRB=(ASKIP,BRT) 03000000 D2365 DFHMDF POS=(23,65), C03010000 LENGTH=15, C03020000 ATTRB=(ASKIP,BRT) 03030000 * LIGNE 24 03040000 LMESSAG DFHMDF POS=(24,01), C03050000 LENGTH=79, C03060000 ATTRB=(ASKIP,NORM) 03070000 DFHMSD TYPE=FINAL 03080000 END 03090000 *********************************************************************** 03100000 *================================================================*03110000 * *03120000 * transaction menu *03130000 * *03140000 *================================================================*03150000 identification division. 03160000 program-id. pbqeg00. 03170000 *================================================================*03180000 * data division *03190000 *================================================================*03200000 data division. 03210000 * *=================================================*03220000 * * working storage section *03230000 * *=================================================*03240000 * 03250000 working-storage section. 03260000 * 03270000 * *-------------------------------------------------*03280000 * * constantes de la transaction *03290000 * *-------------------------------------------------*03300000 * 03310000 01 constantes-transaction. 03320000 05 code-application pic X(005) value 'BQE'. 03330000 05 code-transaction pic X(004) value 'BG00'. 03340000 05 nom-map pic X(007) value 'BQE000'. 03350000 05 nom-mapset pic X(007) value 'MBQEG00'. 03360000 05 curseur pic S9(004) comp value -1. 03370000 05 nom-programme pic X(008) value 'PBQEG11'. 03380000 * 03390000 * *-------------------------------------------------*03400000 * * zone message pour envoi texte non formate *03410000 * *-------------------------------------------------*03420000 * 03430000 01 texte-message pic x(080) value space. 03440000 * 03450000 * *-------------------------------------------------*03460000 * * zone de communication intra-application *03470000 * *-------------------------------------------------*03480000 * 03490000 copy CPBQEG. 03500000 10 cal-bidon pic X. 03510000 01 zone-commarea-bidon pic X. 03520000 * *-------------------------------------------------*03530000 * * compteurs *03540000 * *-------------------------------------------------*03550000 01 compteurs. 03560000 05 ctr-essai-ecriture pic 9. 03570000 * *-------------------------------------------------*03580000 * * variables diverses *03590000 * *-------------------------------------------------*03600000 01 variables-diverses. 03610000 * *--------------------------------*03620000 * * booleen controle saisie *03630000 * *--------------------------------*03640000 05 pic x(001) value 'K'. 03650000 88 controle-saisie-ok value 'O'. 03660000 88 controle-saisie-ko value 'K'. 03670000 * affichage date et heure systeme 03680000 05 date-decomp pic 99999. 03690000 05 edition-date. 03700000 10 AA pic XX. 03710000 10 FILLER pic X value '.'. 03720000 10 QQQ pic XXX. 03730000 05 heure-decomp pic 999999. 03740000 05 edition-heure. 03750000 10 HH pic XX. 03760000 10 FILLER pic X value ':'. 03770000 10 MM pic XX. 03780000 10 FILLER pic X value ':'. 03790000 10 SS pic XX. 03800000 * *-------------------------------------------------*03810000 * * zone communication sous-programme cics asktime *03820000 * * pour recuperer la date absolue *03830000 * *-------------------------------------------------*03840000 05 asktime-commarea PIC S9(15) COMP-3. 03850000 * Code retour des operations WRITE et READ 03860000 05 CODE-RETOUR PIC S9(08) COMP. 03870000 * *-------------------------------------------------*03880000 * * zone communication sous-programme cobol scadnum *03890000 * * pour controle et cadrage champs numeriques *03900000 * *-------------------------------------------------*03910000 copy ccadnumc. 03920000 * *-------------------------------------------------*03930000 * * zone communication sous-programme cics smesapp *03940000 * * pour gestion centralisee des messages *03950000 * *-------------------------------------------------*03960000 copy cmesapp. 03970000 * 03980000 * *-------------------------------------------------*03990000 * * description de la map symbolique mbqe000 *04000000 * *-------------------------------------------------*04010000 01 zone-map. 04020000 copy MBQEG00 replacing ==01== by ==05== 04030000 ==02== by ==10== 04040000 ==03== by ==15==. 04050000 * 04060000 * *-------------------------------------------------*04070000 * * copy standard cics des touches fonction *04080000 * *-------------------------------------------------*04090000 * 04100000 copy dfhaid. 04110000 * 04120000 * *-------------------------------------------------*04130000 * * copy standard cics des attributs bms *04140000 * *-------------------------------------------------*04150000 * 04160000 copy dfhbmsca. 04170000 * 04180000 * *-------------------------------------------------*04190000 * * description du fichier fcompte *04200000 * * (liste des comptes) *04210000 * *-------------------------------------------------*04220000 copy fcompte. 04230000 * *=================================================*04240000 * * linkage section *04250000 * *=================================================*04260000 * 04270000 linkage section. 04280000 * 04290000 * *-------------------------------------------------*04300000 * * description de la zone de communication cics *04310000 * *-------------------------------------------------*04320000 * 04330000 01 dfhcommarea pic x(500). 04340000 * 04350000 *================================================================*04360000 * procedure division *04370000 *================================================================*04380000 * 04390000 procedure division. 04400000 * 04410000 *----------------------------------------------------------------*04420000 * *04430000 * traitement d'un dialogue de la transaction *04440000 * *04450000 *----------------------------------------------------------------*04460000 traitement-transaction. 04470000 * recuperation de la commarea 04480000 if eibcalen > 0 04490000 move dfhcommarea to zone-commarea 04500000 end-if 04510000 * 04520000 * *-------------------------------------------------*04530000 * * orientation du dialogue selon provenance *04540000 * *-------------------------------------------------*04550000 * 04560000 evaluate true 04570000 * *--------------------------------*04580000 * * provenance directe cics *04590000 * * par code transaction b000 *04600000 * *--------------------------------*04610000 when eibtrnid = 'BG00' and eibcalen = 0 04620000 perform dialogue-initial 04630000 thru dialogue-initial-exit 04640000 * *--------------------------------*04650000 * * suite de la conversation *04660000 * * meme transaction *04670000 * *--------------------------------*04680000 when eibcalen not equal 0 and eibtrnid = 'BG00' 04690000 perform dialogue-en-cours 04700000 thru dialogue-en-cours-exit 04710000 * *--------------------------------*04720000 * * suite de la conversation *04730000 * * transaction differente *04740000 * *--------------------------------*04750000 when eibcalen not equal 0 and eibtrnid = 'BG11' 04760000 perform dialogue-retour-menu 04770000 thru dialogue-retour-menu-exit 04780000 when eibcalen not equal 0 and eibtrnid = 'BG21' 04790000 perform dialogue-retour-menu 04800000 thru dialogue-retour-menu-exit 04810000 when eibcalen not equal 0 and eibtrnid = 'BG41' 04820000 perform dialogue-retour-menu 04830000 thru dialogue-retour-menu-exit 04840000 * *--------------------------------*04850000 * * provenance interdite *04860000 * *--------------------------------*04870000 when other 04880000 perform dialogue-interdit 04890000 thru dialogue-interdit-exit 04900000 end-evaluate 04910000 . 04920000 traitement-transaction-exit. goback. 04930000 *----------------------------------------------------------------*04940000 * *04950000 * initialisation du dialogue *04960000 * *04970000 *----------------------------------------------------------------*04980000 dialogue-initial. 04990000 * initialisation de la cal 05000000 initialize zone-commarea-locale 05010000 * *--------------------------------*05020000 * * mise au point de la date *05030000 * *--------------------------------*05040000 exec cics ASKTIME ABSTIME (asktime-commarea) 05050000 end-exec 05060000 exec cics FORMATTIME ABSTIME (asktime-commarea) 05070000 YYYYMMDD (cag-time) 05080000 end-exec 05090000 * *--------------------------------*05100000 * * preparation map *05110000 * *--------------------------------*05120000 move low-value to zone-map 05130000 * *--------------------------------*05140000 * * preparation entete map *05150000 * *--------------------------------*05160000 perform entete-map 05170000 * *--------------------------------*05180000 * * preparation touches fonction *05190000 * *--------------------------------*05200000 perform touches-fonction 05210000 * *--------------------------------*05220000 * message : 001I * initialisation message *05230000 * *--------------------------------*05240000 move space to smesapp-commarea 05250000 move '001I' to smesapp-cmesapp 05260000 perform recherche-message 05270000 * *--------------------------------*05280000 * * mise en place curseur *05290000 * *--------------------------------*05300000 move curseur to cfonmenl 05310000 * *--------------------------------*05320000 * * envoi map physique et logique *05330000 * *--------------------------------*05340000 perform emission-map-complete 05350000 * *--------------------------------*05360000 * * liberation partielle *05370000 * *--------------------------------*05380000 perform liberation-partielle 05390000 . 05400000 dialogue-initial-exit. exit. 05410000 *----------------------------------------------------------------*05420000 * *05430000 * conversation en cours de la transaction *05440000 * *05450000 *----------------------------------------------------------------*05460000 dialogue-en-cours. 05470000 * *--------------------------------*05480000 * * reception map *05490000 * *--------------------------------*05500000 perform reception-map 05510000 * *--------------------------------*05520000 * * preparation attributs initiaux *05530000 * *--------------------------------*05540000 perform initialisation-attributs 05550000 * 05560000 * *-------------------------------------------------*05570000 * * orientation de l'operation selon touche activee *05580000 * *-------------------------------------------------*05590000 * 05600000 evaluate EIBAID 05610000 * *--------------------------------*05620000 * * touche enter : controle *05630000 * *--------------------------------*05640000 when DFHENTER 05650000 perform operation-controle 05660000 thru operation-controle-exit 05670000 * *--------------------------------*05680000 * * touche f2 : effacement *05690000 * *--------------------------------*05700000 when DFHPF2 05710000 perform operation-effacement 05720000 thru operation-effacement-exit 05730000 * *--------------------------------*05740000 * * touche clear : deconnexion *05750000 * *--------------------------------*05760000 when DFHCLEAR 05770000 perform operation-deconnexion 05780000 thru operation-deconnexion-exit 05790000 * *--------------------------------*05800000 * * touche non fonctionnelle *05810000 * *--------------------------------*05820000 when other 05830000 perform operation-imprevue 05840000 thru operation-imprevue-exit 05850000 end-evaluate 05860000 * *--------------------------------*05870000 * * preparation entete map *05880000 * *--------------------------------*05890000 perform entete-map 05900000 * *--------------------------------*05910000 * * envoi map logique *05920000 * *--------------------------------*05930000 perform emission-map-logique 05940000 * *--------------------------------*05950000 * * liberation partielle *05960000 * *--------------------------------*05970000 perform liberation-partielle 05980000 . 05990000 dialogue-en-cours-exit. exit. 06000000 *----------------------------------------------------------------*06010000 * *06020000 * conversation venant d'une autre transanction *06030000 * *06040000 *----------------------------------------------------------------*06050000 dialogue-retour-menu. 06060000 * *--------------------------------*06070000 * * preparation map *06080000 * *--------------------------------*06090000 move low-value to zone-map 06100000 * *--------------------------------*06110000 * * preparation entete map *06120000 * *--------------------------------*06130000 perform entete-map 06140000 * *--------------------------------*06150000 * * preparation touches fonction *06160000 * *--------------------------------*06170000 perform touches-fonction 06180000 * *--------------------------------*06190000 * message : 004I * initialisation message *06200000 * *--------------------------------*06210000 move space to smesapp-commarea 06220000 move '004I' to smesapp-cmesapp 06230000 move cag-cfonmen to smesapp-cparam1 06240000 perform recherche-message 06250000 * *--------------------------------*06260000 * * mise en place curseur *06270000 * *--------------------------------*06280000 move curseur to cfonmenl 06290000 move cag-cnumcpt to cnumcpto 06300000 move cag-cclerib to ccleribo 06310000 move cag-cnumide to cnumideo 06320000 move cag-lnomide to lnomideo 06330000 * *--------------------------------*06340000 * * envoi map physique et logique *06350000 * *--------------------------------*06360000 perform emission-map-complete 06370000 * *--------------------------------*06380000 * * liberation partielle *06390000 * *--------------------------------*06400000 perform liberation-partielle 06410000 . 06420000 dialogue-retour-menu-exit. exit. 06430000 *----------------------------------------------------------------*06440000 * *06450000 * erreur de gestion de provenance *06460000 * *06470000 *----------------------------------------------------------------*06480000 dialogue-interdit. 06490000 * *--------------------------------*06500000 * message : 098E * initialisation texte message *06510000 * *--------------------------------*06520000 move space to smesapp-commarea 06530000 move '098E' to smesapp-cmesapp 06540000 perform recherche-message 06550000 move lmessago to texte-message 06560000 * *--------------------------------*06570000 * * envoi message non formate *06580000 * *--------------------------------*06590000 perform emission-message 06600000 * *--------------------------------*06610000 * * liberation totale *06620000 * *--------------------------------*06630000 perform liberation-totale 06640000 . 06650000 dialogue-interdit-exit. exit. 06660000 *----------------------------------------------------------------*06670000 * *06680000 * controles de la saisie de l'ecran *06690000 * *06700000 *----------------------------------------------------------------*06710000 operation-controle. 06720000 * *--------------------------------*06730000 * * controle saisie des champs *06740000 * *--------------------------------*06750000 perform controle-saisie-champs 06760000 thru controle-saisie-champs-exit 06770000 * *--------------------------------*06780000 * * controle saisie ok : *06790000 * * - appel de la fonction *06800000 * *--------------------------------*06810000 if controle-saisie-ok 06820000 perform appel-fonction-demandee 06830000 thru appel-fonction-demandee-exit 06840000 end-if 06850000 . 06860000 operation-controle-exit. exit. 06870000 *----------------------------------------------------------------*06880000 * *06890000 * effacement de la saisie *06900000 * *06910000 *----------------------------------------------------------------*06920000 operation-effacement. 06930000 * *--------------------------------*06940000 * * effacement des champs *06950000 * *--------------------------------*06960000 move space to cfonmeno 06970000 move space to cnumcpto 06980000 move space to ccleribo 06990000 move space to cnumideo 07000000 move space to lnomideo 07010000 * *--------------------------------*07020000 * * mise en place curseur *07030000 * *--------------------------------*07040000 move curseur to cfonmenl 07050000 * *--------------------------------*07060000 * * initialisation message *07070000 * *--------------------------------*07080000 move space to smesapp-commarea 07090000 move '001I' to smesapp-cmesapp 07100000 perform recherche-message 07110000 . 07120000 operation-effacement-exit. exit. 07130000 *----------------------------------------------------------------*07140000 * demande de deconnexion de l'application *07150000 *----------------------------------------------------------------*07160000 operation-deconnexion. 07170000 * *--------------------------------*07180000 * message : 097E * initialisation message *07190000 * *--------------------------------*07200000 move space to smesapp-commarea 07210000 move '097E' to smesapp-cmesapp 07220000 move code-application to smesapp-cparam1 07230000 perform recherche-message 07240000 move lmessago to texte-message 07250000 * *--------------------------------*07260000 * * envoi message non formate *07270000 * *--------------------------------*07280000 perform emission-message 07290000 * *--------------------------------*07300000 * * liberation totale *07310000 * *--------------------------------*07320000 perform liberation-totale 07330000 . 07340000 operation-deconnexion-exit. exit. 07350000 *----------------------------------------------------------------*07360000 * numero de compte mauvais *07370000 *----------------------------------------------------------------*07380000 erreur-numero-compte. 07390000 * *--------------------------------*07400000 * message : 041E * initialisation message *07410000 * *--------------------------------*07420000 move space to smesapp-commarea 07430000 if cfonmeni = 01 07440000 move '041E' to smesapp-cmesapp 07450000 else 07460000 move '042E' to smesapp-cmesapp 07470000 end-if 07480000 move cnumcpti to smesapp-cparam1 07490000 perform recherche-message 07500000 move lmessago to texte-message 07510000 * on positionne le curseur sur numcpt 07520000 move curseur to cnumcptl 07530000 * *--------------------------------*07540000 * * preparation entete map *07550000 * *--------------------------------*07560000 perform entete-map 07570000 * *--------------------------------*07580000 * * envoi map logique *07590000 * *--------------------------------*07600000 perform emission-map-logique 07610000 * *--------------------------------*07620000 * * liberation partielle *07630000 * *--------------------------------*07640000 perform liberation-partielle 07650000 . 07660000 erreur-numero-compte-exit. exit. 07670000 *----------------------------------------------------------------*07680000 * *07690000 * touche fonction inactive *07700000 * *07710000 *----------------------------------------------------------------*07720000 operation-imprevue. 07730000 * *--------------------------------*07740000 * message : 099E * initialisation message *07750000 * *--------------------------------*07760000 move space to smesapp-commarea 07770000 move curseur to cfonmenl 07780000 move '099E' to smesapp-cmesapp 07790000 perform recherche-message 07800000 . 07810000 operation-imprevue-exit. exit. 07820000 *----------------------------------------------------------------*07830000 * appel de la fonction demandee par l'utilisateur *07840000 *----------------------------------------------------------------*07850000 appel-fonction-demandee. 07860000 evaluate cfonmeni 07870000 when 01 07880000 perform fonction-01 07890000 when 02 07900000 perform fonction-02 07910000 when 04 07920000 perform fonction-04 07930000 when other 07940000 move 'DEFAULT' to nom-programme 07950000 * *--------------------------------*07960000 * * a completer *07970000 * *--------------------------------*07980000 continue 07990000 end-evaluate 08000000 move 0 to cag-ecran 08010000 exec cics xctl program(nom-programme) 08020000 commarea(zone-commarea) 08030000 length(length of 08040000 zone-commarea) 08050000 end-exec 08060000 . 08070000 appel-fonction-demandee-exit. exit. 08080000 **** 08090000 ** Fonction 01 : creation d'un compte 08100000 **** 08110000 fonction-01. 08120000 * Validation du numero de compte 08130000 move space to fcompte 08140000 if cnumcpti <= space 08150000 * Generer un numero de compte 08160000 move high-value to ccptpri 08170000 perform 630-start-fcompte 08180000 perform 620-lecture-fcompte-prev 08190000 perform 640-endbr-fcompte 08200000 add 1 to cnumcpt 08210000 * Reservation du numero de compte 08220000 perform initialisation-compte 08230000 move zero to ctr-essai-ecriture 08240000 perform 600-ecriture-fcompte 08250000 with test after 08260000 until ctr-essai-ecriture > 3 08270000 or code-retour = DFHRESP(NORMAL) 08280000 if code-retour = dfhresp(duprec) 08290000 perform erreur-numero-compte 08300000 end-if 08310000 else 08320000 * Valider le numero de compte saisi 08330000 move cnumcpti to cnumcpt 08340000 perform 610-lecture-fcompte 08350000 if code-retour = dfhresp(normal) 08360000 perform erreur-numero-compte 08370000 end-if 08380000 * Reservation du numero de compte 08390000 perform initialisation-compte 08400000 perform 600-ecriture-fcompte 08410000 if code-retour = dfhresp(duprec) 08420000 perform erreur-numero-compte 08430000 end-if 08440000 end-if 08450000 * Remplissage de la commarea globale 08460000 move cfonmeni to cag-cfonmen 08470000 move cnumcpt to cag-cnumcpt 08480000 move ccleribi to cag-cclerib 08490000 move cnumidei to cag-cnumide 08500000 move 'Benoit' to cag-lnomide 08510000 * Preparation de l'execution du prochain ecran 08520000 move 'PBQEG11 ' to nom-programme 08530000 . 08540000 **** 08550000 ** Fonction 02 : visualisation d'un compte 08560000 **** 08570000 fonction-02. 08580000 * Validation du numero de compte 08590000 initialize fcompte 08600000 move cnumcpti to cnumcpt 08610000 perform 610-lecture-fcompte 08620000 if code-retour = dfhresp(notfnd) 08630000 perform erreur-numero-compte 08640000 end-if 08650000 * Remplissage de la commarea globale 08660000 move cfonmeni to cag-cfonmen 08670000 move cnumcpt to cag-cnumcpt 08680000 move ccleribi to cag-cclerib 08690000 move cnumidei to cag-cnumide 08700000 move 'Benoit' to cag-lnomide 08710000 * Preparation de l'execution du prochain ecran 08720000 move 'PBQEG21 ' to nom-programme 08730000 . 08740000 **** 08750000 ** Fonction 04 : liste des comptes 08760000 **** 08770000 fonction-04. 08780000 * Remplissage de la commarea globale 08790000 move cfonmeni to cag-cfonmen 08800000 move cnumcpti to cag-cnumcpt 08810000 move ccleribi to cag-cclerib 08820000 move cnumidei to cag-cnumide 08830000 move 'Benoit' to cag-lnomide 08840000 * Preparation de l'execution du prochain ecran 08850000 move 'PBQEG41 ' to nom-programme 08860000 . 08870000 *================================================================*08880000 * controle de la saisie de l'ecran mbqe000 *08890000 * *08900000 * donnees en entree : champs input de l'ecran *08910000 * donnees en sortie : champs output de l'ecran *08920000 * booleen controle saisie : ok ou ko *08930000 * libelle message *08940000 *================================================================*08950000 controle-saisie-champs. 08960000 * *--------------------------------*08970000 * * initialisations : *08980000 * * - effacement du message *08990000 * * - zone de communication *09000000 * * module smesapp (message) *09010000 * *--------------------------------*09020000 move space to lmessago 09030000 move space to smesapp-commarea 09040000 * 09050000 * *-------------------------------------------------*09060000 * * controles du champ cfonmen *09070000 * *-------------------------------------------------*09080000 * *--------------------------------*09090000 * message : 001e * - presence obligatoire *09100000 * *--------------------------------*09110000 if cfonmeni <= space 09120000 move curseur to cfonmenl 09130000 move dfhunimd to cfonmena 09140000 move '001E' to smesapp-cmesapp 09150000 go to controle-saisie-champs-stop 09160000 end-if 09170000 * *--------------------------------*09180000 * message : scadnum * - numericite *09190000 * *--------------------------------*09200000 move space to scadnumc-commarea 09210000 move '99' to scadnumc-cforext 09220000 move cfonmeni to scadnumc-ldonext 09230000 perform cadrage-numerique 09240000 if scadnumc-cmesapp = zero 09250000 move scadnumc-ldoncad to cfonmeno 09260000 else 09270000 move curseur to cfonmenl 09280000 move dfhunimd to cfonmena 09290000 go to controle-saisie-champs-stop 09300000 end-if 09310000 * *--------------------------------*09320000 * message : 030E * - autorisation *09330000 * *--------------------------------*09340000 if cfonmeni = '01' or '02' or '03' or 09350000 '04' or '05' or '06' or 09360000 '10' or '11' or '12' 09370000 continue 09380000 else 09390000 move curseur to cfonmenl 09400000 move dfhunimd to cfonmena 09410000 move '030E' to smesapp-cmesapp 09420000 move cfonmeni to smesapp-cparam1 09430000 go to controle-saisie-champs-stop 09440000 end-if 09450000 * 09460000 * *-------------------------------------------------*09470000 * * controles du champ cnumcpt *09480000 * *-------------------------------------------------*09490000 * *--------------------------------*09500000 * message : 002e * - presence obligatoire si code *09510000 * * fonction = 02,03,04 ou 05 *09520000 * *--------------------------------*09530000 if cfonmeni = '02' 09540000 or cfonmeni = '03' 09550000 or cfonmeni = '04' 09560000 or cfonmeni = '05' then 09570000 if cnumcpti <= space then 09580000 move curseur to cnumcptl 09590000 move dfhunimd to cnumcpta 09600000 move '002E' to smesapp-cmesapp 09610000 go to controle-saisie-champs-stop 09620000 end-if 09630000 * *--------------------------------*09640000 * message : scadnum * - numericite *09650000 * *--------------------------------*09660000 move space to scadnumc-commarea 09670000 move '99999999999' to scadnumc-cforext 09680000 move cnumcpti to scadnumc-ldonext 09690000 perform cadrage-numerique 09700000 if scadnumc-cmesapp = zero 09710000 move scadnumc-ldoncad to cnumcpto 09720000 else 09730000 move curseur to cnumcptl 09740000 move dfhunimd to cnumcpta 09750000 go to controle-saisie-champs-stop 09760000 end-if 09770000 end-if 09780000 . 09790000 * 09800000 * *-------------------------------------------------*09810000 * * controles du champ cclerib *09820000 * *-------------------------------------------------*09830000 * *--------------------------------*09840000 * message : 003e * - presence obligatoire si *09850000 * * cnumcpt est saisi *09860000 * *--------------------------------*09870000 if cnumcpti > space then 09880000 if ccleribi <= space 09890000 move curseur to ccleribl 09900000 move dfhunimd to ccleriba 09910000 move '003E' to smesapp-cmesapp 09920000 go to controle-saisie-champs-stop 09930000 end-if 09940000 * *--------------------------------*09950000 * message : scadnum * - numericite *09960000 * *--------------------------------*09970000 move space to scadnumc-commarea 09980000 move '99' to scadnumc-cforext 09990000 move ccleribi to scadnumc-ldonext 10000000 perform cadrage-numerique 10010000 if scadnumc-cmesapp = zero 10020000 move scadnumc-ldoncad to ccleribo 10030000 else 10040000 move curseur to ccleribl 10050000 move dfhunimd to ccleriba 10060000 go to controle-saisie-champs-stop 10070000 end-if 10080000 end-if 10090000 . 10100000 * 10110000 * *-------------------------------------------------*10120000 * * controles du champ cnumide *10130000 * *-------------------------------------------------*10140000 * *--------------------------------*10150000 * message : 004e * - presence obligatoire si code *10160000 * * fonction = 11 *10170000 * *--------------------------------*10180000 if cfonmeni = 11 then 10190000 if cnumidei <= space 10200000 move curseur to cnumidel 10210000 move dfhunimd to cnumidea 10220000 move '004E' to smesapp-cmesapp 10230000 go to controle-saisie-champs-stop 10240000 end-if 10250000 * *--------------------------------*10260000 * message : scadnum * - numericite *10270000 * *--------------------------------*10280000 move space to scadnumc-commarea 10290000 move '999999' to scadnumc-cforext 10300000 move cnumidei to scadnumc-ldonext 10310000 perform cadrage-numerique 10320000 if scadnumc-cmesapp = zero 10330000 move scadnumc-ldoncad to cnumideo 10340000 else 10350000 move curseur to cnumidel 10360000 move dfhunimd to cnumidea 10370000 go to controle-saisie-champs-stop 10380000 end-if 10390000 end-if 10400000 . 10410000 * *-------------------------------------------------*10420000 * * arret des controles de saisie *10430000 * *-------------------------------------------------*10440000 * 10450000 controle-saisie-champs-stop. 10460000 * *--------------------------------*10470000 * * controle saisie ok *10480000 * *--------------------------------*10490000 if smesapp-cmesapp = space 10500000 set controle-saisie-ok to true 10510000 * *--------------------------------*10520000 * * saisie invalide *10530000 * *--------------------------------*10540000 else 10550000 set controle-saisie-ko to true 10560000 perform recherche-message 10570000 end-if 10580000 . 10590000 controle-saisie-champs-exit. exit. 10600000 * 10610000 *================================================================*10620000 * *10630000 * modules generalises *10640000 * *10650000 *================================================================*10660000 * 10670000 *----------------------------------------------------------------*10680000 * *10690000 * preparation des champs de l'entete ecran *10700000 * *10710000 *----------------------------------------------------------------*10720000 entete-map. 10730000 * *--------------------------------*10740000 * * champs affiches en permanence *10750000 * * - code transaction systeme *10760000 * * - code terminal logique *10770000 * * - date tache aa.qqq *10780000 * * - heure tache hh:mm:ss *10790000 * *--------------------------------*10800000 move eibtrnid to ctrnsyso 10810000 * 10820000 move eibtrmid to ctrmlogo 10830000 * 10840000 move eibdate to date-decomp 10850000 move date-decomp(1:2) to edition-date(1:2) 10860000 move date-decomp(3:3) to edition-date(4:3) 10870000 move edition-date to dtacsyso 10880000 * 10890000 move eibtime to heure-decomp 10900000 move heure-decomp(1:2) to edition-heure(1:2) 10910000 move heure-decomp(3:2) to edition-heure(4:2) 10920000 move heure-decomp(5:2) to edition-heure(7:2) 10930000 move edition-heure to htacsyso 10940000 * 10950000 . 10960000 entete-map-exit. exit. 10970000 *----------------------------------------------------------------*10980000 * *10990000 * preparation des touches fonction actives *11000000 * *11010000 *----------------------------------------------------------------*11020000 touches-fonction. 11030000 * *--------------------------------*11040000 * * code et libelle touche *11050000 * *--------------------------------*11060000 move 'Ent' to d2201o 11070000 move 'Contr“le saisie' to d2205o 11080000 * 11090000 move 'F2 ' to d2221o 11100000 move 'Efface saisie ' to d2225o 11110000 * 11120000 move 'Clr' to d2241o 11130000 move 'D‚connexion ' to d2245o 11140000 . 11150000 touches-fonction-exit. exit. 11160000 *----------------------------------------------------------------*11170000 * *11180000 * preparation des attributs initiaux *11190000 * *11200000 *----------------------------------------------------------------*11210000 initialisation-attributs. 11220000 * *--------------------------------*11230000 * * attributs fset *11240000 * *--------------------------------*11250000 move dfhbmfse to cfonmena 11260000 move dfhunnum to cnumcpta 11270000 move dfhunnum to ccleriba 11280000 move dfhunnum to cnumidea 11290000 move dfhbmfse to lnomidea 11300000 . 11310000 initialisation-attributs-exit. exit. 11320000 *----------------------------------------------------------------*11330000 * *11340000 * recherche d'un message ecran sur fmesapp *11350000 * *11360000 *----------------------------------------------------------------*11370000 recherche-message. 11380000 * *--------------------------------*11390000 * * recherche et habillage message *11400000 * *--------------------------------*11410000 if smesapp-cappinf = space 11420000 move code-application to smesapp-cappinf 11430000 end-if 11440000 * 11450000 exec cics link program ('SMESAPP') 11460000 commarea (smesapp-commarea) 11470000 length (length of 11480000 smesapp-commarea) 11490000 end-exec 11500000 * *--------------------------------*11510000 * * affichage du message. *11520000 * *--------------------------------*11530000 move smesapp-lmessag to lmessago 11540000 . 11550000 recherche-message-exit. exit. 11560000 *----------------------------------------------------------------*11570000 * *11580000 * controle et cadrage d'une zone numerique *11590000 * *11600000 *----------------------------------------------------------------*11610000 cadrage-numerique. 11620000 * *--------------------------------*11630000 * * cadrage de la zone numerique *11640000 * *--------------------------------*11650000 call 'SCADNUM' using scadnumc-commarea 11660000 * *--------------------------------*11670000 * * message d'erreur *11680000 * *--------------------------------*11690000 if scadnumc-cmesapp not = zero 11700000 move 'GEN' to smesapp-cappinf 11710000 move scadnumc-cmesapp to smesapp-cmesapp 11720000 move scadnumc-cparam1 to smesapp-cparam1 11730000 end-if 11740000 . 11750000 cadrage-numerique-exit. exit. 11760000 * 11770000 *================================================================*11780000 * *11790000 * modules de gestion cics *11800000 * *11810000 *================================================================*11820000 * 11830000 *----------------------------------------------------------------*11840000 * *11850000 * emission de la map physique + logique *11860000 * *11870000 *----------------------------------------------------------------*11880000 emission-map-complete. 11890000 * *--------------------------------*11900000 * * emission map physique + logique*11910000 * *--------------------------------*11920000 exec cics send map (nom-map) 11930000 mapset (nom-mapset) 11940000 from (zone-map) 11950000 erase 11960000 cursor 11970000 end-exec 11980000 . 11990000 emission-map-complete-exit. exit. 12000000 *----------------------------------------------------------------*12010000 * *12020000 * emission de la map logique uniquement *12030000 * *12040000 *----------------------------------------------------------------*12050000 emission-map-logique. 12060000 * *--------------------------------*12070000 * * emission map logique *12080000 * *--------------------------------*12090000 exec cics send map (nom-map) 12100000 mapset (nom-mapset) 12110000 from (zone-map) 12120000 dataonly 12130000 cursor 12140000 end-exec 12150000 . 12160000 emission-map-logique-exit. exit. 12170000 *----------------------------------------------------------------*12180000 * *12190000 * reception de la map logique *12200000 * *12210000 *----------------------------------------------------------------*12220000 reception-map. 12230000 * *--------------------------------*12240000 * * reception saisie utilisateur *12250000 * *--------------------------------*12260000 move low-value to zone-map 12270000 * 12280000 exec cics receive map (nom-map) 12290000 mapset (nom-mapset) 12300000 into (zone-map) 12310000 nohandle 12320000 end-exec 12330000 . 12340000 reception-map-exit. exit. 12350000 *----------------------------------------------------------------*12360000 * *12370000 * emission d'un message non formate *12380000 * *12390000 *----------------------------------------------------------------*12400000 emission-message. 12410000 * *--------------------------------*12420000 * * emission selon controle *12430000 * *--------------------------------*12440000 exec cics send from (texte-message) 12450000 length (length of 12460000 texte-message) 12470000 erase 12480000 end-exec 12490000 . 12500000 emission-message-exit. exit. 12510000 *----------------------------------------------------------------*12520000 * *12530000 * liberation totale de la partition *12540000 * *12550000 *----------------------------------------------------------------*12560000 liberation-totale. 12570000 * *--------------------------------*12580000 * * retour definitif cics *12590000 * *--------------------------------*12600000 exec cics return 12610000 end-exec 12620000 . 12630000 liberation-totale-exit. exit. 12640000 *----------------------------------------------------------------*12650000 * liberation partielle de la partition *12660000 *----------------------------------------------------------------*12670000 liberation-partielle. 12680000 * *--------------------------------*12690000 * * retour temporaire cics *12700000 * *--------------------------------*12710000 exec cics return transid (code-transaction) 12720000 commarea (zone-commarea) 12730000 length (length of 12740000 zone-commarea) 12750000 end-exec 12760000 . 12770000 liberation-partielle-exit. exit. 12780000 *----------------------------------------------------------------*12790000 * initialisation compte *12800000 *----------------------------------------------------------------*12810000 initialisation-compte. 12820000 move 12 to cclerib 12830000 move zero to ctypcpt 12840000 move zero to lintcpt 12850000 move zero to cforint 12860000 move zero to cnumide 12870000 move zero to cperrel 12880000 move zero to mmoydom 12890000 move zero to cforchq 12900000 move zero to crenaut 12910000 move zero to cremchq 12920000 move zero to cdecaut 12930000 move zero to mdecaut 12940000 move zero to pdecaut 12950000 move zero to cstacpt 12960000 move 'Benoit' to cgescpt 12970000 move zero to douvcpt 12980000 . 12990000 initialisation-compte-exit. exit. 13000000 **** 13010000 ** ECRITURE FCOMPTE 13020000 **** 13030000 600-ECRITURE-FCOMPTE. 13040000 ADD 1 to CTR-ESSAI-ECRITURE 13050000 EXEC CICS WRITE FILE(FCOMPTE-FILE) 13060000 FROM(FCOMPTE) 13070000 RIDFLD(CNUMCPT) 13080000 RESP(CODE-RETOUR) 13090000 END-EXEC 13100000 EVALUATE CODE-RETOUR 13110000 WHEN DFHRESP(NORMAL) 13120000 CONTINUE 13130000 WHEN DFHRESP(DUPREC) 13140000 CONTINUE 13150000 WHEN OTHER 13160000 PERFORM 700-ABANDON-TRANSACTION 13170000 END-EVALUATE 13180000 . 13190000 **** 13200000 ** LECTURE FCOMPTE 13210000 **** 13220000 610-LECTURE-FCOMPTE. 13230000 EXEC CICS READ FILE(FCOMPTE-FILE) 13240000 INTO(FCOMPTE) 13250000 RIDFLD(CNUMCPT) 13260000 RESP(CODE-RETOUR) 13270000 END-EXEC 13280000 EVALUATE CODE-RETOUR 13290000 WHEN DFHRESP(NORMAL) 13300000 CONTINUE 13310000 WHEN DFHRESP(NOTFND) 13320000 CONTINUE 13330000 WHEN OTHER 13340000 PERFORM 700-ABANDON-TRANSACTION 13350000 END-EVALUATE 13360000 . 13370000 **** 13380000 ** LECTURE FCOMPTE PREV 13390000 **** 13400000 620-LECTURE-FCOMPTE-PREV. 13410000 EXEC CICS READPREV FILE(FCOMPTE-FILE) 13420000 INTO(FCOMPTE) 13430000 RIDFLD(CNUMCPT) 13440000 RESP(CODE-RETOUR) 13450000 END-EXEC 13460000 EVALUATE CODE-RETOUR 13470000 WHEN DFHRESP(NORMAL) 13480000 CONTINUE 13490000 WHEN DFHRESP(ENDFILE) 13500000 MOVE 0 TO CNUMCPT 13510000 WHEN OTHER 13520000 PERFORM 700-ABANDON-TRANSACTION 13530000 END-EVALUATE 13540000 . 13550000 **** 13560000 ** START FCOMPTE 13570000 **** 13580000 630-START-FCOMPTE. 13590000 EXEC CICS STARTBR FILE(FCOMPTE-FILE) 13600000 RIDFLD(CNUMCPT) 13610000 RESP(CODE-RETOUR) 13620000 END-EXEC 13630000 EVALUATE CODE-RETOUR 13640000 WHEN DFHRESP(NORMAL) 13650000 CONTINUE 13660000 WHEN OTHER 13670000 PERFORM 700-ABANDON-TRANSACTION 13680000 END-EVALUATE 13690000 . 13700000 **** 13710000 ** end browse fcompte 13720000 **** 13730000 640-ENDBR-FCOMPTE. 13740000 EXEC CICS ENDBR FILE(FCOMPTE-FILE) 13750000 RESP(CODE-RETOUR) 13760000 END-EXEC 13770000 EVALUATE CODE-RETOUR 13780000 WHEN DFHRESP(NORMAL) 13790000 CONTINUE 13800000 WHEN OTHER 13810000 PERFORM 700-ABANDON-TRANSACTION 13820000 END-EVALUATE 13830000 . 13840000 **** 13850000 ** ABANDON TRANSACTION 13860000 **** 13870000 700-ABANDON-TRANSACTION. 13880000 * *--------------------------------*13890000 * message : 097E * initialisation message *13900000 * *--------------------------------*13910000 move space to smesapp-commarea 13920000 move '097E' to smesapp-cmesapp 13930000 move code-application to smesapp-cparam1 13940000 perform recherche-message 13950000 move lmessago to texte-message 13960000 * *--------------------------------*13970000 * * envoi message non formate *13980000 * *--------------------------------*13990000 perform emission-message 14000000 * *--------------------------------*14010000 * * liberation totale *14020000 * *--------------------------------*14030000 perform liberation-totale 14040000 . 14050000 *================================================================*14060000 * *14070000 * transaction menu *14080000 * *14090000 *================================================================*14100000 * 14110000 identification division. 14120000 program-id. pbqeg11. 14130000 * 14140000 *================================================================*14150000 * data division *14160000 *================================================================*14170000 * 14180000 data division. 14190000 * 14200000 * *=================================================*14210000 * * working storage section *14220000 * *=================================================*14230000 * 14240000 working-storage section. 14250000 * 14260000 * *-------------------------------------------------*14270000 * * constantes de la transaction *14280000 * *-------------------------------------------------*14290000 * 14300000 01 constantes-transaction. 14310000 05 code-application pic x(005) value 'BQE'. 14320000 05 code-transaction pic x(004) value 'BG11'. 14330000 05 code-menu pic x(004) value 'BG00'. 14340000 05 nom-map pic x(007) value 'BQE011'. 14350000 05 nom-mapset pic x(007) value 'MBQE011'. 14360000 05 curseur pic S9(004) comp value -1. 14370000 05 nom-programme pic X(008) value 'PBQEG00'. 14380000 * 14390000 * *-------------------------------------------------*14400000 * * zone message pour envoi texte non formate *14410000 * *-------------------------------------------------*14420000 * 14430000 01 texte-message pic X(080) value space. 14440000 * 14450000 * *-------------------------------------------------*14460000 * * zone de communication intra-application *14470000 * *-------------------------------------------------*14480000 * 14490000 copy cpbqeg. 14500000 10 cal-bidon pic X. 14510000 10 pic X(001). 14520000 88 cal-validation-ok value 'O'. 14530000 88 cal-validation-ko value 'K'. 14540000 10 cal-ctypcpt pic X. 14550000 10 cal-cforint pic X. 14560000 10 cal-lintcpt pic X(32). 14570000 10 cal-cnumide pic 9(06). 14580000 10 cal-cperrel pic X. 14590000 10 cal-mmoydom pic x(10). 14600000 10 cal-mmoydom-comp pic S9(7)V9(2) COMP-3. 14610000 10 cal-cforchq pic X(01). 14620000 10 cal-crenaut pic X(01). 14630000 10 cal-cremchq pic X(01). 14640000 10 cal-cdecaut pic X(01). 14650000 10 cal-mdecaut pic X(10). 14660000 10 cal-mdecaut-comp pic S9(7)V9(2) COMP-3. 14670000 10 cal-pdecaut pic X(4). 14680000 10 cal-pdecaut-comp pic S9(3)V9(2) COMP-3. 14690000 01 zone-commarea-bidon pic X. 14700000 * 14710000 * *-------------------------------------------------*14720000 * * variables diverses *14730000 * *-------------------------------------------------*14740000 * 14750000 01 variables-diverses. 14760000 * Code retour des operations WRITE et READ 14770000 05 CODE-RETOUR PIC S9(08) COMP. 14780000 * pour la conversion de x en comp-3 14790000 05 mmoydom-comp pic s9(7)v9(2) comp-3. 14800000 05 mdecaut-comp pic s9(7)v9(2) comp-3. 14810000 05 pdecaut-comp pic s9(3)v9(2) comp-3. 14820000 * 14830000 * *--------------------------------*14840000 * * booleen controle saisie *14850000 * *--------------------------------*14860000 * 14870000 05 pic x(001) value 'K'. 14880000 88 controle-saisie-ok value 'O'. 14890000 88 controle-saisie-ko value 'K'. 14900000 05 date-decomp pic 99999. 14910000 05 edition-date. 14920000 10 AA pic XX. 14930000 10 FILLER pic X value '.'. 14940000 10 QQQ pic XXX. 14950000 05 heure-decomp pic 999999. 14960000 05 edition-heure. 14970000 10 HH pic XX. 14980000 10 FILLER pic X value ':'. 14990000 10 MM pic XX. 15000000 10 FILLER pic X value ':'. 15010000 10 SS pic XX. 15020000 05 time9 pic 9(08). 15030000 05 tempsettaux. 15040000 10 taux pic 9(04). 15050000 10 temps pic 9(08). 15060000 * 15070000 * *-------------------------------------------------*15080000 * * zone communication sous-programme cobol scadnum *15090000 * * pour controle et cadrage champs numeriques *15100000 * *-------------------------------------------------*15110000 * 15120000 copy ccadnumc. 15130000 * *-------------------------------------------------*15140000 * * zone communication sous-programme cics smesapp *15150000 * * pour gestion centralisee des messages *15160000 * *-------------------------------------------------*15170000 * 15180000 copy cmesapp. 15190000 * *-------------------------------------------------*15200000 * * zone communication sous-programme cics fpargen *15210000 * * pour controle des champs *15220000 * *-------------------------------------------------*15230000 * 15240000 copy cpargen. 15250000 * *-------------------------------------------------*15260000 * * description de la map symbolique mbqe000 *15270000 * *-------------------------------------------------*15280000 * 15290000 01 zone-map. 15300000 copy MBQE011 replacing ==01== by ==05== 15310000 ==02== by ==10== 15320000 ==03== by ==15==. 15330000 * 15340000 * *-------------------------------------------------*15350000 * * copy standard cics des touches fonction *15360000 * *-------------------------------------------------*15370000 * 15380000 copy dfhaid. 15390000 * 15400000 * *-------------------------------------------------*15410000 * * copy standard cics des attributs bms *15420000 * *-------------------------------------------------*15430000 * 15440000 copy dfhbmsca. 15450000 * *-------------------------------------------------*15460000 * * description du fichier fcompte *15470000 * * (liste des comptes) *15480000 * *-------------------------------------------------*15490000 copy fcompte. 15500000 * *-------------------------------------------------*15510000 * * description du fichier fidenti *15520000 * * (liste des identit‚s) *15530000 * *-------------------------------------------------*15540000 copy fidenti. 15550000 * *=================================================*15560000 * * linkage section *15570000 * *=================================================*15580000 linkage section. 15590000 * 15600000 * *-------------------------------------------------*15610000 * * description de la zone de communication cics *15620000 * *-------------------------------------------------*15630000 * 15640000 01 dfhcommarea pic x(500). 15650000 * 15660000 *================================================================*15670000 * procedure division *15680000 *================================================================*15690000 * 15700000 procedure division. 15710000 * 15720000 *----------------------------------------------------------------*15730000 * *15740000 * traitement d'un dialogue de la transaction *15750000 * *15760000 *----------------------------------------------------------------*15770000 traitement-transaction. 15780000 * recuperation de la commarea 15790000 if eibcalen > 0 15800000 move dfhcommarea to zone-commarea 15810000 end-if 15820000 * 15830000 * *-------------------------------------------------*15840000 * * orientation du dialogue selon provenance *15850000 * *-------------------------------------------------*15860000 * 15870000 evaluate true 15880000 * *--------------------------------*15890000 * * Dialogue initial : *15900000 * * en venant du menu *15910000 * *--------------------------------*15920000 when eibcalen not equal 0 and eibtrnid = 'BG00' 15930000 perform dialogue-initial 15940000 thru dialogue-initial-exit 15950000 * *--------------------------------*15960000 * * suite de la conversation *15970000 * * meme transaction *15980000 * *--------------------------------*15990000 when eibcalen not equal 0 and eibtrnid = 'BG11' 16000000 perform dialogue-en-cours 16010000 thru dialogue-en-cours-exit 16020000 * *--------------------------------*16030000 * * provenance interdite *16040000 * *--------------------------------*16050000 when other 16060000 perform dialogue-interdit 16070000 thru dialogue-interdit-exit 16080000 end-evaluate 16090000 . 16100000 traitement-transaction-exit. goback. 16110000 *----------------------------------------------------------------*16120000 * *16130000 * initialisation du dialogue *16140000 * *16150000 *----------------------------------------------------------------*16160000 dialogue-initial. 16170000 * initialisation de la cal 16180000 initialize zone-commarea-locale 16190000 * initialisation du boolen dans la cal 16200000 set cal-validation-ko to true 16210000 * *--------------------------------*16220000 * * remplissage du champ pdecaut *16230000 * *--------------------------------*16240000 move space to spargen-commarea 16250000 move 'PDECAUT' to spargen-ctyppar 16260000 move '>=' to spargen-copepar 16270000 compute time9 = 99999999 - cag-time 16280000 move time9 to spargen-cclepar 16290000 perform recherche-parametre 16300000 move spargen-ldonpar to tempsettaux 16310000 move taux to pdecauto 16320000 move temps to ddecauto 16330000 * *--------------------------------*16340000 * * preparation map *16350000 * *--------------------------------*16360000 move low-value to zone-map 16370000 * *--------------------------------*16380000 * * preparation entete map *16390000 * *--------------------------------*16400000 perform entete-map 16410000 * *--------------------------------*16420000 * * preparation touches fonction *16430000 * *--------------------------------*16440000 perform touches-fonction 16450000 * *--------------------------------*16460000 * message : 001I * initialisation message *16470000 * *--------------------------------*16480000 move space to smesapp-commarea 16490000 move '001I' to smesapp-cmesapp 16500000 perform recherche-message 16510000 * *--------------------------------*16520000 * * mise en place curseur *16530000 * *--------------------------------*16540000 move curseur to ctypcptl 16550000 move cag-cnumcpt to cnumcpto 16560000 move cag-cclerib to ccleribo 16570000 * *--------------------------------*16580000 * * envoi map physique et logique *16590000 * *--------------------------------*16600000 perform emission-map-complete 16610000 * *--------------------------------*16620000 * * liberation partielle *16630000 * *--------------------------------*16640000 perform liberation-partielle 16650000 . 16660000 dialogue-initial-exit. exit. 16670000 *----------------------------------------------------------------*16680000 * *16690000 * conversation en cours de la transaction *16700000 * *16710000 *----------------------------------------------------------------*16720000 dialogue-en-cours. 16730000 * *--------------------------------*16740000 * * reception map *16750000 * *--------------------------------*16760000 perform reception-map 16770000 * *--------------------------------*16780000 * * preparation attributs initiaux *16790000 * *--------------------------------*16800000 perform initialisation-attributs 16810000 * 16820000 * *-------------------------------------------------*16830000 * * orientation de l'operation selon touche activee *16840000 * *-------------------------------------------------*16850000 * 16860000 evaluate EIBAID 16870000 * *--------------------------------*16880000 * * touche enter : controle *16890000 * *--------------------------------*16900000 when DFHENTER 16910000 perform operation-controle 16920000 thru operation-controle-exit 16930000 * *--------------------------------*16940000 * * touche f2 : effacement *16950000 * *--------------------------------*16960000 when DFHPF2 16970000 perform operation-effacement 16980000 thru operation-effacement-exit 16990000 * *--------------------------------*17000000 * * touche f4 : retour menu *17010000 * *--------------------------------*17020000 when DFHPF4 17030000 perform operation-retour-menu 17040000 thru operation-retour-menu-exit 17050000 * *--------------------------------*17060000 * * touche clear : deconnexion *17070000 * *--------------------------------*17080000 when DFHPF5 17090000 if cal-validation-ok then 17100000 perform operation-validation 17110000 thru operation-validation-exit 17120000 else 17130000 perform operation-imprevue 17140000 thru operation-imprevue-exit 17150000 end-if 17160000 * *--------------------------------*17170000 * * touche non fonctionnelle *17180000 * *--------------------------------*17190000 when other 17200000 perform operation-imprevue 17210000 thru operation-imprevue-exit 17220000 end-evaluate 17230000 * *--------------------------------*17240000 * * preparation entete map *17250000 * *--------------------------------*17260000 perform entete-map 17270000 * *--------------------------------*17280000 * * envoi map logique *17290000 * *--------------------------------*17300000 perform emission-map-logique 17310000 * *--------------------------------*17320000 * * liberation partielle *17330000 * *--------------------------------*17340000 perform liberation-partielle 17350000 . 17360000 dialogue-en-cours-exit. exit. 17370000 *----------------------------------------------------------------*17380000 * *17390000 * conversation venant d'une autre transanction *17400000 * *17410000 *----------------------------------------------------------------*17420000 dialogue-initial-menu. 17430000 * *--------------------------------*17440000 * * preparation map *17450000 * *--------------------------------*17460000 move low-value to zone-map 17470000 * *--------------------------------*17480000 * * preparation entete map *17490000 * *--------------------------------*17500000 perform entete-map 17510000 * *--------------------------------*17520000 * * preparation touches fonction *17530000 * *--------------------------------*17540000 perform touches-fonction 17550000 * *--------------------------------*17560000 * message : pas de message * initialisation message *17570000 * *--------------------------------*17580000 * move space to smesapp-commarea 17590000 * move '004I' to smesapp-cmesapp 17600000 * move cag-cfonmen to smesapp-cparam1 17610000 * perform recherche-message 17620000 * *--------------------------------*17630000 * * mise en place curseur *17640000 * *--------------------------------*17650000 move curseur to cforintl 17660000 move cag-cnumcpt to cnumcpto 17670000 move cag-cclerib to ccleribo 17680000 * *--------------------------------*17690000 * * envoi map physique et logique *17700000 * *--------------------------------*17710000 perform emission-map-complete 17720000 * *--------------------------------*17730000 * * liberation partielle *17740000 * *--------------------------------*17750000 perform liberation-partielle 17760000 . 17770000 dialogue-initial-menu-exit. exit. 17780000 *----------------------------------------------------------------*17790000 * *17800000 * erreur de gestion de provenance *17810000 * *17820000 *----------------------------------------------------------------*17830000 dialogue-interdit. 17840000 exec cics return transid(code-menu) 17850000 immediate 17860000 end-exec 17870000 . 17880000 dialogue-interdit-exit. exit. 17890000 *----------------------------------------------------------------*17900000 * *17910000 * controles de la saisie de l'ecran *17920000 * *17930000 *----------------------------------------------------------------*17940000 operation-controle. 17950000 * *--------------------------------*17960000 * * controle saisie des champs *17970000 * *--------------------------------*17980000 perform controle-saisie-champs 17990000 thru controle-saisie-champs-exit 18000000 * *--------------------------------*18010000 * * controle saisie ok : *18020000 * * - appel de la fonction *18030000 * *--------------------------------*18040000 if controle-saisie-ok 18050000 perform apparition-validation 18060000 thru apparition-validation-exit 18070000 else 18080000 perform disparition-validation 18090000 thru disparition-validation-exit 18100000 end-if 18110000 . 18120000 operation-controle-exit. exit. 18130000 *----------------------------------------------------------------*18140000 * *18150000 * effacement de la saisie *18160000 * *18170000 *----------------------------------------------------------------*18180000 operation-effacement. 18190000 * *--------------------------------*18200000 * * effacement des champs *18210000 * *--------------------------------*18220000 move space to cnumcpto 18230000 move space to ccleribo 18240000 move space to cnumideo 18250000 move space to lnomideo 18260000 * *--------------------------------*18270000 * * mise en place curseur *18280000 * *--------------------------------*18290000 move curseur to cforintl 18300000 * *--------------------------------*18310000 * * initialisation message *18320000 * *--------------------------------*18330000 move space to smesapp-commarea 18340000 move '001I' to smesapp-cmesapp 18350000 perform recherche-message 18360000 . 18370000 operation-effacement-exit. exit. 18380000 *----------------------------------------------------------------*18390000 * apparition de validation *18400000 *----------------------------------------------------------------*18410000 apparition-validation. 18420000 18430000 move 'F5 ' to d2261o 18440000 move 'Validation ' to d2265o 18450000 set cal-validation-ok to true 18460000 move ctypcpti to cal-ctypcpt 18470000 move cforinti to cal-cforint 18480000 move lintcpti to cal-lintcpt 18490000 move cnumidei to cal-cnumide 18500000 move cperreli to cal-cperrel 18510000 move mmoydomi to cal-mmoydom 18520000 move cforchqi to cal-cforchq 18530000 move crenauti to cal-crenaut 18540000 move cremchqi to cal-cremchq 18550000 move cdecauti to cal-cdecaut 18560000 move mdecauti to cal-mdecaut 18570000 18580000 . 18590000 apparition-validation-exit. exit. 18600000 *----------------------------------------------------------------*18610000 * disparition de validation *18620000 *----------------------------------------------------------------*18630000 disparition-validation. 18640000 18650000 move space to d2261o 18660000 move space to d2265o 18670000 set cal-validation-ko to true 18680000 18690000 . 18700000 disparition-validation-exit. exit. 18710000 *----------------------------------------------------------------*18720000 * demande de validation *18730000 *----------------------------------------------------------------*18740000 operation-validation. 18750000 move space to smesapp-cmesapp 18760000 if ctypcpti not equal to cal-ctypcpt 18770000 or cforinti not equal to cal-cforint 18780000 or lintcpti not equal to cal-lintcpt 18790000 or cnumidei not equal to cal-cnumide 18800000 or cperreli not equal to cal-cperrel 18810000 or mmoydomi not equal to cal-mmoydom 18820000 or cforchqi not equal to cal-cforchq 18830000 or crenauti not equal to cal-crenaut 18840000 or cremchqi not equal to cal-cremchq 18850000 or cdecauti not equal to cal-cdecaut 18860000 or mdecauti not equal to cal-mdecaut then 18870000 move space to smesapp-commarea 18880000 move curseur to ctypcptl 18890000 move '007I' to smesapp-cmesapp 18900000 perform recherche-message 18910000 perform disparition-validation 18920000 thru disparition-validation-exit 18930000 else 18940000 * preparation de pdecaut-comp via scadnum 18950000 move space to scadnumc-commarea 18960000 move 'Z999' to scadnumc-cforext 18970000 move cal-pdecaut to scadnumc-ldonext 18980000 perform cadrage-numerique 18990000 move scadnumc-qdonnum2 to cal-pdecaut-comp 19000000 * on pose un verrou en ecriture 19010000 move cag-cnumcpt to cnumcpt 19020000 perform 610-read-update-fcompte 19030000 * On enregistre le compte 19040000 move ccleribi to cclerib 19050000 move ctypcpti to ctypcpt 19060000 move lintcpti to lintcpt 19070000 move cforinti to cforint 19080000 move cnumidei to cnumide of fcompte 19090000 move cperreli to cperrel 19100000 move cal-mmoydom-comp to mmoydom 19110000 move cforchqi to cforchq 19120000 move crenauti to crenaut 19130000 move cremchqi to cremchq 19140000 move cdecauti to cdecaut 19150000 if cdecauti = 'O' then 19160000 move cal-mdecaut-comp to mdecaut 19170000 end-if 19180000 move cal-pdecaut-comp to pdecaut 19190000 perform 620-ecraser-fcompte 19200000 * On retourne au menu 19210000 move cnumidei to cag-cnumide 19220000 exec cics xctl program(nom-programme) 19230000 commarea(zone-commarea) 19240000 length(length of 19250000 zone-commarea) 19260000 end-exec 19270000 end-if 19280000 . 19290000 operation-validation-exit. exit. 19300000 *----------------------------------------------------------------*19310000 * demande de retour menu *19320000 *----------------------------------------------------------------*19330000 operation-retour-menu. 19340000 move cag-cnumcpt to cnumcpt 19350000 perform 610-read-update-fcompte 19360000 perform 600-effacer-fcompte 19370000 move cnumidei to cag-cnumide 19380000 exec cics xctl program(nom-programme) 19390000 commarea(zone-commarea) 19400000 length(length of 19410000 zone-commarea) 19420000 end-exec 19430000 . 19440000 operation-retour-menu-exit. exit. 19450000 *----------------------------------------------------------------*19460000 * *19470000 * touche fonction inactive *19480000 * *19490000 *----------------------------------------------------------------*19500000 operation-imprevue. 19510000 * *--------------------------------*19520000 * message : 099E * initialisation message *19530000 * *--------------------------------*19540000 move space to smesapp-commarea 19550000 move curseur to ctypcptl 19560000 move '099E' to smesapp-cmesapp 19570000 perform recherche-message 19580000 . 19590000 operation-imprevue-exit. exit. 19600000 * 19610000 *================================================================*19620000 * *19630000 * controle de la saisie de l'ecran mbqe000 *19640000 * *19650000 * donnees en entree : champs input de l'ecran *19660000 * donnees en sortie : champs output de l'ecran *19670000 * booleen controle saisie : ok ou ko *19680000 * libelle message *19690000 * *19700000 *================================================================*19710000 * 19720000 controle-saisie-champs. 19730000 * *--------------------------------*19740000 * * initialisations : *19750000 * * - effacement du message *19760000 * * - zone de communication *19770000 * * module smesapp (message) *19780000 * *--------------------------------*19790000 move space to lmessago 19800000 move space to smesapp-commarea 19810000 move zero to mmoydom-comp 19820000 move zero to mdecaut-comp 19830000 * *-------------------------------------------------*19840000 * * controles du champ ctypcpt *19850000 * *-------------------------------------------------*19860000 * *--------------------------------*19870000 * message : 006e * - presence obligatoire *19880000 * *--------------------------------*19890000 if ctypcpti <= space 19900000 move curseur to ctypcptl 19910000 move dfhunimd to ctypcpta 19920000 move '006E' to smesapp-cmesapp 19930000 go to controle-saisie-champs-stop 19940000 end-if 19950000 * *--------------------------------*19960000 * message : 007E * - presence sur fpargen *19970000 * *--------------------------------*19980000 move space to spargen-commarea 19990000 move 'CTYPCPT' to spargen-ctyppar 20000000 move '=' to spargen-copepar 20010000 move ctypcpti to spargen-cclepar 20020000 move nom-map to spargen-cclepar(2:) 20030000 perform recherche-parametre 20040000 if spargen-cstapar not = '00' 20050000 move curseur to ctypcpto 20060000 move dfhunimd to ctypcpta 20070000 move '007E' to smesapp-cmesapp 20080000 move ctypcpti to smesapp-cparam1 20090000 go to controle-saisie-champs-stop 20100000 else 20110000 move spargen-ldonpar to ltypcpto 20120000 end-if 20130000 * *-------------------------------------------------*20140000 * * controles du champ cforint *20150000 * *-------------------------------------------------*20160000 * *--------------------------------*20170000 * message : 039e * - presence obligatoire *20180000 * *--------------------------------*20190000 if cforinti <= space 20200000 move curseur to cforintl 20210000 move dfhunimd to cforinta 20220000 move '039E' to smesapp-cmesapp 20230000 go to controle-saisie-champs-stop 20240000 end-if 20250000 * *--------------------------------*20260000 * message : 040E * - presence sur fpargen *20270000 * *--------------------------------*20280000 move space to spargen-commarea 20290000 move 'CFORINT' to spargen-ctyppar 20300000 move '=' to spargen-copepar 20310000 move cforinti to spargen-cclepar 20320000 perform recherche-parametre 20330000 if spargen-cstapar not = '00' 20340000 move curseur to cforinto 20350000 move dfhunimd to cforinta 20360000 move '040E' to smesapp-cmesapp 20370000 move cforinti to smesapp-cparam1 20380000 go to controle-saisie-champs-stop 20390000 else 20400000 move spargen-ldonpar to lforinto 20410000 end-if 20420000 * *-------------------------------------------------*20430000 * * controles du champ lintcpt *20440000 * *-------------------------------------------------*20450000 * *--------------------------------*20460000 * message : 008e * - presence obligatoire *20470000 * *--------------------------------*20480000 if lintcpti <= space 20490000 move curseur to lintcptl 20500000 move dfhunimd to lintcpta 20510000 move '008E' to smesapp-cmesapp 20520000 go to controle-saisie-champs-stop 20530000 end-if 20540000 * *-------------------------------------------------*20550000 * * controles du champ cnumide *20560000 * *-------------------------------------------------*20570000 * *--------------------------------*20580000 * message : 009e * - presence obligatoire *20590000 * *--------------------------------*20600000 if cnumidei <= space 20610000 move curseur to cnumidel 20620000 move dfhunint to cnumidea 20630000 move '009E' to smesapp-cmesapp 20640000 go to controle-saisie-champs-stop 20650000 end-if 20660000 * *--------------------------------*20670000 * message : scadnum * - numericite *20680000 * *--------------------------------*20690000 move space to scadnumc-commarea 20700000 move '999999' to scadnumc-cforext 20710000 move cnumidei to scadnumc-ldonext 20720000 perform cadrage-numerique 20730000 if scadnumc-cmesapp = zero 20740000 move scadnumc-ldoncad to cnumideo 20750000 else 20760000 move curseur to cnumidel 20770000 move dfhunint to cnumidea 20780000 go to controle-saisie-champs-stop 20790000 end-if 20800000 * *--------------------------------*20810000 * message : 045E * - presence sur fidenti *20820000 * *--------------------------------*20830000 move cnumidei to cnumide of fidenti 20840000 perform 630-read-fidenti 20850000 if code-retour = dfhresp(notfnd) then 20860000 move curseur to cnumidel 20870000 move dfhunint to cnumidea 20880000 move '045E' to smesapp-cmesapp 20890000 move cnumidei to smesapp-cparam1 20900000 go to controle-saisie-champs-stop 20910000 else 20920000 move lnomide of fidenti to lnomideo 20930000 end-if 20940000 * *-------------------------------------------------*20950000 * * controles du champ cperrel *20960000 * *-------------------------------------------------*20970000 * *--------------------------------*20980000 * message : 010e * - presence obligatoire *20990000 * *--------------------------------*21000000 if cperreli <= space 21010000 move curseur to cperrell 21020000 move dfhunimd to cperrela 21030000 move '010E' to smesapp-cmesapp 21040000 go to controle-saisie-champs-stop 21050000 end-if 21060000 * *--------------------------------*21070000 * message : 011E * - presence sur fpargen *21080000 * *--------------------------------*21090000 move space to spargen-commarea 21100000 move 'CPERREL' to spargen-ctyppar 21110000 move '=' to spargen-copepar 21120000 move cperreli to spargen-cclepar 21130000 perform recherche-parametre 21140000 if spargen-cstapar not = '00' 21150000 move curseur to cperrelo 21160000 move dfhunimd to cperrela 21170000 move '011E' to smesapp-cmesapp 21180000 move cperreli to smesapp-cparam1 21190000 go to controle-saisie-champs-stop 21200000 else 21210000 move spargen-ldonpar to lperrelo 21220000 end-if 21230000 * *-------------------------------------------------*21240000 * * controles du champ mmoydom *21250000 * *-------------------------------------------------*21260000 * *--------------------------------*21270000 * message : 012e * - presence obligatoire *21280000 * *--------------------------------*21290000 if mmoydomi <= space 21300000 move curseur to mmoydoml 21310000 move dfhunint to mmoydoma 21320000 move '012E' to smesapp-cmesapp 21330000 go to controle-saisie-champs-stop 21340000 end-if 21350000 * *--------------------------------*21360000 * message : scadnum * - numericite *21370000 * *--------------------------------*21380000 move space to scadnumc-commarea 21390000 move 'ZZZZZZ9,99' to scadnumc-cforext 21400000 move mmoydomi to scadnumc-ldonext 21410000 perform cadrage-numerique 21420000 if scadnumc-cmesapp = zero 21430000 move scadnumc-ldoncad to mmoydomo 21440000 move scadnumc-qdonnum2 to cal-mmoydom-comp 21450000 else 21460000 move curseur to mmoydoml 21470000 move dfhunint to mmoydoma 21480000 go to controle-saisie-champs-stop 21490000 end-if 21500000 * *-------------------------------------------------*21510000 * * controles du champ cforchq *21520000 * *-------------------------------------------------*21530000 * *--------------------------------*21540000 * message : 013e * - presence obligatoire *21550000 * *--------------------------------*21560000 if cforchqi <= space 21570000 move curseur to cforchql 21580000 move dfhunimd to cforchqa 21590000 move '013E' to smesapp-cmesapp 21600000 go to controle-saisie-champs-stop 21610000 end-if 21620000 * *--------------------------------*21630000 * message : 014E * - presence sur fpargen *21640000 * *--------------------------------*21650000 move space to spargen-commarea 21660000 move 'CFORCHQ' to spargen-ctyppar 21670000 move '=' to spargen-copepar 21680000 move cforchqi to spargen-cclepar 21690000 perform recherche-parametre 21700000 if spargen-cstapar not = '00' 21710000 move curseur to cforchqo 21720000 move dfhunimd to cforchqa 21730000 move '014E' to smesapp-cmesapp 21740000 move cforchqi to smesapp-cparam1 21750000 go to controle-saisie-champs-stop 21760000 else 21770000 move spargen-ldonpar to lforchqo 21780000 end-if 21790000 * *-------------------------------------------------*21800000 * * controles du champ crenaut *21810000 * *-------------------------------------------------*21820000 * *-----------------------------------*21830000 * message : 015E * - presence obligatoire et format *21840000 * *-----------------------------------*21850000 if crenauti not equal to 'O' 21860000 and crenauti not equal to 'N' then 21870000 move curseur to crenautl 21880000 move dfhunimd to crenauta 21890000 move '015E' to smesapp-cmesapp 21900000 go to controle-saisie-champs-stop 21910000 end-if 21920000 * *-------------------------------------------------*21930000 * * controles du champ cremchq *21940000 * *-------------------------------------------------*21950000 if crenauti = 'o' then 21960000 * *--------------------------------*21970000 * message : 016e * - presence obligatoire *21980000 * *--------------------------------*21990000 if cremchqi <= space 22000000 move curseur to cremchql 22010000 move dfhunimd to cremchqa 22020000 move '016E' to smesapp-cmesapp 22030000 go to controle-saisie-champs-stop 22040000 end-if 22050000 * *--------------------------------*22060000 * message : 017E * - presence sur fpargen *22070000 * *--------------------------------*22080000 move space to spargen-commarea 22090000 move 'CREMCHQ' to spargen-ctyppar 22100000 move '=' to spargen-copepar 22110000 move cremchqi to spargen-cclepar 22120000 perform recherche-parametre 22130000 if spargen-cstapar not = '00' 22140000 move curseur to cremchqo 22150000 move dfhunimd to cremchqa 22160000 move '017E' to smesapp-cmesapp 22170000 move cremchqi to smesapp-cparam1 22180000 go to controle-saisie-champs-stop 22190000 else 22200000 move spargen-ldonpar to lremchqo 22210000 end-if 22220000 end-if 22230000 * *-------------------------------------------------*22240000 * * controles du champ cdecaut *22250000 * *-------------------------------------------------*22260000 * *-----------------------------------*22270000 * message : 015E * - presence obligatoire et format *22280000 * *-----------------------------------*22290000 if cdecauti not equal to 'O' 22300000 and cdecauti not equal to 'N' then 22310000 move curseur to cdecautl 22320000 move dfhunimd to cdecauta 22330000 move '015E' to smesapp-cmesapp 22340000 go to controle-saisie-champs-stop 22350000 end-if 22360000 * *-------------------------------------------------*22370000 * * controles du champ mdecaut *22380000 * *-------------------------------------------------*22390000 if cdecauti = 'O' then 22400000 * *--------------------------------*22410000 * message : 018e * - presence obligatoire *22420000 * *--------------------------------*22430000 if mdecauti <= space 22440000 move curseur to mdecautl 22450000 move dfhunint to mdecauta 22460000 move '018E' to smesapp-cmesapp 22470000 go to controle-saisie-champs-stop 22480000 end-if 22490000 * *--------------------------------*22500000 * message : scadnum * - numericite *22510000 * *--------------------------------*22520000 move space to scadnumc-commarea 22530000 move 'ZZZZZZ9,99' to scadnumc-cforext 22540000 move mdecauti to scadnumc-ldonext 22550000 perform cadrage-numerique 22560000 if scadnumc-cmesapp = zero 22570000 move scadnumc-ldoncad to mdecauto 22580000 move scadnumc-qdonnum2 to cal-mdecaut-comp 22590000 else 22600000 move curseur to mdecautl 22610000 move dfhunint to mdecauta 22620000 go to controle-saisie-champs-stop 22630000 end-if 22640000 else 22650000 * *--------------------------------*22660000 * message : 019e * - presence interdite *22670000 * *--------------------------------*22680000 if mdecauti > space 22690000 move curseur to mdecautl 22700000 move dfhunint to mdecauta 22710000 move '019E' to smesapp-cmesapp 22720000 go to controle-saisie-champs-stop 22730000 end-if 22740000 move zero to cal-mdecaut-comp 22750000 end-if 22760000 * *-------------------------------------------------*22770000 * * arret des controles de saisie *22780000 * *-------------------------------------------------*22790000 . 22800000 controle-saisie-champs-stop. 22810000 * *--------------------------------*22820000 * * controle saisie ok *22830000 * *--------------------------------*22840000 if smesapp-cmesapp = space 22850000 set controle-saisie-ok to true 22860000 * *--------------------------------*22870000 * * saisie invalide *22880000 * *--------------------------------*22890000 else 22900000 set controle-saisie-ko to true 22910000 perform recherche-message 22920000 end-if 22930000 . 22940000 controle-saisie-champs-exit. exit. 22950000 * 22960000 *================================================================*22970000 * *22980000 * modules generalises *22990000 * *23000000 *================================================================*23010000 * 23020000 *----------------------------------------------------------------*23030000 * *23040000 * preparation des champs de l'entete ecran *23050000 * *23060000 *----------------------------------------------------------------*23070000 entete-map. 23080000 * *--------------------------------*23090000 * * champs affiches en permanence *23100000 * * - code transaction systeme *23110000 * * - code terminal logique *23120000 * * - date tache aa.qqq *23130000 * * - heure tache hh:mm:ss *23140000 * *--------------------------------*23150000 * *--------------------------------*23160000 * * remplissage du champ pdecaut *23170000 * *--------------------------------*23180000 move space to spargen-commarea 23190000 move 'PDECAUT' to spargen-ctyppar 23200000 move '>=' to spargen-copepar 23210000 compute time9 = 99999999 - cag-time 23220000 move time9 to spargen-cclepar 23230000 perform recherche-parametre 23240000 move spargen-ldonpar to tempsettaux 23250000 move temps to ddecauto 23260000 move taux to pdecauto 23270000 move taux to cal-pdecaut 23280000 move eibtrnid to ctrnsyso 23290000 * 23300000 move eibtrmid to ctrmlogo 23310000 * 23320000 move eibdate to date-decomp 23330000 move date-decomp(1:2) to edition-date(1:2) 23340000 move date-decomp(3:3) to edition-date(4:3) 23350000 move edition-date to dtacsyso 23360000 * 23370000 move eibtime to heure-decomp 23380000 move heure-decomp(1:2) to edition-heure(1:2) 23390000 move heure-decomp(3:2) to edition-heure(4:2) 23400000 move heure-decomp(5:2) to edition-heure(7:2) 23410000 move edition-heure to htacsyso 23420000 * 23430000 . 23440000 entete-map-exit. exit. 23450000 *----------------------------------------------------------------*23460000 * *23470000 * preparation des touches fonction actives *23480000 * *23490000 *----------------------------------------------------------------*23500000 touches-fonction. 23510000 * *--------------------------------*23520000 * * code et libelle touche *23530000 * *--------------------------------*23540000 move 'Ent' to d2201o 23550000 move 'Contr“le saisie' to d2205o 23560000 * 23570000 move 'F2 ' to d2221o 23580000 move 'Efface saisie ' to d2225o 23590000 * 23600000 move 'F4 ' to d2241o 23610000 move 'Retour menu ' to d2245o 23620000 . 23630000 touches-fonction-exit. exit. 23640000 *----------------------------------------------------------------*23650000 * *23660000 * preparation des attributs initiaux *23670000 * *23680000 *----------------------------------------------------------------*23690000 initialisation-attributs. 23700000 * *--------------------------------*23710000 * * attributs fset *23720000 * *--------------------------------*23730000 move dfhbmfse to ctypcpta 23740000 move dfhbmfse to cforinta 23750000 move dfhbmfse to lintcpta 23760000 move dfhunnum to cnumidea 23770000 move dfhbmfse to cperrela 23780000 move dfhunnum to mmoydoma 23790000 move dfhbmfse to cforchqa 23800000 move dfhbmfse to crenauta 23810000 move dfhbmfse to cremchqa 23820000 move dfhbmfse to cdecauta 23830000 move dfhunnum to mdecauta 23840000 . 23850000 initialisation-attributs-exit. exit. 23860000 *----------------------------------------------------------------*23870000 * *23880000 * recherche d'un message ecran sur fmesapp *23890000 * *23900000 *----------------------------------------------------------------*23910000 recherche-message. 23920000 * *--------------------------------*23930000 * * recherche et habillage message *23940000 * *--------------------------------*23950000 if smesapp-cappinf = space 23960000 move code-application to smesapp-cappinf 23970000 end-if 23980000 * 23990000 exec cics link program ('SMESAPP') 24000000 commarea (smesapp-commarea) 24010000 length (length of 24020000 smesapp-commarea) 24030000 end-exec 24040000 * *--------------------------------*24050000 * * affichage du message. *24060000 * *--------------------------------*24070000 move smesapp-lmessag to lmessago 24080000 . 24090000 recherche-message-exit. exit. 24100000 *----------------------------------------------------------------*24110000 * *24120000 * recherche d'un parametre de saisie sur fpargen *24130000 * *24140000 *----------------------------------------------------------------*24150000 recherche-parametre. 24160000 * *--------------------------------*24170000 * * recherche parametre *24180000 * *--------------------------------*24190000 exec cics link program ('SPARGEN') 24200000 commarea (spargen-commarea) 24210000 length (length of 24220000 spargen-commarea) 24230000 end-exec 24240000 . 24250000 recherche-message-exit. exit. 24260000 *----------------------------------------------------------------*24270000 * *24280000 * controle et cadrage d'une zone numerique *24290000 * *24300000 *----------------------------------------------------------------*24310000 cadrage-numerique. 24320000 * *--------------------------------*24330000 * * cadrage de la zone numerique *24340000 * *--------------------------------*24350000 call 'SCADNUM' using scadnumc-commarea 24360000 * *--------------------------------*24370000 * * message d'erreur *24380000 * *--------------------------------*24390000 if scadnumc-cmesapp not = zero 24400000 move 'GEN' to smesapp-cappinf 24410000 move scadnumc-cmesapp to smesapp-cmesapp 24420000 move scadnumc-cparam1 to smesapp-cparam1 24430000 end-if 24440000 . 24450000 cadrage-numerique-exit. exit. 24460000 * 24470000 *================================================================*24480000 * *24490000 * modules de gestion cics *24500000 * *24510000 *================================================================*24520000 * 24530000 *----------------------------------------------------------------*24540000 * *24550000 * emission de la map physique + logique *24560000 * *24570000 *----------------------------------------------------------------*24580000 emission-map-complete. 24590000 * *--------------------------------*24600000 * * emission map physique + logique*24610000 * *--------------------------------*24620000 exec cics send map (nom-map) 24630000 mapset (nom-mapset) 24640000 from (zone-map) 24650000 erase 24660000 cursor 24670000 end-exec 24680000 . 24690000 emission-map-complete-exit. exit. 24700000 *----------------------------------------------------------------*24710000 * *24720000 * emission de la map logique uniquement *24730000 * *24740000 *----------------------------------------------------------------*24750000 emission-map-logique. 24760000 * *--------------------------------*24770000 * * emission map logique *24780000 * *--------------------------------*24790000 exec cics send map (nom-map) 24800000 mapset (nom-mapset) 24810000 from (zone-map) 24820000 dataonly 24830000 cursor 24840000 end-exec 24850000 . 24860000 emission-map-logique-exit. exit. 24870000 *----------------------------------------------------------------*24880000 * *24890000 * reception de la map logique *24900000 * *24910000 *----------------------------------------------------------------*24920000 reception-map. 24930000 * *--------------------------------*24940000 * * reception saisie utilisateur *24950000 * *--------------------------------*24960000 move low-value to zone-map 24970000 * 24980000 exec cics receive map (nom-map) 24990000 mapset (nom-mapset) 25000000 into (zone-map) 25010000 nohandle 25020000 end-exec 25030000 . 25040000 reception-map-exit. exit. 25050000 *----------------------------------------------------------------*25060000 * *25070000 * emission d'un message non formate *25080000 * *25090000 *----------------------------------------------------------------*25100000 emission-message. 25110000 * *--------------------------------*25120000 * * emission selon controle *25130000 * *--------------------------------*25140000 exec cics send from (texte-message) 25150000 length (length of 25160000 texte-message) 25170000 erase 25180000 end-exec 25190000 . 25200000 emission-message-exit. exit. 25210000 *----------------------------------------------------------------*25220000 * *25230000 * liberation totale de la partition *25240000 * *25250000 *----------------------------------------------------------------*25260000 liberation-totale. 25270000 * *--------------------------------*25280000 * * retour definitif cics *25290000 * *--------------------------------*25300000 exec cics return 25310000 end-exec 25320000 . 25330000 liberation-totale-exit. exit. 25340000 *----------------------------------------------------------------*25350000 * *25360000 * liberation partielle de la partition *25370000 * *25380000 *----------------------------------------------------------------*25390000 liberation-partielle. 25400000 * *--------------------------------*25410000 * * retour temporaire cics *25420000 * *--------------------------------*25430000 exec cics return transid (code-transaction) 25440000 commarea (zone-commarea) 25450000 length (length of 25460000 zone-commarea) 25470000 end-exec 25480000 . 25490000 liberation-partielle-exit. exit. 25500000 **** 25510000 ** EFFACER COMPTE 25520000 **** 25530000 600-EFFACER-FCOMPTE. 25540000 EXEC CICS DELETE FILE(FCOMPTE-FILE) 25550000 RESP(CODE-RETOUR) 25560000 END-EXEC 25570000 EVALUATE CODE-RETOUR 25580000 WHEN DFHRESP(NORMAL) 25590000 CONTINUE 25600000 WHEN OTHER 25610000 PERFORM 700-ABANDON-TRANSACTION 25620000 END-EVALUATE 25630000 . 25640000 **** 25650000 ** READ UPDATE COMPTE 25660000 **** 25670000 610-READ-UPDATE-FCOMPTE. 25680000 EXEC CICS READ UPDATE FILE(FCOMPTE-FILE) 25690000 INTO(FCOMPTE) 25700000 RIDFLD(CNUMCPT) 25710000 RESP(CODE-RETOUR) 25720000 END-EXEC 25730000 EVALUATE CODE-RETOUR 25740000 WHEN DFHRESP(NORMAL) 25750000 CONTINUE 25760000 WHEN OTHER 25770000 PERFORM 700-ABANDON-TRANSACTION 25780000 END-EVALUATE 25790000 . 25800000 **** 25810000 ** ECRASER COMPTE 25820000 **** 25830000 620-ECRASER-FCOMPTE. 25840000 EXEC CICS REWRITE FILE(FCOMPTE-FILE) 25850000 FROM(FCOMPTE) 25860000 RESP(CODE-RETOUR) 25870000 END-EXEC 25880000 EVALUATE CODE-RETOUR 25890000 WHEN DFHRESP(NORMAL) 25900000 CONTINUE 25910000 WHEN OTHER 25920000 PERFORM 700-ABANDON-TRANSACTION 25930000 END-EVALUATE 25940000 . 25950000 **** 25960000 ** READ FIDENTI 25970000 **** 25980000 630-READ-FIDENTI. 25990000 EXEC CICS READ FILE(FIDENTI-FILE) 26000000 INTO(FIDENTI) 26010000 RIDFLD(CNUMIDE of FIDENTI) 26020000 RESP(CODE-RETOUR) 26030000 END-EXEC 26040000 EVALUATE CODE-RETOUR 26050000 WHEN DFHRESP(NORMAL) 26060000 CONTINUE 26070000 WHEN DFHRESP(NOTFND) 26080000 CONTINUE 26090000 WHEN OTHER 26100000 PERFORM 700-ABANDON-TRANSACTION 26110000 END-EVALUATE 26120000 . 26130000 **** 26140000 ** ABANDON TRANSACTION 26150000 **** 26160000 700-ABANDON-TRANSACTION. 26170000 * *--------------------------------*26180000 * message : 097E * initialisation message *26190000 * *--------------------------------*26200000 move space to smesapp-commarea 26210000 move '097E' to smesapp-cmesapp 26220000 move code-application to smesapp-cparam1 26230000 perform recherche-message 26240000 move lmessago to texte-message 26250000 * *--------------------------------*26260000 * * envoi message non formate *26270000 * *--------------------------------*26280000 perform emission-message 26290000 * *--------------------------------*26300000 * * liberation totale *26310000 * *--------------------------------*26320000 perform liberation-totale 26330000 26340000 . 26350000 *================================================================*26360000 * transaction menu *26370000 *================================================================*26380000 identification division. 26390000 program-id. pbqeg21. 26400000 *================================================================*26410000 * data division *26420000 *================================================================*26430000 data division. 26440000 * *=================================================*26450000 * * working storage section *26460000 * *=================================================*26470000 working-storage section. 26480000 * *-------------------------------------------------*26490000 * * constantes de la transaction *26500000 * *-------------------------------------------------*26510000 01 constantes-transaction. 26520000 05 code-application pic X(005) value 'BQE'. 26530000 05 code-transaction pic X(004) value 'BG21'. 26540000 05 code-menu pic x(004) value 'BG00'. 26550000 05 nom-map pic X(007) value 'BQE021'. 26560000 05 nom-mapset pic X(007) value 'MBQE021'. 26570000 05 curseur pic S9(004) comp value -1. 26580000 05 nom-programme pic X(008) value 'PBQEG00'. 26590000 * *-------------------------------------------------*26600000 * * zone message pour envoi texte non formate *26610000 * *-------------------------------------------------*26620000 01 texte-message pic x(080) value space. 26630000 * *-------------------------------------------------*26640000 * * zone de communication intra-application *26650000 * *-------------------------------------------------*26660000 copy cpbqeg. 26670000 10 indice-compte-courant PIC S9(4) COMP. 26680000 10 cal-bidon PIC X. 26690000 01 zone-commarea-bidon PIC X. 26700000 * *-------------------------------------------------*26710000 * * variables diverses *26720000 * *-------------------------------------------------*26730000 01 variables-diverses. 26740000 * Code retour des operations WRITE et READ 26750000 05 CODE-RETOUR PIC S9(08) COMP. 26760000 * *--------------------------------*26770000 * * booleen controle saisie *26780000 * *--------------------------------*26790000 05 pic x(001) value 'K'. 26800000 88 test-ok value 'O'. 26810000 88 test-ko value 'K'. 26820000 * Affichage des dates 26830000 05 date-decomp pic 99999. 26840000 05 edition-date. 26850000 10 AA pic XX. 26860000 10 FILLER pic X value '.'. 26870000 10 QQQ pic XXX. 26880000 05 heure-decomp pic 999999. 26890000 05 edition-heure. 26900000 10 HH pic XX. 26910000 10 FILLER pic X value ':'. 26920000 10 MM pic XX. 26930000 10 FILLER pic X value ':'. 26940000 10 SS pic XX. 26950000 05 time9 pic 9(08). 26960000 * *-------------------------------------------------*26970000 * * zone communication sous-programme cobol scadnum *26980000 * * pour controle et cadrage champs numeriques *26990000 * *-------------------------------------------------*27000000 * 27010000 copy ccadnumc. 27020000 * *-------------------------------------------------*27030000 * * zone communication sous-programme cics smesapp *27040000 * * pour gestion centralisee des messages *27050000 * *-------------------------------------------------*27060000 * 27070000 copy cmesapp. 27080000 * *-------------------------------------------------*27090000 * * zone communication sous-programme cics fpargen *27100000 * * pour controle des champs *27110000 * *-------------------------------------------------*27120000 * 27130000 copy cpargen. 27140000 * *-------------------------------------------------*27150000 * * description de la map symbolique mbqe000 *27160000 * *-------------------------------------------------*27170000 * 27180000 01 zone-map. 27190000 copy MBQE021 replacing ==01== by ==05== 27200000 ==02== by ==10== 27210000 ==03== by ==15==. 27220000 * 27230000 * *-------------------------------------------------*27240000 * * copy standard cics des touches fonction *27250000 * *-------------------------------------------------*27260000 * 27270000 copy dfhaid. 27280000 * 27290000 * *-------------------------------------------------*27300000 * * copy standard cics des attributs bms *27310000 * *-------------------------------------------------*27320000 * 27330000 copy dfhbmsca. 27340000 * *-------------------------------------------------*27350000 * * description du fichier fcompte *27360000 * * (liste des comptes) *27370000 * *-------------------------------------------------*27380000 copy fcompte. 27390000 * *-------------------------------------------------*27400000 * * copy pour les declarations de variables pour *27410000 * * les fichiers temporaires qts *27420000 * *-------------------------------------------------*27430000 copy ctsg. 27440000 * *=================================================*27450000 * * linkage section *27460000 * *=================================================*27470000 linkage section. 27480000 * 27490000 * *-------------------------------------------------*27500000 * * description de la zone de communication cics *27510000 * *-------------------------------------------------*27520000 * 27530000 01 dfhcommarea pic x(500). 27540000 * 27550000 *================================================================*27560000 * procedure division *27570000 *================================================================*27580000 * 27590000 procedure division. 27600000 * 27610000 *----------------------------------------------------------------*27620000 * *27630000 * traitement d'un dialogue de la transaction *27640000 * *27650000 *----------------------------------------------------------------*27660000 traitement-transaction. 27670000 * recuperation de la commarea 27680000 if eibcalen > 0 27690000 move dfhcommarea to zone-commarea 27700000 end-if 27710000 * 27720000 * *-------------------------------------------------*27730000 * * orientation du dialogue selon provenance *27740000 * *-------------------------------------------------*27750000 * 27760000 evaluate true 27770000 * *--------------------------------*27780000 * * Dialogue initial : *27790000 * * en venant du menu *27800000 * *--------------------------------*27810000 when eibcalen not equal 0 and eibtrnid = 'BG00' 27820000 perform dialogue-initial 27830000 thru dialogue-initial-exit 27840000 * *--------------------------------*27850000 * * suite de la conversation *27860000 * * meme transaction *27870000 * *--------------------------------*27880000 when eibcalen not equal 0 and eibtrnid = 'BG21' 27890000 perform dialogue-en-cours 27900000 thru dialogue-en-cours-exit 27910000 * *--------------------------------*27920000 * * Visualisation en venant de la *27930000 * * liste *27940000 * *--------------------------------*27950000 when eibcalen not equal 0 and eibtrnid = 'BG41' 27960000 perform dialogue-initial 27970000 thru dialogue-initial 27980000 * *--------------------------------*27990000 * * provenance interdite *28000000 * *--------------------------------*28010000 when other 28020000 perform dialogue-interdit 28030000 thru dialogue-interdit-exit 28040000 end-evaluate 28050000 . 28060000 traitement-transaction-exit. goback. 28070000 *----------------------------------------------------------------*28080000 * *28090000 * initialisation du dialogue *28100000 * *28110000 *----------------------------------------------------------------*28120000 dialogue-initial. 28130000 * initialisation de la cal 28140000 initialize zone-commarea-locale 28150000 * *--------------------------------*28160000 * * preparation map *28170000 * *--------------------------------*28180000 move low-value to zone-map 28190000 * *--------------------------------*28200000 * * preparation entete map *28210000 * *--------------------------------*28220000 perform entete-map 28230000 * *--------------------------------*28240000 * * preparation touches fonction *28250000 * *--------------------------------*28260000 perform touches-fonction 28270000 * *--------------------------------*28280000 * message : 001I * initialisation message *28290000 * *--------------------------------*28300000 move space to smesapp-commarea 28310000 move '001I' to smesapp-cmesapp 28320000 perform recherche-message 28330000 * *--------------------------------*28340000 * * Remplissage de l'‚cran *28350000 * *--------------------------------*28360000 if cag-ecran = 0 then 28370000 move cag-cnumcpt to cnumcpt of fcompte 28380000 perform 610-lecture-fcompte 28390000 perform remplissage-fcompte 28400000 else 28410000 set test-ko to true 28420000 perform varying indice-ts from 1 by 1 28430000 until indice-ts > 15 28440000 or test-ok 28450000 if cag-sel(indice-ts) = 'V' 28460000 set test-ok to true 28470000 move '*' to cag-sel(indice-ts) 28480000 move indice-ts to indice-compte-courant 28490000 end-if 28500000 end-perform 28510000 subtract 1 from indice-ts 28520000 perform 650-read-ts 28530000 move zone-ts to fcompte 28540000 perform remplissage-fcompte 28550000 end-if 28560000 * *--------------------------------*28570000 * * mise en place curseur *28580000 * *--------------------------------*28590000 * move curseur to ctypcptl 28600000 * *--------------------------------*28610000 * * envoi map physique et logique *28620000 * *--------------------------------*28630000 perform emission-map-complete 28640000 * *--------------------------------*28650000 * * liberation partielle *28660000 * *--------------------------------*28670000 perform liberation-partielle 28680000 . 28690000 dialogue-initial-exit. exit. 28700000 *----------------------------------------------------------------*28710000 * conversation en cours de la transaction *28720000 *----------------------------------------------------------------*28730000 dialogue-en-cours. 28740000 * *--------------------------------*28750000 * * reception map *28760000 * *--------------------------------*28770000 move low-value to zone-map 28780000 * *-------------------------------------------------*28790000 * * orientation de l'operation selon touche activee *28800000 * *-------------------------------------------------*28810000 * 28820000 evaluate EIBAID 28830000 * *--------------------------------*28840000 * * touche f3 : ecran precedent *28850000 * *--------------------------------*28860000 when DFHPF3 28870000 perform operation-ecran-prec 28880000 thru operation-ecran-prec-exit 28890000 * *--------------------------------*28900000 * * touche f4 : retour menu *28910000 * *--------------------------------*28920000 when DFHPF4 28930000 perform operation-retour-menu 28940000 thru operation-retour-menu-exit 28950000 * *--------------------------------*28960000 * * touche f7 : visu prec *28970000 * *--------------------------------*28980000 when DFHPF7 28990000 perform operation-visu-prec 29000000 thru operation-visu-prec-exit 29010000 * *--------------------------------*29020000 * * touche f8 : visu prec *29030000 * *--------------------------------*29040000 when DFHPF8 29050000 perform operation-visu-suiv 29060000 thru operation-visu-suiv-exit 29070000 * * touche non fonctionnelle *29080000 * *--------------------------------*29090000 when other 29100000 perform operation-imprevue 29110000 thru operation-imprevue-exit 29120000 end-evaluate 29130000 * *--------------------------------*29140000 * * preparation entete map *29150000 * *--------------------------------*29160000 perform entete-map 29170000 * *--------------------------------*29180000 * * envoi map logique *29190000 * *--------------------------------*29200000 perform emission-map-logique 29210000 * *--------------------------------*29220000 * * liberation partielle *29230000 * *--------------------------------*29240000 perform liberation-partielle 29250000 . 29260000 dialogue-en-cours-exit. exit. 29270000 *----------------------------------------------------------------*29280000 * erreur de gestion de provenance *29290000 *----------------------------------------------------------------*29300000 dialogue-interdit. 29310000 exec cics start transid(code-menu) 29320000 termid(eibtrmid) 29330000 end-exec 29340000 . 29350000 dialogue-interdit-exit. exit. 29360000 *----------------------------------------------------------------*29370000 * demande de retour menu *29380000 *----------------------------------------------------------------*29390000 operation-retour-menu. 29400000 exec cics xctl program(nom-programme) 29410000 commarea(zone-commarea) 29420000 length(length of 29430000 zone-commarea) 29440000 end-exec 29450000 . 29460000 operation-retour-menu-exit. exit. 29470000 *----------------------------------------------------------------*29480000 * demande de retour … l'‚cran pr‚c‚dent *29490000 *----------------------------------------------------------------*29500000 operation-ecran-prec. 29510000 evaluate cag-ecran 29520000 when 0 29530000 move 'PBQEG00 ' to nom-programme 29540000 when 4 29550000 move cag-first-cnumcpt to cag-cnumcpt 29560000 move 'PBQEG41 ' to nom-programme 29570000 when other 29580000 continue 29590000 end-evaluate 29600000 move 2 to cag-ecran 29610000 exec cics xctl program(nom-programme) 29620000 commarea(zone-commarea) 29630000 length(length of 29640000 zone-commarea) 29650000 end-exec 29660000 . 29670000 operation-ecran-prec-exit. exit. 29680000 *----------------------------------------------------------------*29690000 * demande de passage a la visualisation pr‚c‚dente *29700000 *----------------------------------------------------------------*29710000 operation-visu-suiv. 29720000 set test-ko to true 29730000 add 1 to indice-compte-courant 29740000 perform varying indice-ts from indice-compte-courant 29750000 by 1 29760000 until indice-ts > 15 29770000 or test-ok 29780000 if cag-sel(indice-ts) = 'V' 29790000 set test-ok to true 29800000 move '*' to cag-sel(indice-ts) 29810000 move indice-ts to indice-compte-courant 29820000 end-if 29830000 end-perform 29840000 if test-ok then 29850000 subtract 1 from indice-ts 29860000 perform 650-read-ts 29870000 move zone-ts to fcompte 29880000 perform remplissage-fcompte 29890000 else 29900000 perform operation-ecran-prec 29910000 end-if 29920000 . 29930000 operation-visu-suiv-exit. exit. 29940000 *----------------------------------------------------------------*29950000 * demande de passage a la visualisation suivante *29960000 *----------------------------------------------------------------*29970000 operation-visu-prec. 29980000 set test-ko to true 29990000 subtract 1 from indice-compte-courant 30000000 perform varying indice-ts from indice-compte-courant 30010000 by -1 30020000 until indice-ts < 1 30030000 or test-ok 30040000 if cag-sel(indice-ts) = '*' 30050000 set test-ok to true 30060000 move indice-ts to indice-compte-courant 30070000 * move 'V' to cag-sel(indice-ts) 30080000 end-if 30090000 end-perform 30100000 if test-ok then 30110000 add 1 to indice-ts 30120000 perform 650-read-ts 30130000 move zone-ts to fcompte 30140000 perform remplissage-fcompte 30150000 else 30160000 perform operation-ecran-prec 30170000 end-if 30180000 . 30190000 operation-visu-prec-exit. exit. 30200000 *----------------------------------------------------------------*30210000 * touche fonction inactive *30220000 *----------------------------------------------------------------*30230000 operation-imprevue. 30240000 * *--------------------------------*30250000 * message : 099E * initialisation message *30260000 * *--------------------------------*30270000 move space to smesapp-commarea 30280000 * move curseur to ctypcptl 30290000 move '099E' to smesapp-cmesapp 30300000 perform recherche-message 30310000 . 30320000 operation-imprevue-exit. exit. 30330000 *----------------------------------------------------------------*30340000 * remplissage depuis fcompte *30350000 *----------------------------------------------------------------*30360000 remplissage-fcompte. 30370000 * *------------------------------------------*30380000 * * remplissage des autres champs par *30390000 * * lecture de fcompte *30400000 * *------------------------------------------*30410000 * cnumcpt 30420000 move cnumcpt of fcompte to cnumcpto 30430000 * cclerib 30440000 move cclerib of fcompte to ccleribo 30450000 * ctypcpt 30460000 move ctypcpt of fcompte to ctypcpto 30470000 * ltypcpt 30480000 move space to spargen-commarea 30490000 move 'CTYPCPT' to spargen-ctyppar 30500000 move '=' to spargen-copepar 30510000 move ctypcpt of fcompte to spargen-cclepar 30520000 move nom-map to spargen-cclepar(2:) 30530000 perform recherche-parametre 30540000 move spargen-ldonpar to ltypcpto 30550000 * lintcpt 30560000 move lintcpt of fcompte to lintcpto 30570000 * cgescpt 30580000 move cgescpt of fcompte to cgescpto 30590000 * cforint 30600000 move cforint of fcompte to cforinto 30610000 * lforint 30620000 move space to spargen-commarea 30630000 move 'CFORINT' to spargen-ctyppar 30640000 move '=' to spargen-copepar 30650000 move cforint of fcompte to spargen-cclepar 30660000 perform recherche-parametre 30670000 if spargen-cstapar not = '00' 30680000 continue 30690000 else 30700000 move spargen-ldonpar to lforinto 30710000 end-if 30720000 * cnumide 30730000 move cnumide of fcompte to cnumideo 30740000 * cperrel 30750000 move cperrel of fcompte to cperrelo 30760000 * lperrel 30770000 move space to spargen-commarea 30780000 move 'CPERREL' to spargen-ctyppar 30790000 move '=' to spargen-copepar 30800000 move cperrel of fcompte to spargen-cclepar 30810000 perform recherche-parametre 30820000 if spargen-cstapar not = '00' 30830000 continue 30840000 else 30850000 move spargen-ldonpar to lperrelo 30860000 end-if 30870000 * mmoydom 30880000 move mmoydom of fcompte to mmoydomo 30890000 * cforchq 30900000 move cforchq of fcompte to cforchqo 30910000 * lforchq 30920000 move space to spargen-commarea 30930000 move 'CFORCHQ' to spargen-ctyppar 30940000 move '=' to spargen-copepar 30950000 move cforchq of fcompte to spargen-cclepar 30960000 perform recherche-parametre 30970000 if spargen-cstapar not = '00' 30980000 continue 30990000 else 31000000 move spargen-ldonpar to lforchqo 31010000 end-if 31020000 * crenaut 31030000 move crenaut of fcompte to crenauto 31040000 * cremchq 31050000 move cremchq of fcompte to cremchqo 31060000 * lremchq 31070000 move space to spargen-commarea 31080000 move 'CREMCHQ' to spargen-ctyppar 31090000 move '=' to spargen-copepar 31100000 move cremchq of fcompte to spargen-cclepar 31110000 perform recherche-parametre 31120000 if spargen-cstapar not = '00' 31130000 continue 31140000 else 31150000 move spargen-ldonpar to lremchqo 31160000 end-if 31170000 * cdecaut 31180000 move cdecaut of fcompte to cdecauto 31190000 * mdecaut 31200000 if cdecaut of fcompte = 'O' 31210000 move mdecaut of fcompte to mdecauto 31220000 end-if 31230000 * pdecaut 31240000 move pdecaut of fcompte to pdecauto 31250000 . 31260000 *================================================================*31270000 * modules generalises *31280000 *================================================================*31290000 * 31300000 *----------------------------------------------------------------*31310000 * preparation des champs de l'entete ecran *31320000 *----------------------------------------------------------------*31330000 entete-map. 31340000 * *--------------------------------*31350000 * * champs affiches en permanence *31360000 * * - code transaction systeme *31370000 * * - code terminal logique *31380000 * * - date tache aa.qqq *31390000 * * - heure tache hh:mm:ss *31400000 * *--------------------------------*31410000 move eibtrnid to ctrnsyso 31420000 * 31430000 move eibtrmid to ctrmlogo 31440000 * 31450000 move eibdate to date-decomp 31460000 move date-decomp(1:2) to edition-date(1:2) 31470000 move date-decomp(3:3) to edition-date(4:3) 31480000 move edition-date to dtacsyso 31490000 * 31500000 move eibtime to heure-decomp 31510000 move heure-decomp(1:2) to edition-heure(1:2) 31520000 move heure-decomp(3:2) to edition-heure(4:2) 31530000 move heure-decomp(5:2) to edition-heure(7:2) 31540000 move edition-heure to htacsyso 31550000 * 31560000 . 31570000 entete-map-exit. exit. 31580000 *----------------------------------------------------------------*31590000 * preparation des touches fonction actives *31600000 *----------------------------------------------------------------*31610000 touches-fonction. 31620000 * *--------------------------------*31630000 * * code et libelle touche *31640000 * *--------------------------------*31650000 move 'F3 ' to d2221o 31660000 move 'Ecran pr‚c‚dent' to d2225o 31670000 * 31680000 move 'F4 ' to d2241o 31690000 move 'Retour menu ' to d2245o 31700000 * 31710000 move 'F7 ' to d2321o 31720000 move 'Visu pr‚c‚dente' to d2325o 31730000 * 31740000 move 'F8 ' to d2341o 31750000 move 'Visu suivante ' to d2345o 31760000 . 31770000 touches-fonction-exit. exit. 31780000 *----------------------------------------------------------------*31790000 * preparation des attributs initiaux *31800000 *----------------------------------------------------------------*31810000 initialisation-attributs. 31820000 * *--------------------------------*31830000 * * attributs fset *31840000 * *--------------------------------*31850000 continue 31860000 . 31870000 initialisation-attributs-exit. exit. 31880000 *----------------------------------------------------------------*31890000 * recherche d'un message ecran sur fmesapp *31900000 *----------------------------------------------------------------*31910000 recherche-message. 31920000 * *--------------------------------*31930000 * * recherche et habillage message *31940000 * *--------------------------------*31950000 if smesapp-cappinf = space 31960000 move code-application to smesapp-cappinf 31970000 end-if 31980000 * 31990000 exec cics link program ('SMESAPP') 32000000 commarea (smesapp-commarea) 32010000 length (length of 32020000 smesapp-commarea) 32030000 end-exec 32040000 * *--------------------------------*32050000 * * affichage du message. *32060000 * *--------------------------------*32070000 move smesapp-lmessag to lmessago 32080000 . 32090000 recherche-message-exit. exit. 32100000 *----------------------------------------------------------------*32110000 * recherche d'un parametre de saisie sur fpargen *32120000 *----------------------------------------------------------------*32130000 recherche-parametre. 32140000 * *--------------------------------*32150000 * * recherche parametre *32160000 * *--------------------------------*32170000 exec cics link program ('SPARGEN') 32180000 commarea (spargen-commarea) 32190000 length (length of 32200000 spargen-commarea) 32210000 end-exec 32220000 . 32230000 recherche-message-exit. exit. 32240000 *----------------------------------------------------------------*32250000 * controle et cadrage d'une zone numerique *32260000 *----------------------------------------------------------------*32270000 cadrage-numerique. 32280000 * *--------------------------------*32290000 * * cadrage de la zone numerique *32300000 * *--------------------------------*32310000 call 'SCADNUM' using scadnumc-commarea 32320000 * *--------------------------------*32330000 * * message d'erreur *32340000 * *--------------------------------*32350000 if scadnumc-cmesapp not = zero 32360000 move 'GEN' to smesapp-cappinf 32370000 move scadnumc-cmesapp to smesapp-cmesapp 32380000 move scadnumc-cparam1 to smesapp-cparam1 32390000 end-if 32400000 . 32410000 cadrage-numerique-exit. exit. 32420000 * 32430000 *================================================================*32440000 * modules de gestion cics *32450000 *================================================================*32460000 * 32470000 *----------------------------------------------------------------*32480000 * emission de la map physique + logique *32490000 *----------------------------------------------------------------*32500000 emission-map-complete. 32510000 * *--------------------------------*32520000 * * emission map physique + logique*32530000 * *--------------------------------*32540000 exec cics send map (nom-map) 32550000 mapset (nom-mapset) 32560000 from (zone-map) 32570000 erase 32580000 cursor 32590000 end-exec 32600000 . 32610000 emission-map-complete-exit. exit. 32620000 *----------------------------------------------------------------*32630000 * emission de la map logique uniquement *32640000 *----------------------------------------------------------------*32650000 emission-map-logique. 32660000 * *--------------------------------*32670000 * * emission map logique *32680000 * *--------------------------------*32690000 exec cics send map (nom-map) 32700000 mapset (nom-mapset) 32710000 from (zone-map) 32720000 dataonly 32730000 cursor 32740000 end-exec 32750000 . 32760000 emission-map-logique-exit. exit. 32770000 *----------------------------------------------------------------*32780000 * reception de la map logique *32790000 *----------------------------------------------------------------*32800000 reception-map. 32810000 * *--------------------------------*32820000 * * reception saisie utilisateur *32830000 * *--------------------------------*32840000 move low-value to zone-map 32850000 * 32860000 exec cics receive map (nom-map) 32870000 mapset (nom-mapset) 32880000 into (zone-map) 32890000 nohandle 32900000 end-exec 32910000 . 32920000 reception-map-exit. exit. 32930000 *----------------------------------------------------------------*32940000 * emission d'un message non formate *32950000 *----------------------------------------------------------------*32960000 emission-message. 32970000 * *--------------------------------*32980000 * * emission selon controle *32990000 * *--------------------------------*33000000 exec cics send from (texte-message) 33010000 length (length of 33020000 texte-message) 33030000 erase 33040000 end-exec 33050000 . 33060000 emission-message-exit. exit. 33070000 *----------------------------------------------------------------*33080000 * liberation totale de la partition *33090000 *----------------------------------------------------------------*33100000 liberation-totale. 33110000 * *--------------------------------*33120000 * * retour definitif cics *33130000 * *--------------------------------*33140000 exec cics return 33150000 end-exec 33160000 . 33170000 liberation-totale-exit. exit. 33180000 *----------------------------------------------------------------*33190000 * liberation partielle de la partition *33200000 *----------------------------------------------------------------*33210000 liberation-partielle. 33220000 * *--------------------------------*33230000 * * retour temporaire cics *33240000 * *--------------------------------*33250000 exec cics return transid (code-transaction) 33260000 commarea (zone-commarea) 33270000 length (length of 33280000 zone-commarea) 33290000 end-exec 33300000 . 33310000 liberation-partielle-exit. exit. 33320000 **** 33330000 ** LECTURE FCOMPTE 33340000 **** 33350000 610-LECTURE-FCOMPTE. 33360000 EXEC CICS READ FILE(FCOMPTE-FILE) 33370000 INTO(FCOMPTE) 33380000 RIDFLD(CNUMCPT of fcompte) 33390000 RESP(CODE-RETOUR) 33400000 END-EXEC 33410000 EVALUATE CODE-RETOUR 33420000 WHEN DFHRESP(NORMAL) 33430000 CONTINUE 33440000 WHEN OTHER 33450000 PERFORM 700-ABANDON-TRANSACTION 33460000 END-EVALUATE 33470000 . 33480000 **** 33490000 ** CREATE TS 33500000 **** 33510000 640-CREATE-TS. 33520000 MOVE EIBTRMID TO NOM-TS(1:4) 33530000 MOVE 'LIST' TO NOM-TS(5:4) 33540000 EXEC CICS WRITEQ TS QUEUE(NOM-TS) 33550000 FROM(ZONE-TS) 33560000 LENGTH(LENGTH OF ZONE-TS) 33570000 RESP(CODE-RETOUR) 33580000 END-EXEC 33590000 EVALUATE CODE-RETOUR 33600000 WHEN DFHRESP(NORMAL) 33610000 CONTINUE 33620000 WHEN OTHER 33630000 PERFORM 700-ABANDON-TRANSACTION 33640000 END-EVALUATE 33650000 . 33660000 **** 33670000 ** READ TS 33680000 **** 33690000 650-READ-TS. 33700000 MOVE EIBTRMID TO NOM-TS(1:4) 33710000 MOVE 'LIST' TO NOM-TS(5:4) 33720000 EXEC CICS READQ TS QUEUE(NOM-TS) 33730000 INTO(ZONE-TS) 33740000 LENGTH(LENGTH OF ZONE-TS) 33750000 ITEM(INDICE-TS) 33760000 RESP(CODE-RETOUR) 33770000 END-EXEC 33780000 EVALUATE CODE-RETOUR 33790000 WHEN DFHRESP(NORMAL) 33800000 CONTINUE 33810000 WHEN OTHER 33820000 PERFORM 700-ABANDON-TRANSACTION 33830000 END-EVALUATE 33840000 . 33850000 **** 33860000 ** REWRITE TS 33870000 **** 33880000 670-REWRITE-TS. 33890000 MOVE EIBTRMID TO NOM-TS(1:4) 33900000 MOVE 'LIST' TO NOM-TS(5:4) 33910000 EXEC CICS WRITEQ TS QUEUE(NOM-TS) 33920000 FROM(ZONE-TS) 33930000 LENGTH(LENGTH OF ZONE-TS) 33940000 ITEM(INDICE-TS) REWRITE 33950000 RESP(CODE-RETOUR) 33960000 END-EXEC 33970000 EVALUATE CODE-RETOUR 33980000 WHEN DFHRESP(NORMAL) 33990000 CONTINUE 34000000 WHEN OTHER 34010000 PERFORM 700-ABANDON-TRANSACTION 34020000 END-EVALUATE 34030000 . 34040000 **** 34050000 ** DELETE TS 34060000 **** 34070000 660-DELETE-TS. 34080000 MOVE EIBTRMID TO NOM-TS(1:4) 34090000 MOVE 'LIST' TO NOM-TS(5:4) 34100000 EXEC CICS DELETEQ TS QUEUE(NOM-TS) 34110000 RESP(CODE-RETOUR) 34120000 END-EXEC 34130000 EVALUATE CODE-RETOUR 34140000 WHEN DFHRESP(NORMAL) 34150000 CONTINUE 34160000 WHEN DFHRESP(QIDERR) 34170000 CONTINUE 34180000 WHEN OTHER 34190000 PERFORM 700-ABANDON-TRANSACTION 34200000 END-EVALUATE 34210000 . 34220000 **** 34230000 ** ABANDON TRANSACTION 34240000 **** 34250000 700-ABANDON-TRANSACTION. 34260000 * *--------------------------------*34270000 * message : 097E * initialisation message *34280000 * *--------------------------------*34290000 move space to smesapp-commarea 34300000 move '097E' to smesapp-cmesapp 34310000 move code-application to smesapp-cparam1 34320000 perform recherche-message 34330000 move lmessago to texte-message 34340000 * *--------------------------------*34350000 * * envoi message non formate *34360000 * *--------------------------------*34370000 perform emission-message 34380000 * *--------------------------------*34390000 * * liberation totale *34400000 * *--------------------------------*34410000 perform liberation-totale 34420000 34430000 . 34440000 *================================================================*34450000 * Liste des comptes *34460000 *================================================================*34470000 identification division. 34480000 program-id. pbqeg41. 34490000 *================================================================*34500000 * data division *34510000 *================================================================*34520000 data division. 34530000 * *=================================================*34540000 * * working storage section *34550000 * *=================================================*34560000 working-storage section. 34570000 * *-------------------------------------------------*34580000 * * constantes de la transaction *34590000 * *-------------------------------------------------*34600000 01 constantes-transaction. 34610000 05 code-application pic x(005) value 'BQE'. 34620000 05 code-transaction pic x(004) value 'BG41'. 34630000 05 code-menu pic x(004) value 'BG00'. 34640000 05 nom-map pic x(007) value 'BQE041'. 34650000 05 nom-mapset pic x(007) value 'MBQE041'. 34660000 05 curseur pic S9(004) comp value -1. 34670000 05 nom-programme pic X(008) value 'PBQEG00'. 34680000 * *-------------------------------------------------*34690000 * * zone message pour envoi texte non formate *34700000 * *-------------------------------------------------*34710000 01 texte-message pic X(080) value space. 34720000 * *-------------------------------------------------*34730000 * * zone de communication intra-application *34740000 * *-------------------------------------------------*34750000 copy cpbqeg. 34760000 10 cal-first-cpt pic 9(11). 34770000 10 cal-last-cpt pic 9(11). 34780000 10 cal-bidon pic X. 34790000 01 zone-commarea-bidon pic X. 34800000 * *-------------------------------------------------*34810000 * * variables diverses *34820000 * *-------------------------------------------------*34830000 01 variables-diverses. 34840000 * Code retour des operations WRITE et READ 34850000 05 CODE-RETOUR PIC S9(08) COMP. 34860000 * Compteur de comptes dans la page 34870000 05 CTR-CPT PIC 9(04) COMP. 34880000 * cle de debut de remplissage 34890000 05 cle-x. 34900000 10 cle PIC 9(11). 34910000 * *--------------------------------*34920000 * * booleen controle saisie *34930000 * *--------------------------------*34940000 05 pic x(001) value 'K'. 34950000 88 controle-saisie-ok value 'O'. 34960000 88 controle-saisie-ko value 'K'. 34970000 05 date-decomp pic 99999. 34980000 05 edition-date. 34990000 10 AA pic XX. 35000000 10 FILLER pic X value '.'. 35010000 10 QQQ pic XXX. 35020000 05 heure-decomp pic 999999. 35030000 05 edition-heure. 35040000 10 HH pic XX. 35050000 10 FILLER pic X value ':'. 35060000 10 MM pic XX. 35070000 10 FILLER pic X value ':'. 35080000 10 SS pic XX. 35090000 05 time9 pic 9(08). 35100000 * *-------------------------------------------------*35110000 * * zone communication sous-programme cobol scadnum *35120000 * * pour controle et cadrage champs numeriques *35130000 * *-------------------------------------------------*35140000 copy ccadnumc. 35150000 * *-------------------------------------------------*35160000 * * zone communication sous-programme cics smesapp *35170000 * * pour gestion centralisee des messages *35180000 * *-------------------------------------------------*35190000 copy cmesapp. 35200000 * *-------------------------------------------------*35210000 * * zone communication sous-programme cics fpargen *35220000 * * pour controle des champs *35230000 * *-------------------------------------------------*35240000 copy cpargen. 35250000 * *-------------------------------------------------*35260000 * * description de la map symbolique mbqe000 *35270000 * *-------------------------------------------------*35280000 01 zone-map. 35290000 copy CBQE041 replacing ==01== by ==05== 35300000 ==02== by ==10== 35310000 ==03== by ==15==. 35320000 * *-------------------------------------------------*35330000 * * copy standard cics des touches fonction *35340000 * *-------------------------------------------------*35350000 copy dfhaid. 35360000 * *-------------------------------------------------*35370000 * * copy standard cics des attributs bms *35380000 * *-------------------------------------------------*35390000 copy dfhbmsca. 35400000 * *-------------------------------------------------*35410000 * * description du fichier fcompte *35420000 * * (liste des comptes) *35430000 * *-------------------------------------------------*35440000 copy fcompte. 35450000 * *-------------------------------------------------*35460000 * * copy pour les declarations de variables pour *35470000 * * les fichiers temporaires qts *35480000 * *-------------------------------------------------*35490000 copy ctsg. 35500000 * *=================================================*35510000 * * linkage section *35520000 * *=================================================*35530000 linkage section. 35540000 * *-------------------------------------------------*35550000 * * description de la zone de communication cics *35560000 * *-------------------------------------------------*35570000 01 dfhcommarea pic x(500). 35580000 *================================================================*35590000 * procedure division *35600000 *================================================================*35610000 procedure division. 35620000 *----------------------------------------------------------------*35630000 * traitement d'un dialogue de la transaction *35640000 *----------------------------------------------------------------*35650000 traitement-transaction. 35660000 * recuperation de la commarea 35670000 if eibcalen > 0 35680000 move dfhcommarea to zone-commarea 35690000 end-if 35700000 * *-------------------------------------------------*35710000 * * orientation du dialogue selon provenance *35720000 * *-------------------------------------------------*35730000 evaluate true 35740000 * *--------------------------------*35750000 * * Dialogue initial : *35760000 * * en venant du menu *35770000 * *--------------------------------*35780000 when eibcalen not equal 0 and eibtrnid = 'BG00' 35790000 perform dialogue-initial 35800000 thru dialogue-initial-exit 35810000 * *--------------------------------*35820000 * * Dialogue initial : *35830000 * * en venant de la visu *35840000 * *--------------------------------*35850000 when eibcalen not equal 0 and eibtrnid = 'BG21' 35860000 perform dialogue-retour-visu 35870000 thru dialogue-retour-visu-exit 35880000 * *--------------------------------*35890000 * * suite de la conversation *35900000 * * meme transaction *35910000 * *--------------------------------*35920000 when eibcalen not equal 0 and eibtrnid = 'BG41' 35930000 perform dialogue-en-cours 35940000 thru dialogue-en-cours-exit 35950000 * *--------------------------------*35960000 * * provenance interdite *35970000 * *--------------------------------*35980000 when other 35990000 perform dialogue-interdit 36000000 thru dialogue-interdit-exit 36010000 end-evaluate 36020000 . 36030000 traitement-transaction-exit. goback. 36040000 *----------------------------------------------------------------*36050000 * initialisation du dialogue *36060000 *----------------------------------------------------------------*36070000 dialogue-initial. 36080000 * initialisation de la cal 36090000 initialize zone-commarea-locale 36100000 * *--------------------------------*36110000 * * preparation zone-ts *36120000 * *--------------------------------*36130000 perform initialisation-ts 36140000 * *--------------------------------*36150000 * * preparation map *36160000 * *--------------------------------*36170000 move low-value to zone-map 36180000 * *--------------------------------*36190000 * * preparation entete map *36200000 * *--------------------------------*36210000 perform entete-map 36220000 * *--------------------------------*36230000 * * preparation touches fonction *36240000 * *--------------------------------*36250000 perform touches-fonction 36260000 * *--------------------------------*36270000 * message : 001I * initialisation message *36280000 * *--------------------------------*36290000 move space to smesapp-commarea 36300000 move '001I' to smesapp-cmesapp 36310000 perform recherche-message 36320000 * *--------------------------------*36330000 * * remplissage initial *36340000 * *--------------------------------*36350000 if cag-cnumcpt <= space 36360000 perform operation-premiere-page 36370000 else 36380000 move cag-cnumcpt to cle 36390000 perform 500-remplissage-avant 36400000 move cnumcpto(1) to cal-first-cpt 36410000 move cnumcpto(ctr-cpt) to cal-last-cpt 36420000 if ctr-cpt = 1 then 36430000 perform operation-derniere-page 36440000 end-if 36450000 end-if 36460000 * *--------------------------------*36470000 * * mise en place curseur *36480000 * *--------------------------------*36490000 move curseur to csellisl(1) 36500000 * *--------------------------------*36510000 * * envoi map physique et logique *36520000 * *--------------------------------*36530000 perform emission-map-complete 36540000 * *--------------------------------*36550000 * * liberation partielle *36560000 * *--------------------------------*36570000 perform liberation-partielle 36580000 . 36590000 dialogue-initial-exit. exit. 36600000 *----------------------------------------------------------------*36610000 * retour de l'ecran visualisation *36620000 *----------------------------------------------------------------*36630000 dialogue-retour-visu. 36640000 * initialisation de la cal 36650000 initialize zone-commarea-locale 36660000 * *--------------------------------*36670000 * * preparation map *36680000 * *--------------------------------*36690000 move low-value to zone-map 36700000 * *--------------------------------*36710000 * * preparation entete map *36720000 * *--------------------------------*36730000 perform entete-map 36740000 * *--------------------------------*36750000 * * preparation attributs initiaux *36760000 * *--------------------------------*36770000 perform initialisation-attributs 36780000 * *--------------------------------*36790000 * * preparation touches fonction *36800000 * *--------------------------------*36810000 perform touches-fonction 36820000 * *--------------------------------*36830000 * message : 001I * initialisation message *36840000 * *--------------------------------*36850000 move space to smesapp-commarea 36860000 move '001I' to smesapp-cmesapp 36870000 perform recherche-message 36880000 * *--------------------------------*36890000 * * remplissage colonne selection *36900000 * *--------------------------------*36910000 perform varying ctr-cpt from 1 by 1 36920000 until ctr-cpt > 15 36930000 move cag-sel(ctr-cpt) to cselliso(ctr-cpt) 36940000 end-perform 36950000 * *--------------------------------*36960000 * * remplissage initial *36970000 * *--------------------------------*36980000 perform 560-remplissage-ts 36990000 move cnumcpto(1) to cal-first-cpt 37000000 move cnumcpto(ctr-cpt) to cal-last-cpt 37010000 * *--------------------------------*37020000 * * mise en place curseur *37030000 * *--------------------------------*37040000 move curseur to csellisl(1) 37050000 * *--------------------------------*37060000 * * envoi map physique et logique *37070000 * *--------------------------------*37080000 perform emission-map-complete 37090000 * *--------------------------------*37100000 * * liberation partielle *37110000 * *--------------------------------*37120000 perform liberation-partielle 37130000 . 37140000 dialogue-retour-visu-exit. exit. 37150000 *----------------------------------------------------------------*37160000 * conversation en cours de la transaction *37170000 *----------------------------------------------------------------*37180000 dialogue-en-cours. 37190000 * *--------------------------------*37200000 * * reception map *37210000 * *--------------------------------*37220000 perform reception-map 37230000 * *--------------------------------*37240000 * * preparation attributs initiaux *37250000 * *--------------------------------*37260000 perform initialisation-attributs 37270000 * *-------------------------------------------------*37280000 * * orientation de l'operation selon touche activee *37290000 * *-------------------------------------------------*37300000 evaluate EIBAID 37310000 * *--------------------------------*37320000 * * touche enter : controle *37330000 * *--------------------------------*37340000 when DFHENTER 37350000 perform operation-controle 37360000 thru operation-controle-exit 37370000 * *--------------------------------*37380000 * * touche f2 : effacement *37390000 * *--------------------------------*37400000 when DFHPF2 37410000 perform operation-effacement 37420000 thru operation-effacement-exit 37430000 * *--------------------------------*37440000 * * touche f3 : ecran precedent *37450000 * *--------------------------------*37460000 when DFHPF3 37470000 perform operation-ecran-prec 37480000 thru operation-ecran-prec-exit 37490000 * *--------------------------------*37500000 * * touche f4 : retour menu *37510000 * *--------------------------------*37520000 when DFHPF4 37530000 perform operation-retour-menu 37540000 thru operation-retour-menu-exit 37550000 * *--------------------------------*37560000 * * touche f7 : page pr‚c‚dente *37570000 * *--------------------------------*37580000 when DFHPF7 37590000 perform operation-page-prec 37600000 thru operation-page-prec-exit 37610000 * *--------------------------------*37620000 * * touche f8 : page suivante *37630000 * *--------------------------------*37640000 when DFHPF8 37650000 perform operation-page-suiv 37660000 thru operation-page-suiv-exit 37670000 * *--------------------------------*37680000 * * touche f9 : premiŠre page *37690000 * *--------------------------------*37700000 when DFHPF9 37710000 perform operation-premiere-page 37720000 thru operation-premiere-page-exit 37730000 * *--------------------------------*37740000 * * touche f10 : premiŠre page *37750000 * *--------------------------------*37760000 when DFHPF10 37770000 perform operation-derniere-page 37780000 thru operation-derniere-page-exit 37790000 * *--------------------------------*37800000 * * touche non fonctionnelle *37810000 * *--------------------------------*37820000 when other 37830000 perform operation-imprevue 37840000 thru operation-imprevue-exit 37850000 end-evaluate 37860000 * *--------------------------------*37870000 * * preparation entete map *37880000 * *--------------------------------*37890000 perform entete-map 37900000 * *--------------------------------*37910000 * * envoi map logique *37920000 * *--------------------------------*37930000 perform emission-map-logique 37940000 * *--------------------------------*37950000 * * liberation partielle *37960000 * *--------------------------------*37970000 perform liberation-partielle 37980000 . 37990000 dialogue-en-cours-exit. exit. 38000000 *----------------------------------------------------------------*38010000 * erreur de gestion de provenance *38020000 *----------------------------------------------------------------*38030000 dialogue-interdit. 38040000 exec cics return transid(code-menu) 38050000 immediate 38060000 end-exec 38070000 . 38080000 dialogue-interdit-exit. exit. 38090000 *----------------------------------------------------------------*38100000 * controles de la saisie de l'ecran *38110000 *----------------------------------------------------------------*38120000 operation-controle. 38130000 * Initialisations 38140000 set controle-saisie-ok to true 38150000 move space to lmessago 38160000 move space to smesapp-commarea 38170000 * Controles 38180000 perform varying ctr-cpt from 1 by 1 38190000 until ctr-cpt > 15 38200000 or controle-saisie-ko 38210000 evaluate csellisi(ctr-cpt) 38220000 when 'V' 38230000 continue 38240000 when space 38250000 continue 38260000 when low-value 38270000 continue 38280000 when '*' 38290000 continue 38300000 when other 38310000 set controle-saisie-ko to true 38320000 end-evaluate 38330000 end-perform 38340000 38350000 * Gestion erreur de saisie 38360000 if controle-saisie-ko then 38370000 subtract 1 from ctr-cpt 38380000 move curseur to csellisl(ctr-cpt) 38390000 move dfhunimd to csellisa(ctr-cpt) 38400000 move '050E' to smesapp-cmesapp 38410000 perform recherche-message 38420000 else 38430000 perform 400-aiguilleur 38440000 end-if 38450000 . 38460000 operation-controle-exit. exit. 38470000 *----------------------------------------------------------------*38480000 * effacement de la saisie *38490000 *----------------------------------------------------------------*38500000 operation-effacement. 38510000 * *--------------------------------*38520000 * * effacement des champs *38530000 * *--------------------------------*38540000 perform 560-vide-colonne-sel 38550000 * *--------------------------------*38560000 * * mise en place curseur *38570000 * *--------------------------------*38580000 move curseur to csellisl(1) 38590000 * *--------------------------------*38600000 * * initialisation message *38610000 * *--------------------------------*38620000 move space to smesapp-commarea 38630000 move '001I' to smesapp-cmesapp 38640000 perform recherche-message 38650000 . 38660000 operation-effacement-exit. exit. 38670000 *----------------------------------------------------------------*38680000 * demande de retour … l'‚cran pr‚c‚dent *38690000 *----------------------------------------------------------------*38700000 operation-ecran-prec. 38710000 perform 560-vide-colonne-sel 38720000 evaluate cag-ecran 38730000 when 0 38740000 move 'PBQEG00 ' to nom-programme 38750000 when 2 38760000 move 'PBQEG21 ' to nom-programme 38770000 when other 38780000 continue 38790000 end-evaluate 38800000 exec cics xctl program(nom-programme) 38810000 commarea(zone-commarea) 38820000 length(length of 38830000 zone-commarea) 38840000 end-exec 38850000 . 38860000 operation-ecran-prec-exit. exit. 38870000 *----------------------------------------------------------------*38880000 * demande de retour au menu *38890000 *----------------------------------------------------------------*38900000 operation-retour-menu. 38910000 exec cics xctl program(nom-programme) 38920000 commarea(zone-commarea) 38930000 length(length of 38940000 zone-commarea) 38950000 end-exec 38960000 . 38970000 operation-retour-menu-exit. exit. 38980000 *----------------------------------------------------------------*38990000 * demande de passage a la page pr‚c‚dente *39000000 *----------------------------------------------------------------*39010000 operation-page-prec. 39020000 perform initialisation-ts 39030000 perform 560-vide-colonne-sel 39040000 move cal-first-cpt to cle 39050000 perform 520-remplissage-arriere 39060000 move cnumcpto(ctr-cpt) to cal-first-cpt 39070000 move cnumcpto(15) to cal-last-cpt 39080000 if ctr-cpt not equal to 1 then 39090000 perform operation-premiere-page 39100000 end-if 39110000 move curseur to csellisl(1) 39120000 . 39130000 operation-page-prec-exit. exit. 39140000 *----------------------------------------------------------------*39150000 * demande de passage a la page suivante *39160000 *----------------------------------------------------------------*39170000 operation-page-suiv. 39180000 perform initialisation-ts 39190000 perform 560-vide-colonne-sel 39200000 move cal-last-cpt to cle 39210000 add 1 to cle 39220000 perform 500-remplissage-avant 39230000 move cnumcpto(1) to cal-first-cpt 39240000 move cnumcpto(ctr-cpt) to cal-last-cpt 39250000 move curseur to csellisl(1) 39260000 . 39270000 operation-page-suiv-exit. exit. 39280000 *----------------------------------------------------------------*39290000 * demande de passage a la premiŠre page *39300000 *----------------------------------------------------------------*39310000 operation-premiere-page. 39320000 perform initialisation-ts 39330000 perform 560-vide-colonne-sel 39340000 move zero to cle 39350000 perform 500-remplissage-avant 39360000 move cnumcpto(1) to cal-first-cpt 39370000 move cnumcpto(ctr-cpt) to cal-last-cpt 39380000 move curseur to csellisl(1) 39390000 . 39400000 operation-premiere-page-exit. exit. 39410000 *----------------------------------------------------------------*39420000 * demande de passage a la derniŠre page *39430000 *----------------------------------------------------------------*39440000 operation-derniere-page. 39450000 perform initialisation-ts 39460000 perform 560-vide-colonne-sel 39470000 move high-value to cle-x 39480000 perform 520-remplissage-arriere 39490000 move cnumcpto(ctr-cpt) to cal-first-cpt 39500000 move cnumcpto(15) to cal-last-cpt 39510000 move curseur to csellisl(1) 39520000 . 39530000 operation-derniere-page-exit. exit. 39540000 *----------------------------------------------------------------*39550000 * touche fonction inactive *39560000 *----------------------------------------------------------------*39570000 operation-imprevue. 39580000 * *--------------------------------*39590000 * message : 099E * initialisation message *39600000 * *--------------------------------*39610000 move space to smesapp-commarea 39620000 move curseur to csellisl(1) 39630000 move '099E' to smesapp-cmesapp 39640000 perform recherche-message 39650000 . 39660000 operation-imprevue-exit. exit. 39670000 *================================================================*39680000 * controle de la saisie de l'ecran mbqe000 *39690000 * *39700000 * donnees en entree : champs input de l'ecran *39710000 * donnees en sortie : champs output de l'ecran *39720000 * booleen controle saisie : ok ou ko *39730000 * libelle message *39740000 *================================================================*39750000 controle-saisie-champs. 39760000 * *--------------------------------*39770000 * * initialisations : *39780000 * * - effacement du message *39790000 * * - zone de communication *39800000 * * module smesapp (message) *39810000 * *--------------------------------*39820000 move space to lmessago 39830000 move space to smesapp-commarea 39840000 * *-------------------------------------------------*39850000 * * arret des controles de saisie *39860000 * *-------------------------------------------------*39870000 . 39880000 controle-saisie-champs-stop. 39890000 * *--------------------------------*39900000 * * controle saisie ok *39910000 * *--------------------------------*39920000 if smesapp-cmesapp = space 39930000 set controle-saisie-ok to true 39940000 * *--------------------------------*39950000 * * saisie invalide *39960000 * *--------------------------------*39970000 else 39980000 set controle-saisie-ko to true 39990000 perform recherche-message 40000000 end-if 40010000 . 40020000 controle-saisie-champs-exit. exit. 40030000 * 40040000 *================================================================*40050000 * *40060000 * modules generalises *40070000 * *40080000 *================================================================*40090000 * 40100000 *----------------------------------------------------------------*40110000 * *40120000 * preparation des champs de l'entete ecran *40130000 * *40140000 *----------------------------------------------------------------*40150000 entete-map. 40160000 * *--------------------------------*40170000 * * champs affiches en permanence *40180000 * * - code transaction systeme *40190000 * * - code terminal logique *40200000 * * - date tache aa.qqq *40210000 * * - heure tache hh:mm:ss *40220000 * *--------------------------------*40230000 move eibtrnid to ctrnsyso 40240000 * 40250000 move eibtrmid to ctrmlogo 40260000 * 40270000 move eibdate to date-decomp 40280000 move date-decomp(1:2) to edition-date(1:2) 40290000 move date-decomp(3:3) to edition-date(4:3) 40300000 move edition-date to dtacsyso 40310000 * 40320000 move eibtime to heure-decomp 40330000 move heure-decomp(1:2) to edition-heure(1:2) 40340000 move heure-decomp(3:2) to edition-heure(4:2) 40350000 move heure-decomp(5:2) to edition-heure(7:2) 40360000 move edition-heure to htacsyso 40370000 * 40380000 . 40390000 entete-map-exit. exit. 40400000 *----------------------------------------------------------------*40410000 * *40420000 * preparation des touches fonction actives *40430000 * *40440000 *----------------------------------------------------------------*40450000 touches-fonction. 40460000 * *--------------------------------*40470000 * * code et libelle touche *40480000 * *--------------------------------*40490000 move 'Ent' to d2201o 40500000 move 'Contr“le saisie' to d2205o 40510000 * 40520000 move 'F2 ' to d2221o 40530000 move 'Efface saisie ' to d2225o 40540000 * 40550000 move 'F3 ' to d2241o 40560000 move 'Ecran pr‚c‚dent' to d2245o 40570000 * 40580000 move 'F4 ' to d2261o 40590000 move 'Retour menu ' to d2265o 40600000 * 40610000 move 'F7 ' to d2301o 40620000 move 'Page pr‚c‚dente' to d2305o 40630000 * 40640000 move 'F8 ' to d2321o 40650000 move 'Page suivante ' to d2325o 40660000 * 40670000 move 'F9 ' to d2341o 40680000 move 'PremiŠre page ' to d2345o 40690000 * 40700000 move 'F10' to d2361o 40710000 move 'DerniŠre page ' to d2365o 40720000 . 40730000 touches-fonction-exit. exit. 40740000 *----------------------------------------------------------------*40750000 * preparation des attributs initiaux *40760000 *----------------------------------------------------------------*40770000 initialisation-attributs. 40780000 * *--------------------------------*40790000 * * attributs fset *40800000 * *--------------------------------*40810000 perform varying ctr-cpt from 1 by 1 40820000 until ctr-cpt > 15 40830000 move dfhbmfse to csellisa(ctr-cpt) 40840000 move dfhbmasf to cnumcpta(ctr-cpt) 40850000 end-perform 40860000 . 40870000 initialisation-attributs-exit. exit. 40880000 *----------------------------------------------------------------*40890000 * preparation de la ts *40900000 *----------------------------------------------------------------*40910000 initialisation-ts. 40920000 PERFORM 660-DELETE-TS 40930000 initialize zone-ts 40940000 move 'V' to ts-statut 40950000 perform varying ctr-cpt from 1 by 1 40960000 until ctr-cpt > 15 40970000 perform 640-create-ts 40980000 end-perform 40990000 . 41000000 initialisation-ts-exit. exit. 41010000 *----------------------------------------------------------------*41020000 * recherche d'un message ecran sur fmesapp *41030000 *----------------------------------------------------------------*41040000 recherche-message. 41050000 * *--------------------------------*41060000 * * recherche et habillage message *41070000 * *--------------------------------*41080000 if smesapp-cappinf = space 41090000 move code-application to smesapp-cappinf 41100000 end-if 41110000 * 41120000 exec cics link program ('SMESAPP') 41130000 commarea (smesapp-commarea) 41140000 length (length of 41150000 smesapp-commarea) 41160000 end-exec 41170000 * *--------------------------------*41180000 * * affichage du message. *41190000 * *--------------------------------*41200000 move smesapp-lmessag to lmessago 41210000 . 41220000 recherche-message-exit. exit. 41230000 *----------------------------------------------------------------*41240000 * *41250000 * recherche d'un parametre de saisie sur fpargen *41260000 * *41270000 *----------------------------------------------------------------*41280000 recherche-parametre. 41290000 * *--------------------------------*41300000 * * recherche parametre *41310000 * *--------------------------------*41320000 exec cics link program ('SPARGEN') 41330000 commarea (spargen-commarea) 41340000 length (length of 41350000 spargen-commarea) 41360000 end-exec 41370000 . 41380000 recherche-message-exit. exit. 41390000 *----------------------------------------------------------------*41400000 * *41410000 * controle et cadrage d'une zone numerique *41420000 * *41430000 *----------------------------------------------------------------*41440000 cadrage-numerique. 41450000 * *--------------------------------*41460000 * * cadrage de la zone numerique *41470000 * *--------------------------------*41480000 call 'SCADNUM' using scadnumc-commarea 41490000 * *--------------------------------*41500000 * * message d'erreur *41510000 * *--------------------------------*41520000 if scadnumc-cmesapp not = zero 41530000 move 'GEN' to smesapp-cappinf 41540000 move scadnumc-cmesapp to smesapp-cmesapp 41550000 move scadnumc-cparam1 to smesapp-cparam1 41560000 end-if 41570000 . 41580000 cadrage-numerique-exit. exit. 41590000 * 41600000 *================================================================*41610000 * *41620000 * modules de gestion cics *41630000 * *41640000 *================================================================*41650000 * 41660000 *----------------------------------------------------------------*41670000 * *41680000 * emission de la map physique + logique *41690000 * *41700000 *----------------------------------------------------------------*41710000 emission-map-complete. 41720000 * *--------------------------------*41730000 * * emission map physique + logique*41740000 * *--------------------------------*41750000 exec cics send map (nom-map) 41760000 mapset (nom-mapset) 41770000 from (zone-map) 41780000 erase 41790000 cursor 41800000 end-exec 41810000 . 41820000 emission-map-complete-exit. exit. 41830000 *----------------------------------------------------------------*41840000 * *41850000 * emission de la map logique uniquement *41860000 * *41870000 *----------------------------------------------------------------*41880000 emission-map-logique. 41890000 * *--------------------------------*41900000 * * emission map logique *41910000 * *--------------------------------*41920000 exec cics send map (nom-map) 41930000 mapset (nom-mapset) 41940000 from (zone-map) 41950000 dataonly 41960000 cursor 41970000 end-exec 41980000 . 41990000 emission-map-logique-exit. exit. 42000000 *----------------------------------------------------------------*42010000 * *42020000 * reception de la map logique *42030000 * *42040000 *----------------------------------------------------------------*42050000 reception-map. 42060000 * *--------------------------------*42070000 * * reception saisie utilisateur *42080000 * *--------------------------------*42090000 move low-value to zone-map 42100000 * 42110000 exec cics receive map (nom-map) 42120000 mapset (nom-mapset) 42130000 into (zone-map) 42140000 nohandle 42150000 end-exec 42160000 . 42170000 reception-map-exit. exit. 42180000 *----------------------------------------------------------------*42190000 * emission d'un message non formate *42200000 *----------------------------------------------------------------*42210000 emission-message. 42220000 * *--------------------------------*42230000 * * emission selon controle *42240000 * *--------------------------------*42250000 exec cics send from (texte-message) 42260000 length (length of 42270000 texte-message) 42280000 erase 42290000 end-exec 42300000 . 42310000 emission-message-exit. exit. 42320000 *----------------------------------------------------------------*42330000 * liberation totale de la partition *42340000 *----------------------------------------------------------------*42350000 liberation-totale. 42360000 * *--------------------------------*42370000 * * retour definitif cics *42380000 * *--------------------------------*42390000 exec cics return 42400000 end-exec 42410000 . 42420000 liberation-totale-exit. exit. 42430000 *----------------------------------------------------------------*42440000 * liberation partielle de la partition *42450000 *----------------------------------------------------------------*42460000 liberation-partielle. 42470000 * *--------------------------------*42480000 * * retour temporaire cics *42490000 * *--------------------------------*42500000 exec cics return transid (code-transaction) 42510000 commarea (zone-commarea) 42520000 length (length of 42530000 zone-commarea) 42540000 end-exec 42550000 . 42560000 liberation-partielle-exit. exit. 42570000 ******************************************************************42580000 **** FIN DES MODULES ****42590000 ******************************************************************42600000 **** 42610000 ** Aiguillage 42620000 **** 42630000 400-AIGUILLEUR. 42640000 * Memorisations 42650000 move cnumcpto(1) to cag-first-cnumcpt 42660000 perform varying ctr-cpt from 1 by 1 42670000 until ctr-cpt > 15 42680000 move csellisi(ctr-cpt) to cag-sel(ctr-cpt) 42690000 end-perform 42700000 * Envoi 42710000 perform varying ctr-cpt from 1 by 1 42720000 until ctr-cpt > 15 42730000 if cag-sel(ctr-cpt) = 'V' then 42740000 move cnumcpto(ctr-cpt) to cag-cnumcpt 42750000 perform 410-visualisation 42760000 end-if 42770000 end-perform 42780000 . 42790000 **** 42800000 ** Visualisation 42810000 **** 42820000 410-VISUALISATION. 42830000 move 'PBQEG21 ' to nom-programme 42840000 move 4 to cag-ecran 42850000 exec cics xctl program(nom-programme) 42860000 commarea(zone-commarea) 42870000 length(length of 42880000 zone-commarea) 42890000 end-exec 42900000 42910000 . 42920000 **** 42930000 ** REMPLISSAGE AVANT 42940000 **** 42950000 500-REMPLISSAGE-AVANT. 42960000 perform 540-vide-tableau 42970000 move 2 to ctr-cpt 42980000 move cle to ccptpri of fcompte 42990000 perform 600-start-br 43000000 if code-retour = dfhresp(normal) then 43010000 perform 630-read-next 43020000 perform varying ctr-cpt from 1 by 1 43030000 until ctr-cpt > 15 43040000 or code-retour = dfhresp(endfile) 43050000 * Gestion de la ts 43060000 move 'P' to zone-ts 43070000 move fcompte to zone-ts 43080000 move ctr-cpt to indice-ts 43090000 perform 670-rewrite-ts 43100000 * Gestion de la colonne selection 43110000 move dfhbmfse to csellisa(ctr-cpt) 43120000 * Gestion du tableau 43130000 move cnumcpt of fcompte to cnumcpto(ctr-cpt) 43140000 move cclerib of fcompte to ccleribo(ctr-cpt) 43150000 move cnumide of fcompte to cnumideo(ctr-cpt) 43160000 move lintcpt of fcompte to lintcpto(ctr-cpt) 43170000 move ctypcpt of fcompte to ctypcpto(ctr-cpt) 43180000 * move msolcpt of fcompte to msolcpto(ctr-cpt) 43190000 * move dderrel of fcompte to dderrelo(ctr-cpt) 43200000 perform 630-read-next 43210000 end-perform 43220000 perform 610-end-br 43230000 end-if 43240000 subtract 1 from ctr-cpt 43250000 . 43260000 **** 43270000 ** REMPLISSAGE ARRIERE 43280000 **** 43290000 520-REMPLISSAGE-ARRIERE. 43300000 perform 540-vide-tableau 43310000 move 0 to ctr-cpt 43320000 move cle to ccptpri of fcompte 43330000 perform 600-start-br 43340000 if code-retour = dfhresp(normal) 43350000 perform 620-read-prev 43360000 perform 620-read-prev 43370000 perform varying ctr-cpt from 15 by -1 43380000 until ctr-cpt < 1 43390000 or code-retour = dfhresp(endfile) 43400000 * Gestion de la ts 43410000 move 'P' to zone-ts 43420000 move fcompte to zone-ts 43430000 move ctr-cpt to indice-ts 43440000 perform 670-rewrite-ts 43450000 * Gestion de la colonne selection 43460000 move dfhbmfse to csellisa(ctr-cpt) 43470000 * Gestion du tableau 43480000 move cnumcpt of fcompte to cnumcpto(ctr-cpt) 43490000 move cclerib of fcompte to ccleribo(ctr-cpt) 43500000 move cnumide of fcompte to cnumideo(ctr-cpt) 43510000 move lintcpt of fcompte to lintcpto(ctr-cpt) 43520000 move ctypcpt of fcompte to ctypcpto(ctr-cpt) 43530000 * move msolcpt of fcompte to msolcpto(ctr-cpt) 43540000 * move dderrel of fcompte to dderrelo(ctr-cpt) 43550000 perform 620-read-prev 43560000 end-perform 43570000 perform 610-end-br 43580000 end-if 43590000 add 1 to ctr-cpt 43600000 . 43610000 **** 43620000 ** VIDANGE DU TABLEAU 43630000 **** 43640000 540-VIDE-TABLEAU. 43650000 perform varying ctr-cpt from 1 by 1 43660000 until ctr-cpt > 15 43670000 move dfhbmasf to csellisa(ctr-cpt) 43680000 move space to cnumcpto(ctr-cpt) 43690000 move space to ccleribo(ctr-cpt) 43700000 move space to cnumideo(ctr-cpt) 43710000 move space to lintcpto(ctr-cpt) 43720000 move space to ctypcpto(ctr-cpt) 43730000 * move msolcpt to msolcpto(ctr-cpt) 43740000 * move dderrel to dderrelo(ctr-cpt) 43750000 end-perform 43760000 . 43770000 **** 43780000 ** REMPLISSAGE DEPUIS TS 43790000 **** 43800000 560-REMPLISSAGE-TS. 43810000 perform 540-vide-tableau 43820000 move 1 to indice-ts 43830000 perform 650-read-ts 43840000 perform varying ctr-cpt from 1 by 1 43850000 until ctr-cpt > 15 43860000 or ts-statut = 'V' 43870000 * Gestion de la colonne selection 43880000 move dfhbmfse to csellisa(ctr-cpt) 43890000 * Gestion du tableau 43900000 move cnumcpt of zone-ts to cnumcpto(ctr-cpt) 43910000 move cclerib of zone-ts to ccleribo(ctr-cpt) 43920000 move cnumide of zone-ts to cnumideo(ctr-cpt) 43930000 move lintcpt of zone-ts to lintcpto(ctr-cpt) 43940000 move ctypcpt of zone-ts to ctypcpto(ctr-cpt) 43950000 * move msolcpt of zone-ts to msolcpto(ctr-cpt) 43960000 * move dderrel of zone-ts to dderrelo(ctr-cpt) 43970000 move ctr-cpt to indice-ts 43980000 perform 650-read-ts 43990000 end-perform 44000000 subtract 1 from ctr-cpt 44010000 . 44020000 **** 44030000 ** VIDANGE DE LA COLONNE SELECTIONNEE 44040000 **** 44050000 560-VIDE-COLONNE-SEL. 44060000 perform varying ctr-cpt from 1 by 1 44070000 until ctr-cpt > 15 44080000 move space to cselliso(ctr-cpt) 44090000 end-perform 44100000 . 44110000 **** 44120000 ** START BR 44130000 **** 44140000 600-START-BR. 44150000 EXEC CICS STARTBR FILE(FCOMPTE-FILE) 44160000 RIDFLD(CCPTPRI of fcompte) 44170000 RESP(CODE-RETOUR) 44180000 END-EXEC 44190000 EVALUATE CODE-RETOUR 44200000 WHEN DFHRESP(NORMAL) 44210000 CONTINUE 44220000 WHEN DFHRESP(NOTFND) 44230000 CONTINUE 44240000 WHEN OTHER 44250000 PERFORM 700-ABANDON-TRANSACTION 44260000 END-EVALUATE 44270000 . 44280000 **** 44290000 ** END BR 44300000 **** 44310000 610-END-BR. 44320000 EXEC CICS ENDBR FILE(FCOMPTE-FILE) 44330000 RESP(CODE-RETOUR) 44340000 END-EXEC 44350000 EVALUATE CODE-RETOUR 44360000 WHEN DFHRESP(NORMAL) 44370000 CONTINUE 44380000 WHEN OTHER 44390000 PERFORM 700-ABANDON-TRANSACTION 44400000 END-EVALUATE 44410000 . 44420000 **** 44430000 ** READPREV 44440000 **** 44450000 620-READ-PREV. 44460000 EXEC CICS READPREV FILE(FCOMPTE-FILE) 44470000 INTO(FCOMPTE) 44480000 RIDFLD(CCPTPRI of fcompte) 44490000 RESP(CODE-RETOUR) 44500000 END-EXEC 44510000 EVALUATE CODE-RETOUR 44520000 WHEN DFHRESP(NORMAL) 44530000 CONTINUE 44540000 WHEN DFHRESP(ENDFILE) 44550000 MOVE LOW-VALUE TO CCPTPRI of fcompte 44560000 WHEN OTHER 44570000 PERFORM 700-ABANDON-TRANSACTION 44580000 END-EVALUATE 44590000 . 44600000 **** 44610000 ** READ NEXT 44620000 **** 44630000 630-READ-NEXT. 44640000 EXEC CICS READNEXT FILE(FCOMPTE-FILE) 44650000 INTO(FCOMPTE) 44660000 RIDFLD(CCPTPRI of fcompte) 44670000 RESP(CODE-RETOUR) 44680000 END-EXEC 44690000 EVALUATE CODE-RETOUR 44700000 WHEN DFHRESP(NORMAL) 44710000 CONTINUE 44720000 WHEN DFHRESP(ENDFILE) 44730000 MOVE HIGH-VALUE TO CCPTPRI of fcompte 44740000 WHEN OTHER 44750000 PERFORM 700-ABANDON-TRANSACTION 44760000 END-EVALUATE 44770000 . 44780000 **** 44790000 ** CREATE TS 44800000 **** 44810000 640-CREATE-TS. 44820000 MOVE EIBTRMID TO NOM-TS(1:4) 44830000 MOVE 'LIST' TO NOM-TS(5:4) 44840000 EXEC CICS WRITEQ TS QUEUE(NOM-TS) 44850000 FROM(ZONE-TS) 44860000 LENGTH(LENGTH OF ZONE-TS) 44870000 RESP(CODE-RETOUR) 44880000 END-EXEC 44890000 EVALUATE CODE-RETOUR 44900000 WHEN DFHRESP(NORMAL) 44910000 CONTINUE 44920000 WHEN OTHER 44930000 PERFORM 700-ABANDON-TRANSACTION 44940000 END-EVALUATE 44950000 . 44960000 **** 44970000 ** READ TS 44980000 **** 44990000 650-READ-TS. 45000000 MOVE EIBTRMID TO NOM-TS(1:4) 45010000 MOVE 'LIST' TO NOM-TS(5:4) 45020000 EXEC CICS READQ TS QUEUE(NOM-TS) 45030000 INTO(ZONE-TS) 45040000 LENGTH(LENGTH OF ZONE-TS) 45050000 ITEM(INDICE-TS) 45060000 RESP(CODE-RETOUR) 45070000 END-EXEC 45080000 EVALUATE CODE-RETOUR 45090000 WHEN DFHRESP(NORMAL) 45100000 CONTINUE 45110000 WHEN OTHER 45120000 PERFORM 700-ABANDON-TRANSACTION 45130000 END-EVALUATE 45140000 . 45150000 **** 45160000 ** REWRITE TS 45170000 **** 45180000 670-REWRITE-TS. 45190000 MOVE EIBTRMID TO NOM-TS(1:4) 45200000 MOVE 'LIST' TO NOM-TS(5:4) 45210000 EXEC CICS WRITEQ TS QUEUE(NOM-TS) 45220000 FROM(ZONE-TS) 45230000 LENGTH(LENGTH OF ZONE-TS) 45240000 ITEM(INDICE-TS) REWRITE 45250000 RESP(CODE-RETOUR) 45260000 END-EXEC 45270000 EVALUATE CODE-RETOUR 45280000 WHEN DFHRESP(NORMAL) 45290000 CONTINUE 45300000 WHEN OTHER 45310000 PERFORM 700-ABANDON-TRANSACTION 45320000 END-EVALUATE 45330000 . 45340000 **** 45350000 ** DELETE TS 45360000 **** 45370000 660-DELETE-TS. 45380000 MOVE EIBTRMID TO NOM-TS(1:4) 45390000 MOVE 'LIST' TO NOM-TS(5:4) 45400000 EXEC CICS DELETEQ TS QUEUE(NOM-TS) 45410000 RESP(CODE-RETOUR) 45420000 END-EXEC 45430000 EVALUATE CODE-RETOUR 45440000 WHEN DFHRESP(NORMAL) 45450000 CONTINUE 45460000 WHEN DFHRESP(QIDERR) 45470000 CONTINUE 45480000 WHEN OTHER 45490000 PERFORM 700-ABANDON-TRANSACTION 45500000 END-EVALUATE 45510000 . 45520000 **** 45530000 ** ABANDON TRANSACTION 45540000 **** 45550000 700-ABANDON-TRANSACTION. 45560000 * *--------------------------------*45570000 * message : 097E * initialisation message *45580000 * *--------------------------------*45590000 move space to smesapp-commarea 45600000 move '097E' to smesapp-cmesapp 45610000 move code-application to smesapp-cparam1 45620000 perform recherche-message 45630000 move lmessago to texte-message 45640000 * *--------------------------------*45650000 * * envoi message non formate *45660000 * *--------------------------------*45670000 perform emission-message 45680000 * *--------------------------------*45690000 * * liberation totale *45700000 * *--------------------------------*45710000 perform liberation-totale 45720000 45730000 . 45740000