35.漢字の0E，0Fを補正するサブルーチン
漢字の名称などを短いフィールドに 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
