source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXX.m@ 794

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1PXRMXX ; SLC/PJH - Extract Patient sample;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Update ^TMP - all patients with encounters
5 ;------------------------------------------
6TMP S ^TMP(NODE,$J,"TEMP",DFN)="" Q
7 ;
8 ;Save individual encounter into FIND1
9 ;------------------------------------
10SAV S FCNT=FCNT+1,FOUND=1 M FIND1(FCNT)=FIND(ENC) Q
11 ;
12 ;Check if finding is in date range
13 ;---------------------------------
14DCHK(DNODE) ;
15 N DATE,LTERM,LTRAN,TNAM,SNUM,TERMNAM,TERMNAT
16 S DATE=$G(FIND(ENC,DNODE)) Q:DATE=""
17 ;
18 I (DATE<BD)!(DATE>ED) Q
19 ;Lab transforms
20 I REM(PXRMITEM)="VA-NATIONAL EPI LAB EXTRACT" D Q:LTRAN
21 .S LTRAN=0 D:$P(FIND(ENC,"FINDING"),";",2)="LAB(60," LTRAN
22 ;National DB term mapping
23 S TERMNAM=$P($G(FIND(ENC,"TERM")),U)
24 ;If term exists check if it needs re-mapping for this reminder
25 I TERMNAM]"" D
26 .;Get the alternate name from the REM array
27 .S TERMNAT=$G(REM(PXRMITEM,TERMNAM)) Q:TERMNAT=""
28 .;National database code
29 .S FIND(ENC,"ALTTRM")=TERMNAT
30 ;Set source number code
31 S SNUM=""
32 I $G(FIND(ENC,"FILE NUMBER"))=9000011 S SNUM=1
33 I $G(FIND(ENC,"FILE NUMBER"))=9000010.07 S SNUM=2
34 I $G(FIND(ENC,"FILE NUMBER"))=45 S SNUM=3
35 S FIND(ENC,"S/N")=SNUM
36 ;
37 ;Save encounter
38 D SAV
39 Q
40 ;
41 ;Check for findings
42 ;------------------
43FCHEK(PXRMITEM) ;
44 N ECNT,EDATE,ENC,LDONE,FOUND
45 ;Get reminder name
46 S PXRMNAM=$P($G(^PXD(811.9,PXRMITEM,0)),U)
47 ;Check each encounter
48 S ENC=0,ECNT=0,FOUND=0,LDONE=0
49 F S ENC=$O(FIND(ENC)) Q:'ENC D
50 .;Ignore medications - these are loaded from pharmacy
51 .I $D(FIND(ENC,"DRUG")) Q
52 .;Check if finding is in date range
53 .I $D(FIND(ENC,"FINDING")) D DCHK("DATE")
54 ;
55 Q
56 ;
57 ;Update ^TMP - all patients with findings
58 ;----------------------------------------
59FSAVE N CNT,FIEN,FCNT,FUNIQ,FREC
60 N VDATA,VDATE,VFOUND,VLAST,VIEN,VLTYP,VOK,VSERV,VTYP
61 ;Extract the visit date and type from visit record
62 S CNT=0,FUNIQ=0,VLAST=0,VFOUND=0,VLTYP=""
63 F S CNT=$O(FIND1(CNT)) Q:'CNT D
64 .S VOK=0
65 .I $D(FIND1(CNT,"VIEN")) D
66 ..S VIEN=$G(FIND1(CNT,"VIEN")) Q:'VIEN
67 ..S VDATA=$G(^AUPNVSIT(VIEN,0)) Q:VDATA=""
68 ..;Get visit date and service from visit record
69 ..S VDATE=$P(VDATA,U),VSERV=$P(VDATA,U,7),VFOUND=1,VOK=1,VTYP="O"
70 ..;Calculate visit type from sevice
71 ..I (VSERV="D")!(VSERV="H")!(VSERV="I") S VTYP="I"
72 .;If no visit info default to finding date
73 .I 'VOK S VDATE=$G(FIND1(CNT,"DATE")),VTYP="O" D
74 ..N VAIN,VAINDT S VAINDT=VDATE D INP^VADPT
75 ..I $G(VAIN(7))'="" S VTYP="I"
76 .;Save encounter/finding date and type
77 .S FIND1(CNT)=VDATE_U_VTYP
78 .;Save count by finding for report
79 .S FIEN=$G(FIND1(CNT,"FINDING")) I FIEN="" S FIEN="NO FINDING"
80 .S FREC=$G(PXRMFIEN(FIEN)),FCNT=$P(FREC,U),FUNIQ=$P(FREC,U,2)
81 .S FCNT=FCNT+1 I '$G(FUNIQ(FIEN)) S FUNIQ=FUNIQ+1
82 .S PXRMFIEN(FIEN)=FCNT_U_FUNIQ,FUNIQ(FIEN)=1
83 .;Save most recent
84 .I VDATE>VLAST S VLAST=VDATE,VLTYP=VTYP
85 ;
86 ;Save patient
87 S ^TMP(NODE,$J,DFN)=VLAST_U_VLTYP
88 ;Save findings
89 M ^TMP(NODE,$J,DFN,"FIND")=FIND1
90 ;
91 Q
92 ;
93 ;Check each patient for findings
94 ;-------------------------------
95FIND N BD,DFN,ED,LAB,LABN,PXRMITEM,PXRMNAM,OR,REM,SAVE,SEARCH
96 ;
97 ;Build array of reminders and terms to be re-mapped
98 ;
99 ;This requires that LAB(69.51) is created to include a list of IEN's
100 ;
101 S PXRMITEM=0
102 F S PXRMITEM=$O(^LAB(69.51,"B",PXRMITEM)) Q:'PXRMITEM D
103 .S PXRMNAM=$P($G(^PXD(811.9,PXRMITEM,0)),U)
104 .I PXRMNAM'="VA-NATIONAL EPI RX EXTRACT" S REM(PXRMITEM)=PXRMNAM
105 .;Get finding list for these reminders and medication list
106 .D REM^PXRMXX1(PXRMITEM,.SEARCH,.LAB)
107 .;Hep A,B,C lab tests
108 .S LABN("HEP C VIRUS ANTIBODY POSITIVE")=""
109 .S LABN("HEP C VIRUS ANTIBODY NEGATIVE")=""
110 .S LABN("HAV Ab positive")=""
111 .S LABN("HAV IgM Ab positive")=""
112 .S LABN("HAV IgG positive")=""
113 .S LABN("HBs Ab positive")=""
114 .S LABN("HBs Ag positive")=""
115 .S LABN("HBc Ab IgM positive")=""
116 .S LABN("HBe Ag positive")=""
117 .;NDB Transformations
118 .I PXRMNAM="VA-HEP C RISK ASSESSMENT" D
119 ..S REM(PXRMITEM,"VA-DECLINED HEP C RISK ASSESSMENT")=1
120 ..S REM(PXRMITEM,"VA-NO RISK FACTORS FOR HEP C")=2
121 ..S REM(PXRMITEM,"VA-PREVIOUSLY ASSESSED HEP C RISK")=3
122 ..S REM(PXRMITEM,"VA-RISK FACTOR FOR HEPATITIS C")=4
123 ..S REM(PXRMITEM,"VA-HEP C VIRUS ANTIBODY POSITIVE")=5
124 ..S REM(PXRMITEM,"VA-HEP C VIRUS ANTIBODY NEGATIVE")=6
125 ..S REM(PXRMITEM,"VA-HEPATITIS C INFECTION")=7
126 ;
127 ;Build pharmacy codes list
128 F FTYPE="PSNDF(50.6,","PSDRUG(","PS(50.605," D
129 .S FIEN=""
130 .F S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN D
131 ..S OR(FIEN_";"_FTYPE)=""
132 ;
133 ;Search for pharmacy outpatients
134 I $O(OR(""))]"" D EN^PSOORAPI(PXRMBDT,PXRMEDT,.OR,"F","PXRMPSO"_NODE)
135 ;
136 ;Search for pharmacy inpatients
137 I $O(OR(""))]"" D EN^PSJORAPI(PXRMBDT,PXRMEDT,.OR,"","PXRMPSI"_NODE)
138 ;
139 ;Build Lab codes list
140 S FTYPE="LAB(60,",FIEN="" K OR
141 F S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN D
142 .S OR(FIEN)=""
143 ;
144 ;Search for lab patients
145 I $O(OR(""))]"" D LAB^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)
146 ;
147 ;Build Health Factors list
148 S FTYPE="AUTTHF(",FIEN="" K OR
149 F S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN D
150 .S OR(FIEN)=""
151 ;
152 ;Search for HF patients
153 I $O(OR(""))]"" D HF^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)
154 ;
155 ;Build Patient Education list
156 S FTYPE="AUTTEDT(",FIEN="" K OR
157 F S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN D
158 .S OR(FIEN)=""
159 ;
160 ;Search for PED patients
161 I $O(OR(""))]"" D PED^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)
162 ;
163 ;Build Examination list
164 S FTYPE="AUTTEXAM(",FIEN="" K OR
165 F S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN D
166 .S OR(FIEN)=""
167 ;
168 ;Search for Exam patients
169 I $O(OR(""))]"" D EXAM^PXRMXX2(PXRMBDT,PXRMEDT,.OR,NODE)
170 ;
171 ;Build POV codes list
172 S FTYPE="ICD9(",FIEN="" K OR
173 F S FIEN=$O(SEARCH(FTYPE,FIEN)) Q:'FIEN D
174 .S OR(FIEN)="",^TMP("PXRMPOV"_NODE,$J,FIEN)=""
175 ;
176 ;Search for POV patients
177 I $O(OR(""))]"" D POV^PXRMXX2(PXRMBDT,PXRMEDT,"PXRMPOV"_NODE,NODE)
178 ;
179 S BD=PXRMBDT-.0001,ED=PXRMEDT+.2359,DFN=""
180 F S DFN=$O(^TMP(NODE,$J,"TEMP",DFN)) Q:'DFN Q:TSTOP=1 D
181 .;Check if stop task requested
182 .I $$S^%ZTLOAD S TSTOP=1 Q
183 .;Update total patient count for report
184 .S PXRMCNT=PXRMCNT+1
185 .N FIND1,FCNT
186 .;Process reminders
187 .S PXRMITEM=0,FCNT=0
188 .F S PXRMITEM=$O(REM(PXRMITEM)) Q:'PXRMITEM D
189 ..;Check reminder exists
190 ..Q:'$D(^PXD(811.9,PXRMITEM,0))
191 ..;Evaluate reminder to obtain list of findings
192 ..N FIND
193 ..D FIDATA^PXRM(DFN,PXRMITEM,.FIND)
194 ..;Check if findings exist for the date range
195 ..D FCHEK(PXRMITEM)
196 .;Save in ^TMP
197 .I FCNT D FSAVE K FIND1 S PXRMFCNT=PXRMFCNT+1
198 ;
199 ;Merge in patients from Outpatient Pharmacy
200 D PSMERG^PXRMXX1("PXRMPSO",NODE,.SEARCH)
201 ;Merge in patients from Inpatient Pharmacy
202 D PSMERG^PXRMXX1("PXRMPSI",NODE,.SEARCH)
203 ;
204 Q
205 ;
206 ;Complex logic to handle lab/reminder mismatches
207 ;-----------------------------------------------
208LTRAN S LTERM=$P($G(FIND(ENC,"TERM")),U) Q:LTERM=""
209 ;Skip terms not used in cohort logic
210 I $D(LAB(LTERM)) S LTRAN=1 Q
211 ;If one of selected list send the latest out of cohort entries instead
212 I $D(LABN(LTERM)) S LTRAN=1 Q:LDONE=1 D
213 .N ENC,TERM,DATE
214 .S ENC=0,LDONE=1
215 .F S ENC=$O(FIND(ENC)) Q:'ENC D
216 ..S TERM=$P($G(FIND(ENC,"TERM")),U) Q:TERM=""
217 ..;Check if the term is in the out of cohort list
218 ..I $D(LAB(TERM)) D
219 ...;Check if lab test is within date range or prior
220 ...S DATE=$G(FIND(ENC,"DATE")) Q:DATE="" Q:DATE>ED
221 ...D SAV
222 ;
223 Q
224 ;
225 ;
226 ;Entry point for API
227 ;-------------------
228PATS(PXRMBDT,PXRMEDT,NODE) ;
229 ;
230 ; PXRMBDT - Start date in fileman format
231 ; PXRMEDT - End date in fileman format
232 ; NODE - Target name for ^TMP(NODE,$J)
233 ;
234 ;Task stopped
235 N TSTOP S TSTOP=0
236 ;
237 ;
238 ;Build temporary array of all wards
239 ;N PXRMLCHL,PXRMLOCN D LCHL^PXRMXAP(1,.PXRMLCHL)
240 ;
241 ;Patients, patients with findings, finding and term counts
242 N PXRMCNT,PXRMFCNT,PXRMFIEN,PXRMTIEN S PXRMCNT=0,PXRMFCNT=0
243 ;
244 ;Clear ^TMP
245 K ^TMP(NODE,$J)
246 ;Current inpatients
247 ;D INP
248 ;Inpatient admissions
249 ;D ADM
250 ;Outpatient visits
251 ;D VISITS Q:TSTOP=1
252 ;
253 ;Check for findings in the selected patients
254 D FIND Q:TSTOP=1
255 ;
256 ;Save report
257 D REPORT^PXRMXX1(NODE)
258 ;
259 ;Remove list of all patients with encounters
260 K ^TMP(NODE,$J,"TEMP")
261 ;Remove pharmacy outpatient list
262 K ^TMP("PXRMPSO"_NODE,$J)
263 ;Remove pharmacy inpatient list
264 K ^TMP("PXRMPSI"_NODE,$J)
265 ;Remove icd9 list
266 K ^TMP("PXRMPOV"_NODE,$J)
267 Q
268 ;
269 ;Build list of inpatients admissions
270 ;-----------------------------------
271ADM N HLOCIEN,IC,DFN,BD,ED
272 ;Get admissions for each selected location
273 F IC=1:1 Q:'$D(PXRMLCHL(IC)) D
274 .S HLOCIEN=$P(PXRMLCHL(IC),U,2) Q:HLOCIEN=""
275 .; Get admissions from patient movements and return DFN's in PATS
276 .S BD=PXRMBDT-.0001
277 .S ED=PXRMEDT+.2359
278 .N PATS D ADM^PXRMXAP(HLOCIEN,.PATS,BD,ED)
279 .;Build ^TMP for selected patients
280 .S DFN=""
281 .F S DFN=$O(PATS(DFN)) Q:DFN="" D TMP
282 Q
283 ;
284 ;Build list of Current inpatients
285 ;--------------------------------
286INP N HLOCIEN,IC,DFN
287 ;Get Current inpatients for each location
288 F IC=1:1 Q:'$D(PXRMLCHL(IC)) D
289 .S HLOCIEN=$P(PXRMLCHL(IC),U,2) Q:HLOCIEN=""
290 .;Get WARDIEN,WARDNAM and return DFN's in PATS
291 .N PATS D WARD^PXRMXAP(HLOCIEN,.PATS)
292 .;Build ^TMP for selected patients
293 .S DFN=""
294 .F S DFN=$O(PATS(DFN)) Q:DFN="" D TMP
295 Q
296 ;
297 ;Scan visit file to build list of patients
298 ;-----------------------------------------
299VISITS N BD,DFN,ED,HLOCIEN,IC,VIEN,VISIT
300 ;
301 S BD=PXRMBDT-.0001
302 S ED=PXRMEDT+.2359
303 ;Get Date ; DBIA #2028
304 F S BD=$O(^AUPNVSIT("B",BD)) Q:BD>ED Q:BD="" Q:TSTOP=1 D
305 .S VIEN=0
306 .;Get individual visit
307 .F S VIEN=$O(^AUPNVSIT("B",BD,VIEN)) Q:VIEN="" Q:TSTOP=1 D
308 ..;Check if stop task requested
309 ..I $$S^%ZTLOAD S TSTOP=1 Q
310 ..;Screen Individual Visit
311 ..S VISIT=$G(^AUPNVSIT(VIEN,0)) Q:VISIT=""
312 ..;Patient IEN
313 ..S DFN=$P(VISIT,U,5) Q:'DFN
314 ..;Build patient list in ^TMP
315 ..D TMP
316 Q
Note: See TracBrowser for help on using the repository browser.