source: FOIAVistA/trunk/r/GEN_MED_OTHER-GMV/GMVPCE3.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1GMVPCE3 ;HIOFO/RM,FT-V/M Data Validation for AICS ;2/5/02 15:19
2 ;;5.0;GEN. MED. REC. - VITALS;;Oct 31, 2002
3 ;
4 ; This routine uses the following IAs:
5 ; #10104 - ^XLFSTR calls (supported)
6 ;
7VALID(TYPE,X) ; This function returns 1 if rate (X) is valid for
8 ; measurement type (TYPE).
9 N FXN S FXN=0
10 I TYPE="VU" S TYPE="VC"
11 D @TYPE I $D(X) S FXN=1
12 Q FXN
13AG ; INPUT TRANSFORM FOR ABDOMINAL GIRTH
14 N UNIT S UNIT=$$UP^XLFSTR($P(X,+X,2,10)) I UNIT="" K X Q
15 S X=+X
16 I $E(UNIT)="C"&("CM"[UNIT) S X=$$CMTOIN(+X,0),UNIT="IN"
17 I $E(UNIT)="I"&("IN"[UNIT) K:+X'=X!(X>150)!(X<0)!(X?.E1"."1N.N) X
18 E K X
19 Q
20AUD ; INPUT TRANSFORM FOR AUDIOMETRY.
21 N I,R,L
22 K:X'?.N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/".N1"/" X
23 I $D(X) F I=1:1:8 S R=$P(X,"/",I) I R]"" K:+R'=R!(R>110)!(R<0) X
24 I $D(X) F I=9:1:16 S L=$P(X,"/",I) I L]"" K:+L'=L!(L>110)!(L<0) X
25 Q
26BP ; INPUT TRANSFORM FOR BLOOD PRESSURE
27 K:X'?2.3N1"/"2.3N1"/"2.3N&(X'?2.3N1"/"2.3N) X I $D(X) K:$P(X,"/",1)>300!($P(X,"/",2)>300)!(+$P(X,"/",3)>300) X
28 I $D(X),$P(X,"/")'>$P(X,"/",$L(X,"/")) K X
29 Q
30FH ; INPUT TRANSFORM FOR FUNDAL HEIGHT
31 N UNIT S UNIT=$$UP^XLFSTR($P(X,+X,2,10)) I UNIT="" K X Q
32 S X=+X
33 I $E(UNIT)="C"&("CM"[UNIT) S X=$$CMTOIN(+X,0),UNIT="IN"
34 I $E(UNIT)="I"&("IN"[UNIT) K:+X'=X!(X>50)!(X<10)!(X?.E1"."1N.N) X
35 E K X
36 Q
37FT ; INPUT TRANSFORM FOR FETAL HEART TONES
38 K:+X'=X!(X>250)!(X<50)!(X?.E1"."1N.N) X
39 Q
40HC ; INPUT TRANSFORM FOR HEAD CIRCUMFERENCE
41 N UNIT S UNIT=$$UP^XLFSTR($P(X,+X,2,10)) I UNIT="" K X Q
42 I $E(UNIT)="C"&("CM"[UNIT) D Q
43 . K:+X>76!(+X<26)!(+X?.E1"."3N.N) X
44 . I $D(X) S X=$J(.3937*(+X),0,2)
45 . Q
46 I $E(UNIT)="I" D Q
47 . K:+X>30!(+X<10)!(+X?.E1"."4N.N) X
48 . I $D(X),+X?.E1"."1N.N D
49 . . N F S F=$P(+X,".",2)
50 . . K:"^125^25^375^5^625^75^875^"'[("^"_F_"^") X
51 . . Q
52 . I $D(X) S X=+X
53 . Q
54 K X
55 Q
56HE ; INPUT TRANSFORM FOR HEARING
57 K:"^N^A^"'[("^"_$$UP^XLFSTR(X)_"^") X
58 Q
59HT ; INPUT TRANSFORM FOR HEIGHT
60 D EN3^GMVUT0 K:X=0!(X>100)!(X<1) X
61 Q
62PU ; INPUT TRANSFORM FOR PULSE
63 K:+X'=X!(X>300)!(X<0)!(X?.E1"."1N.N) X
64 Q
65RS ; INPUT TRANSFORM FOR RESPIRATION
66 K:+X'=X!(X>100)!(X<0)!(X?.E1"."1N.N) X
67 Q
68TON ; INPUT TRANSFORM FOR TONOMETRY
69 N R,L
70 K:X'?.N1"/"1N.N&(X'?1N.N1"/".N) X
71 I $D(X) S R=$P(X,"/") I R]"" K:R'=+R!(R>80)!(R<0) X
72 I $D(X) S L=$P(X,"/",2) I L]"" K:L'=+L!(L>80)!(L<0) X
73 Q
74TMP ; INPUT TRANSFORM FOR TEMPERATURE
75 K:+X'=X!(X>120)!(X<0)!(X?.E1"."3N.N) X I $D(X) S:X<45 X=$J(+X*(9/5)+32,0,1)
76 Q
77VC ; INPUT TRANSFORM FOR VISION CORRECTED (AND VISION UNCORRECTED)
78 N R,L
79 K:X'=+X&(X'?.N1"/"1N.N) X
80 I $D(X) S R=$P(X,"/") I R]"" K:R'=+R!(R>999)!(R<10) X
81 I $D(X) S L=$P(X,"/",2) I L]"" K:L'=+L!(L>999)!(L<10) X
82 Q
83WT ; INPUT TRANSFORM FOR WEIGHT
84 I $L(X)>10 K X Q
85 S GMR=$E($P(X,+X,2)) S X=$S(GMR="":0,"Kk"[GMR:+$J(2.2*(+X),0,2),"Ll"[GMR:+X,1:0) K:X>1500!(X=0)!(X<0) X K GMR
86 Q
87PN ; INPUT TRANSFORM FOR PAIN
88 K:"^0^1^2^3^4^5^6^7^8^9^10^99^"'[(U_X_U) X
89 Q
90UNITRATE(TYPE,RATE,UNIT) ; This function will add the unit of
91 ; measurement to the rate so the input transforms will work properly.
92 ; Input variables: TYPE = Measurement type
93 ; RATE = Actual measurement (passed in by ref.)
94 ; UNIT = Unit of measurement
95 ; Function value: Transormed rate with units on the end.
96 N FXN S FXN=RATE,UNIT=$G(UNIT)
97 I TYPE="AG"!(TYPE="FH")!(TYPE="HC")!(TYPE="HT") D
98 . I "^CM^IN^"'[("^"_UNIT_"^") S FXN=""
99 . E S FXN=RATE_$E(UNIT)
100 . Q
101 I TYPE="TMP" D
102 . I "^C^F^"'[("^"_UNIT_"^") S FXN=""
103 . I UNIT="C" S FXN=+$J(+RATE*(9/5)+32,0,1)
104 . Q
105 I TYPE="WT" D
106 . I "^LB^KG^"'[("^"_UNIT_"^") S FXN=""
107 . E S FXN=RATE_$E(UNIT)
108 . Q
109 Q FXN
110CMTOIN(X,PREC) ; Convert CM to IN, given CM value (X) this function will
111 ; return IN value. Optional input value of PREC for precision,
112 ; if not set, 2 decimals will be returned.
113 Q +$J(.3937*(+X),0,+$G(PREC,2))
Note: See TracBrowser for help on using the repository browser.