IDENTIFICATION DIVISION. 00010000 *------------------------ 00020000 00030000 PROGRAM-ID. DB2TP01G. 00040003 00050000 ENVIRONMENT DIVISION. 00060000 *--------------------- 00070000 INPUT-OUTPUT SECTION. 00080000 FILE-CONTROL. 00090000 SELECT ETAT ASSIGN TO OUT001. 00100000 00110000 S21 * SELECT FACTURE ASSIGN TO INP001 00120000 S21 * ORGANIZATION IS INDEXED 00130000 S21 * ACCESS MODE IS SEQUENTIAL 00140000 S21 * FILE STATUS IS CODRET-FACTURE. 00150000 S21 * SELECT LIGFAC ASSIGN TO INP002 00160000 S21 * ORGANIZATION IS INDEXED 00170000 S21 * ACCESS MODE IS DYNAMIC 00180000 S21 * RECORD KEY IS CLE-LIGFAC 00190000 S21 * FILE STATUS IS CODRET-LIGFAC. 00200000 00210000 DATA DIVISION. 00220000 *-------------- 00230000 FILE SECTION. 00240000 FD ETAT 00250000 RECORD CONTAINS 133 CHARACTERS 00260000 DATA RECORD IS ENRG-ETAT. 00270000 00280000 01 ENRG-ETAT PIC X(133). 00290000 S21 *FD FACTURE 00300000 S21 * LABEL RECORD IS STANDART 00310000 S21 * BLOCK CONTAINS 0 RECORDS 00320000 S21 * RECORD CONTAINS 90 CHARACTERS 00330000 S21 * DATA RECORD IS ENRG-FACTURE. 00340000 00350000 S21 *01 ENRG-FACTURE PIC X(90). 00360000 00370000 S21 *FD LIGFAC 00380000 S21 * RECORD CONTAINS 60 CHARACTERS 00390000 S21 * DATA RECORD IS ENRG-LIGFAC. 00400000 00410000 S21 *01 ENRG-LIGFAC. 00420000 S21 * O5 CLE-LIGFAC PIC X(08). 00430000 S21 * 05 FILLER PIC X(52). 00440000 00450000 WORKING-STORAGE SECTION. 00460000 00470000 A21 *----------- COMMUNICATION AVEC DB2 (SQLCA) 00480000 A21 EXEC SQL 00490008 A21 INCLUDE SQLCA 00500000 A21 END-EXEC 00510008 00520000 A21 *----------- INTERFACE ROUTINE D'ERREUR DSNTIAR 00530000 A21 77 DSNTIAR-LENGTH PIC S9(009) COMP VALUE +120. 00540010 A21 01 DSNTIAR-MESSAGE. 00550010 A21 05 DSNTIAR-LEN PIC S9(009) COMP VALUE +840. 00560010 A21 05 DSNTIAR-TEXT PIC X(120) OCCURS 7 TIMES 00570010 A21 INDEXED BY IX-DSNTIAR. 00580010 00590000 A21 *----------- DESCRIPTIONS ENREGISTREMENTS DCLGEN 00600000 A21 EXEC SQL 00610008 A21 INCLUDE VFACTURG 00620000 A21 END-EXEC 00640008 00650000 A21 EXEC SQL 00651008 A21 INCLUDE VLIGFACG 00653000 A21 END-EXEC 00654008 *----------- DESCRIPTIONS ENREGISTREMENTS FICHIERS 00660000 00670000 S21 * COPY FACTURE. 00680000 S21 * COPY LIGFAC. 00690000 00700000 *----------- VARIABLES INDICATEURS DE LA TABLE TCLIENT0 00701018 01 INDICATEURS-CLIENT. 00701118 05 CLIENT-IND PIC S9(004) COMP OCCURS 9. 00702020 00703018 *----------- DECLARATIONS DES CODES RETOUR 00710018 00720000 77 CODRET-FACTURE PIC X(02). 00730000 77 CODRET-LIGFACE PIC X(02). 00740000 00750000 *----------------------------------------------------------------*00760000 * DECLARATIONS VARIABLES PROGRAMME *00770000 *----------------------------------------------------------------*00780000 00790000 01 W-DATE. 00800000 05 W-AA PIC 9(02) VALUE ZEROES. 00810029 05 W-MM PIC 9(02) VALUE ZEROES. 00820000 05 W-JJ PIC 9(02) VALUE ZEROES. 00830000 00840028 A21 01 W-DATE-SQL. 00841028 A21 05 W-AA PIC 9(04) VALUE ZEROES. 00842028 A21 05 FILLER PIC X VALUE '-'. 00842128 A21 05 W-MM PIC 9(02) VALUE ZEROES. 00843028 A21 05 FILLER PIC X VALUE '-'. 00843128 A21 05 W-JJ PIC 9(02) VALUE ZEROES. 00844028 00845028 77 RESULTAT PIC 9(3) VALUE 0. 00850000 77 RESTE PIC 9(3) VALUE 0. 00860000 00870000 77 W-PAGE PIC 9(3) VALUE 0. 00880000 00890000 77 W-MTHTXLFA PIC S9(6)V99 COMP-3 VALUE ZEROES. 00900000 77 W-MTTVALFA PIC S9(5)V99 COMP-3 VALUE ZEROES. 00910000 77 W-MTTTCLFA PIC S9(6)V99 COMP-3 VALUE ZEROES. 00920000 00930000 *----------------------------------------------------------------*00940000 * DECLARATIONS LIGNES D'EDITION *00950000 *----------------------------------------------------------------*00960000 00970000 01 LIGNE-DATE-PAGE. 00980000 05 FILLER PIC X(05) VALUE SPACES. 00990000 05 FILLER PIC X(03) VALUE 'LE '. 01000000 05 W-JJ PIC 9(02) VALUE ZEROES. 01010000 05 FILLER PIC X(01) VALUE '/'. 01020000 05 W-MM PIC 9(02) VALUE ZEROES. 01030000 05 FILLER PIC X(03) VALUE '/20'. 01040029 05 W-AA PIC 9(02) VALUE ZEROES. 01050029 05 FILLER PIC X(67) VALUE SPACES. 01060000 05 FILLER PIC X(07) VALUE 'PAGE : '. 01070000 05 E-PAGE PIC ZZ9. 01080000 05 FILLER PIC X(37) VALUE SPACES. 01090000 01100000 01 LIGNE-ENTETE-FAC. 01110000 05 FILLER PIC X(36) VALUE SPACES. 01120000 05 FILLER PIC X(13) VALUE 'FACTURE DU : '. 01130000 05 W-JJ PIC 9(02) VALUE ZEROES. 01140000 05 FILLER PIC X(01) VALUE '/'. 01150000 05 W-MM PIC 9(02) VALUE ZEROES. 01160000 05 FILLER PIC X(01) VALUE '/'. 01170025 05 W-AA PIC 9(04) VALUE ZEROES. 01180025 05 FILLER PIC X(73) VALUE SPACES. 01190000 01200000 01 LIGNE-CDE-NOMCLI. 01210000 05 FILLER PIC X(05) VALUE SPACES. 01220000 05 FILLER PIC X(17) VALUE 01230000 'Nø COMMANDE : '. 01240000 05 E-CDNUMCOM PIC X(06) VALUE SPACES. 01250000 05 FILLER PIC X(32) VALUE ' '. 01260000 05 E-LBNOMCLI PIC X(33) VALUE SPACES. 01270000 05 FILLER PIC X(39) VALUE SPACES. 01280000 01290000 01300000 01 LIGNE-DATE-LBRUECLI. 01310000 05 FILLER PIC X(05) VALUE SPACES. 01320000 05 FILLER PIC X(17) VALUE 01330000 'DATE COMMANDE : '. 01340000 05 E-DTETACOM. 01350000 10 W-JJ PIC 9(02) VALUE ZEROES. 01360000 10 FILLER PIC X(01) VALUE '/'. 01370000 10 W-MM PIC 9(02) VALUE ZEROES. 01380000 10 FILLER PIC X(01) VALUE '/'. 01390025 10 W-AA PIC 9(04) VALUE ZEROES. 01400025 05 FILLER PIC X(28) VALUE ' '. 01410000 05 E-LBRUECLI PIC X(35) VALUE SPACES. 01420000 05 FILLER PIC X(37) VALUE SPACES. 01430000 01440000 01 LIGNE-REF-LBVILCLI. 01450000 05 FILLER PIC X(05) VALUE SPACES. 01460000 05 FILLER PIC X(17) VALUE 01470000 'REF A RAPPELER : '. 01480000 05 E-CDNUMCLI PIC X(06) VALUE SPACES. 01490000 05 FILLER PIC X(32) VALUE ' '. 01500000 05 E-CDPTTCLI PIC X(05) VALUE SPACES. 01510000 05 FILLER PIC X(01) VALUE SPACES. 01520000 05 E-LBVILCLI PIC X(25) VALUE SPACES. 01530000 05 FILLER PIC X(41) VALUE SPACES. 01540000 01550000 01 LIGNE-ENCADRE. 01560000 05 FILLER PIC X(05) VALUE SPACES. 01570000 05 FILLER PIC X(95) VALUE ALL '*'. 01580000 05 FILLER PIC X(32) VALUE SPACES. 01590000 01600000 01 LIGNE-DANS-CADRE. 01610000 05 FILLER PIC X(05) VALUE SPACES. 01620000 05 FILLER PIC X(06) VALUE '*----I'. 01630000 05 FILLER PIC X(09) VALUE ALL '-'. 01640000 05 FILLER PIC X(01) VALUE 'I'. 01650000 05 FILLER PIC X(35) VALUE ALL '-'. 01660000 05 FILLER PIC X(01) VALUE 'I'. 01670000 05 FILLER PIC X(14) VALUE ALL '-'. 01680000 05 FILLER PIC X(01) VALUE 'I'. 01690000 05 FILLER PIC X(12) VALUE ALL '-'. 01700000 05 FILLER PIC X(01) VALUE 'I'. 01710000 05 FILLER PIC X(14) VALUE ALL '-'. 01720000 05 FILLER PIC X(01) VALUE '*'. 01730000 05 FILLER PIC X(32) VALUE SPACES. 01740000 01750000 01 LIGNE-NOM-COL-TABLEAU. 01760000 05 FILLER PIC X(05) VALUE SPACES. 01770000 05 FILLER PIC X(06) VALUE '* I'. 01780000 05 FILLER PIC X(09) VALUE 01790000 ' REF ART '. 01800000 05 FILLER PIC X(01) VALUE 'I'. 01810000 05 FILLER PIC X(35) VALUE 01820000 ' LIBELLE ARTICLE '. 01830000 05 FILLER PIC X(01) VALUE 'I'. 01840000 05 FILLER PIC X(14) VALUE 01850000 ' MONTANT HT '. 01860000 05 FILLER PIC X(01) VALUE 'I'. 01870000 05 FILLER PIC X(12) VALUE 01880000 'MONTANT TVA '. 01890000 05 FILLER PIC X(01) VALUE 'I'. 01900000 05 FILLER PIC X(14) VALUE 01910000 ' MONTANT TTC '. 01920000 05 FILLER PIC X(01) VALUE '*'. 01930000 05 FILLER PIC X(32) VALUE SPACES. 01940000 01950000 01 LIGNE-FACTURE. 01960000 05 FILLER PIC X(05) VALUE SPACES. 01970000 05 FILLER PIC X(02) VALUE '* '. 01980000 05 E-RANG PIC 9(02) VALUE ZEROES. 01990000 05 FILLER PIC X(04) VALUE ' I '. 02000000 05 E-CDNUMART PIC X(06) VALUE SPACES. 02010000 05 FILLER PIC X(03) VALUE ' I '. 02020000 05 E-LBNOMART PIC X(33) VALUE SPACES. 02030000 05 FILLER PIC X(04) VALUE ' I '. 02040000 05 E-MTHTXLFA PIC ZZZZZZZ9V,99. 02050000 05 FILLER PIC X(03) VALUE ' I '. 02060000 05 E-MTTVALFA PIC ZZZZZZ9V,99. 02070000 05 FILLER PIC X(03) VALUE ' I '. 02080000 05 E-MTTTCLFA PIC ZZZZZZZ9V,99. 02090000 05 FILLER PIC X(03) VALUE ' *'. 02100000 05 FILLER PIC X(32) VALUE SPACES. 02110000 02120000 01 LIGNE-TOTAUX. 02130000 05 FILLER PIC X(05) VALUE SPACES. 02140000 05 FILLER PIC X(06) VALUE '* '. 02150000 05 FILLER PIC X(30) VALUE ' '. 02160000 05 FILLER PIC X(14) VALUE 'TOTAUX........'. 02170000 05 FILLER PIC X(04) VALUE ' I '. 02180000 05 T-MTHTXLFA PIC ZZZZZZZ9V,99. 02190000 05 FILLER PIC X(03) VALUE ' I '. 02200000 05 T-MTTVALFA PIC ZZZZZZ9V,99. 02210000 05 FILLER PIC X(03) VALUE ' I '. 02220000 05 T-MTTTCLFA PIC ZZZZZZZ9V,99. 02230000 05 FILLER PIC X(03) VALUE ' *'. 02240000 05 FILLER PIC X(32) VALUE SPACES. 02250000 02260000 01 LIGNE-SS-TOTAUX. 02270000 05 FILLER PIC X(05) VALUE SPACES. 02280000 05 FILLER PIC X(06) VALUE '* '. 02290000 05 FILLER PIC X(30) VALUE ' '. 02300000 05 FILLER PIC X(14) VALUE 'SOUS-TOTAUX...'. 02310000 05 FILLER PIC X(04) VALUE ' I '. 02320000 05 SS-MTHTXLFA PIC ZZZZZZZ9V,99. 02330000 02340000 05 FILLER PIC X(03) VALUE ' I '. 02350000 05 SS-MTTVALFA PIC ZZZZZZ9V,99. 02360000 05 FILLER PIC X(03) VALUE ' I '. 02370000 05 SS-MTTTCLFA PIC ZZZZZZZ9V,99. 02380000 05 FILLER PIC X(03) VALUE ' *'. 02390000 05 FILLER PIC X(32) VALUE SPACES. 02400000 02410000 01 LIGNE-REPORT. 02420000 05 FILLER PIC X(05) VALUE SPACES. 02430000 05 FILLER PIC X(06) VALUE '* '. 02440000 05 FILLER PIC X(35) VALUE ' '. 02450000 05 FILLER PIC X(09) VALUE 'REPORT...'. 02460000 05 FILLER PIC X(04) VALUE ' I '. 02470000 05 R-MTHTXLFA PIC ZZZZZZZ9V,99. 02480000 05 FILLER PIC X(03) VALUE ' I '. 02490000 05 R-MTTVALFA PIC ZZZZZZ9V,99. 02500000 05 FILLER PIC X(03) VALUE ' I '. 02510000 05 R-MTTTCLFA PIC ZZZZZZZ9V,99. 02520000 05 FILLER PIC X(03) VALUE ' *'. 02530000 05 FILLER PIC X(32) VALUE SPACES. 02540000 02550000 01 LIGNE-MT-A-REGLER. 02560000 05 FILLER PIC X(36) VALUE SPACES. 02570000 05 FILLER PIC X(32) VALUE 02580000 'MONTANT A REGLER TTC..........: '. 02590000 05 TOT-MTTTCLFA PIC ZZZZZZZ9V,99. 02600000 05 FILLER PIC X(53) VALUE SPACES. 02610000 02620000 A21 EXEC SQL 02630000 A21 DECLARE CURSORF 02640005 A21 CURSOR FOR 02650000 A21 SELECT * 02660000 A21 FROM VFACTURG 02670000 A21 END-EXEC 02680000 02690000 A21 EXEC SQL 02700000 A21 DECLARE CURSORL 02710005 A21 CURSOR FOR 02720000 A21 SELECT * 02730000 A21 FROM VLIGFACG 02740000 A21 WHERE CDNUMFAC = :FAC-CDNUMFAC 02750011 A21 END-EXEC 02760000 02770000 PROCEDURE DIVISION. 02780000 *------------------- 02790000 02800000 S21 * OPEN INPUT FACTURE. 02810000 S21 * OPEN I-O LIGFAC. 02820000 OPEN OUTPUT ETAT. 02830000 02840000 A21 PERFORM 910-OPEN-CURSEUR-FACTURE 02850000 02870000 ACCEPT W-DATE FROM DATE. 02880000 MOVE CORR W-DATE TO LIGNE-DATE-PAGE. 02890000 02900000 S21 * PERFORM 215-LECTURE-FACTURE. 02910000 A21 PERFORM 950-FETCH-FACTURE. 02911000 S21 * IF W-CODRET-FACTURE = '10' 02920000 A21 IF SQLCODE = 100 02921012 DISPLAY '**** AUCUNE FACTURE A TRAITER ****'. 02930000 02940000 PERFORM 100-TRAITEMENT-FACTURE 02950000 S21 * UNTIL CODRET-FACTURE = '10'. 02960000 A21 UNTIL SQLCODE = 100. 02961012 02970000 S21 * CLOSE ETAT FACTURE LIGFAC. 02980000 A21 CLOSE ETAT. 02981000 A21 PERFORM 930-CLOSE-CURSEUR-FACTURE 02982017 02990000 DISPLAY '*******************************************'. 03000000 DISPLAY '* PROGRAMME TERMINE *'. 03010000 DISPLAY '*******************************************'. 03020000 03030000 STOP RUN. 03040000 03050000 *----------------------------------------------------------------*03060000 * PARAGRAPHES PRINCIPAUX DE TRAITEMENT *03070000 *----------------------------------------------------------------*03080000 03090000 100-TRAITEMENT-FACTURE. 03100000 *----------------------- 03110000 03120000 MOVE 0 TO E-RANG 03130000 W-PAGE 03140000 W-MTHTXLFA 03150000 W-MTTVALFA 03160000 W-MTTTCLFA. 03170000 03180000 S21 * MOVE FAC-CDNUMFAC TO CLE-LIGFAC. 03190007 S21 * START LIGFAC KEY NOT < CLE-LIGFAC. 03200000 A21 PERFORM 920-OPEN-CURSEUR-LIGNE-FACTURE. 03201000 03210000 S21 * IF CODRET-LIGFAC NOT = '00' 03220000 S21 * DISPLAY 'PB START LIGFAC,CODE RETOUR = ' CODRET-LIGFAC 03230000 S21 * STOP RUN. 03240000 03250000 S21 * PERFORM 225-LECTURE-LIGNE-FAC. 03270000 A21 PERFORM 960-FETCH-LIGNE-FACTURE. 03271000 03280000 PERFORM 700-CHARGEMENT-LIGNES-ENTETES. 03290000 PERFORM 810-LIGNE-ENTETE. 03300000 03310000 PERFORM 110-TRAITEMENT-LIGNE-FACTURE 03320000 S21 * UNTIL CODRET-LIGFAC = '10' 03330000 A21 UNTIL SQLCODE = 100 03331012 S21 * OR LFA-CDNUMFAC NOT = FAC-CDNUMFAC. 03340000 03350000 PERFORM 820-LIGNE-TOTAUX. 03360000 PERFORM 940-CLOSE-CURSEUR-LIGNE. 03370016 S21 * PERFORM 215-LECTURE-FACTURE. 03380000 A21 PERFORM 950-FETCH-FACTURE. 03381000 03390000 110-TRAITEMENT-LIGNE-FACTURE. 03400000 *----------------------------- 03410000 03420000 MOVE LFA-LBNOMART TO E-LBNOMART. 03430000 MOVE LFA-CDNUMART TO E-CDNUMART. 03440000 MOVE LFA-MTHTXLFA TO E-MTHTXLFA. 03450000 MOVE LFA-MTTVALFA TO E-MTTVALFA. 03460000 MOVE LFA-MTTTCLFA TO E-MTTTCLFA. 03470000 03480000 ADD LFA-MTHTXLFA TO W-MTHTXLFA. 03490000 ADD LFA-MTTVALFA TO W-MTTVALFA. 03500000 ADD LFA-MTTTCLFA TO W-MTTTCLFA. 03510000 03520000 A21 ADD 1 TO E-RANG. 03520127 A21 WRITE ENRG-ETAT FROM LIGNE-FACTURE. 03521026 03522026 *------- TEST POUR SAUT DE PAGE 03530000 *------- ==> SI 15 LIGNES ARTICLES DEJA ECRITES 03540000 S21 * ADD 1 TO E-RANG. 03550027 DIVIDE 5 INTO E-RANG GIVING RESULTAT REMAINDER RESTE. 03560025 IF RESTE = 0 03570000 PERFORM 830-LIGNE-SS-TOTAUX 03580000 PERFORM 810-LIGNE-ENTETE 03590000 WRITE ENRG-ETAT FROM LIGNE-REPORT. 03600000 03610000 S21 * WRITE ENRG-ETAT FROM LIGNE-FACTURE. 03620026 03630000 S21 * PERFORM 225-LECTURE-LIGNE-FAC. 03640000 A21 PERFORM 960-FETCH-LIGNE-FACTURE. 03641000 03650000 *----------------------------------------------------------------*03660000 * PARAGRAPHES ORDRES FICHIERS *03670000 *----------------------------------------------------------------*03680000 03690000 S21 *215-LECTURE-FACTURE. 03700015 S21 *-------------------- 03710015 S21 * 03720015 S21 * READ FACTURE INTO W-ENRG-FACTURE. 03730013 S21 * 03740015 S21 * IF CODRET-FACTURE NOT = '00' AND NOT = '10' 03750015 S21 * DISPLAY 'PB LECTURE FACTURE,CODE RETOUR = ' CODRET-FACTURE 03760015 S21 * STOP RUN. 03770015 S21 * 03780015 S21 *225-LECTURE-LIGNE-FAC. 03790015 S21 *---------------------- 03800015 S21 * 03810015 S21 * READ LIGFAC NEXT INTO W-ENRG-LIGFAC. 03820013 S21 * 03830015 S21 * IF CODRET-LIGFAC NOT = '00' AND NOT = '10' 03840015 S21 * DISPLAY 'PB LECTURE LIGFAC,CODE RETOUR = ' CODRET-LIGFAC 03850015 S21 * STOP RUN. 03860015 S21 * 03870015 *----------------------------------------------------------------*03880000 * PARAGRAPHES DE TRAITEMENT *03890013 *----------------------------------------------------------------*03900000 03910000 700-CHARGEMENT-LIGNES-ENTETES. 03920000 *------------------------------ 03930000 03940000 MOVE FAC-DTETAFAC TO W-DATE-SQL. 03950028 MOVE CORR W-DATE-SQL TO LIGNE-ENTETE-FAC. 03960028 03970000 MOVE FAC-CDNUMCOM TO E-CDNUMCOM. 03980000 MOVE FAC-LBNOMCLI TO E-LBNOMCLI. 03990000 04000000 MOVE FAC-DTETACOM TO W-DATE-SQL. 04010028 MOVE CORR W-DATE-SQL TO E-DTETACOM. 04020028 04030018 A21 IF CLIENT-IND(3) < ZERO THEN 04031018 A21 DISPLAY 'CHAMP LBRUECLI EST A NULL' 04032018 A21 MOVE SPACE TO E-LBRUECLI 04032124 A21 ELSE 04033018 MOVE FAC-LBRUECLI-TEXT TO E-LBRUECLI 04040021 A21 END-IF 04041018 MOVE FAC-CDNUMCLI TO E-CDNUMCLI 04050022 A21 IF CLIENT-IND(4) < ZERO THEN 04051018 A21 DISPLAY 'CHAMP CDPTTCLI EST A NULL' 04052018 A21 MOVE SPACE TO E-CDPTTCLI 04052124 A21 ELSE 04053018 MOVE FAC-CDPTTCLI TO E-CDPTTCLI 04060021 A21 END-IF 04061018 A21 IF CLIENT-IND(5) < ZERO THEN 04062018 A21 DISPLAY 'CHAMP LBVILCLI EST A NULL' 04063018 A21 MOVE SPACE TO E-LBVILCLI 04063124 A21 ELSE 04064018 MOVE FAC-LBVILCLI TO E-LBVILCLI 04070021 A21 END-IF 04071018 . 04080022 *----------------------------------------------------------------*04090000 * PARAGRAPHES D'EDITION *04100000 *----------------------------------------------------------------*04110000 04120000 810-LIGNE-ENTETE. 04130000 *----------------- 04140000 04150000 ADD 1 TO W-PAGE. 04160000 MOVE W-PAGE TO E-PAGE. 04170000 04180000 WRITE ENRG-ETAT FROM LIGNE-DATE-PAGE 04190000 AFTER ADVANCING PAGE. 04200000 04210000 WRITE ENRG-ETAT FROM LIGNE-ENTETE-FAC 04220000 AFTER ADVANCING 2. 04230000 04240000 WRITE ENRG-ETAT FROM LIGNE-CDE-NOMCLI 04250000 AFTER ADVANCING 2. 04260000 04270000 WRITE ENRG-ETAT FROM LIGNE-DATE-LBRUECLI. 04280000 04290000 WRITE ENRG-ETAT FROM LIGNE-REF-LBVILCLI 04300000 AFTER ADVANCING 2. 04310000 04320000 WRITE ENRG-ETAT FROM LIGNE-ENCADRE 04330000 AFTER ADVANCING 2. 04340000 04350000 WRITE ENRG-ETAT FROM LIGNE-NOM-COL-TABLEAU. 04360000 04370000 WRITE ENRG-ETAT FROM LIGNE-DANS-CADRE. 04380000 04390000 820-LIGNE-TOTAUX. 04400000 *----------------- 04410000 04420000 MOVE W-MTHTXLFA TO T-MTHTXLFA. 04430000 MOVE W-MTTVALFA TO T-MTTVALFA. 04440000 MOVE W-MTTTCLFA TO T-MTTTCLFA 04450000 TOT-MTTTCLFA. 04460000 04470000 WRITE ENRG-ETAT FROM LIGNE-DANS-CADRE. 04480000 WRITE ENRG-ETAT FROM LIGNE-DANS-CADRE. 04490000 04500000 WRITE ENRG-ETAT FROM LIGNE-TOTAUX. 04510000 04520000 WRITE ENRG-ETAT FROM LIGNE-ENCADRE. 04530000 04540000 WRITE ENRG-ETAT FROM LIGNE-MT-A-REGLER 04550000 AFTER ADVANCING 2. 04560000 04570000 830-LIGNE-SS-TOTAUX. 04580000 *-------------------- 04590000 04600000 MOVE W-MTHTXLFA TO SS-MTHTXLFA 04610000 R-MTHTXLFA. 04620000 MOVE W-MTTVALFA TO SS-MTTVALFA 04630000 R-MTTVALFA. 04640000 MOVE W-MTTTCLFA TO SS-MTTTCLFA 04650000 R-MTTTCLFA. 04660000 04670000 WRITE ENRG-ETAT FROM LIGNE-DANS-CADRE. 04680000 WRITE ENRG-ETAT FROM LIGNE-SS-TOTAUX. 04690000 WRITE ENRG-ETAT FROM LIGNE-ENCADRE. 04700000 . 04710014 A21 900-ERREUR-SQL. 04720000 A21 *-------------------- FORMATTAGE DES MESSAGES D'ERREURS SQL 04730000 A21 CALL 'DSNTIAR' USING SQLCA 04740000 A21 DSNTIAR-MESSAGE 04750000 A21 DSNTIAR-LENGTH. 04760000 A21 04770000 A21 PERFORM 04780000 A21 VARYING IX-DSNTIAR FROM 1 BY 1 04790000 A21 UNTIL IX-DSNTIAR > 7 04800000 A21 DISPLAY DSNTIAR-TEXT(IX-DSNTIAR) 04810000 A21 END-PERFORM 04820000 A21 . 04830014 04840000 A21 910-OPEN-CURSEUR-FACTURE. 04841000 A21 *-------------------- 04842000 A21 EXEC SQL 04843000 A21 OPEN CURSORF 04844005 A21 END-EXEC 04845000 A21 04846000 A21 EVALUATE TRUE 04847014 A21 WHEN SQLCODE = 0 04848014 A21 CONTINUE 04849000 A21 WHEN SQLCODE > 0 04849114 A21 PERFORM 900-ERREUR-SQL 04849200 A21 WHEN OTHER 04849315 A21 PERFORM 900-ERREUR-SQL 04849400 A21 PERFORM 990-ABANDON-PROGRAMME 04849500 A21 END-EVALUATE 04849600 A21 . 04849714 04849800 A21 920-OPEN-CURSEUR-LIGNE-FACTURE. 04849900 A21 *-------------------- 04850000 A21 EXEC SQL 04850100 A21 OPEN CURSORL 04850205 A21 END-EXEC 04850300 A21 04850400 A21 EVALUATE SQLCODE 04850500 A21 WHEN 0 04850615 A21 CONTINUE 04850700 A21 WHEN OTHER 04851015 A21 PERFORM 900-ERREUR-SQL 04851100 A21 PERFORM 990-ABANDON-PROGRAMME 04851200 A21 END-EVALUATE 04851300 A21 . 04851414 04851500 A21 930-CLOSE-CURSEUR-FACTURE. 04851600 A21 *-------------------- 04851700 A21 EXEC SQL 04851800 A21 CLOSE CURSORF 04851905 A21 END-EXEC 04852000 A21 04852100 A21 EVALUATE SQLCODE 04852200 A21 WHEN 0 04852315 A21 CONTINUE 04852400 A21 WHEN OTHER 04852715 A21 PERFORM 900-ERREUR-SQL 04852800 A21 PERFORM 990-ABANDON-PROGRAMME 04852900 A21 END-EVALUATE 04853000 A21 . 04853114 04853200 A21 940-CLOSE-CURSEUR-LIGNE. 04853316 A21 *-------------------- 04853400 A21 EXEC SQL 04853500 A21 CLOSE CURSORL 04853605 A21 END-EXEC 04853700 A21 04853800 A21 EVALUATE SQLCODE 04853900 A21 WHEN 0 04854015 A21 CONTINUE 04854100 A21 WHEN OTHER 04854415 A21 PERFORM 900-ERREUR-SQL 04854500 A21 PERFORM 990-ABANDON-PROGRAMME 04854600 A21 END-EVALUATE 04854700 A21 . 04854814 04854900 A21 950-FETCH-FACTURE. 04855000 A21 *-------------------- 04855100 A21 EXEC SQL 04855200 A21 FETCH CURSORF 04855305 A21 INTO :DCLVFACTURG:CLIENT-IND 04855419 A21 END-EXEC 04855500 A21 04855600 A21 EVALUATE SQLCODE 04855700 A21 WHEN 0 04855815 A21 CONTINUE 04855900 A21 WHEN 100 04856015 A21 CONTINUE 04856110 A21 WHEN OTHER 04856415 A21 PERFORM 900-ERREUR-SQL 04856500 A21 PERFORM 990-ABANDON-PROGRAMME 04856600 A21 END-EVALUATE 04856700 A21 . 04856814 04856900 A21 960-FETCH-LIGNE-FACTURE. 04857000 A21 *-------------------- 04857100 A21 EXEC SQL 04857200 A21 FETCH CURSORL 04857305 A21 INTO :DCLVLIGFACG 04857406 A21 END-EXEC 04857500 A21 04857600 A21 EVALUATE SQLCODE 04857700 A21 WHEN 0 04857815 A21 CONTINUE 04857910 A21 WHEN 100 04858015 A21 CONTINUE 04858100 A21 WHEN OTHER 04858415 A21 PERFORM 900-ERREUR-SQL 04858500 A21 PERFORM 990-ABANDON-PROGRAMME 04858600 A21 END-EVALUATE 04858700 A21 . 04858814 04858900 A21 **** 04859600 A21 ** ABANDON-PROGRAMME 04859700 A21 **** 04859800 A21 990-ABANDON-PROGRAMME. 04859900 A21 DISPLAY 'PGM DB2TP01G FIN ANORMALE ' 04860100 A21 . 04860500 04860600 999-FIN-PGM. 04861000 EXIT. 04870000