PGM PARM(&QUAL &DEV &SEQNBR &CPR &C1)
DCL &QUAL *CHAR 20
DCL &PGM *CHAR 10
DCL &LIB *CHAR 10
DCL &DEV *CHAR 10
DCL &SEQNBR *DEC (2 0)
DCL &SEQCHAR *CHAR 4
DCL &CPR *CHAR 4
DCL &C1 *CHAR 512
/* 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 */
 
MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR)
 
/* CORPS DU PROGRAMME */
CHGVAR VAR(&PGM) VALUE(%SST(&QUAL 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&QUAL 11 10))
IF (&LIB = '*LIBL') RTVOBJD &PGM *PGM RTNLIB(&LIB)
 
DLTPGM PGM(QTEMP/QINSTAPP)
MONMSG CPF0000 EXEC(RCVMSG MSGTYPE(*EXCP))
 
CRTDUPOBJ OBJ(&PGM) FROMLIB(&LIB) OBJTYPE(*PGM) +
TOLIB(QTEMP) NEWOBJ(QINSTAPP)
 
IF (&SEQNBR = 0) THEN(CHGVAR &SEQCHAR '*END')
ELSE CHGVAR &SEQCHAR &SEQNBR
SAVOBJ OBJ(QINSTAPP) LIB(QTEMP) DEV(&DEV) +
OBJTYPE(*PGM) SEQNBR(&SEQCHAR) +
LABEL(*LIB) ENDOPT(*LEAVE) DTACPR(&CPR)
 
IF (&C1 ^= ' ') THEN(DO)
CALL QCMDEXC PARM(&C1 512)
ENDDO
 
 
/* RENVOI DES MESSAGES DE TYPE *COMP SI FIN NORMALE */
COMPMSG: RCVMSG MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') RETURN /* FIN DU PGM */
|