| 
PGM PARM(&PRF &MDP &ADP &RQS) DCL VAR(&PRF) TYPE(*CHAR) LEN(10) DCL VAR(&MDP) TYPE(*CHAR) LEN(512) DCL VAR(&BIB) TYPE(*CHAR) LEN(10) DCL VAR(&ADP) TYPE(*CHAR) LEN(4) DCL VAR(&RQS) TYPE(*CHAR) LEN(50) DCL VAR(&CUR) TYPE(*CHAR) LEN(10) DCL VAR(&CURCOD) TYPE(*CHAR) LEN(12) DCL VAR(&PRFCOD) TYPE(*CHAR) LEN(12) DCL VAR(&USRLIBL) TYPE(*CHAR) LEN(2750) DCL VAR(&CMD) TYPE(*CHAR) LEN(3000) DCL VAR(&LG) TYPE(*DEC) LEN(15 5) VALUE(3000) DCL VAR(&INLPGM) TYPE(*CHAR) LEN(10) DCL VAR(&INLPGML) TYPE(*CHAR) LEN(10) DCL VAR(&INLMNU) TYPE(*CHAR) LEN(10) DCL VAR(&INLMNUL) TYPE(*CHAR) LEN(10) DCL VAR(&ATNPGM) TYPE(*CHAR) LEN(10) DCL VAR(&ATNPGML) TYPE(*CHAR) LEN(10) DCL VAR(&MSGQ) TYPE(*CHAR) LEN(10) DCL VAR(&MSGQL) TYPE(*CHAR) LEN(10) DCL VAR(&DLVRY) TYPE(*CHAR) LEN(10) DCL VAR(&JOBD) TYPE(*CHAR) LEN(10) DCL VAR(&JOBDL) TYPE(*CHAR) LEN(10) DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10) DCL VAR(&OUTQL) TYPE(*CHAR) LEN(10) DCL VAR(&DEV) TYPE(*CHAR) LEN(10) DCL VAR(&LOG) TYPE(*CHAR) LEN(1) DCL VAR(&SEV) TYPE(*DEC) LEN(2 0) DCL VAR(&LOGTXT) TYPE(*CHAR) LEN(10) DCL VAR(&INQMSG) TYPE(*CHAR) LEN(10) DCL VAR(&MDPL) TYPE(*INT) VALUE(512) DCL VAR(&ERRCOD) TYPE(*CHAR) LEN(15) + VALUE(X'00000000') DCL VAR(&CCSID) TYPE(*INT) VALUE(-1) /* VARIABLES UTILISEES PAR LA GESTION DE MESSAGES */ 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 */ /* GESTION DES ERREURS */ MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR) /* VALIDATION DES PROFILS */ |
|
CALL QSYGETPH PARM('*CURRENT' ' ' &CURCOD)
CALL QSYGETPH PARM(&PRF &MDP &PRFCOD &ERRCOD &MDPL &CCSID)
/* RECHERCHE DES INFOS *LIBL */
RTVJOBA LOGLVL(&LOG) LOGSEV(&SEV) LOGTYPE(&LOGTXT) +
INQMSGRPY(&INQMSG) OUTQ(&OUTQ) +
OUTQLIB(&OUTQL) USRLIBL(&USRLIBL) +
CURLIB(&CUR) PRTDEV(&DEV)
RTVUSRPRF USRPRF(&PRF) INLPGM(&INLPGM) +
INLPGMLIB(&INLPGML) JOBD(&JOBD) +
JOBDLIB(&JOBDL) MSGQ(&MSGQ) +
MSGQLIB(&MSGQL) CURLIB(&BIB) +
INLMNU(&INLMNU) INLMNULIB(&INLMNUL) +
DLVRY(&DLVRY) ATNPGM(&ATNPGM) +
ATNPGMLIB(&ATNPGML)
/* MISE EN PLACE DE *LIBL */
AF4TOOL/REINZJOB JOBD(&JOBDL/&JOBD)
CHGCURLIB CURLIB(&BIB)
/* MISE EN PLACE PGM ATTN ET MSGQ UTILISATEUR BREAK */
IF (&ATNPGM *NE '*SYSVAL') THEN(+
SETATNPGM PGM(&ATNPGML/&ATNPGM) )
CHGMSGQ MSGQ(&MSGQL/&MSGQ) DLVRY(&DLVRY)
MONMSG CPF0000
/* MISE EN PLACE DE LA CDE à EXECUTER */
IF (&RQS *EQ ' ') THEN(DO)
IF (&INLPGM *NE '*NONE') +
CHGVAR VAR(&RQS) VALUE('CALL ' *CAT &INLPGML *TCAT +
'/' *CAT &INLPGM)
ELSE +
CHGVAR VAR(&RQS) VALUE('GO ' *CAT &INLMNUL *TCAT +
'/' *CAT &INLMNU)
ENDDO
/* SI DEMANDE D'ADOPTION DE DROITS APPEL D'UN PGM EN *OWNER */
IF (&ADP *EQ '*YES') THEN(DO)
CALL PRFCPPADP PARM(&PRFCOD &RQS)
ENDDO
ELSE DO
/* CHANGEMENT DE PROFIL ET EXECUTION DE LA DEMANDE */
CALL QWTSETP PARM(&PRFCOD)
CALL QCMDEXC PARM(&RQS 50)
MONMSG MSGID(CPF0000)
ENDDO
/* RETOUR A L'ENVIRONEMENT DE DEBUT DE PGM */
|
|
CALL QWTSETP PARM(&CURCOD)
CHGMSGQ MSGQ(&MSGQL/&MSGQ) DLVRY(*HOLD)
MONMSG MSGID(CPF0000)
CHGCURLIB CURLIB(&CUR)
CHGVAR &CMD ('CHGLIBL LIBL(' *TCAT &USRLIBL *TCAT ')')
CALL QCMDEXC PARM(&CMD &LG)
SETATNPGM PGM(*PRVINVLVL)
CHGJOB PRTDEV(&DEV) LOG(&LOG &SEV +
&LOGTXT) INQMSGRPY(&INQMSG)
IF COND(&OUTQ *NE '*DEV') THEN(+
CHGJOB OUTQ(&OUTQL/&OUTQ) )
/* ANNULATION DES VALIDATIONS DE PROFIL */
CALL QSYRLSPH PARM(&PRFCOD)
CALL QSYRLSPH PARM(&CURCOD)
RETURN
/*----------------------------------------*/
ERREUR: /* GESTION DES ERREURS */
/*----------------------------------------*/
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
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) MSGFLIB(&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) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM
|
