- 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 Feb 19, 2025@00:07:09 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