source: qrda/C0Q/branches/ohum/p/C0QMAIN2.m@ 1743

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

reorganizing the project for ohum contributions

File size: 7.7 KB
Line 
1C0QMAIN ; GPL - Quality Reporting Main Processing ;10/13/10 17:05
2 ;;0.1;C0Q;nopatch;noreleasedate;
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
29 ;
30NBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING
31 ;
32 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
33 I Y<1 Q ; EXIT
34 N MSIEN S MSIEN=+Y
35 W !,"NUMERATOR PATIENT LIST",!
36 N C0QPAT
37 D PATS(.C0QPAT,MSIEN,"N") ; GET THE NUMERATOR PATIENT LIST
38 I $D(C0QPAT) D ; LIST RETURNED
39 .
40 . ;
41 Q
42 ;
43DBYP ; ENTRY POINT FOR COMMAND LINE BY PATIENT MEASURE LISTING
44 ;
45 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
46 I Y<1 Q ; EXIT
47 N MSIEN S MSIEN=+Y
48 N C0QPAT
49 W !,"DENOMINATOR PATIENT LIST",!
50 D PATS(.C0QPAT,MSIEN,"D") ; GET THE NUMERATOR PATIENT LIST
51 I $D(C0QPAT) D ; LIST RETURNED
52 . ;
53 . ;
54 Q
55 ;
56PATS(ZRTN,MSIEN,NORD,PAT,EFORM) ; BUILDS A LIST OF PATIENTS AND THEIR MEASURES
57 ; FOR MEASURE SET MSIEN. NORD="N" (DEFAULT) MEANS NUMERATOR PATIENTS
58 ; NORD="D" MEANS DENOMINATOR PATIENTS
59 ; PAT IS THE IEN OF A SINGLE PATIENT FOR PROCESSING. IF PAT IS OMMITED OR "*",
60 ; ALL PATIENTS IN THE MEASURE SET NUM/DENOM WILL BE PROCESSED
61 ; EFORM=1 MEANS ZRTN IS IN "EXTERNAL FORMAT" - THIS IS FOR USE AS AN RPC
62 ; EXTERNAL FORMAT IS AN ARRAY OF STRINGS
63 ; ZRTN(x)=DFN^NAME^MEASURE IEN^MEASURE NAME
64 ; ONE FOR EACH MEASURE FOR EACH PATIENT IN THE NUMERATOR/DENOMINATOR
65 ; EFORM=0 (DEFAULT) MEANS "INTERNAL FORMAT" - THIS IS FOR MUMPS CALLS
66 ; ZRTN(DFN,MEASURE IEN)="" IT IS A PAIR OF POINTERS IN INDEX FORMAT
67 ; ONE FOR EACH MEASURE FOR EACH PATIENT IN THE NUMERATOR/DENOMINATOR
68 ;
69 N ZI,ZJ,ZK,ZIDX
70 S ZI=""
71 ; GOING TO USE THE NUMERATOR BY PATIENT INDEX
72 I '$D(NORD) S NORD="N"
73 I '((NORD="N")!(NORD="D")) S NORD="N"
74 I NORD="N" S ZIDX=$NA(^C0Q(201,"ANBYP"))
75 E S ZIDX=$NA(^C0Q(201,"ADBYP"))
76 F S ZI=$O(@ZIDX@(ZI)) Q:ZI="" D ; FOR EACH PATIENT
77 . I $O(@ZIDX@(ZI,MSIEN,""))'="" D ; IF PATIENT IS IN THIS SET
78 . . W !,$$GET1^DIQ(2,ZI_",",.01) ;PATIENT NAME
79 . E Q ; NEXT PATIENT
80 . S (ZJ,ZK)=""
81 . F S ZJ=$O(@ZIDX@(ZI,MSIEN,ZJ)) Q:ZJ="" D ; FOR EACH MEASURE
82 . . ;S ZL=$O(@ZIDX@(ZI,MSIEN,ZJ,"")) ; MEASURE IS FOURTH
83 . . S ZK=""
84 . . S ZK=$$GET1^DIQ($$C0QMMFN,ZJ_","_MSIEN_",",.01,"I")
85 . . ;W !,"ZK:",ZK," ZJ:",ZJ," ZI",ZI,!
86 . . W " ",$$GET1^DIQ($$C0QQFN,ZK_",",.01) ; MEASURE NAME
87 Q
88 ;
89EN ; ENTRY POINT FOR COMMAND LINE AND MENU ACCESS TO C0QRPC
90 ;
91 S DIC=$$C0QMFN,DIC(0)="AEMQ" D ^DIC
92 I Y<1 Q ; EXIT
93 N MSIEN S MSIEN=+Y
94 D C0QRPC(.G,MSIEN)
95 Q
96 ;
97C0QRPC(RTN,MSET,FMT,NOPURGE) ; RPC FORMAT
98 ; MSET IS THE NAME OR IEN OF THE MEASURE SET
99 ; RTN IS THE RETURN ARRAY OF THE RESULTS PASSED BY REFERENCE
100 ; FMT IS THE FORMAT OF THE OUTPUT - "ARRAY" OR "HTML" OR "XML"
101 ; NOTE: ARRAY IS DEFAULT AND THE OTHERS ARE NOT IMPLEMENTED YET
102 ; IF NOPURGE IS 1, PATIENT LISTS WILL NOT BE DELETED BEFORE ADDING
103 ; IF NOPURGE IS 0 OR OMITTED, PATIENT LISTS WILL BE DELETED THEN ADDED
104 W !,"LOOKING FOR MEASURE SET ",MSET,!
105 N ZI S ZI=""
106 N C0QM ; FOR HOLDING THE MEASURES IN THE SET
107 D LIST^DIC($$C0QMMFN,","_MSET_",",".01I") ; GET ALL THE MEASURES
108 D DELIST("C0QM")
109 N ZII S ZII=""
110 F S ZII=$O(C0QM(ZII)) Q:ZII="" D ; FOR EACH MEASURE
111 . S ZI=$P(C0QM(ZII),U,1) ; IEN OF THE MEASURE IN THE C0Q QUALITY MEAS FILE
112 . ;W $$GET1^DIQ($$C0QQFN,ZI_",","DISPLAY NAME"),!
113 . ;N C0QNL,C0QDL ;NUMERATOR AND DENOMINATOR LIST POINTERS
114 . W "MEASURE: ",$$GET1^DIQ($$C0QQFN,ZI_",",.01),! ; PRINT THE MEASURE NAME
115 . ; FOLLOW THE POINTERS TO THE C0Q QUALITY MEASURE FILE AND GET LIST PTRS
116 . S C0QNL=$$GET1^DIQ($$C0QQFN,ZI_",",1,"I") ; NUMERATOR POINTER
117 . S C0QDL=$$GET1^DIQ($$C0QQFN,ZI_",",2,"I") ; DENOMINATOR POINTER
118 . ; NOW FOLLOW THE LIST POINTERS TO THE REMINDER PATIENT LIST FILE
119 . W "NUMERATOR: ",$$GET1^DIQ($$RLSTFN,C0QNL_",","NAME"),!
120 . ; FIRST PROCESS THE NUMERATOR
121 . K ^TMP("DILIST",$J)
122 . D LIST^DIC($$RLSTPFN,","_C0QNL_",",".01I") ; GET THE LIST OF PATIENTS
123 . ;D DELIST("G") ;
124 . ;I $D(G) ZWR G
125 . K C0QNUMP
126 . N ZJ S ZJ=""
127 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ;
128 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01)
129 . . S C0QNUMP("N",ZJ,ZDFN)=""
130 . ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES
131 . D ADDPATS(MSET,ZII,"C0QNUMP")
132 . ; NEXT PROCESS THE DENOMINATOR
133 . W "DENOMINATOR: ",$$GET1^DIQ($$RLSTFN,C0QDL_",","NAME"),!
134 . K ^TMP("DILIST",$J)
135 . D LIST^DIC($$RLSTPFN,","_C0QDL_",",".01I") ; GET THE LIST OF PATIENTS
136 . ;D DELIST("G")
137 . ;I $D(G) ZWR G
138 . ;S ZJ=""
139 . K C0QDEMP
140 . F S ZJ=$O(^TMP("DILIST",$J,"ID",ZJ)) Q:ZJ="" D ;
141 . . S ZDFN=^TMP("DILIST",$J,"ID",ZJ,.01)
142 . . S C0QDEMP("D",ZJ,ZDFN)=""
143 . D ADDPATS(MSET,ZII,"C0QDEMP")
144 . ZWR ^TMP("DILIST",$J,1,*) ; LIST THE PATIENT NAMES
145 Q
146 ;
147ADDPATS(MSET,MEAS,PATS) ;ADD PATIENTS TO NUMERATOR AND DENOMINATOR
148 ; OF MEASURE SET IEN MSET MEASURE IEN MEAS
149 ; PATS IS OF THE FORM @PATS@("N",X,DFN)="" AND @PATS@("D",X,DFN)=""
150 ; WHERE N IS FOR NUMERATOR AND D IS FOR DENOMINATOR AND X 1..N
151 ; IF PATIENTS ARE ALREADY THERE, THEY WILL NOT BE ADDED AGAIN
152 N C0QI,C0QJ
153 N C0QFDA
154 S C0QI=""
155 F S C0QI=$O(@PATS@("N",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT
156 . S C0QFDA($$C0QMMNFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("N",C0QI,""))
157 ;W "ADDING NUMERATOR",!
158 ;I $D(C0QFDA) ZWR C0QFDA
159 I $D(C0QFDA) D UPDIE
160 K C0QFDA
161 S C0QI=""
162 F S C0QI=$O(@PATS@("D",C0QI)) Q:C0QI="" D ; FOR EACH NUMERATOR PATIENT
163 . S C0QFDA($$C0QMMDFN,"?+"_C0QI_","_MEAS_","_MSET_",",.01)=$O(@PATS@("D",C0QI,""))
164 ;W "ADDING DENOMINATOR",!
165 ;I $D(C0QFDA) ZWR C0QFDA
166 I $D(C0QFDA) D UPDIE
167 Q
168 ;
169DELIST(RTN) ; DECODES ^TMP("DILIST",$J) INTO
170 ; @RTN@(IEN)=INTERNAL VALUE^EXTERNAL VALUE
171 N ZI,IV,EV,ZDI,ZIEN
172 S ZI=""
173 S ZDI=$NA(^TMP("DILIST",$J))
174 K @RTN
175 F S ZI=$O(@ZDI@(1,ZI)) Q:ZI="" D ;
176 . S EV=@ZDI@(1,ZI) ;EXTERNAL VALUE
177 . S IV=$G(@ZDI@("ID",ZI,.01)) ; INTERNAL VALUE
178 . S ZIEN=@ZDI@(2,ZI) ; IEN
179 . S @RTN@(ZIEN)=IV_"^"_EV
180 Q
181 ;
182DELPATS(MSET,MEAS,NDEL) ; DELETE PATIENTS FROM NUMERATOR AND DENOMINATOR
183 ; FOR A MEASURE (ONLY AFFECTS THE C0Q MEASURES FILE)
184 ; MSET IS THE IEN OF THE MEASURE SET
185 ; MEAS IS THE IEN OF THE MEASURE
186 ; NDEL IS A LIST OF PATIENTS TO NOT DELETE (NOT IMPLEMENTED YET)
187 ; IN THE FORM @NDEL@("N",IEN,DFN)="" FOR NUMERATOR PATIENTS
188 ; AND @NDEL@("D",IEN,DFN)="" FOR DENOMINATOR PATIENTS WHERE IEN IS
189 ; THE IEN OF THE PATIENT RECORD IN THE SUBFILE
190 ; THIS FEATURE WILL ALLOW EFFICIENCIES FOR LONG PATIENT LISTS
191 ; IN THAT PATIENTS THAT ARE GOING TO BE ADDED ARE NOT FIRST DELETED
192 N C0QI,C0QJ
193 D LIST^DIC($$C0QMMFN,","_MSET_",")
194 K C0QFDA
195 ZWR ^TMP("DILIST",$J,*)
196 ZWR ^TMP("DIERR",$J,*)
197 D
198 Q
199 ;
200UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
201 K ZERR
202 D CLEAN^DILF
203 D UPDATE^DIE("","C0QFDA","","ZERR")
204 I $D(ZERR) D ;
205 . W "ERROR",!
206 . ZWR ZERR
207 . B
208 K C0QFDA
209 Q
210 ;
Note: See TracBrowser for help on using the repository browser.