Moder­ni­ser votre code RPG avec Agi­li­té – Par­tie 2

Moder­ni­ser votre code RPG avec Agi­li­té – Par­tie 2

mar 23 juin 2020 2 Par Ibmiiste
Moder­ni­ser votre code RPG avec Agi­li­té – Introduction
Moder­ni­ser votre code RPG avec Agi­li­té – Par­tie 1
Moder­ni­ser votre code RPG avec Agi­li­té – Par­tie 2
Moder­ni­ser votre code RPG avec Agi­li­té – Par­tie 3
Moder­ni­ser votre code RPG avec Agi­li­té – Par­tie 4

Du RPG IV colon­né au Free-form 1re étape la fonc­tion inté­grée à RDI

Pour pas­ser du RPG IV issu de la par­tie 2 au Free-form, il est néces­saire de pas­ser par plu­sieurs étapes : nous allons décrire ici celle de la fonc­tion pré­sente dans RDI 

Dans Rdi, uti­li­ser la fonc­tion Source–>Convertir tout au for­mat libre.
Contrai­re­ment à ce que le nom de la fonc­tion pour­rait nous faire pen­ser, la conver­sion n’est pas com­plète. Seule les lignes « Cal­cu­la­tion » sont conver­tis mais pas toutes. Les mot-clefs qui n’ont pas de cor­res­pon­dance en Free-form res­tent tel-que.

Si nous repre­nons le source résul­tat du billet précédent :

    H
      * FICHIER CLIENT
      *---------------
     FBNCLTL01  IF   E           K DISK
      *
      * ADRESSE CLIENT
      *---------------
     FBACLTL02  IF   E           K DISK
      *----------------------------------------------------*
      * PARAMETRES                                         
      *----------------------------------------------------*
     C     *ENTRY        PLIST                               
     C                   PARM                    $ODCLI            8     
     C                   MOVE      $ODCLI        CODCLI                  
      *----------------------------------------------------
      * CLES                                               
      *----------------------------------------------------
      *                                                    
     C     CLTL02        KLIST                                        
     C                   KFLD                    CODCLI               
     C                   KFLD                    ACATEG               
      *----------------------------------------------------
      * INITIALISATIONS                                    
      *----------------------------------------------------
     C                   Z-ADD     20            SATJOU          
     C                   Z-ADD     UYEAR         AATJOU          
     C                   Z-ADD     UMONTH        MATJOU           
     C                   Z-ADD     UDAY          JATJOU            
     C                   MOVE      '/'           SLASH1             
     C                   MOVE      '/'           SLASH2            
     C                   MOVE      '-'           TIRET1          
     C                   MOVE      '/'           SLASH3                     
       * RECHERCHE CLIENT                                   I
     C     CODCLI        CHAIN     BNCLTL01                           60     
      * RECHERCHE ADRESSE CLI                              I
     C                   MOVE      'CLI'         ACATEG                         
     C     CLTL02        CHAIN     BACLTL02                           60       
     C  N60NIDEAD        CHAIN     BACISL01                           60        
     C     *IN60         IFEQ      '0'                                          
     C                   MOVE      ALIGN3        CLIGN3                         
     C                   MOVE      ALIGN4        CLIGN4                         
     C                   MOVE      ALIGN5        CLIGN5                         
     C                   MOVE      ALIGN6        CLIGN6                         
     C                   ENDIF                                                 

Cela donne

     H
      // FICHIER CLIENT
      //---------------
     FBNCLTL01  IF   E           K DISK
      //
      // ADRESSE CLIENT
      //---------------
     FBACLTL02  IF   E           K DISK
      //----------------------------------------------------*
      // PARAMETRES                                         
      //----------------------------------------------------*
     C     *ENTRY        PLIST                               
     C                   PARM                    $ODCLI            8     
     C                   MOVE      $ODCLI        CODCLI                  
      //----------------------------------------------------
      // CLES                                               
      //----------------------------------------------------
      //                                                    
     C     CLTL02        KLIST                                        
     C                   KFLD                    CODCLI               
     C                   KFLD                    ACATEG               
      //----------------------------------------------------
      // INITIALISATIONS                                    
      //----------------------------------------------------
     C                   Z-ADD     20            SATJOU          
     C                   Z-ADD     UYEAR         AATJOU          
     C                   Z-ADD     UMONTH        MATJOU           
     C                   Z-ADD     UDAY          JATJOU            
     C                   MOVE      '/'           SLASH1             
     C                   MOVE      '/'           SLASH2            
     C                   MOVE      '-'           TIRET1          
     C                   MOVE      '/'           SLASH3                     
      // RECHERCHE CLIENT                                   I
      /FREE
       CHAIN CODCLI BNCLTL01;
       *IN60 = NOT %FOUND;
       // RECHERCHE ADRESSE CLI                              I
      /END-FREE
     C                   MOVE      'CLI'         ACATEG                         
      /FREE
       CHAIN CLTL02 BACLTL02;
       *IN60 = NOT %FOUND;
      /END-FREE
     C  N60NIDEAD        CHAIN     BACISL01                           60        
      /FREE
       IF *IN60 = '0';
      /END-FREE
     C                   MOVE      ALIGN3        CLIGN3                         
     C                   MOVE      ALIGN4        CLIGN4                         
     C                   MOVE      ALIGN5        CLIGN5                         
     C                   MOVE      ALIGN6        CLIGN6                         
      /FREE
       ENDIF;
      /END-FREE

