GETOBJUC: + PGM PARM(&OBJECT &TYPE &MEMBER &RETMSG &RETMSGFLD &RETFILE) /* -----------------------------------------------------------------*/ /* This program finds all the jobs which are using an object. */ /* It returns a message suitable for display to the operator */ /* and/or file QTEMP/GETOBJUP listing all jobs. This file */ /* could be used to send a message to all users of the object. */ /* -----------------------------------------------------------------*/ /* Use the GETOBJUSR command to invoke this program */ /* -----------------------------------------------------------------*/ /* 11/24/97 LENNON Original writing */ /* -----------------------------------------------------------------*/ /* 10/05/2001 Sam Lennon. If a non file object is locked *EXCL then */ /* RTVOBJD to get real library name to put in the */ /* message fails. If this occurs, just continue and */ /* *LIBL may appear in the message. */ /* 08/--/2021 Sam Lennon. Change error handling to use commands to */ /* call message APIs. */ /* Remove GETOBJUP logic. Now created in RPG by SQL. */ /* -----------------------------------------------------------------*/ /* Input parameters */ DCL VAR(&OBJECT) TYPE(*CHAR) LEN(20) /* Obj & lib */ DCL VAR(&TYPE) TYPE(*CHAR) LEN(10) /* Obj type */ DCL VAR(&MEMBER) TYPE(*CHAR) LEN(10) /* if *FILE */ DCL VAR(&RETMSG) TYPE(*CHAR) LEN(4) /* Return a msg? */ DCL VAR(&RETMSGFLD) TYPE(*CHAR) LEN(200) /* Fld for msg */ DCL VAR(&RETFILE) TYPE(*CHAR) LEN(4) /* Return a file? */ /* Variables used in this program */ DCL VAR(&OBJNAM) TYPE(*CHAR) LEN(10) /* Obj name */ DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10) /* Obj lib */ DCL VAR(&FRMOBJLIB) TYPE(*CHAR) LEN(10) /* For duping file */ DCL VAR(&FAKMSGFLD) TYPE(*CHAR) LEN(1) /* No msg fld passed */ /* Catch unmonitored errors */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) /* Convert *LIBL/*CURLIB into a real name, if possible */ CHGVAR VAR(&OBJNAM) VALUE(%SST(&OBJECT 1 10)) CHGVAR VAR(&OBJLIB) VALUE(%SST(&OBJECT 11 10)) RTVOBJD OBJ(&OBJLIB/&OBJNAM) OBJTYPE(&TYPE) RTNLIB(&OBJLIB) MONMSG MSGID(CPF9803) EXEC(DO) /*Cannot Allocate*/ GOTO CMDLBL(PASTLIBGET) ENDDO CHGVAR VAR(%SST(&OBJECT 11 10)) VALUE(&OBJLIB) PASTLIBGET: + /* Call RPG program to find the lock users */ IF COND(&RETMSG = '*YES') THEN(DO) CALL PGM(GETOBJUR) PARM(&OBJECT &TYPE &MEMBER &RETMSG + &RETMSGFLD &RETFILE) ENDDO ELSE CMD(DO) CALL PGM(GETOBJUR) PARM(&OBJECT &TYPE &MEMBER &RETMSG + &FAKMSGFLD &RETFILE) ENDDO /* End of program */ GOTO CMDLBL(ENDPGM) /* Error handler - resend any trapped escape message */ ERROR: + MOVPGMMSG MSGTYPE(*DIAG) RSNESCMSG ENDPGM: + ENDPGM