ΓΒ©copyright 1

RPG 100 *ZEROS alpha ou numérique 200 *BLANKS alphanumérique 300 *HIVAL hexa 'ff' 99999+ alphanumérique 400 *LOVAL hexa '00' 99999- alphanumérique 500 *ALL'xxxx' 4 caractères maxi alpha ou numérique 600 700 I) Définition de fichier 1100 Positionnement n° de rang relatif 1200 F KRECNO RANG 1300 Changement de nom de format 1400 F Ancienformat KRENAMENvformat 1500 Contrôle du SFL 1600 F LIGNE KSFILE ART 1700 Omission d'un format d'enregistrement 1800 F FORMAT KIGNORE 1900 Gestion d'affichage en ligne variable 2000 F KSFL ligne de départ 2100 Gestion de la zone d'information fichier (I/O FEEBACK) 2200 F KINFDS INFDS 2300 * 2400 IINFDS DS 2500 I *FILE nom du fichier 2600 I *RECORD ENREG 2700 I *STATUS CODERREUR 2800 I *OPCODE CODEOPERATION 2900 I *ROUTINE SPR Traitement des erreurs par sous-programme 3100 F KINFDS INFSR Si aucun indicateur n'est mentionné en col 56/57 (lock) de l'instruct. provoquant l'erreur, le ss-pgm défini en description de fichier (KINFSR) recevra implicitement le contrôle. Lorsqu'une erreur survient, les informations d'état fichier sont mises à jour dans la structure de données correspondante (INFDS). L'indicateur (facultatif) mentionné en col 56/57 d'une instruction est mis en fonction si une erreur se produit pendant l'exécution de cette opération et permet d'appeler de manière explicite le ss-pgm de traitement de l'erreur. 3800 C OPEN FILE 80 3900 C 80 EXSR ERREUR Si le facteur 2 de l'opération ENDSR contient un point de retour spécifié par un des mots-clés suivants, le contrôle sera rendu à cette étape du pgm. Sinon traitement de l'erreur par un pgm d'erreur. 4300 *DETL début des lignes détail 4400 *GETIN lecture enreg 4500 *TOTC début de traitement total 4600 *TOTL début des lignes total 4700 *OFL début du traitment de dépassement de capacité 4800 (continuation au début des lignes de fin de page) 4900 *DETC début du traitement détail 5000 *CANCL fin du pgm (annulation de l'exécution du pgm) 5100 5200 FFichier1IF E DISK 5300 F Ancienformat KRENAMENvformat 5400 KRENAME permet de renommer un format 5500 5600 FFichier2IF E DISK KRECNO RFFD 5700 KRECNO positionnement n° de rang relatif 5800 C la 1re fois Z-ADD1 RFFD 50 5900 C RFFD SETLLNvformat 6000 C READ Nvformat 50 = 6100 6200 FFichier3IF E DISK UC 6300 UC ouverture et fermeture contrôlée du fichier 6400 C OPEN Fichier2 6500 C XXX xxx 6600 C CLOSEFichier2 6700 6800 FFécran1 CF E WORKSTN KINFDS DSSFL

ΓΒ©copyright 2

