RPGLE - convert amount Numeric to WORD
E AR$ 11 1 ALPHA AMOUNT
E W 20 9 ARRAY OF WORDS
E X 7 19 9 WORDS 1 TO 19
E Y 7 8 9 WORDS 20 TO 90
E MISC 7 10 9 MISC. WORDS
E WORK 9 1 WORK ARRAY
E AMT 150 1 RESULT ARRAY
*
* PARAMETERS: LIMIT = WORD LENGTH LIMIT (MAXIMUM 150),
* CHK$ = CHECK AMOUNT TO CONVERT (MAXIMUM 999,999,999.99),
* VALUE = SPELLED AMOUNT RETURNED TO CALLING PROGRAM, ERROR =
* ERROR FLAG WHEN SPELLED AMOUNT EXCEEDS LIMIT.
*
C *ENTRY PLIST
C PARM LIMIT 30 MAX: 150
C PARM CHK$ 112 999,999,999.99
C PARM VALUE 150 RETURN VALUE
C PARM ERROR 1 ERROR FLAG
*
* CONVERT CHECK AMOUNT TO POSITIVE, IF NECESSARY
*
C CHK$ IFLT 0
C Z-SUBCHK$ CHK$2 112
C ELSE
C Z-ADDCHK$ CHK$2
C END
*
* TRANSLATE CHECK AMOUNT INTO WORDS
*
C MOVEA'00' *IN,06
C MOVE *BLANKS WORDS 4
C MOVE *BLANKS ERROR
*
C WORDS DOUEQ'QUIT'
C MOVE *BLANKS AMT
C MOVE *BLANKS W
C MOVE CHK$2 CHK$A 11
C MOVEACHK$A AR$
C Z-ADD1 I 30
*
C CHK$2 IFGE 1000000 OVER $1,000,000
C MOVEAAR$,1 A03 3
C EXSR SUBN30
C MOVE MISC,2 W,I
C ADD 1 I
C END CHK$2>=1000000
*
C MOVEAAR$,4 A03 OVER $1,000
C MOVE A03 N30
C N30 IFNE 0
C EXSR SUBN30
C MOVE MISC,3 W,I
C ADD 1 I
C END N30 IFNE 0
*
C MOVEAAR$,7 A03 LESS THAN $1000
C MOVE A03 N30
C N30 CASNE*ZEROS SUBN30
C END
*
C CHK$2 IFLT 1 UNDER A BUCK
C MOVE MISC,4 W,I
C ADD 1 I
C END CHK2$ IFLT 1
*
C MOVE MISC,5 W,I ADD "DOLLARS
C ADD 1 I AND"
C *IN07 IFEQ '0'
C MOVE MISC,6 W,I
C ELSE
C MOVE MISC,10 W,I
C END *IN07 IFEQ '0'
C ADD 1 I
*
C MOVEAAR$,10 A02 2 PROCESS CENTS
C MOVE A02 N20
C N20 IFEQ *ZEROS
C MOVE MISC,4 W,I
C ADD 1 I
C ELSE
C *IN06 IFEQ '0'
C EXSR SUBN20
C ELSE
C MOVELA02 W,I
C ADD 1 I
C END *IN06 IFEQ '0'
C END N20 IFEQ *ZERO
C N20 IFNE 01
C MOVE MISC,7 W,I
C ELSE
C MOVE MISC,8 W,I
C END N20 IFNE 01
C ADD 1 I
*
C CHK$ IFLT 0 NEGATIVE AMOUNT
C MOVE MISC,9 W,I
C END CHK$ IFLT 0
*
C Z-ADD1 I COMPRESS ARRAY
C Z-ADD1 J 30 W
*
C I DOWLE19
C MOVEAW,I WORK
C Z-ADD1 K 20
C ' ' LOKUPWORK,K 05
C *IN05 IFEQ '0'
C Z-ADD10 K
C END
C MOVEAWORK AMT,J
C ADD K J
C ADD 1 I
C W,I IFEQ *BLANKS
C Z-ADD20 I
C END
*
C END I DOWLE 19
*
* IS THE RESULTANT CHARACTER STRING TOO LONG? IF YES,
* TRY TO SHORTEN IT.
*
C J IFGT LIMIT
*
* IF *IN07 IS ON, STRING IS TOO LONG. EXIT WITH ERROR.
*
C *IN07 IFEQ '1'
C MOVE 'QUIT' WORDS
C MOVE 'Y' ERROR
C END
*
* IF *IN06 IS ON, RETRY SHORTENING STRING.
*
C *IN06 IFEQ '1'
C MOVE '1' *IN07
C END
C MOVE '1' *IN06
C ELSE
C MOVE 'QUIT' WORDS
C END J IFGT LIMIT
*
C END WORDS LOOP
*
* SETON LAST RECORD LE
*
C MOVE *BLANKS VALUE
C ERROR IFNE 'Y'
C MOVEAAMT VALUE
C END
*
C MOVE '1' *INLR
*
* SUBROUTINE TO TRANSLATE THE TWO RIGHT DIGITS OF EACH DIGIT
* TRIAD TO ITS SPELLED-OUT EQUIVALENT.
*
*
CSR SUBN20 BEGSR
C N20 IFGE 20
C MOVELN20 N10
C SUB 1 N10
C MOVE Y,N10 W,I
C ADD 1 I
C MOVE N20 N10
C N10 IFNE 0
C MOVE X,N10 W,I
C ADD 1 I
C END N10 IFNE 0
C ELSE
C N20 IFNE 0
C MOVE X,N20 W,I
C ADD 1 I
C END N20 IFNE 0
C END N20 IFGE 20
CSR ENDSR
*
* SUBROUTINE TO TRANSLATE THE LEFTMOST DIGIT OF A TRIAD TO
* ITS WORD QUIVALENT AND STORE THE TWO RIGHTMOST DIGITS OF
* THE TRIAD IN VARIABLE N20 FOR SUBSEQUENT PROCESSING.
*
CSR SUBN30 BEGSR
C MOVE A03 N30 30
C MOVELA03 N10 10
C MOVE A03 N20 20
C N10 IFNE 0
C MOVE X,N10 W,I
C ADD 1 I
C MOVE MISC,1 W,I
C ADD 1 I
C END N10 IFNE 0
C EXSR SUBN20
CSR ENDSR
*
* WORD ARRAYS
*
**
ONE TWO THREE FOUR FIVE SIX SEVEN
EIGHT NINE TEN ELEVEN TWELVE THIRTEEN FOURTEEN
FIFTEEN SIXTEEN SEVENTEENEIGHTEEN NINETEEN
**
TWENTY THIRTY FORTY FIFTY SIXTY SEVENTY EIGHTY
NINETY
**
HUNDRED MILLION, THOUSAND,NO DOLLARS AND CENTS
CENT CR &
No comments:
Post a Comment