Main Menu

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.

View BASIS LinkedIN Profile Visit our Twitter Feed Check out our Facebook Public Profile Click to View the BASIS youTube channel