source: qrda/C0Q/branches/recon/JJOHMU12.m

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

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