This example Loads a subfile of spooled files selected by their userdata field.
The userdata field is an order number so it is validated against an order master
file. Also the production orders print in multiple outqueues so when they load
in the subfile they are in outqueue order. So we used the QLGSORT API to resort
them by production order number. An added extra is the use of the INDDS data
structure and the use of Hex byte codes for function keys.
*
* Field Definitions.
*
DEXITER S 1A
DNOTUSED S 16A
DRETURNSIZE S 9B 0
DSIZELIST S 9B 0
DSFLRCD DS
D S1PRO# 1 7 0
D S1CNAME 8 37
D H1JOB 38 47
D H1USER 48 57
D H1JOB# 58 63
D H1SPFN 64 73
D H1SPF# 74 78 0
D H1OUTQ 79 88
D H1OUTQLIB 89 98
*
DSORTBLOCK DS
D BLOCKLEN 1 4B 0 INZ(0)
D REQTYPE 5 8B 0 INZ(8)
D RSVP1 9 12B 0 INZ(0)
D OPTIONS 13 16B 0 INZ(0)
D RECLEN 17 20B 0 INZ(0)
D RECCOUNT 21 24B 0 INZ(0)
D OFF2KEY 25 28B 0 INZ(80)
D NBROFKEYS 29 32B 0 INZ(0)
D OFF2NLSI 33 36B 0 INZ(0)
D OFF2IFL 37 40B 0 INZ(0)
D NBRINF 41 44B 0 INZ(0)
D OFF2OFL 45 48B 0 INZ(0)
D NBROUTF 49 52B 0 INZ(0)
D KEYENTLEN 53 56B 0 INZ(16)
D NLSSLEN 57 60B 0 INZ(290)
D IFELEN 61 64B 0 INZ(0)
D OFELEN 65 68B 0 INZ(0)
D OFF2NBM 69 72B 0 INZ(0)
D OFF2VLRA 73 76B 0 INZ(0)
D RSVP2 77 80B 0 INZ(0)
D KEYINF 16A DIM(MaxKey)
*
DSORTIOBLOC DS
D IOTYPE 1 4B 0 INZ(0)
D RSVP3 5 8B 0 INZ(0)
D IORECLEN 9 12B 0 INZ(0)
D IORECCNT 13 16B 0 INZ(0)
*
DKEYINFDS DS
D KEYSTART 1 4B 0
D KEYSIZE 5 8B 0
D KEYDTATYP 9 12B 0
D KEYASCDESC 13 16B 0
*
DERROR DS
D ERRORLEN 1 4B 0 INZ(272)
D ERRORAVL 5 8B 0
D ERRORID 9 15A
D ERRORDTA 17 272A
*
* constants
*
DMAXKEY c 4
*==============================================================
* Subroutine - SortSfl
* This subroutine sorts the subfile records.
*==============================================================
c $SortSFL begsr
*
* Initialize the key fields to sort on.
* Load S1PRO# field as key field, 07 byte, dec, ascending sequence.
*
c eval KeyStart = 1
c eval KeySize = 07
c eval KeyDtaTyp = 2
c eval KeyAscDesc = 1
c eval KeyInf(1) = KeyInfDs
*
* Load S1CNAM field as key field, 30 byte, char , descending sequence.
*
c eval KeyStart = 8
c eval KeySize = 30
c eval KeyDtaTyp = 6
c eval KeyAscDesc = 2
c eval KeyInf(2) = KeyInfDs
*
* Load other sort parameters.
*
c eval BlockLen = 80 + 16 * MaxKey
c eval NbrOfKeys = 2 Variable
c eval RecLen = %size(SFLRCD)
*
* Initialize Sort I/O API fields.
*
c eval IORecLen = RecLen
c eval IORecCnt = 1
*
* All done initializing.
* First step - Initialize the sort routine.
*
c call 'QLGSORT'
c parm SortBlock
c parm NotUsed
c parm NotUsed
c parm SizeList
c parm ReturnSize
c parm Error
*
* Next step - write records to I/O routine.
*
c eval IOType = 1
*
* read the entire subfile
*
c for count = 1 to Savrrn
*
c count chain SUB01
*
c if %found
*
c call 'QLGSRTIO'
c parm SortIOBloc
c parm SflRcd
c parm NotUsed
c parm SizeList
c parm NotUsed
c parm Error
*
c endif
*
c endfor
*
* Next step - Signal end of input, clear subfile for reload.
*
c eval IOType = 2
c
c call 'QLGSRTIO'
c parm SortIOBloc
c parm SflRcd
c parm NotUsed
c parm SizeList
c parm NotUsed
c parm Error
*
* Clear the subfile
*
c exsr $ClearSFL
*
* Final step - write the records back to the subfile.
*
c eval IOType = 3
*
*
* read the entire subfile
*
c for count = 1 to Savrrn
*
c call 'QLGSRTIO'
c parm SortIOBloc
c parm NotUsed
c parm SflRcd
c parm IORecLen
c parm NotUsed
c parm Error
*
c eval RRN1 = Count
c eval SCRRN = RRN1
c write Sub01
*
c endfor
c eval SubfileEnd = *on
c z-add SCRRN SavRrn
*
c if SavRrn = *Zeros And SubfileEnd
c eval DisplaySubfile = *Off
c else
c eval RRN1 = 1.
c eval SCRRN = 1.
c endif
*
c endsr
|
