CPP --> RTVPFSRC

BoTTom |
             PGM        PARM(&FICLIB &SRCFICLIB &SRCMBR &MBROPT)
             DCL        VAR(&FICLIB) TYPE(*CHAR) LEN(20)
             DCL        VAR(&SRCFICLIB) TYPE(*CHAR) LEN(20)
             DCL        VAR(&FIC) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCFIC) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&MBROPT) TYPE(*CHAR) LEN(8)
             DCL        VAR(&TXT) TYPE(*CHAR) LEN(50)
             DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
             DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
             DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
             DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(200)
             DCL VAR(&MSGDTALEN) TYPE(*DEC) LEN(5 0)
             MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERREUR))
 
             CHGVAR     VAR(&FIC) VALUE(%SST(&FICLIB 1 10))
             CHGVAR     VAR(&LIB) VALUE(%SST(&FICLIB 11 10))
             CHGVAR     VAR(&SRCFIC) VALUE(%SST(&SRCFICLIB 1 10))
             CHGVAR     VAR(&SRCLIB) VALUE(%SST(&SRCFICLIB 11 10))
             IF         COND(&SRCMBR = '*FILE') THEN(CHGVAR +
                          VAR(&SRCMBR) VALUE(&FIC))
             DSPFFD     FILE(&LIB/&FIC) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/DSPFFDTEMP)
             OVRDBF     FILE(QADSPFFD) TOFILE(QTEMP/DSPFFDTEMP)
             DSPFD      FILE(&LIB/&FIC) TYPE(*ACCPTH) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPACCPTH)
             OVRDBF     FILE(QAFDACCP) TOFILE(QTEMP/DSPACCPTH)
             CHKOBJ     OBJ(&SRCLIB/&SRCFIC) OBJTYPE(*FILE) +
                          MBR(&SRCMBR)
             MONMSG     MSGID(CPF9815) EXEC(DO)
             RTVOBJD    OBJ(&LIB/&FIC) OBJTYPE(*FILE) TEXT(&TXT)
             ADDPFM     FILE(&SRCLIB/&SRCFIC) MBR(&SRCMBR) +
                          TEXT(&TXT) SRCTYPE(PF)
             ENDDO
 
             IF         COND(&MBROPT = '*REPLACE') THEN(CLRPFM +
                          FILE(&SRCLIB/&SRCFIC) MBR(&SRCMBR))
             CHKOBJ     OBJ(QTEMP/TEMPSRC) OBJTYPE(*FILE)
              MONMSG     MSGID(CPF0000) EXEC(DO)
              CRTSRCPF   FILE(QTEMP/TEMPSRC) ACCPTH(*KEYED)
              ENDDO
             CHKOBJ     OBJ(QTEMP/TEMPSRC) OBJTYPE(*FILE) +


|
                          MBR(&SRCMBR)
             MONMSG     MSGID(CPF9815) EXEC(DO)
             ADDPFM     FILE(QTEMP/TEMPSRC) MBR(&SRCMBR) +
                          TEXT('Fichier de travail') SRCTYPE(PF)
             ENDDO
             CPYSRCF    FROMFILE(&SRCLIB/&SRCFIC) +
                          TOFILE(QTEMP/TEMPSRC) FROMMBR(&SRCMBR) +
                          SRCOPT(*SEQNBR)
              MONMSG CPF2800 EXEC(CLRPFM QTEMP/TEMPSRC &SRCMBR)
 
             OVRDBF     FILE(TEMPSRC) TOFILE(QTEMP/TEMPSRC) +
                          MBR(&SRCMBR) LVLCHK(*NO)
             CALL       PGM(RTVPFCBL)
             CPYSRCF    FROMFILE(QTEMP/TEMPSRC) +
                          TOFILE(&SRCLIB/&SRCFIC) FROMMBR(&SRCMBR) +
                          SRCOPT(*SEQNBR)
             SNDPGMMSG  MSG('Source de ' *CAT &LIB *TCAT '/' *CAT +
                          &FIC *BCAT 'extrait') MSGTYPE(*COMP)
             GOTO FIN
 ERREUR:     RCVMSG     MSGTYPE(*DIAG) MSGDTA(&MSGDTA) +
                          MSGDTALEN(&MSGDTALEN) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)
             IF         COND(&MSGID = ' ') THEN(GOTO CMDLBL(SUITE))
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(%SST(&MSGDTA 1 &MSGDTALEN)) +
                          MSGTYPE(*DIAG)
             GOTO       CMDLBL(ERREUR)
 SUITE:      RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) +
                          MSGDTALEN(&MSGDTALEN) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(%SST(&MSGDTA 1 &MSGDTALEN)) +
                          MSGTYPE(*ESCAPE)
FIN:         DLTOVR     FILE(QDDSSRC QADSPFFD QAFDACCP)
             MONMSG CPF0000
     ENDPGM




©AF400