source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XLFMSMT.m@ 635

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1XLFMSMT ;SLC,SF/MH,RWF - Callable functions for conversions in measurement ;04/09/2002 09:02
2 ;;8.0;KERNEL;**228**;Jul 10, 1995
3 N I,VAL
4 W !!,"Routine: "_$T(+0),! F I=8:1 S VAL=$T(+I) Q:'$L(VAL) I VAL[";;" W !,VAL
5 W !!
6 Q
7 ;;
8WEIGHT(VAL,FROM,TO) ;;Convert weight between metric and U.S. weights
9 ;; returns equivilent value with units
10 ;; VAL must contain a positive numeric value
11 ;; FROM must contain the units of measure of VAL
12 ;; TO must contain the units of measure to convert VAL to
13 ;; eg. W $$WEIGHT(12,"LB","G") ===> 5448 G
14 ;; Valid units in either lowercase or uppercase are
15 ;; t = metric tons tn = tons
16 ;; kg = kilograms lb = pounds
17 ;; g = grams oz = ounces
18 ;; mg = milligram gr = grain
19 N CKY,CKZ
20 I '$G(VAL) Q 0
21 I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
22 S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
23 Q:'$L(FROM)!('$L(TO)) 0
24 I "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKY Q "ERROR"
25 I "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKZ Q "ERROR"
26 ; quit with no conversion
27 G WT^XLFMSMT2
28LENGTH(VAL,FROM,TO) ;;Convert length between metric and U.S. length
29 ;; returns equivilent value with units
30 ;; VAL must contain a positive numeric value
31 ;; FROM must contain the units of measure of VAL
32 ;; TO must contain the units of measure to convert VAL to
33 ;; eg. W $$LENGTH(12,"IN","CM") ===> 30.480 CM
34 ;; Valid units are in either uppercase or lowercase are:
35 ;; km = kilometers mi = miles
36 ;; m = meters yd = yards
37 ;; cm = centimeters ft = feet
38 ;; mm = millimeters in = inches
39 N CKY,CKZ
40 I '$G(VAL) Q 0
41 I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
42 S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
43 Q:'$L(FROM)!('$L(TO)) 0
44 I "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKY Q "ERROR"
45 I "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKZ Q "ERROR"
46 ; quit with no conversion
47 I FROM=TO Q VAL_" "_TO
48 G LN^XLFMSMT2
49 ;;
50VOLUME(VAL,FROM,TO) ;;Convert volume between metric and U.S. volume
51 ;; Mililiters to cubic inches or quarts or ounces
52 ;; returns equivilent value with units
53 ;; VAL must contain a positive numeric value
54 ;; FROM must contain the units of measure of VAL
55 ;; TO must contain the units of measure to convert VAL to
56 ;; eg. W $$VOLUME(12,"CF","ML") ===> 339800.832 ML
57 ;; Valid units in either uppercase or lowercase are:
58 ;; kl = kiloliter cf = feet
59 ;; hl = hectoliter ci = inch
60 ;; dal = dekaliter gal = gallon
61 ;; l = liters qt = quart
62 ;; dl = deciliter pt = pint
63 ;; cl = centiliter c = cup
64 ;; ml = mililiter oz = ounce
65 ;
66 N CKY,CKZ
67 I '$G(VAL) Q 0
68 I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
69 S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
70 Q:'$L(FROM)!('$L(TO)) 0
71 I "^KL^HL^DAL^L^DL^CL^ML^CF^CI^GAL^QT^PT^C^OZ^"'[CKY Q "ERROR"
72 I "^KL^HL^DAL^L^DL^CL^ML^CF^CI^GAL^QT^PT^C^OZ^"'[CKZ Q "ERROR"
73 ; quit with no conversion
74 I FROM=TO Q VAL_" "_TO
75 G VOL^XLFMSMT2
76 ;;
77BSA(%HT,%WT) ;;Return Body Surface Area using Dubois formula
78 ;; Dubois formula BSA=.007184*(ht**.725)*(wt**.425)
79 ;; %HT is height in centimeters
80 ;; %WT is weight in Kilograms
81 ;; eg. $$BSA(175,86)=2.02
82 ;; or $$BSA(100,43)=1.00
83 I '$$VAL(%HT) Q 0_"ILLEGAL NUMBER"
84 I '$$VAL(%WT) Q 0_" ILLEGAL NUMBER"
85 ;Q $FN(($$PWR^XLFMTH(%HT,.425)*$$PWR^XLFMTH(%WT,.725)*71.84)/10000,"",2)
86 Q $FN(((%HT**.725)*(%WT**.425)*71.84)/10000,"",2)
87 ;
88TEMP(VAL,FROM,TO) ;;Convert metric temperature to U.S. temperature
89 ;; F = fahrenheit C = celsius
90 N CKY,CKZ
91 I '$D(VAL) Q 0
92 I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
93 S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
94 Q:'$L(FROM)!('$L(TO)) 0
95 I "^F^C^"'[CKY Q "ERROR"
96 I "^F^C^"'[CKZ Q "ERROR"
97 I FROM=TO Q VAL_" "_TO
98 I TO="C" Q $$FORMAT^XLFMSMT2((VAL-32)/1.8)_" "_TO
99 I TO="F" Q $$FORMAT^XLFMSMT2(1.8*VAL+32)_" "_TO
100 Q "ERROR"
101VAL(X) ;
102 I X[".",$L(X)>19 Q 0
103 I $L(X)>18 Q 0
104 Q 1
105UPCASE(X) ;
106 Q $TR(X,"zxcvbnmlkjhgfdsaqwertyuiop","ZXCVBNMLKJHGFDSAQWERTYUIOP")
107 ;
Note: See TracBrowser for help on using the repository browser.