RPGLE - QLGSORT - Use APi to sort subfile data

    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
      *