6900 KINFDS gestion de la zone d'information de fichier (nom data structure) 7000 IDSSFL DS 7100 récupération de la position du curseur 7200 I B 370 3710CURSOR 7300 nb d'enreg. dans le sous-fichier 7400 I B 378 3790SRRN 7500 7600 FFécran2 CF E WORKSTN 7700 F RRN KSFILE SFL 7800 F NOCLEAR KIGNORE 7900 KSFILE contrôle du sous-fichier 8000 KIGNORE omission d'un format d'enregistrement 8100 8200 II) Récupérer des zones de la *LDa ou INZCU 8600 *- Program DS (INRDEP10) 8700 récupérer attribut travail 8800 ID£PGM SDS 8900 I 1 10 P£PGM nom du pgm 9000 I 244 253 P£JOB nom du job(écran) 9100 I 254 263 P£USER nom de l'utilis. 9200 I 264 269 P£JOBI n° du travail 9300 I 276 2810P£DATE date pgm 9400 I *STATUS P£STUS 9500 I *PARMS PARM la zone PARM donnera le nombre exact de paramètre possédant une valeur. 9700 9800 *- DS QTEMP/INZCU 9900 I£ZCU DS 10000 I 1 256 ZCU 10100 *- DS *LDA Récupération attribut de la *LDA 10300 I UDS 10400 I 1 256 U£ZCU 10500 I 1 2 U£SOC 10600 I 5 14 U£USER 10700 I 15 16 U£SECV 10800 I 10241024 U£ERR 10900 * DEBUT PROGRAMME * 11000 C *NAMVAR DEFN INZCU £ZCU 11100 C write *LOCK IN *NAMVAR READ 11200 * FIN PROGRAMME * 11300 C £FIN TAG 11400 C MOVELU£ZCU ZCU 11500 C read OUT £ZCU WRITE 11600 C MOVEL'1' *INLR 11700 11800 * Permet d'utiliser des zones de la *LDA dans le pgm 11900 *- DS *LDA 12000 I UDS 12100 I 1 2 U£SOCI 12200 I 17 180U£SECA 12300 I 90 93 U£NDOS 12400 D001 C U£SECA IFEQ 96 12500 * interdiction de supprimer 12600 F001 C END < IFEQ 0161 12700 12800 * Chargement DTAARA Travail Utilisateur 12900 C *NAMVAR DEFN INZCU U£ZCU 13000 C IN U£ZCU 13100 13200 13300 III) Définition DS et autre 13600 I -1345676,24- C NUM2 13700 I 56 13800 I 'CHAR-CONST' C ALPH1 13900 14000 IDS2 DS 14100 I 1 2 ZON1 14200 I I 123 3 50ZON2

ΓΒ©copyright 3

14300 I I '5CHAR' 6 10 ZON3 14400 I I 'LA VALEUR CONTIENT..- 11 70 ZON4 14500 I 'TROIS- 14600 I 'LIGNES' 14700 I I ALPH1 71 90 ZON5 14800 I I NUM1 91 952ZON6 14900 IDS3 EIDS 15000 15100 Hexa 15200 I X'C1F2C3' C HEX1 15300 IV) Défintion de clé 15800 * DS de la Clé 15900 IDSKxx0 DS 4 16000 I 1 2 Kxx1 16100 I 3 4 Kxx2 16200 * Définition des KLIST de Travail 16300 C Kxx0 KLIST 16400 C KFLD Kxx1 16500 C KFLD Kxx2 16600 16700 V) Définition de paramètre d'un pgm 17100 C P£xxx PLIST 17200 C PARM I£xxxx 6 17300 C PARM 10 I£xx 20 donne la valeur de la zone 17400 C PARM xxxx I£xxx 2 17500 C PARM 'x' I£xxx 1 17600 C PARM *BLANKS O£xxxx 50 met zone à blanc à l'envoi 17700 C xxxx1 PARM 'xxxx' B£xxx 50 xxxx1 valeur retour > < = 17800 * valeur : retour envoyé 17900 C CALL 'xxxxxxxx'P£xxx 98 indic. pr pb pgm < 18000 C 98 MOVELERR,2 àERMSG 18100 ERR,2 --> l'appel du pgm s'est mal terminé 18200 VI) Définition de table 18700 * Tables 18800 E MSG 1 10 80 Messages Internes 18900 E CAH 7 4 2 19000 E T32 1 12 66 MAQUETTE PRTF 19100 E TEQ 8 8 2 19200 E CLS 1 5 10 NIV 1 0 Equiv. Classe / Niveau * la zone est défine en packée --> 4,2 en étendue = à 3,2 en packée 19400 I DS 19500 I P 1 21 CAH 19600 I P 1 32CAH001 19700 I P 4 62CAH002 19800 I P 7 92CAH003 19900 I P 10 122CAH004 20000 I P 13 152CAH005 20100 I P 16 182CAH006 20200 I P 19 212CAH007 20300 C Z-ADDCAH,I WHEURE 20400 * Substitution définition de colonne 20500 C MOVELTIT,1 àENTPA 20600 * 20700 OETAT E 101 ENTET1 20800 O T32,1 66 20900 O T32,2 132 21000 O E 1 ENTET1 21100 O T32,9 66 21200 O T32,10 132 21300 O FILE B 12 21400 O TEXT B 58 21500 O LIBL B 89 21600 O TYPE B 130 21700 * 21800 ** MSG Table des Messages Internes

