XTBASE ;SLC/RWF - NUMBER BASE CHANGER ;4/9/92 07:31 ;
;;7.3;TOOLKIT;;Apr 25, 1995
K DIR S:'$D(DTIME) DTIME=$$DTIME^XUP($G(DUZ),$G(IOS))
BASE S DIR(0)="SB^2:2;8:8;10:10;16:16",DIR("A")="BASE",DIR("?")="Enter the number base you want converted" D ^DIR G END:$D(DIRUT) S BASE=Y
G BASE:(BASE<2)!(BASE>36)!(BASE\1'=BASE)
SET DIGIT=$E("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",1,BASE)
B2 W !! S DIR(0)="FO^1:20",DIR("A")="BASE "_BASE_" NUMBER",DIR("?")="Enter the number to convert" D ^DIR G END:$D(DIRUT),BASE:X="" S X=Y
IF BASE=10,X<0 S X=65536+X
F I=1:1:$L(X) IF DIGIT'[$E(X,I) W " Invalid digit in number" G B2
S X1=BASE D DEC W !,"DECIMAL ",Y S %D=Y
F J=1:1:3 S X1=$P("2^8^16","^",J),X=%D D CNV W !,$P("BINARY^OCTAL^HEX","^",J),?7," ",Y
G B2
DEC S Y=0 IF X1=10 S Y=X Q
F I=1:1:$L(X) S Y=Y*X1+($F("0123456789ABCDEF",$E(X,I))-2)
Q
CNV S Y=""
F I=1:1 S Y=$E("0123456789ABCDEF",X#X1+1)_Y,X=X\X1 Q:X<1
Q
END K DIR,BASE,X1,X,Y,I,%D,DIGIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTBASE 967 printed Dec 13, 2024@02:40:41 Page 2
XTBASE ;SLC/RWF - NUMBER BASE CHANGER ;4/9/92 07:31 ;
+1 ;;7.3;TOOLKIT;;Apr 25, 1995
+2 KILL DIR
if '$DATA(DTIME)
SET DTIME=$$DTIME^XUP($GET(DUZ),$GET(IOS))
BASE SET DIR(0)="SB^2:2;8:8;10:10;16:16"
SET DIR("A")="BASE"
SET DIR("?")="Enter the number base you want converted"
DO ^DIR
if $DATA(DIRUT)
GOTO END
SET BASE=Y
+1 if (BASE<2)!(BASE>36)!(BASE\1'=BASE)
GOTO BASE
+2 SET DIGIT=$EXTRACT("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",1,BASE)
B2 WRITE !!
SET DIR(0)="FO^1:20"
SET DIR("A")="BASE "_BASE_" NUMBER"
SET DIR("?")="Enter the number to convert"
DO ^DIR
if $DATA(DIRUT)
GOTO END
if X=""
GOTO BASE
SET X=Y
+1 IF BASE=10
IF X<0
SET X=65536+X
+2 FOR I=1:1:$LENGTH(X)
IF DIGIT'[$EXTRACT(X,I)
WRITE " Invalid digit in number"
GOTO B2
+3 SET X1=BASE
DO DEC
WRITE !,"DECIMAL ",Y
SET %D=Y
+4 FOR J=1:1:3
SET X1=$PIECE("2^8^16","^",J)
SET X=%D
DO CNV
WRITE !,$PIECE("BINARY^OCTAL^HEX","^",J),?7," ",Y
+5 GOTO B2
DEC SET Y=0
IF X1=10
SET Y=X
QUIT
+1 FOR I=1:1:$LENGTH(X)
SET Y=Y*X1+($FIND("0123456789ABCDEF",$EXTRACT(X,I))-2)
+2 QUIT
CNV SET Y=""
+1 FOR I=1:1
SET Y=$EXTRACT("0123456789ABCDEF",X#X1+1)_Y
SET X=X\X1
if X<1
QUIT
+2 QUIT
END KILL DIR,BASE,X1,X,Y,I,%D,DIGIT
+1 QUIT
