Function VSAM005: Get List of Spool Files on an iSeries Output Queue

LANSA

previous page next page
Function VSAM005: Get List of Spool Files on an iSeries Output Queue
Name: VSAM005

Description: The following RDML function is used as a remote procedure. It must be compiled on the iSeries server system. It creates returns a list (of any size) of the available spool files on a specified output queue.
********** COMMENT(=======================================================);
********** COMMENT(Component : VSAM005);
********** COMMENT(Type : Function);
********** COMMENT();
********** COMMENT(Description : Get List of Spool files on an Outqueue);
********** COMMENT(The following RDML function is used as a remote);
********** COMMENT(procedure. It must be compiled on the AS/400 server);
********** COMMENT(system. It creates returns a list (of any size) of the);
********** COMMENT(available spool files on a specified output queue.);
********** COMMENT();
********** COMMENT(Disclaimer : The following material is supplied as);
********** COMMENT( sample material only. No warranty concerning this);
********** COMMENT( material or its use in any way whatsoever is);
********** COMMENT(expressed or implied);
********** COMMENT(=======================================================);
FUNCTION OPTIONS(*HEAVYUSAGE *DIRECT) RCV_LIST(#SFILES );
DEFINE FIELD(#RQS_005) TYPE(*CHAR) LENGTH(010);
DEFINE FIELD(#OUTQN_005) TYPE(*CHAR) LENGTH(010);
DEFINE FIELD(#OUTQL_005) TYPE(*CHAR) LENGTH(010);
EXCHANGE FIELDS(#RQS_005 #OUTQN_005 #OUTQL_005) OPTION(*ALWAYS);
********** COMMENT(Data layout of records read back from OS/400);
DEFINE FIELD(#DATA_005) TYPE(*CHAR) LENGTH(120);
DEFINE FIELD(#SPLF_005) TYPE(*CHAR) LENGTH(010) TO_OVERLAY(#DATA_005 006);
DEFINE FIELD(#USER_005) TYPE(*CHAR) LENGTH(010) TO_OVERLAY(#DATA_005 017);
DEFINE FIELD(#PAGE_005) TYPE(*CHAR) LENGTH(005) TO_OVERLAY(#DATA_005 046);
DEFINE FIELD(#SPLN_005) TYPE(*CHAR) LENGTH(005) TO_OVERLAY(#DATA_005 076);
DEFINE FIELD(#JOB_005) TYPE(*CHAR) LENGTH(010) TO_OVERLAY(#DATA_005 086);
DEFINE FIELD(#JOBN_005) TYPE(*CHAR) LENGTH(006) TO_OVERLAY(#DATA_005 097);
********** COMMENT();
DEFINE FIELD(#CNT_005) TYPE(*DEC) LENGTH(007) DECIMALS(0);
DEFINE FIELD(#MAX_005) TYPE(*DEC) LENGTH(007) DECIMALS(0) DEFAULT(130);
DEF_LIST NAME(#SFILES) FIELDS((#SPLF_005)(#SPLN_005)(#USER_005)(#JOB_005)(#JOBN_005)(#PAGE_005)) COUNTER(#CNT_005) TYPE(*WORKING) ENTRYS(0000130);
********** COMMENT();
DEFINE FIELD(#TST1_005) TYPE(*CHAR) LENGTH(003) TO_OVERLAY(#DATA_005 001);
DEFINE FIELD(#TST2_005) TYPE(*CHAR) LENGTH(001) TO_OVERLAY(#DATA_005 004);
DEFINE FIELD(#TST3_005) TYPE(*CHAR) LENGTH(003) TO_OVERLAY(#DATA_005 006);
********** COMMENT();
DEFINE FIELD(#RET_005) TYPE(*CHAR) LENGTH(002);
********** COMMENT();
********** COMMENT();
CLR_LIST NAMED(#SFILES);
DOUNTIL COND('(#RQS_005 = END) *OR (#RQS_005 = MORE)');
CASE OF_FIELD(#RQS_005);
WHEN VALUE_IS('= OPEN');
EXECUTE SUBROUTINE(OPEN);
WHEN VALUE_IS('= READ' '= MORE');
EXECUTE SUBROUTINE(READ);
WHEN VALUE_IS('= CLOSE');
EXECUTE SUBROUTINE(CLOSE);
OTHERWISE;
EXECUTE SUBROUTINE(UNKNOWN);
ENDCASE;
ENDUNTIL;
RETURN;
********** COMMENT();
SUBROUTINE NAME(OPEN);
DEFINE FIELD(#ENTRY_005) TYPE(*DEC) LENGTH(007) DECIMALS(0) DEFAULT(0);
IF COND('#ENTRY_005 = 0');
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('crtpf qtemp/vsplfile rcdlen(132)' *BLANKS *BLANKS *BLANKS *BLANKS);
ENDIF;
CHANGE FIELD(#ENTRY_005) TO('#ENTRY_005 + 1');
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('clrpfm qtemp/vsplfile' *BLANKS *BLANKS *BLANKS *BLANKS);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('wrkoutq outq(' #OUTQL_005 '/' #OUTQN_005 ') output(*print)');
********** COMMENT();
********** COMMENT(When a job is being run as a server job, two user);
********** COMMENT(profiles are associated with it:);
********** COMMENT(1. The actual job user profile, which is the same for);
********** COMMENT(all server jobs);
********** COMMENT(2. The current user, which was the user profile that);
********** COMMENT(was specified when the client connected to the server.);
********** COMMENT();
********** COMMENT(If these two user profiles are the same, any spool);
********** COMMENT(files that the job creates will belong to the job);
********** COMMENT(i.e. jobname/jobuser/jobnumber);
********** COMMENT();
********** COMMENT(If the two user profiles are different, spool files);
********** COMMENT(will belong to a new job called QPRTJOB/Current User);
********** COMMENT();
********** COMMENT(The current user is found in LANSA using *USER or #USER);
********** COMMENT(The actual job user is found using RTVJOBA USER);
DEFINE FIELD(#S_WRKJUSR) REFFLD(#USER) DESC('Actual Job User');
CALL PGM(SETJOBUSER) PARM(#S_WRKJUSR);
IF COND('#S_WRKJUSR *EQ #USER');
********** COMMENT(spool files belong to this job);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('cpysplf qprtsplq qtemp/vsplfile' ' splnbr(*last) ctlchar(*prtctl)' *BLANKS *BLANKS *BLANKS);
USE BUILTIN(CLR_MESSAGES);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('DLTSPLF qprtsplq splnbr(*last)' *BLANKS *BLANKS *BLANKS *BLANKS);
ELSE;
********** COMMENT(spool files belong to a different job called QPRTJOB);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('cpysplf qprtsplq qtemp/vsplfile' ' splnbr(*last) ctlchar(*prtctl) job(' #USER '/QPRTJOB)' *BLANKS);
USE BUILTIN(CLR_MESSAGES);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('DLTSPLF qprtsplq splnbr(*last) job(' #USER '/QPRTJOB)' *BLANKS *BLANKS);
ENDIF;
********** COMMENT();
********** COMMENT();
********** COMMENT();
USE BUILTIN(ACCESS_FILE) WITH_ARGS(OPEN VSPLFILE QTEMP);
CHANGE FIELD(#RQS_005) TO(READ);
ENDROUTINE;
********** COMMENT();
SUBROUTINE NAME(READ);
IF COND('#CNT_005 *GE #MAX_005');
CHANGE FIELD(#RQS_005) TO(MORE);
ELSE;
CHANGE FIELD(#RQS_005) TO(CLOSE);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ VSPLFILE QTEMP) TO_GET(#RET_005 #DATA_005);
IF COND('#RET_005 = OK');
CHANGE FIELD(#RQS_005) TO(READ);
IF COND('(#TST1_005 = *BLANKS) *AND (#TST2_005 *NE *BLANKS) *AND (#TST3_005 *NE *BLANKS)');
ADD_ENTRY TO_LIST(#SFILES);
ENDIF;
ENDIF;
ENDIF;
ENDROUTINE;
********** COMMENT();
SUBROUTINE NAME(CLOSE);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(CLOSE VSPLFILE QTEMP);
CHANGE FIELD(#RQS_005) TO(END);
ENDROUTINE;
********** COMMENT();
SUBROUTINE NAME(UNKNOWN);
CHANGE FIELD(#RQS_005) TO(END);
ENDROUTINE;
********** COMMENT();
SUBROUTINE NAME(EXECUTECMD) PARMS((#CP1_004 *RECEIVED) (#CP2_004 *RECEIVED) (#CP3_004 *RECEIVED) (#CP4_004 *RECEIVED) (#CP5_004 *RECEIVED));
DEFINE FIELD(#CP1_004) TYPE(*CHAR) LENGTH(050);
DEFINE FIELD(#CP2_004) TYPE(*CHAR) LENGTH(050);
DEFINE FIELD(#CP3_004) TYPE(*CHAR) LENGTH(050);
DEFINE FIELD(#CP4_004) TYPE(*CHAR) LENGTH(050);
DEFINE FIELD(#CP5_004) TYPE(*CHAR) LENGTH(050);
DEFINE FIELD(#CMD_004) TYPE(*CHAR) LENGTH(256);
DEFINE FIELD(#LEN_004) TYPE(*DEC) LENGTH(015) DECIMALS(5) DEFAULT(256);
USE BUILTIN(TCONCAT) WITH_ARGS(#CP1_004 #CP2_004 #CP3_004 #CP4_004 #CP5_004) TO_GET(#CMD_004);
CALL PGM(QCMDEXC) PARM(#CMD_004 #LEN_004) NUM_LEN(*DEFINED) IF_ERROR(*NEXT);
ENDROUTINE;

previous page start next page