ΓΒ©copyright 4

21900 xxxxxxxxxxxxxxx 22000 ** TIT pour substituer une entête dans Géode 22100 ---- REFERENCE ---- Heure Vitesse Tors. N° Réel Rendem. Turb. Coef. 22200 22300 ** T32 22400 ================================================================== 22500 ================================================================== 22600 :----------------------------------------------------------------- 22700 -----------------------------------------------------------------: 22800 : 22900 : 23000 : NOM TEXTE F REFERENCE 23100 FONCTION : 23200 : 23300 TYPE : : 23400 ============= * : LA LONGUEUR DE L'ENREGISTREMENT DU FICHIER LOGIQ 23500 UE EST DIFFERENTE DE CELLE DU FICHIER PHYSIQUE =================== 23600 23700 ** TEQ 23800 EQGTLTGELENENGNL 23900 24000 * 24100 * API 24200 IERROR DS 24300 * longueur de la DS en entrée 24400 I B 1 40INPUT 24500 * longueur de la DS en sortie 24600 I B 5 80OUTPUT 24700 * code du message 'CPFxxxx' 24800 I 9 15 MSGID 24900 * zone réservée 25000 I 16 16 RESERV 25100 * Extraire information utilisateur 25200 IRCVVAR DS 254 25300 I 19 28 USRCL 25400 I DS 25500 I B 1 40£NVAR 25600 * 25700 * Recherche de la classe du user 25800 C MOVEL*BLANKS ERROR 25900 C Z-ADD256 INPUT 26000 C Z-ADD254 £NVAR 26100 C CALL 'QSYRUSRI' 98 < 26200 C PARM *BLANKS RCVVAR 26300 C PARM £NVAR 26400 C PARM 'USRI0200'£FORMA 8 26500 C PARM EàUSER 26600 C PARM ERROR 26700 C N98 MOVELUSRCL £CLS 10 P 26800 * 26900 C Z-ADD1 X 10 27000 C £CLS LOKUPCLS,X 55 = 27100 C 55 MOVELNIV,X £NIV 10 27200 C SETOF 55 = 27300 * Classe utilisateur 27400 D003 C N55 CANN IFLT £NIV 27500 003 C SETON 55 > 27600 F003 C END < IFLT 0137 27700 ** TABLE DE TRANSLATION (Niveau de sécurité *système, Niveau chiffré) 27800 *SECOFR 0 27900 *SECADM 1 28000 *PGMR 2 28100 *SYSOPR 3 28200 *USER 4 28300 28400 VII) Redéfinition de zone 28800 C *LIKE DEFN WHRLEN ZHRLEN 28900 C *LIKE DEFN WHNFLD ZHNFLD 29000

ΓΒ©copyright 5

