漢字の名称などを短いフィールドに MOVEL しただけでは0F の欠落によって印刷不能や表示にエラーとなる。
このサブルーチンは それらを補正する。
0001.00 E KJR 256 1 漢字補正
0002.00 +C MOVEAFIELD KJR 補正 FLD
0003.00 C Z-ADD32 KJLEN 30 FLD 長
0004.00 C EXSR KANJI 漢字補正
0005.00 C MOVEAKJR FIELD
0006.00 C******************************************************
0007.00 C KANJI BEGSR
0008.00 C******************************************************
0009.00 C*( 漢字補正 SUB-ROUTINE )
0010.00 CSR Z-ADDKJLEN KL 30
0011.00 CSR KL SUB 1 KM 30
0012.00 CSR KL ADD 1 KU 30
0013.00 CSR MOVEA*BLANKS KJR,KU
0014.00 C* 漢字 FIELD の O/E O/F の欠落を補正する。
0015.00 CSR MOVE ' ' OEOF 2
0016.00 CSR MOVELOEOF OE 1
0017.00 CSR MOVE OEOF OF 1
0018.00 CSR Z-ADD1 KJ 20
0019.00 CSR NXTKJ TAG
0020.00 CSR OE LOKUPKJR,KJ 50
0021.00 CSRN50 GOTO KJ0END
0022.00 CSR Z-ADDKJ KJE 20
0023.00 CSR KJE IFEQ KL
0024.00 CSR MOVE *BLANKS KJR,KL
0025.00 CSR GOTO KJ0END
0026.00 CSR END
0027.00 C*
0028.00 CSR KJE IFLT KJLEN KJE < 30
0029.00 CSR ADD 1 KJ
0030.00 CSR OF LOKUPKJR,KJ 50
0031.00 CSR 50 KJ CABEQKJLEN KJ0END
0032.00 CSR 50 ADD 1 KJ
0033.00 CSR 50 GOTO NXTKJ
0034.00 CSR END KJE < 30
0035.00 C*( OE に対応する OF がなかった )
0036.00 CSR ADD KL KJE
0037.00 CSR KJE DIV 2 KJA 20
0038.00 CSR MVR KJB 20
0039.00 C* KJB=0:OE は偶数桁にある
0040.00 C* KJB=1:OE は奇数桁にある
0041.00 CSR KJB IFEQ *ZEROS KJB=0
0042.00 CSR MOVE OF KJR,KM
0043.00 CSR MOVE ' ' KJR,KL
0044.00 CSR ELSE KJB=0
0045.00 CSR MOVE OF KJR,KL
0046.00 CSR END KJB=0
0047.00 CSR KJ0END ENDSR