GETOBJUC

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