VIII) Déblocage d'enregistrement par EXCPT 29500 C EXCPTMAJxxx 29600 C EXCPTLIBxxx 29700 OFichier1E LIBxxx déblocage d'un enreg en MAJ 29800 OFichier1E MAJxxx 29900 O 80Zone1A 30000 O 81Zone2E IX) Ecriture à vide du SFL après suppression de tous les enreg. Il faut écrire une ligne à blanc dans le sous-fichier 30700 D001 C RRN IFEQ *ZEROS 30800 001 C ADD 1 RRN 30900 001 C EXSR $ZONBS remise à blanc zone SFL 31000 001 C SETON 89 31100 001 C WRITESFL 37 = 31200 F001 C END < IFEQ 0202 31300 89 positionne le curseur en haut à gauche de l'écran et protège l'option X) Ecriture x fenêtres sans perdre le fond de la fenêtre principal Il faut faire un WRITE du format de fond et ensuite call des autres fenêtre 32100 C EXFMTECRAN1 affichage normal 32200 C fenêtre1 CALL 'GCRCEEF0' écran1 reste affiché et fenêtre dessus 32300 C WRITEECRAN1 obligation d'écrire écran1 pour le 32400 C fenêtre2 CALL 'GCRCEEC0' garder avec la nvle fenêtre 32500 C WRITEECRAN1 32600 C fenêtre3 CALL 'GCRCEER0' 32700 IL FAUT COMPILER LE DSPF AVEC RSTDSP(*YES) DFRWRT(*NO) XI) Lecture d'un fichier par n° relatif (ANRCFR10) 33300 FANPPRFI0IF E DISK KINFDS QSDS 33400 * 33500 IQSDS DS 33600 I B 156 1590REC 33700 I B 397 4000QRRN 33800 * 33900 C N36 READ PRFI0P 38 = 34000 C N36 Z-ADDQRRN SVQRRN 30 34100 * si ENTREE = *ON repositionnement du SFL au début 34200 C 36 Z-ADDSVQRRN QRRN 34300 C SETOF 36 = 34400 C QRRN SETLLPRFI0P 34500 * 34600 D001 C *IN36 DOWEQ*OFF 34700 001 C READ PRFI0P 36 = XII) Divers La ss-brutine *INZSR passe en premier ds un pgm. Je sors de ce pgm par un RETRN. Le pgm reste chargé ds le pgm appelant, donc qd je retourne ds ce pgm, il ne passe plus ds *INZSR. Qd on utilise un *INZSR, il veut mieux sortir du pgm par un SETON LR, car à chaque appel il y repasse. 35600 Ds le *INZSR, il ne faut pas mettre des tests concernant la *LDA, car celle-ci n'est pas encore chargée. 35900 ******************* Par défaut les nombres numériques sont cadrés à droite de la zone avec des zéros devant, si la zone n'est pas entièrement remplie. Par défaut les alphas sont cadrés à gauche de la zone avec des blancs derrières, si la zone n'est pas complètement remplie. 36500 ******************* Un fichier décrit ds les cartes F en O ne peut pas avoir des cartes I (C/O) Un fichier décrit ds les cartes F en I ne peut pas avoir des cartes O (I/C) 36900 ******************* 37100 FETAT OF 132 OF LPRINTER 37200 LETAT 69FL 60OL 37300 ETAT nom du fichier imprimante comme indiqué sur spécif F 69 (nombre de ligne) valeur 2 à 112 nb de ligne d'impression disponible

ΓΒ©copyright 6

