Function VSAM006: Get Spool File Content

LANSA

Function VSAM006: Get Spool File Content
Name: VSAM006

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 print lines in a specified spool file.
FUNCTION OPTIONS(*HEAVYUSAGE *DIRECT) RCV_LIST(#SPLFILE01 #SPLFILE02 #SPLFILE03 #SPLFILE04 #SPLFILE05 #SPLFILE06 #SPLFILE07 #SPLFILE08 #SPLFILE09 #SPLFILE10);
**********;
DEFINE FIELD(#RQS_006) TYPE(*CHAR) LENGTH(10);
EXCHANGE FIELDS(#RQS_006) OPTION(*ALWAYS);
DEFINE FIELD(#RET_006) TYPE(*CHAR) LENGTH(2);
**********;
DEFINE FIELD(#SPLF_005) TYPE(*CHAR) LENGTH(10);
DEFINE FIELD(#USER_005) TYPE(*CHAR) LENGTH(10);
DEFINE FIELD(#SPLN_005) TYPE(*CHAR) LENGTH(5);
DEFINE FIELD(#JOB_005) TYPE(*CHAR) LENGTH(10);
DEFINE FIELD(#JOBN_005) TYPE(*CHAR) LENGTH(6);
**********;
DEFINE FIELD(#IMAGE_006) TYPE(*CHAR) LENGTH(136) DESC('Image layout');
DEFINE FIELD(#SKIP_006) TYPE(*CHAR) LENGTH(3) TO_OVERLAY(#IMAGE_006);
DEFINE FIELD(#SKIPN_006) LENGTH(3) DECIMALS(0) REFFLD(#DATE) EDIT_CODE(4) DEFAULT(0) TO_OVERLAY(#IMAGE_006);
DEFINE FIELD(#SPAC_006) TYPE(*CHAR) LENGTH(1) TO_OVERLAY(#IMAGE_006 4);
DEFINE FIELD(#SPACN_006) LENGTH(1) DECIMALS(0) REFFLD(#DATE) EDIT_CODE(4) DEFAULT(0) TO_OVERLAY(#IMAGE_006 4);
**********;
DEFINE FIELD(#PAGE_006) TYPE(*DEC) LENGTH(5) DECIMALS(0);
DEFINE FIELD(#LINE_006) TYPE(*DEC) LENGTH(5) DECIMALS(0);
DEFINE FIELD(#DATA_006) TYPE(*CHAR) LENGTH(132) TO_OVERLAY(#IMAGE_006 5);
DEFINE FIELD(#CNT_006) TYPE(*DEC) LENGTH(7) DECIMALS(0);
**********;
DEF_LIST NAME(#SPLFILE01) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE02) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE03) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE04) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE05) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE06) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE07) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE08) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE09) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
DEF_LIST NAME(#SPLFILE10) FIELDS(#PAGE_006 #LINE_006 #DATA_006) TYPE(*WORKING) ENTRYS(60);
**********;
CHANGE FIELD(#CNT_006) TO(0);
CLR_LIST NAMED(#SPLFILE01);
CLR_LIST NAMED(#SPLFILE02);
CLR_LIST NAMED(#SPLFILE03);
CLR_LIST NAMED(#SPLFILE04);
CLR_LIST NAMED(#SPLFILE05);
CLR_LIST NAMED(#SPLFILE06);
CLR_LIST NAMED(#SPLFILE07);
CLR_LIST NAMED(#SPLFILE08);
CLR_LIST NAMED(#SPLFILE09);
CLR_LIST NAMED(#SPLFILE10);
**********;
DOUNTIL COND('(#rqs_006 = END) *or (#rqs_006 = MORE)');
CASE OF_FIELD(#RQS_006);
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);
DEFINE FIELD(#TJOB_006) TYPE(*CHAR) LENGTH(50);
DEFINE FIELD(#ENTRY_006) TYPE(*DEC) LENGTH(7) DECIMALS(0) DEFAULT(0);
IF COND('#entry_006 = 0');
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('crtpf qtemp/xsplfile rcdlen(135)' *BLANKS *BLANKS *BLANKS *BLANKS *BLANKS *BLANKS);
ENDIF;
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('clrpfm qtemp/xsplfile' *BLANKS *BLANKS *BLANKS *BLANKS *BLANKS *BLANKS);
CHANGE FIELD(#ENTRY_006) TO('#entry_006 + 1');
USE BUILTIN(TCONCAT) WITH_ARGS(#JOBN_005 '/' #USER_005 '/' #JOB_005) TO_GET(#TJOB_006);
EXECUTE SUBROUTINE(EXECUTECMD) WITH_PARMS('cpysplf file(' #SPLF_005 ') tofile(qtemp/xsplfile) job(' #TJOB_006 ') splnbr(' #SPLN_005 ' ) CTLCHAR(*PRTCTL)');
USE BUILTIN(ACCESS_FILE) WITH_ARGS(OPEN XSPLFILE QTEMP);
CHANGE FIELD(#RQS_006) TO(READ);
CHANGE FIELD(#PAGE_006) TO(1);
CHANGE FIELD(#LINE_006) TO(0);
ENDROUTINE;
**********;
SUBROUTINE NAME(READ);
IF COND('#CNT_006 *GE 600');
CHANGE FIELD(#RQS_006) TO(MORE);
ELSE;
CHANGE FIELD(#RQS_006) TO(CLOSE);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(READ XSPLFILE QTEMP) TO_GET(#RET_006 #IMAGE_006);
IF COND('#ret_006 = OK ');
CHANGE FIELD(#RQS_006) TO(READ);
IF COND('#SKIP_006 *ne *blanks');
IF COND('#skipn_006 < #line_006');
CHANGE FIELD(#PAGE_006) TO('#page_006 + 1');
ENDIF;
CHANGE FIELD(#LINE_006) TO(#SKIPN_006);
ELSE;
IF COND('#SPAC_006 *ne *blanks');
CHANGE FIELD(#LINE_006) TO('#LINE_006 + #SPACN_006');
ELSE;
CHANGE FIELD(#LINE_006) TO('#LINE_006 + 1');
ENDIF;
ENDIF;
CHANGE FIELD(#CNT_006) TO('#cnt_006 + 1');
CASE OF_FIELD(#CNT_006);
WHEN VALUE_IS('<= 60');
ADD_ENTRY TO_LIST(#SPLFILE01);
WHEN VALUE_IS('<= 120');
ADD_ENTRY TO_LIST(#SPLFILE02);
WHEN VALUE_IS('<= 180');
ADD_ENTRY TO_LIST(#SPLFILE03);
WHEN VALUE_IS('<= 240');
ADD_ENTRY TO_LIST(#SPLFILE04);
WHEN VALUE_IS('<= 300');
ADD_ENTRY TO_LIST(#SPLFILE05);
WHEN VALUE_IS('<= 360');
ADD_ENTRY TO_LIST(#SPLFILE06);
WHEN VALUE_IS('<= 420');
ADD_ENTRY TO_LIST(#SPLFILE07);
WHEN VALUE_IS('<= 480');
ADD_ENTRY TO_LIST(#SPLFILE08);
WHEN VALUE_IS('<= 540');
ADD_ENTRY TO_LIST(#SPLFILE09);
WHEN VALUE_IS('<= 600');
ADD_ENTRY TO_LIST(#SPLFILE10);
ENDCASE;
ENDIF;
ENDIF;
ENDROUTINE;
**********;
SUBROUTINE NAME(CLOSE);
USE BUILTIN(ACCESS_FILE) WITH_ARGS(CLOSE XSPLFILE QTEMP);
CHANGE FIELD(#RQS_006) TO(END);
ENDROUTINE;
**********;
SUBROUTINE NAME(UNKNOWN);
CHANGE FIELD(#RQS_006) TO(END);
ENDROUTINE;
**********;
SUBROUTINE NAME(EXECUTECMD) PARMS((#CP1_004 *RECEIVED) (#CP2_004 *RECEIVED) (#CP3_004 *RECEIVED) (#CP4_004 *RECEIVED) (#CP5_004 *RECEIVED) (#CP6_004 *RECEIVED) (#CP7_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(#CP6_004) TYPE(*CHAR) LENGTH(50);
DEFINE FIELD(#CP7_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);
USE BUILTIN(TCONCAT) WITH_ARGS(#CMD_004 #CP6_004 #CP7_004) TO_GET(#CMD_004);
CALL PGM(QCMDEXC) PARM(#CMD_004 #LEN_004) NUM_LEN(*DEFINED) IF_ERROR(*NEXT);
ENDROUTINE;