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.