Procedure NumfromChar determines whether a character string is a formatted number and then tells you its value.
The RPG IV built-in functions (BIFs) %editc and %editw have been a great help in presenting numeric data on display devices and in reports. Although youve always been able to use edit codes and words with individual fields, they arent very helpful when you want to edit and embed a number like $1,000,000.00 into a sentence. Or maybe you just want to display a field that could be both numeric and alpha. The two new BIFs make this a breeze.
But what if you have an input-capable display field that accepts both alpha and numeric input? How do you distinguish between a number formatted with commas, a number formatted with a decimal point and sign, and an alphabetic string? And how do you extract the numeric value of this string? The procedure NumfromChar was written to address problems like these.
NumfromChar accepts an alpha argument of up to 32 characters and returns its numeric value. If the string passed isnt numeric, 0 is returned.
Additionally, an optional second parameter may be passed that is loaded with *ON or *OFF.
This enables you to distinguish between a return value of 0 (indicating nonnumeric) and the return value of 0 you would expect if you passed 0 or blanks (blanks are treated like valid numerics with value zero).
The features of NumfromChar include the following:
Leading and trailing blanks are ignored. Embedded blanks cause an error.
Commas are ignored. 10,00, 1,000, and 1000 are all read as the same value.
Leading or trailing + or - signs are recognized.
A trailing CR is recognized as a negative sign.
Parentheses around the character string are read as a negative sign.
The period is recognized as a decimal point. I keep NumfromChar in a service program called STRING, which is dedicated to common character string functions such as upper- and lowercase conversion, text centering, etc. The source for the module STRING resides in source file QRPGLESRC(STRING), shown in Figure 1. The prototypes reside in QRPGLESRC(STRINGCPY), shown in Figure 2. To compile the module, ensure QRPGLESRC is in your library list (and is the first file in the library list with that name), and then issue the commands shown in the compile boxes.
Figure 3 is an example program that shows NumfromChar at work. Run it under the interactive debugger and view the contents of Numeric after each invocation of NumfromChar.
*===============================================================
* String Handling Methods
*===============================================================
* To compile:
*
* CRTRPGMOD MODULE(XXX/STRING) SRCFILE(XXX/QRPGLESRC)
*
* CRTSRVPGM SRVPGM(XXX/STRING) MODULE(STRING) +
* EXPORT(*ALL) ACTGRP(STRING)
*
*===============================================================
H NOMAIN
*
/COPY xxxQRPGLESRC,STRINGCPY
*
P NumfromChar B export
*
* Returns Numeric equivalent of String.
* Returns 0 if unable to translate.
* Optionally loads OptValid with *OFF/*ON depending on success.
*
D NumfromChar PI 25P 9
D String 32A value
D OptValid 1A options(*NOPASS)
*
* Locals:
D IsNumber S 1A inz(*OFF)
D Value S 25P 9 inz(0)
D StringLength S 10I 0 inz(0)
D WorkString S 33A inz(*BLANKS)
D ThisChar S 1A based(ThisChar@)
D ThisChar@ S *
D LastChar S 1A based(LastChar@)
D LastChar@ S *
D Digit S 1P 0
D Negative S 1A inz(*OFF)
D IntoDecimals S 1A inz(*OFF)
D DecPlace S 10U 0 inz(10)
*
C do
*
C if String=*BLANKS
C eval IsNumber=*ON
C leave
C endif
*
C eval WorkString=%trim(String)
C eval StringLength=%len(%trim(WorkString))
*
* Evaluate sign and remove:
C eval IsNumber=*ON
C eval Negative=*OFF
C eval ThisChar@=%addr(WorkString)
C eval LastChar@=ThisChar@+StringLength-1
*
C select
*
C when ThisChar=( and LastChar=)
C eval Negative=*ON
C eval ThisChar=*BLANKS
C eval LastChar=*BLANKS
*
C when ThisChar=-
C eval ThisChar=*BLANKS
C eval Negative=*ON
*
C when ThisChar=+
C eval ThisChar=*BLANKS
*
C when LastChar=-
C eval LastChar=*BLANKS
C eval Negative=*ON
*
C when LastChar=+
C eval LastChar=*BLANKS
*
C when LastChar=R and StringLength>1
C eval ThisChar@=LastChar@-1
C if ThisChar=C
C eval Negative=*ON
C eval ThisChar=*BLANKS
C eval LastChar=*BLANKS
C endif
*
C endsl
*
C eval WorkString=%trim(WorkString)
C eval StringLength=%len(%trim(WorkString))
C eval ThisChar@=%addr(WorkString)
C eval LastChar@=ThisChar@+StringLength-1
*
C dow ThisChar@<=LastChar@
*
C eval Digit=IsDigit(ThisChar)
*
C select
* No embedded blanks:
C when ThisChar=*BLANKS
C eval IsNumber=*OFF
C leave
* check for decimal point, allow only one:
C when ThisChar=. and IntoDecimals=*OFF
C eval IntoDecimals=*ON
* if digit, calculate value and significance:
C when Digit>=0
C if IntoDecimals=*OFF
C eval Value=(Value*10)+Digit
C else
C eval Value=Value+(Digit/DecPlace)
C eval DecPlace=DecPlace*10
C endif
* ignore commas:
C when ThisChar=,
* anything else is an error:
C other
C eval IsNumber=*OFF
C leave
*
C endsl
*
C eval ThisChar@=ThisChar@+1
C enddo
*
C if IsNumber=*ON and Negative=*ON
C eval Value=Value * -1
C endif
*
C enddo
*
C if %parms>1
C eval OptValid=IsNumber
C endif
*
C if IsNumber=*ON
C return Value
C else
C return 0
C endif
*
P E
*===============================================================
P IsDigit B export
*
* returns integer 0-9 if Digit is in range 0-9, else returns -1
*
D IsDigit PI 5I 0
D Digit 1A value
*
* Locals:
D SignedDS DS
D Number 1S 0
D Char 1A overlay(Number:1)
*
C if Digit<0 or Digit>9
C return -1
C endif
*
C eval Char=Digit
C return Number
*
P E *===============================================================
* NumfromChar
* returns numeric equivalent of String.
* returns 0 if unable to translate.
* optionally loads OptValid with *OFF/*ON depending on success.
*
D NumfromChar PR 25P 9
D String 32A value
D OptValid 1A options(*NOPASS)
*===============================================================
* IsDigit
* returns integer 0-9 if Digit is in range 0-9, else returns -1.
*
D IsDigit PR 5I 0
D Digit 1A value
*===============================================================
*===============================================================
* To compile:
*
* CRTRPGMOD MODULE(XXX/STRINGTEST) SRCFILE(QRPGLESRC)
* CRTPGM PGM(XXX/STRINGTEST) BNDSRVPGM(XXX/STRING)
*
*===============================================================
/COPY xxxQRPGLESRC,STRINGCPY
*
D Numeric S 15P 5
D Valid S 1A
*
* the following 6 assignments will work:
C eval Numeric = NumfromChar(1,000,000.01)
C eval Numeric = NumfromChar( 3.14159 )
C eval Numeric = NumfromChar(+0.438)
C eval Numeric = NumfromChar( 1,200CR)
C eval Numeric = NumfromChar( )
C eval Numeric = NumfromChar((1))
*
* this assignment will fail - two sign indicators (- and CR):
C eval Numeric = NumfromChar(-978CR:Valid)
C if Valid=*OFF
C eval Numeric = *HIVAL
C endif
*
C eval *INLR = *ON
LATEST COMMENTS
MC Press Online