source: qrda/C0Q/trunk/p/C0QMAIN.m@ 1526

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

Latest routines; T11 copy

File size: 12.4 KB
RevLine 
[1223]1C0QMAIN ; GPL - Quality Reporting Main Processing ;10/13/10 17:05
[1501]2 ;;1.0;C0Q;;May 21, 2012;Build 63
[1223]3 ;Copyright 2009 George Lilly. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 Q
21 ;
22C0QQFN() Q 1130580001.101 ; FILE NUMBER FOR C0Q QUALITY MEASURE FILE
23C0QMFN() Q 1130580001.201 ; FILE NUMBER FOR C0Q MEASUREMENT FILE
24C0QMMFN() Q 1130580001.2011 ; FN FOR MEASURE SUBFILE
25C0QMMNFN() Q 1130580001.20111 ; FN FOR NUMERATOR SUBFILE
26C0QMMDFN() Q 1130580001.20112 ; FN FOR DENOMINATOR SUBFILE
27RLSTFN() Q 810.5 ; FN FOR REMINDER PATIENT LIST FILE
28RLSTPFN() Q 810.53 ; FN FOR REMINDER PATIENT LIST PATIENT SUBFILE
[1335]29C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
[1014]30EXPORT ; EXPORT ENTRY POINT FOR CCR
31 ; Select a patient.
32 N C0QMS,C0QM,C0QMIEN,C0QNA,C0QNORD
33 S C0QNORD=3 ; WE WANT DENOMINATORS USE 1 FOR NUMERATORS
34 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
35 I Y<1 Q ; EXIT
36 S C0QMS=$P(Y,U,1) ; SET THE MEASURE SET
37 S DIC=$$C0QQFN,DIC(0)="AEMQ" D ^DIC
38 I Y<1 Q ; EXIT
39 S C0QM=$P(Y,U,1) ; SET THE MEASURE IEN
40 N C0QMN S C0QMN=$P(Y,U,2) ; SET THE MEASURE NAME
41 S C0QMIEN=$O(^C0Q(201,C0QMS,5,"B",C0QM,""))
42 S C0QNA=$NA(^C0Q(201,C0QMS,5,C0QMIEN,C0QNORD,"B"))
43 N ZI S ZI=""
44 F S ZI=$O(@C0QNA@(ZI)) Q:ZI="" D ;
45 . W !,ZI
46 . N ONAME S ONAME=C0QMN_"_"_ZI_"_CCR_V1_0_0.xml"
47 . D XPAT^C0CCCR(ZI,,,ONAME) ; EXPORT TO A FILE
48 Q
49 ;
[1223]50NBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING
51 ;
52 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
53 I Y<1 Q ; EXIT
54 N MSIEN S MSIEN=+Y
55 W !,"NUMERATOR PATIENT LIST",!
56 N C0QPAT
57 D PATS(.C0QPAT,MSIEN,"N") ; GET THE NUMERATOR PATIENT LIST
58 I $D(C0QPAT) D ; LIST RETURNED
59 . ;
60 Q
61 ;
62DBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING
63 ;
64 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
65 I Y<1 Q ; EXIT
66 N MSIEN S MSIEN=+Y
67 N C0QPAT
68 W !,"DENOMINATOR PATIENT LIST",!
69 D PATS(.C0QPAT,MSIEN,"D") ; GET THE NUMERATOR PATIENT LIST
70 I $D(C0QPAT) D ; LIST RETURNED
71 . ;
72 . ;
73 Q
74 ;
75ENEXP ; EXTERNAL MENU ENTRY POINT FOR EXP
76 ;
77 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
78 I Y<1 Q ; EXIT
79 N MSIEN S MSIEN=+Y
80 D EXP(MSIEN)
81 Q
82 ;
83EXP(MSET,NOEX) ; EXPORT ALL PATIENTS FOR MEASURE SET IEN MSET
84 ; ALSO, WRITE OUT THE BY PATIENT MEASURE TEXT FILE
85 ; IF NOEX=1, THEN ONLY THE MEASURE TEXT FILE GETS WRITTEN, NO EXPORTS ARE
86 ; DONE
87 I '$D(NOEX) S NOEX=0
88 N ZQI,ZARY,ZFN,ODIR
89 S ZQI=""
90 D PATS(.ZARY,MSET,"D",1)
91 S ZFN="MEASURES-BY-PATIENT.txt"
92 S ODIR=^TMP("C0CCCR","ODIR") ; OUTPUT DIRECTORY
93 S GARY=$NA(^TMP("C0Q",$J))
94 K @GARY
95 M @GARY=ZARY
96 S GARY1=$NA(@GARY@(1))
97 N ZY
98 S ZY=$$OUTPUT^C0CXPATH(GARY1,ZFN,ODIR)
99 W !,ZY
100 I NOEX=1 Q ; DO NOT EXPORT
101 F S ZQI=$O(ZARY(ZQI)) Q:ZQI="" D ; FOR EACH PATIENT
102 . D XPAT^C0CCCR(+ZARY(ZQI)) ;
103 Q
104 ;
105PATS(ZRTN,MSIEN,NORD,QT) ; BUILDS A LIST OF PATIENTS AND THEIR MEASURES
106 ; FOR MEASURE SET MSET. NORD="N" (DEFAULT) MEANS NUMERATOR PATIENTS
107 ; NORD="D" MEANS DENOMINATOR PATIENTS
108 ; QT=1 MEANS QUIET
109 I $G(QT)'=1 S QT=0
110 N ZI,ZJ,ZK,ZIDX,ZN,ZM
111 S ZN=0 ; COUNT OF PATIENTS
112 S ZI=""
113 ; GOING TO USE THE NUMERATOR BY PATIENT INDEX
114 I '$D(NORD) S NORD="N"
115 I '((NORD="N")!(NORD="D")) S NORD="N"
116 I NORD="N" S ZIDX=$NA(^C0Q(201,"ANBYP"))
117 E S ZIDX=$NA(^C0Q(201,"ADBYP"))
118 F S ZI=$O(@ZIDX@(ZI)) Q:ZI="" D ; FOR EACH PATIENT
119 . I $O(@ZIDX@(ZI,MSIEN,""))'="" D ; IF PATIENT IS IN THIS SET
120 . . I 'QT W !,$$GET1^DIQ(2,ZI_",",.01) ;PATIENT NAME
121 . . S ZN=ZN+1 ; INCREMENT PATIENT COUNT
122 . . S ZRTN(ZN)=ZI
123 . E Q ; NEXT PATIENT
124 . S (ZJ,ZK)=""
125 . F S ZJ=$O(@ZIDX@(ZI,MSIEN,ZJ)) Q:ZJ="" D ; FOR EACH MEASURE
126 . . ;S ZL=$O(@ZIDX@(ZI,MSIEN,ZJ,"")) ; MEASURE IS FOURTH
127 . . S ZK=""
128 . . S ZK=$$GET1^DIQ($$C0QMMFN,ZJ_","_MSIEN_",",.01,"I")
129 . . ;W !,"ZK:",ZK," ZJ:",ZJ," ZI",ZI,!
130 . . S ZM=$$GET1^DIQ($$C0QQFN,ZK_",",.01) ; MEASURE NAME
131 . . I 'QT W " ",ZM
132 . . S ZRTN(ZN)=ZRTN(ZN)_" "_ZM
133 Q
134 ;
135EN ; ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC
136 ;
137 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
138 I Y<1 Q ; EXIT
139 N MSIEN S MSIEN=+Y
[1230]140 ;D C0QRPC(.G,MSIEN)
[1335]141 D UPDATE^C0QUPDT(.G,MSIEN)
[1223]142 Q
143 ;
144EN2 ; SUMMARY ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC
145 ;
146 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
147 I Y<1 Q ; EXIT
148 N MSIEN S MSIEN=+Y
[1335]149 ; changed by gpl to call the new UPDATE^C0QUPDT routine instead
150 D UPDATE^C0QUPDT(.G,MSIEN)
151 Q
152 ; end gpl change
[1223]153 S C0QSUM=1
154 D C0QRPC(.G,MSIEN)
155 ; iterate over the measures
156 S MEASURE=0
157 F S MEASURE=$O(^C0Q(201,MSIEN,5,MEASURE)) Q:MEASURE'>0 D
158 . S NUMER=0,DENOM=0
159 . ; now count the numerator patients
160 . S P=0 F S P=$O(^C0Q(201,MSIEN,5,MEASURE,1,P)) Q:P'>0 S NUMER=NUMER+1
161 . S $P(^C0Q(201,MSIEN,5,MEASURE,2),U)=NUMER
162 . ; and count the denominator patients
163 . S P=0 F S P=$O(^C0Q(201,MSIEN,5,MEASURE,3,P)) Q:P'>0 S DENOM=DENOM+1
164 . Q:DENOM=0
165 . ; and stuff the values
166 . S $P(^C0Q(201,MSIEN,5,MEASURE,4),U,1,2)=DENOM_U_$J(100*NUMER/DENOM,0,0)
167 . Q
168 Q
169 ;
170C0QRPC(RTN,MSET,FMT,NOPURGE) ; RPC FORMAT
171 ; MSET IS THE NAME OR IEN OF THE MEASURE SET
172 ; RTN IS THE RETURN ARRAY OF THE RESULTS PASSED BY REFERENCE
173 ; FMT IS THE FORMAT OF THE OUTPUT - "ARRAY" OR "HTML" OR "XML"
174 ; NOTE: ARRAY IS DEFAULT AND THE OTHERS ARE NOT IMPLEMENTED YET
175 ; IF NOPURGE IS 1, PATIENT LISTS WILL NOT BE DELETED BEFORE ADDING
176 ; IF NOPURGE IS 0 OR OMITTED, PATIENT LISTS WILL BE DELETED THEN ADDED
177 ;W !,"LOOKING FOR MEASURE SET ",MSET,!
178 N ZI S ZI=""
179 N C0QM ; FOR HOLDING THE MEASURES IN THE SET
180 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES
181 D DELIST("C0QM")
[1230]182 N ZII S ZII=0
183 F S ZII=$O(C0QM(ZII)) Q:+ZII=0 D ; FOR EACH MEASURE
[1223]184 . D CLEARMEA(MSET,ZII) ; FIRST CLEAR OUT THE MEASURE
185 K C0QM
186 D CLEAN^DILF
187 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES AGAIN
188 D DELIST("C0QM")
189 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE
190 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE
191 . ;W $$GET1^DIQ($$C0QQFN,ZI_",","DISPLAY NAME"),!
192 . ;N C0QNL,C0QDL ;NUMERATOR AND DENOMINATOR LIST POINTERS
193 . ;W !,"MEASURE: ",$$GET1^DIQ($$C0QQFN,ZI_",",.01),! ; PRINT THE MEASURE NAME
194 . ; FOLLOW THE POINTERS TO THE C0Q QUALITYM MEASURE FILE AND GET LIST PTRS
195 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER
196 . I C0QNL="" D ; CHECK ALTERNATE LIST
197 . . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1.1,"I") ; NUMERATOR POINTER
198 . . I C0QNL'="" S C0QNALT=1
199 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER
200 . I C0QDL="" D ; CHECK ALTERNATE LIST
201 . . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2.1,"I") ; DENOMINATOR POINTER
202 . . I C0QDL'="" S C0QDALT=1
203 . ; NOW FOLLOW THE LIST POINTERS TO THE REMINDER PATIENT LIST FILE
204 . ;W "NUMERATOR: ",$$GET1^DIQ($$RLSTFN,C0QNL_",","NAME"),!
205 . ; FIRST PROCESS THE NUMERATOR
206 . K ^TMP("DILIST",$J)
207 . N C0QUFN ; FILE NUMBER TO USE
208 . I $G(C0QNALT)=1 S C0QUFN=$$C0QALFN()
209 . E S C0QUFN=$$RLSTPFN
210 . D LIST^DIC(C0QUFN,","_C0QNL_",",".01I") ; GET THE LIST OF PATIENTS
211 . ;D DELIST("G") ;
212 . ;I $D(G) ZWR G
213 . K C0QNUMP
214 . S NCNT=$O(^TMP("DILIST",$J,"ID",""),-1) ; NUMERATOR COUNT
215 . N ZJ S ZJ=""
216 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ;
217 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01)
218 . . S C0QNUMP("N",ZJ,ZDFN)=""
219 . ;I '$G(C0QSUM) ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES
220 . D ADDPATS(MSET,ZII,"C0QNUMP")
221 . ; NEXT PROCESS THE DENOMINATOR
222 . ;W "DENOMINATOR: ",$$GET1^DIQ($$RLSTFN,C0QDL_",","NAME"),!
223 . K ^TMP("DILIST",$J)
224 . I $G(C0QDALT)=1 S C0QUFN=$$C0QALFN()
225 . E S C0QUFN=$$RLSTPFN
226 . D LIST^DIC(C0QUFN,","_C0QDL_",",".01I") ; GET THE LIST OF PATIENTS
227 . ;D DELIST("G")
228 . ;I $D(G) ZWR G
229 . ;S ZJ=""
230 . S DCNT=$O(^TMP("DILIST",$J,"ID",""),-1) ; DENOMONIATOR COUNT
231 . K C0QDEMP
232 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ;
233 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01)
234 . . S C0QDEMP("D",ZJ,ZDFN)=""
235 . D ADDPATS(MSET,ZII,"C0QDEMP")
236 . ;I $G(C0QSUM)'=1 ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES
237 . ;E D ;
238 . ;. W "NUM CNT: ",NCNT
239 . ;. W " DEN CNT: ",DCNT,!
240 Q
241 ;
242CLEARMEA(MSET,MEAS) ; DELETE AND THEN RECREATE AS EMPTY THE
243 ; MEASURE MEAS IN MEASURE SET IEN MSET
244 ;
245 N C0QFDA,MFN,MEASURE
246 S MFN=$$C0QMMFN() ; FILE NUMBER FOR MEASURE SUBFILE
247 D CLEAN^DILF
248 S MEASURE=$$GET1^DIQ(MFN,MEAS_","_MSET_",",.01,"I") ; MEASURE POINTER
249 D CLEAN^DILF
250 K ZERR
251 S C0QFDA(MFN,MEAS_","_MSET_",",.01)="@" ; GET READY TO DELETE THE MEASURE
252 D FILE^DIE(,"C0QFDA","ZERR") ; KILL THE SUBFILE
253 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
254 ;. W "ERROR",!
255 ;. ZWR ZERR
256 ;. B
257 K C0QFDA
258 S C0QFDA(MFN,"+1,"_MSET_",",.01)=MEASURE ; GET READY TO RECREATE THE SUBFILE
259 D UPDIE ; CREATE THE SUBFILE
260 Q
261 ;
262ADDPATS(MSET,MEAS,PATS) ;ADD PATIENTS TO NUMERATOR AND DENOMINATOR
263 ; OF MEASURE SET IEN MSET MEASURE IEN MEAS
264 ; PATS IS OF THE FORM @PATS@("N",X,DFN)="" AND @PATS@("D",X,DFN)=""
265 ; WHERE N IS FOR NUMERATOR AND D IS FOR DENOMINATOR AND X 1..N
266 ; IF PATIENTS ARE ALREADY THERE, THEY WILL NOT BE ADDED AGAIN
267 N C0QI,C0QJ
268 N C0QFDA
269 S C0QI=""
270 F S C0QI=$O(@PATS@("N",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT
271 . S C0QFDA($$C0QMMNFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("N",C0QI,""))
272 ;W "ADDING NUMERATOR",!
273 ;I $D(C0QFDA) ZWR C0QFDA
274 I $D(C0QFDA) D UPDIE
275 K C0QFDA
276 S C0QI=""
277 F S C0QI=$O(@PATS@("D",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT
278 . S C0QFDA($$C0QMMDFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("D",C0QI,""))
279 ;W "ADDING DENOMINATOR",!
280 ;I $D(C0QFDA) ZWR C0QFDA
281 I $D(C0QFDA) D UPDIE
282 Q
283 ;
284DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO
285 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE
286 N ZI,IV,EV,ZDI,ZIEN
287 S ZI=""
288 S ZDI=$NA(^TMP("DILIST",$J))
289 K @RTN
290 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ;
291 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE
292 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE
293 . S ZIEN=@ZDI@(2,ZI) ; IEN
294 . S @RTN@(ZIEN)=IV_"^"_EV
295 Q
296 ;
297DELPATS(MSET,MEAS,NDEL) ; DELETE PATIENTS FROM NUMERATOR AND DENOMINATOR
298 ; FOR A MEASURE (ONLY AFFECTS THE C0Q MEASURES FILE)
299 ; MSET IS THE IEN OF THE MEASURE SET
300 ; MEAS IS THE IEN OF THE MEASURE
301 ; NDEL IS A LIST OF PATIENTS TO NOT DELETE (NOT IMPLEMENTED YET)
302 ; IN THE FORM @NDEL@("N",IEN,DFN)="" FOR NUMERATOR PATIENTS
303 ; AND @NDEL@("D",IEN,DFN)="" FOR DENOMINATOR PATIENTS WHERE IEN IS
304 ; THE IEN OF THE PATIENT RECORD IN THE SUBFILE
305 ; THIS FEATURE WILL ALLOW EFFICIENCIES FOR LONG PATIENT LISTS
306 ; IN THAT PATIENTS THAT ARE GOING TO BE ADDED ARE NOT FIRST DELETED
307 N C0QI,C0QJ
308 D LIST^DIC($$C0QMMFN,","_MSET_",")
309 K C0QFDA
310 ;ZWR ^TMP("DILIST",$J,*)
311 ;ZWR ^TMP("DIERR",$J,*)
312 ;D
313 Q
314 ;
[1014]315UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
[1223]316 K ZERR
317 D CLEAN^DILF
318 D UPDATE^DIE("","C0QFDA","","ZERR")
319 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
320 ;. W "ERROR",!
321 ;. ZWR ZERR
322 ;. B
323 K C0QFDA
324 Q
325 ;
326QUE ;QUE THE RUN OF THE PATIENT LISTS AND THE BUILD THE LISTS OF THE PATIENTS
327 ;AND THEIR MEASURES
328 S MSIEN=$$GET^XPAR("DIV."_$P($$SITE^VASITE(),U,2),"C0Q MEASUREMENT TO USE")
329 N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
330 S ZTDESC="CREATE PATIENT LIST"
331 S ZTRTN="RUN^C0QMAIN"
332 S ZTSAVE("MSIEN")=""
333 S ZTIO=""
334 S ZTDTH=$$NOW^XLFDT
335 D ^%ZTLOAD
336 Q
337 ;
338RUN ; DO THE REAL WORK
339 I '$D(MSIEN) S MSIEN=$$GET^XPAR("DIV."_$P($$SITE^VASITE(),U,2),"C0Q MEASUREMENT TO USE")
340 S BEG=$P(^C0Q(201,MSIEN,4),U,3) ;Begin date
341 S END=$P(^C0Q(201,MSIEN,4),U,4) ;End date
342 S PATCREAT="N" ;Secure list - N=No
343 S PLISTPUG="N" ;Purge list after 5 years - N=No
344 S PXRMDPAT=0 ;Include deceased patients - N=No
345 S PXRMTPAT=0 ;Include test patients - N=No
346 S PXRMNODE="PXRMRULE" ;Node in ^TMP($J,"PXRMRULE"
347 N ZI S ZI=""
348 F S ZI=$O(^C0Q(201,MSIEN,5,"B",ZI)) Q:ZI'>0 D ; LOOP THROUGH EACH QM
349 . S PXRMLSTN=+$P(^C0Q(101,ZI,0),U,2) ; NUMERATOR MEASURE
350 . S PXRMLSTD=+$P(^C0Q(101,ZI,0),U,3) ; DENOMINATOR MEASURE
351 . S PXRMRULN=+$P(^PXRMXP(810.5,PXRMLSTN,0),U,6) ; RULES FOR THE LIST
352 . S PXRMRULD=+$P(^PXRMXP(810.5,PXRMLSTD,0),U,6)
353 . D RUN^PXRMLCR(PXRMRULD,PXRMLSTD,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT)
354 . D RUN^PXRMLCR(PXRMRULN,PXRMLSTN,PXRMNODE,BEG,END,PXRMDPAT,PXRMTPAT)
355 D C0QRPC(.G,MSIEN)
356 Q
Note: See TracBrowser for help on using the repository browser.