|
Here's another copy of the source, but I've now commented it.
-Bob
H
** Convert Character to Numeric in RPGIII :(
** To use, set the value of FLDLEN equal to
** the length of the character variable that
** contains your numeric data. in this example,
** I use the MYFLD field to store the text form
** of the numeric value. I've initialized it also,
** obviously in a real-world situation, that
** initial value would not be there, but rather
** it would use your runtime value.
I '0123456789-' C NUMS
I ' ' C BLKS
** The following data structure contains all the
** work fields I used in this example. In a real
** world situation, these fields may be declared
** in a similar data structure but the MYFLD field
** would be replaced with the actual name of the
** character field that contains the numeric data,
** and it would not be part of this data structure.
** In addition, the target field, NUMVAL in this
** example, would also be a stand-alone field that
** was probably declared elsewhere in the code.
IFIELDS DS
I P 1 30STR
I P 4 60ENDPOS
I P 7 90LEN
I P 10 120CNT
I P 13 170NUMVAL
I 18 37 NONNUM
I I ' 2345<>((' 38 47 MYFLD
I I 10 P 48 500FLDLEN
.....C*Rn01n02n03Factor1+++OpCodFactor2+++ResultLenDXHiLoEq
** First, convert all the digits to blanks so that
** we end up with the NONNUM field containing only
** the crap we want to get rid of.
C NUMS:BLKS XLATEMYFLD NONNUM
** Next, find the start and end positions of the
** real numeric data in the character field.
C NONNUM CHEKRMYFLD ENDPOS
C NONNUM CHECKMYFLD STR
C ENDPOS SUB STR LEN
C ADD 1 LEN
** Issolate the digits and the sign (if applicable)
** from the original character variable. After this
** operation, the MYFLD field should contain only
** digits and be left-justified.
C LEN SUBSTMYFLD:STR MYFLD P
** Now check to see how many positions are on the
** right side of the digits.
C ' ' CHEKRMYFLD ENDPOS
** Right-adjust and zero fill the numeric value
** in the original character field.
C FLDLEN SUB ENDPOS CNT
C DO CNT
C '0' CAT MYFLD:0 MYFLD
C ENDDO
** At this point, the number has been cleaned up and
** may be copied to the packed decimal number properly.
C MOVE MYFLD NUMVAL
** ENDPROC;
C MOVE *ON *INLR
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.