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")= 
0100:0 THEN GOTO BAD 
0110 RETURN D% 
0120 BAD: FNERR 41 
0130 FNEND 

Last Modified: 01/28/1998 Product: PRO/5 Operating System: N/A

BASIS structures five components of their technology into the BBx Generations.