構造体サブフィールドでのソート

V7R1からは、構造体配列のサブフィールドをキーにしてソートも出来る様になっています。
世の中当り前の事が、RPGの世界では未だに出来ないこともありますが、日々進歩していると言うことでしょう。ただし第２キーは指定出来ないので、第２キー以降のソート順については不明…。

USR403.rpgle

     H****************************************************************
     H*-‚------------------------------*
     H*-‚---<<日付・著作権    >>-----*
     H*-‚------------------------------*
     H DATEDIT(*YMD)
     H COPYRIGHT('(C) ushiday - ')
     H*-‚------------------------------*
     H*-‚---<<コンパイル条件  >>-----*
     H*-‚------------------------------*
     H DFTACTGRP(*NO) ACTGRP(*NEW)
     H OPTION(*NOUNREF)
     H BNDDIR('QC2LE')
     F*-š---<<ファイル定義   >>-----*
     FITEM      IF   E           K DISK
     D*-š---<<変数定義 >>-----*
     D*
     D REC           E DS                  EXTNAME(ITEM : *INPUT)
     D                                     QUALIFIED
     D                                     DIM(10)
     D*
     D COUNT           S              2S 0 INZ
     D IX              S              2S 0 INZ
     D*
     D print           PR                  EXTPROC('print')                     標準出力関数
     D    msg                      1000A   VARYING CONST
     C*-‚------------------------------*
     C*-‚---<<メインルーチン  >>-----*
     C*-‚------------------------------*
      /FREE

           print ( '---- PROGRAM START ----')    ;
           DOW COUNT <= 9   ;
               //読取り
               COUNT += 1 ;
               CLEAR REC(COUNT)      ;
               READ ITEM REC(COUNT)  ;
               IF %EOF ;
                 COUNT -= 1 ;
                 LEAVE ;
               ENDIF ;
           ENDDO ;

           IF  COUNT = *ZERO ;
               EXSR @END  ;
           ENDIF ;

           //コードと単価をそのまま出力
           FOR IX = 1 TO COUNT  ;
               print ( '(' + %EDITC(REC(IX).CODE :'X') + ')'
                           + %EDITC(REC(IX).PRICE :'3') +'円') ;

           ENDFOR ;

           print ( '==== PRICE SORT     ====')    ;
           //単価を昇順でソート
           SORTA REC(*).PRICE  ;

           //出力
           FOR IX = 1 TO COUNT  ;
               print ( '(' + %EDITC(REC(IX).CODE :'X') + ')'
                           + %EDITC(REC(IX).PRICE :'3') +'円') ;

           ENDFOR ;

           EXSR @END  ;

           //終了
           BEGSR   @END   ;
                print ( '---- PROGRAM END   ----')    ;

               *INLR = *ON    ;
               RETURN        ;
           ENDSR         ;

      /END-FREE
     P****************************************************************
     P** < print             >: 標準出力                          **
     P****************************************************************
     P print           B                   EXPORT
     P                 E 

●実行結果