/* ================================================================= */
/* */
/* Brief Documentation : */
/* */
/* This program retrieves the initial user library list of */
/* a job description and set the library list based on the */
/* information retrieved. */
/* */
/* The program expects the name of the job description and the */
/* library of the job description beeing passed to it. */
/* */
/* Provided by Thomas Raddatz */
/* */
/* e-mail Adresse: */
/* Thomas.Raddatz@Online-Club.de */
/* */
/* Homepage: */
/* http://www.online-club.de/~Thomas.Raddatz/ */
/* ================================================================= */
PGM PARM(&JOBD &JOBDLIB)
/* *ENTRY-Parameter */
DCL VAR(&JOBD ) TYPE(*CHAR) LEN( 10)
DCL VAR(&JOBDLIB ) TYPE(*CHAR) LEN( 10)
/* API - QWDRJOBD - Retrieve Job Description Information */
DCL VAR(&JOBD0100 ) TYPE(*CHAR) LEN(1024)
DCL VAR(&INITLIBOFS) TYPE(*DEC ) LEN(5 0)
DCL VAR(&NBRINITLIB) TYPE(*DEC ) LEN(5 0)
DCL VAR(&LENRCVVAR ) TYPE(*CHAR) LEN( 4)
DCL VAR(&FORMATNAME) TYPE(*CHAR) LEN( 8)
DCL VAR(&QJOBNAME ) TYPE(*CHAR) LEN( 20)
DCL VAR(&ERRORCODE ) TYPE(*CHAR) LEN( 8)
/* Work Fields */
DCL VAR(&BIN4$ ) TYPE(*CHAR) LEN( 4)
DCL VAR(&POS ) TYPE(*DEC ) LEN(5 0)
DCL VAR(&QPOS ) TYPE(*DEC ) LEN(5 0)
DCL VAR(&LENGTH ) TYPE(*DEC ) LEN(5 0)
DCL VAR(&USRLIBL ) TYPE(*CHAR) LEN(275)
DCL VAR(&QUSRLIBL ) TYPE(*CHAR) LEN(250)
DCL VAR(&LIB ) TYPE(*CHAR) LEN( 10)
DCL VAR(&CURLIB ) TYPE(*CHAR) LEN( 10)
DCL VAR(&PRDLIB1 ) TYPE(*CHAR) LEN( 10)
DCL VAR(&PRDLIB2 ) TYPE(*CHAR) LEN( 10)
/* Error handling */
DCL VAR(&ERROR ) TYPE(*LGL) +
VALUE('0')
DCL VAR(&TRUE ) TYPE(*LGL) +
VALUE('1')
DCL VAR(&FALSE ) TYPE(*LGL) +
VALUE('0')
DCL VAR(&ERRMSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&ERRMSGTYP) TYPE(*CHAR) LEN(10) +
VALUE('*DIAG')
DCL VAR(&ERRNBRTYP) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001')
DCL VAR(&ERRPGMMSGQ) TYPE(*CHAR) LEN(10) +
VALUE('*')
DCL VAR(&ERRSTKCTR) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001')
DCL VAR(&ERRCODE ) TYPE(*CHAR) LEN(4) +
VALUE(X'00000000')
/* Global error handler */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
CHGVAR VAR(&ERROR ) VALUE(&FALSE)
/* -------------------------------------------------------------- */
/* Let's start */
/* -------------------------------------------------------------- */
/* Retrieve the initial user library list */
CHGVAR VAR(&JOBD0100 ) VALUE(' ')
CHGVAR VAR(%BIN(&LENRCVVAR 1 4)) VALUE(1024)
CHGVAR VAR(&FORMATNAME) VALUE('JOBD0100')
CHGVAR VAR(&QJOBNAME ) VALUE(&JOBD *CAT &JOBDLIB)
CHGVAR VAR(%BIN(&ERRORCODE 1 4)) VALUE( 0)
CHGVAR VAR(%BIN(&ERRORCODE 5 4)) VALUE( 0)
CALL PGM(QWDRJOBD) PARM(&JOBD0100 +
&LENRCVVAR +
&FORMATNAME +
&QJOBNAME +
&ERRORCODE )
CHGVAR VAR(&BIN4$) VALUE(%SST(&JOBD0100 365 4))
CHGVAR VAR(&NBRINITLIB) VALUE(%BIN(&BIN4$))
CHGVAR VAR(&BIN4$) VALUE(%SST(&JOBD0100 361 4))
CHGVAR VAR(&INITLIBOFS) VALUE(%BIN(&BIN4$))
CHGVAR VAR(&POS ) VALUE(&INITLIBOFS + 1)
CHGVAR VAR(&LENGTH ) VALUE(&NBRINITLIB * 11)
CHGVAR VAR(&USRLIBL ) VALUE(%SST(&JOBD0100 &POS &LENGTH))
/* Check for special values: *SYSVAL, *NONE ... */
IF COND(%SST(&USRLIBL 1 10) *EQ '*SYSVAL') +
THEN(DO)
/* ... *SYSVAL */
RTVSYSVAL SYSVAL(QUSRLIBL) RTNVAR(&QUSRLIBL)
CHGVAR VAR(&QPOS ) VALUE(1)
CHGVAR VAR(&POS ) VALUE(1)
CHGVAR VAR(&NBRINITLIB) VALUE(0)
QLOOP:
IF COND(&QPOS *LT 250) THEN(DO)
CHGVAR VAR(&LIB) VALUE(%SST(&QUSRLIBL &QPOS 10))
IF COND(&LIB *NE ' ') THEN(DO)
CHGVAR VAR(%SST(&USRLIBL &POS 11)) VALUE(&LIB)
CHGVAR VAR(&QPOS ) VALUE(&QPOS + 10)
CHGVAR VAR(&POS ) VALUE(&POS + 11)
CHGVAR VAR(&NBRINITLIB) VALUE(&NBRINITLIB + 1)
GOTO CMDLBL(QLOOP)
ENDDO
ENDDO
ENDDO
IF COND(%SST(&USRLIBL 1 10) *EQ '*NONE') +
THEN(DO)
/* ... *NONE */
CHGVAR VAR(&USRLIBL ) VALUE(' ')
CHGVAR VAR(&NBRINITLIB) VALUE(0)
ENDDO
/* Set the user library list */
CHGVAR VAR(&CURLIB ) VALUE('*SAME')
CHGVAR VAR(&PRDLIB1 ) VALUE('*SAME')
CHGVAR VAR(&PRDLIB2 ) VALUE('*SAME')
CHGVAR VAR(%BIN(&BIN4$) ) VALUE(&NBRINITLIB)
CHGVAR VAR(%BIN(&ERRORCODE 1 4)) VALUE( 0)
CHGVAR VAR(%BIN(&ERRORCODE 5 4)) VALUE( 0)
CALL PGM(QLICHGLL) PARM(&CURLIB +
&PRDLIB1 +
&PRDLIB2 +
&USRLIBL +
&BIN4$ +
&ERRORCODE )
/* -------------------------------------------------------------- */
/* End of program */
/* -------------------------------------------------------------- */
ENDE:
/* ---------------- */
/* In case of an */
/* Error ... */
/* ---------------- */
IF COND(&ERROR) THEN(DO)
/* ... resend latest *ESCAPE message again */
CALL PGM(QMHRSNEM) PARM(&ERRMSGKEY &ERRCODE)
MONMSG MSGID(CPF0000)
ENDDO
RETURN
/* -------------------------------------------------------------- */
/* Global Error Handler */
/* -------------------------------------------------------------- */
ERROR:
IF COND(&ERROR) THEN(GOTO CMDLBL(ENDE))
ELSE CHGVAR VAR(&ERROR) VALUE(&TRUE)
/* Move all *DIAG messages to the calling program */
CALL PGM(QMHMOVPM) PARM(&ERRMSGKEY &ERRMSGTYP +
&ERRNBRTYP &ERRPGMMSGQ &ERRSTKCTR &ERRCODE)
GOTO CMDLBL(ENDE)
ENDPGM
|