source: qrda/C0Q/trunk/p/C0QUPDT.m@ 1510

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

Adding support for running eRx from the main C0Q package
File size: 10.9 KB
Line 
1C0QUPDT ; GPL - Quality Reporting List Update Routines ; 5/30/12 3:47pm
2 ;;1.0;C0Q;;May 21, 2012;Build 44
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
29C0QPLF() Q 1130580001.301 ; C0Q PATIENT LIST FILE
30C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
31 ;
32UPDATE(RNT,MSET) ; UPDATE A MEASURE SET BY ADDING NEW ENTRIES TO PATIENT
33 ; LISTS AND DELETING ENTRIES THAT ARE NO LONGER VALID. ALSO UPDATE
34 ; NUMERATOR AND DENOMINATOR COUNTS
35 ; MAKES HEAVY USE OF UNITY^C0QSET TO DETERMINE WHAT TO ADD AND DELETE
36 ;
37 ; THIS IS A REPLACEMENT FOR C0QRPC^C0QMAIN WHICH DELETES THE PATIENT
38 ; LISTS AND RECREATES THEM, WHICH IS A LOT OF UNNECESSARY PROCESSING
39 ;
40 N ZI S ZI=""
41 N C0QM ; FOR HOLDING THE MEASURES IN THE SET
42 I $$GET1^DIQ($$C0QMFN,MSET_",",.05,"I")="Y" D Q ; IS IT LOCKED?
43 . W !,"ERROR MEASURE SET IS LOCKED, EXITING"
44 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I;1.2I;2.2I") ; GET ALL THE MEASURES
45 D DELIST("C0QM")
46 N ZII S ZII=""
47 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE
48 . ;
49 . ; Special processing for eRx measure.
50 . I $P(C0QM(ZII),U,2)="MU EP ERX" D ERXCOUNT(MSET,ZII) QUIT
51 . ;
52 . ; Otherwise, we go on
53 . N C0QNL,C0QDL,C0QFLTN,C0QFLTD
54 . S C0QFLTN=$P(C0QM(ZII),U,3) ;IEN OF NUMERATOR FILTER LIST
55 . S C0QFLTD=$P(C0QM(ZII),U,4) ; IEN OF DENOMINATOR FILTER LIST
56 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE
57 . ;
58 . ; Numerator
59 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER
60 . I C0QNL="" D ; CHECK ALTERNATE LIST
61 . . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1.1,"I") ; NUMERATOR POINTER
62 . . I C0QNL'="" S C0QNALT=1
63 . I C0QNL="" QUIT ; No Numerator. Can't perform calculation.--smh
64 . ;
65 . ; Denominator
66 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER
67 . I C0QDL="" D ; CHECK ALTERNATE LIST
68 . . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2.1,"I") ; DENOMINATOR POINTER
69 . . I C0QDL'="" S C0QDALT=1
70 . I C0QDL="" QUIT ; No Denominator. Can't perform calcuation.--smh
71 . ;
72 . ; FIRST PROCESS THE NUMERATOR
73 . ;
74 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
75 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
76 . . S C0QNEW=$NA(^C0Q(301,C0QNL,1,"B")) ; B INDEX FOR THIS LIST
77 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
78 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QNL,30,"B")) ; REMINDER LIST PATIENTS
79 . I C0QFLTN'="" D ; USE A NUMERATOR FILTER LIST
80 . . N ZNEW
81 . . S ZNEW=$NA(^C0Q(301,C0QFLTN,1,"B")) ; B INDEX OF FILTER LIST
82 . . K C0QFLTRD
83 . . D AND^C0QSET("C0QFLTRD",ZNEW,C0QNEW)
84 . . S C0QNEW="C0QFLTRD"
85 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
86 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,1,"B")) ; NUMERATOR LIST IN MEASURE SET
87 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
88 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
89 . N C0QCNT
90 . S C0QNCNT=$G(C0QRSLT("COUNT"))
91 . I C0QNCNT="" D ;
92 . . S C0QNCNT=0 ; DEFAULT COUNT IS ZERO
93 . . N GZZ S GZZ=""
94 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
95 . . . S C0QNCNT=C0QNCNT+1
96 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
97 . . . S C0QNCNT=C0QNCNT+1
98 . K C0QFDA ; CLEAR THE FDA
99 . N C0QONCNT ; OLD COUNT
100 . S C0QONCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",1.1)
101 . I C0QNCNT'=C0QONCNT D ; COUNT HAS CHANGED
102 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",1.1)=C0QNCNT ; NUMERATOR COUNT
103 . . D UPDIE ; UPDATE THE NUMERATOR COUNT
104 . I $D(C0QRSLT) D ;B ;
105 . . ;ZWR C0QRSLT
106 . ; FIRST PROCESS DELETIONS
107 . K C0QFDA ; CLEAR OUT THE FDA
108 . N ZG,ZIEN S ZG=""
109 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
110 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
111 . . I ZIEN="" D Q ; OOPS
112 . . . W !,"ERROR DELETING ENTRY!! ",ZG
113 . . S C0QFDA($$C0QMMNFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
114 . I $D(C0QFDA) D UPDIE ; PROCESS
115 . ; SECOND, PROCESS ADDITIONS
116 . K C0QFDA ; CLEAR OUT THE FDA
117 . N ZG,ZC S ZG="" S ZC=1
118 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
119 . . S C0QFDA($$C0QMMNFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
120 . . S ZC=ZC+1
121 . I $D(C0QFDA) D UPDIE ; PROCESS
122 . ;
123 . ; PROCESS THE DENOMINATOR
124 . ;
125 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
126 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
127 . . S C0QNEW=$NA(^C0Q(301,C0QDL,1,"B")) ; B INDEX FOR THIS LIST
128 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
129 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QDL,30,"B")) ; REMINDER LIST PATIENTS
130 . I C0QFLTD'="" D ; USE A DENOMINATOR FILTER LIST
131 . . N ZNEW
132 . . S ZNEW=$NA(^C0Q(301,C0QFLTD,1,"B")) ; B INDEX OF FILTER LIST
133 . . K C0QFLTRD
134 . . D AND^C0QSET("C0QFLTRD",ZNEW,C0QNEW)
135 . . S C0QNEW="C0QFLTRD"
136 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
137 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,3,"B")) ; DENOMINATOR LIST IN MEASURE SET
138 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
139 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
140 . N C0QDCNT
141 . S C0QDCNT=$G(C0QRSLT("COUNT"))
142 . I C0QDCNT="" D ;
143 . . S C0QDCNT=0 ; DEFAULT COUNT IS ZERO
144 . . N GZZ S GZZ=""
145 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
146 . . . S C0QDCNT=C0QDCNT+1
147 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
148 . . . S C0QDCNT=C0QDCNT+1
149 . K C0QFDA ; CLEAR THE FDA
150 . N C0QODCNT ; OLD COUNT
151 . S C0QODCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",2.1)
152 . I C0QDCNT'=C0QODCNT D ; COUNT HAS CHANGED
153 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",2.1)=C0QDCNT ; DENOMINATOR COUNT
154 . . D UPDIE ; UPDATE THE DENOMINATOR COUNT
155 . I $D(C0QRSLT) D ;B ;
156 . . ;ZWR C0QRSLT
157 . I '$D(C0QRSLT) Q ; NO RESULTS TO USE
158 . ; FIRST PROCESS DELETIONS
159 . K C0QFDA ; CLEAR OUT THE FDA
160 . N ZG,ZIEN S ZG=""
161 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
162 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
163 . . I ZIEN="" D Q ; OOPS
164 . . . W !,"ERROR DELETING ENTRY!! ",ZG
165 . . S C0QFDA($$C0QMMDFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
166 . I $D(C0QFDA) D UPDIE ; PROCESS
167 . ; SECOND, PROCESS ADDITIONS
168 . K C0QFDA ; CLEAR OUT THE FDA
169 . N ZG,ZC S ZG="" S ZC=1
170 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
171 . . S C0QFDA($$C0QMMDFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
172 . . S ZC=ZC+1
173 . I $D(C0QFDA) D UPDIE ; PROCESS
174 . ;
175 . ; File Percentage
176 . N C0QPCT ; PERCENT
177 . D ;
178 . . I C0QDCNT>0 D ;
179 . . . S C0QPCT=$J(100*C0QNCNT/C0QDCNT,0,0)
180 . . E S C0QPCT=0
181 . . K C0QFDA
182 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",3)=C0QPCT ; PERCENT
183 . . D UPDIE
184 Q
185 ;
186DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO
187 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE
188 ; ADDED A B INDEX @RTN@("B",INTERNAL VALUE,IEN)=EXTERNAL VALUE
189 N ZI,IV,EV,ZDI,ZIEN,FLTN,FLTD
190 S ZI=""
191 S ZDI=$NA(^TMP("DILIST",$J))
192 K @RTN
193 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ;
194 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE
195 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE
196 . S FLTN=$G(@ZDI@("ID",ZI,1.2)) ; NUMERATOR FILTER LIST
197 . S FLTD=$G(@ZDI@("ID",ZI,2.2)) ; DENOMINATOR FILTER LIST
198 . S ZIEN=@ZDI@(2,ZI) ; IEN
199 . S @RTN@(ZIEN)=IV_"^"_EV_"^"_FLTN_"^"_FLTD
200 . ;S @RTN@("B",IV,ZIEN)=EV
201 Q
202 ;
203UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
204 K ZERR
205 D CLEAN^DILF
206 N % S %=$NA(C0QFDA) F S %=$Q(@%) Q:%="" W %_"="_@%,! ; smh instead of zwrite
207 D UPDATE^DIE("","C0QFDA","","ZERR")
208 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
209 ;. W "ERROR",!
210 ;. ZWR ZERR
211 ;. B
212 K C0QFDA
213 Q
214 ;
215ERXCOUNT(MSETIEN,MIEN) ; Private Proc; Get eRx and file as Numerator, Denominator, and %
216 ; Inputs:
217 ; MSETIEN - Measurement Set IEN - By Value
218 ; MIEN - Measurement IEN inside the Measurement Set - By Value
219 ; No check is done to see if the caller is sending bad data. Measurement must be
220 ; in a subfile under Measurement Set.
221 ;
222 ; Example of Data we go through in the C0Q Parameter File, so the code below
223 ; will make sense.
224 ; ^C0Q(401,"AMMS",2,1)=""
225 ; ^C0Q(401,"AMMS",2,2)=""
226 ; ^C0Q(401,"AQMS",6,2)=""
227 ; ^C0Q(401,"B","INPATIENT",2)=""
228 ; ^C0Q(401,"B","OUTPATIENT",1)=""
229 ; ^C0Q(401,"MU","MU12",1)=""
230 ; ^C0Q(401,"MU","MU12",2)=""
231 ; ^C0Q(401,"MUTYP","MU12","EP",1)=""
232 ; ^C0Q(401,"MUTYP","MU12","INP",2)=""
233 ;
234 ; Get Parameter year from the Parameters file.
235 ; 1. Get parameter associated with this measurement set from AMMS x-ref (new in C0Q*1*1).
236 N C0QPARAM
237 N % S %="" F S %=$O(^C0Q(401,"AMMS",MSETIEN,%)) Q:%="" S C0QPARAM(%)=""
238 ;
239 ; 2. Find the year for each of those--store as value of node; IEN still subscript.
240 N % S %="" F S %=$O(C0QPARAM(%)) Q:%="" S C0QPARAM(%)=$$GET1^DIQ(1130580001.401,%_",",.02)
241 ;
242 ; 3. Now make sure that this parameter that point to an Outpatient Parameters
243 ; WARNING: CONFUSING CODE WRITTEN BY ME AHEAD
244 ; The % loop will stop with a valid value if found; % is used in the lines immediately below
245 N % S %="" F S %=$O(C0QPARAM(%)) Q:%="" Q:$D(^C0Q(401,"MUTYP",C0QPARAM(%),"EP",%))
246 ;
247 ; 4. If % has a valid IEN (there can be multiple, we take the first), then off we go.
248 ; Otherwise, if it is back to "", we quit.
249 N MUYEAR
250 IF '% W "No suitable parameter found. Cannot determine Measurement Year.",! QUIT
251 ELSE S MUYEAR=C0QPARAM(%)
252 ;
253 ; Now, based on the MU year, construct the patient list name that has the eRx data.
254 N LISTNAME S LISTNAME=MUYEAR_"-"_"EP"_"-"_"HasERX"
255 ;
256 ; Call the API in C0QMUERX to get the counts already calculated
257 ; Data is returned NUM/DEN
258 N COUNTS S COUNTS=$$COUNT^C0QMUERX($$PATLN^C0QMU12(LISTNAME))
259 ;
260 ; File the count
261 N NUM S NUM=$P(COUNTS,"/") ; Numerator
262 N DEN S DEN=$P(COUNTS,"/",2) ; Denominator
263 ;
264 ; Prepare FDA
265 N C0QFDA,C0QERR
266 S C0QFDA($$C0QMMFN(),MIEN_","_MSETIEN_",",1.1)=NUM ; Numerator
267 S C0QFDA($$C0QMMFN(),MIEN_","_MSETIEN_",",2.1)=DEN ; Denominator
268 S C0QFDA($$C0QMMFN(),MIEN_","_MSETIEN_",",3)=$S(DEN=0:0,1:$J(100*NUM/DEN,0,0)) ; Percentage; avoid dividing by zero!
269 ;
270 ; File FDA using Filer not updater (editing existing entry only)
271 D FILE^DIE("ET",$NAME(C0QFDA),$NAME(C0QERR)) ; Flags: External, Transaction
272 ;
273 ; If error, print it out
274 I $D(C0QERR) DO
275 . W "Error filing data",!
276 . N % S %=$NAME(C0QERR) F S %=$Q(@%) Q:%="" W %_": "_@%,!
277 ;
278 QUIT
Note: See TracBrowser for help on using the repository browser.