Output Distribution : Retreive Last Spoolfile# for job.
* -- Fields...
d #of@entry s inz like(binary@9)
d #of@keys s inz like(binary@9)
d binary@9 s 9b 0 inz
d blank@10 s 10a inz
d blank@20 s 20a inz
d ccyymmdd s d datfmt(*iso)
d curr@job s 26a inz
d dtl@data s 1000a inz
d format s 8a inz
d lib@pgm s 21a inz
d no c *off
d selected s inz like(*in01)
d start@pos s inz like(binary@9)
d us@extatr s 10a inz('quslspl')
d us@initsiz s inz(2000) like(binary@9)
d us@initval s 1a inz
d us@pubauth s 10a inz('*ALL')
d us@desc s 50a inz('OD@RTVSP# Temporary User Space')
d us@replace s 10a inz('*YES')
d usrspc@len s inz like(binary@9)
d x s 9b 0 inz
d y s 9b 0 inz
d z s 9b 0 inz
d yes c *on
* -- Data Structures....
d holdInfo ds
d hold@job 10a inz
d hold@user 10a inz
d hold@job# 6a inz
d hold@prtf 10a inz
d hold@splf# 4s 0 inz
d hold@sts 10a inz
* ---- Character/Numeric conversion...
d character ds
d numeric 1 4b 0 inz
* ---- User Space Name...
d user@space ds
d usrspc@nam 10a inz('OD@RTVSPF#')
d usrspc@lib 10a inz('QTEMP')
* ---- Requested Spooled File keys...
d splf@keys ds
d splf@key1 1 4b 0 inz(201)
d splf@key2 5 8b 0 inz(202)
d splf@key3 9 12b 0 inz(203)
d splf@key4 13 16b 0 inz(204)
d splf@key5 17 20b 0 inz(205)
d splf@key6 21 24b 0 inz(210)
* ---- Edit API Error Data Structure...
d api@err@ds ds inz
d bytes@rsvd 1 4b 0 inz(%size(api@err@ds))
d bytes@aval 5 8b 0 inz
d api@msgid# 9 15a inz
d api@rsvrd 16 16a inz
d api@errmsg 17 116a inz
* -- Indicators...
d ind@ptr s * inz(%addr(*in))
d ds based(ind@ptr)
d indicators 99
* ---- 01 - 29 : Functions Key indicators...
* ---- 30 - 39 : Random indicators...
* ---- 40 - 49 : Subfile indicators...
* ---- 50 - 89 : Error indicators...
* ---- 90 - 99 : File/Array/Scan indicators..
d recnotfnd 1 overlay(indicators:90)
d endoffile 1 overlay(indicators:99)
* -- Program parameters...
d pgm@parms ds
d out@job 10a
d out@user 10a
d out@job# 6a
d out@prtf 10a
d out@splf# 4s 0
* -- API QUSLSPL data strucure...
/copy qsysinc/qrpglesrc,quslspl
* -- Common User Space data strucure...
/copy qsysinc/qrpglesrc,qusgen
* -- Create User Space API...
c call 'QUSCRTUS'
c parm user@space
c parm us@extatr
c parm us@initsiz
c parm us@initval
c parm us@pubauth
c parm us@desc
c parm us@replace
c parm api@err@ds
* -- List out Job Spooled Files...
c call 'QUSLSPL'
c parm user@space
c parm 'SPLF0200' format
c parm blank@10
c parm blank@20
c parm blank@10
c parm blank@10
c parm api@err@ds
c parm '*' curr@job
c parm splf@keys
c parm 6 #of@keys
* ---- Retrieve User Space Header contents...
c call 'QUSRTVUS'
c parm user@space
c parm 1 start@pos
c parm 192 usrspc@len
c parm qush0100
c parm api@err@ds
* -- Check User Space status for good data...
* ---- Header Format...
c if (qussrl = '0100')
* ---- 'C'omplete or 'P'artial...
c and ((qusis = 'C') or (qusis = 'P'))
* ---- Number of List Entries in User Space is greater than 0..
c and (qusnbrle > 0)
c exsr @retrieve
* ---- If value of HOLD@STS is not *FINISHED, then return SPLF#.
c if hold@sts <> '*FINISHED'
c eval out@job = hold@job
c eval out@user = hold@user
c eval out@job# = hold@job#
c eval out@prtf = hold@prtf
c eval out@splf# = hold@splf#
c endif
c endif
c eval *inlr = *on
*****************************************************************
* Sub-routine : @retrieve *
*****************************************************************
c @retrieve begsr
* -- Maintain the number of List Entrees...
c eval #of@entry = 0
c eval x = qusnbrle
c do qusnbrle
c eval x = x - 1
* -- Adjust the Offset value to *Last Spoolfile value...
c eval start@pos = qusold + 1 +
c (x * qussee)
c clear holdInfo
* -- Retrieve the lesser of allocated storage or available data..
c eval usrspc@len = 1000
c if qussee < 1000
c eval usrspc@len = qussee
c endif
* ---- Retrieve User Space Detail contents...
c call 'QUSRTVUS'
c parm user@space
c parm start@pos
c parm usrspc@len
c parm dtl@data
c parm api@err@ds
* ---- Loop Through returned data...
c eval qusf0200 = %subst(dtl@data:1:4)
c eval z = 5
c do qusnbrfr00
* ------ Retrieve header information...
c eval qussplki = %subst(dtl@data:z:16)
* ------ Set Y to location of actual data associated with key...
c eval y = z + 16
c select
c when quskfffr00 = 201
c eval hold@prtf = %subst(dtl@data:y:qusdl02)
c when quskfffr00 = 202
c eval hold@job = %subst(dtl@data:y:qusdl02)
c when quskfffr00 = 203
c eval hold@user = %subst(dtl@data:y:qusdl02)
c when quskfffr00 = 204
c eval hold@job# = %subst(dtl@data:y:qusdl02)
c when quskfffr00 = 205
c eval character = %subst(dtl@data:y:qusdl02)
c eval hold@splf# = numeric
c when quskfffr00 = 210
c eval hold@sts = %subst(dtl@data:y:qusdl02)
c endsl
* ------ Adjust Z to address next keyed record returned...
c eval z = z + quslfir02
c enddo
* -------- If the status of the report comes back not *FINISHED
* (written or deleted) then exit do-loop..
c if hold@sts <> '*FINISHED'
c leave
c endif
c enddo
c endsr
*****************************************************************
* Sub-routine : *inzsr *
*****************************************************************
c *inzsr begsr
c *entry plist
c parm pgm@parms
c eval out@splf# = 0
c endsr
Thanks to David L Mosley, Jr.
阅读(965) | 评论(0) | 转发(0) |
