
|
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
|