親−子−孫 ... のツリー状の階層構造を持つデータベースをRPGでアクセスする方法を紹介しよう。
Windowsでは 「構造化記憶」と呼ばれているものに等しい。
ソースを紹介する前に、
親 | 子 子 子 子 子 | | | | | 孫 孫 孫 孫 孫 孫 孫
階層の深さは RPGソースの配列の項目数を拡大するだけで良い。
親から 子へ 下がるときに 親の横の次の兄弟を配列に保管しておいてから階層を下る方法である。
このテクニックはIBMが古くから紹介した部品構成の読取り手法を元にしている。
001.00 E* ARA:LEVEL 別部品構成 KEY の配列 002.00 E ARA 20 10 003.00 E* ARA の長さ = 部品構成 KEY の合計 BYTE 数 004.00 E* ARA の項目数 = 最大 LEVEL の深さ 005.00 I*( 部品展開 KEY の DS 記述 ) 006.00 I DS 007.00 I 1 20 T\KEY 008.00 I 1 10 OY\KEY 009.00 I 11 20 KO\KEY 010.00 C****************************************************** 011.00 C READ BEGSR 012.00 C****************************************************** 013.00 C*( 部品構成 FILE の READ ) 014.00 CSR MOVE STRCOD OY\KEY 015.00 CSR MOVE *LOVAL KO\KEY 016.00 CSR MOVE *BLANKS ARA 017.00 CSR Z-ADD1 LV 20 018.00 CSR NXTCMP TAG 019.00 C*----------------------------------------------------+ 020.00 C TENKEY KLIST | 021.00 C KFLD OYCODE | 022.00 C KFLD KOCODE | 023.00 C*----------------------------------------------------+ 024.00 CSR MOVE OY\KEY OYCODE 025.00 CSR MOVE KO\KEY KOCODE 026.00 C*( 子部品があるか ?) 027.00 CSR SETOF 50 028.00 CSR TENKEY READETENKAI 50 029.00 C* 子部品なし 030.00 CSR *IN50 IFEQ '1' OY\KEY 031.00 C* LOW LEVEL= 1 であれば終了 032.00 CSR NXTLV TAG 033.00 CSR LV CABEQ1 REDEND 034.00 C* 親の兄弟を検索 035.00 CSR SUB 1 LV 036.00 C* 横部品あるか ? 037.00 CSR ARA,LV CABEQ*BLANKS NXTLV 038.00 CSR MOVE ARA,LV T\KEY 039.00 C* 子部品あり 040.00 CSR ELSE OY\KEY 041.00 CSR ADD 1 LV 042.00 CSR END OY\KEY 043.00 C* 部品構成 MASTER を検索 044.00 C*----------------------------------------------------+ 045.00 C TENKEY KLIST | 046.00 C KFLD OYCODE | 047.00 C KFLD KOCODE | 048.00 C*----------------------------------------------------+ 049.00 CSR SETOF 99 050.00 CSR TENKEY CHAINTENKAI 99 051.00 CSR *IN99 IFEQ '0' 052.00 C*( PROCES: 部品構成の処理 ) 053.00 C*----------------------------------------------------+ 054.00 C EXSR PROCES | 055.00 C*----------------------------------------------------+ 056.00 CSR END 057.00 CSR TENKEY SETGTTENKAI 058.00 CSR SETOF 50 059.00 CSR OYKEY READETENKAI 50 060.00 CSR *IN50 IFEQ '1' 061.00 CSR MOVE *BLANKS ARA,LV 062.00 CSR ELSE 063.00 CSR MOVE OYCODE OY\KEY 064.00 CSR MOVE KOKEY KO\KEY 065.00 CSR MOVE T\KEY ARA,LV 066.00 CSR END 067.00 CSR MOVE KO\KEY OY\KEY 068.00 CSR MOVE *BLANKS KO\KEY 069.00 CSR GOTO NXTCMP 070.00 CSR ENDSR