FDSPI06    CF   E             WORKSTN
     FFICH1L0   UF A E           K DISK
     FFICH2P1   IF   E           K DISK
     D  error          S               N
      * PGM PRINCIPAL (BOUCLE SUR IMAGE 1)
      * ==================================
     C                   WRITE     TITRE
     C                   EXFMT     F1
     C                   DOW       not *in03
     C                   EXSR      TRTF1
     C                   EXFMT     F1
     C                   ENDDO
     C                   MOVE      *ON           *INLR
      * DEBUT DES SOUS PROGRAMMES
      * =========================
     C     TRTF1         BEGSR
     C     CLE           CHAIN     FICH1F1                            45
     C     *IN06         CASEQ     *ON           TRTADD
     C     *IN23         CASEQ     *ON           TRTDLT
     C                   CAS                     TRTUPD
     C                   ENDCS
     C                   ENDSR
      *
     C     TRTADD        BEGSR
     C                   IF        not *in45
     C                   eval      *in55 = *on
     C                   ELSE
     C     *NOKEY        CLEAR                   FICH1F1
     C                   EXSR      TRTF2
     C                   ENDIF
     C                   ENDSR
      *
     C     TRTDLT        BEGSR
     C                   IF        *in45
     C                   eval      *IN50 = *on
     C                   ELSE
     C                   WRITE     F2
     C                   DOU       *in23
     C                   EXFMT     F3
     C                   SELECT
     C                   WHEN      *in12
     C                   LEAVE
     C                   WHEN      *in23
     C                   DELETE    FICH1F1

     C                   ENDSL
     C                   ENDDO
     C                   ENDIF
     C                   ENDSR
      *
     C     TRTUPD        BEGSR
     C                   IF        *in45
     C                   eval      *IN50 = *on
     C                   ELSE
     C                   EXSR      TRTF2
     C                   ENDIF
     C                   ENDSR
      *
     C     TRTF2         BEGSR
     C                   DOU       not error
     C                   EXFMT     F2
     C                   SELECT
     C                   WHEN      *in12
     C                   LEAVE
     C                   OTHER
     C                   EXSR      CTLF2
     C                   IF        not error
      * CTL ==> OK
     C                   IF        *in06
     C                   WRITE     FICH1F1
     C                   ELSE
     C                   UPDATE    FICH1F1
     C                   ENDIF
      *
     C                   ENDIF
     C                   ENDSL
     C                   ENDDO
     C                   ENDSR
      *
     C     CTLF2         BEGSR
     C                   eval      error = *off
      * CONTROLE DU CODE
     C     CODE          CHAIN     FICH2F1                            51
     C                   IF        *in51
     C                   eval       ERROR = *on
     C                   ENDIF
      * AUTRES CONTROLES DE VALIDITE
     C*                  IF   .....
     C*                  eval       ERROR = *on

     C*                  eval       *inxx = *on
     C*                  ENDIF
     C                   ENDSR