source: qrda/C0Q/trunk/p/C0QPRML.m@ 1623

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

Updated routines after many small fixes; added C0QKIDS as well
File size: 24.8 KB
Line 
1C0QPRML ;JJOH/ZAG/GPL - Patient Reminder List ;7/5/11 8:50pm
2 ;;1.0;C0Q;;May 21, 2012;Build 33
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 ;
21BUILD ; CALL ALL AND DIS AND BUILD THE GRSLT ARRAY or print or create
22 ; patient lists
23 ;N GRSLT ; ARRAY FOR RESULTS
24 I '$D(C0QSS) S C0QSS=0 ;default don't build spreadsheet array
25 I '$D(C0QPR) S C0QPR=0 ;default don't print out results
26 I '$D(C0QPL) S C0QPL=1 ;default do create patient lists
27 N G1 ; ONE SET OF VALUES - RNF1 FORMAT
28 ; INITIALIZE LISTS
29 ; this is done so that if there are no matching patients, the patient list
30 ; will be zeroed out
31 S C0QLIST("HasDemographics")=""
32 S C0QLIST("Patient")=""
33 S C0QLIST("HasProblem")=""
34 S C0QLIST("HasAllergy")=""
35 S C0QLIST("HasMed")=""
36 S C0QLIST("HasVitalSigns")=""
37 S C0QLIST("HasMedOrders")=""
38 S C0QLIST("HasSmokingStatus")=""
39 D ALL ; all currently admitted patients in the hospital
40 D DIS ; all patients discharged since the reporting period began
41 I C0QSS ZWR GRSLT
42 I C0QPL D ;
43 . D FILE ; FILE THE PATIENT LISTS
44 . D UPDATE^C0QUPDT(.G,8) ; UPDATE THE MU MEASUREMENT SET
45 . D UPDATE^C0QUPDT(.G,9) ; UPDATE THE MU MEASUREMENT SET
46 Q
47 ;
48ALL ;retrieve active inpatients
49 N WARD S WARD=""
50 F D Q:WARD=""
51 . S WARD=$O(^DIC(42,"B",WARD)) ;ward name
52 . Q:WARD=""
53 . N WIEN S WIEN=""
54 . F S WIEN=$O(^DIC(42,"B",WARD,WIEN)) Q:'WIEN D ;wards IEN
55 . . S WARDNAME=$P(^DIC(42,WIEN,0),U,2) ;ward name
56 . . N DFN,RB S DFN=""
57 . . F S DFN=$O(^DPT("CN",WARD,+DFN)) Q:'DFN D ;DFN of patient on ward
58 . . . D DEMO
59 . . . D PROBLEM
60 . . . D ALLERGY
61 . . . D MEDS4
62 . . . D RECON2
63 . . . D ADVDIR
64 . . . D SMOKING
65 . . . D VITALS
66 . . . D VTE1
67 . . . D EDTIME
68 . . . I C0QPR D PRINT
69 . . . I C0QSS D SS
70 . . . I C0QPL D PATLIST
71 Q
72 ;
73DEMO ; patient demographics
74 K PTDOB
75 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
76 S PTNAME=$P(^DPT(DFN,0),U) ;patient name
77 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
78 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
79 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
80 S PTHRN=$P($G(VA("PID")),U) ;health record number
81 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
82 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
83 S RACE=""
84 F D Q:RACE=""
85 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
86 . Q:'RACE
87 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
88 S ETHN=""
89 F D Q:ETHN=""
90 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
91 . Q:'ETHN
92 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
93 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
94 N DEMOYN S DEMOYN=1
95 I $G(PTSEX)="" S DEMOYN=0
96 I $G(PTDOB)="" S DEMOYN=0
97 I $G(PTHRN)="" S DEMOYN=0
98 I $G(PTLANG)="" S DEMOYN=0
99 I $G(RACEDSC)="" S DEMOYN=0
100 I $G(ETHNDSC)="" S DEMOYN=0
101 I DEMOYN S C0QLIST("HasDemographics",DFN)=""
102 E S C0QLIST("FailedDemographics",DFN)=""
103 Q
104 ;
105PROBLEM ; PATIENT PROBLEMS
106 D LIST^ORQQPL(.PROBL,DFN,"A")
107 S PBCNT=""
108 F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
109 . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
110 K PROBL
111 Q
112 ;
113ALLERGY ; ALLERGY LIST
114 D LIST^ORQQAL(.ALRGYL,DFN)
115 S ALCNT=""
116 F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
117 . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
118 K ALRGYL
119 Q
120 ;
121MEDS ; MEDICATIONS
122 ;
123 I DFN=97 D Q ;
124 . S MDCNT=271
125 K MEDSL
126 D EN^C0CNHIN(.MEDSL,DFN,"MED;") ; GET THE MEDS FROM THE NHIN API
127 ; can't use COVER^ORWPS even though it's fast.. we need to detect
128 ; if the medications are Inpatient to compute the CPOE measure
129 ; we will use the NHINV routines for this purpose
130 ;D COVER^ORWPS(.MEDSL,DFN)
131 S MDCNT="" S HASINP=0
132 F S MDCNT=$O(MEDSL("med",MDCNT)) Q:MDCNT="" D
133 . ;Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
134 . Q:MEDSL("med",MDCNT,"status@value")'="active"
135 . ;S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
136 . S MDDESC=$G(MEDSL("med",MDCNT,"products.product@name"))
137 . ;S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
138 . S MDITEM=$G(MEDSL("med",MDCNT,"sig")) ; i think this is what meditem is
139 . I MEDSL("med",MDCNT,"vaType@value")="I" S HASINP=1
140 I HASINP D ; THE PATIENT HAS AN INPATIENT MED
141 . S C0QLIST("HasMedOrders",DFN)="" ; an inpatient drug indicates CPOE
142 E S C0QLIST("NoMedOrders",DFN)="" ; this will be different for outpatient
143 K MEDSL
144 Q
145 ;
146MEDS2 ; MEDICATIONS
147 ;
148 K MEDSL,MDDESC,MDITEM
149 D COVER^ORWPS(.MEDSL,DFN) ; CPRS MED LIST
150 I '$D(MEDSL) D ;
151 . S C0QLIST("NoMedOrders",DFN)=""
152 . I $$HFYN^C0QHF(DFN,"MEDS HAVE BEEN REVIEWED") D ;
153 . . S C0QLIST("HasMed",DFN)=""
154 . E S C0QLIST("NoMed",DFN)=""
155 S MDCNT="" S HASINP=0
156 F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D ;
157 . ;Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
158 . ;S C0QLIST("HasMedOrders",DFN)=""
159 . S C0QLIST("HasMed",DFN)=""
160 . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
161 . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
162 . I $P($P(MEDSL(MDCNT),"^",1),";",2)="I" S HASINP=1
163 I HASINP D ; THE PATIENT HAS AN INPATIENT MED
164 . S C0QLIST("HasMedOrders",DFN)="" ; an inpatient drug indicates CPOE
165 E S C0QLIST("NoMedOrders",DFN)="" ; this will be different for outpatient
166 K MEDSL
167 Q
168 ;
169MEDS3 ; USE THE REMINDER INDEX ^PXRMINDX TO CHECK FOR MEDS
170 ;
171 S C0QPXRM=$NA(^PXRMINDX(55,"PI")) ; REMINDER INDEX FOR DRUGS
172 I $D(@C0QPXRM@(DFN)) D ; HAS MEDS
173 . S C0QLIST("HasMed",DFN)=""
174 . S C0QLIST("HasMedOrders",DFN)=""
175 E D ; NO MEDS
176 . S C0QLIST("NoMed",DFN)=""
177 . S C0QLIST("NoMedOrders",DFN)=""
178 Q
179 ;
180MEDS4 ; USE OCL^PSOORRL TO GET ALL MEDS
181 N BEG,END
182 S BEG=$$DT^C0PCUR("JULY 3,2011")
183 S END=$$DT^C0PCUR("NOW")
184 D OCL^PSOORRL(DFN,BEG,END) ;DBIA #2400
185 N C0QMEDS
186 M C0QMEDS=^TMP("PS",$J) ; MEDS RETURNED FROM CALL
187 N FOUND
188 N ZI
189 I '$D(C0QMEDS(1)) D Q ; QUIT IF NO MEDS
190 . S C0QLIST("NoMed",DFN)=""
191 E D ; HAS MEDS
192 . S C0QLIST("HasMed",DFN)=""
193 S ZI="" S FOUND=0
194 F S ZI=$O(C0QMEDS(ZI)) Q:ZI="" D ; FOR EACH MED
195 . N ZM
196 . S ZM=$G(C0QMEDS(ZI,0)) ;THE MEDICATION
197 . I $P($P(ZM,"^",1),";",2)="I" D ; IE 1U;I FOR AN INPATIENT UNIT DOSE
198 . . S FOUND=1
199 I FOUND S C0QLIST("HasMedOrders",DFN)="" ; MET CPOE MEASURE
200 E S C0QLIST("NoMedOrders",DFN)=""
201 Q
202 ;
203RECON ; MEDICATIONS RECONCILIATION
204 ;
205 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
206 . S C0QLIST("XferOfCare",DFN)="" ; transfer of care patient
207 N HASRECON S HASRECON=0
208 N GT,G
209 S GT(4,"HasMedRecon","MEDICATION RECONCILIATION COMPLET")=""
210 S GT(5,"HasMedRecon","Medication Reconcilation Complete")=""
211 I $$TXTALL^C0QNOTES(.G,.GT,DFN) D ; SEARCH ALL NOTES FOR MED RECON
212 . S HASRECON=1
213 ;N ZT
214 ;S ZT="MEDICATION RECONCILIATION COMPLET"
215 ;I $$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) D ;
216 ;. S HASRECON=1
217 ;E D ;
218 ;. S ZT="Medication Reconcilation Complete"
219 ;. I $$NTTXT^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",ZT,DFN) D ;
220 ;. . S HASRECON=1
221 ;I $$HFYN^C0QHF("MEDS HAVE BEEN REVIEWED",DFN) S HASRECON=1
222 I HASRECON D ;
223 . S C0QLIST("HasMedRecon",DFN)=""
224 E S C0QLIST("NoMedRecon",DFN)=""
225 Q
226 ;
227RECON2 ; USE HEALTH FACTORS FOR MEDICATION RECONCILIATION
228 I $$HASNTYN^C0QNOTES("MED/SURG NURSING ADMISSION ASSESSMENT",DFN) D ;
229 . S C0QLIST("XferOfCare",DFN)="" ; transfer of care patient
230 I $$HFYN^C0QHF(DFN,"Medication Reconciliation Completed: Yes") D ;
231 . S C0QLIST("HasMedRecon",DFN)=""
232 E S C0QLIST("NoMedRecon",DFN)=""
233 Q
234 ;
235ADVDIR ; ADVANCE DIRECTIVE
236 ;
237 I $$AGE^C0QUTIL(DFN)>64 D ; ONLY FOR PATIENTS 65 AND OLDER
238 . S C0QLIST("Over65",DFN)=""
239 . I $$HASNTYN^C0QNOTES("ADVANCE DIRECTIVE",DFN) D ;
240 . . S C0QLIST("HasAdvanceDirective",DFN)=""
241 . E D ;
242 . . S C0QLIST("NoAdvanceDirective",DFN)=""
243 Q
244 ;
245SMOKING ;
246 I $$INLIST("HasSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STATUS CHECK
247 . S C0QLIST("HasSmokingStatus",DFN)=""
248 . S C0QLIST("Over12",DFN)=""
249 I $$INLIST("NoSmokingStatus",DFN) D Q ; ALREADY HAS SMOKING STATUS CHECK
250 . S C0QLIST("NoSmokingStatus",DFN)=""
251 . S C0QLIST("Over12",DFN)=""
252 N C0QSMOKE,C0QSYN
253 S C0QSYN=0
254 I $$AGE^C0QUTIL(DFN)<13 Q ; DON'T CHECK UNDER AGE 13
255 D HFCAT^C0QHF(.C0QSMOKE,DFN,"TOBACCO") ; GET ALL HEALTH FACTORS FOR THE
256 ; PATIENT IN THE CATEGORY OF TOBACCO
257 I $D(C0QSMOKE) S C0QSYN=1
258 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco <1 Yr Ago")
259 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco > 20 Yrs Ago")
260 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 1-5 Yrs Ago")
261 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 10-20 Yrs Ago")
262 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smokeless Tobacco: 5-10 Yrs Ago")
263 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking")
264 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking < 1 Yr Ago")
265 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking > 20 Yrs Ago")
266 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 1-5 Yrs Ago")
267 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 10-20 Yrs Ago")
268 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Quit Smoking: 5-10 Yrs Ago")
269 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
270 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 1-5 YRS AGO")
271 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 10-20 YRS AGO")
272 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: 5-10 YRS AGO")
273 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: < 1 YR AGO")
274 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS: > 20 YRS AGO")
275 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER")
276 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 10-20 YRS")
277 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER 20+ YRS")
278 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR")
279 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER < 1 YR AGO")
280 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER > 20 YRS AGO")
281 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS")
282 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 1-5 YRS AGO")
283 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 10-20 YRS AGO")
284 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS")
285 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKER: 5-10 YRS AGO")
286 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"PREVIOUS SMOKELESS TOBACCO USER")
287 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
288 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
289 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
290 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
291 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
292 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
293 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
294 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
295 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
296 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
297 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
298 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
299 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
300 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
301 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
302 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
303 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
304 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
305 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
306 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking Cessation (OPH)")
307 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
308 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
309 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
310 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
311 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
312 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
313 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
314 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
315 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
316 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
317 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
318 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
319 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
320 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
321 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
322 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
323 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
324 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
325 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
326 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
327 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
328 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
329 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
330 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
331 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
332 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
333 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
334 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
335 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
336 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
337 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
338 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
339 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
340 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
341 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
342 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
343 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
344 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
345 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
346 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
347 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
348 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
349 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
350 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
351 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
352 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
353 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
354 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
355 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
356 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
357 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
358 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
359 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
360 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
361 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
362 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
363 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
364 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
365 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
366 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"LIFETIME NON-SMOKER")
367 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smokeless Tobacco User")
368 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker")
369 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Former Smoker (PMH)")
370 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoke Exposure/2nd Hand Exposure")
371 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 1-5 Yrs")
372 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 10-20 Yrs")
373 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For 5-10 Yrs")
374 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For < 1 Yr")
375 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoked For > 20 Yrs")
376 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Tobacco User")
377 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 1-5 Yrs")
378 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 10-20 Yrs")
379 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for 5-10 Yrs")
380 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for < 1 Yr")
381 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smokeless Used for > 20 Yrs")
382 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoker (HPI)")
383 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (FMH)")
384 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Smoking (PMH)")
385 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker")
386 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Smoker (PMH)")
387 S:'C0QSYN C0QSYN=$$HFYN^C0QHF(DFN,"Non-Tobacco User")
388 S C0QLIST("Over12",DFN)=""
389 N GT
390 S GT(1,"HasSmokingStatus","SMOK")=""
391 S GT(2,"HasSmokingStatus","Smok")=""
392 S GT(3,"HasSmokingStatus","smok")=""
393 ;N ZT
394 ;S ZT="Smok"
395 ;S:'C0QSYN C0QSYN=$$NTTXT^C0QNOTES("ER NURSE NOTE",ZT,DFN) ;
396 I 'C0QSYN D ;
397 . N G
398 . S OK=$$TXTALL^C0QNOTES(.G,.GT,DFN)
399 . I $D(G) S C0QSYN=1
400 I C0QSYN S C0QLIST("HasSmokingStatus",DFN)=""
401 E S C0QLIST("NoSmokingStatus",DFN)=""
402 Q
403 ;
404VITALS ;
405 ;
406 N C0QSDT,C0QEDT
407 D DT^DILF(,"JULY 3,2011",.C0QSDT) ; START DATE
408 D DT^DILF(,"T",.C0QEDT) ; END DATE TODAY
409 D VITALS^ORQQVI(.VITRSLT,DFN,C0QSDT,C0QEDT) ; CALL FAST VITALS
410 I $D(VITRSLT) D ;ZWR VITRSLT B ;
411 . I VITRSLT(1)["No vitals found." S C0QLIST("NoVitalSigns",DFN)=""
412 . E S C0QLIST("HasVitalSigns",DFN)=""
413 Q
414 ;
415VTE1 ; VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL
416 ;
417 I $$HFYN^C0QHF(DFN,"VTE PROPHYLAXIS WITHIN 24HRS OF ARRIVAL") D ;
418 . S C0QLIST("HasVTE24",DFN)=""
419 E S C0QLIST("NoVTE24",DFN)=""
420 Q
421 ;
422EDTIME ; CHECK FOR EMERGENCY DEPT TIME FACTORS
423 N FOUND
424 S FOUND=0
425 I $$HFYN^C0QHF(DFN,"ED ARRIVAL TIME") S FOUND=1
426 I '$$HFYN^C0QHF(DFN,"ED DEPARTURE TIME") S FOUND=0
427 I '$$HFYN^C0QHF(DFN,"TIME DECISION TO ADMIT MADE") S FOUND=0
428 I FOUND D ;
429 . S C0QLIST("HasEDtime",DFN)=""
430 E S C0QLIST("NoEDtime",DFN)=""
431 Q
432 ;
433INLIST(ZLIST,DFN) ; EXTRINSIC FOR IS PATIENT ALREADY IN LIST ZLIST
434 N ZL,ZR
435 S ZL=$O(^C0Q(301,"CATTR",ZLIST,"")) ; IEN OF LIST IN C0Q PATIENT LIST FILE
436 I ZL="" Q 0 ; LIST DOES NOT EXIST
437 S ZR=0 ; ASSUME NOT IN LIST
438 I $D(^C0Q(301,ZL,1,"B",DFN)) S ZR=1 ; PATIENT IS IN LIST
439 Q ZR
440 ;
441PRINT ; PRINT TO SCREEN
442
443 I $D(WARD) W !!,WARD_"-"_WARDNAME_" "_RB_": "_PTNAME_"("_PTSEX_") "
444 I $D(EXDTE) D ;
445 . W !,"Discharge Date: ",EXDTE
446 . W !,DFN," ",PTNAME
447 W !,"DOB: ",PTDOB," HRN: ",PTHRN
448 W !,"Language Spoken: ",$G(PTLANG)
449 W !,"Race: ",RACEDSC
450 W !,"Ethnicity: ",$G(ETHNDSC)
451 W !,"Problems: "
452 W !,PBDESC
453 W !,"Allergies: "
454 W !,ALDESC
455 W !,"Medications: "
456 W !
457 Q
458 ;
459SS ; CREATE SPREADSHEET ARRAY
460 S G1("Patient")=DFN
461 I $D(WARD) D ;
462 . S G1("WardName")=WARDNAME
463 . S G1("RoomAndBed")=RB
464 I $D(EXDTE) D ;
465 . S G1("DischargeDate")=EXDTE
466 S G1("PatientName")=PTNAME
467 S G1("Gender")=PTSEX
468 S G1("DateOfBirth")=PTDOB
469 S G1("HealthRecordNumber")=PTHRN
470 S G1("LanguageSpoken")=$G(PTLANG)
471 S G1("Race")=RACEDSC
472 S G1("Ehtnicity")=$G(ETHNDSC)
473 S G1("Problem")=PBDESC
474 I PBDESC["No problems found" S G1("HasProblem")=0
475 E S G1("HasProblem")=1
476 S G1("Allergies")=ALDESC
477 I ALDESC["No Allergy" S G1("HasAllergy")=0
478 E S G1("HasAllergy")=1
479 I $D(MDITEM) D ;
480 . S G1("HasMed")=1
481 E S G1("HasMed")=0
482 S G1("MedDescription")=$G(MDDESC)
483 I $D(MDITEM) W !,"("_MDITEM_")"_MDDESC E W !,MDDESC
484 D RNF1TO2B^C0CRNF("GRSLT","G1")
485 K G1
486 Q ; DON'T WANT TO DO THE NHIN STUFF NOW
487 ;
488PATLIST ; CREATE PATIENT LISTS
489 S C0QLIST("Patient",DFN)="" ; THE PATIENT LIST
490 N DEMOYN S DEMOYN=1
491 I $G(PTSEX)="" S DEMOYN=0
492 I $G(PTDOB)="" S DEMOYN=0
493 I $G(PTHRN)="" S DEMOYN=0
494 I $G(PTLANG)="" S DEMOYN=0
495 I $G(RACEDSC)="" S DEMOYN=0
496 I $G(ETHNDSC)="" S DEMOYN=0
497 ;I DEMOYN S C0QLIST("HasDemographics",DFN)=""
498 ;E S C0QLIST("FailedDemographics",DFN)=""
499 ;S G1("Gender")=PTSEX
500 ;S G1("DateOfBirth")=PTDOB
501 ;S G1("HealthRecordNumber")=PTHRN
502 ;S G1("LanguageSpoken")=$G(PTLANG)
503 ;S G1("Race")=RACEDSC
504 ;S G1("Ehtnicity")=$G(ETHNDSC)
505 S G1("Problem")=PBDESC
506 I PBDESC["No problems found" S C0QLIST("NoProblem",DFN)=""
507 E S C0QLIST("HasProblem",DFN)=""
508 ;S G1("Allergies")=ALDESC
509 I ALDESC["No Allergy" S C0QLIST("NoAllergy",DFN)=""
510 E S C0QLIST("HasAllergy",DFN)=""
511 ;I $D(MDITEM) D ;
512 ;. S C0QLIST("HasMed",DFN)=""
513 ;E S G1("NoMed",DFN)=""
514 ;S G1("MedDescription")=$G(MDDESC)
515 Q
516 ;
517NHIN ; SHOW THE NHIN ARRAY FOR THIS PATIENT
518 Q:DFN=137!14
519 D EN^C0CNHIN(.G,DFN,"")
520 ZWR G
521 K G
522 ;
523 QUIT ;end of WARD
524 ;
525 ;
526DIS;
527 N DFN,DTE,EXDTE S DTE=""
528 F D Q:DTE=""
529 . S DTE=$O(^DGPM("B",DTE))
530 . Q:'DTE
531 . Q:$P(DTE,".")<3110703
532 . S EXDTE=$$FMTE^XLFDT(DTE)
533 . N PTFM S PTFM=""
534 . D
535 . . S PTFM=$O(^DGPM("B",DTE,PTFM))
536 . . Q:'PTFM
537 . . S DFN=$P(^DGPM(PTFM,0),U,3)
538 . . S C0QLIST("Patient",DFN)=""
539 . . D DEMO
540 . . D PROBLEM
541 . . D ALLERGY
542 . . D MEDS4
543 . . D RECON2
544 . . D ADVDIR
545 . . D SMOKING
546 . . D VITALS
547 . . D VTE1
548 . . D EDTIME
549 . . I C0QPR D PRINT
550 . . I C0QSS D SS
551 . . I C0QPL D PATLIST
552 Q
553 ;
554C0QPLF() Q 1130580001.301 ; FILE NUMBER FOR C0Q PATIENT LIST FILE
555C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE
556FILE ; FILE THE PATIENT LISTS TO C0Q PATIENT LIST
557 ;
558 I '$D(C0QLIST) Q ;
559 N LFN S LFN=$$C0QALFN()
560 N ZI,ZN
561 S ZI=""
562 F S ZI=$O(C0QLIST(ZI)) Q:ZI="" D ;
563 . S ZN=$O(^C0Q(301,"CATTR",ZI,""))
564 . I ZN="" D Q ; OOPS
565 . . W !,"ERROR, ATTRIBUTE NOT FOUND IN PATIENT LIST FILE:"_ZI
566 . ;S ZN=$$KLNCR(ZN) ; KILL AND RECREATE RECORD ZN
567 . N C0QNEW,C0QOLD,C0QRSLT
568 . S C0QNEW=$NA(C0QLIST(ZI)) ; THE NEW PATIENT LIST
569 . S C0QOLD=$NA(^C0Q(301,ZN,1,"B")) ; THE OLD PATIENT LIST
570 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND WHAT'S NEW
571 . N ZJ,ZK
572 . ; FIRST, DELETE THE OLD ONES - NO LONGER IN THE LIST
573 . K C0QFDA
574 . S ZJ=""
575 . F S ZJ=$O(C0QRSLT(2,ZJ)) Q:ZJ="" D ; MARKED WITH A 2 FROM UNITY
576 . . S ZK=$O(@C0QOLD@(ZJ,"")) ; GET THE IEN OF THE RECORD TO DELETE
577 . . I ZK="" D Q ; OOPS SHOULDN'T HAPPEN
578 . . . W !,"INTERNAL ERROR FINDING A PATIENT TO DELETE"
579 . . . B
580 . . S C0QFDA(LFN,ZK_","_ZN_",",.01)="@"
581 . I $D(C0QFDA) D UPDIE ; PROCESS THE DELETIONS
582 . ; SECOND, PROCESS THE ADDITIONS
583 . K C0QFDA
584 . S ZJ="" S ZK=1
585 . F S ZJ=$O(C0QRSLT(0,ZJ)) Q:ZJ="" D ; PATIENTS TO ADD ARE MARKED WITH 0
586 . . S C0QFDA(LFN,"+"_ZK_","_ZN_",",.01)=ZJ
587 . . S ZK=ZK+1
588 . I $D(C0QFDA) D UPDIE ; PROCESS THE ADDITIONS
589 ;. Q
590 ;. K C0QFDA
591 ;. N ZJ,ZC
592 ;. S ZJ="" S ZC=1
593 ;. F S ZJ=$O(C0QLIST(ZI,ZJ)) Q:ZJ="" D ; FOR EACH PAT IN LIST
594 ;. . S C0QFDA(LFN,"?+"_ZC_","_ZN_",",.01)=ZJ
595 ;. . S ZC=ZC+1
596 ;. D UPDIE
597 ;. W !,"FOUND:"_ZI
598 Q
599 ;
600KLNCR(ZREC) ; KILL AND RECREATE RECORD ZREC IN PATIENT LIST FILE
601 ;
602 N C0QFDA,ZFN,LIST,ATTR
603 S ZFN=$$C0QPLF() ; FILE NUMBER FOR C0Q PATIENT LIST FILE
604 D CLEAN^DILF
605 S LIST=$$GET1^DIQ(ZFN,ZREC_",",.01) ; MEASURE NAME
606 S ATTR=$$GET1^DIQ(ZFN,ZREC_",",999) ; ATTRIBUTE
607 D CLEAN^DILF
608 K ZERR
609 S C0QFDA(ZFN,ZREC_",",.01)="@" ; GET READY TO DELETE THE MEASURE
610 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
611 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
612 ;. W "ERROR",!
613 ;. ZWR ZERR
614 ;. B
615 K C0QFDA
616 S C0QFDA(ZFN,"+1,",.01)=LIST ; GET READY TO RECREATE THE RECORD
617 S C0QFDA(ZFN,"+1,",999)=ATTR ; ATTRIBUTE
618 D UPDIE ; CREATE THE SUBFILE
619 N ZR ; NEW IEN FOR THE RECORD
620 S ZR=$O(^C0Q(301,"CATTR",ATTR,""))
621 ;
622 Q ZR
623 ;
624UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
625 K ZERR
626 D CLEAN^DILF
627 D UPDATE^DIE("","C0QFDA","","ZERR")
628 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
629 ;. W "ERROR",!
630 ;. ZWR ZERR
631 ;. B
632 K C0QFDA
633 Q
634 ;
635 ; WHAT FOLLOWS IS OLD CODE - DELETE WHEN THIS WORKS
636 ;. . N PTNAME S PTNAME=$P(^DPT(DFN,0),U,1)
637 ;. . S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
638 ;. . S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
639 ;. . D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
640 ;. . S PTHRN=$P($G(VA("PID")),U) ;health record number
641 ;. . S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
642 ;. . I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
643 ;. . S RACE=""
644 ;. . F D Q:RACE=""
645 ;. . . S RACE=$O(^DPT(DFN,.02,"B",RACE))
646 ;. . . Q:'RACE
647 ;. . . S RACEDSC=$P($G(^DIC(10,RACE,0)),U)
648 ;. . N ETHNDSC
649 ;. . N ETHNDSC S ETHNDSC=""
650 ;. . S ETHN=""
651 ;. . F D Q:ETHN=""
652 ;. . . S ETHN=$O(^DPT(DFN,.06,"B",ETHN))
653 ;. . . Q:'ETHN
654 ;. . . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U)
655 ;. . D LIST^ORQQPL(.PROBL,DFN,"A")
656 ;. . S PBCNT=""
657 ;. . F S PBCNT=$O(PROBL(PBCNT)) Q:PBCNT="" D
658 ;. . . S PBDESC=$P(PROBL(PBCNT),U,2) ;problem description
659 ;. . K PROBL
660 ;. . D LIST^ORQQAL(.ALRGYL,DFN)
661 ;. . S ALCNT=""
662 ;. . F S ALCNT=$O(ALRGYL(ALCNT)) Q:ALCNT="" D
663 ;. . . S ALDESC=$P(ALRGYL(ALCNT),U,2) ;allergy description
664 ;. . K ALRGYL
665 ;. . D COVER^ORWPS(.MEDSL,DFN)
666 ;. . S MDCNT=""
667 ;. . F S MDCNT=$O(MEDSL(MDCNT)) Q:MDCNT="" D
668 ;. . . Q:$P(MEDSL(MDCNT),U,4)'="ACTIVE" ;active medications only
669 ;. . . S MDDESC=$P(MEDSL(MDCNT),U,2) ;medication description
670 ;. . . S MDITEM=$P($G(MEDSL(MDCNT)),U,3)
671 ;. . K MEDSL
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: ",ETHNDSC
678 ;. . W !,"Problems: "
679 ;. . W !,PBDESC
680 ;. . W !,"Allergies: "
681 ;. . W !,ALDESC
682 ;. . W !,"Medications: "
683 ;. . I $D(MDITEM) W !,"(",MDITEM,")",MDDESC E W !,MDDESC
684 ;. . W !
685 ;Q
686 ;
687 ;
688 ;
689 ;
690END ;end of C0QPRML;
Note: See TracBrowser for help on using the repository browser.