Routine: LRAFUNC6

LRAFUNC6 ; IHS/DIR/FJE - FUNCTION CALLS CONVERSION IN MEASUREMENT A5AFUNC6 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;;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 !!

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")

LRAFUNC6  ; IHS/DIR/FJE - FUNCTION CALLS CONVERSION IN MEASUREMENT A5AFUNC6 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4       ;

 +5        NEW I,X

 +6        WRITE !!,"Routine: "_$TEXT(+0),!

           FOR I=8:1

               SET X=$TEXT(LRAFUNC6+I)

               IF '$LENGTH(X)

                   QUIT

               IF X[";;"

                   WRITE !,X

 +7        WRITE !!

 +8        QUIT

 +9       ;

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")

LRAFUNC6.m