Coder en RPG IV colonné, les mêmes programmes, en plus lisible

Programme 1 Hello world

Hello world : une déclaration, deux calculs

*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
     D* HELLO : le premier programme RPG IV
     DMsg              S             13A   Inz('Hello world !')
     C     Msg           DSPLY
     C                   EVAL      *INLR = *ON

DMsg S 13A Inz('Hello world !')

Une zone simple (S) de 13 caractères (A), avec sa valeur initiale. Le littéral est en zone mots-clés : plus besoin de MOVEL puis MOVE comme en RPG III.

C Msg DSPLY

Affiche le facteur 1, comme en RPG III.

C EVAL *INLR = *ON

Allume LR par une affectation, en facteur 2 étendu.

CRTBNDRPG PGM(JOBIR4/HELLO) SRCFILE(JOBIR4/QRPGLESRC) DBGVIEW(*SOURCE)
CALL HELLO

Programme 2 Sans écran, avec un PF à clé

Sortir du stock un article lu par sa clé

Même rôle, mêmes paramètres et mêmes codes retour qu'en RPG III : SORTIE reçoit un code article et une quantité, et rend OK, INC ou INS.

*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
     FARTICLE   UF   E           K DISK
     D* SORTIE : sortie de stock d'un article, sans ecran.
     D* Parametres : code article, quantite (5 chiffres),
     D* code retour : OK, INC (inconnu), INS (stock insuffisant)
     DSORTIE           PI
     D PCode                          5A
     D PQteA                          5A
     D PRet                           3A
     DQte              S              5P 0
     C*
     C                   EVAL      Qte = %DEC(PQteA:5:0)
     C     PCode         CHAIN     ARTICLE
     C                   IF        NOT %FOUND(ARTICLE)
     C                   EVAL      PRet = 'INC'
     C                   ELSEIF    Qte > ARTSTK
     C                   EVAL      PRet = 'INS'
     C                   ELSE
     C                   EVAL      ARTSTK = ARTSTK - Qte
     C                   UPDATE    ARTICLR
     C                   EVAL      PRet = 'OK '
     C                   ENDIF
     C                   EVAL      *INLR = *ON

FARTICLE UF E K DISK

La même déclaration qu'en RPG III, aux nouvelles positions : U en 17, F en 18, E en 22, K en 34, DISK en 36.

DSORTIE PI et les trois lignes suivantes

L'interface du programme : les paramètres reçus, avec leur longueur et leur type. Elle remplace le *ENTRY PLIST. Sur IBM i 7.5, aucun prototype n'est exigé pour le programme principal.

DQte S 5P 0

La quantité en décimal condensé de 5 chiffres, déclarée à part au lieu de l'être dans un MOVE.

EVAL Qte = %DEC(PQteA:5:0)

%DEC convertit le texte reçu en nombre.

C PCode CHAIN ARTICLE puis IF NOT %FOUND(ARTICLE)

Plus d'indicateur : %FOUND dit si le CHAIN a trouvé l'article.

ELSEIF Qte > ARTSTK

Une seule structure IF, ELSEIF, ELSE, ENDIF, au lieu de deux IF imbriqués.

UPDATE ARTICLR

UPDATE en toutes lettres, toujours sur le nom du format.

Ce qui a changé depuis le RPG III

CRTBNDRPG PGM(JOBIR4/SORTIE) SRCFILE(JOBIR4/QRPGLESRC) DBGVIEW(*SOURCE)

Programme 3 Un écran, un PF et un LF

Consulter un article par son code ou par son libellé

L'écran ARTECR et le LF ARTICL1 sont repris tels quels. Le programme fait la même chose qu'en RPG III, mais la boucle et les tests se lisent en clair :

*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
     FARTECR    CF   E             WORKSTN
     FARTICLE   IF   E           K DISK
     FARTICL1   IF   E           K DISK
     C* ARTCON : consultation d'un article par son code (PF)
     C* ou par le debut de son libelle (LF). F3 pour sortir.
     C                   DOW       NOT *IN03
     C                   EXFMT     ECRAN
     C                   IF        *IN03
     C                   LEAVE
     C                   ENDIF
     C                   EVAL      *IN41 = *OFF
     C                   EVAL      *IN42 = *OFF
     C                   IF        ECODE <> *BLANKS
     C* Un code : acces direct par la cle du PF
     C     ECODE         CHAIN     ARTICLE
     C                   EVAL      *IN41 = NOT %FOUND(ARTICLE)
     C                   ELSE
     C* Sinon : positionnement dans le LF, puis lecture
     C     ERECH         SETLL     ARTICL1
     C                   READ      ARTICL1
     C                   EVAL      *IN42 = %EOF(ARTICL1)
     C                   ENDIF
     C* Rien trouve : on vide la fiche
     C                   IF        *IN41 OR *IN42
     C                   CLEAR                   ARTCOD
     C                   CLEAR                   ARTLIB
     C                   CLEAR                   ARTSTK
     C                   ENDIF
     C                   ENDDO
     C                   EVAL      *INLR = *ON

DOW NOT *IN03 … LEAVE

La boucle tourne tant que F3 n'est pas pressée ; LEAVE sort aussitôt après l'écran, sans refaire de recherche.

EVAL *IN41 = NOT %FOUND(ARTICLE)

L'indicateur 41 conditionne toujours le message « Article inconnu. » des DDS : on lui donne la valeur de %FOUND.

EVAL *IN42 = %EOF(ARTICL1)

Même chose pour le message 42, après le READ dans le LF.

CLEAR ARTCOD

CLEAR remet une zone à blanc ou à zéro selon son type : plus besoin de MOVE *BLANKS et Z-ADD 0.

CRTPF     FILE(JOBIR4/ARTICLE) SRCFILE(JOBIR4/QDDSSRC)
CRTLF     FILE(JOBIR4/ARTICL1) SRCFILE(JOBIR4/QDDSSRC)
CRTDSPF   FILE(JOBIR4/ARTECR) SRCFILE(JOBIR4/QDDSSRC)
CRTBNDRPG PGM(JOBIR4/ARTCON) SRCFILE(JOBIR4/QRPGLESRC) DBGVIEW(*SOURCE)
CALL ARTCON

Les quatre essais de la page RPG III (code connu, libellé, code inconnu, recherche vide) donnent les mêmes écrans, au caractère près.