Comme vous pou­vez le voir, cer­taines lignes ne sont pas convertis :

  • les décla­ra­tions autre que « Cal­cu­la­tions » (F, D, H etc…),
    Pour les trans­for­mer en for­mat libre, vous pou­vez uti­li­ser le plu­gin JCRCMDS pour RDI ou la ver­sion par com­mande.
  • la décla­ra­tion des para­mètres (*ENTRY), nous aurions dû avoir une « Pro­cé­dure Inter­face Defi­ni­tion » (Dcl-pi),
    • Ici nous aurions :
Dcl-pi Liste_des_client Extpgm('LSTCLT');
  $Codcli Char(8);
End-pi;
  • Les opé­ra­teurs MOVE, Z‑ADD,
    • Move sera rem­pla­cé par des com­bi­nai­sons d’E­val, Evalr et éven­tuel­le­ment une %BIF.
  • L’u­sage d’in­di­ca­teur dans les colonnes 9, 10 et 11 etc… pour­ra être rem­pla­cé par des indi­ca­teurs nom­més, plus clair.
  • Les décla­ra­tions de clef KLIST ne sont pas transformés

Nous ver­rons dans d’autres billets ces cas particuliers.

Autre exemple, la ges­tion d’un sous-fichier de clients

         H DEBUG DECEDIT('0,') DATEDIT(*DMY.)
     F**********************************************************************
     F* CC 01/01/2009
     F* Liste du personnel
     F**********************************************************************
     F* Déclaration des fichiers
     FPGMF01FM  CF   E             WORKSTN
     F                                     SFILE(SFL01 :WRAN01)
     F                                     INFDS(DSSFL1)
     FFIC02L    IF   E           K DISK
     F                                     INFDS(FIC)
     F* Déclaration des variables
     DWDAT             S              8
     DWHEU             S              6
     DW14              S             14  0
     DWSNOM            S             35
     DWSNOP            S             35
     DI                S              3  0
     D* La DS du programme, noter le S indispensable
     DDSPROG          SDS
     DWNPROG                   1     10
     DWSTATP                  11     15  0
     DWSTAPR                  16     20  0
     DWSQSRC                  21     28
     DWSBROU                  29     36
     DWNPARM                  37     39  0
     DWTYEXC                  40     42
     DWNMSGM                  40     46
     DWNMEXC                  43     46
     DWINSMC                  47     50
     DWZOMSG                  51     80
     DWLBPGM                  81     90
     DWSFDTA                  91    170
     DWCDERR                 171    174
     DWLSFIL                 201    208
     DWLSINF                 209    243
     DWJOB                   244    253
     DWUSER                  254    263
     DWNJOB                  264    269  0
     D* La DS du sous=fichier
     DDSSFL1           DS
     DWPOSC                  370    371B 0
     DWRRNG                  376    377B 0
     DWRNGP                  378    379B 0
     DWNBRSF                 380    381B 0
     D* La DS du fichier
     DFIC              DS
     DWNRC01                 397    400B 0
     DWDSFIC           DS
     DWCDFIL                   1      8
     DWOPENF                   9      9
     DWSTSFI                  11     15  0
     DWOPCOD                  16     21
     DWRPGSQ                  30     37
     DWRPGNR                  38     45
     DWERRFI                  46     52
     DWNFICH                  83     92
     DWNLIBR                  93    102
     DWSPNAM                 103    112
     DWSPLIB                 113    122
     DWSPNUM                 123    124B 0
     DWLIMBR                 129    138
     DWNBPUT                 243    246B 0
     DWNBGET                 247    250B 0
     DWNBPG                  251    254B 0
     DWNBIO                  255    258B 0
     DWRCDFT                 261    270
     DWNBRCD                 283    286B 0
     DWNRCFI                 397    400B 0
     C* la clé d'accés au fichier
     C     KEY001        KLIST
     C                   KFLD                    FIFON
     C                   KFLD                    FINOM
     C* le nombre de lignes afichables, déclaration a la volée
     C                   Z-ADD     14            NBLIS1            4 0
     C* initialisation des variables générales
     C                   MOVEL     WNPROG        ZPGM
     C                   EXSR      DATHEU
     C                   MOVE      WDAT          ZDATE
     C                   MOVE      WHEU          ZHEUR
     C                   MOVEL     WUSER         ZUSER
     C                   MOVEL     WJOB          ZJOB
     C* Initialisation du sous=fichier des messages
     C                   MOVEL     '*  '         WPGMQ
     C                   MOVEL     'CC01'        WMGKEY
     C                   SETON                                        0910
     C* Indicateur fin
     C                   SETON                                        50
     C* Debut du traitement,
     C                   EXSR      INITSF
     C* Boucle d'attente de sortie
     C                   DOW       *IN50 = '1'
     C                   EXSR      TRTSFL
     C                   END
     C* Indicateur de fin de programme
     C                   SETON                                        LR
     C* Les procédures
     C* Traitement de l'écran
     C     TRTSFL        BEGSR
     C* Effacement du sous=fichier de messages
     C                   MOVEL     '3'           PTYP
     C                   MOVEL     *BLANK        PFIM
     C                   MOVEL     *BLANK        PMID
     C                   CALL      'PGM001CL'
     C                   PARM                    PTYP              1
     C                   PARM                    PFIM             10
     C                   PARM                    PMID              7
     C                   PARM                    PMDT             99
     C                   WRITE     WSFCTL
     C* Ecriture de l'écran
     C                   SETON                                        0405
     C                   WRITE     FORE1                                  70
     C                   WRITE     FORB1
     C* Attente lecture
     C                   READ      FORE1                                  70
     C* Une touche a été actionnée
     C* Chargement de l'heure
     C                   TIME                    ZHEUR
     C* Indicateur pour ne pas tester d'autres actions
     C                   SETON                                        51
     C                   IF        *IN02 = '1'
     C* page suivante
     C                   EXSR      CHGPAG
     C                   SETOFF                                       51
     C                   END
     C*
     C   51              IF        WSNOP <> ZSNOM
     C* Test si selection/ si changé on initialise
     C                   EXSR      INITSF
     C                   SETOFF                                       51
     C                   END
     C* touches F3 et F12
     C                   IF        *INKC = '1' OR
     C                             *INKL = '1'
     C* on met l'indicateur à Off = fin du programme
     C                   SETOFF                                       5051
     C                   END
     C*
     C                   IF        *INKE = '1'
     C* F5 Rafraichissement de l'écran
     C                   EXSR      INITSF
     C                   SETOFF                                       51
     C                   END
     C*
     C                   IF        *INKF = '1'
     C* F6 création d'un nouveau matricule
     C                   MOVEL     'CR'          PCHX
     C                   MOVEL     *BLANK        NREC
     C                   CALL      'PGMF02'
     C                   PARM                    PCHX              2
     C                   PARM                    NREC             10
     C                   EXSR      INITSF
     C                   SETOFF                                       51
     C                   END
     C                   IF        *INKH = '1'
     C* F8 impression du fichier
     C                   MOVEL     *BLANK        PMAT
     C* On appelle le CL de routage sans soumission, sinon PGMF20CL
     C                   CALL      'PGMF2SCL'
     C                   PARM                    PMAT             10
     C                   SETOFF                                       51
     C                   END
     C* On ne fait ceci que s'il n'y a eu rien d'autre
     C                   IF        *IN51 = '1'
     C                   EXSR      TRTOPT
     C                   END
     C* On recommence la boucle d'attente
     C                   ENDSR
     C* Initialisation du sous-fichier
     C     INITSF        BEGSR
     C*    l'indicateur 20 conditionne la zone OPT (protection)
     C                   SETOFF                                       20
     C* Initialisation de la variable de sélection
     C                   MOVEL     ZSNOM         WSNOP
     C                   MOVEL     *BLANK        WSNOM
     C* Initialisation de la clé pour positionnement
     C                   MOVEL     *BLANK        FIFON
     C                   MOVEL     *BLANK        FINOM
     C                   SETOFF                                       8485
     C                   IF        ZSNOM <> *BLANK
     C* Si différent de blank il y a selection
     C                   SETON                                        84
     C                   Z-ADD     0             I
     C     '*'           SCAN      ZSNOM         I                      85
     C                   IF        I > 0
     C     I             SUB       1             I
     C     I             SUBST (P) ZSNOM:1       WSNOM                  90
     C* On est dans le cas d'une sélection générique
     C                   SETON                                          85
     C* On se positionnera juste au bon endroit dans le fichier
     C                   MOVEL     WSNOM         FINOM
     C                   END
     C                   END
     C* La dernière ligne écrite
     C                   Z-ADD     0             LSTLIG            4 0
     C* Le compteur de ligne par page
     C                   Z-ADD     0             NBRLIG            4 0
     C* Le fameux WRAN01
     C                   Z-ADD     0             WRAN01            4 0
     C* Effacement du sous=fichier
     C                   SETON                                        0607
     C                   SETOFF                                       0405
     C                   WRITE     FORE1
     C                   SETOFF                                       06
     C                   SETON                                        0405
     C* Positionnement en début de fichier
     C     KEY001        SETLL     FICF                                   70
     C* Chargement de la première page
     C                   EXSR      CHGPAG
     C                   ENDSR
     C* Traitement des options, on ne lit que les enregistrements modifiés
     C     TRTOPT        BEGSR
     C* Lecture des enregistrements modifiés
     C                   Z-ADD     1             WRAN01
     C* Top pour rafraichir l'écran, si besoin
     C                   SETOFF                                       86
     C  N70              READC     SFL01                                7070
     C*
     C     *IN70         DOWEQ     '0'
     C                   MOVE      HNREC         NREC
     C                   IF        HTOUT = '1'
     C                   IF        ZOPT='2' OR ZOPT='3' OR ZOPT='4' OR ZOPT='99'
     C* Si l'employé à quitté on ne peut plus rien modifier
     C                   MOVE      '5 '          ZOPT
     C                   END
     C                   END
     C                   SETON                                        85
     C* Selection en fonction du choix saisi
     C                   SELECT
     C                   WHEN      (ZOPT = '2') OR (ZOPT = ' 2')
     C                   MOVEL     'MO'          PCHX
     C                   WHEN      (ZOPT = '3') OR (ZOPT = ' 3')
     C                   MOVEL     'CO'          PCHX
     C                   WHEN      (ZOPT = '4') OR (ZOPT = ' 4')
     C                   MOVEL     'SU'          PCHX
     C                   WHEN      (ZOPT = '5') OR (ZOPT = ' 5')
     C                   MOVEL     'AF'          PCHX
     C                   WHEN      (ZOPT = '6') OR (ZOPT = ' 6')
     C                   MOVE      HMATR         PMAT
     C                   CALL      'PGMF2SCL'
     C                   PARM                    PMAT             10
     C                   SETOFF                                       85
     C                   WHEN      (ZOPT = '99')
     C                   MOVEL     'PE'          PCHX
     C                   OTHER
     C* La saisie ne correspond à rien
     C                   SETOFF                                       85
     C* Envoyer un message pour dire que l'option n'existe pas
     C                   MOVEL     '1'           PTYP
     C                   MOVEL     'FICMSG   '   PFIM
     C                   MOVEL     'MSG0002'     PMID
     C                   CALL      'PGM001CL'
     C                   PARM                    PTYP              1
     C                   PARM                    PFIM             10
     C                   PARM                    PMID              7
     C                   PARM                    PMDT             99
     C                   ENDSL
     C                   IF        HTOUT = '0'
     C* Pour ne pas perdre l'attribut couleur
     C                   SETOFF                                       30
     C                   ELSE
     C                   SETON                                        30
     C                   END
     C* Nettoyage
     C                   MOVEL     *BLANK        ZOPT
     C                   UPDATE    SFL01                                90
     C* On aurait pu aussi faire IF..., en tout cas le choix est bon
     C   85              CALL      'PGMF02'
     C                   PARM                    PCHX              2
     C                   PARM                    NREC             10
     C   85              SETON                                        86
     C* On continue de boucler si autre option
     C                   READC     SFL01                                7070
     C                   END
     C* Potentiellement il y a eu mise à jour, on pourrait affiner
     C   86              EXSR      INITSF
     C                   ENDSR
     C* Chargement d'une page
     C     CHGPAG        BEGSR
     C* Il faut positionner correctement les indicateurs et les variables
     C                   SETOFF                                       08
     C*                  SETON                                        04
     C                   Z-ADD     LSTLIG        WRAN01
     C* Lexture de l'enregistrement suivant
     C                   READ      FICF                                   70
     C* Remise à zéro du compteur de ligne, mais on pourrait faire autrement
     C                   Z-ADD     0             NBRLIG            4 0
     C*
     C     *IN70         DOWEQ     '0'
     C     NBRLIG        ANDLT     14
     C* Remplissage des zones écran
     C                   SETON                                        86
     C* Test s'il y a selection
     C                   IF        *IN84 = '1' OR *IN85 = '1'
     C                   IF        *IN84 = '1' AND *IN85 = '0'
     C* On recherche la stricte égalité de nom
     C                   IF        FINOM <> ZSNOM
     C                   SETOFF                                       86
     C                   END
     C                   ELSE
     C* On recherche si le nom commence par la valeur avant le '*'
     C     I             SUBST (P) FINOM:1       WXNOM            35    90
     C* Petite entorse de flemmard WXNOM est déclarée au fil de l'eau
     C                   IF        WXNOM <> WSNOM
     C                   SETOFF                                       86
     C                   END
     C                   END
     C                   END
     C* L'indicateur est à '1' si sélection OK ou pas de sélection
     C                   IF        *IN86 = '1'
     C                   MOVEL     FINOM         ZNOM
     C                   MOVEL     FIPR1         ZPR1
     C                   MOVEL     FIFON         ZFONC
     C                   Z-ADD     FIMAT         ZMATR
     C                   MOVEL     FICPO         ZCPO
     C                   MOVEL     FIC           WDSFIC
     C                   Z-ADD     WNRCFI        HNREC
     C                   MOVE      FIMAT         HMATR
     C                   IF        FIDAS = 0
     C* Top salarié licencié
     C                   MOVE      '0'           HTOUT
     C                   SETOFF                                       30
     C                   ELSE
     C                   MOVE      '1'           HTOUT
     C                   SETON                                        30
     C                   END
     C* Les compteurs, attention au WRAN01
     C                   ADD       1             NBRLIG
     C                   ADD       1             LSTLIG
     C                   ADD       1             WRAN01
     C* Ecriture de la ligne
     C                   WRITE     SFL01
     C                   END
     C* Lecture du suivant
     C                   READ      FICF                                   70
     C                   END
     C* On quitte la boucle soit en fin de page
     C*                     soit en fin de fichier
     C     *IN70         IFEQ      '1'
     C* Le caractère de suite, on est en fin de fichier
     C                   SETON                                        07
     C                   ELSE
     C                   SETOFF                                       07
     C                   END
     C* Si le fichier est vide
     C     WRAN01        IFEQ      0
     C                   Z-ADD     1             NBRLIG
     C                   Z-ADD     1             LSTLIG            4 0
     C* Un petit message
     C                   Z-ADD     1             WRAN01
     C* Pas de saisie d'option
     C                   SETON                                        20
     C                   IF        ZSNOM = *BLANK
     C* Si on a un vieil AS400 du siècle dernier
     C                   MOVEL     'Fic. Vide'   ZNOM
     C                   ELSE
     C* En RPG ILE
     C                   eval      ZNOM = 'Sélection Vide'
     C                   END
     C* Ne pas oublier de remettre à blanc
     C                   MOVEL     *BLANK        ZPR1
     C                   MOVEL     *BLANK        ZFONC
     C                   Z-ADD     0             ZMATR
     C                   MOVEL     *BLANK        ZCPO
     C                   MOVEL     *BLANK        WDSFIC
     C                   Z-ADD     0             HNREC
     C* Ecriture du message sur la première ligne
     C                   WRITE     SFL01
     C                   END
     C* le WRAN01 à 1 pour afficher le premier enregistrement
     C*                  Z-ADD     LSTLIG        WRAN01
     C                   ENDSR
     C* Lecture date et heure systeme
     C     DATHEU        BEGSR
     C                   TIME                    W14
     C                   MOVE      W14           WDAT
     C                   MOVEL     W14           WHEU
     C                   ENDSR 

