Moderniser votre code RPG avec Agilité – Partie 2
mar 23 juin 2020Du RPG IV colonné au Free-form 1re étape la fonction intégrée à RDI
Pour passer du RPG IV issu de la partie 2 au Free-form, il est nécessaire de passer par plusieurs étapes : nous allons décrire ici celle de la fonction présente dans RDI
Dans Rdi, utiliser la fonction Source–>Convertir tout au format libre.
Contrairement à ce que le nom de la fonction pourrait nous faire penser, la conversion n’est pas complète. Seule les lignes « Calculation » sont convertis mais pas toutes. Les mot-clefs qui n’ont pas de correspondance en Free-form restent tel-que.
Si nous reprenons le source résultat 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-FREEComme vous pouvez le voir, certaines lignes ne sont pas convertis :
- les déclarations autre que « Calculations » (F, D, H etc…),
Pour les transformer en format libre, vous pouvez utiliser le plugin JCRCMDS pour RDI ou la version par commande.
- la déclaration des paramètres (*ENTRY), nous aurions dû avoir une « Procédure Interface Definition » (Dcl-pi),
- Ici nous aurions :
Dcl-pi Liste_des_client Extpgm('LSTCLT');
$Codcli Char(8);
End-pi;- Les opérateurs MOVE, Z‑ADD,
- Move sera remplacé par des combinaisons d’Eval, Evalr et éventuellement une %BIF.
- L’usage d’indicateur dans les colonnes 9, 10 et 11 etc… pourra être remplacé par des indicateurs nommés, plus clair.
- Les déclarations de clef KLIST ne sont pas transformés
Nous verrons dans d’autres billets ces cas particuliers.
Autre exemple, la gestion 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 application de l’option de conversion en format 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-FREEDans les prochains billets, ce source va continuer d’être travaillé pour observer ensemble l’évolution vers la forme libre que j’appelle complète.
[…] Moderniser votre code RPG avec Agilité – Partie 2 […]
[…] Moderniser votre code RPG avec Agilité – Partie 2 […]