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

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

added smoking status and cpoe calculation

File size: 7.0 KB
RevLine 
[1232]1C0QUPDT ; GPL - Quality Reporting List Update Routines ;8/29/11 17:05
2 ;;0.1;C0Q;nopatch;noreleasedate;Build 19
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
29C0QALFN() Q 1130580001.311 ; FILE NUMBER FOR C0Q PATIENT LIST PATIENT SUBFILE ;
30 ;
31UPDATE(RNT,MSET) ; UPDATE A MEASURE SET BY ADDING NEW ENTRIES TO PATIENT
32 ; LISTS AND DELETING ENTRIES THAT ARE NO LONGER VALID. ALSO UPDATE
33 ; NUMERATOR AND DENOMINATOR COUNTS
34 ; MAKES HEAVY USE OF UNITY^C0QSET TO DETERMINE WHAT TO ADD AND DELETE
35 ;
36 ; THIS IS A REPLACEMENT FOR C0QRPC^C0QMAIN WHICH DELETES THE PATIENT
37 ; LISTS AND RECREATES THEM, WHICH IS A LOT OF UNNECESSARY PROCESSING
38 ;
39 N ZI S ZI=""
40 N C0QM ; FOR HOLDING THE MEASURES IN THE SET
41 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES
42 D DELIST("C0QM")
43 N ZII S ZII=""
44 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE
45 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE
46 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER
47 . I C0QNL="" D ; CHECK ALTERNATE LIST
48 . . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1.1,"I") ; NUMERATOR POINTER
49 . . I C0QNL'="" S C0QNALT=1
50 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER
51 . I C0QDL="" D ; CHECK ALTERNATE LIST
52 . . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2.1,"I") ; DENOMINATOR POINTER
53 . . I C0QDL'="" S C0QDALT=1
54 . ;
55 . ; FIRST PROCESS THE NUMERATOR
56 . ;
57 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
58 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
59 . . S C0QNEW=$NA(^C0Q(301,C0QNL,1,"B")) ; B INDEX FOR THIS LIST
60 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
61 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QNL,30,"B")) ; REMINDER LIST PATIENTS
62 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
63 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,1,"B")) ; NUMERATOR LIST IN MEASURE SET
64 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
65 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
66 . N C0QCNT
67 . S C0QNCNT=$G(C0QRSLT("COUNT"))
68 . I C0QNCNT="" D ;
69 . . S C0QNCNT=0 ; DEFAULT COUNT IS ZERO
70 . . N GZZ S GZZ=""
71 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
72 . . . S C0QNCNT=C0QNCNT+1
73 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
74 . . . S C0QNCNT=C0QNCNT+1
75 . K C0QFDA ; CLEAR THE FDA
76 . N C0QONCNT ; OLD COUNT
77 . S C0QONCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",1.1)
78 . I C0QNCNT'=C0QONCNT D ; COUNT HAS CHANGED
79 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",1.1)=C0QNCNT ; NUMERATOR COUNT
80 . . D UPDIE ; UPDATE THE NUMERATOR COUNT
81 . I $D(C0QRSLT) D ;B ;
82 . . ;ZWR C0QRSLT
83 . ; FIRST PROCESS DELETIONS
84 . K C0QFDA ; CLEAR OUT THE FDA
85 . N ZG,ZIEN S ZG=""
86 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
87 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
88 . . I ZIEN="" D Q ; OOPS
89 . . . W !,"ERROR DELETING ENTRY!! ",ZG
90 . . S C0QFDA($$C0QMMNFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
91 . I $D(C0QFDA) D UPDIE ; PROCESS
92 . ; SECOND, PROCESS ADDITIONS
93 . K C0QFDA ; CLEAR OUT THE FDA
94 . N ZG,ZC S ZG="" S ZC=1
95 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
96 . . S C0QFDA($$C0QMMNFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
97 . . S ZC=ZC+1
98 . I $D(C0QFDA) D UPDIE ; PROCESS
99 . ;
100 . ; PROCESS THE DENOMINATOR
101 . ;
102 . N C0QNEW ; REFERENCE TO NEW NUMBERATOR LIST B INDEX
103 . I $G(C0QNALT)=1 D ; USING ALTERNATE LIST FOR NUMERATOR
104 . . S C0QNEW=$NA(^C0Q(301,C0QDL,1,"B")) ; B INDEX FOR THIS LIST
105 . E D ; USE THE REMINDER PACKAGE PATIENT LISTS
106 . . S C0QNEW=$NA(^PXRMXP(810.5,C0QDL,30,"B")) ; REMINDER LIST PATIENTS
107 . N C0QOLD ; REFERENCE FOR OLD PATIENT LIST
108 . S C0QOLD=$NA(^C0Q(201,MSET,5,ZII,3,"B")) ; DENOMINATOR LIST IN MEASURE SET
109 . N C0QRSLT ; ARRAY FOR THE UNITY DIFFERENCES
110 . D UNITY^C0QSET("C0QRSLT",C0QNEW,C0QOLD) ; FIND THE DIFFERENCES
111 . N C0QDCNT
112 . S C0QDCNT=$G(C0QRSLT("COUNT"))
113 . I C0QDCNT="" D ;
114 . . S C0QDCNT=0 ; DEFAULT COUNT IS ZERO
115 . . N GZZ S GZZ=""
116 . . F S GZZ=$O(C0QRSLT(0,GZZ)) Q:GZZ="" D ; EVERY ADD ENTRY
117 . . . S C0QDCNT=C0QDCNT+1
118 . . F S GZZ=$O(C0QRSLT(1,GZZ)) Q:GZZ="" D ; EVERY EQUAL ENTRY
119 . . . S C0QDCNT=C0QDCNT+1
120 . K C0QFDA ; CLEAR THE FDA
121 . N C0QODCNT ; OLD COUNT
122 . S C0QODCNT=$$GET1^DIQ($$C0QMMFN(),ZII_","_MSET_",",2.1)
123 . I C0QDCNT'=C0QODCNT D ; COUNT HAS CHANGED
124 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",2.1)=C0QDCNT ; DENOMINATOR COUNT
125 . . D UPDIE ; UPDATE THE DENOMINATOR COUNT
126 . I $D(C0QRSLT) D ;B ;
127 . . ;ZWR C0QRSLT
128 . I '$D(C0QRSLT) Q ; NO RESULTS TO USE
129 . ; FIRST PROCESS DELETIONS
130 . K C0QFDA ; CLEAR OUT THE FDA
131 . N ZG,ZIEN S ZG=""
132 . F S ZG=$O(C0QRSLT(2,ZG)) Q:ZG="" D ; FOR EACH DELETION
133 . . S ZIEN=$O(@C0QOLD@(ZG,"")) ; IEN OF THE ENTRY
134 . . I ZIEN="" D Q ; OOPS
135 . . . W !,"ERROR DELETING ENTRY!! ",ZG
136 . . S C0QFDA($$C0QMMDFN(),ZIEN_","_ZII_","_MSET_",",.01)="@" ; DELETE
137 . I $D(C0QFDA) D UPDIE ; PROCESS
138 . ; SECOND, PROCESS ADDITIONS
139 . K C0QFDA ; CLEAR OUT THE FDA
140 . N ZG,ZC S ZG="" S ZC=1
141 . F S ZG=$O(C0QRSLT(0,ZG)) Q:ZG="" D ; FOR EACH ADDITION
142 . . S C0QFDA($$C0QMMDFN(),"+"_ZC_","_ZII_","_MSET_",",.01)=ZG ; ADD THE ENTRY
143 . . S ZC=ZC+1
144 . I $D(C0QFDA) D UPDIE ; PROCESS
145 . N C0QPCT ; PERCENT
146 . I C0QDCNT>0 D ;
147 . . S C0QPCT=$J(100*C0QNCNT/C0QDCNT,0,0)
148 . . K C0QFDA
149 . . S C0QFDA($$C0QMMFN(),ZII_","_MSET_",",3)=C0QPCT ; PERCENT
150 . . D UPDIE
151 Q
152 ;
153DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO
154 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE
155 ; ADDED A B INDEX @RTN@("B",INTERNAL VALUE,IEN)=EXTERNAL VALUE
156 N ZI,IV,EV,ZDI,ZIEN
157 S ZI=""
158 S ZDI=$NA(^TMP("DILIST",$J))
159 K @RTN
160 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ;
161 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE
162 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE
163 . S ZIEN=@ZDI@(2,ZI) ; IEN
164 . S @RTN@(ZIEN)=IV_"^"_EV
165 . ;S @RTN@("B",IV,ZIEN)=EV
166 Q
167 ;
168UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
169 K ZERR
170 D CLEAN^DILF
171 ZWR C0QFDA
172 D UPDATE^DIE("","C0QFDA","","ZERR")
173 I $D(ZERR) S ZZERR=ZZERR ; ZZERR DOESN'T EXIST, INVOKE THE ERROR TRAP IF TASKED
174 ;. W "ERROR",!
175 ;. ZWR ZERR
176 ;. B
177 K C0QFDA
178 Q
179 ;
Note: See TracBrowser for help on using the repository browser.