Après appli­ca­tion de l’op­tion de conver­sion en for­mat libre de RDI, nous obtenons :

     H DEBUG DECEDIT('0,') DATEDIT(*DMY.)
      //*********************************************************************
      // CC 01/01/2009
      // Liste du personnel
      //*********************************************************************
      // Déclaration des fichiers
     FPGMF01FM  CF   E             WORKSTN
     F                                     SFILE(SFL01 :WRAN01)
     F                                     INFDS(DSSFL1)
     FFIC02L    IF   E           K DISK
     F                                     INFDS(FIC)
      // Déclaration des variables
     DWDAT             S              8
     DWHEU             S              6
     DW14              S             14  0
     DWSNOM            S             35
     DWSNOP            S             35
     DI                S              3  0
      // La DS du programme, noter le S indispensable
     DDSPROG          SDS
     DWNPROG                   1     10
     DWSTATP                  11     15  0
     DWSTAPR                  16     20  0
     DWSQSRC                  21     28
     DWSBROU                  29     36
     DWNPARM                  37     39  0
     DWTYEXC                  40     42
     DWNMSGM                  40     46
     DWNMEXC                  43     46
     DWINSMC                  47     50
     DWZOMSG                  51     80
     DWLBPGM                  81     90
     DWSFDTA                  91    170
     DWCDERR                 171    174
     DWLSFIL                 201    208
     DWLSINF                 209    243
     DWJOB                   244    253
     DWUSER                  254    263
     DWNJOB                  264    269  0
      // La DS du sous=fichier
     DDSSFL1           DS
     DWPOSC                  370    371B 0
     DWRRNG                  376    377B 0
     DWRNGP                  378    379B 0
     DWNBRSF                 380    381B 0
      // La DS du fichier
     DFIC              DS
     DWNRC01                 397    400B 0
     DWDSFIC           DS
     DWCDFIL                   1      8
     DWOPENF                   9      9
     DWSTSFI                  11     15  0
     DWOPCOD                  16     21
     DWRPGSQ                  30     37
     DWRPGNR                  38     45
     DWERRFI                  46     52
     DWNFICH                  83     92
     DWNLIBR                  93    102
     DWSPNAM                 103    112
     DWSPLIB                 113    122
     DWSPNUM                 123    124B 0
     DWLIMBR                 129    138
     DWNBPUT                 243    246B 0
     DWNBGET                 247    250B 0
     DWNBPG                  251    254B 0
     DWNBIO                  255    258B 0
     DWRCDFT                 261    270
     DWNBRCD                 283    286B 0
     DWNRCFI                 397    400B 0
      // la clé d'accés au fichier
     C     KEY001        KLIST
     C                   KFLD                    FIFON
     C                   KFLD                    FINOM
      // le nombre de lignes afichables, déclaration a la volée
     C                   Z-ADD     14            NBLIS1            4 0
      // initialisation des variables générales
     C                   MOVEL     WNPROG        ZPGM
      /FREE
       EXSR DATHEU;
      /END-FREE
     C                   MOVE      WDAT          ZDATE
     C                   MOVE      WHEU          ZHEUR
     C                   MOVEL     WUSER         ZUSER
     C                   MOVEL     WJOB          ZJOB
      // Initialisation du sous=fichier des messages
     C                   MOVEL     '*  '         WPGMQ
     C                   MOVEL     'CC01'        WMGKEY
      /FREE
       *IN09 = *ON;
       *IN10 = *ON;
       // Indicateur fin
       *IN50 = *ON;
       // Debut du traitement,
       EXSR INITSF;
       // Boucle d'attente de sortie
       DOW *IN50 = '1';
         EXSR TRTSFL;
       ENDDO;
       // Indicateur de fin de programme
       *INLR = *ON;
       // Les procédures
       // Traitement de l'écran
       BEGSR TRTSFL;
         // Effacement du sous=fichier de messages
      /END-FREE
     C                   MOVEL     '3'           PTYP
     C                   MOVEL     *BLANK        PFIM
     C                   MOVEL     *BLANK        PMID
     C                   CALL      'PGM001CL'
     C                   PARM                    PTYP              1
     C                   PARM                    PFIM             10
     C                   PARM                    PMID              7
     C                   PARM                    PMDT             99
      /FREE
         WRITE WSFCTL;
         // Ecriture de l'écran
         *IN04 = *ON;
         *IN05 = *ON;
         WRITE FORE1;
         *IN70 = %EOF;
         WRITE FORB1;
         // Attente lecture
         READ FORE1;
         *IN70 = %EOF;
         // Une touche a été actionnée
         // Chargement de l'heure
      /END-FREE
     C                   TIME                    ZHEUR
      // Indicateur pour ne pas tester d'autres actions
      /FREE
         *IN51 = *ON;
         IF *IN02 = '1';
           // page suivante
           EXSR CHGPAG;
           *IN51 = *OFF;
         ENDIF;
         //
      /END-FREE
     C   51              IF        WSNOP <> ZSNOM
      // Test si selection/ si changé on initialise
      /FREE
           EXSR INITSF;
           *IN51 = *OFF;
         ENDIF;
         // touches F3 et F12
         IF *INKC = '1' OR
               *INKL = '1';
           // on met l'indicateur à Off = fin du programme
           *IN50 = *OFF;
           *IN51 = *OFF;
         ENDIF;
         //
         IF *INKE = '1';
           // F5 Rafraichissement de l'écran
           EXSR INITSF;
           *IN51 = *OFF;
         ENDIF;
         //
         IF *INKF = '1';
           // F6 création d'un nouveau matricule
      /END-FREE
     C                   MOVEL     'CR'          PCHX
     C                   MOVEL     *BLANK        NREC
     C                   CALL      'PGMF02'
     C                   PARM                    PCHX              2
     C                   PARM                    NREC             10
      /FREE
           EXSR INITSF;
           *IN51 = *OFF;
         ENDIF;
         IF *INKH = '1';
           // F8 impression du fichier
      /END-FREE
     C                   MOVEL     *BLANK        PMAT
      // On appelle le CL de routage sans soumission, sinon PGMF20CL
     C                   CALL      'PGMF2SCL'
     C                   PARM                    PMAT             10
      /FREE
           *IN51 = *OFF;
         ENDIF;
         // On ne fait ceci que s'il n'y a eu rien d'autre
         IF *IN51 = '1';
           EXSR TRTOPT;
         ENDIF;
         // On recommence la boucle d'attente
       ENDSR;
       // Initialisation du sous-fichier
       BEGSR INITSF;
         //    l'indicateur 20 conditionne la zone OPT (protection)
         *IN20 = *OFF;
         // Initialisation de la variable de sélection
      /END-FREE
     C                   MOVEL     ZSNOM         WSNOP
     C                   MOVEL     *BLANK        WSNOM
      // Initialisation de la clé pour positionnement
     C                   MOVEL     *BLANK        FIFON
     C                   MOVEL     *BLANK        FINOM
      /FREE
         *IN84 = *OFF;
         *IN85 = *OFF;
         IF ZSNOM <> *BLANK;
           // Si différent de blank il y a selection
           *IN84 = *ON;
      /END-FREE
     C                   Z-ADD     0             I
     C     '*'           SCAN      ZSNOM         I                      85
      /FREE
           IF I > 0;
      /END-FREE
     C     I             SUB       1             I
     C     I             SUBST (P) ZSNOM:1       WSNOM                  90
      // On est dans le cas d'une sélection générique
      /FREE
             *IN85 = *ON;
             // On se positionnera juste au bon endroit dans le fichier
      /END-FREE
     C                   MOVEL     WSNOM         FINOM
      /FREE
           ENDIF;
         ENDIF;
         // La dernière ligne écrite
      /END-FREE
     C                   Z-ADD     0             LSTLIG            4 0
      // Le compteur de ligne par page
     C                   Z-ADD     0             NBRLIG            4 0
      // Le fameux WRAN01
     C                   Z-ADD     0             WRAN01            4 0
      // Effacement du sous=fichier
      /FREE
         *IN06 = *ON;
         *IN07 = *ON;
         *IN04 = *OFF;
         *IN05 = *OFF;
         WRITE FORE1;
         *IN06 = *OFF;
         *IN04 = *ON;
         *IN05 = *ON;
         // Positionnement en début de fichier
         SETLL KEY001 FICF;
         *IN70 = %EQUAL;
         // Chargement de la première page
         EXSR CHGPAG;
       ENDSR;
       // Traitement des options, on ne lit que les enregistrements modifiés
       BEGSR TRTOPT;
         // Lecture des enregistrements modifiés
      /END-FREE
     C                   Z-ADD     1             WRAN01
      // Top pour rafraichir l'écran, si besoin
      /FREE
         *IN86 = *OFF;
      /END-FREE
     C  N70              READC     SFL01                                7070
      //
      /FREE
         DOW *IN70 = '0';
      /END-FREE
     C                   MOVE      HNREC         NREC
      /FREE
           IF HTOUT = '1';
             IF ZOPT='2' OR ZOPT='3' OR ZOPT='4' OR ZOPT='99';
               // Si l'employé à quitté on ne peut plus rien modifier
      /END-FREE
     C                   MOVE      '5 '          ZOPT
      /FREE
             ENDIF;
           ENDIF;
           *IN85 = *ON;
           // Selection en fonction du choix saisi
           SELECT;
           WHEN (ZOPT = '2') OR (ZOPT = ' 2');
      /END-FREE
     C                   MOVEL     'MO'          PCHX
      /FREE
           WHEN (ZOPT = '3') OR (ZOPT = ' 3');
      /END-FREE
     C                   MOVEL     'CO'          PCHX
      /FREE
           WHEN (ZOPT = '4') OR (ZOPT = ' 4');
      /END-FREE
     C                   MOVEL     'SU'          PCHX
      /FREE
           WHEN (ZOPT = '5') OR (ZOPT = ' 5');
      /END-FREE
     C                   MOVEL     'AF'          PCHX
      /FREE
           WHEN (ZOPT = '6') OR (ZOPT = ' 6');
      /END-FREE
     C                   MOVE      HMATR         PMAT
     C                   CALL      'PGMF2SCL'
     C                   PARM                    PMAT             10
      /FREE
             *IN85 = *OFF;
           WHEN (ZOPT = '99');
      /END-FREE
     C                   MOVEL     'PE'          PCHX
      /FREE
           OTHER;
             // La saisie ne correspond à rien
             *IN85 = *OFF;
             // Envoyer un message pour dire que l'option n'existe pas
      /END-FREE
     C                   MOVEL     '1'           PTYP
     C                   MOVEL     'FICMSG   '   PFIM
     C                   MOVEL     'MSG0002'     PMID
     C                   CALL      'PGM001CL'
     C                   PARM                    PTYP              1
     C                   PARM                    PFIM             10
     C                   PARM                    PMID              7
     C                   PARM                    PMDT             99
      /FREE
           ENDSL;
           IF HTOUT = '0';
             // Pour ne pas perdre l'attribut couleur
             *IN30 = *OFF;
           ELSE;
             *IN30 = *ON;
           ENDIF;
           // Nettoyage
      /END-FREE
     C                   MOVEL     *BLANK        ZOPT
      /FREE
           UPDATE(E) SFL01;
           *IN90 = %ERROR;
           // On aurait pu aussi faire IF..., en tout cas le choix est bon
      /END-FREE
     C   85              CALL      'PGMF02'
     C                   PARM                    PCHX              2
     C                   PARM                    NREC             10
     C   85              SETON                                        86
      // On continue de boucler si autre option
      /FREE
           READC(E) SFL01;
           *IN70 = %ERROR OR %EOF;
         ENDDO;
         // Potentiellement il y a eu mise à jour, on pourrait affiner
      /END-FREE
     C   86              EXSR      INITSF
      /FREE
       ENDSR;
       // Chargement d'une page
       BEGSR CHGPAG;
         // Il faut positionner correctement les indicateurs et les variables
         *IN08 = *OFF;
         //                  SETON                                        04
      /END-FREE
     C                   Z-ADD     LSTLIG        WRAN01
      // Lexture de l'enregistrement suivant
      /FREE
         READ FICF;
         *IN70 = %EOF;
         // Remise à zéro du compteur de ligne, mais on pourrait faire autrement
      /END-FREE
     C                   Z-ADD     0             NBRLIG            4 0
      //
      /FREE
         DOW *IN70 = '0'
         AND NBRLIG < 14;
           // Remplissage des zones écran
           *IN86 = *ON;
           // Test s'il y a selection
           IF *IN84 = '1' OR *IN85 = '1';
             IF *IN84 = '1' AND *IN85 = '0';
               // On recherche la stricte égalité de nom
               IF FINOM <> ZSNOM;
                 *IN86 = *OFF;
               ENDIF;
             ELSE;
               // On recherche si le nom commence par la valeur avant le '*'
      /END-FREE
     C     I             SUBST (P) FINOM:1       WXNOM            35    90
      // Petite entorse de flemmard WXNOM est déclarée au fil de l'eau
      /FREE
               IF WXNOM <> WSNOM;
                 *IN86 = *OFF;
               ENDIF;
             ENDIF;
           ENDIF;
           // L'indicateur est à '1' si sélection OK ou pas de sélection
           IF *IN86 = '1';
      /END-FREE
     C                   MOVEL     FINOM         ZNOM
     C                   MOVEL     FIPR1         ZPR1
     C                   MOVEL     FIFON         ZFONC
     C                   Z-ADD     FIMAT         ZMATR
     C                   MOVEL     FICPO         ZCPO
     C                   MOVEL     FIC           WDSFIC
     C                   Z-ADD     WNRCFI        HNREC
     C                   MOVE      FIMAT         HMATR
      /FREE
             IF FIDAS = 0;
               // Top salarié licencié
      /END-FREE
     C                   MOVE      '0'           HTOUT
      /FREE
               *IN30 = *OFF;
             ELSE;
      /END-FREE
     C                   MOVE      '1'           HTOUT
      /FREE
               *IN30 = *ON;
             ENDIF;
             // Les compteurs, attention au WRAN01
      /END-FREE
     C                   ADD       1             NBRLIG
     C                   ADD       1             LSTLIG
     C                   ADD       1             WRAN01
      // Ecriture de la ligne
      /FREE
             WRITE SFL01;
           ENDIF;
           // Lecture du suivant
           READ FICF;
           *IN70 = %EOF;
         ENDDO;
         // On quitte la boucle soit en fin de page
         //                     soit en fin de fichier
         IF *IN70 = '1';
           // Le caractère de suite, on est en fin de fichier
           *IN07 = *ON;
         ELSE;
           *IN07 = *OFF;
         ENDIF;
         // Si le fichier est vide
         IF WRAN01 = 0;
      /END-FREE
     C                   Z-ADD     1             NBRLIG
     C                   Z-ADD     1             LSTLIG            4 0
      // Un petit message
     C                   Z-ADD     1             WRAN01
      // Pas de saisie d'option
      /FREE
           *IN20 = *ON;
           IF ZSNOM = *BLANK;
             // Si on a un vieil AS400 du siècle dernier
      /END-FREE
     C                   MOVEL     'Fic. Vide'   ZNOM
      /FREE
           ELSE;
             // En RPG ILE
             ZNOM = 'Sélection Vide';
           ENDIF;
           // Ne pas oublier de remettre à blanc
      /END-FREE
     C                   MOVEL     *BLANK        ZPR1
     C                   MOVEL     *BLANK        ZFONC
     C                   Z-ADD     0             ZMATR
     C                   MOVEL     *BLANK        ZCPO
     C                   MOVEL     *BLANK        WDSFIC
     C                   Z-ADD     0             HNREC
      // Ecriture du message sur la première ligne
      /FREE
           WRITE SFL01;
         ENDIF;
         // le WRAN01 à 1 pour afficher le premier enregistrement
         //                  Z-ADD     LSTLIG        WRAN01
       ENDSR;
       // Lecture date et heure systeme
       BEGSR DATHEU;
      /END-FREE
     C                   TIME                    W14
     C                   MOVE      W14           WDAT
     C                   MOVEL     W14           WHEU
      /FREE
       ENDSR;
      /END-FREE

Dans les pro­chains billets, ce source va conti­nuer d’être tra­vaillé pour obser­ver ensemble l’é­vo­lu­tion vers la forme libre que j’ap­pelle complète.