XLFMSMT ;SLC,SF/MH,RWF - Callable functions for conversions in measurement ;04/09/2002 09:02
;;8.0;KERNEL;**228**;Jul 10, 1995
N I,VAL
W !!,"Routine: "_$T(+0),! F I=8:1 S VAL=$T(+I) Q:'$L(VAL) I VAL[";;" W !,VAL
W !!
Q
;;
WEIGHT(VAL,FROM,TO) ;;Convert weight between metric and U.S. weights
;; returns equivilent value with units
;; VAL must contain a positive numeric value
;; FROM must contain the units of measure of VAL
;; TO must contain the units of measure to convert VAL to
;; eg. W $$WEIGHT(12,"LB","G") ===> 5448 G
;; Valid units in either lowercase or uppercase are
;; t = metric tons tn = tons
;; kg = kilograms lb = pounds
;; g = grams oz = ounces
;; mg = milligram gr = grain
N CKY,CKZ
I '$G(VAL) Q 0
I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
Q:'$L(FROM)!('$L(TO)) 0
I "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKY Q "ERROR"
I "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKZ Q "ERROR"
; quit with no conversion
G WT^XLFMSMT2
LENGTH(VAL,FROM,TO) ;;Convert length between metric and U.S. length
;; returns equivilent value with units
;; VAL must contain a positive numeric value
;; FROM must contain the units of measure of VAL
;; TO must contain the units of measure to convert VAL to
;; eg. W $$LENGTH(12,"IN","CM") ===> 30.480 CM
;; Valid units are in either uppercase or lowercase are:
;; km = kilometers mi = miles
;; m = meters yd = yards
;; cm = centimeters ft = feet
;; mm = millimeters in = inches
N CKY,CKZ
I '$G(VAL) Q 0
I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
Q:'$L(FROM)!('$L(TO)) 0
I "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKY Q "ERROR"
I "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKZ Q "ERROR"
; quit with no conversion
I FROM=TO Q VAL_" "_TO
G LN^XLFMSMT2
;;
VOLUME(VAL,FROM,TO) ;;Convert volume between metric and U.S. volume
;; Mililiters to cubic inches or quarts or ounces
;; returns equivilent value with units
;; VAL must contain a positive numeric value
;; FROM must contain the units of measure of VAL
;; TO must contain the units of measure to convert VAL to
;; eg. W $$VOLUME(12,"CF","ML") ===> 339800.832 ML
;; Valid units in either uppercase or lowercase are:
;; kl = kiloliter cf = feet
;; hl = hectoliter ci = inch
;; dal = dekaliter gal = gallon
;; l = liters qt = quart
;; dl = deciliter pt = pint
;; cl = centiliter c = cup
;; ml = mililiter oz = ounce
;
N CKY,CKZ
I '$G(VAL) Q 0
I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
Q:'$L(FROM)!('$L(TO)) 0
I "^KL^HL^DAL^L^DL^CL^ML^CF^CI^GAL^QT^PT^C^OZ^"'[CKY Q "ERROR"
I "^KL^HL^DAL^L^DL^CL^ML^CF^CI^GAL^QT^PT^C^OZ^"'[CKZ Q "ERROR"
; quit with no conversion
I FROM=TO Q VAL_" "_TO
G VOL^XLFMSMT2
;;
BSA(%HT,%WT) ;;Return Body Surface Area using Dubois formula
;; Dubois formula BSA=.007184*(ht**.725)*(wt**.425)
;; %HT is height in centimeters
;; %WT is weight in Kilograms
;; eg. $$BSA(175,86)=2.02
;; or $$BSA(100,43)=1.00
I '$$VAL(%HT) Q 0_"ILLEGAL NUMBER"
I '$$VAL(%WT) Q 0_" ILLEGAL NUMBER"
;Q $FN(($$PWR^XLFMTH(%HT,.425)*$$PWR^XLFMTH(%WT,.725)*71.84)/10000,"",2)
Q $FN(((%HT**.725)*(%WT**.425)*71.84)/10000,"",2)
;
TEMP(VAL,FROM,TO) ;;Convert metric temperature to U.S. temperature
;; F = fahrenheit C = celsius
N CKY,CKZ
I '$D(VAL) Q 0
I '$$VAL(VAL) Q 0_" ILLEGAL NUMBER"
S FROM=$$UPCASE(FROM),CKY="^"_FROM_"^",TO=$$UPCASE(TO),CKZ="^"_TO_"^"
Q:'$L(FROM)!('$L(TO)) 0
I "^F^C^"'[CKY Q "ERROR"
I "^F^C^"'[CKZ Q "ERROR"
I FROM=TO Q VAL_" "_TO
I TO="C" Q $$FORMAT^XLFMSMT2((VAL-32)/1.8)_" "_TO
I TO="F" Q $$FORMAT^XLFMSMT2(1.8*VAL+32)_" "_TO
Q "ERROR"
VAL(X) ;
I X[".",$L(X)>19 Q 0
I $L(X)>18 Q 0
Q 1
UPCASE(X) ;
Q $TR(X,"zxcvbnmlkjhgfdsaqwertyuiop","ZXCVBNMLKJHGFDSAQWERTYUIOP")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFMSMT 4230 printed Nov 22, 2024@17:12:58 Page 2
XLFMSMT ;SLC,SF/MH,RWF - Callable functions for conversions in measurement ;04/09/2002 09:02
+1 ;;8.0;KERNEL;**228**;Jul 10, 1995
+2 NEW I,VAL
+3 WRITE !!,"Routine: "_$TEXT(+0),!
FOR I=8:1
SET VAL=$TEXT(+I)
if '$LENGTH(VAL)
QUIT
IF VAL[";;"
WRITE !,VAL
+4 WRITE !!
+5 QUIT
+6 ;;
WEIGHT(VAL,FROM,TO) ;;Convert weight between metric and U.S. weights
+1 ;; returns equivilent value with units
+2 ;; VAL must contain a positive numeric value
+3 ;; FROM must contain the units of measure of VAL
+4 ;; TO must contain the units of measure to convert VAL to
+5 ;; eg. W $$WEIGHT(12,"LB","G") ===> 5448 G
+6 ;; Valid units in either lowercase or uppercase are
+7 ;; t = metric tons tn = tons
+8 ;; kg = kilograms lb = pounds
+9 ;; g = grams oz = ounces
+10 ;; mg = milligram gr = grain
+11 NEW CKY,CKZ
+12 IF '$GET(VAL)
QUIT 0
+13 IF '$$VAL(VAL)
QUIT 0_" ILLEGAL NUMBER"
+14 SET FROM=$$UPCASE(FROM)
SET CKY="^"_FROM_"^"
SET TO=$$UPCASE(TO)
SET CKZ="^"_TO_"^"
+15 if '$LENGTH(FROM)!('$LENGTH(TO))
QUIT 0
+16 IF "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKY
QUIT "ERROR"
+17 IF "^T^KG^G^MG^TN^LB^OZ^GR^"'[CKZ
QUIT "ERROR"
+18 ; quit with no conversion
+19 GOTO WT^XLFMSMT2
LENGTH(VAL,FROM,TO) ;;Convert length between metric and U.S. length
+1 ;; returns equivilent value with units
+2 ;; VAL must contain a positive numeric value
+3 ;; FROM must contain the units of measure of VAL
+4 ;; TO must contain the units of measure to convert VAL to
+5 ;; eg. W $$LENGTH(12,"IN","CM") ===> 30.480 CM
+6 ;; Valid units are in either uppercase or lowercase are:
+7 ;; km = kilometers mi = miles
+8 ;; m = meters yd = yards
+9 ;; cm = centimeters ft = feet
+10 ;; mm = millimeters in = inches
+11 NEW CKY,CKZ
+12 IF '$GET(VAL)
QUIT 0
+13 IF '$$VAL(VAL)
QUIT 0_" ILLEGAL NUMBER"
+14 SET FROM=$$UPCASE(FROM)
SET CKY="^"_FROM_"^"
SET TO=$$UPCASE(TO)
SET CKZ="^"_TO_"^"
+15 if '$LENGTH(FROM)!('$LENGTH(TO))
QUIT 0
+16 IF "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKY
QUIT "ERROR"
+17 IF "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKZ
QUIT "ERROR"
+18 ; quit with no conversion
+19 IF FROM=TO
QUIT VAL_" "_TO
+20 GOTO LN^XLFMSMT2
+21 ;;
VOLUME(VAL,FROM,TO) ;;Convert volume between metric and U.S. volume
+1 ;; Mililiters to cubic inches or quarts or ounces
+2 ;; returns equivilent value with units
+3 ;; VAL must contain a positive numeric value
+4 ;; FROM must contain the units of measure of VAL
+5 ;; TO must contain the units of measure to convert VAL to
+6 ;; eg. W $$VOLUME(12,"CF","ML") ===> 339800.832 ML
+7 ;; Valid units in either uppercase or lowercase are:
+8 ;; kl = kiloliter cf = feet
+9 ;; hl = hectoliter ci = inch
+10 ;; dal = dekaliter gal = gallon
+11 ;; l = liters qt = quart
+12 ;; dl = deciliter pt = pint
+13 ;; cl = centiliter c = cup
+14 ;; ml = mililiter oz = ounce
+15 ;
+16 NEW CKY,CKZ
+17 IF '$GET(VAL)
QUIT 0
+18 IF '$$VAL(VAL)
QUIT 0_" ILLEGAL NUMBER"
+19 SET FROM=$$UPCASE(FROM)
SET CKY="^"_FROM_"^"
SET TO=$$UPCASE(TO)
SET CKZ="^"_TO_"^"
+20 if '$LENGTH(FROM)!('$LENGTH(TO))
QUIT 0
+21 IF "^KL^HL^DAL^L^DL^CL^ML^CF^CI^GAL^QT^PT^C^OZ^"'[CKY
QUIT "ERROR"
+22 IF "^KL^HL^DAL^L^DL^CL^ML^CF^CI^GAL^QT^PT^C^OZ^"'[CKZ
QUIT "ERROR"
+23 ; quit with no conversion
+24 IF FROM=TO
QUIT VAL_" "_TO
+25 GOTO VOL^XLFMSMT2
+26 ;;
BSA(%HT,%WT) ;;Return Body Surface Area using Dubois formula
+1 ;; Dubois formula BSA=.007184*(ht**.725)*(wt**.425)
+2 ;; %HT is height in centimeters
+3 ;; %WT is weight in Kilograms
+4 ;; eg. $$BSA(175,86)=2.02
+5 ;; or $$BSA(100,43)=1.00
+6 IF '$$VAL(%HT)
QUIT 0_"ILLEGAL NUMBER"
+7 IF '$$VAL(%WT)
QUIT 0_" ILLEGAL NUMBER"
+8 ;Q $FN(($$PWR^XLFMTH(%HT,.425)*$$PWR^XLFMTH(%WT,.725)*71.84)/10000,"",2)
+9 QUIT $FNUMBER(((%HT**.725)*(%WT**.425)*71.84)/10000,"",2)
+10 ;
TEMP(VAL,FROM,TO) ;;Convert metric temperature to U.S. temperature
+1 ;; F = fahrenheit C = celsius
+2 NEW CKY,CKZ
+3 IF '$DATA(VAL)
QUIT 0
+4 IF '$$VAL(VAL)
QUIT 0_" ILLEGAL NUMBER"
+5 SET FROM=$$UPCASE(FROM)
SET CKY="^"_FROM_"^"
SET TO=$$UPCASE(TO)
SET CKZ="^"_TO_"^"
+6 if '$LENGTH(FROM)!('$LENGTH(TO))
QUIT 0
+7 IF "^F^C^"'[CKY
QUIT "ERROR"
+8 IF "^F^C^"'[CKZ
QUIT "ERROR"
+9 IF FROM=TO
QUIT VAL_" "_TO
+10 IF TO="C"
QUIT $$FORMAT^XLFMSMT2((VAL-32)/1.8)_" "_TO
+11 IF TO="F"
QUIT $$FORMAT^XLFMSMT2(1.8*VAL+32)_" "_TO
+12 QUIT "ERROR"
VAL(X) ;
+1 IF X["."
IF $LENGTH(X)>19
QUIT 0
+2 IF $LENGTH(X)>18
QUIT 0
+3 QUIT 1
UPCASE(X) ;
+1 QUIT $TRANSLATE(X,"zxcvbnmlkjhgfdsaqwertyuiop","ZXCVBNMLKJHGFDSAQWERTYUIOP")
+2 ;
