Wording for Check Amount
Diana Six
amount into its corresponding wording. For example: Convert 42,643.05 to
"FORTY-TWO THOUSAND SIX HUNDRED FORTY-THREE and 05/100".
If there's anything out there specific to a release, we are on V5R1 of
OS/400.
Thanks in advance!
Diana Six
ds...@catlmbr.com
Jeff Crosby
> Looking for a utility or RPGLE source that will convert a numerical check
> amount into its corresponding wording. For example: Convert 42,643.05 to
> "FORTY-TWO THOUSAND SIX HUNDRED FORTY-THREE and 05/100".
>
> If there's anything out there specific to a release, we are on V5R1 of
> OS/400.
This is close to what you want, except it spells out "FIVE CENTS"
instead of "05/100". The "Copying Prototypes" stuff in there is so I
can have my procedure prototypes in the same member as the actual
procedures.
You use the following like this:
Eval AlfVNDNS = SpellCurr(VNDNS)
Where VNDNS is the numeric amount you want converted to words.
This is RPG service program SUBNtoA:
===== Start of member SubNtoA =====
/If Not Defined( CopyingPrototypes )
é*============================================================
é*
é* Service program : SubNToA
é* Description : Procedures for Converting numbers to alpha
é*
é* To compile:
é*
é* CRTRPGMOD MODULE(XXX/COMMAND) SRCFILE(XXX/QRPGLESRC)
é*
é* CRTSRVPGM SRVPGM(XXX/COMMAND) MODULE(XXX/COMMAND) +
é* EXPORT(*ALL) ACTGRP(*CALLER)
é*
é*============================================================
H NoMain
/COPY QRPGSRC,HDefault
é*============================================================
é* Procedure prototypes
é*============================================================
/Define CpySpellNum
/Define CpySpellCurr
/Endif
/If Defined( CpySpellNum )
é*============================================================
é*
é* INPUT: UnsNumber - The numeric field to be spelled
é*
é* OUTPUT: WorkString - The spelled number
é*
é*============================================================
D SpellNum PR 128A
D UnsNumber 10U 0 Value
/EndIf
/If Defined( CpySpellCurr )
é*============================================================
é*
é* INPUT: CurrAmt - The currency amount
é*
é* OUTPUT: WorkString - The spelled number
é*
é*============================================================
D SpellCurr PR 128A
D CurrAmt 9P 2 Value
/EndIf
/If Not Defined( CopyingPrototypes )
/Eject
é*============================================================
é*
é* Prototypes for internal (not exported) procedures
é*
é*============================================================
D DivUnsign PR
D Dividend 10U 0 Value
D Divisor 10U 0 Value
D Quotient 10U 0
D Remainder 10U 0
D ConvUnit PR 128A
D Units 10U 0 Value
D ListOfUnts S 9 Dim(19) CTData PerRcd(7)
D ListOfTens S 7 Dim( 9) CTData PerRcd(9)
D Group S 8 Dim( 4) CTData PerRcd(4)
/Eject
é*============================================================
é*
é* Procedure : DivUnsign
é* Description : Divide, returning quotient and remainder
é*
é*============================================================
P DivUnsign B
D PI
D Dividend 10U 0 Value
D Divisor 10U 0 Value
D Quotient 10U 0
D Remainder 10U 0
C If Divisor <> *Zero
C Dividend Div Divisor Quotient
C MVR Remainder
C Else
C Eval Quotient = *Zero
C Eval Remainder = *Zero
C Endif
P DivUnsign E
/Eject
é*============================================================
é*
é* Procedure : ConvUnit
é* Description : Convert a number between 1 and 999 to words
é*
é*============================================================
P ConvUnit B
D PI 128A
D Units 10U 0 Value
D Hundreds S 10U 0
D TensAndOne S 10U 0
D Tens S 10U 0
D Ones S 10U 0
D WorkString S 128A
C Eval WorkString = *Blanks
C Callp
DivUnsign(Units:100:Hundreds:TensAndOne)
C
C If TensAndOne > *Zero
C If TensAndOne <= 19
C Eval WorkString = ListOfUnts(TensAndOne)
C Else
C Callp DivUnsign(TensAndOne:10:Tens:Ones)
C Eval WorkString = ListOfTens(Tens)
C If Ones > *Zero
C Eval WorkString = %Trim(WorkString) + '-'
+
C ListOfUnts(Ones)
C Endif
C Endif
C Endif
C
C If Hundreds > *Zero
C Eval WorkString =
%Trim(ListOfUnts(Hundreds))
C + ' HUNDRED ' + %Trim(WorkString)
C Endif
C
C Return WorkString
P ConvUnit E
/Eject
é*============================================================
é*
é* Procedure : SpellNum
é* Description : Spell out a numeric value in words.
é*
é*============================================================
P SpellNum B Export
D PI 128A
D UnsNumber 10U 0 Value
D iX S 10U 0
D Units S 10U 0
D WorkNumber S 10U 0
D WorkString S 128A
D UnitsStg S 128A
C If UnsNumber > *Zero
C Eval WorkString = *Blanks
C Eval WorkNumber = UnsNumber
C Eval iX = 1
C Dow WorkNumber > *Zero
C Callp
DivUnsign(WorkNumber:1000:WorkNumber:Units)
C If Units > *Zero
C Eval UnitsStg = %Trim(ConvUnit(Units))
C + ' ' + Group(iX)
C If WorkString = *Blanks
C Eval WorkString = UnitsStg
C Else
C Eval WorkString = %Trim(UnitsStg) +
C ', ' + WorkString
C Endif
C Endif
C Eval iX = iX + 1
C Enddo
C Else
C Eval WorkString = 'ZERO'
C Endif
C
C Return WorkString
P SpellNum E
/Eject
é*============================================================
é*
é* Procedure : SpellCurr
é* Description : Spell out a currency amount in words
é*
é*============================================================
P SpellCurr B Export
D PI 128A
D CurrAmt 9P 2 Value
D Dollars S 7P 0
D Cents S 2P 0
C If CurrAmt < *zero
C Mllzo '0' CurrAmt
C Endif
C Movel CurrAmt Dollars
C Move CurrAmt Cents
C Return %Trim(SpellNum(Dollars)) +
C ' DOLLARS AND ' +
C %Trim(SpellNum(Cents)) +
C ' CENTS'
P SpellCurr E
/EndIf
é* The following causes the compile time data to be ignored
/If Defined( CopyingPrototypes )
/EOF
/EndIf
**CTData ListOfUnts
ONE TWO THREE FOUR FIVE SIX SEVEN
EIGHT NINE TEN ELEVEN TWELVE THIRTEEN FOURTEEN
FIFTEEN SIXTEEN SEVENTEENEIGHTEEN NINETEEN
**CTData ListOfTens
TEN TWENTY THIRTY FORTY FIFTY SIXTY SEVENTYEIGHTY NINETY
**CTData Group
THOUSANDMILLION BILLION
===== End of member SUBNtoA =====
In case your wondering how the calling RPG program uses the "Copying
Prototypes", the following goes into calling RPG programs:
*
* Procedure prototypes
*
* Define the SUBNToA procedures
/Define CpySpellNum
/Define CpySpellCurr
* Copy all defined procedure prototypes & then undefine them
/Copy Dilgard/QRPGSrc,Prototypes
/UnDefine CpySpellNum
/UnDefine CpySpellCurr
And member PROTOTYPES has the following in it:
/Define CopyingPrototypes
...<snip>...
*
* SUBNTOA : Numbers to alpha words procedures
*
/If Defined( CpySpellNum )
/Copy *LIBL/QRPGSRC,SubNToA
/ElseIf Defined( CpySpellCurr )
/Copy *LIBL/QRPGSRC,SubNToA
/EndIf
...<snip>...
/UnDefine CopyingPrototypes
By doing the above, 1) Procedures and there prototypes are in the same
member, and 2) a single RPG member (PROTOTYPES) contains the name of
every single service program and procedure that I have written.
HTH.
--
-Jeff
The opinions expressed are my own and not necessarily
the opinion of my company. Unless I say so.
John Johnson
called procedures that do various things such as string manipulation, date
formatting, etc. One of them does exactly what you want. My client bought
it for $745.00 and some have been useful.
Hope this helps.
"Diana Six" <ds...@catlmbr.com> wrote in message
news:dsMf8.9040$BW6.3...@nnrp1.ptd.net...