| 
IDENTIFICATION DIVISION. PROGRAM-ID. CBLI07. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT ECRAN ASSIGN TO WORKSTATION-DSPI09-SI ORGANIZATION TRANSACTION ACCESS DYNAMIC RELATIVE KEY IS RANG FILE STATUS IS ETAT. SELECT FICH1L1 ASSIGN TO DATABASE-FICH1L1 ORGANIZATION INDEXED ACCESS DYNAMIC RECORD KEY IS EXTERNALLY-DESCRIBED-KEY WITH DUPLICATES. SELECT FICH2P1 ASSIGN TO DATABASE-FICH2P1 ORGANIZATION INDEXED ACCESS RANDOM RECORD KEY IS EXTERNALLY-DESCRIBED-KEY WITH DUPLICATES. DATA DIVISION. FILE SECTION. FD ECRAN. 01 BUFFER PIC X(38). FD FICH1L1. 01 enreg1. COPY DDS-FICH1F1 OF FICH1L1. FD FICH2P1. 01 enreg2. COPY DDS-FICH2F1 OF FICH2P1. WORKING-STORAGE SECTION. 01 TINDIC. 05 IND OCCURS 99 PIC 1 INDICATOR 01. 01 F1I. |
|
COPY DDS-F1-I OF DSPI09. 01 SFLIO. COPY DDS-SFL OF DSPI09. 01 CTLO. COPY DDS-CTL-O OF DSPI09. 77 ERREUR PIC XXX VALUE "NON". 77 RANG PIC 9999. 77 FLAGEOF PIC X. 88 EOF value "O". 77 FLAGEOSFL PIC X. 88 EOSFL value "O". 77 ETAT PIC XX. *=========================================== PROCEDURE DIVISION. *=========================================== OPEN INPUT FICH2P1 FICH1L1 I-O ECRAN. WRITE BUFFER FORMAT "TITRE". WRITE BUFFER FORMAT "F1". READ ECRAN INTO F1-I FORMAT "F1" INDIC TINDIC. PERFORM UNTIL IND(03) = B"1" PERFORM TRAITEMENT WRITE BUFFER FORMAT "F1" INDIC TINDIC READ ECRAN INTO F1-I FORMAT "F1" INDIC TINDIC END-PERFORM. CLOSE FICH1L1 FICH2P1 ECRAN. STOP RUN. TRAITEMENT. MOVE CODE OF F1-I TO CODE OF FICH2F1. READ FICH2P1 INVALID KEY MOVE B"1" TO IND(50) NOT INVALID KEY MOVE CODE OF F1-I TO CODE OF FICH1F1 START FICH1L1 KEY IS EQUAL TO CODE OF FICH1F1 INVALID KEY MOVE B"1" TO IND(50) NOT INVALID KEY PERFORM SOUSFICHIER END-START END-READ. SOUSFICHIER. PERFORM RAZ. |
|
READ FICH1L1 NEXT AT END SET EOF TO TRUE. PERFORM UNTIL EOF OR CODE OF FICH1F1 NOT = CODE OF F1-I PERFORM ECRSOUSFICHIER READ FICH1L1 NEXT AT END SET EOF TO TRUE END-READ END-PERFORM. MOVE CORR FICH2F1 TO CTL-O. WRITE BUFFER FORMAT "PIED". PERFORM WITH TEST AFTER UNTIL IND(12) = B"1" WRITE BUFFER FROM CTL-O FORMAT "CTL" INDIC TINDIC READ ECRAN FORMAT "CTL" INDIC TINDIC PERFORM SFLMODIF END-PERFORM. RAZ. MOVE "N" TO FLAGEOF. MOVE ZERO TO RANG. MOVE B"0" TO IND(30) IND(31). WRITE BUFFER FROM CTL-O FORMAT "CTL" INDIC TINDIC. MOVE B"1" TO IND(31). ECRSOUSFICHIER. MOVE CORR FICH1F1 TO SFL. ADD 1 TO RANG. MOVE B"1" TO IND(30). WRITE SUBFILE BUFFER FROM SFL FORMAT "SFL". SFLMODIF. MOVE "N" TO FLAGEOSFL. READ SUBFILE ECRAN NEXT MODIFIED INTO SFL FORMAT "SFL" AT END SET EOSFL TO TRUE . PERFORM UNTIL EOSFL EVALUATE OPTION WHEN "2" CALL "CBLOP2" USING CLE OF SFL ON OVERFLOW DISPLAY "APPEL CBLOP2 EN ERREUR" END-CALL WHEN "5" CALL "CBLOP5" USING CLE OF SFL ON OVERFLOW DISPLAY "APPEL CBLOP5 EN ERREUR" END-CALL END-EVALUATE MOVE SPACES TO OPTION REWRITE SUBFILE BUFFER FROM SFL FORMAT "SFL" |
|
READ SUBFILE ECRAN NEXT MODIFIED INTO SFL FORMAT "SFL" AT END SET EOSFL TO TRUE END-READ END-PERFORM. |
