source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAFUNC.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1LAFUNC ;SLC/DLG - GENERIC FUNCTIONS USED BY LA ROUTINES ;7/20/90 08:28 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
3 ;CHECKSUM CALCULATIONS AND NUMBER BASE CONVERSIONS.
4 ;CHECKSUM CALCULATION VARIABLES
5 ; LAX = STRING FOR CALCULATION
6 ; LAS = POSITION TO START CALCULATION
7 ; LAE = POSITION TO STOP CALCULATION
8 ; LAY = FULL NUMERIC VALUE OF CHECKSUM
9 ;NUMBER BASE CONVERSION VARIABLES
10 ; LAX = NUMBER TO CONVERT
11 ; LAY = NUMBER IN NEW BASE
12 ; LAS, LAE = NOT USED
13 ;ALL INTERNAL VARIABLES KILED. LAX,LAS,LAE RETURNED UNCHANGED
14 ;
15AND ;AND AL CHAR IN STRING
16 S LAY=$A(LAX,LAS) F II=LAS+1:1:LAE S LAY=LAY+$A(LAX,II)
17 Q:$D(F) G EXIT
18NAND ;NOT AND OF STRING OF CHAR
19 S F=0 D AND S LAY=-(LAY+1) G EXIT
20OR ;OR AL CHAR IN STRING
21 S LAY=$A(LAX,LAS) F II=LAS+1:1:LAE S M=LAY,N=$A(LAX,II),B=64,LAY=0 X "F JJ=1:1:7 S K=M\B,L=N\B,O=$S(((K=L)&(M=0)):0,1:1),LAY=LAY*2+O,M=M#B,N=N#B,B=B\2"
22 Q:$D(F) G EXIT
23NOR ;NOT OR OF STRING
24 S F=0 D OR S LAY=-(LAY+1) G EXIT
25XOR ;XOR AL CHAR IN STRING
26 S LAY=$A(LAX,LAS) F II=LAS+1:1:LAE S M=LAY,N=$A(LAX,II),B=64,LAY=0 X "F JJ=1:1:7 S K=M\B,L=N\B,O=$S(K=L:0,1:1),LAY=LAY*2+O,M=M#B,N=N#B,B=B\2"
27 Q:$D(F) G EXIT
28XNOR ;EXCLUSIVE NOT OR OF STRING
29 S F=0 D XOR S LAY=-(LAY+1) G EXIT
30BTOO ;BINARY STRING TO OCTAL
31 S TEMP=LAX,F=0 D BTOD S LAX=LAY D DTOO S LAX=TEMP G EXIT
32BTOD ;BINARY STRING TO DECIMAL
33 S LAY=0 F II=1:1:$L(LAX) S LAY=LAY*2+$E(LAX,II)
34 Q:$D(F) G EXIT
35BTOH ;BINARY STRING TO HEX
36 S TEMP=LAX,F=0 D BTOD S LAX=LAY D DTOH S LAX=TEMP G EXIT
37OTOB ;OCTAL TO BINARY STRING
38 S TEMP=LAX,F=0 D OTOD S LAX=LAY D DTOB S LAX=TEMP G EXIT
39OTOD ;OCTAL TO DECIMAL
40 S K=LAX,LAY=0 F II=1:1:$L(K) S LAY=LAY*8+$F("01234567",$E(K,II))-2
41 Q:$D(F) G EXIT
42OTOH ;OCTAL TO HEX
43 S TEMP=LAX,F=0 D OTOD S LAX=LAY D DTOH S LAX=TEMP G EXIT
44DTOB ;DECIMAL VALUE TO BINARY STRING
45 S K=LAX,LAY="" F II=0:0 S L=K#2,K=K\2,LAY=L_LAY Q:K=0
46 Q:$D(F) G EXIT
47DTOO ;DECIMAL TO OCTAL
48 S K=LAX,LAY="",B=8,M=1
49 F II=0:0 S L=K#B\M,LAY=$E("01234567",(L+1))_LAY,M=M*8,B=B*8 Q:(K\M=0)
50 Q:$D(F) G EXIT
51DTOH ;CHANGE DECIMAL VALUE TO 6 HEX CHARACTERS
52 S M=1,B=16,K=LAX,LAY=""
53 F II=0:0 S L=K#B\M S LAY=$E("0123456789ABCDEF",(L+1))_LAY,M=M*16,B=B*16 Q:(K\M=0)
54 Q:$D(F) G EXIT
55HTOB ;HEX VALUE TO BINARY STRING
56 S TEMP=LAX,F=0 D HTOD S LAX=LAY D DTOB S LAX=TEMP G EXIT
57HTOO ;HEX TO OCTAL
58 S TEMP=LAX,F=0 D HTOD S LAX=LAY D DTOO S LAX=TEMP G EXIT
59HTOD ;CHANGE HEX TO DECIMAL VALUE
60 S K=LAX,LAY=0 F II=1:1:$L(K) S LAY=LAY*16+$F("0123456789ABCDEF",$E(K,II))-2
61 Q:$D(F) G EXIT
62NUM W !,"ENTER NUMBER WITH BASE AS LAST CHAR. IE 0101B FOR BINARY: "
63 R LAX:DTIME G EXIT0:'$T,EXIT0:LAX="",EXIT0:LAX="^",NUM1:"BODH"[$E(LAX,$L(LAX))
64 W !!,"ENTER THE NUMBER FOLLOWED BY STARTING BASE. IE 3FH FOR 3F HEX." H 5 G NUM
65NUM1 S STR=$E(LAX,$L(LAX))_"TO",LAX=$E(LAX,1,($L(LAX)-1)),F=1,TY=0 F I=1:1:$L(LAX) S:TY<$A(LAX,I) TY=$A(LAX,I)
66 I STR="BTO",TY<50 S CAL=STR_"O" D @CAL S LAY(2)=LAY,CAL=STR_"D" D @CAL S LAY(3)=LAY S CAL=STR_"H" D @CAL S LAY(4)=LAY,LAY(1)=LAX G PRT
67 I STR="OTO",TY<56 S CAL=STR_"B" D @CAL S LAY(1)=LAY,CAL=STR_"D" D @CAL S LAY(3)=LAY S CAL=STR_"H" D @CAL S LAY(4)=LAY,LAY(2)=LAX G PRT
68 I STR="DTO",LAX?.N S CAL=STR_"B" D @CAL S LAY(1)=LAY,CAL=STR_"O" D @CAL S LAY(2)=LAY S CAL=STR_"H" D @CAL S LAY(4)=LAY,LAY(3)=LAX G PRT
69 I STR="HTO",((TY<58)!((TY>64)&(TY<71))) S CAL=STR_"B" D @CAL S LAY(1)=LAY,CAL=STR_"O" D @CAL S LAY(2)=LAY S CAL=STR_"D" D @CAL S LAY(3)=LAY,LAY(4)=LAX G PRT
70 W !,"INVALID NUMBER",! H 5 G NUM
71PRT W !," BINARY: ",LAY(1),!," OCTAL: ",LAY(2),!,"DECIMAL: ",LAY(3),!," HEX: ",LAY(4),! K LAY G NUM
72TABLE ;PRINT TABLE OF CONVERSIONS FOR 0 TO 256 DECIMAL
73 D ^%ZIS Q:POP S PAGE=0 U IO D HDR
74 F I=0:1:256 S LAX=I D DTOB W $J(LAY,9) D DTOO W ?11,$J(LAY,3) W ?16,$J(I,3) S LAX=I D DTOH W ?21,$J(LAY,3) W:((I>31)&(I<128)) ?27,$C(I) W ! D:(($Y+4)>IOSL) HDR
75 W @IOF U IO(0) D:IO'=IO(0) ^%ZISC G EXIT
76HDR S PAGE=PAGE+1 W @IOF,"NUMBER BASE CONVERSION TABLE",?(IOM-10),"PAGE: ",$J(PAGE,2),!," BINARY OCT DEC HEX ASC",!
77 F J=1:1:(IOM-2) W "-"
78 W !! Q
79EXIT0 K CAL,STR,TY
80EXIT K B,F,II,JJ,K,L,M,N,O,TEMP Q
Note: See TracBrowser for help on using the repository browser.