Pgm d'interrogation

BoTTom |
       IDENTIFICATION DIVISION.
 
       PROGRAM-ID. CBLI04.
 
       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-DSPI04-SI
           ORGANIZATION TRANSACTION.
 
           SELECT FICH1L0 ASSIGN TO DATABASE-FICH1L0
           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  enreg.
           COPY DDS-FICH1F1 OF FICH1L0.
 
       WORKING-STORAGE SECTION.
 
       01  TINDIC.
           05 IND OCCURS 99 PIC 1 INDICATOR 01.
       01  F1I.
           COPY DDS-F1-I OF DSPI04.
       01  F2O.
           COPY DDS-F2-O OF DSPI04.
      *===========================================
       PROCEDURE DIVISION.
      *===========================================
 
           OPEN INPUT FICH1L0 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 FICH1L0 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
                         WRITE BUFFER FROM F2-O FORMAT "F2"
                         READ ECRAN FORMAT "F2"
           END-READ.
 




©AF400