Form S_158FAS: iSeries Output Queue Browser
FUNCTION OPTIONS(*DIRECT)
BEGIN_COM HEIGHT(599) LAYOUTMANAGER(#SPLM_1) LEFT(219) TOP(67) WIDTH(716)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) CAPTION('AS/400 Output Queues') DISPLAYPOSITION(1) HEIGHT(193) LAYOUTMANAGER(#ATLM_3) LEFT(0) PARENT(#PANL_TOP) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(152)
DEFINE_COM CLASS(#PRIM_TRVW) NAME(#TREEOUTQ) DISPLAYPOSITION(1) HEIGHT(157) LEFT(4) PARENT(#GPBX_1) TABPOSITION(1) TOP(13) WIDTH(144)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_1) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(1) PARENT(#TREEOUTQ) SORTPOSITION(1) SOURCE(#STD_OBJ)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_2) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(2) PARENT(#TREEOUTQ) SORTPOSITION(1) SOURCE(#STD_NAME)
DEFINE_COM CLASS(#VL_SAM003) NAME(#SERVER) HEIGHT(225) LEFT(356) TOP(221) WIDTH(347)
DEFINE FIELD(#RETCODE) TYPE(*CHAR) LENGTH(2)
DEFINE FIELD(#RETCOD1) reffld(#retcode)
DEFINE FIELD(#RETCOD2) reffld(#retcode)
DEFINE FIELD(#OUTQFILE) TYPE(*CHAR) LENGTH(20) DEFAULT('VL_S007A.TMP')
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(1) HEIGHT(25) LEFT(0) MESSAGEPOSITION(1) PARENT(#PANL_BOT) TABPOSITION(1) TOP(350) WIDTH(708)
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#STOPLIGHT) DISPLAYPOSITION(2) HEIGHT(19) LEFT(691) PARENT(#STBR_1) TABPOSITION(2) TOP(4) VISIBLE(False) WIDTH(15)
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#GOLIGHT) DISPLAYPOSITION(1) HEIGHT(19) LEFT(674) PARENT(#STBR_1) TABPOSITION(1) TOP(4) WIDTH(15)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_REFQ) CAPTION('Refresh Queues') DISPLAYPOSITION(2) HEIGHT(19) LEFT(4) PARENT(#GPBX_1) TABPOSITION(2) TOP(170) WIDTH(144)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) CAPTION('Spool Files') DISPLAYPOSITION(2) HEIGHT(193) LAYOUTMANAGER(#ATLM_4) LEFT(152) PARENT(#PANL_TOP) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(556)
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#LISTSPLF) DISPLAYPOSITION(2) HEIGHT(159) LEFT(4) PARENT(#GPBX_2) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(30) WIDTH(548)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) CAPTION('User') CAPTIONTYPE(Caption) DISPLAYPOSITION(3) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#USER) WIDTH(24)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) CAPTION('Job Name ') CAPTIONTYPE(Caption) DISPLAYPOSITION(4) PARENT(#LISTSPLF) SOURCE(#JOBNAME) WIDTH(23)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_3) CAPTION('Job No') CAPTIONTYPE(Caption) DISPLAYPOSITION(5) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#JOBNBR) WIDTH(13)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_4) CAPTION('No') CAPTIONTYPE(Caption) DISPLAYPOSITION(6) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#STD_CODEL) WIDTH(8) WIDTHTYPE(Remainder)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_5) CAPTION('Spool File ') CAPTIONTYPE(Caption) DISPLAYPOSITION(1) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#STD_NAME) WIDTH(20)
DEFINE_COM CLASS(#PRIM_LABL) NAME(#SPLFMSG) CAPTION(' Loading Job Queue Details from AS/400 ') DISPLAYPOSITION(1) HEIGHT(17) LEFT(4) PARENT(#GPBX_2) TABPOSITION(2) TABSTOP(False) TOP(13) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(548)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) CAPTION('Spool File') DISPLAYPOSITION(2) HEIGHT(350) LAYOUTMANAGER(#ATLM_5) LEFT(0) PARENT(#PANL_BOT) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(708)
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_1) DISPLAYPOSITION(1) SOURCE(#SYSVAR$AV) WIDTH(200)
DEFINE_COM CLASS(#PRIM_LABL) NAME(#FILEMSG) CAPTION(' Loading File Details from AS/400 Server') DISPLAYPOSITION(3) HEIGHT(16) LEFT(4) PARENT(#GPBX_3) TABPOSITION(3) TABSTOP(False) TOP(13) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(700)
DEFINE_COM CLASS(#PRIM_MEMO) NAME(#LISTFILE) CURRENTLINE(1) DISPLAYPOSITION(1) ENABLEPASTE(False) HEIGHT(317) LEFT(65) MAXIMUMLINELENGTH(256) MAXIMUMLINES(1000) PARENT(#GPBX_3) READONLY(True) TABPOSITION(1) TOP(29) VISUALSTYLE(#VS_FIXED) WIDTH(639)
DEFINE_COM CLASS(#PRIM_MECL) NAME(#MECL_1) COLUMNROLE(Data) DISPLAYPOSITION(1) PARENT(#LISTFILE) SOURCE(#SYSVAR$AV) WIDTH(20)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_6) CAPTION('Pages') CAPTIONTYPE(Caption) DISPLAYPOSITION(2) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#STD_TEXTS) WIDTH(10)
DEFINE_COM CLASS(#PRIM_LTBX) NAME(#PAGELIST) DISPLAYPOSITION(2) HEIGHT(314) LEFT(4) PARENT(#GPBX_3) TABPOSITION(2) TOP(29) WIDTH(61)
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_2) DISPLAYPOSITION(1) PARENT(#PAGELIST) SOURCE(#STD_NUM) WIDTH(20)
* Layout Management
DEFINE_COM CLASS(#PRIM_SPLM) NAME(#SPLM_1) DIVIDERSTYLE(Gap)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_TOP) DISPLAYPOSITION(1) HEIGHT(193) LAYOUTMANAGER(#ATLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(708)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_BOT) DISPLAYPOSITION(2) HEIGHT(375) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(197) WIDTH(708)
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_TOP) MANAGE(#PANL_TOP) PARENT(#SPLM_1) WEIGHT(1)
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_BOT) MANAGE(#PANL_BOT) PARENT(#SPLM_1)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Left) MANAGE(#GPBX_1) PARENT(#ATLM_1)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#GPBX_2) PARENT(#ATLM_1)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Bottom) MANAGE(#STBR_1) PARENT(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Center) MANAGE(#GPBX_3) PARENT(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#TREEOUTQ) PARENT(#ATLM_3)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_6) ATTACHMENT(Bottom) MANAGE(#BTN_REFQ) PARENT(#ATLM_3)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_7) ATTACHMENT(Center) MANAGE(#LISTSPLF) PARENT(#ATLM_4)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_8) ATTACHMENT(Top) MANAGE(#SPLFMSG) PARENT(#ATLM_4)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_5)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_9) ATTACHMENT(Top) MANAGE(#FILEMSG) PARENT(#ATLM_5)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_10) ATTACHMENT(Center) MANAGE(#LISTFILE) PARENT(#ATLM_5)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_11) ATTACHMENT(Left) MANAGE(#PAGELIST) PARENT(#ATLM_5)
DEFINE FIELD(#OV_RC) TYPE(*CHAR) LENGTH(2)
DEFINE FIELD(#OV_HANDLE) TYPE(*CHAR) LENGTH(10) default(NONE)
* Form Initialization
EVTROUTINE handling(#com_owner.Initialize)
execute SetBusy (On)
SET #com_owner caption(*component_desc)
change #sysvar$av *PART_DIR_EXECUTE
use tconcat (#sysvar$av 'stopligh.bmp') (#sysvar$av)
set #stoplight filename(#sysvar$av)
change #sysvar$av *PART_DIR_EXECUTE
use tconcat (#sysvar$av 'golight.bmp') (#sysvar$av)
set #golight filename(#sysvar$av)
execute LoadOutqs (N)
execute SetBusy (Off)
ENDROUTINE
* Form Termination
EVTROUTINE HANDLING(#com_owner.Closing)
execute DestroyIdx
invoke #Server.UDisconnect
ENDROUTINE
* Create index space
subroutine CreateIdx
Execute DestroyIdx
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(CREATE 'page_006 key(), line_006 key(), data_006') TO_GET(#OV_RC #OV_HANDLE)
endroutine
* Destroy index space
subroutine DestroyIdx
IF COND('#OV_HANDLE *NE NONE')
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(DESTROY #OV_HANDLE) TO_GET(#OV_RC)
CHANGE FIELD(#OV_HANDLE) TO(NONE)
ENDIF
endroutine
* Tuen RED light and GREEN light on or off as requested by caller
subroutine setbusy ((#busyopt *received))
define #busyopt *char 5
if '#busyopt = on'
set #golight visible(False)
set #stoplight visible(True)
else
set #stoplight visible(False)
set #golight visible(True)
endif
endroutine
* Handle Refresh queues button
EVTROUTINE HANDLING(#BTN_REFQ.Click)
execute SetBusy (On)
clr_list #listsplf
clr_list #listfile
clr_list #pagelist
execute LoadOutqs (Y)
execute SetBusy (Off)
ENDROUTINE
* Handle new Output queue name selected in queue tree view
EVTROUTINE HANDLING(#TREEOUTQ.ItemGotFocus)
if '#TREEOUTQ.CurrentItem.Level = 2'
execute SetBusy (On)
clr_list #listsplf
clr_list #listfile
clr_list #pagelist
execute LoadSplfs (#std_name #std_obj)
execute SetBusy (Off)
endif
ENDROUTINE
* Handle new spool File selected in list view
EVTROUTINE HANDLING(#LISTSPLF.ItemGotFocus)
execute SetBusy (On)
clr_list #listfile
clr_list #pagelist
execute loadfile ( #std_name #std_codel #user #jobname #jobnbr )
execute SetBusy (Off)
ENDROUTINE
* Handle a spool file page selected from the page number list
EVTROUTINE HANDLING(#PAGELIST.ItemGotSelection)
DEFINE FIELD(#CLINE_006) TYPE(*DEC) LENGTH(7) DECIMALS(0)
Execute SetBusy (On)
CHANGE FIELD(#CLINE_006) TO(1)
CLR_LIST NAMED(#LISTFILE)
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(FIRST #OV_HANDLE) TO_GET(#OV_RC)
DOWHILE COND('(#ov_rc = OK) *and (#PAGE_006 <= #STD_NUM)')
IF COND('#PAGE_006 = #STD_NUM')
DOWHILE COND('#cline_006 *lt #line_006')
CHANGE FIELD(#sysvar$av) TO(*BLANKS)
ADD_ENTRY TO_LIST(#LISTFILE)
CHANGE FIELD(#CLINE_006) TO('#cline_006 + 1')
ENDWHILE
CHANGE FIELD(#sysvar$av) TO(#DATA_006)
CHANGE FIELD(#CLINE_006) TO('#cline_006 + 1')
ADD_ENTRY TO_LIST(#LISTFILE)
ENDIF
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(NEXT #OV_HANDLE) TO_GET(#OV_RC)
ENDWHILE
execute SetBusy (Off)
ENDROUTINE
* (Re)Load output queue details from flat local file or by RPC to VSAM004
subroutine loadoutqs ((#refresh *received))
DEFINE FIELD(#REFRESH) TYPE(*CHAR) LENGTH(1)
DEFINE FIELD(#NAM_004) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#LIB_004) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#RQS_004) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#CNT_004) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEF_LIST NAME(#WORKOUTQ) FIELDS(#NAM_004 #LIB_004) COUNTER(#CNT_004) TYPE(*WORKING) ENTRYS(9999)
* Force refresh if requested by deleting list stored in local files
IF COND('#refresh = Y')
USE BUILTIN(OV_FILE_SERVICE) WITH_ARGS(REMOVE_FILE #OUTQFILE)
ENDIF
* Clear tree and working list equivalent
CLR_LIST NAMED(#TREEOUTQ)
CLR_LIST NAMED(#WORKOUTQ)
* Try to load from local file. If not loaded (or empty) resort to calling function VSAM004 as an RPC to get list from server
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#WORKOUTQ #OUTQFILE T I Y '.') TO_GET(#RETCODE)
IF COND('(#retcode *NE ER) *and (#cnt_004 > 0)')
EXECUTE SUBROUTINE(COPYOUTQ)
ELSE
invoke #Server.UConnectModal
if '*sserver_type *ne AS400'
Message 'You are not currently connected to an AS/400 server system'
else
USE BUILTIN(CLR_MESSAGES)
CHANGE FIELD(#RQS_004) TO(OPEN)
DOUNTIL COND('(#RQS_004 = END) *OR (#RETCOD1 *NE OK) *OR (#RETCOD2 *NE OK)')
EXCHANGE FIELDS(#RQS_004)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*SSERVER_SSN VSAM004 Y Y #WORKOUTQ) TO_GET(#RETCOD1)
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#WORKOUTQ #OUTQFILE T I Y '.' N) TO_GET(#RETCOD2)
EXECUTE SUBROUTINE(COPYOUTQ)
ENDUNTIL
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#WORKOUTQ #OUTQFILE T I Y '.' Y) TO_GET(#RETCOD2)
endif
ENDIF
endroutine
* Copy contents of WORKOUTQ list into TREEOUTQ list and then clear WORKOUTQ list
SUBROUTINE NAME(COPYOUTQ)
SELECTLIST NAMED(#WORKOUTQ)
CHANGE FIELD(#STD_OBJ) TO(#LIB_004)
CHANGE FIELD(#STD_NAME) TO(#NAM_004)
ADD_ENTRY TO_LIST(#TREEOUTQ)
ENDSELECT
CLR_LIST NAMED(#WORKOUTQ)
ENDROUTINE
* (Re)Load spool file details for specifed job queue
subroutine loadsplfs ((#OUTQN_005 *received)(#OUTQL_005 *received))
DEFINE FIELD(#OUTQN_005) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#OUTQL_005) TYPE(*CHAR) LENGTH(10)
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(#PAGE_005) TYPE(*CHAR) LENGTH(5)
DEFINE FIELD(#JOB_005) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#JOBN_005) TYPE(*CHAR) LENGTH(6)
DEFINE FIELD(#RQS_005) TYPE(*CHAR) LENGTH(10)
**********
DEFINE FIELD(#CNT_005) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEF_LIST NAME(#WORKSPLF) FIELDS(#SPLF_005 #SPLN_005 #USER_005 #JOB_005 #JOBN_005 #PAGE_005) COUNTER(#CNT_005) TYPE(*WORKING) entrys(9999)
* Clear current lists
CLR_LIST NAMED(#LISTSPLF)
CLR_LIST NAMED(#WORKSPLF)
Set #splfmsg visible(true)
set #gpbx_2 caption(#OUTQN_005)
MESSAGE MSGTXT(' ') TYPE(*STATUS)
* Call function VSAM005 as an RPC to get list from server
invoke #Server.UConnectModal
if '*sserver_type *ne AS400'
Message 'You are not currently connected to an AS/400 server system'
else
CHANGE FIELD(#RQS_005) TO(OPEN)
EXCHANGE FIELDS(#OUTQN_005 #OUTQL_005)
DOUNTIL COND('(#RQS_005 = END) *OR (#RETCODE *NE OK)')
EXCHANGE FIELDS(#RQS_005)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*SSERVER_SSN VSAM005 Y Y #WORKSPLF) TO_GET(#RETCODE)
EXECUTE SUBROUTINE(COPYSPLF)
ENDUNTIL
endif
Set #splfmsg visible(False)
endroutine
* Copy contents of WORKSPLF list into LISTSPLF llist and then clear WORKSPLF list
SUBROUTINE NAME(COPYSPLF)
SELECTLIST NAMED(#WORKSPLF)
CHANGE FIELD(#STD_OBJ) TO(#LIB_004)
CHANGE FIELD(#STD_NAME) TO(#NAM_004)
change #std_name #SPLF_005
change #user #USER_005
change #std_codel #SPLN_005
change #jobname #JOB_005
change #jobnbr #JOBN_005
change #std_texts #page_005
ADD_ENTRY TO_LIST(#LISTSPLF)
ENDSELECT
CLR_LIST NAMED(#WORKSPLF)
ENDROUTINE
* (Re)Load a specific spool file details for specifed job queue
subroutine loadfile ((#SPLF_005 *received) (#SPLN_005 *received) (#USER_005 *received) (#JOB_005 *received) (#JOBN_005 *received) )
DEFINE FIELD(#RQS_006) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#CNT_006) reffld(#date) LENGTH(7) DECIMALS(0) edit_code(4) default(0)
DEFINE FIELD(#CNT1H_006) TYPE(*CHAR) LENGTH(2) TO_OVERLAY(#CNT_006 6)
**********
DEFINE FIELD(#PAGE_006) TYPE(*DEC) LENGTH(5) DECIMALS(0)
DEFINE FIELD(#PPAGE_006) REFFLD(#PAGE_006)
DEFINE FIELD(#LINE_006) TYPE(*DEC) LENGTH(5) DECIMALS(0)
DEFINE FIELD(#DATA_006) TYPE(*CHAR) LENGTH(132)
DEF_LIST NAME(#WRKFILE01) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE02) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE03) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE04) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE05) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE06) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE07) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE08) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE09) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE10) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
* Clear current lists
CLR_LIST NAMED(#WRKFILE01)
CLR_LIST NAMED(#WRKFILE02)
CLR_LIST NAMED(#WRKFILE03)
CLR_LIST NAMED(#WRKFILE04)
CLR_LIST NAMED(#WRKFILE05)
CLR_LIST NAMED(#WRKFILE06)
CLR_LIST NAMED(#WRKFILE07)
CLR_LIST NAMED(#WRKFILE08)
CLR_LIST NAMED(#WRKFILE09)
CLR_LIST NAMED(#WRKFILE10)
CLR_LIST NAMED(#LISTFILE)
CLR_LIST NAMED(#PAGELIST)
CHANGE FIELD(#PPAGE_006) TO(*HIVAL)
EXECUTE CreateIdx
*
Set #filemsg visible(true)
set #gpbx_3 caption(#SPLF_005)
MESSAGE MSGTXT(' ') TYPE(*STATUS)
* Call function VSAM006 as an RPC to get list from server
invoke #Server.UConnectModal
if '*sserver_type *ne AS400'
Message 'You are not currently connected to an AS/400 server system'
else
CHANGE FIELD(#CNT_006) TO(0)
CHANGE FIELD(#RQS_006) TO(OPEN)
exchange fields(#SPLF_005 #SPLN_005 #USER_005 #JOB_005 #JOBN_005)
DOUNTIL COND('(#RQS_006 = END) *OR (#RETCODE *NE OK)')
exchange fields(#RQS_006)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*SSERVER_SSN VSAM006 Y Y #WRKFILE01 #WRKFILE02 #WRKFILE03 #WRKFILE04 #WRKFILE05 #WRKFILE06 #WRKFILE07 #WRKFILE08 #WRKFILE09 #WRKFILE10) TO_GET(#RETCODE)
EXECUTE SUBROUTINE(COPYFILE)
ENDUNTIL
endif
Set #filemsg visible(False)
Invoke #pagelist.SetFocus
endroutine
* Copy contents of WORKSPLF list into LISTSPLF llist and then clear WORKSPLF list
SUBROUTINE NAME(COPYFILE)
SELECTLIST NAMED(#WRKFILE01)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE01)
SELECTLIST NAMED(#WRKFILE02)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE02)
SELECTLIST NAMED(#WRKFILE03)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE03)
SELECTLIST NAMED(#WRKFILE04)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE04)
SELECTLIST NAMED(#WRKFILE05)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE05)
SELECTLIST NAMED(#WRKFILE06)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE06)
SELECTLIST NAMED(#WRKFILE07)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE07)
SELECTLIST NAMED(#WRKFILE08)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE08)
SELECTLIST NAMED(#WRKFILE09)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE09)
SELECTLIST NAMED(#WRKFILE10)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE10)
ENDROUTINE
* Add the details of a spool file line to the indexed space and page number list view
subroutine AddLine
IF COND('#cnt1h_006 = ''00''')
DEFINE FIELD(#EX_COUNT) TYPE(*DEC) LENGTH(15) DECIMALS(0)
DEFINE FIELD(#EX_NAME) TYPE(*CHAR) LENGTH(20)
CHANGE FIELD(#EX_COUNT) TO(#CNT_006)
CHANGE FIELD(#EX_NAME) TO('''Print Lines''')
MESSAGE MSGID(DCU0017) MSGF(DC@M01) MSGDTA(#EX_COUNT #EX_NAME) TYPE(*STATUS)
endif
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(INSERT #OV_HANDLE) TO_GET(#OV_RC)
IF COND('#page_006 *ne #ppage_006')
CHANGE FIELD(#PPAGE_006 #STD_NUM) TO(#PAGE_006)
ADD_ENTRY TO_LIST(#PAGELIST)
ENDIF
CHANGE FIELD(#CNT_006) TO('#cnt_006 + 1')
endroutine
END_COM
FUNCTION OPTIONS(*DIRECT)
BEGIN_COM HEIGHT(599) LAYOUTMANAGER(#SPLM_1) LEFT(219) TOP(67) WIDTH(716)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) CAPTION('AS/400 Output Queues') DISPLAYPOSITION(1) HEIGHT(193) LAYOUTMANAGER(#ATLM_3) LEFT(0) PARENT(#PANL_TOP) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(152)
DEFINE_COM CLASS(#PRIM_TRVW) NAME(#TREEOUTQ) DISPLAYPOSITION(1) HEIGHT(157) LEFT(4) PARENT(#GPBX_1) TABPOSITION(1) TOP(13) WIDTH(144)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_1) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(1) PARENT(#TREEOUTQ) SORTPOSITION(1) SOURCE(#STD_OBJ)
DEFINE_COM CLASS(#PRIM_TVCL) NAME(#TVCL_2) DISPLAYPOSITION(1) KEYPOSITION(1) LEVEL(2) PARENT(#TREEOUTQ) SORTPOSITION(1) SOURCE(#STD_NAME)
DEFINE_COM CLASS(#VL_SAM003) NAME(#SERVER) HEIGHT(225) LEFT(356) TOP(221) WIDTH(347)
DEFINE FIELD(#RETCODE) TYPE(*CHAR) LENGTH(2)
DEFINE FIELD(#RETCOD1) reffld(#retcode)
DEFINE FIELD(#RETCOD2) reffld(#retcode)
DEFINE FIELD(#OUTQFILE) TYPE(*CHAR) LENGTH(20) DEFAULT('VL_S007A.TMP')
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(1) HEIGHT(25) LEFT(0) MESSAGEPOSITION(1) PARENT(#PANL_BOT) TABPOSITION(1) TOP(350) WIDTH(708)
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#STOPLIGHT) DISPLAYPOSITION(2) HEIGHT(19) LEFT(691) PARENT(#STBR_1) TABPOSITION(2) TOP(4) VISIBLE(False) WIDTH(15)
DEFINE_COM CLASS(#PRIM_IMGE) NAME(#GOLIGHT) DISPLAYPOSITION(1) HEIGHT(19) LEFT(674) PARENT(#STBR_1) TABPOSITION(1) TOP(4) WIDTH(15)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_REFQ) CAPTION('Refresh Queues') DISPLAYPOSITION(2) HEIGHT(19) LEFT(4) PARENT(#GPBX_1) TABPOSITION(2) TOP(170) WIDTH(144)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) CAPTION('Spool Files') DISPLAYPOSITION(2) HEIGHT(193) LAYOUTMANAGER(#ATLM_4) LEFT(152) PARENT(#PANL_TOP) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(556)
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#LISTSPLF) DISPLAYPOSITION(2) HEIGHT(159) LEFT(4) PARENT(#GPBX_2) SELECTIONSTYLE(Single) TABPOSITION(1) TOP(30) WIDTH(548)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) CAPTION('User') CAPTIONTYPE(Caption) DISPLAYPOSITION(3) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#USER) WIDTH(24)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) CAPTION('Job Name ') CAPTIONTYPE(Caption) DISPLAYPOSITION(4) PARENT(#LISTSPLF) SOURCE(#JOBNAME) WIDTH(23)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_3) CAPTION('Job No') CAPTIONTYPE(Caption) DISPLAYPOSITION(5) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#JOBNBR) WIDTH(13)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_4) CAPTION('No') CAPTIONTYPE(Caption) DISPLAYPOSITION(6) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#STD_CODEL) WIDTH(8) WIDTHTYPE(Remainder)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_5) CAPTION('Spool File ') CAPTIONTYPE(Caption) DISPLAYPOSITION(1) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#STD_NAME) WIDTH(20)
DEFINE_COM CLASS(#PRIM_LABL) NAME(#SPLFMSG) CAPTION(' Loading Job Queue Details from AS/400 ') DISPLAYPOSITION(1) HEIGHT(17) LEFT(4) PARENT(#GPBX_2) TABPOSITION(2) TABSTOP(False) TOP(13) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(548)
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) CAPTION('Spool File') DISPLAYPOSITION(2) HEIGHT(350) LAYOUTMANAGER(#ATLM_5) LEFT(0) PARENT(#PANL_BOT) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(708)
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_1) DISPLAYPOSITION(1) SOURCE(#SYSVAR$AV) WIDTH(200)
DEFINE_COM CLASS(#PRIM_LABL) NAME(#FILEMSG) CAPTION(' Loading File Details from AS/400 Server') DISPLAYPOSITION(3) HEIGHT(16) LEFT(4) PARENT(#GPBX_3) TABPOSITION(3) TABSTOP(False) TOP(13) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(700)
DEFINE_COM CLASS(#PRIM_MEMO) NAME(#LISTFILE) CURRENTLINE(1) DISPLAYPOSITION(1) ENABLEPASTE(False) HEIGHT(317) LEFT(65) MAXIMUMLINELENGTH(256) MAXIMUMLINES(1000) PARENT(#GPBX_3) READONLY(True) TABPOSITION(1) TOP(29) VISUALSTYLE(#VS_FIXED) WIDTH(639)
DEFINE_COM CLASS(#PRIM_MECL) NAME(#MECL_1) COLUMNROLE(Data) DISPLAYPOSITION(1) PARENT(#LISTFILE) SOURCE(#SYSVAR$AV) WIDTH(20)
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_6) CAPTION('Pages') CAPTIONTYPE(Caption) DISPLAYPOSITION(2) MINIMUMWIDTH(1) PARENT(#LISTSPLF) SOURCE(#STD_TEXTS) WIDTH(10)
DEFINE_COM CLASS(#PRIM_LTBX) NAME(#PAGELIST) DISPLAYPOSITION(2) HEIGHT(314) LEFT(4) PARENT(#GPBX_3) TABPOSITION(2) TOP(29) WIDTH(61)
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_2) DISPLAYPOSITION(1) PARENT(#PAGELIST) SOURCE(#STD_NUM) WIDTH(20)
* Layout Management
DEFINE_COM CLASS(#PRIM_SPLM) NAME(#SPLM_1) DIVIDERSTYLE(Gap)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_TOP) DISPLAYPOSITION(1) HEIGHT(193) LAYOUTMANAGER(#ATLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(708)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_BOT) DISPLAYPOSITION(2) HEIGHT(375) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(197) WIDTH(708)
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_TOP) MANAGE(#PANL_TOP) PARENT(#SPLM_1) WEIGHT(1)
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_BOT) MANAGE(#PANL_BOT) PARENT(#SPLM_1)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Left) MANAGE(#GPBX_1) PARENT(#ATLM_1)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#GPBX_2) PARENT(#ATLM_1)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Bottom) MANAGE(#STBR_1) PARENT(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Center) MANAGE(#GPBX_3) PARENT(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#TREEOUTQ) PARENT(#ATLM_3)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_6) ATTACHMENT(Bottom) MANAGE(#BTN_REFQ) PARENT(#ATLM_3)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_7) ATTACHMENT(Center) MANAGE(#LISTSPLF) PARENT(#ATLM_4)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_8) ATTACHMENT(Top) MANAGE(#SPLFMSG) PARENT(#ATLM_4)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_5)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_9) ATTACHMENT(Top) MANAGE(#FILEMSG) PARENT(#ATLM_5)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_10) ATTACHMENT(Center) MANAGE(#LISTFILE) PARENT(#ATLM_5)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_11) ATTACHMENT(Left) MANAGE(#PAGELIST) PARENT(#ATLM_5)
DEFINE FIELD(#OV_RC) TYPE(*CHAR) LENGTH(2)
DEFINE FIELD(#OV_HANDLE) TYPE(*CHAR) LENGTH(10) default(NONE)
* Form Initialization
EVTROUTINE handling(#com_owner.Initialize)
execute SetBusy (On)
SET #com_owner caption(*component_desc)
change #sysvar$av *PART_DIR_EXECUTE
use tconcat (#sysvar$av 'stopligh.bmp') (#sysvar$av)
set #stoplight filename(#sysvar$av)
change #sysvar$av *PART_DIR_EXECUTE
use tconcat (#sysvar$av 'golight.bmp') (#sysvar$av)
set #golight filename(#sysvar$av)
execute LoadOutqs (N)
execute SetBusy (Off)
ENDROUTINE
* Form Termination
EVTROUTINE HANDLING(#com_owner.Closing)
execute DestroyIdx
invoke #Server.UDisconnect
ENDROUTINE
* Create index space
subroutine CreateIdx
Execute DestroyIdx
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(CREATE 'page_006 key(), line_006 key(), data_006') TO_GET(#OV_RC #OV_HANDLE)
endroutine
* Destroy index space
subroutine DestroyIdx
IF COND('#OV_HANDLE *NE NONE')
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(DESTROY #OV_HANDLE) TO_GET(#OV_RC)
CHANGE FIELD(#OV_HANDLE) TO(NONE)
ENDIF
endroutine
* Tuen RED light and GREEN light on or off as requested by caller
subroutine setbusy ((#busyopt *received))
define #busyopt *char 5
if '#busyopt = on'
set #golight visible(False)
set #stoplight visible(True)
else
set #stoplight visible(False)
set #golight visible(True)
endif
endroutine
* Handle Refresh queues button
EVTROUTINE HANDLING(#BTN_REFQ.Click)
execute SetBusy (On)
clr_list #listsplf
clr_list #listfile
clr_list #pagelist
execute LoadOutqs (Y)
execute SetBusy (Off)
ENDROUTINE
* Handle new Output queue name selected in queue tree view
EVTROUTINE HANDLING(#TREEOUTQ.ItemGotFocus)
if '#TREEOUTQ.CurrentItem.Level = 2'
execute SetBusy (On)
clr_list #listsplf
clr_list #listfile
clr_list #pagelist
execute LoadSplfs (#std_name #std_obj)
execute SetBusy (Off)
endif
ENDROUTINE
* Handle new spool File selected in list view
EVTROUTINE HANDLING(#LISTSPLF.ItemGotFocus)
execute SetBusy (On)
clr_list #listfile
clr_list #pagelist
execute loadfile ( #std_name #std_codel #user #jobname #jobnbr )
execute SetBusy (Off)
ENDROUTINE
* Handle a spool file page selected from the page number list
EVTROUTINE HANDLING(#PAGELIST.ItemGotSelection)
DEFINE FIELD(#CLINE_006) TYPE(*DEC) LENGTH(7) DECIMALS(0)
Execute SetBusy (On)
CHANGE FIELD(#CLINE_006) TO(1)
CLR_LIST NAMED(#LISTFILE)
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(FIRST #OV_HANDLE) TO_GET(#OV_RC)
DOWHILE COND('(#ov_rc = OK) *and (#PAGE_006 <= #STD_NUM)')
IF COND('#PAGE_006 = #STD_NUM')
DOWHILE COND('#cline_006 *lt #line_006')
CHANGE FIELD(#sysvar$av) TO(*BLANKS)
ADD_ENTRY TO_LIST(#LISTFILE)
CHANGE FIELD(#CLINE_006) TO('#cline_006 + 1')
ENDWHILE
CHANGE FIELD(#sysvar$av) TO(#DATA_006)
CHANGE FIELD(#CLINE_006) TO('#cline_006 + 1')
ADD_ENTRY TO_LIST(#LISTFILE)
ENDIF
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(NEXT #OV_HANDLE) TO_GET(#OV_RC)
ENDWHILE
execute SetBusy (Off)
ENDROUTINE
* (Re)Load output queue details from flat local file or by RPC to VSAM004
subroutine loadoutqs ((#refresh *received))
DEFINE FIELD(#REFRESH) TYPE(*CHAR) LENGTH(1)
DEFINE FIELD(#NAM_004) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#LIB_004) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#RQS_004) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#CNT_004) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEF_LIST NAME(#WORKOUTQ) FIELDS(#NAM_004 #LIB_004) COUNTER(#CNT_004) TYPE(*WORKING) ENTRYS(9999)
* Force refresh if requested by deleting list stored in local files
IF COND('#refresh = Y')
USE BUILTIN(OV_FILE_SERVICE) WITH_ARGS(REMOVE_FILE #OUTQFILE)
ENDIF
* Clear tree and working list equivalent
CLR_LIST NAMED(#TREEOUTQ)
CLR_LIST NAMED(#WORKOUTQ)
* Try to load from local file. If not loaded (or empty) resort to calling function VSAM004 as an RPC to get list from server
USE BUILTIN(TRANSFORM_FILE) WITH_ARGS(#WORKOUTQ #OUTQFILE T I Y '.') TO_GET(#RETCODE)
IF COND('(#retcode *NE ER) *and (#cnt_004 > 0)')
EXECUTE SUBROUTINE(COPYOUTQ)
ELSE
invoke #Server.UConnectModal
if '*sserver_type *ne AS400'
Message 'You are not currently connected to an AS/400 server system'
else
USE BUILTIN(CLR_MESSAGES)
CHANGE FIELD(#RQS_004) TO(OPEN)
DOUNTIL COND('(#RQS_004 = END) *OR (#RETCOD1 *NE OK) *OR (#RETCOD2 *NE OK)')
EXCHANGE FIELDS(#RQS_004)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*SSERVER_SSN VSAM004 Y Y #WORKOUTQ) TO_GET(#RETCOD1)
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#WORKOUTQ #OUTQFILE T I Y '.' N) TO_GET(#RETCOD2)
EXECUTE SUBROUTINE(COPYOUTQ)
ENDUNTIL
USE BUILTIN(TRANSFORM_LIST) WITH_ARGS(#WORKOUTQ #OUTQFILE T I Y '.' Y) TO_GET(#RETCOD2)
endif
ENDIF
endroutine
* Copy contents of WORKOUTQ list into TREEOUTQ list and then clear WORKOUTQ list
SUBROUTINE NAME(COPYOUTQ)
SELECTLIST NAMED(#WORKOUTQ)
CHANGE FIELD(#STD_OBJ) TO(#LIB_004)
CHANGE FIELD(#STD_NAME) TO(#NAM_004)
ADD_ENTRY TO_LIST(#TREEOUTQ)
ENDSELECT
CLR_LIST NAMED(#WORKOUTQ)
ENDROUTINE
* (Re)Load spool file details for specifed job queue
subroutine loadsplfs ((#OUTQN_005 *received)(#OUTQL_005 *received))
DEFINE FIELD(#OUTQN_005) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#OUTQL_005) TYPE(*CHAR) LENGTH(10)
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(#PAGE_005) TYPE(*CHAR) LENGTH(5)
DEFINE FIELD(#JOB_005) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#JOBN_005) TYPE(*CHAR) LENGTH(6)
DEFINE FIELD(#RQS_005) TYPE(*CHAR) LENGTH(10)
**********
DEFINE FIELD(#CNT_005) TYPE(*DEC) LENGTH(7) DECIMALS(0)
DEF_LIST NAME(#WORKSPLF) FIELDS(#SPLF_005 #SPLN_005 #USER_005 #JOB_005 #JOBN_005 #PAGE_005) COUNTER(#CNT_005) TYPE(*WORKING) entrys(9999)
* Clear current lists
CLR_LIST NAMED(#LISTSPLF)
CLR_LIST NAMED(#WORKSPLF)
Set #splfmsg visible(true)
set #gpbx_2 caption(#OUTQN_005)
MESSAGE MSGTXT(' ') TYPE(*STATUS)
* Call function VSAM005 as an RPC to get list from server
invoke #Server.UConnectModal
if '*sserver_type *ne AS400'
Message 'You are not currently connected to an AS/400 server system'
else
CHANGE FIELD(#RQS_005) TO(OPEN)
EXCHANGE FIELDS(#OUTQN_005 #OUTQL_005)
DOUNTIL COND('(#RQS_005 = END) *OR (#RETCODE *NE OK)')
EXCHANGE FIELDS(#RQS_005)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*SSERVER_SSN VSAM005 Y Y #WORKSPLF) TO_GET(#RETCODE)
EXECUTE SUBROUTINE(COPYSPLF)
ENDUNTIL
endif
Set #splfmsg visible(False)
endroutine
* Copy contents of WORKSPLF list into LISTSPLF llist and then clear WORKSPLF list
SUBROUTINE NAME(COPYSPLF)
SELECTLIST NAMED(#WORKSPLF)
CHANGE FIELD(#STD_OBJ) TO(#LIB_004)
CHANGE FIELD(#STD_NAME) TO(#NAM_004)
change #std_name #SPLF_005
change #user #USER_005
change #std_codel #SPLN_005
change #jobname #JOB_005
change #jobnbr #JOBN_005
change #std_texts #page_005
ADD_ENTRY TO_LIST(#LISTSPLF)
ENDSELECT
CLR_LIST NAMED(#WORKSPLF)
ENDROUTINE
* (Re)Load a specific spool file details for specifed job queue
subroutine loadfile ((#SPLF_005 *received) (#SPLN_005 *received) (#USER_005 *received) (#JOB_005 *received) (#JOBN_005 *received) )
DEFINE FIELD(#RQS_006) TYPE(*CHAR) LENGTH(10)
DEFINE FIELD(#CNT_006) reffld(#date) LENGTH(7) DECIMALS(0) edit_code(4) default(0)
DEFINE FIELD(#CNT1H_006) TYPE(*CHAR) LENGTH(2) TO_OVERLAY(#CNT_006 6)
**********
DEFINE FIELD(#PAGE_006) TYPE(*DEC) LENGTH(5) DECIMALS(0)
DEFINE FIELD(#PPAGE_006) REFFLD(#PAGE_006)
DEFINE FIELD(#LINE_006) TYPE(*DEC) LENGTH(5) DECIMALS(0)
DEFINE FIELD(#DATA_006) TYPE(*CHAR) LENGTH(132)
DEF_LIST NAME(#WRKFILE01) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE02) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE03) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE04) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE05) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE06) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE07) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE08) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE09) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
DEF_LIST NAME(#WRKFILE10) FIELDS(#PAGE_006 #LINE_006 #DATA_006) entrys(60) TYPE(*WORKING)
* Clear current lists
CLR_LIST NAMED(#WRKFILE01)
CLR_LIST NAMED(#WRKFILE02)
CLR_LIST NAMED(#WRKFILE03)
CLR_LIST NAMED(#WRKFILE04)
CLR_LIST NAMED(#WRKFILE05)
CLR_LIST NAMED(#WRKFILE06)
CLR_LIST NAMED(#WRKFILE07)
CLR_LIST NAMED(#WRKFILE08)
CLR_LIST NAMED(#WRKFILE09)
CLR_LIST NAMED(#WRKFILE10)
CLR_LIST NAMED(#LISTFILE)
CLR_LIST NAMED(#PAGELIST)
CHANGE FIELD(#PPAGE_006) TO(*HIVAL)
EXECUTE CreateIdx
*
Set #filemsg visible(true)
set #gpbx_3 caption(#SPLF_005)
MESSAGE MSGTXT(' ') TYPE(*STATUS)
* Call function VSAM006 as an RPC to get list from server
invoke #Server.UConnectModal
if '*sserver_type *ne AS400'
Message 'You are not currently connected to an AS/400 server system'
else
CHANGE FIELD(#CNT_006) TO(0)
CHANGE FIELD(#RQS_006) TO(OPEN)
exchange fields(#SPLF_005 #SPLN_005 #USER_005 #JOB_005 #JOBN_005)
DOUNTIL COND('(#RQS_006 = END) *OR (#RETCODE *NE OK)')
exchange fields(#RQS_006)
USE BUILTIN(CALL_SERVER_FUNCTION) WITH_ARGS(*SSERVER_SSN VSAM006 Y Y #WRKFILE01 #WRKFILE02 #WRKFILE03 #WRKFILE04 #WRKFILE05 #WRKFILE06 #WRKFILE07 #WRKFILE08 #WRKFILE09 #WRKFILE10) TO_GET(#RETCODE)
EXECUTE SUBROUTINE(COPYFILE)
ENDUNTIL
endif
Set #filemsg visible(False)
Invoke #pagelist.SetFocus
endroutine
* Copy contents of WORKSPLF list into LISTSPLF llist and then clear WORKSPLF list
SUBROUTINE NAME(COPYFILE)
SELECTLIST NAMED(#WRKFILE01)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE01)
SELECTLIST NAMED(#WRKFILE02)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE02)
SELECTLIST NAMED(#WRKFILE03)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE03)
SELECTLIST NAMED(#WRKFILE04)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE04)
SELECTLIST NAMED(#WRKFILE05)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE05)
SELECTLIST NAMED(#WRKFILE06)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE06)
SELECTLIST NAMED(#WRKFILE07)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE07)
SELECTLIST NAMED(#WRKFILE08)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE08)
SELECTLIST NAMED(#WRKFILE09)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE09)
SELECTLIST NAMED(#WRKFILE10)
EXECUTE AddLine
ENDSELECT
CLR_LIST NAMED(#WRKFILE10)
ENDROUTINE
* Add the details of a spool file line to the indexed space and page number list view
subroutine AddLine
IF COND('#cnt1h_006 = ''00''')
DEFINE FIELD(#EX_COUNT) TYPE(*DEC) LENGTH(15) DECIMALS(0)
DEFINE FIELD(#EX_NAME) TYPE(*CHAR) LENGTH(20)
CHANGE FIELD(#EX_COUNT) TO(#CNT_006)
CHANGE FIELD(#EX_NAME) TO('''Print Lines''')
MESSAGE MSGID(DCU0017) MSGF(DC@M01) MSGDTA(#EX_COUNT #EX_NAME) TYPE(*STATUS)
endif
USE BUILTIN(OV_INDEXED_SPACE) WITH_ARGS(INSERT #OV_HANDLE) TO_GET(#OV_RC)
IF COND('#page_006 *ne #ppage_006')
CHANGE FIELD(#PPAGE_006 #STD_NUM) TO(#PAGE_006)
ADD_ENTRY TO_LIST(#PAGELIST)
ENDIF
CHANGE FIELD(#CNT_006) TO('#cnt_006 + 1')
endroutine
END_COM