FL (longueur de page) indique que l'entrée précédente est la longueur de l'imprimé (veut dire longueur 69) 60 (n°ligne de fin de page) valeur 2 à 112 pour indiquer la lg de fin pg OL (ligne de fin de page) indique que l'entrée précédente est la ligne de fin de page code extension = L les spécif de saut complètent la description du fichier E les spécif d'extension complètent la description du file 38200 ******************* Pour un fichier décrit en interne, on ne peut pas mettre de KLIST. Mettre ds les spécif F AI. Il faut créer une zone clé ds DS et mover à l'intérieur MOVE A CLE 38600 ******************* Si un fichier est vide et qu'il est définit ds un pgm en primaire, le pgm ne se déroule pas car il ne rentre même pas ds le pgm. 39000 ******************* Copier un fichier dans lui même : le pgm une zone en packé 39300 315 39400 __________________|___|_A_________________ 916 de long 39500 312 314 39600 A-> 39700 __________________|____|_A_________________917 de long 39800 312 315 39900 40000 FXXXX UP 917 F DISK 40100 IXXXX NS 01 40200 I 1 311 ZON1 40300 I P 314 314 ZONX 40400 I 315 916 ZON2 si on veut garder la zone X qui est packé 40600 C MOVE ZONX ZONY 40700 OXXXX D 01 40800 O ZON1 311 40900 O 315 '____' ZONY 315 41000 O ZON2 917 DEFINITION DES FICHIERS 41400 F pour afficher une fenêtre sur un fond écran initial 41500 X CRTDSPF RSTDSP(*YES) DFRWRT(*NO) 41600 X + WRITE du format initial avant appel Fenêtre Emploi du slash copy (fichier source/nom objet) 42000 /COPY QRPGSRC,OBJCOPY 42100 I Remise à blanc d'une DS (nom de DS obligatoire) ou de tout type de format (dans ce cas *OFF des indic.) 42600 C CLEARNMDS ou d'enregistrement except. des zones clé 42800 C *NOKEY CLEARFMT Définition de zones 43000 C *LIKE DEFN ZONREP ZONE Module Appel d'un pgm batch depuis un pgm interactif 43400 E Définition d'une table 43500 E T80 80 80 1 SBMJOB Passage de la valeur du paramètre 43700 C MOVEAPARAM T80,50 Appel de QCAEXEC 43900 C CALL 'QCAEXEC' 44000 C PARM T80 44100 C PARM 80 àLNGCD 155 Initialisation de la table 44300 ** 44400 SBMJOB JOB(CMD ) JOBD(ELEVE05 ) RQSDTA('CMD ') GESTION DES MSG ERREUR PAR QCMEXEC AVEC RECUP DU PARAM 44800 C tableau du libellé CMD 44900 E T81 80 80 1 45000 C envoi sur SR error 45100 C *IN51 DOWEQ'0'

ΓΒ©copyright 7

45200 C OPTION CASEQ'4' SUPPR 45300 C CAS ERROR 45400 C END 45500 C 45600 C ERROR BEGSR 45700 C OPTION IFNE *BLANK 45800 C SETON 31 45900 C MOVEAOPTION T81,38 46000 C CALL 'QCMDEXC' 46100 C PARM T81 46200 C PARM 80 TEST 155 réafficher le FMT pour MSG 46400 C WRITEFMT3 46500 C SETOF 31 46600 C END 46700 C ENDSR 46800 ** T81 46900 CHGMSGD DIS0004 COURS/MSGDIS 'OPTION X INVALIDE!!' Traitement d'un fichier par N° enregistremnet 47300 FQRYFIL IF F 256 DISK KINFDS QSDS 47400 F --------1 47500 IQRYFIL NS 01 47600 I --------1 47700 IQSDS DS 47800 I B 397 4000QRRN Lire fichier et traiter chaque records trouvé 48000 C READ QRYFIL LR 48100 C 48200 C *INLR DOWEQ'0' chain pour update(FILE02 en UF) 48400 C QRRN CHAINFILE02 52 mise a jour 48600 C UPDATFILE02 lecture du suivant 48800 C READ QRYFIL LR 48900 C END 49000 C Convertion de date avec IDS 49400 IDS1 IDS 49500 I 1 60DATAMJ 49600 I I '00' 1 2 YY 49700 I I '00' 3 4 MM 49800 I I '00' 5 6 DD 49900 C MOVE '921231' DATAMJ 50000 C DD CAT MM:0 DATNUM 6 ' 50100 C DATNUM CAT YY:0 DATNUM ' 50200 C RESETDS1 50300 C MOVE DATNUM DATJMA 60 Avec overflow numeric 50500 C 123192 MULT 100,0001 DATJM1 60 50600 C SETON LR Conversion des caractères non imprimable par MATRI. 51000 X François ===> Francois 51100 I 'aaaaae- C US 51200 I 'c- 51300 I 'eee- 51400 I 'iiii- 51500 I 'n' 51600 I 'aâàaae- C XA 51700 I 'ç- 51800 I 'éêè- 51900 I 'iîÏi- 52000 I 'n' 52100 C MOVEL'François'NAME 20 52200 C XA:US XLATENAME TRANAM 20