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