| 
PGM PARM(&SPLF &EDIT &JOBQ &SPLNBR &SPLF2 &CPI + &LPI &LI &COL &OUTQQ &HOLD &SAVE &USRDTA) DCL &SPLF *CHAR 10 DCL &EDIT *CHAR 4 DCL &JOBQ *CHAR 26 DCL &JOB *CHAR 10 DCL &USER *CHAR 10 DCL &NBR *CHAR 6 DCL &SPLNBR *CHAR 5 DCL &SPLF2 *CHAR 10 DCL &CPI *CHAR 2 DCL &LPI *CHAR 1 DCL &LI *CHAR 2 DCL &COL *CHAR 3 DCL &OUTQQ *CHAR 20 DCL &OUTQ *CHAR 10 DCL &OUTQL *CHAR 10 DCL &HOLD *CHAR 4 DCL &SAVE *CHAR 4 DCL &USRDTA *CHAR 10 /* VARIABLES UTILISEES PAR LA GESTION DE MESSGAES */ DCL &ERRORSW *LGL /* SWITCH */ DCL &MSGID *CHAR LEN(7) /* ID MSG */ DCL &MSGDTA *CHAR LEN(100) /* DATA */ DCL &MSGF *CHAR LEN(10) /* FICHIER */ DCL &MSGFLIB *CHAR LEN(10) /* BIBLI */ /* VARIABLES API QUSRSPLA */ DCL &SPLNBRB *CHAR 4 DCL &JOBFULL *CHAR 26 DCL &RTVAR *CHAR 432 DCL &RTVARL *CHAR 4 /* VARIABLES DE TRAVAIL */ DCL &SPLNBRN *DEC (5 0) DCL &LINUM *DEC (3 0) DCL &COLNUM *DEC (3 0) DCL &CPINUM *DEC (3 0) DCL &LPINUM *DEC (3 0) DCL &CPI3 *CHAR 3 DCL &LPI3 *CHAR 3 MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR) /* CORPS DU PROGRAMME */ DLTF QTEMP/SPLF |
|
MONMSG MSGID(CPF0000) EXEC(RCVMSG MSGTYPE(*EXCP)) CRTDUPOBJ OBJ(SPLF) FROMLIB(AF4TOOL) OBJTYPE(*FILE) + TOLIB(QTEMP) IF COND(&JOBQ *EQ '*') THEN(RTVJOBA JOB(&JOB) + USER(&USER) NBR(&NBR)) ELSE DO CHGVAR &JOB %SST(&JOBQ 1 10) CHGVAR &USER %SST(&JOBQ 11 10) CHGVAR &NBR %SST(&JOBQ 21 6) ENDDO CPYSPLF FILE(&SPLF) TOFILE(QTEMP/SPLF) + JOB(&NBR/&USER/&JOB) SPLNBR(&SPLNBR) + CTLCHAR(*FCFC) /* API */ IF (&SPLNBR = '*ONLY') CHGVAR %BIN(&SPLNBRB) 0 ELSE IF (&SPLNBR = '*LAST') CHGVAR %BIN(&SPLNBRB) -1 ELSE DO CHGVAR &SPLNBRN &SPLNBR CHGVAR %BIN(&SPLNBRB) &SPLNBRN ENDDO CHGVAR %BIN(&RTVARL) 432 CHGVAR &JOBFULL (&JOB !! &USER !! &NBR) CALL QUSRSPLA PARM(&RTVAR &RTVARL 'SPLA0100' + &JOBFULL ' ' ' ' &SPLF &SPLNBRB) /* EDITION */ IF COND(&EDIT = '*YES') THEN(CHGDTA + DFUPGM(AF4TOOL/DFUSPL) FILE(QTEMP/SPLF)) /* VALEURS PAR DFT */ IF COND(%SST(&OUTQQ 1 4) *EQ '*JOB') + THEN(RTVJOBA OUTQ(&OUTQ) OUTQLIB(&OUTQL)) ELSE DO IF COND(%SST(&OUTQQ 1 5) *EQ '*SAME') + THEN(CHGVAR &OUTQQ %SST(&RTVAR 183 20)) CHGVAR &OUTQ %SST(&OUTQQ 1 10) CHGVAR &OUTQL %SST(&OUTQQ 11 10) ENDDO IF (&LI = '*') THEN(DO) CHGVAR &LINUM %BIN(&RTVAR 425 4) |
|
CHGVAR &LI &LINUM
ENDDO
IF (&COL = '*') THEN(DO)
CHGVAR &COLNUM %BIN(&RTVAR 429 4)
CHGVAR &COL &COLNUM
ENDDO
IF (&CPI = '*') THEN(DO)
CHGVAR &CPINUM %BIN(&RTVAR 177 4)
CHGVAR &CPI3 &CPINUM
CHGVAR &CPI %SST(&CPI3 1 2)
ENDDO
IF (&LPI = '*') THEN(DO)
CHGVAR &LPINUM %BIN(&RTVAR 173 4)
CHGVAR &LPI3 &LPINUM
CHGVAR &LPI %SST(&LPI3 2 2)
ENDDO
IF (&HOLD = '*') THEN(DO)
CHGVAR &HOLD %SST(&RTVAR 121 4)
ENDDO
IF (&SAVE = '*') THEN(DO)
CHGVAR &SAVE %SST(&RTVAR 131 4)
ENDDO
IF (&USRDTA = '*') THEN(DO)
CHGVAR &USRDTA %SST(&RTVAR 91 10)
ENDDO
IF (&SPLF2 = '*SAME') THEN(DO)
CHGVAR &SPLF2 &SPLF
ENDDO
OVRPRTF FILE(QSYSPRT) PAGESIZE(&LI &COL) LPI(&LPI) +
CPI(&CPI) CTLCHAR(*FCFC) PRTTXT(*BLANK) +
OUTQ(&OUTQL/&OUTQ) HOLD(&HOLD) +
SAVE(&SAVE) USRDTA(&USRDTA) SPLFNAME(&SPLF2)
CPYF FROMFILE(QTEMP/SPLF) TOFILE(QSYSPRT)
DLTOVR QSYSPRT
/* ENVOI D'UN MESSAGE DE TYPE *COMP SI FIN NORMALE */
SNDPGMMSG MSG('Fichier spool copié') MSGTYPE(*COMP)
RETURN
/*----------------------------------------*/
ERREUR: /* GESTION DES ERREURS */
|
|
/*----------------------------------------*/ IF &ERRORSW SNDPGMMSG MSGID(CPF9899) + MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* 2EME FOIS*/ /* ARRET PGM*/ CHGVAR &ERRORSW '1' /* MISE EN PLACE DU SWTICH */ /* RENVOI DES MESSAGES DE TYPE *DIAG SI FIN ANORMALE */ DIAGMSG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) IF (&MSGID *EQ ' ') GOTO EXCPMSG SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*DIAG) GOTO DIAGMSG /* BOUCLE SUR MESSAGES *DIAG */ /* RENVOI DU MESSAGE D'ERREUR */ EXCPMSG: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) ENDPGM |
