Function VSAM004: Get List of iSeries Output Queues

LANSA

Function VSAM004: Get List of iSeries Output Queues
Name: VSAM004

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 output queues.
FUNCTION OPTIONS(*DIRECT *LIGHTUSAGE) RCV_LIST(#OUTQS);
EXCHANGE FIELDS(#RQS_004) OPTION(*ALWAYS);
DEFINE FIELD(#DTA_004) TYPE(*CHAR) LENGTH(256);
DEFINE FIELD(#NAM_004) TYPE(*CHAR) LENGTH(10) TO_OVERLAY(#DTA_004 24);
DEFINE FIELD(#LIB_004) TYPE(*CHAR) LENGTH(10) TO_OVERLAY(#DTA_004 14);
DEFINE FIELD(#RQS_004) TYPE(*CHAR) LENGTH(10);
DEFINE FIELD(#CNT_004) TYPE(*DEC) LENGTH(7) DECIMALS(0);
DEFINE FIELD(#MAX_004) TYPE(*DEC) LENGTH(7) DECIMALS(0) DEFAULT(100);
DEF_LIST NAME(#OUTQS) FIELDS(#NAM_004 #LIB_004) COUNTER(#CNT_004) TYPE(*WORKING) ENTRYS(100);
DEFINE FIELD(#RET_004) TYPE(*CHAR) LENGTH(2);
**********;
CLR_LIST NAMED(#OUTQS);
DOUNTIL COND('(#rqs_004 = END) *or (#rqs_004 = MORE)');
CASE OF_FIELD(#RQS_004);
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;
**********;
SUBROUTINE NAME(OPEN);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('dspobjd *allusr/*all *outq' ' output(*outfile) outfile(qtemp/voutqfile)' *BLANKS *BLANKS *BLANKS);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(OPEN VOUTQFILE QTEMP);
CHANGE FIELD(#RQS_004) TO(READ);
ENDROUTINE;
**********;
SUBROUTINE NAME(READ);
IF COND('#CNT_004 *GE #MAX_004');
CHANGE FIELD(#RQS_004) TO(MORE);
ELSE;
CHANGE FIELD(#RQS_004) TO(CLOSE);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ VOUTQFILE QTEMP) TO_GET(#RET_004 #DTA_004);
IF COND('#ret_004 = OK');
ADD_ENTRY TO_LIST(#OUTQS);
CHANGE FIELD(#RQS_004) TO(READ);
ENDIF;
ENDIF;
ENDROUTINE;
**********;
SUBROUTINE NAME(CLOSE);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(CLOSE VOUTQFILE QTEMP);
CHANGE FIELD(#RQS_004) TO(END);
ENDROUTINE;
**********;
SUBROUTINE NAME(UNKNOWN);
CHANGE FIELD(#RQS_004) TO(END);
ENDROUTINE;
**********;
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(50);
DEFINE FIELD(#CP2_004) TYPE(*CHAR) LENGTH(50);
DEFINE FIELD(#CP3_004) TYPE(*CHAR) LENGTH(50);
DEFINE FIELD(#CP4_004) TYPE(*CHAR) LENGTH(50);
DEFINE FIELD(#CP5_004) TYPE(*CHAR) LENGTH(50);
DEFINE FIELD(#CMD_004) TYPE(*CHAR) LENGTH(256);
DEFINE FIELD(#LEN_004) TYPE(*DEC) LENGTH(15) 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;