| 1 | XTBASE ;SLC/RWF - NUMBER BASE CHANGER ;4/9/92 07:31 ;
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | K DIR S:'$D(DTIME) DTIME=$$DTIME^XUP($G(DUZ),$G(IOS))
|
|---|
| 4 | 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
|
|---|
| 5 | G BASE:(BASE<2)!(BASE>36)!(BASE\1'=BASE)
|
|---|
| 6 | SET DIGIT=$E("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",1,BASE)
|
|---|
| 7 | 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
|
|---|
| 8 | IF BASE=10,X<0 S X=65536+X
|
|---|
| 9 | F I=1:1:$L(X) IF DIGIT'[$E(X,I) W " Invalid digit in number" G B2
|
|---|
| 10 | S X1=BASE D DEC W !,"DECIMAL ",Y S %D=Y
|
|---|
| 11 | F J=1:1:3 S X1=$P("2^8^16","^",J),X=%D D CNV W !,$P("BINARY^OCTAL^HEX","^",J),?7," ",Y
|
|---|
| 12 | G B2
|
|---|
| 13 | DEC S Y=0 IF X1=10 S Y=X Q
|
|---|
| 14 | F I=1:1:$L(X) S Y=Y*X1+($F("0123456789ABCDEF",$E(X,I))-2)
|
|---|
| 15 | Q
|
|---|
| 16 | CNV S Y=""
|
|---|
| 17 | F I=1:1 S Y=$E("0123456789ABCDEF",X#X1+1)_Y,X=X\X1 Q:X<1
|
|---|
| 18 | Q
|
|---|
| 19 | END K DIR,BASE,X1,X,Y,I,%D,DIGIT
|
|---|
| 20 | Q
|
|---|
