1 | WVUTL1 ;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 | ;
|
---|
9 | NAME(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 | ;
|
---|
16 | DOB(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 | ;
|
---|
24 | AGE(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 | ;
|
---|
36 | DECEASED(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 | ;
|
---|
44 | SEX(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 | ;
|
---|
52 | INACT(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 | ;
|
---|
59 | AGEAT(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 | ;
|
---|
72 | NAMAGE(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 | ;
|
---|
78 | SSN(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 | ;
|
---|
89 | HRCN(DFN) ;EP
|
---|
90 | ;---> RETURN SSN.
|
---|
91 | ;---> REQUIRED VARIABLE: DFN
|
---|
92 | Q $$SSN(DFN)
|
---|
93 | ;
|
---|
94 | HPHONE(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 | ;
|
---|
103 | STREET(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 | ;
|
---|
112 | CITY(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 | ;
|
---|
121 | STATE(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 | ;
|
---|
131 | ZIP(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 | ;
|
---|
140 | CTYSTZ(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 | ;
|
---|
146 | CMGR(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 | ;
|
---|
155 | PERSON(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 | ;
|
---|
162 | EDC(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 | ;
|
---|
174 | PAPRG(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 | ;
|
---|
185 | PAPRG1(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 | ;
|
---|
192 | CNEED(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 | ;
|
---|
205 | BNEED(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 | ;
|
---|
218 | DES(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 | ;
|
---|
228 | FAMHX(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 | ;
|
---|
239 | REFS(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 | ;
|
---|
248 | ENRLDT(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 | ;
|
---|
259 | Z(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 | ;
|
---|
267 | ACC(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)
|
---|