Pgm de mise à jour

BoTTom | 
       IDENTIFICATION DIVISION.
 
       PROGRAM-ID. CBLI05.
 
       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-DSPI05-SI
           ORGANIZATION TRANSACTION.
 
           SELECT FICH1L0 ASSIGN TO DATABASE-FICH1L0
           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(42).
       FD  FICH1L0.
       01  enreg1.
           COPY DDS-FICH1F1 OF FICH1L0.
       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 DSPI05.

| 
       01  F2I.
           COPY DDS-F2-I OF DSPI05.
       01  F2O.
           COPY DDS-F2-O OF DSPI05.
       77  ERREUR PIC XXX VALUE "NON".
      *===========================================
       PROCEDURE DIVISION.
      *===========================================
 
           OPEN INPUT FICH2P1 I-O FICH1L0 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 FICH1L0 FICH2P1 ECRAN.
           STOP RUN.
 
       TRAITEMENT.
           MOVE CLE OF F1-I TO CLE OF FICH1F1.
           READ FICH1L0 INVALID KEY
                         MOVE B"1" TO IND(50)
                        NOT INVALID KEY
                         MOVE CORR FICH1F1 TO F2-O
                         PERFORM MAJ
           END-READ.
       MAJ.
             PERFORM WITH TEST AFTER UNTIL
                     ERREUR = "NON" OR IND(12) = B"1"
               WRITE BUFFER FROM F2-O FORMAT "F2" INDIC TINDIC
               READ ECRAN INTO F2-I FORMAT "F2" INDIC TINDIC
               IF IND(12) NOT = B"1"
                 PERFORM CONTROLE
                 IF ERREUR = "NON"
                    MOVE CORR F2-I TO FICH1F1
                    REWRITE ENREG1
                 END-IF
               END-IF
             END-PERFORM.
       CONTROLE.
           MOVE "NON" TO ERREUR.

| 
           MOVE CODE OF F2-I TO CODE OF FICH2P1.
           READ FICH2P1 INVALID KEY
                        MOVE "OUI" TO ERREUR
                        MOVE B"1" TO IND(51)
           END-READ.
      * AUTRES CONTROLES DE VALIDITE
      *    IF .... NOT = .....
      *           MOVE "OUI" TO ERREUR
      *           MOVE B"1" TO IND(51)
      *    END-IF.




©AF400