XTBASE.m

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

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