- 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 Mar 13, 2025@21:07:42 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 ;
