RPGLE - QLGSORT - Use APi to sort subfile data
*==============================================================
* Subroutine - SortSfl
*
* For information on Sort API's see
* OS/400 National Language Support API Guide
* 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
*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
* $PosSubfile - Position the subfile
*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-==-
cSR $PosSubfile begsr
*
c for count = 1 to Savrrn
*
c count chain SUB01
c if %found and
c S1PRO# = C1PRO# or
c %found and
c S1PRO# > C1PRO# or
c count = Savrrn
*
c eval RRN1 = Count
c eval SCRRN = Count
*
* check to see last pink record and un-pink it
*
c if LastPinkRRN > *Zeros
c LastPinkRRN chain SUB01
c if %found
c eval Pink = *Off
c update SUB01
c clear LastPinkRRN
c endif
c endif
*
c Count chain SUB01
c if %found
c clear C1PRO#
c eval Pink = *On
c update SUB01
c eval Pink = *Off
c z-add Count LastPinkRrn
c leave
c endif
*
c endif
*
c endfor
*
c endsr
*
