# KB#00552-Sample code to pack and unpack decimal numbers into IBM's packed decimal format.

## Title:

Sample code to pack and unpack decimal numbers into IBM's packed decimal format.

### Description:

1) Convert integer to packed format:

0010 INPUT "Enter integer (e.g. -123): ",D%
0020 PRINT HTA(FNPCK\$(D%))
0030 GOTO 0010
0040 REM --- FNPCK\$(D%) --- Convert integer to IBM Packed Decimal format
0050 DEF FNPCK\$(D%)
0060 LET P\$=STR(ABS(D%)); REM ' convert number to ASCII digits (IBM Zoned)
0070 IF D%<0 THEN LET P\$=P\$+"D" ELSE LET P\$=P\$+"C"; REM ' Add packed sign (C=+
0070:/D=-)
0080 IF MOD(LEN(P\$)/2,1) THEN LET P\$="0"+P\$; REM ' Add leading 0 if necessary
0090 LET P\$=ATH(P\$); REM ' convert to packed decimal
0100 RETURN P\$
0110 FNEND

(2) Convert packed format to integer:

0010 INPUT "Enter packed decimal (e.g. '123D'): ",P\$
0020 LET P\$=ATH(P\$); REM ' convert from printable to binary packed
0030 PRINT FNUPK(P\$,ERR=0040); GOTO 0010
0040 PRINT 'RB',"Invalid packed format."; GOTO 0010
0050 REM --- FNUPK(P\$) --- Convert IBM Packed Decimal to integer
0060 DEF FNUPK(P\$)
0070 IF LEN(P\$)=0 THEN GOTO BAD
0080 LET P\$=CVS(HTA(P\$),4); REM ' make sure sign nybble is uppercase
0090 LET D%=NUM(P\$(1,LEN(P\$)-1),ERR=BAD); REM ' all except sign must be number
0100 IF POS(P\$(LEN(P\$))="DB") THEN LET D%=-D% ELSE IF POS(P\$(LEN(P\$))="CAEF")=