| 
IDENTIFICATION DIVISION. *****-************************************************************ PROGRAM-ID. RTVPFCBL. AUTHOR. AF400. *****-************************************************************ ENVIRONMENT DIVISION. *****-************************************************************ *****-************************ CONFIGURATION SECTION. *****-************************ SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *****-************************ INPUT-OUTPUT SECTION. *****-************************ FILE-CONTROL. SELECT QADSPFFD ASSIGN TO DATABASE-QADSPFFD ORGANIZATION RELATIVE. SELECT QAFDACCP ASSIGN TO DATABASE-QAFDACCP ORGANIZATION RELATIVE. SELECT QDDSSRC ASSIGN TO DATABASE-TEMPSRC ORGANIZATION INDEXED ACCESS DYNAMIC RECORD KEY IS SEQNBR WITH DUPLICATES. *****-************************************************************ DATA DIVISION. *****-************************************************************ *****-************************ FILE SECTION. *****-************************ FD QADSPFFD LABEL RECORD STANDARD. 01 ENRFFD. COPY DDS-QWHDRFFD OF QADSPFFD. FD QAFDACCP LABEL RECORD STANDARD. 01 ENRACC. COPY DDS-QWHFDACP OF QAFDACCP. |
|
FD QDDSSRC LABEL RECORD STANDARD. 01 DATASRC. 05 SEQNBR PIC 9(6). 05 RESTE. 06 DATENBR PIC 9(6). 06 FILLER PIC X(5). 06 A PIC X. 06 C PIC X. 06 FILLER PIC X(9). 06 DATASRC2. 07 F PIC X. 07 FILLER PIC X. 07 NAME PIC X(10). 07 R PIC X. 07 LEN PIC X(5). 07 T PIC X. 07 D PIC X(2). 07 B PIC X. 07 FILLER PIC X(6). 07 FUNCTIONS PIC X(36). *****-************************ WORKING-STORAGE SECTION. *****-************************ * RESULTAT DE L'ANALYSE FORMAT DDS. 01 TEXTE1. 02 TEXTE11 PIC X(36). 02 TEXTE12 PIC X(36). 01 TEXTE2 REDEFINES TEXTE1. 02 CARA OCCURS 72 PIC X. * TEXTE A ANALYSER ET A COPIER DANS LES FUNCTIONS. 01 TEXT-ANALYSE. 02 CARA-ANALYSE OCCURS 50 PIC X. * DOIT ON DOUBLER LES ' (O/N) 77 DBL-COTE PIC X. * LONGUEUR DE TEXT-ANALYSE. |
|
77 LONG PIC 999. * POSITION POUR L'ANALYSE (RANG DE CARA) 77 POS PIC 999. * POSITION POUR CARA-ANALYSE 77 POSANA PIC 999. * N° DE RANG POUR LE FICHIER SOURCE 77 NORANG PIC 999999. PROCEDURE DIVISION. *****-************************************************************ PRINCIPALE SECTION. DEBUT. OPEN INPUT QADSPFFD QAFDACCP I-O QDDSSRC. MOVE 1 TO POS. READ QDDSSRC LAST RECORD AT END MOVE 0 TO SEQNBR. MOVE SPACES TO RESTE. ACCEPT DATENBR FROM DATE. MOVE "A" TO A. MOVE " " TO C. * TRAITEMENT CHEMIN D'ACCES NIVEAU FICHIER READ QAFDACCP. IF APUNIQ = "Y" MOVE "UNIQUE" TO TEXTE1 PERFORM ECRITURE GO TO FORMATS. IF APKEYO = "L" MOVE "LIFO" TO TEXTE1 PERFORM ECRITURE. IF APKEYO = "F" MOVE "FIFO" TO TEXTE1 PERFORM ECRITURE. FORMATS. * TRAITEMENT DU FORMAT READ QADSPFFD. MOVE "R" TO F. MOVE WHNAME TO NAME. * ECRITURE DU TEXTE FORMAT IF WHTEXT = SPACE GO TO ECRIREF. |
|
MOVE "TEXT('" TO TEXTE1.
MOVE 7 TO POS
MOVE WHTEXT TO TEXT-ANALYSE.
MOVE "O" TO DBL-COTE.
PERFORM ANALYSE.
MOVE "')" TO TEXT-ANALYSE.
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
ECRIREF.
PERFORM ECRITURE.
* TRAITEMENT DES ZONES
ZONES.
MOVE WHFLDI TO NAME.
MOVE WHFLDT TO T.
IF T = "A" OR T = "L" OR T = "T"
MOVE " " TO D ELSE MOVE WHFLDP TO D.
IF D(1:1) = "0" MOVE SPACE TO D(1:1).
IF T = "P" OR T = "B" MOVE WHFLDD TO WHFLDB.
IF (T = "L" OR T = "T" OR T = "Z")
MOVE SPACES TO LEN
ELSE MOVE WHFLDB TO LEN
MOVE 1 TO POS.
PERFORM UNTIL LEN(POS:1) GREATER THAN "0"
OR POS EQUAL 5
MOVE SPACE TO LEN(POS:1)
ADD 1 TO POS
END-PERFORM
* ECRITURE DU TEXTE ZONE.
IF WHFTXT = SPACE GO TO COLHDGZ.
MOVE "TEXT('" TO TEXTE1.
MOVE 7 TO POS
|
|
MOVE WHFTXT TO TEXT-ANALYSE.
MOVE "O" TO DBL-COTE.
PERFORM ANALYSE.
MOVE "')" TO TEXT-ANALYSE.
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
PERFORM ECRITURE.
COLHDGZ.
* ECRITURE DES COLHDG
IF WHCHD1 = " " AND WHCHD2 = " " AND WHCHD3 = " "
GO TO EDTCDEZ.
MOVE "COLHDG('" TO TEXTE1.
MOVE 9 TO POS.
MOVE WHCHD1 TO TEXT-ANALYSE.
MOVE "O" TO DBL-COTE.
PERFORM ANALYSE.
IF WHCHD2 = " " AND WHCHD3 = " " GO TO EC-COLHDGZ.
MOVE "' '" TO TEXT-ANALYSE.
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
MOVE WHCHD2 TO TEXT-ANALYSE.
MOVE "O" TO DBL-COTE.
PERFORM ANALYSE.
IF WHCHD3 = " " GO TO EC-COLHDGZ.
MOVE "' '" TO TEXT-ANALYSE.
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
MOVE WHCHD3 TO TEXT-ANALYSE.
MOVE "O" TO DBL-COTE.
PERFORM ANALYSE.
EC-COLHDGZ.
MOVE "')" TO TEXT-ANALYSE.
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
|
|
PERFORM ECRITURE.
EDTCDEZ.
IF WHECDE = " " GO TO EDTWRDZ.
MOVE "EDTCDE(" TO TEXTE1.
MOVE 8 TO POS.
MOVE WHECDE TO TEXT-ANALYSE.
IF CARA-ANALYSE(2) = " "
MOVE ")" TO CARA-ANALYSE(2)
ELSE
MOVE CARA-ANALYSE(2) TO CARA-ANALYSE(3)
MOVE " " TO CARA-ANALYSE(2)
MOVE ")" TO CARA-ANALYSE(4).
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
PERFORM ECRITURE.
EDTWRDZ.
IF WHEWRD = " " GO TO REFSHIFTZ.
MOVE "EDTWRD('" TO TEXTE1.
MOVE 9 TO POS.
MOVE WHEWRD TO TEXT-ANALYSE.
MOVE "O" TO DBL-COTE.
PERFORM ANALYSE.
MOVE "')" TO TEXT-ANALYSE.
MOVE "N" TO DBL-COTE.
PERFORM ANALYSE.
PERFORM ECRITURE.
REFSHIFTZ.
IF WHSHFT = " " GO TO DATFMTZ.
MOVE "REFSHIFT(" TO TEXTE1.
MOVE WHSHFT TO CARA(10).
MOVE ")" TO CARA(11).
PERFORM ECRITURE.
DATFMTZ.
IF WHFMT = " " GO TO ECRIREZ.
STRING "DATFMT(" WHFMT ")" DELIMITED BY SIZE INTO TEXTE1.
PERFORM ECRITURE.
|
|
IF WHSEP > " "
STRING "DATSEP(" WHSEP ")" DELIMITED BY SIZE INTO TEXTE1
PERFORM ECRITURE
END-IF.
ECRIREZ.
* SI LA LIGNE N'A PAS ENCORE ETE ECRITE
IF WHFLDI = NAME PERFORM ECRITURE.
READ QADSPFFD AT END CONTINUE NOT AT END GO TO ZONES.
*TRAITEMENT DES CLEFS.
IF APKEYF = " " GO TO FERMETURE.
CLEFS.
MOVE "K" TO F.
MOVE APKEYF TO NAME.
IF APKSEQ = "D" MOVE "DESCEND" TO TEXTE1
PERFORM ECRITURE.
IF APKZD = "Z" MOVE "ZONE" TO TEXTE1
PERFORM ECRITURE.
IF APKZD = "D" MOVE "DIGIT" TO TEXTE1
PERFORM ECRITURE.
IF APKSIN = "N" MOVE "UNSIGNED" TO TEXTE1
PERFORM ECRITURE.
IF APKSIN = "S" MOVE "SIGNED" TO TEXTE1
PERFORM ECRITURE.
* SI LA LIGNE N'A PAS ENCORE ETE ECRITE
IF NAME = APKEYF PERFORM ECRITURE.
READ QAFDACCP AT END CONTINUE NOT AT END GO TO CLEFS.
FERMETURE.
CLOSE QADSPFFD QAFDACCP QDDSSRC.
GOBACK.
ANALYSE SECTION.
|
|
DEBUT-ANALYSE. * TROUVE LA LONGUEUR DU TEXTE A ANALYSER. MOVE 50 TO LONG. TEST-LONG. IF LONG = 1 GO TO SCAN. IF CARA-ANALYSE(LONG) NOT = " " GO TO SCAN. SUBTRACT 1 FROM LONG. GO TO TEST-LONG. SCAN. MOVE 1 TO POSANA. TRANSF. IF POS NOT = 37 GO TO TRANSF1. MOVE CARA(36) TO CARA(37). MOVE "-" TO CARA(36). MOVE 38 TO POS. TRANSF1. MOVE CARA-ANALYSE(POSANA) TO CARA(POS). ADD 1 TO POS. IF NOT(CARA-ANALYSE(POSANA) = "'" AND DBL-COTE = "O") GO TO TRANSF3. IF POS NOT = 37 GO TO TRANSF2. MOVE CARA(36) TO CARA(37). MOVE "-" TO CARA(36). MOVE 38 TO POS. TRANSF2. MOVE "'" TO CARA(POS). ADD 1 TO POS. TRANSF3. ADD 1 TO POSANA. IF POSANA NOT > LONG GO TO TRANSF. ECRITURE SECTION. DEBUT-ECRITURE. ADD 100 TO SEQNBR. MOVE TEXTE11 TO FUNCTIONS. IF POS NOT > 37 GO TO FIN-ECRITURE. WRITE DATASRC. MOVE SPACES TO DATASRC2. MOVE TEXTE12 TO FUNCTIONS. ADD 100 TO SEQNBR. FIN-ECRITURE. |
|
WRITE DATASRC. MOVE SPACES TO DATASRC2. MOVE " " TO TEXTE1. MOVE 1 TO POS. |
