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

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

Adding support for filing the denominator and numerator into a patient list
File size: 8.0 KB
Line 
1C0QMUERX ; VEN - Analyze ERx Data for Patients ; 5/30/12 1:48am
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 QUIT
29EN(C0QLIST) ; PEP - Analyze ERx Data and store
30 ; Parameters:
31 ; C0QLIST - Pass by Name. Global or Local Reference.
32 ; Can be: ^DPT("B") for all patients or ^C0Q(301,2,1,"B") for a specific patient list
33 ; Future: Can be a search template on file 2 or 9000001
34 ;
35 ; Check if XML Soap Message is installed
36 I '$D(^C0PX("B","GETMEDS6")) WRITE "GETMEDS6 Soap Message not installed",! QUIT
37 ;
38 ; Check if SOAP^C0PWS2 exists
39 I '$L($T(SOAP^C0PWS2)) WRITE "C0PWS2 Doesn't exist",! QUIT
40 ;
41 ; Check C0QLIST for sanity. Must be a single node.
42 IF '($DATA(C0QLIST)#2)!(C0QLIST="") WRITE "You didn't pass the list",! QUIT
43 ;
44 ; Contents must be a Reference with Data
45 IF '$DATA(@C0QLIST) WRITE "Destination doesn't contain any data",! QUIT
46 ;
47 ; Is this a B index?
48 NEW C0QB
49 IF $QSUBSCRIPT(C0QLIST,$QLENGTH(C0QLIST))="B" DO
50 . SET C0QB=1
51 . ; DEBUG
52 . W:$G(C0QDEBUG) "B index passed",!
53 . ; DEBUG
54 ELSE SET C0QB=0
55 ;
56 ; Make sure our TMP is empty
57 K ^TMP($J)
58 ;
59 ; Walk the global
60 N C0QWALK S C0QWALK=$SELECT(C0QB:"",'C0QB:0) ; Walker, start of $ORDER?
61 N C0QDONE S C0QDONE=0 ; Finish Flag
62 FOR SET C0QWALK=$O(@C0QLIST@(C0QWALK)) QUIT:C0QDONE DO
63 . ; Are we done?
64 . I C0QB,C0QWALK="" S C0QDONE=1 QUIT ; If in index and we are out, done
65 . I 'C0QB,'+C0QWALK S C0QDONE=1 QUIT ; If not in index and we are not numeric, done
66 . ;
67 . N C0QDFN ; DFN of Patient
68 . ; If Walking B Index and Index not numeric, grab DFN (assuming ^DPT or ^AUPNPAT)
69 . ; TODO: Should I check that the global is ^DPT or ^AUPNPAT?
70 . I C0QB,'+C0QWALK S C0QDFN=$O(@C0QLIST@(C0QWALK,""))
71 . ; Otherwise, we will assume the contents of the index are the DFNs
72 . E S C0QDFN=C0QWALK
73 . I $G(C0QDEBUG) W C0QDFN," "
74 . ;
75 . ; Now, check to see if the patient has e-Rx's
76 . I $$HASERX(C0QDFN) S ^TMP($J,C0QDFN)=""
77 ;
78 W:$G(C0QDEBUG) ! ;
79 ;
80 ; Loop through collected DFNs, send to WS, and get data back, store in ^TMP($J,DFN)
81 N C0QDFN S C0QDFN=0
82 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
83 . N C0POUT
84 . W:$G(C0QDEBUG) "Calling GETMEDS6 SOAP Web Service Call for "_C0QDFN,!
85 . D SOAP^C0PWS2("C0POUT","GETMEDS6",DUZ,C0QDFN)
86 . Q:$G(C0POUT(1,"RowCount"))=0 ; WS says no data
87 . M ^TMP($J,C0QDFN)=C0POUT
88 ;
89 ; From the New Crop Meaningful Use documentation:
90 ; Appendix G: Meaningful Use Certification FAQ Question 10
91 ;
92 ; DENOMINATOR NUMERATOR
93 ; DeaClassCode = 0, 9 DeaClassCode = 0, 9
94 ; PharmacyType = 1 PharmacyType = 1
95 ; PharmacyDetailType = 1, 2 PharmacyDetailType = 1, 2
96 ; FinalDestinationType = 1, 2, 3, 4 FinalDestinationType = 3, 4
97 ; FinalStatusType = 1, 4, 5 FinalStatusType = 1, 5
98 ;
99 ; DeMorgan's Law
100 ; NOT(A or B) = NOT(A) and NOT(B)
101 ; So to collect prescriptions for which DeaClassCode is 0 or 9
102 ; We exclude all those who are not 0 AND not 9.
103 ; See: http://en.wikipedia.org/wiki/De_Morgan%27s_laws#Negation_of_a_disjunction
104 ;
105 ; The algorithms below use an Onion Peeling method. Any prescription which
106 ; fails makes you jump to the next prescription.
107 ; The "Onion levels" are:
108 ; DeaClassCode, PharamcyType, PharmacyDetailType, FinalDestinationType, FinalStatusType
109 ;
110 ; Now walk through collected DFNs and accumulate MU stats
111 ;
112 ; WARNING: Naked References below
113 ;
114 N C0QDFN,C0QRXNO S (C0QDFN,C0QRXNO)=0
115 N C0QD S C0QD=0 ; Denominator - Overall (cf C0QDP below)
116 ;
117 ; Calculate Denominator below
118 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
119 . N C0QDP S C0QDP=0 ; Denominator - Patient Specific
120 . F S C0QRXNO=$O(^TMP($J,C0QDFN,C0QRXNO)) Q:C0QRXNO="" DO
121 .. W:$G(C0QDEBUG) "Patient "_C0QDFN_" Rx "_C0QRXNO,!
122 .. ;
123 .. I ^(C0QRXNO,"DeaClassCode") ; Change $REFERENCE
124 .. ;
125 .. N DEA S DEA=^("DeaClassCode")
126 .. W:$G(C0QDEBUG) "DeaClassCode: "_DEA,!
127 .. Q:((DEA'=0)&(DEA'=9))
128 .. ;
129 .. N PT S PT=^("PharmacyType")
130 .. W:$G(C0QDEBUG) "PharmacyType: "_PT,!
131 .. Q:(PT'=1)
132 .. ;
133 .. N PDT S PDT=^("PharmacyDetailType")
134 .. W:$G(C0QDEBUG) "PharmacyDetailType: "_PDT,!
135 .. Q:((PDT'=1)&(PDT'=2))
136 .. ;
137 .. N FDT S FDT=^("FinalDestinationType")
138 .. W:$G(C0QDEBUG) "FinalDestinationType: "_FDT,!
139 .. Q:((FDT'=1)&(FDT'=2)&(FDT'=3)&(FDT'=4))
140 .. ;
141 .. N FST S FST=^("FinalStatusType")
142 .. W:$G(C0QDEBUG) "FinalStatusType: "_FST,!
143 .. Q:((FST'=1)&(FST'=4)&(FST'=5))
144 .. ;
145 .. W:$G(C0QDEBUG) "Adding to Denominator",!
146 .. S C0QDP=C0QDP+1
147 .. S C0QD=C0QD+1
148 . ;
149 . ; SAVE C0QDP - while it lasts!
150 . D SAVE(C0QLIST,C0QDFN,"ERXDEN",C0QDP)
151 ;
152 ; Calculate Numerator below
153 N C0QDFN,C0QRXNO S (C0QDFN,C0QRXNO)=0
154 N C0QN S C0QN=0 ; Numerator - Overall (cf C0QNP below)
155 F S C0QDFN=$O(^TMP($J,C0QDFN)) Q:C0QDFN="" DO
156 . N C0QNP S C0QNP=0 ; Numerator - Patient Specific
157 . F S C0QRXNO=$O(^TMP($J,C0QDFN,C0QRXNO)) Q:C0QRXNO="" DO
158 .. W:$G(C0QDEBUG) "Patient "_C0QDFN_" Rx "_C0QRXNO,!
159 .. ;
160 .. I ^(C0QRXNO,"DeaClassCode") ; Change $REFERENCE
161 .. ;
162 .. N DEA S DEA=^("DeaClassCode")
163 .. W:$G(C0QDEBUG) "DeaClassCode: "_DEA,!
164 .. Q:((DEA'=0)&(DEA'=9))
165 .. ;
166 .. N PT S PT=^("PharmacyType")
167 .. W:$G(C0QDEBUG) "PharmacyType: "_PT,!
168 .. Q:(PT'=1)
169 .. ;
170 .. N PDT S PDT=^("PharmacyDetailType")
171 .. W:$G(C0QDEBUG) "PharmacyDetailType: "_PDT,!
172 .. Q:((PDT'=1)&(PDT'=2))
173 .. ;
174 .. N FDT S FDT=^("FinalDestinationType")
175 .. W:$G(C0QDEBUG) "FinalDestinationType: "_FDT,!
176 .. Q:((FDT'=3)&(FDT'=4))
177 .. ;
178 .. N FST S FST=^("FinalStatusType")
179 .. W:$G(C0QDEBUG) "FinalStatusType: "_FST,!
180 .. Q:((FST'=1)&(FST'=5))
181 .. ;
182 .. W:$G(C0QDEBUG) "Adding to Numerator",!
183 .. S C0QNP=C0QNP+1
184 .. S C0QN=C0QN+1
185 . ;
186 . ; Save C0QNP while it lasts
187 . D SAVE(C0QLIST,C0QDFN,"ERXNUM",C0QNP)
188 ;
189 S ^TMP($J)=C0QN_U_C0QD
190 ;
191 ; TODO: Over here, do something with the numerator and denominator..
192 ; Probably store them somewhere.
193 ;
194 I '$G(C0QDEBUG) K ^TMP($J) ; Empty out in production not testing
195 QUIT
196 ;
197HASERX(DFN) ; $$ - Private; Has E-Prescriptions?
198 ; Parameters
199 ; - DFN by Value
200 ; Output
201 ; 0 or 1 (false or true)
202 N ZI S ZI=""
203 N ZERX S ZERX=$NA(^PS(55,DFN,"NVA"))
204 N DONE,HASERX
205 F S ZI=$O(@ZERX@(ZI)) Q:ZI="" Q:$G(DONE) D
206 . I $G(@ZERX@(ZI,1,1,0))["E-Rx Web" S (DONE,HASERX)=1
207 Q +$G(HASERX)
208 ;
209SAVE(C0QLIST,C0QDFN,TYPE,COUNT) ; Proc - Private; Save Count
210 ; TODO: Documentation
211 ;
212 ; First, QUIT if this isn't a Quality Measures List?
213 ; $QS(x,0) gets you the global name
214 ;
215 ; This should give you an idea of what I am dealing with!
216 ;
217 ; ^C0Q(301,48,1,15,0)=91
218 ; ^C0Q(301,48,1,16,0)=93
219 ; ^C0Q(301,48,1,17,0)=173
220 ; ^C0Q(301,48,1,18,0)=174
221 ; ^C0Q(301,48,1,"B",5,1)=""
222 ; ^C0Q(301,48,1,"B",10,2)=""
223 ; ^C0Q(301,48,1,"B",11,3)=""
224 ; ^C0Q(301,48,1,"B",14,4)=""
225 ;
226 I $QS(C0QLIST,0)'="^C0Q" W:$G(C0QDEBUG) "Not Saving Patient "_C0QDFN,! QUIT
227 ;
228 ; Otherwise, prepare to save
229 N C0QFDA ; Fileman Data Array
230 N C0QIENS ; IENS
231 N L1,L2 ; Top Level, Level 2
232 S L1=$QS(C0QLIST,2) ; Top Level IEN
233 S L2=$O(^C0Q(301,L1,1,"B",C0QDFN,"")) ; Patient IEN
234 S C0QIENS="?+1"_C0QDFN_","_L2_","_L1_"," ; TODO: Here C0QDFN is a dummy for uniqueness in FDA, not meaningful! - DO BETTER!
235 W:$G(C0QDEBUG) "IENs "_C0QIENS_" ready to file",!
236 W:$G(C0QDEBUG) "Saving "_TYPE_" of "_COUNT_" for Patient "_$P(^DPT(C0QDFN,0),U)_" ("_C0QDFN_")",!
237 S C0QFDA(1130580001.3111,C0QIENS,.01)=TYPE
238 S C0QFDA(1130580001.3111,C0QIENS,.02)=COUNT
239 ;
240 W:$G(C0QDEBUG) "Fileman Data Array",!
241 I $G(C0QDEBUG) N % S %=$NA(C0QFDA) F S %=$Q(@%) Q:%="" W %_": "_@%,!
242 ;
243 N C0QERR ; Errors
244 D UPDATE^DIE("","C0QFDA","","C0QERR")
245 ;
246 I $D(C0QERR) DO
247 . W "Error in filing data",!
248 . S %=$NAME(C0QERR) F S %=$Q(@%) Q:%="" W %_": "_@%,!
249 ;
250 QUIT
Note: See TracBrowser for help on using the repository browser.