Extract Packed Decimal Numbers from Character Strings
Do you know how to convert a packed decimal value that is embedded within a character variable to a usable form using RPG?
The C run-time library includes several functions that convert packed and zoned data from and to the "politically correct" integer and real types. Here's a look at the functions:
In the following example, a five-digit packed decimal value is embedded in bytes two through four of an eight-byte character variable. The QXXPTOI function extracts the value into an integer variable:
* Convert packed decimal to integer * * To compile: * * CRTRPGMOD MODULE(xxx/PACKTOZONE) * SRCFILE(xxx/QRPGLESRC) * SRCMBR(PACKTOZONE) * CRTPGM PGM(xxx/PACKTOZONE) * MODULE(PACKTOZONE) * BNDDIR(QC2LE) D PackedToInt pr 10i 0 extproc('QXXPTOI') D Ptr * value options(*string) D Digits 10i 0 value D Fraction 10i 0 value D D ValidData s n D PackedNbr s 8a D IntegerNbr s 10i 0 D /free PackedNbr = x'4013579F40404040'; ValidData = *on; monitor; IntegerNbr = PackedToInt (%addr(PackedNbr)+1: 5: 0); on-error; ValidData = *off; endmon; *inlr = *on; /end-free
The first parameter, Ptr, is a pointer to the raw data. I added one to the address of the character variable in order to pass a pointer to the second byte of the character variable. I specified a size of five digits in the second parameter, Digits. The third parameter, Fraction, is the number of assumed decimal positions in the packed value. Since I specified a value of zero in the call to QXXPTOI, IntegerNbr was set to 13,579. Had I specified two decimal positions, IntegerNbr would have been set to 135.
If the input data is not valid, you'll get an error message. When I disabled the monitor op code and set PackedNbr to blank, I got errors MCH1202 (Decimal data error), CPF9999 (Function check), and RNQ0202 (The call to QXXPTOI ended in error.)
Here's another method that's not as sophisticated. It uses some of those old RPG features, like the TESTB and MLLZO op codes, but it gets the job done. You can compile it as a standalone program or as a module. If you decide to run it as a program, you'll need to use the FREE op code in the caller to deactivate it when you're finished with it:
* Convert a packed decimal number to a zoned decimal number. * Status returns 0 if input is valid, 1 if invalid. D OWORK S 1 DIM(32) C *ENTRY PLIST C PARM PACKIN 16 C PARM ZONEOUT 31 C PARM STATUS 1 C MOVE *ZERO IX 3 0 C MOVE *ZERO OX 3 0 C MOVE *BLANKS OWORK C DOW '0' = '0' C ADD 1 IX * IF NO SIGN BYTE FOUND, ERROR & EXIT C IF IX > 16 C MOVE *ON STATUS C LEAVE C ENDIF C 1 SUBST PACKIN:IX CHAR 1 * CONVERT ZONE & DIGIT TO NUMBERS C EXSR EXTRACT * ZONE MUST BE 0 THRU 9 C IF ZONE < 10 C ADD 1 OX C MOVE ZONE OWORK (OX) C ELSE C MOVE *ON STATUS C LEAVE C ENDIF * DIGIT MAY BE 0 THRU 9 (NUMBER) OR A THRU F (SIGN) C IF DIGIT < 10 C ADD 1 OX C MOVE DIGIT OWORK (OX) C ELSE * CHECK SIGN -- X'B' AND X'D' ARE NEGATIVES C IF DIGIT = 11 OR C DIGIT = 13 * MAKE THE ZONED NUMBER NEGATIVE C MLLZO 'J' OWORK (OX) C ENDIF * DATA IS VALID C MOVE *OFF STATUS C LEAVE C ENDIF C ENDDO C * IF VALID PACKED DATA FOUND, UPDATE OUTPUT PARM C IF STATUS = *OFF C 1 DO OX CX 3 0 C EVAL %SUBST(ZONEOUT: CX: 1) = C OWORK (CX) C ENDDO C ENDIF C RETURN * ========================================================== * EXTRACT -- EXTRACT ZONE & DIGIT * ========================================================== C EXTRACT BEGSR C MOVE *ZERO ZONE 3 0 C MOVE *ZERO DIGIT 3 0 C TESTB '0' CHAR 01 C 01 ADD 8 ZONE C TESTB '1' CHAR 01 C 01 ADD 4 ZONE C TESTB '2' CHAR 01 C 01 ADD 2 ZONE C TESTB '3' CHAR 01 C 01 ADD 1 ZONE C TESTB '4' CHAR 01 C 01 ADD 8 DIGIT C TESTB '5' CHAR 01 C 01 ADD 4 DIGIT C TESTB '6' CHAR 01 C 01 ADD 2 DIGIT C TESTB '7' CHAR 01 C 01 ADD 1 DIGIT C ENDSR
You don't have to tell this routine the size of the packed decimal input value. It extracts any packed number up to 31 digits in size and copies the value to a zoned decimal number. The zoned number will be left-adjusted and any unneeded trailing bytes are not affected. If the input does not contain a valid packed decimal value, the zoned number is not modified.
This routine sets the status code parameter to zero if the input data contained a valid packed value, but the routine sets the status code parameter to one if the input data was invalid.
Be careful when calling this routine. Since it does not use procedure prototyping, you can pass it any type of value you want. As a rule, you'll probably pass a character value in the first parameter and a zoned decimal value in the second parameter. Be sure the zoned decimal parameter has the exact number of digits in the packed value. A five-byte packed value, for example, stores nine digits.
As with all code published in Midrange Guru, test it thoroughly, and use it at your own risk.
Contact the Editors
|Copyright © 1996-2008 Guild Companies, Inc. All Rights Reserved.|