000100 IDENTIFICATION DIVISION. 00010000 000200 PROGRAM-ID. COBTP215. 00020000 000300 00030000 000400 ENVIRONMENT DIVISION. 00040000 000500 CONFIGURATION SECTION. 00050000 000600 INPUT-OUTPUT SECTION. 00060000 000700 FILE-CONTROL. 00070000 000800 SELECT FIC-CPT ASSIGN TO CPT 00080000 000900 ORGANIZATION INDEXED 00090000 001000 ACCESS MODE DYNAMIC 00100000 001100 RECORD KEY CLE-CPT 00110000 001200 ALTERNATE RECORD KEY IS NOM-CLIENT-CPT WITH DUPLICATES 00120000 001300 FILE STATUS FS-CPT. 00130000 001400 SELECT FIC-ETAT ASSIGN TO ETAT. 00140000 001500 DATA DIVISION. 00150000 001600**** 00160000 001700** FILE SECTION 00170000 001800**** 00180000 001900 FILE SECTION. 00190000 002000 FD FIC-CPT. 00200000 002100 01 ENREG-CPT. 00210000 002200 05 CLE-CPT. 00220000 002300 10 NUM-CPT-CPT PIC 9(10). 00230000 002400 05 NOM-CLIENT-CPT PIC X(20). 00240000 002500 05 DATE-CREATION-CPT. 00250000 002600 10 AA PIC XX. 00260000 002700 10 MM PIC XX. 00270000 002800 10 JJ PIC XX. 00280000 002900 05 SOLDE-CPT PIC S9(07)V99 COMP-3. 00290000 003000 05 DATE-MAJ-CPT. 00300000 003100 10 AA PIC XX. 00310000 003200 10 MM PIC XX. 00320000 003300 10 JJ PIC XX. 00330000 003400 05 FILLER PIC X(3). 00340000 003500 FD FIC-ETAT. 00350000 003600 01 ENREG-ETAT PIC X(80). 00360000 003700**** 00370000 003800** WORKING-STORAGE SECTION 00380000 003900**** 00390000 004000 WORKING-STORAGE SECTION. 00400000 004100 01 INDICATEURS-DE-RUPTURE. 00410000 004200 05 EOF-CARTE PIC X VALUE 'N'. 00420000 004300 05 FIN-LISTE PIC X VALUE 'N'. 00430000 004400 01 COMPTEURS. 00440000 004500 05 CTR-DEMANDE PIC 999 COMP-3. 00450000 004600 05 CTR-DEMANDE-A PIC 999 COMP-3. 00460000 004700 05 CTR-DEMANDE-B PIC 999 COMP-3. 00470000 004800 01 CODE-RETOUR-FICHIER. 00480000 004900 05 FS-CPT PIC XX. 00490000 005000 88 FS-CPT-NORMAL VALUE '00'. 00500000 005100 88 FS-CPT-DUPKEY VALUE '02'. 00510000 005200 88 FS-CPT-ENDFILE VALUE '10'. 00520000 005300 88 FS-CPT-NOTFND VALUE '23'. 00530000 005400 88 FS-CPT-DUPREC VALUE '22'. 00540000 005500 01 CARTE. 00550000 005600 05 TYPE-DEMANDE PIC X(1). 00560000 005700 05 FILLER PIC X(79). 00570000 005800 01 DEMANDE-A. 00580000 005900 05 TYPE-DEMANDE-A PIC X(1). 00590000 006000 05 NOM-DEMANDE-A PIC X(20). 00600000 006100 05 DEBUT-DEMANDE-A PIC 9(10). 00610000 006200 05 FIN-DEMANDE-A PIC 9(10). 00620000 006300 05 FILLER PIC X(39). 00630000 006400 01 DEMANDE-B. 00640000 006500 05 TYPE-DEMANDE-B PIC X(1). 00650000 006600 05 NOM-DEMANDE-B PIC X(20). 00660000 006700 05 DEBUT-DEMANDE-B PIC X(20). 00670000 006800 05 FIN-DEMANDE-B PIC X(20). 00680000 006900 05 FILLER PIC X(19). 00690000 007000 01 DONNEES-TEMPORELLES. 00700000 007100 05 DATE-SYSTEME. 00710000 007200 10 AA PIC X(2). 00720000 007300 10 MM PIC X(2). 00730000 007400 10 JJ PIC X(2). 00740000 007500 05 DATE-TRAITEMENT. 00750000 007600 10 JJ PIC X(2)/. 00760000 007700 10 MM PIC X(2)/. 00770000 007800 10 AA PIC X(2). 00780000 007900 05 DATE-COMPILATION PIC X(16). 00790000 008000 05 HEURE-SYSTEME. 00800000 008100 10 HH PIC X(2). 00810000 008200 10 MN PIC X(2). 00820000 008300 10 SS PIC X(2). 00830000 008400 10 CC PIC X(2). 00840000 008500 05 HEURE-TRAITEMENT. 00850000 008600 10 HH PIC X(2). 00860000 008700 10 PIC X VALUE ':'. 00870000 008800 10 MN PIC X(2). 00880000 008900 10 PIC X VALUE ':'. 00890000 009000 10 SS PIC X(2). 00900000 009100 10 PIC X VALUE '.'. 00910000 009200 10 CC PIC X(2). 00920000 009300* FIC-ETAT 00930000 009400 01 LIGNE-PAGE. 00940000 009500 05 FILLER PIC X(11) VALUE 'EDITION DU '. 00950000 009600 05 EDITION-DATE-TRAITEMENT PIC XX/XX/XX. 00960000 009700 05 FILLER PIC X(51) VALUE SPACE. 00970000 009800 05 FILLER PIC X(7) VALUE 'PAGE : '. 00980000 009900 05 EDITION-NUM-PAGE PIC ZZ9. 00990000 010000 01 LIGNE-DEMANDEUR. 01000000 010100 05 FILLER PIC X(12) VALUE 'DEMANDEUR : '. 01010000 010200 05 EDITION-NOM-DEMANDEUR PIC X(20). 01020000 010300 05 FILLER PIC X(4) VALUE SPACE. 01030000 010400 05 FILLER PIC X(14) VALUE 'NUM DEMANDE : '. 01040000 010500 05 EDITION-NUM-DEMANDE PIC ZZ9. 01050000 010600 05 FILLER PIC X(27) VALUE SPACE. 01060000 010700 01 LIGNE-TYPE. 01070000 010800 05 FILLER PIC X(20) VALUE SPACE. 01080000 010900 05 FILLER PIC X(22) VALUE 'LISTE DES COMPTES PAR '. 01090000 011000 05 EDITION-TYPE PIC X(06). 01100000 011100 05 FILLER PIC X(32) VALUE SPACE. 01110000 011200 01 LIGNE-REF-DEBUT. 01120000 011300 05 EDITION-TYPE-REF-DEBUT PIC X(18) VALUE 'REFERENCE01130000 011400- 'DEBUT : '. 01140000 011500 05 EDITION-REF-DEBUT PIC X(20). 01150000 011600 05 FILLER PIC X(42) VALUE SPACE. 01160000 011700 01 LIGNE-REF-FIN. 01170000 011800 05 EDITION-TYPE-REF-FIN PIC X(18) VALUE 'REFERENCE01180000 011900- 'FIN : '. 01190000 012000 05 EDITION-REF-FIN PIC X(20). 01200000 012100 05 FILLER PIC X(42) VALUE SPACE. 01210000 012200 01 LIGNE-TITRES. 01220000 012300 05 FILLER PIC X(16) VALUE 'NUMERO COMPTE '. 01230000 012400 05 FILLER PIC X(16) VALUE ' CREATION '. 01240000 012500 05 FILLER PIC X(16) VALUE ' M-A-J '. 01250000 012600 05 FILLER PIC X(16) VALUE ' SOLDE '. 01260000 012700 05 FILLER PIC X(16) VALUE ' NOM CLIENT '. 01270000 012800 01 LIGNE-VIDE. 01280000 012900 05 FILLER PIC X(80) VALUE SPACE. 01290000 013000 01 LIGNE-COMPTE. 01300000 013100 05 FILLER PIC X(5) VALUE SPACE. 01310000 013200 05 EDITION-NUM-CPT PIC 9(10). 01320000 013300 05 FILLER PIC X(3) VALUE SPACE. 01330000 013400 05 EDITION-DATE-CREATION. 01340000 013500 10 JJ PIC XX/. 01350000 013600 10 MM PIC XX/. 01360000 013700 10 AA PIC XX. 01370000 013800 05 FILLER PIC X(2) VALUE SPACE. 01380000 013900 05 EDITION-DATE-MAJ. 01390000 014000 10 JJ PIC XX/. 01400000 014100 10 MM PIC XX/. 01410000 014200 10 AA PIC XX. 01420000 014300 05 FILLER PIC X(3) VALUE SPACE. 01430000 014400 05 EDITION-SOLDE PIC +ZBZZZBZZ9V,99. 01440000 014500 05 FILLER PIC X(2) VALUE SPACE. 01450000 014600 05 EDITION-NOM-CLIENT PIC X(20). 01460000 014700 05 FILLER PIC X(6) VALUE SPACE. 01470000 014800 PROCEDURE DIVISION. 01480000 014900 01490000 015000 01500000 015100**** 01510000 015200** PROGRAMME 01520000 015300**** 01530000 015400 000-PROGRAMME. 01540000 015500 PERFORM 010-INITIALISATION-PROGRAMME 01550000 015600 PERFORM 520-LECTURE-CARTE 01560000 015700 PERFORM 100-DEMANDE 01570000 015800 UNTIL EOF-CARTE = 'O' 01580000 015900 PERFORM 020-TERMINAISON-PROGRAMME 01590000 016000 STOP RUN 01600000 016100 . 01610000 016200 01620000 016300**** 01630000 016400** INITIALISATION-PROGRAMME 01640000 016500**** 01650000 016600 010-INITIALISATION-PROGRAMME. 01660000 016700* DATES DE DEBUT DE TRAITEMENT ET DE COMPILATION 01670000 016800 PERFORM 500-LIRE-INFOS-SYSTEME 01680000 016900 DISPLAY 'PGM COBTP214 DEBUT TRAITEMENT : ' DATE-TRAITEMENT 01690000 017000 ' A ' HEURE-TRAITEMENT 01700000 017100 MOVE WHEN-COMPILED TO DATE-COMPILATION 01710000 017200 DISPLAY 'PGM COBTP214 VERSION COMPILEE : ' DATE-COMPILATION 01720000 017300* OUVERTURE DES FICHIERS 01730000 017400 OPEN OUTPUT FIC-ETAT 01740000 017500 PERFORM 600-OPEN-FICHIER-COMPTES 01750000 017600* INITIALISATIONS DIVERSES 01760000 017700 MOVE 'N' TO EOF-CARTE 01770000 017800 MOVE 0 TO RETURN-CODE 01780000 017900 MOVE DATE-TRAITEMENT TO EDITION-DATE-TRAITEMENT 01790000 018000* INITIALISATIONS COMPTEURS 01800000 018100 INITIALIZE COMPTEURS 01810000 018200 . 01820000 018300 01830000 018400**** 01840000 018500** TERMINAISON-PROGRAMME 01850000 018600**** 01860000 018700 020-TERMINAISON-PROGRAMME. 01870000 018800* DATE DE FIN DU TRAITEMENT 01880000 018900 PERFORM 500-LIRE-INFOS-SYSTEME 01890000 019000 DISPLAY 'PGM COBTP215 FIN NORMALE … : ' DATE-TRAITEMENT 01900000 019100 ' A ' HEURE-TRAITEMENT 01910000 019200 DISPLAY 'PGM COBTP215 CODE RETOUR POSTE : ' RETURN-CODE 01920000 019300* LOGS DIVERS 01930000 019400 DISPLAY ' ' CTR-DEMANDE ' DEMANDES TRAITEES' 01940000 019500 DISPLAY ' ' CTR-DEMANDE-A ' DEMANDES A ' 01950000 019600 DISPLAY ' ' CTR-DEMANDE-B ' DEMANDES B ' 01960000 019700* FERMETURE DES FICHIERS 01970000 019800 CLOSE FIC-ETAT 01980000 019900 CLOSE FIC-CPT 01990000 020000 . 02000000 020100 02010000 020200**** 02020000 020300** ABANDON-PROGRAMME 02030000 020400**** 02040000 020500 030-ABANDON-PROGRAMME. 02050000 020600 PERFORM 500-LIRE-INFOS-SYSTEME 02060000 020700 DISPLAY 'PGM COBTP215 FIN ANORMALE : ' DATE-TRAITEMENT 02070000 020800 ' A ' HEURE-TRAITEMENT 02080000 020900 DISPLAY 'PGM COBTP215 CODE RETOUR POST‚ … ' RETURN-CODE 02090000 021000* LOGS DIVERS 02100000 021100 DISPLAY ' ' CTR-DEMANDE ' DEMANDES TRAITEES' 02110000 021200 DISPLAY ' ' CTR-DEMANDE-A ' DEMANDES A ' 02120000 021300 DISPLAY ' ' CTR-DEMANDE-B ' DEMANDES B ' 02130000 021400 STOP RUN 02140000 021500 . 02150000 021600 02160000 021700**** 02170000 021800** DEMANDE 02180000 021900**** 02190000 022000 100-DEMANDE. 02200000 022100 ADD 1 TO CTR-DEMANDE 02210000 022200 EVALUATE TRUE 02220000 022300 WHEN TYPE-DEMANDE = 'A' PERFORM 120-DEMANDE-A 02230000 022400 WHEN TYPE-DEMANDE = 'B' PERFORM 140-DEMANDE-B 02240000 022500 WHEN OTHER CONTINUE 02250000 022600 END-EVALUATE 02260000 022700 PERFORM 520-LECTURE-CARTE 02270000 022800 . 02280000 022900 02290000 023000**** 02300000 023100** DEMANDE-A 02310000 023200**** 02320000 023300 120-DEMANDE-A. 02330000 023400 MOVE CARTE TO DEMANDE-A 02340000 023500 MOVE 'N' TO FIN-LISTE 02350000 023600 ADD 1 TO CTR-DEMANDE-A 02360000 023700* POUR EDITION 02370000 023800 MOVE NOM-DEMANDE-A TO EDITION-NOM-DEMANDEUR 02380000 023900 MOVE 'NUMERO' TO EDITION-TYPE 02390000 024000 MOVE DEBUT-DEMANDE-A TO EDITION-REF-DEBUT 02400000 024100 MOVE FIN-DEMANDE-A TO EDITION-REF-FIN 02410000 024200 02420000 024300 PERFORM 420-EDITION-DEMANDE 02430000 024400 MOVE DEBUT-DEMANDE-A TO NUM-CPT-CPT 02440000 024500 START FIC-CPT KEY IS >= CLE-CPT 02450000 024600 END-START 02460000 024700 PERFORM 640-TEST-START-KEY 02470000 024800 PERFORM 660-READ-NEXT 02480000 024900 PERFORM 200-COMPTE 02490000 025000 UNTIL FIN-LISTE = 'O' OR FIN-DEMANDE-A < NUM-CPT-CPT 02500000 025100 . 02510000 025200 02520000 025300**** 02530000 025400** DEMANDE-B 02540000 025500**** 02550000 025600 140-DEMANDE-B. 02560000 025700 MOVE CARTE TO DEMANDE-B 02570000 025800 MOVE 'N' TO FIN-LISTE 02580000 025900 ADD 1 TO CTR-DEMANDE-B 02590000 026000* POUR EDITION 02600000 026100 MOVE NOM-DEMANDE-B TO EDITION-NOM-DEMANDEUR 02610000 026200 MOVE 'NOM ' TO EDITION-TYPE 02620000 026300 MOVE DEBUT-DEMANDE-B TO EDITION-REF-DEBUT 02630000 026400 MOVE FIN-DEMANDE-B TO EDITION-REF-FIN 02640000 026500 02650000 026600 PERFORM 420-EDITION-DEMANDE 02660000 026700 MOVE DEBUT-DEMANDE-B TO NOM-CLIENT-CPT 02670000 026800 START FIC-CPT KEY IS >= NOM-CLIENT-CPT 02680000 026900 END-START 02690000 027000 PERFORM 640-TEST-START-KEY 02700000 027100 PERFORM 660-READ-NEXT 02710000 027200 PERFORM 200-COMPTE 02720000 027300 UNTIL FIN-LISTE = 'O' OR FIN-DEMANDE-B < NOM-CLIENT-CPT 02730000 027400 . 02740000 027500 02750000 027600**** 02760000 027700** COMPTE 02770000 027800**** 02780000 027900 200-COMPTE. 02790000 028000 PERFORM 400-EDITION-COMPTE 02800000 028100 PERFORM 660-READ-NEXT 02810000 028200 . 02820000 028300 02830000 028400**** 02840000 028500** EDITION-COMPTE 02850000 028600**** 02860000 028700 400-EDITION-COMPTE. 02870000 028800 MOVE NUM-CPT-CPT TO EDITION-NUM-CPT 02880000 028900 MOVE CORR DATE-CREATION-CPT TO EDITION-DATE-CREATION 02890000 029000 MOVE CORR DATE-MAJ-CPT TO EDITION-DATE-MAJ 02900000 029100 MOVE SOLDE-CPT TO EDITION-SOLDE 02910000 029200 MOVE NOM-CLIENT-CPT TO EDITION-NOM-CLIENT 02920000 029300 WRITE ENREG-ETAT FROM LIGNE-COMPTE 02930000 029400 . 02940000 029500 02950000 029600**** 02960000 029700** EDITION-DEMANDE 02970000 029800**** 02980000 029900 420-EDITION-DEMANDE. 02990000 030000 03000000 030100* LIGNE PAGE 03010000 030200 MOVE 0 TO EDITION-NUM-PAGE 03020000 030300 WRITE ENREG-ETAT FROM LIGNE-PAGE 03030000 030400 AFTER ADVANCING PAGE 03040000 030500* LIGNE DEMANDEUR 03050000 030600 MOVE CTR-DEMANDE TO EDITION-NUM-DEMANDE 03060000 030700 WRITE ENREG-ETAT FROM LIGNE-DEMANDEUR 03070000 030800 AFTER ADVANCING 2 LINES 03080000 030900* LIGNE TYPE 03090000 031000 WRITE ENREG-ETAT FROM LIGNE-TYPE 03100000 031100 AFTER ADVANCING 2 LINES 03110000 031200* LIGNE REFERENCE DEBUT 03120000 031300 WRITE ENREG-ETAT FROM LIGNE-REF-DEBUT 03130000 031400 AFTER ADVANCING 2 LINES 03140000 031500* LIGNE REFERENCE FIN 03150000 031600 WRITE ENREG-ETAT FROM LIGNE-REF-FIN 03160000 031700* LIGNE REFERENCE TITRES 03170000 031800 WRITE ENREG-ETAT FROM LIGNE-TITRES 03180000 031900 AFTER ADVANCING 2 LINES 03190000 032000 WRITE ENREG-ETAT FROM LIGNE-VIDE 03200000 032100 AFTER ADVANCING 2 LINES 03210000 032200 . 03220000 032300 03230000 032400**** 03240000 032500** LIRE-INFOS-SYSTEME 03250000 032600**** 03260000 032700 500-LIRE-INFOS-SYSTEME. 03270000 032800 ACCEPT DATE-SYSTEME FROM DATE 03280000 032900 MOVE CORR DATE-SYSTEME TO DATE-TRAITEMENT 03290000 033000 ACCEPT HEURE-SYSTEME FROM TIME 03300000 033100 MOVE CORR HEURE-SYSTEME TO HEURE-TRAITEMENT 03310000 033200 . 03320000 033300 03330000 033400**** 03340000 033500** LECTURE-CARTE : LIT SUR SYSIN 03350000 033600**** 03360000 033700 520-LECTURE-CARTE. 03370000 033800 MOVE HIGH-VALUE TO CARTE 03380000 033900 ACCEPT CARTE FROM SYSIN 03390000 034000 IF CARTE = HIGH-VALUE THEN 03400000 034100 MOVE 'O' TO EOF-CARTE 03410000 034200 ELSE 03420000 034300 CONTINUE 03430000 034400 END-IF 03440000 034500 . 03450000 034600 03460000 034700**** 03470000 034800** OPEN-FICHIER-COMPTES 03480000 034900**** 03490000 035000 600-OPEN-FICHIER-COMPTES. 03500000 035100 OPEN INPUT FIC-CPT 03510000 035200 IF FS-CPT-NORMAL 03520000 035300 CONTINUE 03530000 035400 ELSE 03540000 035500 DISPLAY 'OPEN INPUT FIC-CPT FAILED. FS = ' FS-CPT 03550000 035600 MOVE 8 TO RETURN-CODE 03560000 035700 PERFORM 030-ABANDON-PROGRAMME 03570000 035800 END-IF 03580000 035900 . 03590000 036000**** 03600000 036100** LIRE-FICHIER-COMPTE 03610000 036200**** 03620000 036300 620-LECTURE-FICHIER-COMPTES. 03630000 036400 READ FIC-CPT 03640000 036500 IF FS-CPT-NORMAL OR FS-CPT-NOTFND 03650000 036600 CONTINUE 03660000 036700 ELSE 03670000 036800 DISPLAY 'READ INPUT FIC-CPT FAILED. FS = ' FS-CPT 03680000 036900 MOVE 8 TO RETURN-CODE 03690000 037000 PERFORM 030-ABANDON-PROGRAMME 03700000 037100 END-IF 03710000 037200 . 03720000 037300 03730000 037400**** 03740000 037500** TEST-START-KEY 03750000 037600**** 03760000 037700 640-TEST-START-KEY. 03770000 037800 IF FS-CPT-NORMAL OR FS-CPT-NOTFND 03780000 037900 CONTINUE 03790000 038000 ELSE 03800000 038100 DISPLAY 'START-KEY FIC-CPT FAILED. FS = ' FS-CPT 03810000 038200 MOVE 8 TO RETURN-CODE 03820000 038300 PERFORM 030-ABANDON-PROGRAMME 03830000 038400 END-IF 03840000 038500 . 03850000 038600 03860000 038700**** 03870000 038800** READ-NEXT 03880000 038900**** 03890000 039000 660-READ-NEXT. 03900000 039100 READ FIC-CPT NEXT RECORD 03910000 039200 IF FS-CPT-NORMAL OR FS-CPT-DUPKEY 03920000 039300 CONTINUE 03930000 039400 ELSE 03940000 039500 MOVE 'O' TO FIN-LISTE 03950000 039600 END-IF 03960000 039700 . 03970000 039800 IDENTIFICATION DIVISION. 03980000 039900 PROGRAM-ID. COBTP216. 03990000 040000 ENVIRONMENT DIVISION. 04000000 040100 CONFIGURATION SECTION. 04010000 040200 INPUT-OUTPUT SECTION. 04020000 040300 FILE-CONTROL. 04030000 040400 SELECT FIC-CPT ASSIGN TO CPT 04040000 040500 ORGANIZATION INDEXED 04050000 040600 ACCESS MODE SEQUENTIAL 04060000 040700 RECORD KEY CLE-CPT 04070000 040800 ALTERNATE RECORD KEY IS NOM-CLIENT-CPT WITH DUPLICATES 04080000 040900 FILE STATUS FS-CPT. 04090000 041000 DATA DIVISION. 04100000 041100**** 04110000 041200** FILE SECTION 04120000 041300**** 04130000 041400 FILE SECTION. 04140000 041500 FD FIC-CPT. 04150000 041600 01 ENREG-CPT. 04160000 041700 05 CLE-CPT. 04170000 041800 10 NUM-CPT-CPT PIC 9(10). 04180000 041900 05 NOM-CLIENT-CPT PIC X(20). 04190000 042000 05 DATE-CREATION-CPT. 04200000 042100 10 AA PIC XX. 04210000 042200 10 MM PIC XX. 04220000 042300 10 JJ PIC XX. 04230000 042400 05 SOLDE-CPT PIC S9(07)V99 COMP-3. 04240000 042500 05 DATE-MAJ-CPT. 04250000 042600 10 AA PIC XX. 04260000 042700 10 MM PIC XX. 04270000 042800 10 JJ PIC XX. 04280000 042900 05 FILLER PIC X(3). 04290000 043000**** 04300000 043100** WORKING-STORAGE SECTION 04310000 043200**** 04320000 043300 WORKING-STORAGE SECTION. 04330000 043400 01 BOOLEENS. 04340000 043500 05 PIC X VALUE 'N'. 04350000 043600 88 EOF-CARTE VALUE 'O'. 04360000 043700 05 PIC X VALUE 'N'. 04370000 043800 88 EOF-CPT VALUE 'O'. 04380000 043900 88 NON-EOF-CPT VALUE 'N'. 04390000 044000 05 PIC X VALUE 'N'. 04400000 044100 88 TROUVE VALUE 'O'. 04410000 044200 88 NON-TROUVE VALUE 'N'. 04420000 044300 01 COMPTEURS. 04430000 044400 05 CTR-DEMANDE PIC 999 COMP-3. 04440000 044500 01 AUTRES. 04450000 044600 05 SOLDE-MIN PIC S9(07)V9(02) COMP-3. 04460000 044700 05 SOLDE-MAX PIC S9(07)V9(02) COMP-3. 04470000 044800 01 CARTE. 04480000 044900 05 TYPE-DEMANDE PIC X(02). 04490000 045000 05 NUM-CPT-DEMANDE PIC 9(10). 04500000 045100 05 FILLER PIC X(68). 04510000 045200 01 TICF. 04520000 045300 05 POSTE-CLIENT OCCURS 50 TIMES. 04530000 045400 10 RUB-NUM-CPT PIC 9(10). 04540000 045500 10 RUB-NOM-CLIENT PIC X(20). 04550000 045600 10 RUB-DATE-CREATION PIC 9(06). 04560000 045700 10 RUB-SOLDE PIC S9(07)V9(02) COMP-3. 04570000 045800 10 RUB-DATE-MAJ PIC 9(06). 04580000 045900 01 TIXF. 04590000 046000 05 POSTE-CLIENT-X OCCURS 50 TIMES 04600000 046100 ASCENDING KEY IS RUB-NUM-CPT-X 04610000 046200 INDEXED BY IDX. 04620000 046300 10 RUB-NUM-CPT-X PIC 9(10). 04630000 046400 10 RUB-NOM-CLIENT-X PIC X(20). 04640000 046500 10 RUB-DATE-CREATION-X PIC 9(06). 04650000 046600 10 RUB-SOLDE-X PIC S9(07)V9(02) COMP-3. 04660000 046700 10 RUB-DATE-MAJ-X PIC 9(06). 04670000 046800 01 TIXVC. 04680000 046900 05 POSTE-CLIENT-X2 OCCURS 50 TIMES 04690000 047000 DEPENDING ON NBR-COMPTES 04700000 047100 ASCENDING KEY IS RUB-NUM-CPT-X2 04710000 047200 INDEXED BY IDX2. 04720000 047300 10 RUB-NUM-CPT-X2 PIC 9(10). 04730000 047400 10 RUB-NOM-CLIENT-X2 PIC X(20). 04740000 047500 10 RUB-DATE-CREATION-X2 PIC 9(06). 04750000 047600 10 RUB-SOLDE-X2 PIC S9(07)V9(02) COMP-3. 04760000 047700 10 RUB-DATE-MAJ-X2 PIC 9(06). 04770000 047800 01 VARIABLES-POUR-TIXVC. 04780000 047900 10 CLE PIC X. 04790000 048000 10 NBR-COMPTES PIC 9(04) COMP. 04800000 048100 01 VARIABLES-INDEX-TIXVC USAGE INDEX. 04810000 048200 05 TIXVC-COMPTE-DERNIER. 04820000 048300 05 TIXVC-COMPTE-COURANT. 04830000 048400 01 SVG. 04840000 048500 05 SVG-NUM-CPT PIC 9(10). 04850000 048600 05 SVG-NOM-CLIENT PIC X(20). 04860000 048700 05 SVG-DATE-CREATION PIC 9(06). 04870000 048800 05 SVG-SOLDE PIC S9(07)V9(02) COMP-3. 04880000 048900 05 SVG-DATE-MAJ PIC 9(06). 04890000 049000 01 INDICES-TABLEAUX. 04900000 049100 05 IC-TAB PIC S9(04) COMP. 04910000 049200 05 IC-MAX PIC S9(04) COMP VALUE 50. 04920000 049300 05 IC-USED PIC S9(04) COMP. 04930000 049400 05 IC-TRI PIC S9(04) COMP. 04940000 049500 05 BORNE-HAUTE PIC S9(04) COMP. 04950000 049600 05 BORNE-BASSE PIC S9(04) COMP. 04960000 049700 05 QUOTIENT PIC 9(10) COMP. 04970000 049800 05 RESTE PIC 9(10) COMP. 04980000 049900 05 VAR PIC 9(04) COMP. 04990000 050000 05 NOMBRE PIC 9(10) COMP. 05000000 050100 05 TOTAL PIC 9(10) COMP. 05010000 050200 01 VARIABLES-INDEX USAGE INDEX. 05020000 050300 05 INDEX-COMPTE-DERNIER. 05030000 050400 05 INDEX-COMPTE-COURANT. 05040000 050500 01 TABLE-ALPHABET PIC X(46) VALUE 05050000 050600 'A B C D E F G H J K L M N P Q R T U V W X Y Z '. 05060000 050700 01 CODE-RETOUR-FICHIER. 05070000 050800 05 FS-CPT PIC XX. 05080000 050900 88 FS-CPT-NORMAL VALUE '00'. 05090000 051000 88 FS-CPT-DUPKEY VALUE '02'. 05100000 051100 88 FS-CPT-ENDFILE VALUE '10'. 05110000 051200 88 FS-CPT-NOTFND VALUE '23'. 05120000 051300 88 FS-CPT-DUPREC VALUE '22'. 05130000 051400 01 DONNEES-TEMPORELLES. 05140000 051500 05 DATE-SYSTEME. 05150000 051600 10 AA PIC X(2). 05160000 051700 10 MM PIC X(2). 05170000 051800 10 JJ PIC X(2). 05180000 051900 05 DATE-TRAITEMENT. 05190000 052000 10 JJ PIC X(2)/. 05200000 052100 10 MM PIC X(2)/. 05210000 052200 10 AA PIC X(2). 05220000 052300 05 DATE-COMPILATION PIC X(16). 05230000 052400 05 HEURE-SYSTEME. 05240000 052500 10 HH PIC X(2). 05250000 052600 10 MN PIC X(2). 05260000 052700 10 SS PIC X(2). 05270000 052800 10 CC PIC X(2). 05280000 052900 05 HEURE-TRAITEMENT. 05290000 053000 10 HH PIC X(2). 05300000 053100 10 PIC X VALUE ':'. 05310000 053200 10 MN PIC X(2). 05320000 053300 10 PIC X VALUE ':'. 05330000 053400 10 SS PIC X(2). 05340000 053500 10 PIC X VALUE '.'. 05350000 053600 10 CC PIC X(2). 05360000 053700 PROCEDURE DIVISION. 05370000 053800 05380000 053900 05390000 054000**** 05400000 054100** PROGRAMME 05410000 054200**** 05420000 054300 000-PROGRAMME. 05430000 054400 PERFORM 010-INITIALISATION-PROGRAMME 05440000 054500 PERFORM 520-LECTURE-CARTE 05450000 054600 PERFORM 100-DEMANDE 05460000 054700 UNTIL EOF-CARTE 05470000 054800 PERFORM 020-TERMINAISON-PROGRAMME 05480000 054900 STOP RUN 05490000 055000 . 05500000 055100 05510000 055200**** 05520000 055300** INITIALISATION-PROGRAMME 05530000 055400**** 05540000 055500 010-INITIALISATION-PROGRAMME. 05550000 055600* DATES DE DEBUT DE TRAITEMENT ET DE COMPILATION 05560000 055700 PERFORM 500-LIRE-INFOS-SYSTEME 05570000 055800 DISPLAY 'PGM COBTP216 DEBUT TRAITEMENT : ' DATE-TRAITEMENT 05580000 055900 ' A ' HEURE-TRAITEMENT 05590000 056000 MOVE WHEN-COMPILED TO DATE-COMPILATION 05600000 056100 DISPLAY 'PGM COBTP216 VERSION COMPILEE : ' DATE-COMPILATION 05610000 056200* OUVERTURE DES FICHIERS 05620000 056300 OPEN INPUT FIC-CPT 05630000 056400* INITIALISATIONS 05640000 056500 INITIALIZE COMPTEURS 05650000 056600 MOVE 0 TO IC-TAB 05660000 056700 MOVE 0 TO IC-USED 05670000 056800 MOVE 0 TO RETURN-CODE 05680000 056900 . 05690000 057000 05700000 057100**** 05710000 057200** TERMINAISON-PROGRAMME 05720000 057300**** 05730000 057400 020-TERMINAISON-PROGRAMME. 05740000 057500* DATE DE FIN DU TRAITEMENT 05750000 057600 PERFORM 500-LIRE-INFOS-SYSTEME 05760000 057700 DISPLAY 'PGM COBTP216 FIN NORMALE … : ' DATE-TRAITEMENT 05770000 057800 ' A ' HEURE-TRAITEMENT 05780000 057900 DISPLAY 'PGM COBTP216 CODE RETOUR POSTE : ' RETURN-CODE 05790000 058000* LOGS DIVERS 05800000 058100 DISPLAY ' ' CTR-DEMANDE ' DEMANDES LUES' 05810000 058200* FERMETURE DES FICHIERS 05820000 058300 CLOSE FIC-CPT 05830000 058400 . 05840000 058500 05850000 058600**** 05860000 058700** ABANDON-PROGRAMME 05870000 058800**** 05880000 058900 030-ABANDON-PROGRAMME. 05890000 059000 PERFORM 500-LIRE-INFOS-SYSTEME 05900000 059100 DISPLAY 'PGM COBTP216 FIN ANORMALE : ' DATE-TRAITEMENT 05910000 059200 ' A ' HEURE-TRAITEMENT 05920000 059300 DISPLAY 'PGM COBTP216 CODE RETOUR POST‚ … ' RETURN-CODE 05930000 059400 . 05940000 059500 05950000 059600**** 05960000 059700** DEMANDE 05970000 059800**** 05980000 059900 100-DEMANDE. 05990000 060000 ADD 1 TO CTR-DEMANDE 06000000 060100 EVALUATE TRUE 06010000 060200 WHEN TYPE-DEMANDE = '01' PERFORM 201-DEMANDE-01 06020000 060300 WHEN TYPE-DEMANDE = '02' PERFORM 202-DEMANDE-02 06030000 060400 WHEN TYPE-DEMANDE = '03' PERFORM 203-DEMANDE-03 06040000 060500 WHEN TYPE-DEMANDE = '04' PERFORM 204-DEMANDE-04 06050000 060600 WHEN TYPE-DEMANDE = '05' PERFORM 205-DEMANDE-05 06060000 060700 WHEN TYPE-DEMANDE = '06' PERFORM 206-DEMANDE-06 06070000 060800 WHEN TYPE-DEMANDE = '07' PERFORM 207-DEMANDE-07 06080000 060900 WHEN TYPE-DEMANDE = '08' PERFORM 208-DEMANDE-08 06090000 061000 WHEN TYPE-DEMANDE = '09' PERFORM 209-DEMANDE-09 06100000 061100 WHEN TYPE-DEMANDE = '10' PERFORM 210-DEMANDE-10 06110000 061200 WHEN TYPE-DEMANDE = '11' PERFORM 211-DEMANDE-11 06120000 061300 WHEN TYPE-DEMANDE = '12' PERFORM 212-DEMANDE-12 06130000 061400 WHEN TYPE-DEMANDE = '13' PERFORM 213-DEMANDE-13 06140000 061500 WHEN TYPE-DEMANDE = '14' PERFORM 214-DEMANDE-14 06150000 061600 WHEN TYPE-DEMANDE = '15' PERFORM 215-DEMANDE-15 06160000 061700 WHEN TYPE-DEMANDE = '16' PERFORM 216-DEMANDE-16 06170000 061800 WHEN TYPE-DEMANDE = '17' PERFORM 217-DEMANDE-17 06180000 061900 WHEN TYPE-DEMANDE = '18' PERFORM 218-DEMANDE-18 06190000 062000 WHEN OTHER CONTINUE 06200000 062100 END-EVALUATE 06210000 062200 PERFORM 520-LECTURE-CARTE 06220000 062300 . 06230000 062400 06240000 062500**** 06250000 062600** DEMANDE 01 06260000 062700**** 06270000 062800 201-DEMANDE-01. 06280000 062900 DISPLAY 'DEMANDE 01' 06290000 063000 SET NON-EOF-CPT TO TRUE 06300000 063100 MOVE 0000000001 TO NUM-CPT-CPT 06310000 063200 START FIC-CPT KEY IS >= CLE-CPT 06320000 063300 END-START 06330000 063400 PERFORM 640-TEST-START-KEY 06340000 063500 PERFORM 660-READ-NEXT 06350000 063600 06360000 063700 PERFORM VARYING IC-TAB 06370000 063800 FROM 1 BY 1 06380000 063900 UNTIL IC-TAB >= IC-MAX OR EOF-CPT 06390000 064000 MOVE ENREG-CPT TO POSTE-CLIENT(IC-TAB) 06400000 064100 PERFORM 660-READ-NEXT 06410000 064200 END-PERFORM 06420000 064300 MOVE IC-TAB TO IC-USED 06430000 064400 DISPLAY 'IC-USED VAUT : ' IC-USED 06440000 064500 . 06450000 064600 06460000 064700**** 06470000 064800** DEMANDE 02 06480000 064900**** 06490000 065000 202-DEMANDE-02. 06500000 065100 DISPLAY 'DEMANDE 02' 06510000 065200 PERFORM VARYING IC-TAB 06520000 065300 FROM 1 BY 1 06530000 065400 UNTIL IC-TAB >= IC-USED 06540000 065500 DISPLAY ' ' 06550000 065600 DISPLAY 'INDICE : ' IC-TAB 06560000 065700 DISPLAY 'NUMERO DE COMPTE : ' RUB-NUM-CPT(IC-TAB) 06570000 065800 DISPLAY 'NOM DU CLIENT : ' RUB-NOM-CLIENT(IC-TAB) 06580000 065900 DISPLAY 'SOLDE : ' RUB-SOLDE(IC-TAB) 06590000 066000 END-PERFORM 06600000 066100 DISPLAY ' ' 06610000 066200 . 06620000 066300 06630000 066400**** 06640000 066500** DEMANDE 03 06650000 066600**** 06660000 066700 203-DEMANDE-03. 06670000 066800 DISPLAY 'DEMANDE 03' 06680000 066900 MOVE 0 TO SOLDE-MAX 06690000 067000 MOVE 0 TO SOLDE-MIN 06700000 067100 PERFORM VARYING IC-TAB 06710000 067200 FROM 1 BY 1 06720000 067300 UNTIL IC-TAB >= IC-USED 06730000 067400 IF RUB-SOLDE(IC-TAB) > SOLDE-MAX THEN 06740000 067500 MOVE RUB-SOLDE(IC-TAB) TO SOLDE-MAX 06750000 067600 END-IF 06760000 067700 IF RUB-SOLDE(IC-TAB) < SOLDE-MIN THEN 06770000 067800 MOVE RUB-SOLDE(IC-TAB) TO SOLDE-MIN 06780000 067900 END-IF 06790000 068000 END-PERFORM 06800000 068100 DISPLAY 'SOLDE MIN : ' SOLDE-MIN 06810000 068200 DISPLAY 'SOLDE MAX : ' SOLDE-MAX 06820000 068300 . 06830000 068400 06840000 068500**** 06850000 068600** DEMANDE 04 06860000 068700**** 06870000 068800 204-DEMANDE-04. 06880000 068900 DISPLAY 'DEMANDE 04' 06890000 069000 MOVE 1 TO IC-TAB 06900000 069100 PERFORM 06910000 069200 UNTIL IC-TAB >= IC-USED 06920000 069300 PERFORM VARYING IC-TRI 06930000 069400 FROM 1 BY 1 06940000 069500 UNTIL IC-TRI >= IC-USED - 1 06950000 069600 IF RUB-SOLDE(IC-TRI) < RUB-SOLDE(IC-TRI + 1) 06960000 069700 MOVE POSTE-CLIENT(IC-TRI) TO SVG 06970000 069800 MOVE POSTE-CLIENT(IC-TRI + 1) TO POSTE-CLIENT(IC-TRI) 06980000 069900 MOVE SVG TO POSTE-CLIENT(IC-TRI + 1) 06990000 070000 END-IF 07000000 070100 END-PERFORM 07010000 070200 ADD 1 TO IC-TAB 07020000 070300 END-PERFORM 07030000 070400 DISPLAY ' ' 07040000 070500 . 07050000 070600 07060000 070700**** 07070000 070800** DEMANDE 05 07080000 070900**** 07090000 071000 205-DEMANDE-05. 07100000 071100 DISPLAY 'DEMANDE 05' 07110000 071200 SET NON-TROUVE TO TRUE 07120000 071300 PERFORM VARYING IC-TAB 07130000 071400 FROM 1 BY 1 07140000 071500 UNTIL IC-TAB >= IC-USED OR TROUVE 07150000 071600 IF RUB-NUM-CPT(IC-TAB) = NUM-CPT-DEMANDE THEN 07160000 071700 SET TROUVE TO TRUE 07170000 071800 END-IF 07180000 071900 END-PERFORM 07190000 072000 IF TROUVE THEN 07200000 072100 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' TROUVE' 07210000 072200 ELSE 07220000 072300 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' NON TROUVE' 07230000 072400 END-IF 07240000 072500 . 07250000 072600 07260000 072700**** 07270000 072800** DEMANDE 06 07280000 072900**** 07290000 073000 206-DEMANDE-06. 07300000 073100 DISPLAY 'DEMANDE 06' 07310000 073200 SET NON-EOF-CPT TO TRUE 07320000 073300 MOVE 0000000001 TO NUM-CPT-CPT 07330000 073400 START FIC-CPT KEY IS >= CLE-CPT 07340000 073500 END-START 07350000 073600 PERFORM 640-TEST-START-KEY 07360000 073700 PERFORM 660-READ-NEXT 07370000 073800 07380000 073900 PERFORM VARYING IDX 07390000 074000 FROM 1 BY 1 07400000 074100 UNTIL IDX >= IC-MAX OR EOF-CPT 07410000 074200 MOVE ENREG-CPT TO POSTE-CLIENT-X(IDX) 07420000 074300 PERFORM 660-READ-NEXT 07430000 074400 END-PERFORM 07440000 074500 SET INDEX-COMPTE-DERNIER TO IDX 07450000 074600 . 07460000 074700 07470000 074800**** 07480000 074900** DEMANDE 07 07490000 075000**** 07500000 075100 207-DEMANDE-07. 07510000 075200 DISPLAY 'DEMANDE 07' 07520000 075300 PERFORM VARYING IDX 07530000 075400 FROM 1 BY 1 07540000 075500 UNTIL IDX >= INDEX-COMPTE-DERNIER 07550000 075600 DISPLAY ' ' 07560000 075700 DISPLAY 'NUMERO DE COMPTE : ' RUB-NUM-CPT-X(IDX) 07570000 075800 DISPLAY 'NOM DU CLIENT : ' RUB-NOM-CLIENT-X(IDX) 07580000 075900 DISPLAY 'SOLDE : ' RUB-SOLDE-X(IDX) 07590000 076000 END-PERFORM 07600000 076100 DISPLAY ' ' 07610000 076200 . 07620000 076300 07630000 076400**** 07640000 076500** DEMANDE 08 07650000 076600**** 07660000 076700 208-DEMANDE-08. 07670000 076800 DISPLAY 'DEMANDE 08' 07680000 076900 MOVE 0 TO SOLDE-MAX 07690000 077000 MOVE 0 TO SOLDE-MIN 07700000 077100 PERFORM VARYING IDX 07710000 077200 FROM 1 BY 1 07720000 077300 UNTIL IDX >= INDEX-COMPTE-DERNIER 07730000 077400 IF RUB-SOLDE-X(IDX) > SOLDE-MAX THEN 07740000 077500 MOVE RUB-SOLDE-X(IDX) TO SOLDE-MAX 07750000 077600 END-IF 07760000 077700 IF RUB-SOLDE-X(IDX) < SOLDE-MIN THEN 07770000 077800 MOVE RUB-SOLDE-X(IDX) TO SOLDE-MIN 07780000 077900 END-IF 07790000 078000 END-PERFORM 07800000 078100 DISPLAY 'SOLDE MIN : ' SOLDE-MIN 07810000 078200 DISPLAY 'SOLDE MAX : ' SOLDE-MAX 07820000 078300 . 07830000 078400 07840000 078500**** 07850000 078600** DEMANDE 09 07860000 078700**** 07870000 078800 209-DEMANDE-09. 07880000 078900 DISPLAY 'DEMANDE 09' 07890000 079000 SET NON-TROUVE TO TRUE 07900000 079100 PERFORM VARYING IDX 07910000 079200 FROM 1 BY 1 07920000 079300 UNTIL IDX >= INDEX-COMPTE-DERNIER OR TROUVE 07930000 079400 IF RUB-NUM-CPT-X(IDX) = NUM-CPT-DEMANDE THEN 07940000 079500 SET TROUVE TO TRUE 07950000 079600 END-IF 07960000 079700 END-PERFORM 07970000 079800 IF TROUVE THEN 07980000 079900 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' TROUVE' 07990000 080000 ELSE 08000000 080100 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' NON TROUVE' 08010000 080200 END-IF 08020000 080300 . 08030000 080400 08040000 080500**** 08050000 080600** DEMANDE 10 08060000 080700**** 08070000 080800 210-DEMANDE-10. 08080000 080900 DISPLAY 'DEMANDE 10' 08090000 081000 SEARCH POSTE-CLIENT-X 08100000 081100 AT END DISPLAY 'TABLEAU SATURE' 08110000 081200 WHEN IDX > INDEX-COMPTE-DERNIER 08120000 081300 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' NON TROUVE' 08130000 081400 WHEN RUB-NUM-CPT-X(IDX) = NUM-CPT-DEMANDE 08140000 081500 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' TROUVE' 08150000 081600 END-SEARCH 08160000 081700 . 08170000 081800 08180000 081900**** 08190000 082000** DEMANDE 11 08200000 082100**** 08210000 082200 211-DEMANDE-11. 08220000 082300 DISPLAY 'DEMANDE 11' 08230000 082400 SET IDX TO INDEX-COMPTE-DERNIER 08240000 082500 PERFORM 08250000 082600 UNTIL IDX <= 2 08260000 082700 SET INDEX-COMPTE-COURANT TO IDX 08270000 082800 PERFORM VARYING IDX 08280000 082900 FROM 1 BY 1 08290000 083000 UNTIL IDX >= INDEX-COMPTE-COURANT 08300000 083100 IF RUB-NUM-CPT-X(IDX) < RUB-NUM-CPT-X(IDX + 1) 08310000 083200 MOVE POSTE-CLIENT-X(IDX) TO SVG 08320000 083300 MOVE POSTE-CLIENT-X(IDX + 1) TO POSTE-CLIENT-X(IDX) 08330000 083400 MOVE SVG TO POSTE-CLIENT-X(IDX + 1) 08340000 083500 END-IF 08350000 083600 END-PERFORM 08360000 083700 SET IDX TO INDEX-COMPTE-COURANT 08370000 083800 SET IDX DOWN BY 1 08380000 083900 END-PERFORM 08390000 084000 DISPLAY ' ' 08400000 084100 . 08410000 084200 08420000 084300**** 08430000 084400** DEMANDE 12 08440000 084500**** 08450000 084600 212-DEMANDE-12. 08460000 084700 DISPLAY 'DEMANDE 12 SUR ' NUM-CPT-DEMANDE 08470000 084800 SET NON-TROUVE TO TRUE 08480000 084900 SET IDX TO INDEX-COMPTE-DERNIER 08490000 085000 SET BORNE-HAUTE TO IDX 08500000 085100 MOVE 1 TO BORNE-BASSE 08510000 085200 PERFORM UNTIL TROUVE OR BORNE-HAUTE = (BORNE-BASSE + 1) 08520000 085300 OR BORNE-HAUTE = BORNE-BASSE 08530000 085400* LE RESULTAT DE LA DIVISION EST TRONQUE DONC ARRONDI BAS TJRS 08540000 085500 COMPUTE VAR = ((BORNE-HAUTE + BORNE-BASSE) / 2) 08550000 085600 IF RUB-NUM-CPT-X(VAR) < NUM-CPT-DEMANDE 08560000 085700 MOVE VAR TO BORNE-HAUTE 08570000 085800 END-IF 08580000 085900 IF RUB-NUM-CPT-X(VAR) > NUM-CPT-DEMANDE 08590000 086000 MOVE VAR TO BORNE-BASSE 08600000 086100 END-IF 08610000 086200 IF RUB-NUM-CPT-X(VAR) = NUM-CPT-DEMANDE 08620000 086300 SET TROUVE TO TRUE 08630000 086400 END-IF 08640000 086500 END-PERFORM 08650000 086600 IF RUB-NUM-CPT-X(BORNE-BASSE) = NUM-CPT-DEMANDE 08660000 086700 SET TROUVE TO TRUE 08670000 086800 END-IF 08680000 086900 IF TROUVE THEN 08690000 087000 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' TROUVE' 08700000 087100 ELSE 08710000 087200 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' NON TROUVE' 08720000 087300 END-IF 08730000 087400 . 08740000 087500 08750000 087600**** 08760000 087700** DEMANDE 13 08770000 087800**** 08780000 087900 213-DEMANDE-13. 08790000 088000 DISPLAY 'DEMANDE 13' 08800000 088100 08810000 088200 SET NON-EOF-CPT TO TRUE 08820000 088300 MOVE 0000000001 TO NUM-CPT-CPT 08830000 088400 START FIC-CPT KEY IS >= CLE-CPT 08840000 088500 END-START 08850000 088600 PERFORM 640-TEST-START-KEY 08860000 088700 PERFORM 660-READ-NEXT 08870000 088800 PERFORM TEST AFTER 08880000 088900 VARYING NBR-COMPTES 08890000 089000 FROM 1 BY 1 08900000 089100 UNTIL NBR-COMPTES >= IC-MAX OR EOF-CPT 08910000 089200 DISPLAY 'NBR-COMPTES : ' NBR-COMPTES 08920000 089300 MOVE ENREG-CPT TO POSTE-CLIENT-X2(NBR-COMPTES) 08930000 089400 PERFORM 660-READ-NEXT 08940000 089500 END-PERFORM 08950000 089600 . 08960000 089700 08970000 089800**** 08980000 089900** DEMANDE 14 08990000 090000**** 09000000 090100 214-DEMANDE-14. 09010000 090200 DISPLAY 'DEMANDE 14 : ' NUM-CPT-DEMANDE 09020000 090300 SEARCH ALL POSTE-CLIENT-X2 09030000 090400 AT END DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' NON TROUVE' 09040000 090500 WHEN RUB-NUM-CPT-X2(IDX2) = NUM-CPT-DEMANDE 09050000 090600 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' TROUVE' 09060000 090700 END-SEARCH 09070000 090800 . 09080000 090900 09090000 091000**** 09100000 091100** DEMANDE 15 09110000 091200**** 09120000 091300 215-DEMANDE-15. 09130000 091400 DISPLAY 'DEMANDE 15' 09140000 091500 MOVE NUM-CPT-DEMANDE TO NOMBRE 09150000 091600 INITIALIZE TOTAL 09160000 091700 DISPLAY 'NUM CPT' NOMBRE 09170000 091800 PERFORM VARYING VAR 09180000 091900 FROM 1 BY 1 09190000 092000 UNTIL VAR >= 10 09200000 092100 DIVIDE 10 INTO NOMBRE 09210000 092200 GIVING QUOTIENT 09220000 092300 REMAINDER RESTE 09230000 092400 END-DIVIDE 09240000 092500 DISPLAY 'QUOTIENT : ' QUOTIENT 09250000 092600 DISPLAY 'RESTE : ' RESTE 09260000 092700 COMPUTE NOMBRE = QUOTIENT 09270000 092800 COMPUTE TOTAL = TOTAL + (RESTE * 2 ** VAR) 09280000 092900 DISPLAY 'NOMBRE : ' NOMBRE ' ET TOTAL : ' TOTAL 09290000 093000 END-PERFORM 09300000 093100 DIVIDE 23 INTO TOTAL 09310000 093200 GIVING QUOTIENT 09320000 093300 REMAINDER RESTE 09330000 093400 END-DIVIDE 09340000 093500 MOVE TABLE-ALPHABET(RESTE * 2 + 1 : 2) TO CLE 09350000 093600 DISPLAY 'CLE : ' CLE 09360000 093700 . 09370000 093800 09380000 093900**** 09390000 094000** DEMANDE 16 09400000 094100**** 09410000 094200 216-DEMANDE-16. 09420000 094300 DISPLAY 'DEMANDE 16' 09430000 094400 PERFORM VARYING IDX2 09440000 094500 FROM 1 BY 1 09450000 094600 UNTIL IDX2 > NBR-COMPTES 09460000 094700 DISPLAY ' ' 09470000 094800 DISPLAY 'NUMERO DE COMPTE : ' RUB-NUM-CPT-X2(IDX2) 09480000 094900 DISPLAY 'NOM DU CLIENT : ' RUB-NOM-CLIENT-X2(IDX2) 09490000 095000 DISPLAY 'SOLDE : ' RUB-SOLDE-X2(IDX2) 09500000 095100 END-PERFORM 09510000 095200 DISPLAY ' ' 09520000 095300 . 09530000 095400 09540000 095500**** 09550000 095600** DEMANDE 17 09560000 095700**** 09570000 095800 217-DEMANDE-17. 09580000 095900 DISPLAY 'DEMANDE 17 SUR ' NUM-CPT-DEMANDE 09590000 096000 SET NON-TROUVE TO TRUE 09600000 096100 SET IDX TO INDEX-COMPTE-DERNIER 09610000 096200 SET BORNE-HAUTE TO IDX 09620000 096300 MOVE 1 TO BORNE-BASSE 09630000 096400 PERFORM UNTIL TROUVE 09640000 096500 OR BORNE-HAUTE = BORNE-BASSE 09650000 096600* LE RESULTAT DE LA DIVISION EST TRONQUE DONC ARRONDI BAS TJRS 09660000 096700 COMPUTE VAR = ((BORNE-HAUTE + BORNE-BASSE) / 2) 09670000 096800 IF RUB-NUM-CPT-X(VAR) < NUM-CPT-DEMANDE 09680000 096900 SUBTRACT 1 FROM VAR 09690000 097000 MOVE VAR TO BORNE-HAUTE 09700000 097100 END-IF 09710000 097200 IF RUB-NUM-CPT-X(VAR) > NUM-CPT-DEMANDE 09720000 097300 ADD 1 TO VAR 09730000 097400 MOVE VAR TO BORNE-BASSE 09740000 097500 END-IF 09750000 097600 IF RUB-NUM-CPT-X(VAR) = NUM-CPT-DEMANDE 09760000 097700 SET TROUVE TO TRUE 09770000 097800 END-IF 09780000 097900 END-PERFORM 09790000 098000 IF TROUVE THEN 09800000 098100 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' TROUVE' 09810000 098200 ELSE 09820000 098300 DISPLAY 'COMPTE ' NUM-CPT-DEMANDE ' NON TROUVE' 09830000 098400 END-IF 09840000 098500 . 09850000 098600 09860000 098700**** 09870000 098800** DEMANDE 18 09880000 098900**** 09890000 099000 218-DEMANDE-18. 09900000 099100 DISPLAY 'DEMANDE 18' 09910000 099200 CALL 'COBSP216' USING NUM-CPT-DEMANDE CLE 09920000 099300 DISPLAY 'CLE : ' CLE 09930000 099400 . 09940000 099500 09950000 099600**** 09960000 099700** LIRE-INFOS-SYSTEME 09970000 099800**** 09980000 099900 500-LIRE-INFOS-SYSTEME. 09990000 100000 ACCEPT DATE-SYSTEME FROM DATE 10000000 100100 MOVE CORR DATE-SYSTEME TO DATE-TRAITEMENT 10010000 100200 ACCEPT HEURE-SYSTEME FROM TIME 10020000 100300 MOVE CORR HEURE-SYSTEME TO HEURE-TRAITEMENT 10030000 100400 . 10040000 100500 10050000 100600**** 10060000 100700** LECTURE-CARTE : LIT SUR SYSIN 10070000 100800**** 10080000 100900 520-LECTURE-CARTE. 10090000 101000 MOVE HIGH-VALUE TO CARTE 10100000 101100 ACCEPT CARTE FROM SYSIN 10110000 101200 IF CARTE = HIGH-VALUE THEN 10120000 101300 SET EOF-CARTE TO TRUE 10130000 101400 ELSE 10140000 101500 CONTINUE 10150000 101600 END-IF 10160000 101700 . 10170000 101800 10180000 101900**** 10190000 102000** TEST-START-KEY 10200000 102100**** 10210000 102200 640-TEST-START-KEY. 10220000 102300 IF FS-CPT-NORMAL OR FS-CPT-NOTFND 10230000 102400 CONTINUE 10240000 102500 ELSE 10250000 102600 DISPLAY 'START-KEY FIC-CPT FAILED. FS = ' FS-CPT 10260000 102700 MOVE 8 TO RETURN-CODE 10270000 102800 PERFORM 030-ABANDON-PROGRAMME 10280000 102900 END-IF 10290000 103000 . 10300000 103100 10310000 103200**** 10320000 103300** READ-NEXT 10330000 103400**** 10340000 103500 660-READ-NEXT. 10350000 103600 READ FIC-CPT NEXT RECORD 10360000 103700 IF FS-CPT-NORMAL OR FS-CPT-DUPKEY 10370000 103800 CONTINUE 10380000 103900 ELSE 10390000 104000 SET EOF-CPT TO TRUE 10400000 104100 END-IF 10410000 104200 . 10420000 104300*IDENTIFICATION DIVISION. 10430000 104400*PROGRAM-ID. COBTP217. 10440000 104500* 10450000 104600*ENVIRONMENT DIVISION. 10460000 104700*CONFIGURATION SECTION. 10470000 104800*INPUT-OUTPUT SECTION. 10480000 104900*FILE-CONTROL. 10490000 105000*DATA DIVISION. 10500000 105100*FILE SECTION. 10510000 105200* 10520000 105300*WORKING-STORAGE SECTION. 10530000 105400*01 COBSP02A PIC X(8) VALUE 'COBSP217'. 10540000 105500* 10550000 105600*01 REGISTRES. 10560000 105700* 05 CENTAINES PIC 99 VALUE ZEROS. 10570000 105800* 05 DIZAINES PIC 99 VALUE ZEROS. 10580000 105900* 05 UNITES PIC 99 VALUE ZEROS. 10590000 106000* 10600000 106100*01 COMPTEUR. 10610000 106200* 05 CENT PIC 9. 10620000 106300* 05 DIX PIC 9. 10630000 106400* 05 UN PIC 9. 10640000 106500* 10650000 106600*PROCEDURE DIVISION. 10660000 106700*000-PROGRAMME. 10670000 106800* DISPLAY ' SIMULATION D''UN COMPTEUR.' 10680000 106900* DISPLAY ' --------------------------' 10690000 107000* 10700000 107100* DISPLAY ' APPEL D''UNE PROCEDURE .' 10710000 107200* DISPLAY ' ------------------------' 10720000 107300* 10730000 107400* PERFORM 500-DECOMPTE 10740000 107500* VARYING CENTAINES FROM 0 BY 1 UNTIL CENTAINES > 9 10750000 107600* AFTER DIZAINES FROM 0 BY 1 UNTIL DIZAINES > 9 10760000 107700* AFTER UNITES FROM 0 BY 1 UNTIL UNITES > 9 10770000 107800* 10780000 107900* DISPLAY ' PROCEDURE EN LIGNE. ' 10790000 108000* DISPLAY ' ------------------------' 10800000 108100* 10810000 108200* PERFORM VARYING CENTAINES FROM 0 BY 1 UNTIL CENTAINES > 9 10820000 108300* PERFORM VARYING DIZAINES FROM 0 BY 1 UNTIL DIZAINES > 9 10830000 108400* PERFORM VARYING UNITES FROM 0 BY 1 UNTIL UNITES > 9 10840000 108500* MOVE CENTAINES TO CENT 10850000 108600* MOVE DIZAINES TO DIX 10860000 108700* MOVE UNITES TO UN 10870000 108800* DISPLAY '---> ' CENT '-' DIX '-' UN '.' 10880000 108900* END-PERFORM 10890000 109000* END-PERFORM 10900000 109100* END-PERFORM 10910000 109200* 10920000 109300* DISPLAY ' APPEL SOUS-PROGRAMME ' 10930000 109400* DISPLAY ' ------------------------' 10940000 109500* 10950000 109600* PERFORM VARYING CENTAINES FROM 0 BY 1 UNTIL CENTAINES > 9 10960000 109700* PERFORM VARYING DIZAINES FROM 0 BY 1 UNTIL DIZAINES > 9 10970000 109800* PERFORM VARYING UNITES FROM 0 BY 1 UNTIL UNITES > 9 10980000 109900* CALL COBSP02A USING REGISTRES COMPTEUR 10990000 110000* DISPLAY '---> ' CENT '-' DIX '-' UN '.' 11000000 110100* END-PERFORM 11010000 110200* END-PERFORM 11020000 110300* END-PERFORM 11030000 110400* 11040000 110500* DISPLAY ' ---FIN DE LA SIMULATION.--' 11050000 110600* DISPLAY ' --------------------------' 11060000 110700* STOP RUN 11070000 110800* . 11080000 110900*500-DECOMPTE. 11090000 111000* MOVE CENTAINES TO CENT 11100000 111100* MOVE DIZAINES TO DIX 11110000 111200* MOVE UNITES TO UN 11120000 111300* DISPLAY '---> ' CENT '-' DIX '-' UN '.' 11130000 111400* . 11140000 111500 IDENTIFICATION DIVISION. 11150000 111600 PROGRAM-ID. COBSP02E. 11160000 111700 11170000 111800 ENVIRONMENT DIVISION. 11180000 111900 CONFIGURATION SECTION. 11190000 112000 INPUT-OUTPUT SECTION. 11200000 112100 FILE-CONTROL. 11210000 112200 DATA DIVISION. 11220000 112300 FILE SECTION. 11230000 112400 11240000 112500 WORKING-STORAGE SECTION. 11250000 112600 01 PROG01 PIC X(8) VALUE 'SCARRE01'. 11260000 112700 01 PROG02 PIC X(8) VALUE 'SCARRE02'. 11270000 112800 11280000 112900 01 ENREG-01. 11290000 113000 05 DONNEE-01 PIC XX VALUE 'AB'. 11300000 113100 05 DONNEE-02 PIC XX VALUE 'CD'. 11310000 113200 05 DONNEE-03 PIC XX VALUE 'EF'. 11320000 113300 05 DONNEE-04 PIC XX VALUE 'GH'. 11330000 113400 66 DONNEE-06 RENAMES DONNEE-01 THROUGH DONNEE-03. 11340000 113500 11350000 113600 01 EMPLOYE. 11360000 113700 02 EMPLOYE-FIXE. 11370000 113800 05 DEPARTEMENT PIC A(8). 11380000 113900 05 QUALIFICATION PIC X(4). 11390000 114000 05 SALAIRE-MENS PIC 9999V99. 11400000 114100 02 EMPLOYE-TEMPORAIRE REDEFINES EMPLOYE-FIXE. 11410000 114200 05 DEPARTEMEN PIC A(8). 11420000 114300 05 SOCIETE PIC X(7). 11430000 114400 05 TAUX-HORAIRE PIC 9V99. 11440000 114500 01 IT PIC 9(3) VALUE 5. 11450000 114600 01 CARRE PIC 9(4) VALUE 0000. 11460000 114700 01 CONDCODE PIC 9(8) COMP. 11470000 114800 01 ZEROC7 PIC 9(5)V99 COMP-3 VALUE 0. 11480000 114900 01 ERROC7 PIC 9(5)V99 COMP-3. 11490000 115000 PROCEDURE DIVISION. 11500000 115100 MOVE 'ETUDES' TO DEPARTEMENT 11510000 115200 MOVE 'CHEF' TO QUALIFICATION 11520000 115300 MOVE 1250.50 TO SALAIRE-MENS 11530000 115400 DISPLAY ' DEPARTEMENT : ' DEPARTEMENT 11540000 115500 DISPLAY ' QUALIFICATION : ' QUALIFICATION 11550000 115600 DISPLAY ' SALAIRE : ' TAUX-HORAIRE 11560000 115700 DISPLAY ' DONNEE-06 : ' DONNEE-06 11570000 115800 DISPLAY 'PROG02 BY CONTENT AVEC : ' IT CARRE 11580000 115900 CALL PROG02 USING BY CONTENT IT CARRE 11590000 116000 PERFORM 999-RESULT THRU 999-RESULT-FIN 11600000 116100 DISPLAY 'PROG01 DEFAULT AVEC : ' IT CARRE 11610000 116200 CALL PROG01 USING IT CARRE RETURNING CONDCODE 11620000 116300 PERFORM 999-RESULT THRU 999-RESULT-FIN 11630000 116400 DISPLAY 'PROG02 BY REFERENCE AVEC : ' IT CARRE 11640000 116500 CALL PROG02 USING BY REFERENCE IT CARRE 11650000 116600 RETURNING CONDCODE 11660000 116700 PERFORM 999-RESULT THRU 999-RESULT-FIN 11670000 116800 DISPLAY 'PROG01 BY REFERENCE AVEC : ' IT CARRE 11680000 116900 CALL PROG01 USING BY REFERENCE IT CARRE 11690000 117000 RETURNING CONDCODE 11700000 117100 PERFORM 999-RESULT THRU 999-RESULT-FIN 11710000 117200 DISPLAY 'PROG01 BY REFERENCE AVEC : ' IT CARRE 11720000 117300 CALL PROG01 USING BY REFERENCE IT CARRE 11730000 117400 RETURNING CONDCODE 11740000 117500 PERFORM 999-RESULT THRU 999-RESULT-FIN 11750000 117600 DISPLAY 'PROG02 BY CONTENT AVEC : ' IT CARRE 11760000 117700 CALL PROG02 USING BY CONTENT IT CARRE 11770000 117800 RETURNING CONDCODE 11780000 117900 PERFORM 999-RESULT THRU 999-RESULT-FIN 11790000 118000 MOVE 750 TO IT 11800000 118100 DISPLAY 'PROG02 BY CONTENT AVEC : ' IT CARRE 11810000 118200 CALL PROG02 USING BY CONTENT IT CARRE 11820000 118300 PERFORM 999-RESULT THRU 999-RESULT-FIN 11830000 118400 DISPLAY 'PROG01 DEFAULT AVEC : ' IT CARRE 11840000 118500 CALL PROG01 USING IT CARRE RETURNING CONDCODE 11850000 118600 PERFORM 999-RESULT THRU 999-RESULT-FIN 11860000 118700 DISPLAY 'PROG02 BY REFERENCE AVEC : ' IT CARRE 11870000 118800 CALL PROG02 USING BY REFERENCE IT CARRE 11880000 118900 RETURNING CONDCODE 11890000 119000 PERFORM 999-RESULT THRU 999-RESULT-FIN 11900000 119100 DISPLAY 'PROG01 BY REFERENCE AVEC : ' IT CARRE 11910000 119200 CALL PROG01 USING BY REFERENCE IT CARRE 11920000 119300 RETURNING CONDCODE 11930000 119400 PERFORM 999-RESULT THRU 999-RESULT-FIN 11940000 119500 DISPLAY 'PROG01 BY REFERENCE AVEC : ' IT CARRE 11950000 119600 CALL PROG01 USING BY REFERENCE IT CARRE 11960000 119700 RETURNING CONDCODE 11970000 119800 PERFORM 999-RESULT THRU 999-RESULT-FIN 11980000 119900 DISPLAY 'PROG02 BY CONTENT AVEC : ' IT CARRE 11990000 120000 CALL PROG02 USING BY CONTENT IT CARRE 12000000 120100 PERFORM 999-RESULT THRU 999-RESULT-FIN 12010000 120200 MOVE HIGH-VALUE TO SOCIETE 12020000 120300 ADD ERROC7 SALAIRE-MENS GIVING ZEROC7 12030000 120400 DISPLAY '??' 12040000 120500 STOP RUN 12050000 120600 . 12060000 120700 12070000 120800 999-RESULT. 12080000 120900 IF CONDCODE = 0 THEN 12090000 121000 DISPLAY '----------------------' 12100000 121100 DISPLAY ' NOMBRE : ' IT 12110000 121200 DISPLAY ' CARRE : ' CARRE 12120000 121300 ELSE 12130000 121400 DISPLAY '======================' 12140000 121500 DISPLAY ' ERREUR CALCUL : ' IT 12150000 121600 DISPLAY '======================' 12160000 121700 END-IF 12170000 121800 . 12180000 121900 999-RESULT-FIN. 12190000 122000 EXIT 12200000 122100 . 12210000 122200 IDENTIFICATION DIVISION. 12220000 122300 PROGRAM-ID. COBSP02E. 12230000 122400 12240000 122500 ENVIRONMENT DIVISION. 12250000 122600 CONFIGURATION SECTION. 12260000 122700 INPUT-OUTPUT SECTION. 12270000 122800 FILE-CONTROL. 12280000 122900 DATA DIVISION. 12290000 123000 FILE SECTION. 12300000 123100 12310000 123200 WORKING-STORAGE SECTION. 12320000 123300 01 IDX PIC 9(4) COMP. 12330000 123400 01 PARAMETRES. 12340000 123500 02 FILLER OCCURS 5. 12350000 123600 05 PARA PIC X(8). 12360000 123700 05 CNT PIC 9(4) COMP. 12370000 123800 05 SEPA PIC X. 12380000 123900 02 PTR PIC 9(4) COMP VALUE 1. 12390000 124000 02 TAL PIC 9(4) COMP. 12400000 124100 12410000 124200 77 SEP-PARA PIC X VALUE '?'. 12420000 124300 LINKAGE SECTION. 12430000 124400 01 PARM-APPEL. 12440000 124500 05 LONG PIC 9(4) COMP. 12450000 124600 88 NOPARAM VALUE ZERO. 12460000 124700 02 PARAM. 12470000 124800 05 PARAME PIC X OCCURS 1 TO 132 TIMES 12480000 124900 DEPENDING ON LONG. 12490000 125000 12500000 125100 12510000 125200 PROCEDURE DIVISION USING PARM-APPEL. 12520000 125300 IF NOT NOPARAM THEN 12530000 125400 DISPLAY 'PARAMETRE : ' LONG ' ' PARAM 12540000 125500 DISPLAY '---> ' LENGTH OF PARAM 12550000 125600 UNSTRING PARAM DELIMITED BY SEP-PARA OR ALL '*' 12560000 125700 INTO PARA( 1) DELIMITER IN SEPA( 1) COUNT IN CNT( 1)12570000 125800 PARA( 2) DELIMITER IN SEPA( 2) COUNT IN CNT( 2)12580000 125900 PARA( 3) DELIMITER IN SEPA( 3) COUNT IN CNT( 3)12590000 126000 PARA( 4) DELIMITER IN SEPA( 4) COUNT IN CNT( 4)12600000 126100 PARA( 5) DELIMITER IN SEPA( 5) COUNT IN CNT( 5)12610000 126200 WITH POINTER PTR 12620000 126300 TALLYING IN TAL 12630000 126400 ON OVERFLOW GO TO 999-OVER 12640000 126500 END-UNSTRING 12650000 126600 DISPLAY ' TALLY : ' TAL 12660000 126700 DISPLAY ' POINTER : ' PTR 12670000 126800 DISPLAY ' 1 --------------' 12680000 126900 DISPLAY ' PARAMETRE:' PARA( 1) 12690000 127000 DISPLAY ' SEPARATEUR:' SEPA( 1) 12700000 127100 DISPLAY ' COMPTEUR:' CNT( 1) 12710000 127200 DISPLAY ' 2 --------------' 12720000 127300 DISPLAY ' PARAMETRE:' PARA( 2) 12730000 127400 DISPLAY ' SEPARATEUR:' SEPA( 2) 12740000 127500 DISPLAY ' COMPTEUR:' CNT( 2) 12750000 127600 DISPLAY ' 3 --------------' 12760000 127700 DISPLAY ' PARAMETRE:' PARA( 3) 12770000 127800 DISPLAY ' SEPARATEUR:' SEPA( 3) 12780000 127900 DISPLAY ' COMPTEUR:' CNT( 3) 12790000 128000 DISPLAY ' 4 --------------' 12800000 128100 DISPLAY ' PARAMETRE:' PARA( 4) 12810000 128200 DISPLAY ' SEPARATEUR:' SEPA( 4) 12820000 128300 DISPLAY ' COMPTEUR:' CNT( 4) 12830000 128400 DISPLAY ' 5 --------------' 12840000 128500 DISPLAY ' PARAMETRE:' PARA( 5) 12850000 128600 DISPLAY ' SEPARATEUR:' SEPA( 5) 12860000 128700 DISPLAY ' COMPTEUR:' CNT( 5) 12870000 128800 ELSE 12880000 128900 DISPLAY 'PAS DE PARAMETRE!' 12890000 129000 END-IF 12900000 129100 STOP RUN 12910000 129200 . 12920000 129300 999-OVER. 12930000 129400 DISPLAY 'OVERFLOW' 12940000 129500 . 12950000 129600 STOP RUN 12960000 129700 . 12970000 129800 IDENTIFICATION DIVISION. 12980000 129900 PROGRAM-ID. COBSP216. 12990000 130000 ENVIRONMENT DIVISION. 13000000 130100 CONFIGURATION SECTION. 13010000 130200 INPUT-OUTPUT SECTION. 13020000 130300*************************************************** 13030000 130400**** DATA DIVISION 13040000 130500*************************************************** 13050000 130600 DATA DIVISION. 13060000 130700**** 13070000 130800** WORKING-STORAGE SECTION 13080000 130900**** 13090000 131000 WORKING-STORAGE SECTION. 13100000 131100 01 PLOP. 13110000 131200 05 QUOTIENT PIC 9(10) COMP. 13120000 131300 05 RESTE PIC 9(10) COMP. 13130000 131400 05 PUISSANCE PIC 9(02) COMP. 13140000 131500 05 TOTAL PIC 9(10) COMP. 13150000 131600 01 TABLE-ALPHABET PIC X(46) VALUE 13160000 131700 'A B C D E F G H J K L M N P Q R T U V W X Y Z '. 13170000 131800**** 13180000 131900** LINKAGE SECTION 13190000 132000**** 13200000 132100 LINKAGE SECTION. 13210000 132200 01 NUM-CPT PIC 9(10). 13220000 132300 01 CLE PIC X. 13230000 132400 13240000 132500*************************************************** 13250000 132600**** PROCEDURE DIVISION 13260000 132700*************************************************** 13270000 132800 PROCEDURE DIVISION USING NUM-CPT CLE. 13280000 132900 13290000 133000**** 13300000 133100** PROGRAMME 13310000 133200**** 13320000 133300 000-PROGRAMME. 13330000 133400 DISPLAY 'TRAITEMENT DE ' NUM-CPT 13340000 133500 MOVE NUM-CPT TO QUOTIENT 13350000 133600 INITIALIZE TOTAL 13360000 133700 PERFORM VARYING PUISSANCE 13370000 133800 FROM 1 BY 1 13380000 133900 UNTIL PUISSANCE >= 10 13390000 134000 DIVIDE 10 INTO QUOTIENT 13400000 134100 GIVING QUOTIENT 13410000 134200 REMAINDER RESTE 13420000 134300 END-DIVIDE 13430000 134400 COMPUTE TOTAL = TOTAL + (RESTE * 2 ** PUISSANCE) 13440000 134500 END-PERFORM 13450000 134600 DIVIDE 23 INTO TOTAL 13460000 134700 GIVING QUOTIENT 13470000 134800 REMAINDER RESTE 13480000 134900 END-DIVIDE 13490000 135000 MOVE TABLE-ALPHABET(RESTE * 2 + 1 : 1) TO CLE 13500000 135100 EXIT PROGRAM 13510000 135200 . 13520000 135300 13530000 135400 IDENTIFICATION DIVISION. 13540000 135500 PROGRAM-ID. COBSP217. 13550000 135600 13560000 135700 ENVIRONMENT DIVISION. 13570000 135800 CONFIGURATION SECTION. 13580000 135900 INPUT-OUTPUT SECTION. 13590000 136000 FILE-CONTROL. 13600000 136100 DATA DIVISION. 13610000 136200 FILE SECTION. 13620000 136300 13630000 136400 LINKAGE SECTION. 13640000 136500 01 REG. 13650000 136600 05 CENT PIC 99. 13660000 136700 05 DIZ PIC 99. 13670000 136800 05 UNI PIC 99. 13680000 136900 13690000 137000 01 CPTR. 13700000 137100 05 C PIC 9. 13710000 137200 05 D PIC 9. 13720000 137300 05 U PIC 9. 13730000 137400 13740000 137500 PROCEDURE DIVISION USING REG CPTR. 13750000 137600 MOVE CENT TO C 13760000 137700 MOVE DIZ TO D 13770000 137800 MOVE UNI TO U 13780000 137900 EXIT PROGRAM 13790000 138000 . 13800000