Troubleshooting
Problem
This provides a general example for obtaining a list of jobs for a particular subsystem. It also provides an example of the use of Application Interface Programs (APIs) that create and use user spaces by the use of CL programs.
Resolving The Problem
This provides a general example for how to obtain a list of jobs for a particular subsystem. It also provides an example of the use of Application Interface Programs (APIs) that create and use user spaces by the use of CL programs. In addition, it provides an example of how to use a key field in a call to an API. In this program, the QUSLJOB API is used to obtain information on all jobs that are running under a specified subsystem. Information retrieved from the user space passed back to the CL program by the QUSLJOB API program is then placed in a user space. At the conclusion of the program the user space is just dumped to provide a spooled file listing to illustrate what was obtained. More detailed information on the use of APIs is provided by the System API Reference manuals. Note that this example program is not supported by IBM.
IGSC knowledgebase document 642681 , click here General Example of the Use of APIs for other examples.
IGSC knowledgebase document 642681 , click here General Example of the Use of APIs for other examples.
/********START OF SPECIFICATIONS*************************/
/* */
/* NAME: SMPLPGM */
/* */
/* PURPOSE: THIS ILLUSTRATES THE USE OF APIS TO GET A */
/* LIST OF ALL ACTIVE JOBS FOR A SPECIFIED SUBSYSTEM. */
/* THE STATUS VARIABLE IN THE PROGRAM IS SET TO *ACTIVE */
/* WHICH SPECIFIES THE STATUS THE JOB MUST HAVE TO BE */
/* INCLUDED IN THE SET PASSED BACK BY QUSLJOB API. */
/* THE TYPE VARIABLE IN THE PROGRAM IS SET TO I WHICH */
/* SPECIFIES THE TYPE OF JOBS THAT ARE TO BE INCLUDED */
/* WHERE I SIGNIFIES INTERACTIVE. */
/* IF YOU CHANGE THE I TO A B AND RECOMPILE THEN IT */
/* WILL GIVE YOU A LIST OF THE ACTIVE BATCH JOBS */
/* THE PROGRAM IS EXECUTED VIA THE FOLLOWING CALL */
/* CALL LIB/SMPLPGM PARM(SBSNAME SBSLIB) */
/* WHERE LIB IS THE NAME OF THE LIBRARY CONTAINING */
/* THE COMPILED PROGRAM, SBSNAME IS THE NAME OF THE */
/* SUBSYSTEM OF INTEREST AND LIBNAME IS THE NAME OF */
/* LIBRARY THAT HAS THE SUBSYSTEM DEFINITION IN IT. */
/* THE PROGRAM WILL CREATE A USER SPACE OBJECT IN */
/* THE QTEMP LIBRARY WHICH IT WILL DUMP AT THE END */
/* OF THE PROGRAM PRIOR TO DELETING THE OBJECT. */
/* THE USER SPACE WILL HAVE A LIST OF THE JOBS WHICH*/
/* WERE FOUND - WILL SHOW THEIR JOBNAME/USER/NUMBER */
/* */
/* Note that several comment lines have been added to */
/* explicitly show how many blanks are needed in */
/* certain quoted strings. Each 'b' represents a blank */
/* in such strings. */
/***END OF SPECIFICATIONS********************************/
PGM PARM(&SBSNAME &SBSLIB)
DCL VAR(&SBSNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSNAMEX) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSLIBX) TYPE(*CHAR) LEN(10)
DCL VAR(&USRNAME) TYPE(*CHAR) LEN(10)
/* FORMAT NAME FOR THE QUSLJOB CALL */
DCL VAR(&FORMAT200) TYPE(*CHAR) LEN(8) +
VALUE(JOBL0200)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(26) +
VALUE('*ALL *ALL *ALL ')
DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) +
VALUE('I')
DCL VAR(&STATUS) TYPE(*CHAR) LEN(10) +
VALUE(*ACTIVE)
DCL VAR(&ERRCODE) TYPE(*CHAR) LEN(8) +
VALUE(X'0000000000000000')
DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0)
/* Looping counter */
DCL VAR(&USRSPC) TYPE(*CHAR) LEN(20) +
VALUE('XINPUT QTEMP ')
/* VALUE('XINPUTbbbbQTEMPbbbbb') */
DCL VAR(&NUMENTB) TYPE(*CHAR) LEN(4)
/* NUMBER OF entries from list job schedule entries +
in binary form */
DCL VAR(&NUMENT) TYPE(*DEC) LEN(8 0)
/* NUMBER of entries from list job schedule entries +
in decimal form */
DCL VAR(&GENHDR) TYPE(*CHAR) LEN(140)
/* GENERIC header information from the user space */
DCL VAR(&OFFSETB) TYPE(*CHAR) LEN(4)
/* OFFSET to the list portion of the user space in +
binary form */
DCL VAR(&STRPOSB) TYPE(*CHAR) LEN(4)
/* STARTING position in the user space in binary form */
DCL VAR(&STRPOS) TYPE(*DEC) LEN(5 0)
/* STARTING position in the user space in decimal form */
DCL VAR(&ELENB) TYPE(*CHAR) LEN(4)
/* LIST JOB entry length in binary 4 form */
DCL VAR(&ELEN) TYPE(*DEC) LEN(5 0)
/* LIST JOB entry length in decimal form */
DCL VAR(&LENTRY) TYPE(*CHAR) LEN(100)
/* Retrieve area for list job entry */
DCL VAR(&NENTRY) TYPE(*CHAR) LEN(32)
/* AREA FOR NEW ENTRY CREATE */
DCL VAR(&JOBNUMBER) TYPE(*CHAR) LEN(6)
/* JOB NUMBER */
DCL VAR(&OUTINDEX) TYPE(*CHAR) LEN(4)
DCL VAR(&OUTINDEXB) TYPE(*DEC) LEN(5 0)
DCL VAR(&OUTLEN) TYPE(*CHAR) LEN(4)
CHGVAR VAR(%BIN(&OUTINDEX)) VALUE(1)
CHGVAR VAR(%BIN(&OUTLEN)) VALUE(32)
/********************************************************/
/* Create the user space FOR INPUT OF API DATA */
/********************************************************/
CALL PGM(QUSCRTUS) PARM('XINPUT QTEMP ' ' ' +
X'00040000' ' ' '*ALL ' ' ')
/* CALL PGM(QUSCRTUS) PARM('XINPUTbbbbQTEMPbbbbb'b'b' + */
/* X'00040000'b'b'b'*ALLbbbbbb'b'b') */
/********************************************************/
/* MONITOR FOR ERROR CAUSED BY SPACE ALREADY EXISTING */
/********************************************************/
MONMSG MSGID(CPF9870) +
EXEC(GOTO CMDLBL(PROCED1))
/********************************************************/
/* Create the user space FOR OUTPUT SPACE */
/********************************************************/
PROCED1:
CALL PGM(QUSCRTUS) PARM('XOUTPUT QTEMP ' ' ' +
X'00040000' ' ' '*ALL ' ' ')
/* CALL PGM(QUSCRTUS) PARM('XOUTPUTbbbQTEMPbbbbb'b'b' + */
/* X'00040000'b'b'b'*ALLbbbbbb'b'b') */
/********************************************************/
/* MONITOR FOR ERROR CAUSED BY SPACE ALREADY EXISTING */
/********************************************************/
MONMSG MSGID(CPF9870) +
EXEC(GOTO CMDLBL(PROCED2))
PROCED2:
/********************************************************/
/* Call the API to get the job information */
/********************************************************/
CALL PGM(QUSLJOB) PARM( +
&USRSPC &FORMAT200 &JOBNAME &STATUS +
&ERRCODE &JOBTYPE X'00000001' X'00000772')
MONMSG MSGID(CPF0000) +
EXEC(GOTO CMDLBL(ABORT))
/********************************************************/
/* Read the generic header from the user space */
/********************************************************/
CALL PGM(QUSRTVUS) PARM(&USRSPC X'00000001' +
X'0000008C' &GENHDR)
CHGVAR VAR(&NUMENTB) VALUE(%SST(&GENHDR 133 4))
CHGVAR VAR(&NUMENT) VALUE(%BIN(&NUMENTB))
CHGVAR VAR(&ELENB) VALUE(%SST(&GENHDR 137 4))
CHGVAR VAR(&ELEN) VALUE(%BIN(&ELENB))
CHGVAR VAR(&OFFSETB) VALUE(%SST(&GENHDR 125 4))
CHGVAR VAR(%BIN(&STRPOSB)) VALUE(%BIN(&OFFSETB) + 1)
CHGVAR VAR(&STRPOS) VALUE(%BIN(&STRPOSB))
CHGVAR VAR(&COUNT) VALUE(&NUMENT)
/********************************************************/
/* Check if no jobs found, if not then exit early */
/********************************************************/
IF (&COUNT *NE 0) THEN( GOTO GETENTRY)
SNDMSG MSG('NO JOBS FOUND FOR SPECIFIED STATUS') +
TOUSR(*SYSOPR)
GOTO CLEANUP
/********************************************************/
/* Read a list entry out of the user space */
/********************************************************/
GETENTRY:
CALL PGM(QUSRTVUS) PARM(&USRSPC &STRPOSB +
&ELENB &LENTRY)
/********************************************************/
/* Set JOBNUMBER FOR A SPECIFIC JOB FOUND */
/********************************************************/
CHGVAR VAR(&JOBNUMBER) VALUE(%SST(&LENTRY 21 6))
/********************************************************/
/* SET JOBNAME FOR A SPECIFIC JOB FOUND */
/********************************************************/
CHGVAR VAR(&JOBNAME) VALUE(%SST(&LENTRY 1 10))
/********************************************************/
/* SET USRNAME FOR A SPECIFIC JOB FOUND */
/***************************************** **************/
CHGVAR VAR(&USRNAME) VALUE(%SST(&LENTRY 11 10))
/********************************************************/
/* SET SUBSYSTEM DESCRIPTION NAME */
/********************************************************/
CHGVAR VAR(&SBSNAMEX) VALUE(%SST(&LENTRY 81 10))
/********************************************************/
/* SET SUBSYSTEM DESCRIPTION NAME */
/********************************************************/
CHGVAR VAR(&SBSLIBX) VALUE(%SST(&LENTRY 91 10))
/********************************************************/
/* CHECK IF THIS IS SPECIFIED SUBSYSTEM */
/********************************************************/
IF (&SBSNAME *NE &SBSNAMEX) THEN(GOTO PROCED4)
IF (&SBSLIB *NE &SBSLIBX) THEN(GOTO PROCED4)
/********************************************************/
/* SET UP NEW ENTRY FOR THE OUTPUT USER SPACE */
/********************************************************/
CHGVAR VAR(%SST(&NENTRY 1 10)) VALUE(&JOBNAME)
CHGVAR VAR(%SST(&NENTRY 11 10)) VALUE(&USRNAME)
CHGVAR VAR(%SST(&NENTRY 21 6)) VALUE(&JOBNUMBER)
CHGVAR VAR(%SST(&NENTRY 27 6)) VALUE(' ')
/********************************************************/
/* WRITE OUT THIS LAST ENTRY TO THE OUTPUT USER SPACE */
/********************************************************/
CALL PGM(QSYS/QUSCHGUS) PARM('XOUTPUT QTEMP ' +
&OUTINDEX &OUTLEN &NENTRY '0' &ERRCODE)
/* CALL PGM(QSYS/QUSCHGUS) PARM('XOUTPUTbbbQTEMPbbbbb' + */
/* &OUTINDEX &OUTLEN &NENTRYb'0'b&ERRCODE) */
/********************************************************/
/* BUMP THE INDEX FOR NEXT WRITE */
/********************************************************/
CHGVAR VAR(&OUTINDEXB) VALUE(%BIN(&OUTINDEX) + 32)
CHGVAR VAR(%BIN(&OUTINDEX)) VALUE(&OUTINDEXB)
/********************************************************/
/* Go get next entry if any more exist */
/********************************************************/
PROCED4: CHGVAR VAR(&STRPOS) VALUE(&STRPOS + &ELEN)
CHGVAR VAR(%BIN(&STRPOSB)) VALUE(&STRPOS)
/* Save the starting position for next entry*/
CHGVAR VAR(&COUNT) VALUE(&COUNT - 1)
IF (&COUNT *NE 0) THEN( GOTO GETENTRY)
/*********************************************************/
/* DO CLEANUP */
/*********************************************************/
CLEANUP:
/*********************************************************/
/* DUMP THE OUTPUT USER SPACE */
/*********************************************************/
PROCED6: DMPOBJ OBJ(QTEMP/XOUTPUT) OBJTYPE(*USRSPC)
/*********************************************************/
/* Delete the INPUT USER SPACE */
/*********************************************************/
DLTUSRSPC USRSPC(QTEMP/XINPUT)
/*********************************************************/
/* MONITOR FOR ERROR CAUSED BY USER SPACE NOT EXISTING */
/*********************************************************/
MONMSG MSGID(CPF2110) +
EXEC(GOTO CMDLBL(PROCED7))
/*********************************************************/
/* Delete the OUTPUT USER SPACE */
/*********************************************************/
PROCED7: DLTUSRSPC USRSPC(QTEMP/XOUTPUT)
/*********************************************************/
/* MONITOR FOR ERROR CAUSED BY LIB NOT EXISTING */
/*********************************************************/
MONMSG MSGID(CPF2110) +
EXEC(GOTO CMDLBL(EXITPGM))
GOTO CMDLBL(EXITPGM)
ABORT:
SNDMSG MSG('TEST PGM DID NOT COMPLETE SUCCESSFULLY') +
TOUSR(*SYSOPR)
GOTO CMDLBL(CLEANUP)
EXITPGM:
ENDPGM
[{"Type":"MASTER","Line of Business":{"code":"LOB68","label":"Power HW"},"Business Unit":{"code":"BU070","label":"IBM Infrastructure"},"Product":{"code":"SWG60","label":"IBM i"},"ARM Category":[{"code":"a8m0z0000000CHjAAM","label":"Job and Work Management"}],"ARM Case Number":"","Platform":[{"code":"PF012","label":"IBM i"}],"Version":"All Versions"}]
Historical Number
20322514
Was this topic helpful?
Document Information
Modified date:
07 October 2024
UID
nas8N1019555