Add API_SQL

APIs/README.MD

@@ -1,6 +1,8 @@
 # APIs, including QWCLOBJL (List Object Locks), QUSLJOB(List Job) QUSCRTUS, QUSDLTUS, QUSPTRUS (User Spaces)
 
-User commands that use RPG and CL to call IBM i APIs.
+- User commands that use RPG and CL to call IBM i APIs, sepecifically to list locks on objects
+- RPGLE program to return the job type, by calling the QUSLJOB API,
+- Commands to handle error messages in CL program, using the QMHMOVPM and QMHRSNEM APIs.
 
 ## QWCLOBJL (List Object Locks) API
 
@@ -12,7 +14,9 @@ The company is long gone, but I recently found the code on my PC and resurrected
 
 Now (2021) you can get similar information with SQL - see [Work Management Services](https://www.ibm.com/docs/en/i/7.4?topic=services-work-management) on the IBM site.  However, I have not found an SQL interface to QWCLOBJL. I also suspect that this code if faster than SQL, but probably in most use cases speed may not be a factor.
 
-### GETOBJUSR Command
+**Update 08/2021**: See APIs_SQL for code that does the same thing but using SQL provided by IBM in [Work Management Services](https://www.ibm.com/docs/en/i/7.4?topic=services-work-management)
+
+### GETOBJUSR.CMD
 
 This is the top level interface. Prompted, it looks like this:
 ![GetObjUsr Prompt](Images/GetObjUsr_1.jpg)
@@ -27,28 +31,28 @@ The message would be suitable for sending to the operator and look something lik
 
 It shows the details of up to 4 jobs and lists how many additional jobs, if any, have locks.
 
-### GETOBJUC
+### GETOBJUC.CLLE
 
 This the command processing program for the GETOBJUSR command.  It calls GETOBJUR to get the lock information.
 
-### GETOBJUR
+### GETOBJUR.RPGLE
 
 This RPG program creates a user space in QTEMP, then calls the QWCLOBJL (List Object Locks) API to populate the user spaces, calls SRTUSRSPC to sort by job, returns the requested message and/or file, then deletes the user space.
 
 The code was originally in fixed form RPG/400, but I converted it to **FREE (using [Craig Rutledge's JCRCMDS](https://www.jcrcmds.com/)).
 
-## GETOBJUP
+## GETOBJUP.PF
 
 DDS for the file created, if requested, in QTEMP. Resulting file contents look something like this:
 ![GetObjup Sample](Images/GetObjUsr_4.jpg)
 
-### SRTUSRSPC
+### SRTUSRSPC.RPGLE
 
 This program sorts a user space. I believe I downloaded the code from the Old News 3X/400 site.  It is fixed form RPG/400 that I haven't bothered to convert.  Old, educational, and it works.
 
 ## QUSLJOB (List Job) API
 
-### GETJOBTR
+### GETJOBTR.RPGLE
 
 This is a standalone program that returns the job type. GETOBJUR needed it, but I coded it separately in case it was useful elsewhere.
 

APIs_SQL/GETOBJUC.CLLE

@@ -0,0 +1,68 @@
+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

APIs_SQL/GETOBJUR.SQLRPGLE

@@ -0,0 +1,259 @@
+**FREE
+/TITLE GETOBJUR - Get users of an object
+//--------------------------------------------------------------------
+// Note:
+//   The QSYS2.OBJECT_LOCK_INFO SQL service is used, so this code
+//   probably won't run prior to OS 7.2.
+//--------------------------------------------------------------------
+// Given an object and type, this program finds all jobs that have
+// locks on the object.  It returns a message suitable for sending
+// to the system operator and/or a file, QTEMP/GETOBJUP, which
+// could be used to send messages to all interactive users of the
+// object, or for some other use. Or the jobname can be copied and
+// pasted into a command, e.g. wrkjob 110080/LENNONS/QPAD142626.
+// This program is called from CL program GETOBJUC.
+// It uses the QSYS2.OBJECT_LOCK_INFO SQL view.
+// Message looks like this:
+//   QIWS/QCUSTCDT *FILE is in use by 110088/LENNONS/QPAD142626.
+// Or this:
+//   QIWS/QCUSTCDT *FILE is in use by 191174/LENNONS/QPAD160408,
+//   191550/LENNONS/CUSTLST, 191551/LENNONS/INV_UPD, 191552/LENNONS/DAILYORD
+//   plus 1 more.
+//--------------------------------------------------------------------
+// Compile: CRTBNDRPG PGM(GETOBJUR) SRCFILE(...) DBGVIEW(*LIST)
+//--------------------------------------------------------------------
+// 12/00/97 LENNON  Original Writing
+// 07/--/2021 Converted to **FREE and Linear module.
+//            There are SQL services now that can provide similar
+//            infomations, but as far as I know there is no SQL
+//            interface to QWCLOBJL.  And there certainly was not in
+//            1997. This code probably performs better than existing
+//            SQL interfaces. For most use cases performance may not
+//            be a consideration.
+// 08/--2021  Converted to use QSYS2.OBJECT_LOCK_INFO and to create the
+//            GETOBJUP file with SQL.
+//--------------------------------------------------------------------
+ctl-opt debug option(*nodebugio: *srcstmt)
+    dftactgrp(*no) actgrp(*caller)
+    bnddir('UTIL_BND')
+    main(Main);
+//=== Prototypes =====================================================
+/include DEMO,Srv_Msg_P
+
+// Gets job type entry for this job.
+// Returns:  JobType has the job type. I=interactive, B=batch, etc.
+dcl-pr GetJobType extpgm('GETJOBTR');
+    *n char(26); // JobName26
+    *n char(1); // JobType
+end-pr;
+
+//=== Program Parameters =============================================
+// Input Parameters
+//   1) pObject is object name (10c) + object library (10c)
+//   2) pObjType is *FILE, *DTAARA, etc., standard OS/400 type
+//   3) pObjMem is the member for files, or *NONE if just want users
+//           of the file.
+//   4) pMsgYN is *YES to create a message.
+//   5) pFileYN is *YES if file GETOBJUP is to be created in QTEMP
+// Output Parameter
+//   PMsgFld is where the message gets created.
+
+//=== Global Definitions =============================================
+dcl-s JobName28 char(28);   // like '580065/JOBNM/USER''
+dcl-c SQLSuccess       '00000';
+dcl-c SQLNoData        '02000';
+dcl-c SQLNoMoreData    '02000';
+dcl-c SQLProcWarning   '01548';
+dcl-c SQLFileNotFound  '42704';
+
+//====================================================================
+dcl-proc Main ;
+
+    //=== Misc Field Definitions =====================================
+    dcl-s NumJobs packed(5);
+    dcl-c MaxJobs const(4); //Maximum jobs for detailed reporting.
+    // If you increase MaxJobs, increase the message parameter by 30 bytes
+    // for each additional job.
+    dcl-s JobName26 char(26);   // is name(10) User(10) number(6)
+
+    dcl-ds JobSQLDS;            // Output data for GETOBJUP
+        JobName char(10);
+        JobUser char(10);
+        JobNum char(6);
+        JobType char(1);
+        JobNM28 char(28);
+    end-ds;
+
+    dcl-s theLibrary char(10);
+    dcl-s theObject char(10);
+    dcl-s j int(10);
+    // ---------------------------------------------------------
+    dcl-pi *n extpgm('GETOBJUR');
+        pObject char(20);
+        pObjType char(10);
+        pObjMem char(10);
+        pMsgYN char(4);
+        pMsgFld char(200);
+        pFileYN char(4);
+    end-pi;
+
+    //=== Code starts here ===========================================
+    exec sql set option datfmt=*iso,
+                     closqlcsr=*endmod,
+                     commit=*none;
+    // === Initialize requested outputs ===============================
+    if pMsgYN='*YES';
+        clear  pMsgFld;
+    endif;
+
+    if pFileYN='*YES';
+        exec sql drop table qtemp.GETOBJUP;
+        if SQLSTATE <> SQLSuccess and SQLSTATE <> SQLFileNotFound;
+            SQLProblem('Delete GETOBJUP');
+        endif;
+        exec sql declare global temporary table GETOBJUP (
+            OUJOBNAME char(10),
+            OUJOBUSER char(10),
+            OUJOBNUM char(6),
+            OUJOBTYPE char(1),
+            OUJOBNAME28 CHAR(28)
+        );
+        if SQLSTATE <> SQLSuccess;
+            SQLProblem('Declare global tempory table GETOBJUP');
+        endif;
+    endif;
+    theObject = %subst(pObject:1:10);
+    theLibrary = %subst(pObject:11:10);
+
+    // === Find the locks ============================================
+    exec sql declare Lock_Cursor cursor for
+        select distinct JOB_NAME
+        from QSYS2.OBJECT_LOCK_INFO
+        where SYSTEM_OBJECT_SCHEMA = :thelibrary
+          and SYSTEM_OBJECT_NAME = :theobject
+          and OBJECT_TYPE = :pobjtype
+          and ifnull(SYSTEM_TABLE_MEMBER,' ') =
+            case when :pobjtype = '*file' and :pobjmem <> '*all' then  :pobjmem
+                 else ' '
+            END
+        order by JOB_NAME
+    ;
+    exec sql open Lock_Cursor ;
+    if SQLSTT <> SQLSuccess;
+        SQLProblem('open Lock_Cursor');
+    endif;
+
+    // Loop through the cursor, building requested outputs
+    fetchNext();
+    dow SQLSTT <> SQLNoData;
+        NumJobs += 1;
+        if pFileYN='*YES';
+            // JobName28 is  like '580065/USER/JOBNAME'
+            //                     1234567890123456789
+            JobNum = %subst(JobName28 :1 :6);      // Num Always 6
+            j = %scan('/' : JobName28 :8);         // find 2nd '/' (j=12)
+            JobUser= %subst(JobName28 :8 : j-8);   // User (lgth j-8 = 4)
+            JobName = %subst(JobName28: j+1);      // Rest is Job Name
+            JobName26= JobName + JobUser + JobNum;
+            GetJobType(JobName26: JobType);
+            exsr WriteRec;
+        endif;
+
+        if pMsgYN='*YES';
+            exsr BldMsg;
+        endif;
+
+        fetchNext();
+    enddo;
+
+    // === End of Program ============================================
+    if pMsgYN='*YES';
+        select;
+            when NumJobs >= 1 and NumJobs <=MaxJobs;
+                pMsgfld=%trimr(pMsgFld) + '.';
+            when NumJobs > MaxJobs;
+                pMsgfld=%trimr(pMsgFld) + ' plus '
+                  +  %trim(%editc(NumJobs-MaxJobs:'J'))
+                  + ' more.';
+            other;
+        endsl;
+    endif;
+
+    *inlr=*on;
+
+    // === BldMsg ====================================================
+    // Adds current job to the message until MaxJobs have been added.
+    begsr BldMsg;
+        select;
+            when NumJobs=1;
+                pMsgFld=
+                %trimr(%subst(pObject:11:10)) +'/' +
+                %trimr(%subst(pObject:1:10)) + ' ' +
+                %trimr(pObjType) +
+                ' is in use by ' +
+                JobName28;
+            when NumJobs >= 2 and NumJobs <=MaxJobs;
+                pMsgFld=%trimr(pMsgfld) + ', ' +
+                JobName28;
+        endsl;
+    endsr;
+
+    // === WriteRec ==================================================
+    // Builds and writes a record to the file GETOBJUP
+    begsr WriteRec;
+        JobNM28 = JobName28;
+        exec sql insert into qtemp.GETOBJUP values(:JobSQLDS);
+        if SQLSTT <> SQLSuccess;
+            sqlProblem('Insert into GETOBJUP');
+        endif;
+    endsr;
+end-proc;
+
+// === fetchNext =====================================================
+dcl-proc fetchNext;
+    exec sql fetch next from Lock_Cursor into :JobName28;
+    if SQLSTT <> SQLSuccess
+        and SQLSTT <> SQLNOData
+        and SQLSTT <> SQLProcWarning;
+        SQLProblem('fetchNext');
+    endif;
+end-proc;
+
+//=== SQLProblem =====================================================
+// For those "Never should happen" SQL errors.
+// Issues DUMP(A) to dump memory, then ends program by
+// sending an *ESCAPE message of the supplied debugging text.
+dcl-proc SQLProblem;
+    dcl-pi SQLProblem;
+        piSQLDebug varchar(1024) value;
+    end-pi;
+
+    //--- Local Variables ---------------------------------
+    dcl-s myDebugMsg varchar(512); //Max CPF9898 supports
+    dcl-s wkRem int(10);
+
+    dcl-s myState CHAR(5);
+    dcl-s myMSGTXT varchar(32740);
+    dcl-s myMsgLgth int(5);
+    exec sql get diagnostics condition 1
+        :myState = RETURNED_SQLSTATE,
+        :myMsgTxt = MESSAGE_TEXT,
+        :myMsgLgth = MESSAGE_LENGTH
+    ;
+    myDebugMsg =  piSQLDebug
+        + ' - Unexpected SQL return: SQLSTATE='
+        + myState
+        + '. "';
+    // Fit in as much of myMsgTxt as possible.
+    wkRem = (%size(myDebugMsg)-2) - %len(myDebugMsg);
+    if wkRem >= myMsgLgth +1;
+        myDebugMsg += (myMsgTxt +'"');
+    else;
+        myDebugMsg += (%subst(myMsgTxt: 1 :wkRem -5) + ' ..."');
+    endif;
+
+    dump(a);
+    SndEscMsg(myDebugMsg);
+    return;
+end-proc;
+

APIs_SQL/GETOBJUSR.CMD

@@ -0,0 +1,50 @@
+ GETOBJUSR:  CMD        PROMPT('Get Users of an Object')
+ /*-----------------------------------------------------------------*/
+ /* CPP is GETOBJUC                                                 */
+ /* Compile:                                                        */
+ /*   CRTCMD CMD(GETOBJUSR) PGM(GETOBJUC)                           */
+ /*         ALLOW(*BPGM *IPGM *BMOD *IMOD)                          */
+ /*-----------------------------------------------------------------*/
+ /* 12/00/97 LENNON Original writting                               */
+ /*-----------------------------------------------------------------*/
+             PARM       KWD(OBJECT) TYPE(Q1) MIN(1) PROMPT('Object +
+                          Name')
+
+             PARM       KWD(TYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
+                          VALUES(*ALRTBL *AUTL *BNDDIR *CFGL +
+                          *CHTFMT *CLD *CLS *CMD *CNNL *COSD *CRQD +
+                          *CSI *CSPMAP *CSPTBL *CTLD *DEVD *DOC +
+                          *DTAARA *DTADCT *DTAQ *EDTD *EXITRG *FCT +
+                          *FILE *FLR *FNTRSC *FNTTBL *FORMDF *FTR +
+                          *GSS *IPXD *JOBD *JOBQ *JOBSCD *JRN +
+                          *JRNRCV *LIB *LIND *LOCALE *MENU *MODD +
+                          *MODULE *MSGF *MSGQ *M36 *M36CFG *NODL +
+                          *NTBD *NWID *NWSD *OUTQ *OVL *PAGDFN +
+                          *PAGSEG *PDG *PGM *PNLGRP *PRDAVL *PRDDFN +
+                          *PRDLOD *PSFCFG *QMFORM *QMQRY *QRYDFN +
+                          *SBSD *SCHIDX *SPADCT *SQLPKG *SRVPGM +
+                          *SSND *S36 *TBL *USRIDX *USRPRF *USRQ +
+                          *USRSPC *WSCST) MIN(1) PROMPT('Object Type')
+
+             PARM       KWD(MEMBER) TYPE(*NAME) LEN(10) DFT(*ALL) +
+                          SPCVAL((*ALL) (*FIRST) (*NONE)) +
+                          PMTCTL(ISFILE) PROMPT('Member')
+
+             PARM       KWD(RETMSG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
+                          DFT(*YES) VALUES(*YES *NO) PROMPT('Return +
+                          a message?')
+
+             PARM       KWD(MSGFLD) TYPE(*CHAR) LEN(200) +
+                          RTNVAL(*YES) PMTCTL(RETMSGY) +
+                          PROMPT('Return Message Field')
+
+             PARM       KWD(RETFILE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
+                          DFT(*NO) VALUES(*YES *NO) PROMPT('Return +
+                          file QTEMP/GETOBJUSRP?')
+
+ Q1:         QUAL       TYPE(*NAME) LEN(10) MIN(1)
+             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
+                          SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
+
+ RETMSGY:    PMTCTL     CTL(RETMSG) COND((*EQ *YES))
+ ISFILE:     PMTCTL     CTL(TYPE) COND((*EQ *FILE))

APIs_SQL/ReadMe.MD

@@ -0,0 +1,50 @@
+# Using IBM [Work Management Services](https://www.ibm.com/docs/en/i/7.4?topic=services-work-management)
+
+IBM has begun providing access to APIs using SQL. The code here uses the QSYS2.OBJECT_LOCK_INFO SQL view.  It is shorter and simplified code that can be  used to replace that in [APIs which returns users who have a lock on an object](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/APIs).
+
+## GETOBJUSR.CMD
+
+This command is the top level interface. It is unchanged from the version in [APIs](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/APIs), but it provided here for completeness.
+ Prompted, it looks like this:
+![GetObjUsr Prompt](Images/GetObjUsr_1.jpg)
+
+You specify the object and type and the command returns information on the locks on the object. You can return a file of objects and/or a message.
+
+The returned file is GETOBJUP in QTEMP.
+
+The returned message would be suitable for sending to the operator and look something like one of these:
+![GetObjUsr Message](Images/GetObjUsr_2.jpg)
+![GetObjUsr Message](Images/GetObjUsr_3.jpg)
+
+It shows the details of up to 4 jobs and lists how many additional jobs, if any, have locks.
+
+The job name can be copied and pasted into a WRKJOB command, e.g. `wrkjob 233920/LENNONS/QPAD151018`.
+
+## GETOBJUP File
+
+If requested, this file is created in QTEMP. The contents would look like this:
+![GetObjUsr Message](Images/GetObjUsr_4.jpg)
+
+## GETOBJUC.CLLE
+
+This is the command processing program for the GETOBJUSR command. It does some housekeeping and calls GETOBJUR. Unlike the version in [APIs](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/APIs), it does not need to create QTEMP.GETOBJUP.
+
+## GETOBJUR.SQLRPGLE
+
+This creates QTEMP/GETOBJUP if requested, using SQL. Then it retreives the job name using the QSYS2.OBJECT_LOCK_INFO view, and orders it by job name. It populates file GETOBJUP using SQL.
+
+This about 100 lines shorter and it does not need the SRTUSRSPC program.
+
+## T0/T1/T2/T3.CLLE
+
+These are simple CL programs to test GETOBJUSR and display the results by sending a message and/or displaying the QTEMP/GETOBJUP file.
+
+## T9xxx.CLLE
+
+More complex testing:
+
+- Call T9ALLOCMNY to create a interactive lock and several batch locks on QIWS/QCUSTCDT.
+
+- Then call T9DSPMNY to display the locks.
+
+- T9ALLOC1 creates a lock on QIWS/QCUSTCDT. It is called by T9ALLOCMNY.

APIs_SQL/T0.CLLE

@@ -0,0 +1,14 @@
+PGM
+
+/* Basic test, using a library as the object to report on */
+/* Return both a message and a file                       */
+
+             DCL        VAR(&MSG) TYPE(*CHAR) LEN(200)
+
+             GETOBJUSR  OBJECT(QSYS/LENNONS2) TYPE(*LIB) +
+                          MSGFLD(&MSG) RETFILE(*YES)
+
+             SNDMSG     MSG(&MSG) TOUSR(*REQUESTER)
+             QRY        FILE(QTEMP/GETOBJUP)
+
+             ENDPGM

APIs_SQL/T1.CLLE

@@ -0,0 +1,11 @@
+PGM
+
+/* Basic test, using a library as the object to report on */
+/* Return just a  message.                                */
+
+             DCL        VAR(&MSG) TYPE(*CHAR) LEN(200)
+
+             GETOBJUSR  OBJECT(QSYS/LENNONS2) TYPE(*LIB) MSGFLD(&MSG)
+             SNDMSG     MSG(&MSG) TOUSR(*REQUESTER)
+
+             ENDPGM

APIs_SQL/T2.CLLE

@@ -0,0 +1,13 @@
+PGM
+/* Masic test, using a library as the oject of choice. */
+/* Return just a file. Message will be blank.          */
+
+             DCL        VAR(&MSG) TYPE(*CHAR) LEN(200)
+
+             GETOBJUSR  OBJECT(QSYS/LENNONS2) TYPE(*LIB) RETMSG(*NO) +
+                          RETFILE(*YES)
+
+             SNDMSG     MSG(&MSG) TOUSR(*REQUESTER)
+             QRY        FILE(QTEMP/GETOBJUP)
+
+             ENDPGM

APIs_SQL/T3.CLLE

@@ -0,0 +1,12 @@
+PGM
+             DCL        VAR(&MSG) TYPE(*CHAR) LEN(200)
+
+/* QSYS library. Lots of jobs.                             */
+/* Return both a message and a file                        */
+
+             GETOBJUSR  OBJECT(QSYS/QSYS) TYPE(*LIB) MSGFLD(&MSG) +
+                          RETFILE(*YES)
+             SNDMSG     MSG(&MSG) TOUSR(*REQUESTER)
+             QRY        FILE(QTEMP/GETOBJUP)
+
+             ENDPGM

APIs_SQL/T9ALLOC1.CLLE

@@ -0,0 +1,7 @@
+             PGM
+
+/* Create a lock and delay. Called by T9ALLOCMNY        */
+
+             ALCOBJ     OBJ((QIWS/QCUSTCDT *FILE *SHRRD)) WAIT(0)
+             DLYJOB     DLY(90)
+             ENDPGM

APIs_SQL/T9ALLOCMNY.CLLE

@@ -0,0 +1,20 @@
+             PGM
+/***************************************************************/
+/* Creates locks on QIWS/QCUSTCDT to test GETOBJUR.            */
+/* Call T9DSPMNY to report the locks.                          */
+/***************************************************************/
+
+/* Create an interactive lock                                  */
+             ALCOBJ     OBJ((QIWS/QCUSTCDT *FILE *SHRRD))
+
+/* Create some batch locks. Submitted jobs wait for 90 seconds */
+/* so you can call T9DSPMAY to see the locks.                  */
+             SBMJOB     CMD(CALL PGM(T9ALLOC1)) JOB(CUSTLST) +
+                          JOBQ(QUSRNOMAX)
+             SBMJOB     CMD(CALL PGM(T9ALLOC1)) JOB(INV_UPD) +
+                          JOBQ(QUSRNOMAX)
+             SBMJOB     CMD(CALL PGM(T9ALLOC1)) JOB(DAILYORD) +
+                          JOBQ(QUSRNOMAX)
+             SBMJOB     CMD(CALL PGM(T9ALLOC1)) JOB(YTD_RPT) +
+                          JOBQ(QUSRNOMAX)
+             ENDPGM

APIs_SQL/T9DSPMNY.CLLE

@@ -0,0 +1,10 @@
+             PGM
+
+/* Display locks after running T9ALLOCMNY              */
+
+             DCL        VAR(&MSG) TYPE(*CHAR) LEN(200)
+             GETOBJUSR  OBJECT(QIWS/QCUSTCDT) TYPE(*FILE) +
+                          MSGFLD(&MSG) RETFILE(*YES)
+             SNDMSG     MSG(&MSG) TOUSR(*REQUESTER)
+             QRY        FILE(QTEMP/GETOBJUP)
+             ENDPGM