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