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

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

Updated routines after many small fixes; added C0QKIDS as well

File size: 7.9 KB
Line 
1C0QUPDT ; GPL - Quality Reporting List Update Routines ; 5/23/12 5:46pm
2 ;;1.0;C0Q;;May 21, 2012;Build 43
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 . N C0QNL,C0QDL,C0QFLTN,C0QFLTD
49 . S C0QFLTN=$P(C0QM(ZII),U,3) ;IEN OF NUMERATOR FILTER LIST
50 . S C0QFLTD=$P(C0QM(ZII),U,4) ; IEN OF DENOMINATOR FILTER LIST
51 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE
52 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER
53 . I C0QNL="" D ; CHECK ALTERNATE LIST
54 . . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1.1,"I") ; NUMERATOR POINTER
55 . . I C0QNL'="" S C0QNALT=1
56 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER
57 . I C0QDL="" D ; CHECK ALTERNATE LIST
58 . . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2.1,"I") ; DENOMINATOR POINTER
59 . . I C0QDL'="" S C0QDALT=1
60 . ;
61 . ; FIRST PROCESS THE NUMERATOR
62 . ;
63 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
64 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
65 . . S C0QNEW=$NA(^C0Q(301,C0QNL,1,"B")) ; B INDEX FOR THIS LIST
66 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
67 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QNL,30,"B")) ; REMINDER LIST PATIENTS
68 . I C0QFLTN'="" D ; USE A NUMERATOR FILTER LIST
69 . . N ZNEW
70 . . S ZNEW=$NA(^C0Q(301,C0QFLTN,1,"B")) ; B INDEX OF FILTER LIST
71 . . K C0QFLTRD
72 . . D AND^C0QSET("C0QFLTRD",ZNEW,C0QNEW)
73 . . S C0QNEW="C0QFLTRD"
74 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
75 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,1,"B")) ; NUMERATOR LIST IN MEASURE SET
76 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
77 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
78 . N C0QCNT
79 . S C0QNCNT=$G(C0QRSLT("COUNT"))
80 . I C0QNCNT="" D ;
81 . . S C0QNCNT=0 ; DEFAULT COUNT IS ZERO
82 . . N GZZ S GZZ=""
83 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
84 . . . S C0QNCNT=C0QNCNT+1
85 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
86 . . . S C0QNCNT=C0QNCNT+1
87 . K C0QFDA ; CLEAR THE FDA
88 . N C0QONCNT ; OLD COUNT
89 . S C0QONCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",1.1)
90 . I C0QNCNT'=C0QONCNT D ; COUNT HAS CHANGED
91 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",1.1)=C0QNCNT ; NUMERATOR COUNT
92 . . D UPDIE ; UPDATE THE NUMERATOR COUNT
93 . I $D(C0QRSLT) D ;B ;
94 . . ;ZWR C0QRSLT
95 . ; FIRST PROCESS DELETIONS
96 . K C0QFDA ; CLEAR OUT THE FDA
97 . N ZG,ZIEN S ZG=""
98 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
99 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
100 . . I ZIEN="" D Q ; OOPS
101 . . . W !,"ERROR DELETING ENTRY!! ",ZG
102 . . S C0QFDA($$C0QMMNFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
103 . I $D(C0QFDA) D UPDIE ; PROCESS
104 . ; SECOND, PROCESS ADDITIONS
105 . K C0QFDA ; CLEAR OUT THE FDA
106 . N ZG,ZC S ZG="" S ZC=1
107 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
108 . . S C0QFDA($$C0QMMNFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
109 . . S ZC=ZC+1
110 . I $D(C0QFDA) D UPDIE ; PROCESS
111 . ;
112 . ; PROCESS THE DENOMINATOR
113 . ;
114 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
115 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
116 . . S C0QNEW=$NA(^C0Q(301,C0QDL,1,"B")) ; B INDEX FOR THIS LIST
117 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
118 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QDL,30,"B")) ; REMINDER LIST PATIENTS
119 . I C0QFLTD'="" D ; USE A DENOMINATOR FILTER LIST
120 . . N ZNEW
121 . . S ZNEW=$NA(^C0Q(301,C0QFLTD,1,"B")) ; B INDEX OF FILTER LIST
122 . . K C0QFLTRD
123 . . D AND^C0QSET("C0QFLTRD",ZNEW,C0QNEW)
124 . . S C0QNEW="C0QFLTRD"
125 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
126 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,3,"B")) ; DENOMINATOR LIST IN MEASURE SET
127 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
128 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
129 . N C0QDCNT
130 . S C0QDCNT=$G(C0QRSLT("COUNT"))
131 . I C0QDCNT="" D ;
132 . . S C0QDCNT=0 ; DEFAULT COUNT IS ZERO
133 . . N GZZ S GZZ=""
134 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
135 . . . S C0QDCNT=C0QDCNT+1
136 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
137 . . . S C0QDCNT=C0QDCNT+1
138 . K C0QFDA ; CLEAR THE FDA
139 . N C0QODCNT ; OLD COUNT
140 . S C0QODCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",2.1)
141 . I C0QDCNT'=C0QODCNT D ; COUNT HAS CHANGED
142 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",2.1)=C0QDCNT ; DENOMINATOR COUNT
143 . . D UPDIE ; UPDATE THE DENOMINATOR COUNT
144 . I $D(C0QRSLT) D ;B ;
145 . . ;ZWR C0QRSLT
146 . I '$D(C0QRSLT) Q ; NO RESULTS TO USE
147 . ; FIRST PROCESS DELETIONS
148 . K C0QFDA ; CLEAR OUT THE FDA
149 . N ZG,ZIEN S ZG=""
150 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
151 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
152 . . I ZIEN="" D Q ; OOPS
153 . . . W !,"ERROR DELETING ENTRY!! ",ZG
154 . . S C0QFDA($$C0QMMDFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
155 . I $D(C0QFDA) D UPDIE ; PROCESS
156 . ; SECOND, PROCESS ADDITIONS
157 . K C0QFDA ; CLEAR OUT THE FDA
158 . N ZG,ZC S ZG="" S ZC=1
159 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
160 . . S C0QFDA($$C0QMMDFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
161 . . S ZC=ZC+1
162 . I $D(C0QFDA) D UPDIE ; PROCESS
163 . N C0QPCT ; PERCENT
164 . D ;
165 . . I C0QDCNT>0 D ;
166 . . . S C0QPCT=$J(100*C0QNCNT/C0QDCNT,0,0)
167 . . E S C0QPCT=0
168 . . K C0QFDA
169 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",3)=C0QPCT ; PERCENT
170 . . D UPDIE
171 Q
172 ;
173DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO
174 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE
175 ; ADDED A B INDEX @RTN@("B",INTERNAL VALUE,IEN)=EXTERNAL VALUE
176 N ZI,IV,EV,ZDI,ZIEN,FLTN,FLTD
177 S ZI=""
178 S ZDI=$NA(^TMP("DILIST",$J))
179 K @RTN
180 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ;
181 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE
182 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE
183 . S FLTN=$G(@ZDI@("ID",ZI,1.2)) ; NUMERATOR FILTER LIST
184 . S FLTD=$G(@ZDI@("ID",ZI,2.2)) ; DENOMINATOR FILTER LIST
185 . S ZIEN=@ZDI@(2,ZI) ; IEN
186 . S @RTN@(ZIEN)=IV_"^"_EV_"^"_FLTN_"^"_FLTD
187 . ;S @RTN@("B",IV,ZIEN)=EV
188 Q
189 ;
190UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
191 K ZERR
192 D CLEAN^DILF
193 ZWRITE C0QFDA
194 D UPDATE^DIE("","C0QFDA","","ZERR")
195 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
196 ;. W "ERROR",!
197 ;. ZWR ZERR
198 ;. B
199 K C0QFDA
200 Q
201 ;
Note: See TracBrowser for help on using the repository browser.