source: qrda/C0Q/trunk/p/C0QMUERX.m@ 1781

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

Adding support for running eRx from the main C0Q package
File size: 11.0 KB
Line 
1C0QMUERX ; VEN - Analyze ERx Data for Patients ; 5/30/12 12:40pm
2 ;;1.0;C0Q;;May 21, 2012;Build 44
3 QUIT ; No Entry from the top
4 ;
5UT ; Unit Tests
6 N C0QDEBUG S C0QDEBUG=1
7 W "Testing ^DPT B Index",!
8 D EN("^DPT(""B"")")
9 W !,"Testing B Index on a C0Q Patient List",!
10 D EN("^C0Q(301,4,1,""B"")")
11 W !,"Testing ^AUPNPAT B Index",!
12 D EN("^AUPNPAT(""B"")")
13 W !,"Testing Reminder Patient List B Index",!
14 D EN("^PXRMXP(810.5,80,30,""B"")")
15 W !,"Testing upright file ^DPT",!
16 D EN("^DPT")
17 W !,"Testing a file with no data",!
18 D EN("^ALKJSDF")
19 W !,"Testing a no valid parameters",!
20 D EN("")
21UT2 ; Units Tests 2
22 N C0QDEBUG S C0QDEBUG=1
23 D EN("^C0Q(301,4,1,""B"")")
24 QUIT
25UT3 ; More Unit Tests
26 N C0QDEBUG S C0QDEBUG=1
27 D EN($$PATLN^C0QMU12("MU12-EP-HasERX"))
28 W $$COUNT($$PATLN^C0QMU12("MU12-EP-HasERX"))
29 QUIT
30EN(C0QLIST) ; PEP - Analyze ERx Data and store
31 ; Parameters:
32 ; C0QLIST - Pass by Name. Global or Local Reference.
33 ; Can be: ^DPT("B") for all patients or ^C0Q(301,2,1,"B") for a specific patient list
34 ; Future: Can be a search template on file 2 or 9000001
35 ;
36 ; Check if XML Soap Message is installed
37 I '$D(^C0PX("B","GETMEDS6")) WRITE "GETMEDS6 Soap Message not installed",! QUIT
38 ;
39 ; Check if SOAP^C0PWS2 exists
40 I '$L($T(SOAP^C0PWS2)) WRITE "C0PWS2 Doesn't exist",! QUIT
41 ;
42 ; Check C0QLIST for sanity. Must be a single node.
43 IF '($DATA(C0QLIST)#2)!(C0QLIST="") WRITE "You didn't pass the list",! QUIT
44 ;
45 ; Contents must be a Reference with Data
46 IF '$DATA(@C0QLIST) WRITE "Destination doesn't contain any data",! QUIT
47 ;
48 ; Is this a B index?
49 NEW C0QB
50 IF $QSUBSCRIPT(C0QLIST,$QLENGTH(C0QLIST))="B" DO
51 . SET C0QB=1
52 . ; DEBUG
53 . W:$G(C0QDEBUG) "B index passed",!
54 . ; DEBUG
55 ELSE SET C0QB=0
56 ;
57 ; Make sure our TMP is empty
58 K ^TMP($J)
59 ;
60 ; Walk the global
61 N C0QWALK S C0QWALK=$SELECT(C0QB:"",'C0QB:0) ; Walker, start of $ORDER?
62 N C0QDONE S C0QDONE=0 ; Finish Flag
63 FOR SET C0QWALK=$O(@C0QLIST@(C0QWALK)) QUIT:C0QDONE DO
64 . ; Are we done?
65 . I C0QB,C0QWALK="" S C0QDONE=1 QUIT ; If in index and we are out, done
66 . I 'C0QB,'+C0QWALK S C0QDONE=1 QUIT ; If not in index and we are not numeric, done
67 . ;
68 . N C0QDFN ; DFN of Patient
69 . ; If Walking B Index and Index not numeric, grab DFN (assuming ^DPT or ^AUPNPAT)
70 . ; TODO: Should I check that the global is ^DPT or ^AUPNPAT?
71 . I C0QB,'+C0QWALK S C0QDFN=$O(@C0QLIST@(C0QWALK,""))
72 . ; Otherwise, we will assume the contents of the index are the DFNs
73 . E S C0QDFN=C0QWALK
74 . I $G(C0QDEBUG) W C0QDFN," "
75 . ;
76 . ; Now, check to see if the patient has e-Rx's
77 . I $$HASERX(C0QDFN) S ^TMP($J,C0QDFN)=""
78 ;
79 W:$G(C0QDEBUG) ! ;
80 ;
81 ; Loop through collected DFNs, send to WS, and get data back, store in ^TMP($J,DFN)
82 N C0QDFN S C0QDFN=0
83 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
84 . N C0POUT
85 . W:$G(C0QDEBUG) "Calling GETMEDS6 SOAP Web Service Call for "_C0QDFN,!
86 . D SOAP^C0PWS2("C0POUT","GETMEDS6",DUZ,C0QDFN)
87 . Q:$G(C0POUT(1,"RowCount"))=0 ; WS says no data
88 . M ^TMP($J,C0QDFN)=C0POUT
89 ;
90 ; From the New Crop Meaningful Use documentation:
91 ; Appendix G: Meaningful Use Certification FAQ Question 10
92 ;
93 ; DENOMINATOR NUMERATOR
94 ; DeaClassCode = 0, 9 DeaClassCode = 0, 9
95 ; PharmacyType = 1 PharmacyType = 1
96 ; PharmacyDetailType = 1, 2 PharmacyDetailType = 1, 2
97 ; FinalDestinationType = 1, 2, 3, 4 FinalDestinationType = 3, 4
98 ; FinalStatusType = 1, 4, 5 FinalStatusType = 1, 5
99 ;
100 ; DeMorgan's Law
101 ; NOT(A or B) = NOT(A) and NOT(B)
102 ; So to collect prescriptions for which DeaClassCode is 0 or 9
103 ; We exclude all those who are not 0 AND not 9.
104 ; See: http://en.wikipedia.org/wiki/De_Morgan%27s_laws#Negation_of_a_disjunction
105 ;
106 ; The algorithms below use an Onion Peeling method. Any prescription which
107 ; fails makes you jump to the next prescription.
108 ; The "Onion levels" are:
109 ; DeaClassCode, PharamcyType, PharmacyDetailType, FinalDestinationType, FinalStatusType
110 ;
111 ; Now walk through collected DFNs and accumulate MU stats
112 ;
113 ; WARNING: Naked References below
114 ;
115 N C0QDFN,C0QRXNO S (C0QDFN,C0QRXNO)=0
116 N C0QD S C0QD=0 ; Denominator - Overall (cf C0QDP below)
117 ;
118 ; Calculate Denominator below
119 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
120 . N C0QDP S C0QDP=0 ; Denominator - Patient Specific
121 . F S C0QRXNO=$O(^TMP($J,C0QDFN,C0QRXNO)) Q:C0QRXNO="" DO
122 .. W:$G(C0QDEBUG) "Patient "_C0QDFN_" Rx "_C0QRXNO,!
123 .. ;
124 .. I ^(C0QRXNO,"DeaClassCode") ; Change $REFERENCE
125 .. ;
126 .. N DEA S DEA=^("DeaClassCode")
127 .. W:$G(C0QDEBUG) "DeaClassCode: "_DEA,!
128 .. Q:((DEA'=0)&(DEA'=9))
129 .. ;
130 .. N PT S PT=^("PharmacyType")
131 .. W:$G(C0QDEBUG) "PharmacyType: "_PT,!
132 .. Q:(PT'=1)
133 .. ;
134 .. N PDT S PDT=^("PharmacyDetailType")
135 .. W:$G(C0QDEBUG) "PharmacyDetailType: "_PDT,!
136 .. Q:((PDT'=1)&(PDT'=2))
137 .. ;
138 .. N FDT S FDT=^("FinalDestinationType")
139 .. W:$G(C0QDEBUG) "FinalDestinationType: "_FDT,!
140 .. Q:((FDT'=1)&(FDT'=2)&(FDT'=3)&(FDT'=4))
141 .. ;
142 .. N FST S FST=^("FinalStatusType")
143 .. W:$G(C0QDEBUG) "FinalStatusType: "_FST,!
144 .. Q:((FST'=1)&(FST'=4)&(FST'=5))
145 .. ;
146 .. W:$G(C0QDEBUG) "Adding to Denominator",!
147 .. S C0QDP=C0QDP+1
148 .. S C0QD=C0QD+1
149 . ;
150 . ; SAVE C0QDP - while it lasts!
151 . D SAVE(C0QLIST,C0QDFN,"ERXDEN",C0QDP)
152 ;
153 ; Calculate Numerator below
154 N C0QDFN,C0QRXNO S (C0QDFN,C0QRXNO)=0
155 N C0QN S C0QN=0 ; Numerator - Overall (cf C0QNP below)
156 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
157 . N C0QNP S C0QNP=0 ; Numerator - Patient Specific
158 . F S C0QRXNO=$O(^TMP($J,C0QDFN,C0QRXNO)) Q:C0QRXNO="" DO
159 .. W:$G(C0QDEBUG) "Patient "_C0QDFN_" Rx "_C0QRXNO,!
160 .. ;
161 .. I ^(C0QRXNO,"DeaClassCode") ; Change $REFERENCE
162 .. ;
163 .. N DEA S DEA=^("DeaClassCode")
164 .. W:$G(C0QDEBUG) "DeaClassCode: "_DEA,!
165 .. Q:((DEA'=0)&(DEA'=9))
166 .. ;
167 .. N PT S PT=^("PharmacyType")
168 .. W:$G(C0QDEBUG) "PharmacyType: "_PT,!
169 .. Q:(PT'=1)
170 .. ;
171 .. N PDT S PDT=^("PharmacyDetailType")
172 .. W:$G(C0QDEBUG) "PharmacyDetailType: "_PDT,!
173 .. Q:((PDT'=1)&(PDT'=2))
174 .. ;
175 .. N FDT S FDT=^("FinalDestinationType")
176 .. W:$G(C0QDEBUG) "FinalDestinationType: "_FDT,!
177 .. Q:((FDT'=3)&(FDT'=4))
178 .. ;
179 .. N FST S FST=^("FinalStatusType")
180 .. W:$G(C0QDEBUG) "FinalStatusType: "_FST,!
181 .. Q:((FST'=1)&(FST'=5))
182 .. ;
183 .. W:$G(C0QDEBUG) "Adding to Numerator",!
184 .. S C0QNP=C0QNP+1
185 .. S C0QN=C0QN+1
186 . ;
187 . ; Save C0QNP while it lasts
188 . D SAVE(C0QLIST,C0QDFN,"ERXNUM",C0QNP)
189 ;
190 S ^TMP($J)=C0QN_U_C0QD
191 ;
192 ; TODO: Over here, do something with the numerator and denominator..
193 ; Probably store them somewhere.
194 ;
195 I '$G(C0QDEBUG) K ^TMP($J) ; Empty out in production not testing
196 QUIT
197 ;
198HASERX(DFN) ; $$ - Private; Has E-Prescriptions?
199 ; Parameters
200 ; - DFN by Value
201 ; Output
202 ; 0 or 1 (false or true)
203 N ZI S ZI=""
204 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
205 N DONE,HASERX
206 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" Q:$G(DONE) D
207 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" S (DONE,HASERX)=1
208 Q +$G(HASERX)
209 ;
210SAVE(C0QLIST,C0QDFN,TYPE,COUNT) ; Proc - Private; Save Count in C0Q(301, file
211 ; Layman's Explanation: Save the denominator or numerator for ePrescribing for
212 ; each of the patients in the Subfile for that patient in ^C0Q(301,
213 ; Still hard to understand though! Here's a demo:
214 ; ^C0Q(301,IEN has a subfile under node 1 which stores the patients. E.g.
215 ; ^C0Q(301,48,1,15,0)=91$
216 ; ^C0Q(301,48,1,16,0)=93$
217 ; ^C0Q(301,48,1,17,0)=173$
218 ;
219 ; I store the numerator and denominator under each of the patients. The numerator
220 ; stands for the number of prescriptions that were electronically transmitted;
221 ; the denominator stands for the numbers of prescriptions that COULD HAVE BEEN
222 ; electronically transmitted. End result for Patient 173 is as follows:
223 ; ^C0Q(301,48,1,17,0)=173
224 ; ^C0Q(301,48,1,17,1,0)="^1130580001.3111^2^2"
225 ; ^C0Q(301,48,1,17,1,1,0)="ERXDEN^0"
226 ; ^C0Q(301,48,1,17,1,2,0)="ERXNUM^0"
227 ; ^C0Q(301,48,1,17,1,"B","ERXDEN",1)=""
228 ; ^C0Q(301,48,1,17,1,"B","ERXNUM",2)=""
229 ;
230 ; Subroutine COUNT (below) goes and counts the data
231 ;
232 ; Params:
233 ; C0QLIST (by val): "B" x-ref where patients are located. Only supports ^C0Q(301, file.
234 ; C0QDFN (by val): Patient DFN for whom to file data.
235 ; TYPE (by val): Either ERXDEN or ERXNUM for eRx Denominator or eRx Numerator
236 ; COUNT (by val): The number to save
237 ;
238 ; First, QUIT if this isn't a Quality Measures List?
239 ; $QS(x,0) gets you the global name
240 ;
241 ; This should give you an idea of what I am dealing with!
242 ;
243 ; ^C0Q(301,48,1,15,0)=91
244 ; ^C0Q(301,48,1,16,0)=93
245 ; ^C0Q(301,48,1,17,0)=173
246 ; ^C0Q(301,48,1,18,0)=174
247 ; ^C0Q(301,48,1,"B",5,1)=""
248 ; ^C0Q(301,48,1,"B",10,2)=""
249 ; ^C0Q(301,48,1,"B",11,3)=""
250 ; ^C0Q(301,48,1,"B",14,4)=""
251 ;
252 I $QS(C0QLIST,0)'="^C0Q" W:$G(C0QDEBUG) "Not Saving Patient "_C0QDFN,! QUIT
253 ;
254 ; Otherwise, prepare to save
255 N C0QFDA ; Fileman Data Array
256 N C0QIENS ; IENS
257 N L1,L2 ; Top Level, Level 2
258 S L1=$QS(C0QLIST,2) ; Top Level IEN
259 S L2=$O(^C0Q(301,L1,1,"B",C0QDFN,"")) ; Patient IEN
260 S C0QIENS="?+1"_C0QDFN_","_L2_","_L1_"," ; TODO: Here C0QDFN is a dummy for uniqueness in FDA, not meaningful! - DO BETTER!
261 W:$G(C0QDEBUG) "IENs "_C0QIENS_" ready to file",!
262 W:$G(C0QDEBUG) "Saving "_TYPE_" of "_COUNT_" for Patient "_$P(^DPT(C0QDFN,0),U)_" ("_C0QDFN_")",!
263 S C0QFDA(1130580001.3111,C0QIENS,.01)=TYPE
264 S C0QFDA(1130580001.3111,C0QIENS,.02)=COUNT
265 ;
266 W:$G(C0QDEBUG) "Fileman Data Array",!
267 I $G(C0QDEBUG) N % S %=$NA(C0QFDA) F S %=$Q(@%) Q:%="" W %_": "_@%,!
268 ;
269 N C0QERR ; Errors
270 D UPDATE^DIE("","C0QFDA","","C0QERR")
271 ;
272 I $D(C0QERR) DO
273 . W "Error in filing data",!
274 . N % S %=$NAME(C0QERR) F S %=$Q(@%) Q:%="" W %_": "_@%,!
275 ;
276 QUIT
277 ;
278COUNT(C0QLIST) ; $$ - Private; Count Numerator and Denominator for a Patient List
279 ; Input: C0QLIST - Pass by Value - Patient Listing B index (only C0Q(301,IEN,1,"B", listing is supported)
280 ; Output: (as string) NUMERATOR/DENOMINATOR
281 ;
282 I $QS(C0QLIST,0)'="^C0Q" W:$G(C0QDEBUG) "Counting for files other than C0Q(301, not supported ",! QUIT "0/0"
283 ; MEASURE -----------
284 ; IEN ----------- |
285 ; L1 ------| | |
286 ; V V V
287 ; ^C0Q(301,48,1,2,1,1,0)="ERXDEN^0"
288 ; ^C0Q(301,48,1,2,1,2,0)="ERXNUM^0"
289 ; ^C0Q(301,48,1,2,1,"B","ERXDEN",1)=""
290 ; ^C0Q(301,48,1,2,1,"B","ERXNUM",2)=""
291 ; ^C0Q(301,48,1,2,1,"B"
292 W:$G(C0QDEBUG) "DFN",?20,"Denominator",?40,"Numerator",!
293 ;
294 N L1 S L1=$QS(C0QLIST,2) ; Top Level IEN
295 ;
296 N DENTOT,NUMTOT S (DENTOT,NUMTOT)=0 ; Denominator Total, Numerator Total
297 ;
298 N C0QDFN S C0QDFN=0 ; Walker through B index
299 F S C0QDFN=$O(^C0Q(301,L1,1,"B",C0QDFN)) Q:C0QDFN="" DO
300 . N IEN S IEN=$O(^(C0QDFN,"")) ; naked naked - get IEN from B index
301 . W:$G(C0QDEBUG) C0QDFN
302 . ;
303 . ; Denom Processing
304 . N DENIEN S DENIEN=$O(^C0Q(301,L1,1,IEN,1,"B","ERXDEN","")) ; Denom IEN
305 . N DEN S DEN=$S(DENIEN:$P(^C0Q(301,L1,1,IEN,1,DENIEN,0),U,2),1:"N/A") ; Denominator
306 . W:$G(C0QDEBUG) ?20,DEN
307 . S DENTOT=DENTOT+DEN ; Total it up (N/A becomes zero)
308 . ;
309 . N NUMIEN S NUMIEN=$O(^C0Q(301,L1,1,IEN,1,"B","ERXNUM","")) ; Numerator IEN
310 . N NUM S NUM=$S(NUMIEN:$P(^C0Q(301,L1,1,IEN,1,NUMIEN,0),U,2),1:"N/A") ; Numerator
311 . W:$G(C0QDEBUG) ?40,NUM
312 . S NUMTOT=NUMTOT+NUM ; Total it up (N/A becomes zero)
313 . ;
314 . w:$G(C0QDEBUG) !
315 ;
316 ; Write the totals
317 D:$G(C0QDEBUG)
318 . W ?20,"==="
319 . W ?40,"==="
320 . W !
321 . ;
322 . W ?20,DENTOT
323 . W ?40,NUMTOT
324 . W !
325 ;
326 ; Quit with Numeartor/Denominator
327 QUIT NUMTOT_"/"_DENTOT
Note: See TracBrowser for help on using the repository browser.