|
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-2024 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.