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

Last change on this file since 1442 was 1438, checked in by Sam Habiel, 12 years ago

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