Return to the RPG Tips
Character to Numeric Procedure
The following is Barbara Morris' procedure.
<-----* prototype for /COPY file start here ----->
*---------------------------------------------------------
* getNum - procedure to read a number from a string
* and return a 30p 9 value
* Parameters:
* I: string - character value of number
* I:(opt) decComma - decimal point and digit separator
* I:(opt) currency - currency symbol for monetary amounts
* Returns: packed(30,9)
*
* Parameter details:
* string: the string may have
* - blanks anywhere
* - sign anywhere
* accepted signs are: + - cr CR ()
* (see examples below)
* - digit separators anywhere
* - currency symbol anywhere
* decComma: if not passed, this defaults to
* decimal point = '.'
* digit separator = ','
* currency: if not passed, defaults to ' '
*
* Examples of input and output (x means parm not passed):
*
* string | dec | sep | cursym | result
* ---------------+-----+-----+--------+------------
* 123 | x | x | x | 123
* +123 | x | x | x | 123
* 123+ | x | x | x | 123
* -123 | x | x | x | -123
* 123- | x | x | x | -123
* (123) | x | x | x | -123
* 12,3 | , | . | x | 12.3
* 12.3 | x | x | x | 12.3
* 1,234,567.3 | x | x | x | 1234567.3
* $1,234,567.3 | . | , | $ | 1234567.3
* $1.234.567,3 | , | . | $ | 1234567.3
* 123.45CR | x | x | x | -123.45
*
* Author: Barbara Morris, IBM Toronto Lab
* Date: March, 2000
*---------------------------------------------------------
D getNum pr 30p 9
D string 100a const varying
D decComma 2a const options(*nopass)
D currency
1a const options(*nopass)
<-----* prototype for /COPY file end here ----->
<-----* test program start here----->
* Copy prototype for procedure getNum
D/COPY GETNUM_P
D res s like(getNum)
D msg s 52a
C *entry plist
C parm p 32
C parm dc 2
C parm c 1
C select
C when %parms = 1
C eval res = getNum(p)
C when %parms = 2
C eval res = getNum(p : dc)
C when %parms = 3
C eval res = getNum(p : dc : c)
C endsl
C eval msg = '<' + %char(res) + '>'
C msg dsply
C return
<-----* test program end here----->
<-----* module GETNUM start here ----->
H NOMAIN
* Copy prototype for procedure getNum
D/COPY GETNUM_P
p getNum b
D getNum pi 30p 9
D string 100a const varying
D decComma 2a const options(*nopass)
D currency 1a const options(*nopass)
* defaults for optional parameters
D decPoint s 1a inz('.')
D comma s 1a inz(',')
D cursym s 1a inz(' ')
* structure for building result
D ds
D result 30s 9 inz(0)
D resChars 30a overlay(result)
* variables for gathering digit information
* pNumPart points to the area currently being gathered
* (the integer part or the decimal part)
D pNumPart s *
D numPart s 30a varying based(pNumPart)
D intPart s 30a varying inz('')
D decPart s 30a varying inz('')
* other variables
D intStart s 10i 0
D decStart s 10i 0
D sign s 1a inz('+')
D i s 10i 0
D len s 10i 0
D c s 1a
* override defaults if optional parameters were passed
C if %parms > 1
C eval decPoint = %subst(decComma : 1 : 1)
C eval comma = %subst(decComma : 2 :1)
C endif
C if %parms > 2
C eval cursym = currency
C endif
* initialization
C eval len = %len(string)
* begin reading the integer part
C eval pNumPart = %addr(intPart)
* loop through characters
C do len i
C eval c = %subst(string : i : 1)
C select
* ignore blanks, digit separator, currency symbol
C when c = comma or c = *blank or c = cursym
C iter
* decimal point: switch to reading the decimal part
C when c = decPoint
C eval pNumPart = %addr(decPart)
C iter
* sign: remember the most recent sign
C when c = '+' or c = '-'
C eval sign = c
C iter
* more signs: cr, CR, () are all negative signs
C when c = 'C' or c = 'R' or
C c = 'c' or c = 'r' or
C c = '(' or c = ')'
C eval sign = '-'
C iter
* a digit: add it to the current build area
C other
C eval numPart = numPart + c
C endsl
C enddo
* copy the digit strings into the correct positions in the
* zoned variable, using the character overlay
C eval decStart = %len(result) - %decPos(result)
C + 1
C eval intStart = decStart - %len(intPart)
C eval %subst(resChars
C : intStart
C : %len(intPart))
C = intPart
C eval %subst(resChars
C : decStart
C : %len(decPart))
C = decPart
* if the sign is negative, return a negative value
C if sign = '-'
C return - result
* otherwise, return the positive value
C else
C return result
C endif
p e
[report a broken link by clicking here]