- 论坛徽章:
- 0
|
耳朵这个词,乃是CPT一脉相承的说法哦!我也发一个当时看了这个帖子后参考其中的一个代码改的程序,因为当时运行发现不能完全正确,就改了改,供各位参考:
H DATEDIT(*YMD) OPTION(*SRCSTMT:*NODEBUGIO)
*=====================================================================
D wDigDim S 1A DIM(1
*---------------------------------------------------------------------
*中文数字
*---------------------------------------------------------------------
D wChnChaNbr S 40A INZ(X'-
D 0E51840F0E59BB0F0E4C410F0E54FD0F-
D 0E56610F0E57E80F0E51BC0F0E53E10F-
D 0E48C50F0E4FC00F')
*
D wChnDim S 4A DIM(10)
*---------------------------------------------------------------------
*中文单位
*---------------------------------------------------------------------
D wChnChaUnt S 72A INZ(X'-
D 0E4C760F0E4F670F0E5AB10F0E55AF0F-
D 0E48DA0F0E544A0F0E57930F0E55AF0F-
D 0E48DA0F0E544A0F0E59D90F0E55AF0F-
D 0E48DA0F0E544A0F0E57930F0E55AF0F-
D 0E48DA0F0E544A0F')
*
D wUntDim S 4A DIM(1
*=====================================================================
D wSfxTst S 8A
D yMsgRtnCod S 10A
*=====================================================================
D wInpDigAmt S 18S 0
D wOutChrAmt S 200A
*
D wInpLen S 2S 0
D wRpcLen S 2S 0
D wRpcPos S 3S 0
*
D X S 2S 0
D Y S 1S 0
D Z S 1S 0
*---------------------------------------------------------------------
*中文字符
*---------------------------------------------------------------------
D wLinLin S 8A INZ('零零')
D wLinYuan S 8A INZ('零圆')
D wLinWan S 8A INZ('零万')
D wLinYi S 8A INZ('零亿')
D wJiaoLin S 8A INZ('角零')
D wJZ S 8A INZ('角整')
D wYuanLin S 8A INZ('圆零')
D wYZ S 8A INZ('圆整')
D wYiWan S 8A INZ('亿万')
*
D wLin S 4A INZ('零')
D wYuan S 4A INZ('圆')
D wWan S 4A INZ('万')
D wYi S 4A INZ('亿')
C*
C *ENTRY PLIST
C PARM xInpDigAmt 18
C PARM zOutChrAmt 50
C* MOVE '1001010000' xInpDigAmt 18
C* MOVE ' ' zOutChrAmt 50
*=====================================================================
C EXSR #InParm
*
C EXSR #Main
*
C EXSR #OutParm
*
C EVAL *INLR = *ON
C RETURN
*=====================================================================
CSR #Main BEGSR
C*检查输入
C ' 0123456789' CHECK xInpDigAmt 90
C IF *IN90 = *ON
C EVAL yMsgRtnCod = 'FI30671'
C EXSR #ErrRtn
C ENDIF
C*
C MOVE xInpDigAmt wInpDigAmt
C*
C SELECT
C WHEN wInpDigAmt = *ZERO
C EVAL zOutChrAmt = '零圆整'
C ENDSL
C*
C EXSR #IniChnInf
CSR ENDSR
C*===================================================================
CSR #IniChnInf BEGSR
C*初始化中文信息
C EVAL wInpLen = %LEN(%TRIM(
C %CHAR(wInpDigAmt)))
C MOVEA wChnChaNbr wChnDim
C MOVEA wChnChaUnt wUntDim
C*
C MOVEA xInpDigAmt wDigDim
C 1 DO wInpLen X
C EVAL Z=%DEC(wDigDim(18 - X + 1):1:0)
C SELECT
C*该位为零,为一般位
C WHEN Z= 0 AND
C X<>3 AND
C X<>7 AND
C X<>11 AND
C X<>15
C EVAL wOutChrAmt = wChnDim(Z + 1)
C + %TRIM(wOutChrAmt)
C*该位为零,为敏感位,要添零
C WHEN Z=0 AND
C (X=3 OR
C X=7 OR
C X=11 OR
C X=15)
C EVAL wOutChrAmt=wUntDim(X)
C + wChnDim(Z + 1)
C + %TRIM(wOutChrAmt)
C*该位不为零
C WHEN Z<>0
C EVAL wOutChrAmt = wChnDim(Z + 1)
C + wUntDim(X)
C + %TRIM(wOutChrAmt)
C ENDSL
C ENDDO
C*
C EXSR #ChgSpcInf
CSR ENDSR
C*===============================================================
CSR #ChgSpcInf BEGSR
C*转换特殊情况
C*零零->零
C EVAL wRpcPos = %SCAN(wLinLin:wOutChrAmt)
C EVAL wRpcLen = %SIZE(wLinLin)
C*
C DOW wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE(wLin:wOutChrAmt:
C wRpcPos:wRpcLen)
C EVAL wRpcPos = %SCAN(wLinLin:wOutChrAmt)
C ENDDO
C*零圆->圆
C EVAL wRpcPos = %SCAN(wLinYuan:wOutChrAmt)
C IF wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE(wYuan:wOutChrAmt:
C wRpcPos:wRpcLen)
C ENDIF
C*零万->零
C EVAL wRpcPos = %SCAN(wLinWan:wOutChrAmt)
C DOW wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE(wWan:wOutChrAmt:
C wRpcPos:wRpcLen)
C EVAL wRpcPos = %SCAN(wLinWan:wOutChrAmt)
C ENDDO
C*零亿->亿
C EVAL wRpcPos = %SCAN(wLinYi:wOutChrAmt)
C IF wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE(wYi:wOutChrAmt:
C wRpcPos:wRpcLen)
C ENDIF
C*角零->角整
C EVAL wRpcPos = %SCAN(wJiaoLin:wOutChrAmt)
C IF wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE(wJZ:wOutChrAmt:
C wRpcPos:wRpcLen)
C ENDIF
C*圆零->圆整
C EVALR wSfxTst = %TRIM(wOutChrAmt)
C IF wSfxTst = wYuanLin
C EVALR wOutChrAmt = %TRIM(wOutChrAmt)
C MOVE wYZ wOutChrAmt
C EVAL wOutChrAmt = %TRIM(wOutChrAmt)
C ENDIF
C*亿万->亿
C EVAL wRpcPos = %SCAN(wYiWan:wOutChrAmt)
C IF wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE(wYi:wOutChrAmt:
C wRpcPos:wRpcLen)
C ENDIF
C*去除0F0E
C EVAL wRpcPos = %SCAN(X'0F0E':wOutChrAmt)
C DOW wRpcPos > *ZERO
C EVAL wOutChrAmt = %REPLACE('' :wOutChrAmt:
C wRpcPos:2)
C EVAL wRpcPos = %SCAN(X'0F0E':wOutChrAmt)
C ENDDO
CSR ENDSR
C*=============================================================
CSR #ErrRtn BEGSR
C EVAL *INLR = *ON
C RETURN
CSR ENDSR
C*=============================================================
CSR #OutParm BEGSR
C EVAL zOutChrAmt = wOutChrAmt
CSR ENDSR
C*=============================================================
CSR #InParm BEGSR
C EVAL yMsgRtnCod = 'SUC9999'
CSR ENDSR |
|