RPG

36.数字を漢字で表示するサブルーチン

印刷する数字を倍角の漢字として印刷したい。指示書や伝票をみやすくするためだ。
ついでのことなら 浮動 \記号も追加したい。

0001.00      E                    KJN    10  10  1                漢数字
0002.00      E                    KJS    10  10  4                漢数字
0003.00      E                    KJA        10  3               WORK
0004.00      E                    KJB        10  2               WORK
0005.00      E                    KJC        18  1               WORK
0006.00      E                    KGR         9  2               WORK
0007.00      E                    DGR         9  1
0008.00      C******************************************************
0009.00      C           KJSU      BEGSR
0010.00      C******************************************************
0011.00      C*  数字 DG09 9,0 ----> 漢字 KJSUJI 20,0 に変換
0012.00      CSR                   MOVE '  '      OEOF    2
0013.00      CSR                   MOVELOEOF      OE      1
0014.00      CSR                   MOVE OEOF      OF      1
0015.00      CSR                   MOVE ' ¥ '    FLD3    3
0016.00      CSR                   MOVELFLD3      \MARK   2
0017.00      CSR                   MOVELKJS       KJA
0018.00      CSR                   MOVE KJA       KJB
0019.00      C*
0020.00      CSR                   MOVE DG09      FLD9    9
0021.00      CSR                   MOVEAFLD9      DGR
0022.00      CSR         1         DO   9         J       20
0023.00      CSR         DGR,J     COMP ' '                      50
0024.00      CSRN50      DGR,J     COMP '0'                      50
0025.00      CSRN50                GOTO OUTKJ
0026.00      CSR                   MOVE *BLANKS   DGR,J
0027.00      CSR                   END
0028.00      CSR         OUTKJ     TAG
0029.00      C*
0030.00      CSR         1         DO   9         J
0031.00      CSR         DGR,J     IFNE *BLANKS 
0032.00      CSR         J         SUB  1         K
0033.00      CSR         K         IFNE 0
0034.00      CSR                   MOVE '\'       DGR,K
0035.00      CSR                   END
0036.00      CSR                   GOTO OUT\
0037.00      CSR                   END
0038.00      CSR                   END
0039.00      CSR         OUT\      TAG
0040.00      C*
0041.00      CSR         1         DO   9         J
0042.00      CSR         DGR,J     IFEQ *BLANKS
0043.00      CSR                   MOVE *BLANKS   KGR,J
0044.00      CSR                   GOTO BYPASJ
0045.00      CSR                   END
0046.00      C*
0047.00      CSR         DGR,J     IFEQ '\'
0048.00      CSR                   MOVE \MARK     KGR,J
0049.00      CSR                   GOTO BYPASJ
0050.00      CSR                   END
0051.00      C* 
0052.00      CSR                   MOVE DGR,J     FLD1    1
0053.00      CSR                   Z-ADD1         K       20
0054.00      CSR         FLD1      LOKUPKJN,K                    50
0055.00      CSR 50                MOVE KJB,K     KGR,J
0056.00      C*
0057.00      CSR         BYPASJ    TAG
0058.00      CSR                   END
0059.00      CSR                   MOVEAKGR       FLD18  18 
0060.00      CSR                   MOVEAFLD18     KJC
0061.00      C* 
0062.00      CSR         1         DO   18        J
0063.00      CSR         KJC,J     IFNE *BLANKS 
0064.00      CSR         J         SUB  1         K 
0065.00      CSR         K         IFNE 0
0066.00      CSR                   MOVE OE        KJC,K 
0067.00      CSR                   END 
0068.00      CSR                   GOTO OUTOE 
0069.00      CSR                   END
0070.00      CSR                   END
0071.00      CSR         OUTOE     TAG
0072.00      C*
0073.00      CSR                   MOVEAKJC       FLD18
0074.00      CSR                   MOVE FLD18     FLD19  19
0075.00      CSR                   MOVELFLD19     KJSUJI 20
0076.00      CSR         KJSUJI    COMP *BLANKS                  50
0077.00      CSRN50                MOVE OF        KJSUJI
0078.00      CSR                   ENDSR
0079.00 **
0080.00 0123456789
0081.00 ** 
0082.00  0  1  2  3  4  5  6  7  8  9