1 | LRAFUNC5 ;SLC/MRH/FHS - FUNCTION CALLS CONVERSION IN MEASURMENTS A5AFUNC5
|
---|
2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
---|
3 | ;
|
---|
4 | N I,X
|
---|
5 | W !!,"Routine: "_$T(+0),! F I=8:1 S X=$T(LRAFUNC5+I) Q:'$L(X) I X[";;" W !,X
|
---|
6 | W !!
|
---|
7 | Q
|
---|
8 | ;;
|
---|
9 | WEIGHT(X,Y,Z) ;; convert metric mass to approx. U.S. weights and visa versa
|
---|
10 | ;; Call by value
|
---|
11 | ;; returns equivilent value with out units
|
---|
12 | ;; X must contain a positive numeric value
|
---|
13 | ;; Y must contain the units of measure of X
|
---|
14 | ;; Z must contain the units of measure to convert X to
|
---|
15 | ;; eg. S X=$$WEIGHT(12,"LB","GM") will return a value of X (12)
|
---|
16 | ;; pounds in grams
|
---|
17 | ;; Valid units in either lowercase or uppercase
|
---|
18 | ;; are t = metric tons
|
---|
19 | ;; kg = kilograms
|
---|
20 | ;; g = grams
|
---|
21 | ;; mg = milligram
|
---|
22 | ;; tn = tons
|
---|
23 | ;; lb = pounds
|
---|
24 | ;; oz = ounces
|
---|
25 | ;; gr = grain
|
---|
26 | N CKY,CKZ
|
---|
27 | I '$G(X) Q 0
|
---|
28 | I X[".",$L(X)>19 Q 0_" ILLEGAL NUMBER"
|
---|
29 | I $L(X)>18 Q 0_" ILLEGAL NUMBER"
|
---|
30 | S Y=$$UPCASE(Y),Z=$$UPCASE(Z)
|
---|
31 | Q:'$L(Y)!('$L(Z)) 0
|
---|
32 | S CKY=U_Y_U
|
---|
33 | I "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKY Q "ERROR"
|
---|
34 | S CKZ=U_Z_U
|
---|
35 | I "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKZ Q "ERROR"
|
---|
36 | ; quit with no conversion
|
---|
37 | I Y=Z Q X_" "_Z
|
---|
38 | ; common metric unit is kilograms KG
|
---|
39 | I $P("^T^1^KG^1^G^1^MG^1",CKY,2) S X=X*$P("^T^1000^KG^1^G^.001^MG^.000001",CKY,2) S X=X_"M"
|
---|
40 | ; common english unit is pound LB
|
---|
41 | I $P("^TN^1^LB^1^OZ^1^GR^1",CKY,2) S X=X*$P("^TN^2000^LB^1^OZ^.0625^GR^.0001302083",CKY,2) S X=X_"U"
|
---|
42 | ; the result of the above 2 IF statments will result in X being
|
---|
43 | ; converted to kilograms or pounds depending on the value of Y
|
---|
44 | ;
|
---|
45 | ; X in metric and will convert to metric X in KG
|
---|
46 | I X["M",$P("^T^1^KG^1^G^1^MG^1",CKZ,2) S X=X*$P("^T^.00001^KG^1^G^1000^MG^10000",CKZ,2) Q $$FORMAT(X)_" "_Z
|
---|
47 | ;
|
---|
48 | ; X in U.S. and will convert to U.S. X in LB
|
---|
49 | I X["U",$P("^TN^1^LB^1^OZ^1^GR^1",CKZ,2) S X=X*$P("^TN^.0005^LB^1^OZ^16^GR^7680",CKZ,2) Q $$FORMAT(X)_" "_Z
|
---|
50 | ;
|
---|
51 | ; X in U.S. and will convert to metric X in LB
|
---|
52 | I X["U",$P("^T^1^KG^1^G^1^MG^1",CKZ,2) S X=X*$P("^T^.000454^KG^.454^G^454^MG^454000",CKZ,2) Q $$FORMAT(X)_" "_Z
|
---|
53 | ;
|
---|
54 | ; X in metric and will convert to U.S. X in KG
|
---|
55 | I X["M",$P("^TN^1^LB^1^OZ^1^GR^1",CKZ,2) S X=X*$P("^TN^.00062^LB^2.2046^OZ^35.2736^GR^154300",CKZ,2) Q $$FORMAT(X)_" "_Z
|
---|
56 | ;
|
---|
57 | ;;
|
---|
58 | FORMAT(X) ;
|
---|
59 | S X=$S(X>.9:$FN(X,"",3),1:$FN(X,"",4))
|
---|
60 | Q $S($P(X,".",2):X,1:$FN(X,"",0))
|
---|
61 | ;
|
---|
62 | UPCASE(X) ;
|
---|
63 | Q $TR(X,"zxcvbnmlkjhgfdsaqwertyuiop","ZXCVBNMLKJHGFDSAQWERTYUIOP")
|
---|