Rendre lisible les postes du journal du DSPJRN
lun 4 février 2019DSPJRN est la commande qui permet de voir les postes du journal.
Et ce que l’on aime, c’est de voir le contenu de l’enregistrement concerné. Mais voilà l’enregistrement est placé brut dans une zone de type caractère, la plupart du temps illisible s’il y a des champs en Decimal Packed. Voici une petite commande qui permet de le rendre lisible : DSPJRNPST
Elle se compose des étapes de création suivantes :
- Création d’un membre source DDS à partir des caractéristiques du fichier type1 d’une sortie de DSPJRN dans le dernier champ,
- et création du source DDS du fichier dont nous voulons les postes du journal,
- Les deux membres sources constitués précédemment sont concaténés pour n’en former qu’un seul,
- Le source obtenu est compilé pour obtenir un fichier,
- la commande DSPJRN est lancé et récupère les postes insérés directement en sortie dans le fichier constitué précédemment,
- et pour finir un QUERY(obsolète, c’est une partie à revoir) pour voir le contenu
Le source de la commande DSPJRNPST :
CMD PROMPT('AFFICHAGE POSTE JOURNAL')
PARM KWD(JRN) TYPE(QJRN) MIN(1) PROMPT('JOURNAL')
QJRN: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) DFT(*CURLIB) SPCVAL((*CURLIB *CURLIB) (*LIBL)) +
PROMPT('BIBLIOTHÈQUE')
PARM KWD(FILE) TYPE(QFILE) MIN(1) PROMPT('FICHIER')
QFILE: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) DFT(*CURLIB) SPCVAL((*CURLIB *CURLIB)) +
PROMPT('BIBLIOTHÈQUE')
PARM KWD(FROMTIME) TYPE(QFROMTIME) PROMPT('DATE ET HEURE DE DÉBUT')
QFROMTIME: QUAL TYPE(*NAME) LEN(10) DFT(*CURRENT) SPCVAL((*CURRENT '*CURRENT'))
QUAL TYPE(*NAME) LEN(8) PROMPT('HEURE DE DÉBUT')
PARM KWD(TOTIME) TYPE(QTOTIME) MIN(0) PROMPT('DATE ET HEURE DE FIN')
QTOTIME: QUAL TYPE(*NAME) LEN(10) DFT(*NONE) SPCVAL((*NONE '*NONE'))
QUAL TYPE(*NAME) LEN(8) PROMPT('HEURE DE FIN')
PARM KWD(PGM) TYPE(QPGM) MIN(1) PROMPT('PROGRAMME')
QPGM: QUAL TYPE(*NAME) LEN(10) DFT(*ALL) SPCVAL((*ALL))
PARM KWD(RCVRNGD) TYPE(QRCVRNG) MIN(1) PROMPT('PLAGE DE RÉCEPTEURS DE +
JOURNAL')
QRCVRNG: QUAL TYPE(*NAME) LEN(10) DFT(*CURRENT) SPCVAL((*CURRENT *CURRENT))
QUAL TYPE(*NAME) LEN(10) DFT(*CURLIB) SPCVAL((*CURLIB *CURLIB) (*LIBL)) +
PROMPT('BIBLIOTHÈQUE')
PARM KWD(RCVRNGF) TYPE(QRCVRNG2)
QRCVRNG2: QUAL TYPE(*NAME) LEN(10) DFT(*NONE) SPCVAL((*NONE '*NONE'))
QUAL TYPE(*NAME) LEN(10) SPCVAL((*CURLIB *CURLIB) (*LIBL)) +
PROMPT('BIBLIOTHÈQUE')
PARM KWD(FROMENTLRG) TYPE(*CHAR) LEN(25) DFT(*NONE) SPCVAL((*NONE '*NONE')) +
PROMPT('PREMIER NUM. SÉQ. MAXI')
PARM KWD(TOENTLRG) TYPE(*CHAR) LEN(25) DFT(*NONE) SPCVAL((*NONE '*NONE')) +
PROMPT('DERN. NUM. SÉQ. MAXI')
PARM KWD(JOB) TYPE(QJOB) MIN(1) PROMPT('TRAVAIL')
QJOB: QUAL TYPE(*NAME) LEN(10) DFT(*ALL) SPCVAL((*ALL))
QUAL TYPE(*NAME) LEN(10) PROMPT('UTILISATEUR')
QUAL TYPE(*CHAR) LEN(6) RANGE(000000 999999) PROMPT('NUMÉRO')
Cette commande appelle le CLLE RTVJRNPST :
PGM PARM(&QJRN &QFILE &QFROMTIME &QTOTIME &PGM &QRCVRNG1 &QRCVRNG2 +
&FROMENTLRG &TOENTLRG &QJOB)
DCL VAR(&QJRN) TYPE(*CHAR) LEN(20)
DCL VAR(&JRN) TYPE(*CHAR) LEN(10)
DCL VAR(&BIBJRN) TYPE(*CHAR) LEN(10)
DCL VAR(&QFILE) TYPE(*CHAR) LEN(20)
DCL VAR(&FIC) TYPE(*CHAR) LEN(10)
DCL VAR(&FICJRN) TYPE(*CHAR) LEN(10)
DCL VAR(&BIBFIC) TYPE(*CHAR) LEN(10)
DCL VAR(&MBR) TYPE(*CHAR) LEN(10) VALUE('*FIRST')
DCL VAR(&BIBOBJ) TYPE(*CHAR) LEN(10)
DCL VAR(&OBJ) TYPE(*CHAR) LEN(10)
DCL VAR(&TYPOBJ) TYPE(*CHAR) LEN(7)
DCL VAR(&MBROBJ) TYPE(*CHAR) LEN(10)
DCL VAR(&OBJPATH) TYPE(*CHAR) LEN(50)
DCL VAR(&INCLOBJ) TYPE(*CHAR) LEN(8) VALUE('*INCLUDE')
DCL VAR(&SUBTREE) TYPE(*CHAR) LEN(5) VALUE('*NONE')
DCL VAR(&MASQUE) TYPE(*CHAR) LEN(450) VALUE('*')
DCL VAR(&INCMASQ) TYPE(*CHAR) LEN(8) VALUE('*INCLUDE')
DCL VAR(&QRCVRNG1) TYPE(*CHAR) LEN(20)
DCL VAR(&RCVRNG1) TYPE(*CHAR) LEN(10)
DCL VAR(&BIBRCV1) TYPE(*CHAR) LEN(10)
DCL VAR(&QRCVRNG2) TYPE(*CHAR) LEN(20)
DCL VAR(&RCVRNG2) TYPE(*CHAR) LEN(10)
DCL VAR(&BIBRCV2) TYPE(*CHAR) LEN(10)
DCL VAR(&FROMENTLRG) tyPE(*CHAR) LEN(25)
DCL VAR(&QFROMTIME) TYPE(*CHAR) LEN(20)
DCL VAR(&FROMTIME) TYPE(*CHAR) LEN(8)
DCL VAR(&FROMDATE) TYPE(*CHAR) LEN(12)
DCL VAR(&TOENTLRG) TYPE(*CHAR) LEN(25)
DCL VAR(&QTOTIME) TYPE(*CHAR) LEN(20)
DCL VAR(&TOTIME) TYPE(*CHAR) LEN(8)
DCL VAR(&TODATE) TYPE(*CHAR) LEN(12)
DCL VAR(&NBRENT) TYPE(*CHAR) LEN(10) value('*ALL')
DCL VAR(&CDJRN) TYPE(*CHAR) LEN(50) value('*ALL')
DCL VAR(&ENTTYP) TYPE(*CHAR) LEN(50) value('*ALL')
DCL VAR(&QJOB) TYPE(*CHAR) LEN(26)
DCL VAR(&NUMJOB) TYPE(*CHAR) LEN(6)
DCL VAR(&NOMJOB) TYPE(*CHAR) LEN(10)
DCL VAR(&PRF) TYPE(*CHAR) LEN(10)
DCL VAR(&PGM) TYPE(*CHAR) LEN(10)
DCL VAR(&CCIDLRG) TYPE(*CHAR) LEN(24) value('*ALL')
DCL VAR(&DEPENT) TYPE(*CHAR) LEN(5) value('*ALL')
DCL VAR(&OUTFMT) TYPE(*CHAR) LEN(5) value('*CHAR')
DCL VAR(&JRNID) TYPE(*CHAR) LEN(5)
DCL VAR(&INCHIDENT) TYPE(*CHAR) LEN(4) value('*NO')
DCL VAR(&OUTPUT) TYPE(*CHAR) LEN(7) value('*')
DCL VAR(&OUTFILFMT) TYPE(*CHAR) LEN(6) value('*TYPE1')
DCL VAR(&BIBOUTF) TYPE(*CHAR) LEN(10) value('QTEMP')
DCL VAR(&OUTFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&OUTMBR) TYPE(*CHAR) LEN(10) value('*FIRST')
DCL VAR(&REPLACE) TYPE(*CHAR) LEN(8) value('*REPLACE')
DCL VAR(&ENTDTALEN) TYPE(*CHAR) LEN(10) value('*CALC')
DCL VAR(&LNGENTDTA) TYPE(*CHAR) LEN(10)
DCL VAR(&LNGAENTDTA) TYPE(*CHAR) LEN(10)
DCL VAR(&NULLINDLEN) TYPE(*CHAR) LEN(10) value('*OUTFILFMT')
DCL VAR(&LNGNULLIND) TYPE(*CHAR) LEN(10)
DCL VAR(&LNGANULLIN) TYPE(*CHAR) LEN(10)
DCL VAR(&INCENT) TYPE(*CHAR) LEN(10) value('*CONFIRMED')
DCL VAR(&FROMENT) TYPE(*CHAR) LEN(16) value('*FIRST')
DCL VAR(&TOENT) TYPE(*CHAR) LEN(16) value('*LAST')
DCL VAR(&CMTCYCID) TYPE(*CHAR) LEN(16) value('*ALL')
DCL VAR(&ASPDEV) TYPE(*CHAR) LEN(9) value('*')
DCL VAR(&CMD) TYPE(*CHAR) LEN(500)
DCL VAR(&LNGCMD) TYPE(*DEC) LEN(15 5) VALUE(500)
DCL VAR(&TEXT) TYPE(*CHAR) LEN(50)
DCL VAR("E) TYPE(*CHAR) LEN(3) VALUE('''')
CHGVAR VAR(&BIBJRN) VALUE(%SST(&qjrn 11 10))
CHGVAR VAR(&JRN) VALUE(%SST(&qjrn 1 10))
CHGVAR VAR(&BIBfic) VALUE(%SST(&qfile 11 10))
CHGVAR VAR(&fic) VALUE(%SST(&qfile 1 10))
CHGVAR VAR(&FROMDATE) VALUE(%SST(&QFROMTIME 1 10))
CHGVAR VAR(&FROMTIME) VALUE(%SST(&QFROMTIME 11 8))
CHGVAR VAR(&TODATE) VALUE(%SST(&QTOTIME 1 10))
CHGVAR VAR(&TOTIME) VALUE(%SST(&QTOTIME 11 8))
CHGVAR VAR(&RCVRNG1) VALUE(%SST(&QRCVRNG1 1 10))
CHGVAR VAR(&BIBRCV1) VALUE(%SST(&QRCVRNG1 11 10))
CHGVAR VAR(&RCVRNG2) VALUE(%SST(&QRCVRNG2 1 10))
CHGVAR VAR(&BIBRCV2) VALUE(%SST(&QRCVRNG2 11 10))
CHGVAR VAR(&NOMJOB) VALUE(%SST(&QJOB 1 10))
CHGVAR VAR(&PRF) VALUE(%SST(&Qjob 11 10))
CHGVAR VAR(&NUMJOB) VALUE(%SST(&QJOB 21 6))
CHGVAR VAR(&FICJRN) VALUE(%SST(&FIC 1 7) *TCAT 'JRN')
DLTF FILE(QTEMP/&FICJRN)
MONMSG MSGID(CPF0000)
DLTF FILE(QTEMP/QDDSSRC)
MONMSG MSGID(CPF0000)
CRTSRCPF FILE(QTEMP/QDDSSRC) RCDLEN(112)
DLTF FILE(QTEMP/RTVPFSRC1)
MONMSG MSGID(CPF0000)
CHARGE: DSPFD FILE(&BIBFIC/&FIC) TYPE(*ACCPTH) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/RTVPFSRC1)
DLTF FILE(QTEMP/RTVPFSRC)
MONMSG MSGID(CPF0000)
RTVMBRD FILE(&BIBFIC/&FIC) TEXT(&TEXT)
DSPFFD FILE(&BIBFIC/&FIC) OUTPUT(*OUTFILE) OUTFILE(QTEMP/RTVPFSRC)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDUSRMSG MSG(&BIBFIC *TCAT '/' *TCAT &FIC *BCAT 'n''existe pas')
GOTO CMDLBL(FIN)
ENDDO
ADDPFM FILE(QTEMP/QDDSSRC) MBR(&FIC) TEXT(&TEXT) SRCTYPE(PF)
OVRDBF FILE(QDDSSRC) TOFILE(QTEMP/QDDSSRC) MBR(&FIC)
CALL PGM(RTVPFSRC)
DLTOVR FILE(*ALL)
CPYF FROMFILE(*libl/QDDSSRC) TOFILE(QTEMP/QDDSSRC) FROMMBR(ENTJRN) +
TOMBR(ENTJRN) MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*MAP *DROP)
CPYF FROMFILE(QTEMP/QDDSSRC) TOFILE(QTEMP/QDDSSRC) FROMMBR(&FIC) +
TOMBR(ENTJRN) MBROPT(*ADD) FMTOPT(*MAP *DROP)
CRTPF FILE(QTEMP/&FICJRN) SRCFILE(QTEMP/QDDSSRC) SRCMBR(ENTJRN) SIZE(*NOMAX)
CHGVAR VAR(&CMD) VALUE('DSPJRN JRN(' *TCAT &BIBJRN *TCAT '/' *TCAT &JRN *TCAT +
') FILE((' *TCAT &BIBFIC *TCAT '/' *TCAT &FIC *BCAT &MBR *TCAT ')) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/' *TCAT &FIC *TCAT ') +
ENTDTALEN(*CALC)')
IF COND(&NOMJOB *NE *ALL) THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'JOB(' +
*TCAT &NUMJOB *TCAT '/' *TCAT &PRF *TCAT '/' *TCAT &NOMJOB *TCAT +
')'))
IF COND(&PGM *NE *ALL) THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'PGM(' +
*TCAT &PGM *TCAT ')'))
IF COND(&FROMENTLRG *NE '*NONE') THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT +
'FROMENTLRG(' *TCAT &FROMENTLRG *TCAT ')'))
IF COND(&TOENTLRG *NE '*NONE') THEN(CHGVAR VAR(&CMD) VALUE(&CMD *BCAT +
'TOENTLRG(' *TCAT &TOENTLRG *TCAT ')'))
IF COND(&FROMDATE *NE '*CURRENT') THEN(DO)
CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'FROMTIME(''' *TCAT &FROMDATE *BCAT +
&FROMTIME *TCAT ''')')
ENDDO
IF COND(&TODATE *NE '*NONE') THEN(DO)
CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'TOTIME(''' *TCAT &TODATE *BCAT &TOTIME +
*TCAT ''')')
ENDDO
IF COND(&RCVRNG1 *NE *CURRENT) THEN(do)
CHGVAR VAR(&CMD) VALUE(&CMD *BCAT 'RCVRNG(' *TCAT &BIBRCV1 *TCAT '/' *TCAT +
&RCVRNG1)
IF COND(&RCVRNG2 *NE ' ') THEN(CHGVAR VAR(&CMD) VALUE(&CMD +
*BCAT &BIBRCV2 *TCAT '/' *TCAT &RCVRNG2 ))
CHGVAR VAR(&CMD) VALUE(&CMD *TCAT ')')
ENDDO
CALL PGM(QCMDEXC) PARM(&CMD &LNGCMD)
CPYF FROMFILE(QTEMP/&FIC) TOFILE(QTEMP/&FICJRN) MBROPT(*REPLACE) +
FMTOPT(*NOCHK) ERRLVL(*NOMAX)
RUNQRY QRYFILE((QTEMP/&FICJRN *FIRST)) RCDSLT(*YES)
FIN: ENDPGM
Le programme RTVPFSRC permet de régénérer un source à partir du DSPFFD d’un fichier :
FQDDSSRC O A E DISK
F RENAME(QDDSSRC:SOURCE)
FRTVPFSRC IP E DISK
FRTVPFSRC1 IF E DISK
DSRCDTA DS
DT 1 DIM(80)
DXHFLDP DS
DU 1 DIM(2)
DXHFLDB DS
DV 1 DIM(5)
DXHFLDD DS
DW 1 DIM(2)
DED1 S 1 DIM(10) CTDATA PERRCD(10)
* format fichier
C READ RTVPFSRC1 41
*
C MOVEA *BLANKS T
C MOVEA WHFLDI T(19)
C MOVEL WHFLDP XHFLDP
C MOVEL WHFLDB XHFLDB
C MOVEL WHFLDD XHFLDD
* cadrage droite zero suppress
C U(1) IFEQ '0'
C MOVE ' ' U(1)
C ENDIF
C DO 4 X 2 0
C Z-ADD 1 Y 2 0
C V(X) LOOKUP ED1(Y) 40
C N40 MOVE ' ' V(X)
C ENDDO
C W(1) IFEQ '0'
C MOVE ' ' W(1)
C ENDIF
C SELECT
* zone date
C WHFLDT WHENeq 'L'
C MOVE *blank XHFLDD
C MOVE *blank XHFLDP
C MOVE *blank wHFLDD
C MOVE *blank wHFLDP
* zone horodatage
C WHFLDT WHENeq 'T'
C MOVE *blank XHFLDD
C MOVE *blank XHFLDP
C MOVE *blank wHFLDD
C MOVE *blank wHFLDP
* zone alpha
C WHFLDD WHENEQ 0
C MOVEA XHFLDB T(30)
C MOVEA ' ' T(36)
* zone signée
C WHFLDD WHENEQ WHFLDB
C MOVEA XHFLDD T(33)
C MOVEA XHFLDP T(36)
* zone packee
C WHFLDD WHENNE WHFLDB
C MOVEA XHFLDD T(33)
C MOVEA XHFLDP T(36)
C ENDSL
C MOVEA WHFLDT T(35)
C MOVE *BLANKS WKA036 36
* texte zone
C WHFTXT IFNE *BLANKS
C '''':' ' XLATE WHFTXT WHFTXT
C ' ' CHECKR WHFTXT WKN002 2 0
C WKN002 IFGT 28
C MOVEL WHFTXT WKA027 27
C MOVE WHFTXT WKA023 23
C 'TEXT(''' CAT WKA027:0 WKA036
C WKA036 CAT '+':0 WKA036
C MOVEA WKA036 T(45)
C EXSR WTR
C MOVE *BLANKS WKA036
C WKA023 CAT ''')':0 WKA036
C MOVEA WKA036 T(45)
C EXSR WTR
C ELSE
C 'TEXT(''' CAT WHFTXT:0 WKA036
C WKA036 CAT ''')':0 WKA036
C MOVEA WKA036 T(45)
C EXSR WTR
C ENDIF
C ENDIF
* colhdg
C WHCHD1 IFNE *BLANKS
C '''':' ' XLATE WHCHD1 WHCHD1
C MOVE *BLANKS WKA036
C 'COLHDG(''' CAT WHCHD1:0 WKA036
C WHCHD2 IFNE *BLANKS
C WKA036 CAT ''' +':0 WKA036
C ELSE
C WKA036 CAT ''')':0 WKA036
C ENDIF
C MOVEA WKA036 T(45)
C EXSR WTR
C ENDIF
C WHCHD2 IFNE *BLANKS
C '''':' ' XLATE WHCHD2 WHCHD2
C MOVE *BLANKS WKA036
C '''' CAT WHCHD2:0 WKA036
C WHCHD3 IFNE *BLANKS
C WKA036 CAT ''' +':0 WKA036
C ELSE
C WKA036 CAT ''')':0 WKA036
C ENDIF
C MOVEA WKA036 T(45)
C EXSR WTR
C ENDIF
C WHCHD3 IFNE *BLANKS
C '''':' ' XLATE WHCHD3 WHCHD3
C MOVE *BLANKS WKA036
C '''' CAT WHCHD3:0 WKA036
C WKA036 CAT ''')':0 WKA036
C MOVEA WKA036 T(45)
C EXSR WTR
C ENDIF
* Format de la date.
C WHFMT IFNE *BLANKS
c WHFLDT andeq 'L'
C eval WKA036='DATFMT('+WHFMT+')'
C MOVEA WKA036 T(45)
C EXSR WTR
C ENDIF
* Format de l'heure
C WHFMT IFNE *BLANKS
c WHFLDT andeq 'T'
C eval WKA036='TIMFMT('+WHFMT+')'
C MOVEA WKA036 T(45)
C EXSR WTR
C ENDIF
*
CLR EXSR ROOT
*
CSR WTR BEGSR
C ADD 10 SRCSEQ
C MOVEA 'A' T(6)
C WRITE SOURCE
C MOVEA *BLANKS T
CSR ENDSR
*
CSR ROOT BEGSR
C REDO TAG
C APKEYF IFNE *BLANKS
C MOVEA 'K' T(17)
C MOVEA APKEYF T(19)
C APKSEQ IFEQ 'D'
C MOVEA 'DESCEND' T(45)
C ENDIF
C EXSR WTR
C ENDIF
C *IN41 IFNE '1'
C READ RTVPFSRC1 41
C N41 GOTO REDO
C ENDIF
CSR ENDSR
**
123456789
Et pour finir la première partie d’un source DDS, ENTJRN, correspondant au fichier TYPE1 d’une sortie de DSPJRN.
A R QJORDJE
A TEXT('Journal Entries')
A JOENTL 5S 0 TEXT('Length of entry')
A COLHDG('ENTRY' +
A 'LENGTH')
A JOSEQN 10S 0 TEXT('Sequence number')
A COLHDG('SEQUENCE' +
A 'NUMBER')
A JOCODE 1A TEXT('Journal Code')
A COLHDG('CODE')
A JOENTT 2A TEXT('Entry Type')
A COLHDG('TYPE')
A JODATE 6A TEXT('Date of entry: Job date for+
A mat')
A COLHDG('DATE')
A JOTIME 6S 0 TEXT('Time of entry: hour/minute/+
A second')
A COLHDG('TIME')
A JOJOB 10A TEXT('Name of Job')
A COLHDG('JOB' +
A 'NAME')
A JOUSER 10A TEXT('Name of User')
A COLHDG('USER' +
A 'NAME')
A JONBR 6S 0 TEXT('Number of Job')
A COLHDG('JOB' +
A 'NUMBER')
A JOPGM 10A TEXT('Name of Program')
A COLHDG('PROGRAM' +
A 'NAME')
A JOOBJ 10A TEXT('Name of Object')
A COLHDG('OBJECT' +
A 'NAME')
A JOLIB 10A TEXT('Objects Library')
A COLHDG('LIBRARY' +
A 'NAME')
A JOMBR 10A TEXT('Name of Member')
A COLHDG('MEMBER' +
A 'NAME')
A JOCTRR 10S 0 TEXT('Count or relative record nu+
A mber changed')
A COLHDG('COUNT/' +
A 'RRN')
A JOFLAG 1A TEXT('Flag: 1 or 0')
A COLHDG('FLAG')
A JOCCID 10S 0 TEXT('Commit cycle identifier')
A COLHDG('COMMIT' +
A 'CYCLE ID')
A JOINCDAT 1A TEXT('Incomplete Data: 1 or 0')
A COLHDG('INCOMPLETE' +
A 'DATA')
A JOMINESD 1A TEXT('Minimized ESD: 0, 1, or 2')
A COLHDG('MINIMIZED' +
A 'ESD')
A JORES 6A TEXT('Not used')
A COLHDG('RESERVED')
En dernier, le programme de compilation des différents sources. N’oublier pas de remplacer « USERBIB » par la ou les bibliothèques qui correspondent à vos besoins :
PGM
DCL &FAILED TYPE(*DEC) LEN(10 0) VALUE(0)
DCL &FAILEDSTR TYPE(*CHAR) LEN(10)
CRTPF FILE(QTEMP/BROUILLON) RCDLEN(1)
DSPFD FILE(QTEMP/BROUILLON) TYPE(*ACCPTH) OUTPUT(*OUTFILE) OUTFILE(QTEMP/RTVPFSRC1)
DSPFFD FILE(QTEMP/BROUILLON) OUTPUT(*OUTFILE) OUTFILE(QTEMP/RTVPFSRC)
CRTBNDRPG PGM(USERBIB/RTVPFSRC) SRCFILE(USERBIB/QJRNPSTSRC) SRCMBR(RTVPFSRC) +
OPTION(*EVENTF) DBGVIEW(*ALL) OPTIMIZE(*FULL) INDENT(2) +
REPLACE(*YES)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&FAILED) VALUE(&FAILED + 1)
ENDDO
CRTBNDCL PGM(USERBIB/RTVJRNPST) SRCFILE(USERBIB/QJRNPSTSRC) SRCMBR(RTVJRNPST) +
OPTION(*EVENTF) REPLACE(*YES) OPTIMIZE(*FULL) DBGVIEW(*ALL)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&FAILED) VALUE(&FAILED + 1)
ENDDO
CRTCMD SRCFILE(USERBIB/QJRNPSTSRC) SRCMBR(DSPJRNPST) REPLACE(*YES) +
CMD(USERBIB/DSPJRNPST) PGM(*LIBL/RTVJRNPST)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&FAILED) VALUE(&FAILED + 1)
ENDDO
CHGVAR VAR(&FAILEDSTR) VALUE(&FAILED)
ADDENVVAR ENVVAR(QRB_NUMBER_FAILED) VALUE(&FAILEDSTR) REPLACE(*YES)
ENDPGM
Reste à moderniser le tout, passer en Free Format, transformer en architecture ILE avec utilisation de programmes multi-modules et de procédures, utiliser du SQL à la place du QUERY, etc…
