RPG

37.部品表などのツリー構造のアクセス

親−子−孫 ... のツリー状の階層構造を持つデータベースを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