LRAFUNC6 ;SLC/MRH/FHS - FUNCTION CALLS CONVERSION IN MEASUREMENT A5AFUNC6
;;5.2;LAB SERVICE;;Sep 27, 1994
;
N I,X
W !!,"Routine: "_$T(+0),! F I=8:1 S X=$T(LRAFUNC6+I) Q:'$L(X) I X[";;" W !,X
W !!
Q
;
LENGTH(X,Y,Z) ;; convert metric length to U.S. length 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=$$LENGTH(12,"IN","CM") will return a value of X (12)
;; in centimeters
;; Valid units are in either uppercase or lowercase are:
;; km = kilometers
;; m = meters
;; cm = centimeters
;; mm = millimeters
;; mi = miles
;; yd = yards
;; ft = feet
;; in = inches
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 "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKY Q "ERROR"
S CKZ=U_Z_U
I "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKZ Q "ERROR"
; quit with no conversion
I Y=Z Q X_" "_Z
;
; -***- common metric unit is centimeters CM -***-
I $P("^KM^1^M^1^CM^1^MM^1",CKY,2) S X=X*+$P("^KM^100000^M^100^CM^1^MM^.1",CKY,2)_"M"
;
; -***- common U.S. unit is inches IN -***-
I $P("^MI^1^YD^1^FT^1^IN^1",CKY,2) S X=X*$P("^MI^63360^YD^36^FT^12^IN^1",CKY,2)_"U"
;
; X in metric (cm) and will convert to metric
I X["M",$P("^KM^1^M^1^CM^1^MM^1",CKZ,2) S X=X*$P("^KM^.001^M^.01^CM^1^MM^10^",CKZ,2) Q $$FORMAT(X)_" "_Z
;
; X in U.S. and will convert to U.S.
I X["U",$P("^MI^1^YD^1^FT^1^IN^1",CKZ,2) S X=X*$P("^MI^.0000158^YD^.027778^FT^.083338^IN^1",CKZ,2) Q $$FORMAT(X)_" "_Z
;
; X in U.S. and will convert to metric
I X["U",$P("^KM^1^M^1^CM^1^MM^1",CKZ,2) S X=X*$P("^KM^.0000254^M^.0254^CM^2.540^MM^25.4",CKZ,2) Q $$FORMAT(X)_" "_Z
;
; X in metric (cm) and will convert to U.S.
I X["M",$P("^MI^1^YD^1^FT^1^IN^1",CKZ,2) S X=X*$P("^MI^.0000062^YD^.010936^FT^.032808^IN^.393696",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[HLRAFUNC6 2404 printed Sep 23, 2025@19:42:24 Page 2
LRAFUNC6 ;SLC/MRH/FHS - FUNCTION CALLS CONVERSION IN MEASUREMENT A5AFUNC6
+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(LRAFUNC6+I)
if '$LENGTH(X)
QUIT
IF X[";;"
WRITE !,X
+5 WRITE !!
+6 QUIT
+7 ;
LENGTH(X,Y,Z) ;; convert metric length to U.S. length 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=$$LENGTH(12,"IN","CM") will return a value of X (12)
+7 ;; in centimeters
+8 ;; Valid units are in either uppercase or lowercase are:
+9 ;; km = kilometers
+10 ;; m = meters
+11 ;; cm = centimeters
+12 ;; mm = millimeters
+13 ;; mi = miles
+14 ;; yd = yards
+15 ;; ft = feet
+16 ;; in = inches
+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 "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKY
QUIT "ERROR"
+25 SET CKZ=U_Z_U
+26 IF "^KM^M^CM^MM^MI^YD^FT^IN^"'[CKZ
QUIT "ERROR"
+27 ; quit with no conversion
+28 IF Y=Z
QUIT X_" "_Z
+29 ;
+30 ; -***- common metric unit is centimeters CM -***-
+31 IF $PIECE("^KM^1^M^1^CM^1^MM^1",CKY,2)
SET X=X*+$PIECE("^KM^100000^M^100^CM^1^MM^.1",CKY,2)_"M"
+32 ;
+33 ; -***- common U.S. unit is inches IN -***-
+34 IF $PIECE("^MI^1^YD^1^FT^1^IN^1",CKY,2)
SET X=X*$PIECE("^MI^63360^YD^36^FT^12^IN^1",CKY,2)_"U"
+35 ;
+36 ; X in metric (cm) and will convert to metric
+37 IF X["M"
IF $PIECE("^KM^1^M^1^CM^1^MM^1",CKZ,2)
SET X=X*$PIECE("^KM^.001^M^.01^CM^1^MM^10^",CKZ,2)
QUIT $$FORMAT(X)_" "_Z
+38 ;
+39 ; X in U.S. and will convert to U.S.
+40 IF X["U"
IF $PIECE("^MI^1^YD^1^FT^1^IN^1",CKZ,2)
SET X=X*$PIECE("^MI^.0000158^YD^.027778^FT^.083338^IN^1",CKZ,2)
QUIT $$FORMAT(X)_" "_Z
+41 ;
+42 ; X in U.S. and will convert to metric
+43 IF X["U"
IF $PIECE("^KM^1^M^1^CM^1^MM^1",CKZ,2)
SET X=X*$PIECE("^KM^.0000254^M^.0254^CM^2.540^MM^25.4",CKZ,2)
QUIT $$FORMAT(X)_" "_Z
+44 ;
+45 ; X in metric (cm) and will convert to U.S.
+46 IF X["M"
IF $PIECE("^MI^1^YD^1^FT^1^IN^1",CKZ,2)
SET X=X*$PIECE("^MI^.0000062^YD^.010936^FT^.032808^IN^.393696",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")
