Pgm de mise à jour (résultat de CVTRPGSRC)

BoTTom |
.....H*eywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++Comments+++++++++++
     H DATEDIT(*DMY)
.....F*ilename++IPEASFRlen+LKlen+AIDevice+.Keywords+++++++++++++++++++++++++++++Comments+++++++++++
     FRPGI11D   CF   E             WORKSTN
     FFICH1L0   UF   E           K DISK
     FFICH2P1   IF   E           K DISK
     FFICH1PV   UF A E           K DISK
.....D*ame+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++++Comments++++++++++++
     D M1              C                   CONST('ENREGISTREMENT VERRO-
     D                                     UILLÉ PAR')
     D M2              C                   CONST('LE :')
     D                SDS
     D  SDSECR               244    253
     D DATC            DS
     D  DATVER                 1      6  0 INZ
      * PGM PRINCIPAL (BOUCLE SUR IMAGE 1)
      * ==================================
.....C*0N01Factor1+++++++Opcode(E)+Factor2+++++++Result++++++++Len++D+HiLoEq....Comments+++++++++++
     C                   WRITE     TITRE
     C                   EXFMT     F1
     C     *IN03         DOWEQ     *OFF
     C                   EXSR      TRTF1
     C                   EXFMT     F1
     C                   ENDDO
     C                   MOVE      *ON           *INLR
      * DEBUT DES SOUS PROGRAMMES
      * =========================
     C     TRTF1         BEGSR
     C     CLE           CHAIN     FICH1FV                            65
     C     *IN65         IFEQ      *OFF
      * ENREGISTREMENT VERROUILLÉ
     C                   UNLOCK    FICH1PV
     C     M1            CAT(P)    ECRAN:1       MSG
     C                   CAT       M2:1          MSG
     C                   CAT       DATC:1        MSG
     C                   MOVE      *ON           *IN60
     C                   ELSE
      * LECTURE SEULE  --------V
     C     CLE           CHAIN(N)  FICH1F1                            50
     C     *IN50         IFEQ      *OFF
     C                   MOVE      SDSECR        ECRAN
     C                   Z-ADD     UDATE         DATVER
     C                   WRITE     FICH1FV
     C                   EXSR      TRTF2


|
     C     CLE           DELETE    FICH1FV                            90
     C                   ENDIF
     C                   ENDIF
     C                   ENDSR
      *
     C     TRTF2         BEGSR
     C     ERROR         DOUEQ     'NON'
     C                   EXFMT     F2
     C                   SELECT
     C     *IN12         WHENEQ    *ON
     C                   LEAVE
     C                   OTHER
     C                   EXSR      CTLF2
     C     ERROR         IFEQ      'NON'
      * ACCES AU FICHIER EN MISE   JOUR (ON PERD LA SAISIE UTILISATEUR)
     C     CLE           CHAIN     FICH1F1                            50
      * RELECTURE DU BUFFER ECRAN (RETROUVE MISES A JOUR UTILISATEUR)
      * (SANS ACTION CLAVIER CAR "RTNDTA" DANS LE DSPF)
     C                   READ      F2                                     90
      * MISE A JOUR FICHIER ET DEVERROUILLAGE
     C                   UPDATE    FICH1F1
     C                   ENDIF
     C                   ENDSL
     C                   ENDDO
     C                   ENDSR
      *
     C     CTLF2         BEGSR
     C                   MOVE      'NON'         ERROR             3
      * CONTROLE DU CODE
     C     CODE          CHAIN     FICH2F1                            51
     C     *IN51         IFEQ      *ON
     C                   MOVE      'OUI'         ERROR
     C                   ENDIF
      * AUTRES CONTROLES DE VALIDITE
     C*          .....   IF..      .....
     C*                  MOVE      'OUI'         ERROR
     C*                  MOVE      *ON           *IN..
     C*                  ENDIF
     C                   ENDSR




©AF400