2021-08-24 15:29:30 -04:00

69 lines
2.9 KiB
Plaintext

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