Pgm : liste via sous fichier(page à page) + option

BoTTom |
      * exemple récapitulatif
      * ---------------------
      *  sous fichier en chargement page à page avec zone d'option
      *
     FDSPI10    CF   E             WORKSTN
     F                                     SFILE(SFL:RANG)
     FFICH1L1   IF   E           K DISK
     FFICH2P1   IF   E           K DISK
     D  rang           S              4  0
     D  sfpag          c                   15
     D  savrang        S                   like(rang)
     C     CLIST         KLIST
     C                   KFLD                    CODE
     C                   KFLD                    CLE
      * 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     CODE          CHAIN     FICH1F1                            50
     C                   IF        not *in50
     C     CODE          CHAIN     FICH2F1                            51
     C                   EXSR      RAZSF
     C                   EXSR      UNEPAG
     C                   WRITE     PIED
 
     C                   DOU       *in12
     C                   EXFMT     CTL
      * si rollup (le traitement des options n'est prévu que sur ENTREE)
     C                   IF        *in60
      *restauration du rang (sauvegardé en fin de UNEPAG)
      * chaque READC modifiant rang (avec le N° de la ligne lue)
     C                   eval      rang = savrang
     C                   EXSR      UNEPAG
     C                   ELSE
      * boucle de lecture (readc) pour trt options.


|
     C                   EXSR      LECSF
     C                   ENDIF
     C                   ENDDO
 
     C                   ENDIF
     C                   ENDSR
      *
     C     RAZSF         BEGSR
     C                   eval      *in30 = *off
     C                   eval      *in31 = *off
     C                   WRITE     CTL
     C                   eval      *in31 = *on
     C                   eval      rang  = 0
     C                   ENDSR
      *
     C     ECRSF         BEGSR
     C                   eval      rang = rang + 1
     C                   WRITE     SFL
     C                   eval      *IN30 = *on
     C                   ENDSR
      *
     C     UNEPAG        BEGSR
     C                   DO        SFPAG
     C                   EXSR      ECRSF
     C     CODE          READE     FICH1F1                                32
     C                   IF        *in32
     C                   LEAVE
     C                   ENDIF
     C                   ENDDO
     C                   eval      ligne = rang
      * sauvegarde rang (voir + haut)
     C                   eval      savrang = rang
     C                   ENDSR
      *
     C     LECSF         BEGSR
     C                   READC     SFL
     C                   DOW       not %eof
     C                   IF        option <> ' '
     C     OPTION        CASEQ     '2'           OP2SR
     C     OPTION        CASEQ     '5'           OP5SR
     C                   ENDCS
     C                   eval      OPTION = ' '
     C                   UPDATE    SFL
     C                   ENDIF


|
     C                   READC     SFL
     C                   ENDDO
     C                   ENDSR
      *
      *   les options sont traitées par des programmes à part  (==> CALL)
      *
     C     OP2SR         BEGSR
     C                   CALL      'RPG4OP2'
     C                   PARM                    CLE
      * LECTURE POUR REACTUALISER LE SOUS FICHIER
     C     CLIST         CHAIN     FICH1F1                            90
     C                   ENDSR
      *
     C     OP5SR         BEGSR
     C                   CALL      'RPG4OP5'
     C                   PARM                    CLE
     C                   ENDSR




©AF400