MIDRANGE dot COM Mailing List Archive



Home » MIDRANGE-L » June 2008

CHGUSRRPF Exit program



fixed

Exit Program example for - CHGUSRPRF command:


/* ************************************************************** */
/* PROGRAM DESCRIPTION : */
/* */
/* DO SOMETHING WHEN A USER PROFILE IS CHANGED. */
/* */
/* ADDEXITPGM EXITPNT(QIBM_QSY_CHG_PROFILE) */
/* FORMAT(CHGP0100) */
/* PGMNBR(*LOW) */
/* PGM(QGPL/EXCHGUSRPR) */
/* */
/* SPECIAL COMPILE OPTIONS: */
/* */
/* USRPRF(*OWNER) (USER PROFILE WITH SUFFICENT AUTHORITY) */
/* */
/* WRITTEN BY: */
/* UPDATED BY: */
/* */
/* ************************************************************** */
PGM PARM(&ENTRY_PARM)
/* ************************************************************** */
/* */
/* DECLARE PROGRAM VARIABLES */
/* */
/* ************************************************************** */
DCL VAR(&ENTRY_PARM) TYPE(*CHAR) LEN(38)
DCL VAR(&USER_PRF) TYPE(*CHAR) LEN(10)
DCL VAR(&USERID)
DCL &ERRORSW *LGL /* Std err */
DCL &MSGID *CHAR LEN(7) /* Std err */
DCL &MSGDTA *CHAR LEN(100) /* Std err */
DCL &MSGF *CHAR LEN(10) /* Std err */
DCL &MSGFLIB *CHAR LEN(10) /* Std err */
/* ************************************************************** */
/* */
/* GLOBAL MESSAGE MONITOR */
/* */
/* ************************************************************** */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(STDERR1))
/* ************************************************************** */
/* YOU CAN DO ANYTHING YOU WANT HERE... IN THIS EXAMPLE I'M ... */

/* */
/* AUDITING ANY CHANGES TO A USER PROFILE. AN ENTRY IS MADE TO */
/* THE CHGUSRPRF FILE IN QGPL. */
/* */
/* ************************************************************** */


RTVJOBA USER(&USERID)

/* EXTRACT PROFILE NAME FROM ENTRY PARAMETER STRUCTURE. */

CHGVAR VAR(&USER_PRF) VALUE(%SST(&ENTRY_PARM 29 10))



SNDAUDE ID(CHGUSRPRF) ENTDTA('User profile:' *BCAT +

&USER_PRF *BCAT 'has been changed by:' +

*BCAT &USERID)



DSPUSRPRF USRPRF(&USER_PRF) TYPE(*BASIC) OUTPUT(*OUTFILE)
+
OUTFILE(QGPL/CHGUSRPRF) OUTMBR(*FIRST *ADD)




* ************************************************************** */
* */
* NORMAL END OF PROGRAM */
* */
* ************************************************************** */
END: RETURN
* ************************************************************** */
* */
* STANDARD ERROR PROCESSING */
* */
* ************************************************************** */
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail ir error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* Loop back for addl diagnostics */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM




Exit Program example for - CRTUSRPRF command:


/* ************************************************************** */
/* PROGRAM DESCRIPTION : */
/* */
/* DO SOMETHING WHEN A USER PROFILE IS CREATED. */
/* */
/* ADDEXITPGM EXITPNT(QIBM_QSY_CRT_PROFILE) */
/* FORMAT(CRTP0100) */
/* PGMNBR(*LOW) */
/* PGM(QGPL/EXCRTUSRPR) */
/* */
/* SPECIAL COMPILE OPTIONS: */
/* */
/* USRPRF(*OWNER) (USER PROFILE WITH SUFFICENT AUTHORITY) */
/* WRITTEN BY: */
/* */
/* UPDATED BY: */
/* */
/* ************************************************************** */
PGM PARM(&ENTRY_PARM)
/* ************************************************************** */
/* */
/* DECLARE PROGRAM VARIABLES */
/* */
/* ************************************************************** */
DCL VAR(&ENTRY_PARM) TYPE(*CHAR) LEN(38)
DCL VAR(&USER_PRF) TYPE(*CHAR) LEN(10)
DCL VAR(&USERID)
DCL &ERRORSW *LGL /* Std err */
DCL &MSGID *CHAR LEN(7) /* Std err */
DCL &MSGDTA *CHAR LEN(100) /* Std err */
DCL &MSGF *CHAR LEN(10) /* Std err */
DCL &MSGFLIB *CHAR LEN(10) /* Std err */
/* ************************************************************** */
/* */
/* GLOBAL MESSAGE MONITOR */
/* */
/* ************************************************************** */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(STDERR1))
/* ************************************************************** */
/* YOU CAN DO ANYTHING YOU WANT HERE... IN THIS EXAMPLE I'M ... */

/* */
/* AUDITING ANY CREATION OF A USER PROFILE. AN ENTRY IS MADE TO */
/* THE CHGUSRPRF FILE IN QGPL. */
/* */
/* ************************************************************** */


RTVJOBA USER(&USERID)

/* EXTRACT PROFILE NAME FROM ENTRY PARAMETER STRUCTURE. */

CHGVAR VAR(&USER_PRF) VALUE(%SST(&ENTRY_PARM 29 10))

SNDAUDE ID(CRTUSRPRF) ENTDTA('User profile:' *BCAT +
&USER_PRF *BCAT 'has been created by:' +
*BCAT &USERID)

DSPUSRPRF USRPRF(&USER_PRF) TYPE(*BASIC) OUTPUT(*OUTFILE) +
OUTFILE(QGPL/CHGUSRPRF) OUTMBR(*FIRST *ADD)

* ************************************************************** */
* */
* NORMAL END OF PROGRAM */
* */
* ************************************************************** */
END: RETURN
* ************************************************************** */
* */
* STANDARD ERROR PROCESSING */
* */
* ************************************************************** */
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail ir error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* Loop back for addl diagnostics */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM


Kenneth
Kenneth E. Graap
Systems Administrator
NW Natural
keg@xxxxxxxxxxxxx
503-226-4211 x5537






Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2014 by MIDRANGE dot COM and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available here. If you have questions about this, please contact