source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVUTL1.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 7.2 KB
Line 
1WVUTL1 ;HCIOFO/FT,JR-UTIL: MOSTLY PATIENT DATA ;10/11/99 14:31
2 ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; UTILITY: PATIENT DEMOGRAPHICS, NEEDS, AND REGIMENS.
6 ;; ALSO DISPLAY PRIORITY, PROCEDURE TYPE.
7 ;
8 ;
9NAME(DFN) ;EP
10 ;---> PATIENT NAME.
11 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
12 Q:'$G(DFN) "NO PATIENT"
13 Q:'$D(^DPT(DFN,0)) "UNKNOWN"
14 Q $P(^DPT(DFN,0),U)
15 ;
16DOB(DFN) ;EP
17 ;---> RETURN PATIENT'S DATE OF BIRTH IN FILEMAN FORMAT.
18 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
19 Q:'$G(DFN) "NO PATIENT"
20 Q:'$P($G(^DPT(DFN,0)),U,3) "UNKNOWN"
21 Q $P(^DPT(DFN,0),U,3)
22 ;
23 ;
24AGE(DFN) ;EP
25 ;---> YIELD PATIENT'S AGE IN YEARS.
26 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
27 N X,X1,X2
28 Q:'$G(DFN) "NO PATIENT"
29 S X2=$$DOB(DFN)
30 Q:'+X2 "UNKNOWN"
31 I $$DECEASED(DFN) Q "DECEASED: "_$$SLDT2^WVUTL5(+^DPT(DFN,.35))
32 S X1=DT
33 D ^%DTC
34 Q $P(X/365.25,".")_"y/o"
35 ;
36DECEASED(DFN) ;EP
37 ;---> RETURN 1 IF PATIENT IS DECEASED, 0 IF NOT DECEASED.
38 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
39 Q:'$G(DFN) 0
40 Q:'$D(^DPT(DFN,.35)) 0
41 Q:'+^DPT(DFN,.35) 0
42 Q 1
43 ;
44SEX(DFN) ;EP
45 ;---> RETURN 1 IF PATIENT IS FEMALE.
46 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
47 Q:'$G(DFN) ""
48 Q:'$D(^DPT(DFN,0)) ""
49 Q:$P(^DPT(DFN,0),U,2)'="F" ""
50 Q 1
51 ;
52INACT(DFN) ;EP
53 ;---> DATE THIS PATIENT BECAME INACTIVE
54 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
55 Q:'$G(DFN) "NO PATIENT"
56 Q:'$D(^DPT(DFN,0)) "UNKNOWN"
57 Q $P(^WV(790,DFN,0),U,24)
58 ;
59AGEAT(DFN,DATE) ;EP
60 ;---> YIELD PATIENT'S AGE IN YEARS AT GIVEN DATE.
61 ;---> REQUIRED VARIABLE: DFN =IEN PATIENT FILE
62 ;---> DATE=DATE AT WHICH AGE IS DESIRED.
63 N X,X1,X2
64 Q:'$G(DFN) "NO PATIENT"
65 Q:'$G(DATE) "NO DATE"
66 S X2=$$DOB(DFN)
67 Q:'+X2 "UNKNOWN"
68 S X1=DATE
69 D ^%DTC
70 Q $P(X/365.25,".")_"y/o"
71 ;
72NAMAGE(DFN) ;EP
73 ;---> PATIENT NAME CONCAT WITH AGE.
74 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
75 Q:'$G(DFN) "NO PATIENT"
76 Q $$NAME(DFN)_" ("_$$AGE(DFN)_")"
77 ;
78SSN(DFN) ;EP
79 ;---> SOCIAL SECURITY NUMBER.
80 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
81 N X
82 Q:'$G(DFN) "NO PATIENT"
83 Q:'$D(^DPT(DFN,0)) "UNKNOWN"
84 S X=$P(^DPT(DFN,0),U,9)
85 Q:X']"" "UNKNOWN"
86 S X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
87 Q X
88 ;
89HRCN(DFN) ;EP
90 ;---> RETURN SSN.
91 ;---> REQUIRED VARIABLE: DFN
92 Q $$SSN(DFN)
93 ;
94HPHONE(DFN) ;EP
95 ;---> GET HOME PHONE#.
96 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
97 N WVPHONE
98 Q:'$G(DFN) "NO PATIENT"
99 S WVPHONE=$$GET1^DIQ(2,DFN,.131,"I")
100 Q:WVPHONE="" "UNKNOWN"
101 Q WVPHONE
102 ;
103STREET(DFN) ;EP
104 ;---> GET STREET ADDRESS.
105 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
106 Q:'$G(DFN) "NO PATIENT"
107 N WVADDR
108 S WVADDR=$$GET1^DIQ(2,DFN,.111,"I")
109 Q:WVADDR="" "UNKNOWN"
110 Q WVADDR
111 ;
112CITY(DFN) ;EP
113 ;---> GET CITY ADDRESS.
114 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
115 Q:'$G(DFN) "NO PATIENT"
116 N WVCITY
117 S WVCITY=$$GET1^DIQ(2,DFN,.114,"I")
118 Q:WVCITY="" "UNKNOWN"
119 Q WVCITY
120 ;
121STATE(DFN) ;EP
122 ;---> GET STATE ADDRESS.
123 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
124 Q:'$G(DFN) "NO PATIENT"
125 N WVSTATE
126 S WVSTATE=$$GET1^DIQ(2,DFN,.115,"I")
127 Q:WVSTATE="" "UNKNOWN"
128 S WVSTATE=$$GET1^DIQ(5,WVSTATE,1,"I") S:WVSTATE="" WVSTATE="UNKNOWN"
129 Q WVSTATE
130 ;
131ZIP(DFN) ;EP
132 ;---> GET ZIPCODE ADDRESS.
133 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
134 Q:'$G(DFN) "NO PATIENT"
135 N WVZIP
136 S WVZIP=$$GET1^DIQ(2,DFN,.116,"I")
137 Q:WVZIP'>0 "UNKNOWN"
138 Q WVZIP
139 ;
140CTYSTZ(DFN) ;EP
141 ;---> GET ZIPCODE ADDRESS.
142 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
143 Q:'$G(DFN) "NO PATIENT"
144 Q $$CITY(DFN)_", "_$$STATE(DFN)_" "_$$ZIP(DFN)
145 ;
146CMGR(DFN) ;EP
147 ;---> YIELD PATIENT'S CASE MANAGER.
148 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
149 N X
150 Q:'$G(DFN) "NO PATIENT"
151 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
152 S X=$P(^WV(790,DFN,0),U,10)
153 Q $$PERSON(X)
154 ;
155PERSON(X) ;EP
156 ;---> RETURN PERSON'S NAME FROM FILE #200.
157 N WVNAME
158 Q:'X "UNKNOWN"
159 S WVNAME=$$GET1^DIQ(200,X,.01,"E")
160 Q $S(WVNAME'="":WVNAME,1:"UNKNOWN")
161 ;
162EDC(DFN) ;EP
163 ;---> YIELD IF PATIENT IS PREGNANT, AND EDC.
164 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
165 N X,Y
166 Q:'$G(DFN) "NO PATIENT"
167 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
168 S Y=$P(^WV(790,DFN,0),U,13)
169 S X=$P(^WV(790,DFN,0),U,14)
170 Q:'Y ""
171 S Y=" PREGNANT"
172 Q Y_", EDC: "_$S(X:$$SLDT2^WVUTL5(X),1:"NO DATE ")_" "
173 ;
174PAPRG(DFN,TXDT) ;EP
175 ;---> YIELD PATIENT'S PAP REGIMEN AND DATE IT BEGAN.
176 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
177 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
178 N Y,X
179 Q:'$G(DFN) "NO PATIENT"
180 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
181 S Y=$P(^WV(790,DFN,0),U,16)
182 S X=$P(^WV(790,DFN,0),U,17) D Z(.X,$G(TXDT))
183 Q $$PAPRG1(Y)_" (began "_X_")"
184 ;
185PAPRG1(PREG) ;EP
186 ;---> YIELD PATIENT'S PAP REGIMEN.
187 ;---> REQUIRED VARIABLE: PREG=IEN IN WV PAP REGIMEN FILE #790.03.
188 Q:'$G(PREG) "UNKNOWN"
189 Q:'$D(^WV(790.03,PREG,0)) "PAP REGIMEN MISSING"
190 Q $P(^WV(790.03,PREG,0),U)
191 ;
192CNEED(DFN,TXDT) ;PEP
193 ;---> YIELD PATIENT'S CX TX NEED AND CX TX NEED DUE DATE.
194 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
195 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
196 N X,Y
197 Q:'$G(DFN) "NO PATIENT"
198 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
199 S Y=$P(^WV(790,DFN,0),U,11)
200 Q:'Y "UNKNOWN"
201 Q:'$D(^WV(790.5,Y,0)) "UNKNOWN"
202 S X=$P(^WV(790,DFN,0),U,12) D Z(.X,$G(TXDT))
203 Q $E($P(^WV(790.5,Y,0),U),1,22)_" (by "_X_")"
204 ;
205BNEED(DFN,TXDT) ;PEP
206 ;---> YIELD PATIENT'S BR TX NEED AND BR TX NEED DUE DATE.
207 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
208 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE TEXT FORMAT.
209 N X,Y,Z
210 Q:'$G(DFN) "NO PATIENT"
211 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
212 S Y=$P(^WV(790,DFN,0),U,18)
213 Q:'Y "UNKNOWN"
214 Q:'$D(^WV(790.51,Y,0)) "UNKNOWN"
215 S X=$P(^WV(790,DFN,0),U,19) D Z(.X,$G(TXDT))
216 Q $E($P(^WV(790.51,Y,0),U),1,22)_" (by "_X_")"
217 ;
218DES(DFN) ;EP
219 ;---> YIELD PATIENT'S STATUS AS A DES DAUGHTER: 1=YES, 0=NO.
220 ;---> DFN=IEN PATIENT FILE
221 Q:'$G(DFN) "NO PATIENT"
222 Q:'$D(^WV(790,DFN,0)) "NO RECORD"
223 I '$$VFIELD^DILFD(790,.15) Q "^DD MISSING"
224 S X=$P(^WV(790,DFN,0),U,15)
225 Q:X="" ""
226 Q $$EXTERNAL^DILFD(790,.15,"",X)
227 ;
228FAMHX(DFN) ;EP
229 ;---> RETURN FAMILY HISTORY OF BREAST CANCER.
230 ;---> DFN=IEN PATIENT FILE
231 N X
232 Q:'$G(DFN) "NO PATIENT"
233 Q:'$D(^WV(790,DFN,0)) "NO RECORD"
234 I '$$VFIELD^DILFD(790,.23) Q "^DD MISSING"
235 S X=$P(^WV(790,DFN,0),U,23)
236 Q:X="" ""
237 Q $$EXTERNAL^DILFD(790,.23,"",X)
238 ;
239REFS(DFN) ;EP
240 ;---> RETURN REFERRAL SOURCE FOR THIS PATIENT.
241 ;---> DFN=IEN PATIENT FILE
242 Q:'$G(DFN) "NO PATIENT"
243 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
244 I '$$VFIELD^DILFD(790,.22) Q "^DD MISSING"
245 S X=$P(^WV(790,DFN,0),U,22) S:X>0 X=$P($G(^WV(790.07,X,0)),U)
246 Q X
247 ;
248ENRLDT(DFN,TXDT) ;PEP
249 ;---> YIELD PATIENT'S ENROLLMENT DATE.
250 ;---> REQUIRED VARIABLE: DFN=IEN PATIENT FILE
251 ;---> OPTIONAL VARIABLE: TXDT=1 IF DATE SHOULD BE IN TEXT FORMAT.
252 N X
253 Q:'$G(DFN) "NO PATIENT"
254 Q:'$D(^WV(790,DFN,0)) "UNKNOWN"
255 S X=$P(^WV(790,DFN,0),U,21)
256 Q:'X "" D Z(.X,$G(TXDT))
257 Q X
258 ;
259Z(X,Z) ;EP
260 ;---> SET Z = NUMERIC (1/1/95) OR TEXT (JAN 1,1995) FORMAT OF DATE.
261 ;---> REQUIRED VARIABLE: X=FILEMAN INTERNAL DATE FORMAT.
262 ;---> OPTIONAL VARIABLE: Z=1 IF TEXT, 0/"" IF NUMERIC.
263 S X=$S($G(Z):$$TXDT^WVUTL5(X),1:$$SLDT2^WVUTL5(X))
264 Q
265 ;
266 ;
267ACC(IEN) ;EP
268 ;---> ACCESSION#; CONCATENATE SCREENING PAP IF IT EXISTS.
269 ;---> IEN=IEN IN WV PROCEDURE FILE #790.1).
270 Q:'$G(IEN) "NO PROC"
271 Q:'$D(^WV(790.1,IEN,0)) "NO PROC"
272 N X S X=$P(^WV(790.1,IEN,0),U,30)
273 I X]"" I $D(^WV(790.1,X,0)) S X=$P(^WV(790.1,X,0),U),X=","_X
274 Q $E($P(^WV(790.1,IEN,0),U)_X,1,19)
Note: See TracBrowser for help on using the repository browser.