source: qrda/C0Q/trunk/p/C0QMU12.m@ 1335

Last change on this file since 1335 was 1335, checked in by George Lilly, 13 years ago

latest C0Q changes with parameters
File size: 34.0 KB
Line 
1C0QMU12 ;JJOH/ZAG/GPL - Patient Reminder List for 2012 ;7/5/11 8:50pm
2 ;;1.0;MU PACKAGE;;;Build 20
3 ;
4 ;2011 Zach Gonzales<zach@linux.com> - Licensed under the terms of the GNU
5 ;General Public License See attached copy of the License.
6 ;
7 ;This program is free software; you can redistribute it and/or modify
8 ;it under the terms of the GNU General Public License as published by
9 ;the Free Software Foundation; either version 2 of the License, or
10 ;(at your option) any later version.
11 ;
12 ;This program is distributed in the hope that it will be useful,
13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;GNU General Public License for more details.
16 ;
17 ;You should have received a copy of the GNU General Public License along
18 ;with this program; if not, write to the Free Software Foundation, Inc.,
19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 ;
21 ; GPL - THIS ROUTINE IS A COPY OF JJOHMU11 THAT HAS BEEN MODIFIED
22 ; FOR MEANINGFUL USE CALCULATION FOR FISCAL YEAR 2012 AT OROVILLE HOSPITAL
23 ;
24BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
25 ; patient lists
26 ;N GRSLT ; ARRAY FOR RESULTS
27 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
28 I '$D(C0QPR) S C0QPR=0 ;default don't print out results
29 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
30 S ZYR="MU12-"
31 N G1 ; ONE SET OF VALUES - RNF1 FORMAT
32 ; INITIALIZE LISTS
33 ; this is done so that if there are no matching patients, the patient list
34 ; will be zeroed out
35 S C0QLIST(ZYR_"HasDemographics")=""
36 S C0QLIST(ZYR_"Patient")=""
37 S C0QLIST(ZYR_"HasProblem")=""
38 S C0QLIST(ZYR_"HasAllergy")=""
39 S C0QLIST(ZYR_"HasMed")=""
40 S C0QLIST(ZYR_"HasVitalSigns")=""
41 S C0QLIST(ZYR_"HasMedOrders")=""
42 S C0QLIST(ZYR_"HasSmokingStatus")=""
43 D ALL ; all currently admitted patients in the hospital
44 D DIS ; all patients discharged since the reporting period began
45 I C0QSS ZWR GRSLT
46 D ICUPAT ; GENERATE ICU PATIENT LIST
47 I C0QPL D ;
48 . D FILE ; FILE THE PATIENT LISTS
49 . D UPDATE^C0QUPDT(.G,10) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR
50 . D UPDATE^C0QUPDT(.G,11) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR
51 Q
52 ;
53ALL ;retrieve active inpatients
54 N WARD S WARD=""
55 F D Q:WARD=""
56 . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
57 . Q:WARD=""
58 . N WIEN S WIEN=""
59 . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN
60 . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
61 . . N DFN,RB S DFN=""
62 . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward
63 . . . D DEMO
64 . . . D PROBLEM
65 . . . D ALLERGY
66 . . . D MEDS4
67 . . . D RECON2
68 . . . D ADVDIR
69 . . . D SMOKING
70 . . . D VITALS
71 . . . D VTE1
72 . . . D COD
73 . . . D EDTIME
74 . . . I C0QPR D PRINT
75 . . . I C0QSS D SS
76 . . . I C0QPL D PATLIST
77 Q
78 ;
79DEMO ; patient demographics
80 K PTDOB
81 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
82 S PTNAME=$P(^DPT(DFN,0),U) ;patient name
83 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
84 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
85 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
86 S PTHRN=$P($G(VA("PID")),U) ;health record number
87 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
88 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
89 S RACE=""
90 F D Q:RACE=""
91 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
92 . Q:'RACE
93 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
94 S ETHN=""
95 F D Q:ETHN=""
96 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
97 . Q:'ETHN
98 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
99 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
100 N DEMOYN S DEMOYN=1
101 I $G(PTSEX)="" S DEMOYN=0
102 I $G(PTDOB)="" S DEMOYN=0
103 I $G(PTHRN)="" S DEMOYN=0
104 I $G(PTLANG)="" S DEMOYN=0
105 I $G(RACEDSC)="" S DEMOYN=0
106 I $G(ETHNDSC)="" S DEMOYN=0
107 I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)=""
108 E S C0QLIST(ZYR_"FailedDemographics",DFN)=""
109 Q
110 ;
111PROBLEM ; PATIENT PROBLEMS
112 D LIST^ORQQPL(.PROBL,DFN,"A")
113 S PBCNT=""
114 F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
115 . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
116 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
117 E S C0QLIST(ZYR_"HasProblem",DFN)=""
118 K PROBL
119 Q
120 ;
121ALLERGY ; ALLERGY LIST
122 ; WANT TO CHANGE ALLERGIES FOR 2012 TO POPULATE THE C0QLIST DIRECTLY. GPL
123 D LIST^ORQQAL(.ALRGYL,DFN)
124 S ALCNT=""
125 F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
126 . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
127 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
128 E S C0QLIST(ZYR_"HasAllergy",DFN)=""
129 K ALRGYL
130 Q
131 ;
132MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
133 ; DELETED MEDS, MEDS2, AND MEDS3 FOR 2012 TO USE ONLY MEDS4
134 N BEG,END
135 S BEG=$$DT^C0PCUR("JULY 3,2011")
136 S END=$$DT^C0PCUR("NOW")
137 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400
138 N C0QMEDS
139 M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
140 N FOUND
141 N ZI
142 I '$D(C0QMEDS(1)) D Q ; QUIT IF NO MEDS
143 . S C0QLIST(ZYR_"NoMed",DFN)=""
144 E D ; HAS MEDS
145 . S C0QLIST(ZYR_"HasMed",DFN)=""
146 S ZI="" S FOUND=0
147 F S ZI=$O(C0QMEDS(ZI)) Q:ZI="" D ; FOR EACH MED
148 . N ZM
149 . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
150 . I $P($P(ZM,"^",1),";",2)="I" D ; IE 1U;I FOR AN INPATIENT UNIT DOSE
151 . . S FOUND=1
152 I FOUND S C0QLIST(ZYR_"HasMedOrders",DFN)="" ; MET CPOE MEASURE
153 E S C0QLIST(ZYR_"NoMedOrders",DFN)=""
154 Q
155 ;
156RECON ; MEDICATIONS RECONCILIATION
157 ; WANT TO SIMPLIFY MEDS RECON FOR 2012. GPL
158 ;
159 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
160 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
161 N HASRECON S HASRECON=0
162 N GT,G
163 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
164 S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
165 I $$TXTALL^C0QNOTES(.G,.GT,DFN) D ; SEARCH ALL NOTES FOR MED RECON
166 . S HASRECON=1
167 ;N ZT
168 ;S ZT="MEDICATION RECONCILIATION COMPLET"
169 ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D ;
170 ;. S HASRECON=1
171 ;E D ;
172 ;. S ZT="Medication Reconcilation Complete"
173 ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D ;
174 ;. . S HASRECON=1
175 ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
176 I HASRECON D ;
177 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
178 E S C0QLIST(ZYR_"NoMedRecon",DFN)=""
179 Q
180 ;
181RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
182 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
183 . S C0QLIST(ZYR_"XferOfCare",DFN)="" ; transfer of care patient
184 I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D ;
185 . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
186 E S C0QLIST(ZYR_"NoMedRecon",DFN)=""
187 Q
188 ;
189ERX ; FOR EP, WE LOOK AT ERX MEDS
190 N ZI S ZI=""
191 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
192 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" D ;
193 . ;B
194 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" D ;
195 . . S C0QLIST(ZYR_"HasMed",DFN)=""
196 . . S C0QLIST(ZYR_"HasMedOrders",DFN)=""
197 . . S C0QLIST(ZYR_"HasERX",DFN)=""
198 . . S C0QLIST(ZYR_"HasMedRecon",DFN)=""
199 . E D ;
200 . . S C0QLIST(ZYR_"NoMed",DFN)=""
201 . . S C0QLIST(ZYR_"NoMedOrders",DFN)=""
202 . . S C0QLIST(ZYR_"NoERX",DFN)=""
203 . . S C0QLIST(ZYR_"NoMedRecon",DFN)=""
204 Q
205 ;
206ADVDIR ; ADVANCE DIRECTIVE
207 ;
208 I $$AGE^C0QUTIL(DFN)>64 D ; ONLY FOR PATIENTS 65 AND OLDER
209 . S C0QLIST(ZYR_"Over65",DFN)=""
210 . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D ;
211 . . S C0QLIST(ZYR_"HasAdvanceDirective",DFN)=""
212 . E D ;
213 . . S C0QLIST(ZYR_"NoAdvanceDirective",DFN)=""
214 Q
215 ;
216SMOKING ;
217 ; WANT TO CHANGE SMOKING STATUS CHECKING FOR 2012 TO A SIMPLE SET OF
218 ; HEALTH FACTORS. GPL
219 I $$INLIST(ZYR_"HasSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STAT CHECK
220 . S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
221 . S C0QLIST(ZYR_"Over12",DFN)=""
222 I $$INLIST(ZYR_"NoSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STATUS CHECK
223 . S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
224 . S C0QLIST(ZYR_"Over12",DFN)=""
225 N C0QSMOKE,C0QSYN
226 S C0QSYN=0
227 I $$AGE^C0QUTIL(DFN)<13 Q ; DON'T CHECK UNDER AGE 13
228 D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
229 ; PATIENT IN THE CATEGORY OF TOBACCO
230 I $D(C0QSMOKE) S C0QSYN=1
231 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago")
232 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago")
233 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago")
234 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago")
235 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago")
236 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking")
237 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago")
238 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago")
239 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago")
240 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago")
241 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago")
242 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
243 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO")
244 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO")
245 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO")
246 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO")
247 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO")
248 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER")
249 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS")
250 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS")
251 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR")
252 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO")
253 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO")
254 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS")
255 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO")
256 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO")
257 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS")
258 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO")
259 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
260 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
261 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
262 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
263 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
264 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
265 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
266 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
267 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
268 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
269 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
270 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
271 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
272 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
273 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
274 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
275 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
276 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
277 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
278 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
279 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)")
280 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
281 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
282 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
283 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
284 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
285 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
286 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
287 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
288 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
289 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
290 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
291 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
292 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
293 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
294 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
295 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
296 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
297 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
298 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
299 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
300 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
301 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
302 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
303 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
304 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
305 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
306 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
307 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
308 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
309 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
310 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
311 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
312 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
313 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
314 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
315 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
316 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
317 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
318 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
319 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
320 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
321 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
322 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
323 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
324 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
325 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
326 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
327 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
328 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
329 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
330 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
331 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
332 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
333 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
334 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
335 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
336 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
337 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
338 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
339 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
340 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
341 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
342 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
343 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
344 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
345 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
346 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
347 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
348 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
349 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
350 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
351 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
352 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
353 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
354 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
355 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
356 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
357 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
358 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
359 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)")
360 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User")
361 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - No")
362 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Current Smoker - Yes")
363 S C0QLIST(ZYR_"Over12",DFN)=""
364 ;N GT
365 ;S GT(1,"HasSmokingStatus","SMOK")=""
366 ;S GT(2,"HasSmokingStatus","Smok")=""
367 ;S GT(3,"HasSmokingStatus","smok")=""
368 ;I 'C0QSYN D ;
369 ;. N G
370 ;. S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN)
371 ;. I $D(G) S C0QSYN=1
372 I C0QSYN S C0QLIST(ZYR_"HasSmokingStatus",DFN)=""
373 E S C0QLIST(ZYR_"NoSmokingStatus",DFN)=""
374 Q
375 ;
376VITALS ;
377 ;
378 N C0QSDT,C0QEDT
379 D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
380 D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
381 D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
382 I $D(VITRSLT) D ;ZWR VITRSLT B ;
383 . I VITRSLT(1)["No vitals found." S C0QLIST(ZYR_"NoVitalSigns",DFN)=""
384 . E S C0QLIST(ZYR_"HasVitalSigns",DFN)=""
385 Q
386 ;
387VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
388 ;
389 I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D ;
390 . S C0QLIST(ZYR_"HasVTE24",DFN)=""
391 E S C0QLIST(ZYR_"NoVTE24",DFN)=""
392 Q
393 ;
394COD ; TEST FOR PRELIMINARY CAUSE OF DEATH NOTE
395 I $$HASNTYN^C0QNOTES("PRELIMINARY CAUSE OF DEATH",DFN) D ;
396 . S C0QLIST(ZYR_"CauseOfDeath",DFN)=""
397 Q
398 ;
399EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
400 N FOUND
401 S FOUND=0
402 I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
403 I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
404 I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
405 I FOUND D ;
406 . S C0QLIST(ZYR_"HasEDtime",DFN)=""
407 E S C0QLIST(ZYR_"NoEDtime",DFN)=""
408 Q
409 ;
410ICUPAT ; CREATE LIST OF ICU PATIENTS
411 N ZICU
412 S ZICU=$O(^SC("B","IC","")) ; IEN OF ICU HOSPITAL LOCATION
413 N ZI,ZJ,ZP
414 S ZI=""
415 F S ZI=$O(^AUPNVSIT("AHL",ZICU,ZI)) Q:ZI="" D ; EACH DATE
416 . S ZJ=""
417 . F S ZJ=$O(^AUPNVSIT("AHL",ZICU,ZI,ZJ)) Q:ZJ="" D ; EACH VISIT
418 . . S ZP=$P(^AUPNVSIT(ZJ,0),"^",5) ; DFN
419 . . S C0QLIST(ZYR_"ICUPatient",ZP)=""
420 Q
421 ;
422FILTER ; CALLED AFTER ALL THE PATIENT LISTS HAVE BEEN FILED
423 ; WILL KILL C0QLIST AND CREATE DERIVATIVE PATIENT LISTS BY FILTERING
424 K C0QLIST
425 N ZPAT
426 S ZPAT=$$PATLN(ZYR_"Patient") ; name of patient list of all patients admitted
427 ; during the reporting period. used to filter other lists
428 ;
429 ; filter ICU patients against ZPAT
430 N GN,GO,GF
431 S GN=ZPAT
432 S GO=$$PATLN(ZYR_"ICUPatient") ; all ICU patient
433 S GF=$NA(C0QLIST(ZYR_"ICUReporting")) ; the filtered list destination
434 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
435 ;
436 ; FILTER VTE-2 DENOMINATOR FOR QUALITY MEASURE
437 ;
438 S GN=$NA(C0QLIST(ZYR_"ICUReporting")) ; ICU patients admitted inside rpt period
439 S GO=$$RPATLN("MU VTE-2 DENOM PL") ; TAXONOMY BASED DENOMENATOR
440 S GF=$NA(C0QLIST(ZYR_"VTE2DEN")) ; NEW DENOMINATOR PL
441 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
442 ;
443 S GN=ZPAT
444 S GO=$$RPATLN("MU VTE-3 DENOM PL") ; TAXONOMY BASED DENOMENATOR
445 S GF=$NA(C0QLIST(ZYR_"VTE3DEN")) ; NEW DENOMINATOR PL
446 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
447 ;
448 S GN=ZPAT
449 S GO=$$RPATLN("MU VTE-4 DENOM PL") ; TAXONOMY BASED DENOMENATOR
450 S GF=$NA(C0QLIST(ZYR_"VTE4DEN")) ; NEW DENOMINATOR PL
451 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
452 ;
453 S GN=ZPAT
454 S GO=$$RPATLN("MU VTE-5 DENOM PL") ; TAXONOMY BASED DENOMENATOR
455 S GF=$NA(C0QLIST(ZYR_"VTE5DEN")) ; NEW DENOMINATOR PL
456 D AND^C0QSET(GF,GN,GO) ; filter the list with the AND set operation
457 ;
458 D FILE ; FILE ALL THE PATIENT LISTS
459 D UPDATE^C0QUPDT(.G,5) ; UPDATE THE HOS 2011 MEANINGFUL USE measure set
460 Q
461 ;
462ED1 ;
463 S ZYR="MU12-"
464 D DOTIME("ED DEPARTURE TIME")
465 Q
466 ;
467ED2 ;
468 S ZYR="MU12-"
469 D DOTIME2("TIME DECISION TO ADMIT MADE")
470 Q
471 ;
472DOTIME(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
473 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
474 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
475 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
476 N ZP
477 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
478 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
479 S ZVFN=9000010 ; VISIT FILE NUMBER
480 K ZARY1,ZARY2
481 N ZI S ZI=""
482 S COUNT=0
483 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT
484 . S COUNT=COUNT+1
485 . N ZA,ZD
486 . S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
487 . S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
488 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
489 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT
490 . ; THE COMMENT IS THE TIME XXYY
491 . N OK,TMP
492 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
493 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
494 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
495 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
496 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
497 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
498 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
499 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
500 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
501 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
502 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
503 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
504 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
505 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
506 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
507 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
508 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
509 . S GTOT=G1-G2
510 . W !,"TIME: ",GTOT," ESTIMATED"
511 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
512 . W !,"COMPUTED MINUTES: ",ZT
513 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG
514 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES
515 . . W !,"****EXCLUDED****"
516 . I ZT>400000 D Q ; THESE ARE ERRORS
517 . . W !,"****EXCLUDED****"
518 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
519 N ZY,ZZ S ZY="" S ZZ=""
520 N ZCOUNT S ZCOUNT=0
521 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME
522 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME
523 . . S ZCOUNT=ZCOUNT+1
524 . . S ZARY2(ZCOUNT,ZY,ZZ)=""
525 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
526 N ZMID
527 S ZMID=$P(ZCOUNT/2,".")
528 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
529 W !,"ED ARRIVAL TIME UNTIL ",ZHF
530 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
531 Q
532 ;
533DOTIME2(ZHF) ; COMPUTE THE MEAN TIME IN THE ED FROM ARRIVAL TO DEPARTURE
534 ; THIS IS A QUALITY MEASURE ED-1 FOR MEANINGFUL USE
535 ; IT PRINTS A REPORT OF EACH PATIENT WITH THE ED TIMES RECORDED
536 ; AND THEIR TIME. AT THE END IT PRINTS THE MEAN TIME
537 N ZP
538 S ZP=$$PATLN(ZYR_"HasEDtime") ; patient list name for patients to process
539 S ZHFN=9000010.23 ; FILE NUMBER FOR V HEALTH FACTORS
540 S ZVFN=9000010 ; VISIT FILE NUMBER
541 K ZARY1,ZARY2
542 N ZI S ZI=""
543 S COUNT=0
544 F S ZI=$O(@ZP@(ZI)) Q:ZI="" D ; FOR EACH PATIENT
545 . S COUNT=COUNT+1
546 . N ZA,ZD
547 . ;S ZA=$$VHFIEN^C0QHF(ZI,"ED ARRIVAL TIME") ; IEN OF ARRIVAL HEALTH FACTOR
548 . ;S ZD=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
549 . S ZA=$$VHFIEN^C0QHF(ZI,ZHF) ; IEN OF DEPART HEALTH FACTOR
550 . S ZD=$$VHFIEN^C0QHF(ZI,"ED DEPARTURE TIME") ; IEN OF ARRIVAL HEALTH FACTOR
551 . N ZAD,ZDD ; ARRIVAL DATE, DEPARTURE DATE
552 . N ZAC,ZDC ; ARRIVAL COMMENT, DEPARTURE COMMENT
553 . ; THE COMMENT IS THE TIME XXYY
554 . N OK,TMP
555 . S TMP=$$GET1^DIQ(ZHFN,ZA_",",.03,"I") ; VISIT POINTER
556 . S ZAD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
557 . ;S ZAD=$P(^AUPNVHF(ZA,0),U,3) ; DATE IS PIECE 3
558 . S TMP=$$GET1^DIQ(ZHFN,ZD_",",.03,"I") ; VISIT POINTER
559 . S ZDD=$$GET1^DIQ(ZVFN,TMP_",",.01,"I") ; VISIT DATE
560 . ;S ZDD=$$GET1^DIQ(ZHFN,ZD_",",1201,"I") ; EVENT DATE FIELD
561 . ;S ZDD=$P(^AUPNVHF(ZD,0),U,3) ; DATE IS PIECE 3
562 . ;S OK=$$GET1^DIQ(ZHFN,ZA_",",81101,"","ZAC") ; ARRIVAL TIME
563 . S ZAC=$G(^AUPNVHF(ZA,811)) ; THE TIME
564 . ;S OK=$$GET1^DIQ(ZHFN,ZD_",",81101,"","ZDC") ; DEPARTURE TIME
565 . S ZDC=$G(^AUPNVHF(ZD,811)) ; DEPARTURE TIME
566 . N ZT ; THE TIME DIFFERENCE BETWEEN THE DATES
567 . W !,!,"PATIENT: ",ZI," ",$P(^DPT(ZI,0),U,1)
568 . W !,"IN: ",$$FMTE^XLFDT(ZAD_"."_ZAC)," OUT: ",$$FMTE^XLFDT(ZDD_"."_ZDC)
569 . S G1=($E(ZDC,1,2)*60)+($E(ZDC,3,4))
570 . S G2=($E(ZAC,1,2)*60)+($E(ZAC,3,4))
571 . I (ZDD-ZAD)>0 S G1=G1+(((ZDD-ZAD)*24)*60)
572 . S GTOT=G1-G2
573 . W !,"TIME: ",GTOT," ESTIMATED"
574 . S ZT=$$DTDIFF^C0QUTIL(ZDD,ZDC,ZAD,ZAC) ; COMPUTE THE DIFFERENCE IN MINUTES
575 . W !,"COMPUTED MINUTES: ",ZT
576 . ;I ZT'=GTOT B ; LET'S FIND OUT WHAT'S WRONG
577 . I ZT<0 D Q ; SKIP PATIENTS WITH NEGATIVE TIMES
578 . . W !,"****EXCLUDED****"
579 . I ZT>400000 D Q ; THESE ARE ERRORS
580 . . W !,"****EXCLUDED****"
581 . S ZARY1(ZT,ZI)="" ; ARRAY ORDERED BY MINUTES OF PATIENTS
582 N ZY,ZZ S ZY="" S ZZ=""
583 N ZCOUNT S ZCOUNT=0
584 F S ZY=$O(ZARY1(ZY)) Q:ZY="" D ; FOR EACH TIME
585 . F S ZZ=$O(ZARY1(ZY,ZZ)) Q:ZZ="" D ; FOR EACH PATIENT WITH THIS TIME
586 . . S ZCOUNT=ZCOUNT+1
587 . . S ZARY2(ZCOUNT,ZY,ZZ)=""
588 . . ;W !,ZCOUNT," PATIENT: ",ZZ," MINUTES: ",ZY
589 N ZMID
590 S ZMID=$P(ZCOUNT/2,".")
591 W !,"NUMBER OF PATIENTS IN REPORT: ",ZCOUNT
592 W !,"ED ARRIVAL TIME UNTIL ",ZHF
593 W !,"MEDIAN TIME: ",$O(ZARY2(ZMID,""))
594 Q
595 ;
596RPATLN(ZLST) ; EXTRINSIC RETURNS THE GLOBAL NAME OF THE REMINDER PATIENT LIST
597 ; WHOSE NAME IS ZLST
598 N ZIEN,ZN
599 S ZIEN=$O(^PXRMXP(810.5,"B",ZLST,"")) ; ien of patient list
600 S ZN=$NA(^PXRMXP(810.5,ZIEN,30,"B")) ; GLOBAL NAME IN REMINDER PATIENT LIST
601 Q ZN
602 ;
603PATLN(ZATTR) ; EXTRINSIC RETURNS THE NAME OF THE PATIENT LIST WITH
604 ; THE ATTRIBUTE ZATTR
605 N ZIEN,ZN
606 S ZIEN=$O(^C0Q(301,"CATTR",ZATTR,"")) ; ien of patient list
607 S ZN=$NA(^C0Q(301,ZIEN,1,"B")) ; NAME OF PATIENT LIST IN C0Q PATIENT LIST
608 Q ZN
609 ;
610INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
611 N ZL,ZR
612 S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
613 I ZL="" Q 0 ; LIST DOES NOT EXIST
614 S ZR=0 ; ASSUME NOT IN LIST
615 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
616 Q ZR
617 ;
618 ; LOOK AT GETTING RID OF PRINT AND SS AS THEY ARE NOT BEING USED. GPL
619PRINT ; PRINT TO SCREEN
620 I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
621 I $D(EXDTE) D ;
622 . W !,"Discharge Date: ",EXDTE
623 . W !,DFN," ",PTNAME
624 W !,"DOB: ",PTDOB," HRN: ",PTHRN
625 W !,"Language Spoken: ",$G(PTLANG)
626 W !,"Race: ",RACEDSC
627 W !,"Ethnicity: ",$G(ETHNDSC)
628 W !,"Problems: "
629 W !,PBDESC
630 W !,"Allergies: "
631 W !,ALDESC
632 W !,"Medications: "
633 W !
634 Q
635 ;
636SS ; CREATE SPREADSHEET ARRAY
637 S G1("Patient")=DFN
638 I $D(WARD) D ;
639 . S G1("WardName")=WARDNAME
640 . S G1("RoomAndBed")=RB
641 I $D(EXDTE) D ;
642 . S G1("DischargeDate")=EXDTE
643 S G1("PatientName")=PTNAME
644 S G1("Gender")=PTSEX
645 S G1("DateOfBirth")=PTDOB
646 S G1("HealthRecordNumber")=PTHRN
647 S G1("LanguageSpoken")=$G(PTLANG)
648 S G1("Race")=RACEDSC
649 S G1("Ehtnicity")=$G(ETHNDSC)
650 S G1("Problem")=PBDESC
651 I PBDESC["No problems found" S G1("HasProblem")=0
652 E S G1("HasProblem")=1
653 S G1("Allergies")=ALDESC
654 I ALDESC["No Allergy" S G1("HasAllergy")=0
655 E S G1("HasAllergy")=1
656 I $D(MDITEM) D ;
657 . S G1("HasMed")=1
658 E S G1("HasMed")=0
659 S G1("MedDescription")=$G(MDDESC)
660 I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC
661 D RNF1TO2B^C0CRNF("GRSLT","G1")
662 K G1
663 Q ; DON'T WANT TO DO THE NHIN STUFF NOW
664 ;
665PATLIST ; CREATE PATIENT LISTS
666 ; WANT TO GET RID OF PATLIST AND MOVE FUNCTION TO OTHER ROUTINES. GPL
667 S C0QLIST(ZYR_"Patient",DFN)="" ; THE PATIENT LIST
668 N DEMOYN S DEMOYN=1
669 I $G(PTSEX)="" S DEMOYN=0
670 I $G(PTDOB)="" S DEMOYN=0
671 I $G(PTHRN)="" S DEMOYN=0
672 I $G(PTLANG)="" S DEMOYN=0
673 I $G(RACEDSC)="" S DEMOYN=0
674 I $G(ETHNDSC)="" S DEMOYN=0
675 ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
676 ;E S C0QLIST("FailedDemographics",DFN)=""
677 ;S G1("Gender")=PTSEX
678 ;S G1("DateOfBirth")=PTDOB
679 ;S G1("HealthRecordNumber")=PTHRN
680 ;S G1("LanguageSpoken")=$G(PTLANG)
681 ;S G1("Race")=RACEDSC
682 ;S G1("Ehtnicity")=$G(ETHNDSC)
683 S G1("Problem")=PBDESC
684 I PBDESC["No problems found" S C0QLIST(ZYR_"NoProblem",DFN)=""
685 E S C0QLIST(ZYR_"HasProblem",DFN)=""
686 ;S G1("Allergies")=ALDESC
687 I ALDESC["No Allergy" S C0QLIST(ZYR_"NoAllergy",DFN)=""
688 E S C0QLIST(ZYR_"HasAllergy",DFN)=""
689 ;I $D(MDITEM) D ;
690 ;. S C0QLIST("HasMed",DFN)=""
691 ;E S G1("NoMed",DFN)=""
692 ;S G1("MedDescription")=$G(MDDESC)
693 Q
694 ;
695NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
696 Q:DFN=137!14
697 D EN^C0CNHIN(.G,DFN,"")
698 ZWR G
699 K G
700 ;
701 QUIT ;end of WARD
702 ;
703LOCPAT(PREFIX,LOC) ;retrieve active outpatients
704 ; PREFIX WILL GO IN C0XLIST(PREFIX_"-PATIENT",DFN)=""
705 ; LOC IS HOSPITAL LOCATION
706 S ULOC=$O(^SC("B",LOC,"")) ; IEN OF HOSPITAL LOCATION
707 I ULOC="" D Q ; OOPS
708 . W !,"HOSPITAL LOCATION NOT FOUND: ",LOC
709 S IDTE=9999999-DTE ; INVERSE DATE
710 N ZI
711 S ZI="" ; BEGIN AT LATEST DATE FOR THIS LOC IN VISIT FILE
712 F S ZI=$O(^AUPNVSIT("AHL",ULOC,ZI)) Q:(ZI="")!(ZI>IDTE) D ; FOR EACH DATE
713 . W !,$$FMTE^XLFDT(9999999-ZI) ;B ;
714 . I ZI="" Q ;
715 . N ZJ S ZJ=""
716 . F S ZJ=$O(^AUPNVSIT("AHL",ULOC,ZI,ZJ)) Q:ZJ="" D ; FOR EACH VISIT
717 . . S DFN=$$GET1^DIQ(9000010,ZJ,.05,"I") ; PATIENT
718 . . S C0QLIST(PREFIX_"Patient",DFN)=""
719 Q
720 ;
721EPPAT(ZYR) ; BUILD ALL PATIENT LISTS FOR CLINICS
722 ;
723 S DTE=3111000
724 S MUYR=ZYR
725 N ZC,ZN
726 S ZN=0
727 N ZI S ZI=0
728 F S ZI=$O(^SC(ZI)) Q:+ZI=0 D ; FOR EVERY HOSPITAL LOCATION
729 . I $$GET1^DIQ(44,ZI_",",2,"I")'="C" Q ; NOT A CLINIC
730 . S ZC=$$GET1^DIQ(44,ZI_",",.01) ; NAME OF CLINIC
731 . S ZCIEN=ZI ; IEN OF CLINIC
732 . S ZN=ZN+1 ; COUNT OF CLINICS
733 . S PRE=MUYR_"-EP-"_ZC_"-"
734 . D LOCPAT(PRE,ZC)
735 W !,"NUMBER OF CLINICS: ",ZN
736 D FILE ; CREATE ALL THE EP PATIENT LISTS
737 Q
738 ;
739DOEP ; DO EP COMPUTATIONS
740 S DTE=3111000
741 K C0QLIST ; CLEAR THE LIST
742 S PRE="MU12-EP-OIM-BOWEN-"
743 S ZYR=PRE
744 D LOCPAT(PRE,"OIM-BOWEN") ; GET THE PATIENTS
745 ZWR C0QLIST
746 ;B
747 S DFN=""
748 F S DFN=$O(C0QLIST(PRE_"Patient",DFN)) Q:DFN="" D ; FOR EACH PATIENT
749 . D DEMO
750 . D PROBLEM
751 . D ALLERGY
752 . ;D MEDS
753 . D ERX
754 . D SMOKING
755 . D VITALS
756 D FILE ; FILE THE PATIENT LISTS
757 D UPDATE^C0QUPDT(.G,12) ; UPDATE THE MU MEASUREMENT SET - CHANGE EVERY YR
758 Q
759 ;
760DIS;
761 N DFN,DTE,EXDTE S DTE=""
762 F D Q:DTE=""
763 . S DTE=$O(^DGPM("B",DTE))
764 . Q:'DTE
765 . ;Q:$P(DTE,".")<3110703
766 . Q:$P(DTE,".")<3111000 ; NEW BEGIN DATE FOR FISCAL YEAR 2012
767 . S EXDTE=$$FMTE^XLFDT(DTE)
768 . N PTFM S PTFM=""
769 . D
770 . . S PTFM=$O(^DGPM("B",DTE,PTFM))
771 . . Q:'PTFM
772 . . S DFN=$P(^DGPM(PTFM,0),U,3)
773 . . S C0QLIST(ZYR_"Patient",DFN)=""
774 . . D DEMO
775 . . D PROBLEM
776 . . D ALLERGY
777 . . D MEDS4
778 . . D RECON2
779 . . D ADVDIR
780 . . D SMOKING
781 . . D VITALS
782 . . ;D:$P(DTE,".")>3110912 VTE1
783 . . D VTE1
784 . . D COD
785 . . D EDTIME
786 . . I C0QPR D PRINT
787 . . I C0QSS D SS
788 . . I C0QPL D PATLIST
789 Q
790 ;
791C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
792C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
793FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
794 ;
795 I '$D(C0QLIST) Q ;
796 N LFN S LFN=$$C0QALFN()
797 N ZI,ZN
798 S ZI=""
799 F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ;
800 . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
801 . I ZN="" D ; LIST NOT FOUND, CREATE IT
802 . . K C0QFDA
803 . . S FN=$$C0QPLF ; C0Q PATIENT LIST FILE
804 . . S C0QFDA(FN,"+1,",.01)=ZI
805 . . S C0QFDA(FN,"+1,",999)=ZI ; ATTRIBUTE
806 . . W !,"CREATING ",ZI
807 . . D UPDIE ; ADD THE RECORD
808 . . S ZN=$O(^C0Q(301,"CATTR",ZI,"")) ; THE NEW IEN
809 . ;I ZN="" D Q ; OOPS
810 . ;. W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
811 . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
812 . N C0QNEW,C0QOLD,C0QRSLT
813 . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
814 . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
815 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
816 . N ZJ,ZK
817 . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
818 . K C0QFDA
819 . S ZJ=""
820 . F S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ="" D ; MARKED WITH A 2 FROM UNITY
821 . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
822 . . I ZK="" D Q ; OOPS SHOULDN'T HAPPEN
823 . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
824 . . . B
825 . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
826 . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
827 . ; SECOND, PROCESS THE ADDITIONS
828 . K C0QFDA
829 . S ZJ="" S ZK=1
830 . F S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ="" D ; PATIENTS TO ADD ARE MARKED WITH 0
831 . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
832 . . S ZK=ZK+1
833 . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
834 ;. Q
835 ;. K C0QFDA
836 ;. N ZJ,ZC
837 ;. S ZJ="" S ZC=1
838 ;. F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST
839 ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
840 ;. . S ZC=ZC+1
841 ;. D UPDIE
842 ;. W !,"FOUND:"_ZI
843 Q
844 ;
845KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
846 ;
847 N C0QFDA,ZFN,LIST,ATTR
848 S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
849 D CLEAN^DILF
850 S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME
851 S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
852 D CLEAN^DILF
853 K ZERR
854 S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
855 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
856 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
857 ;. W "ERROR",!
858 ;. ZWR ZERR
859 ;. B
860 K C0QFDA
861 S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
862 S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
863 D UPDIE ; CREATE THE SUBFILE
864 N ZR ; NEW IEN FOR THE RECORD
865 S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
866 ;
867 Q ZR
868 ;
869UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
870 K ZERR
871 D CLEAN^DILF
872 D UPDATE^DIE("","C0QFDA","","ZERR")
873 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
874 ;. W "ERROR",!
875 ;. ZWR ZERR
876 ;. B
877 K C0QFDA
878 Q
879 ;
880 ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
881 ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
882 ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
883 ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
884 ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
885 ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
886 ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
887 ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
888 ;. . S RACE=""
889 ;. . F D Q:RACE=""
890 ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
891 ;. . . Q:'RACE
892 ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
893 ;. . N ETHNDSC
894 ;. . N ETHNDSC S ETHNDSC=""
895 ;. . S ETHN=""
896 ;. . F D Q:ETHN=""
897 ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
898 ;. . . Q:'ETHN
899 ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
900 ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
901 ;. . S PBCNT=""
902 ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
903 ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
904 ;. . K PROBL
905 ;. . D LIST^ORQQAL(.ALRGYL,DFN)
906 ;. . S ALCNT=""
907 ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
908 ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
909 ;. . K ALRGYL
910 ;. . D COVER^ORWPS(.MEDSL,DFN)
911 ;. . S MDCNT=""
912 ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D
913 ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
914 ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
915 ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
916 ;. . K MEDSL
917 ;. . W !,"Discharge Date: ",EXDTE
918 ;. . W !,DFN," ",PTNAME
919 ;. . W !,"DOB: ",PTDOB," HRN: ",PTHRN
920 ;. . W !,"Language Spoken: ",$G(PTLANG)
921 ;. . W !,"Race: ",RACEDSC
922 ;. . W !,"Ethnicity: ",ETHNDSC
923 ;. . W !,"Problems: "
924 ;. . W !,PBDESC
925 ;. . W !,"Allergies: "
926 ;. . W !,ALDESC
927 ;. . W !,"Medications: "
928 ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC
929 ;. . W !
930 ;Q
931 ;
932 ;
933 ;
934 ;
935END ;end of C0QPRML;
Note: See TracBrowser for help on using the repository browser.