source: qrda/C0Q/trunk/p/C0QQRDA.m@ 1698

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

updated

File size: 10.2 KB
RevLine 
[1519]1C0QQRDA ; GPL - Quality Reporting QRDA Processing ; 8/2/12 10:15am
[1517]2 ;;1.0;QUALITY MEASURES;**4**;May 21, 2012;Build 28
[1516]3 ;Copyright 2012 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 ;
[1518]20EN ; Private to this Package; Main Entry Point for this routine
21 ; This EP is interactive or silent depending on params
22 ;
[1519]23 ; Check for config errors first; try to set-up.
24 N % S %=$$CHECKPAR()
25 I +%=1 D EN^DDIOL($P(%,U,2)) QUIT ; No inpatient pars found... QUIT
26 I +%=2 D ; No QRDA Measure Sets... try to set it up.
27 . D EN^DDIOL("Trying to automatically set-up measure sets in parameters")
28 . N % S %=$$SETUPPAR($$INPPARM())
29 . I % D EN^DDIOL("Failed to set-up..."_$P(%,U,2))
30 . E D EN^DDIOL("...Set-up complete")
[1518]31 ;
32 ; Print Intro
33 N %
34 S %(1)="This program collects patients from the denominators of the measures"
35 S %(2)="STK, VTE, and ED and outputs modified CCR files to the kernel default"
36 S %(3)="directory (probably /tmp/)."
37 S %(4)=""
38 S %(5)="This will take some time to execute."
39 S %(6)=""
40 S %(6,"F")="!!!"
41 ;
42 D EN^DDIOL(.%)
43 ;
44 ; Ask user which measure set to run
45 N DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,DA ; DIR variables
[1519]46 S DIR(0)="SB^V:VTE;S:STK;E:ED;A:ALL"
[1518]47 S DIR("A")="Measure to calculate"
48 S DIR("A",1)="Which measure set would you like to produce QRDA documents for?"
49 S DIR("A",2)="Choose to Run [V]TE Measure Set, [S]TK Measure Set, or "
[1519]50 S DIR("A",3)="[E]D Measure Set. Or you can choose to run [A]ll of them."
[1518]51 D ^DIR
52 ;
53 I $G(DTOUT)!$G(DUOUT) QUIT ; Did user hit '^' or time out?
54 ;
55 ; Get the Measure Set IEN which the user has seleted.
56 ; NB: field names start with VTE, STK, or ED; so I can use the output
57 ; of DIR directly.
58 ;
[1519]59 N FLD S FLD=Y(0) ; Grab full text of user choice into var "FLD" for field.
60 N C0QMSIENS ; Measure set IENs (^ piece); (0) stores the identifier for file names
61 ;looks like this in the end
62 ; C0QMSIENS=1^3^5
63 ; C0QMSIENS(0)="ED^VTE^STK"
[1518]64 ;
[1519]65 N INPPARM S INPPARM=$$INPPARM() ; Inpatient Parameter IEN in 401
[1518]66 ;
[1519]67 ; If not all, grab the measure; else, grab all of them in ^ pieces
68 I FLD'="ALL" D
69 . S C0QMSIENS=$$GET1^DIQ(1130580001.401,INPPARM,FLD,"I")
70 . S C0QMSIENS(0)=FLD
71 ;
72 E D
73 . N C0QED S C0QED=$$GET1^DIQ(1130580001.401,INPPARM,"ED","I")
74 . N C0QVTE S C0QVTE=$$GET1^DIQ(1130580001.401,INPPARM,"VTE","I")
75 . N C0QSTK S C0QSTK=$$GET1^DIQ(1130580001.401,INPPARM,"STK","I")
76 . S C0QMSIENS=C0QED_U_C0QVTE_U_C0QSTK
77 . S C0QMSIENS(0)="ED"_U_"VTE"_U_"STK"
78 ;
79 ;
80 S:'C0QMSIENS $EC=",U1," ; Debug.Assert that MSIEN is numeric.
81 ;
82 ;
[1518]83 ; Do the work
[1519]84 N C0QI ; Counter through the measures
85 F C0QI=1:1:$L(C0QMSIENS,U) D
86 . N MSIEN S MSIEN=$P(C0QMSIENS,U,C0QI) ; Measure Set IEN
87 . N MSNAME S MSNAME=$P(C0QMSIENS(0),U,C0QI) ; Measure Set Name
88 . N REF S REF=$NAME(^TMP("C0QQRDA",$J)) ; Global for data collection
89 . K @REF ; Clear global
90 . D WORK(REF,MSIEN) ; Process Measure Set, collect data in global
91 . D PRINTXML(REF,MSNAME) ; Generate XML; output to File.
92 . K @REF ; Clear global
[1516]93 QUIT
94 ;
[1518]95 ;SILENTEN(RETURN) ; For future RPC calls...; needs to be reworked.
[1519]96 ; N % S %=$$CHECKPAR()
[1518]97 ; I % S RETURN(0)=% Q
[1516]98 ;
[1518]99 ; N DIQUIET S DIQUIET=1
100 ; D EN
101 ; S RETURN(0)=0
102 ; QUIT
103 ;
[1519]104CHECKPAR() ; Private Proc; Check if environment is okay.
105 ; Output: 0 or +ve^message for error
106 ; 1 -> No Inpatient Parameters found
107 ; 2 -> Measurement Set(s) not found.
108 ;
[1518]109 N INPPARM S INPPARM=$$INPPARM() ; Inpatient Parameters IEN
110 I 'INPPARM Q 1_U_"No Inpatient Parameters found"
111 ;
112 ; Pointer fields to Measurement Set file, we grab the IENs
113 N C0QED S C0QED=$$GET1^DIQ(1130580001.401,INPPARM,"ED","I")
114 N C0QSTK S C0QSTK=$$GET1^DIQ(1130580001.401,INPPARM,"STK","I")
115 N C0QVTE S C0QVTE=$$GET1^DIQ(1130580001.401,INPPARM,"VTE","I")
116 ;
117 N TXT S TXT="" ; Error text
118 I 'C0QED S TXT=TXT_"ED,"
119 I 'C0QSTK S TXT=TXT_"STK,"
120 I 'C0QVTE S TXT=TXT_"VTE"
[1519]121 I $E(TXT,$L(TXT))="," S TXT=$E(TXT,1,$L(TXT)-1) ; remove trailing comma
[1518]122 I $L(TXT) Q 2_U_"Measure Sets missing from parameters: "_TXT
123 ;
124 QUIT 0 ; All okay
125 ;
[1519]126SETUPPAR(INPPARM) ; Private Proc; Set-up QRDA lists if Inpatient Param is found.
127 ; Input: Inpatient Parameter IEN in C0Q(401, -> C0Q Parameters
128 ; Output: 0 if okay or 1^error description
129 N C0QFDA
130 ;
131 N VTEIEN S VTEIEN=$O(^C0Q(201,"B","VTE CMS REPORTING MEASURES",""))
132 I 'VTEIEN QUIT 1_U_"VTE not found"
133 N STKIEN S STKIEN=$O(^C0Q(201,"B","STK CMS REPORTING MEASURES",""))
134 I 'STKIEN QUIT 1_U_"STK not found"
135 N EDIEN S EDIEN=$O(^C0Q(201,"B","ED CMS REPORTING MEASURES",""))
136 I 'EDIEN QUIT 1_U_"ED not found"
137 ;
138 S C0QFDA(1130580001.401,INPPARM_",",5.1)=VTEIEN
139 S C0QFDA(1130580001.401,INPPARM_",",5.2)=STKIEN
140 S C0QFDA(1130580001.401,INPPARM_",",5.3)=EDIEN
141 ;
142 N C0QERR
143 D FILE^DIE("",$NA(C0QFDA),$NA(C0QERR))
144 I $D(C0QERR) Q 2_U_C0QERR("DIERR",1,"TEXT",1)
145 Q 0
146 ;
[1518]147WORK(C0QREF,C0QMSIEN) ; Private Proc; Process Measure Sets; Collect the data.
148 ; Input/Output: C0QREF -> Global for Output passed by Name
149 ; C0QMSIEN -> (Input): Measurement Set IEN to calculate
150 ;
151 ; Print
152 D EN^DDIOL(C0QMSIEN_": "_^C0Q(201,C0QMSIEN,0))
153 D EN^DDIOL("")
154 ;
155 ; Calculate totals and move patients over from individual measures
[1519]156 N A
[1518]157 D UPDATE^C0QUPDT(.A,C0QMSIEN) ; FYI: A isn't used.
158 ;
159 ; Get QRDA code for Measure Set.
160 N C0QMSQRDA S C0QMSQRDA=$$GET1^DIQ($$C0QMFN^C0QUPDT(),C0QMSIEN_",","QRDA TEMPLATE ROOT")
161 ;
162 N C0QI S C0QI=0 ; Fileman IEN looper
163 F S C0QI=$O(^C0Q(201,C0QMSIEN,5,C0QI)) Q:'C0QI D ; For each measure in Measure Set
[1516]164 . ;
[1518]165 . ; Get QRDA code using relational jump
166 . N C0QMEASUREQRDA S C0QMEASUREQRDA=$$GET1^DIQ($$C0QMMFN^C0QUPDT(),C0QI_","_C0QMSIEN_",",".01:QRDA TEMPLATE ROOT")
167 . ;
168 . ; Then collect patients in the denominator, and store in output global
169 . N C0QP S C0QP=0
170 . F S C0QP=$O(^C0Q(201,C0QMSIEN,5,C0QI,3,C0QP)) Q:'C0QP D ; For each patient in denominator
171 . . N C0QDFN S C0QDFN=+^(C0QP,0)
172 . . S @C0QREF@(C0QDFN,C0QMSQRDA,C0QMEASUREQRDA)=""
[1516]173 QUIT
174 ;
[1518]175INPPARM() ; $$ Private; Get Inpatient Parameters IEN
176 ; Output: IEN of Inpatient Parameter in C0Q PARAMETER file
177 ;
178 ; Browse this tree of xrefs to get the IEN of INP type (last line here).
179 ; ^C0Q(401,"B","INPATIENT",2)=""
180 ; ^C0Q(401,"B","OUTPATIENT",1)=""
181 ; ^C0Q(401,"MU","MU12",1)=""
182 ; ^C0Q(401,"MU","MU12",2)=""
183 ; ^C0Q(401,"MUTYP","MU12","EP",1)=""
184 ; ^C0Q(401,"MUTYP","MU12","INP",2)=""
185 ;
186 N MUID S MUID="" ; Looper for MU Year ID
187 N FOUND S FOUND=0 ; Found flag to get out of loop
188 N IEN ; Output variable
189 F S MUID=$O(^C0Q(401,"MUTYP",MUID),-1) Q:MUID="" Q:FOUND D ; Loop backwards
190 . N TYP S TYP="" ; Type ("EP" or "INP")
191 . F S TYP=$O(^C0Q(401,"MUTYP",MUID,TYP)) Q:TYP="" Q:FOUND D
192 . . I TYP="INP" S IEN=$O(^(TYP,"")),FOUND=1 Q ; If found, get IEN, quit out of loops
193 QUIT +$G(IEN)
194 ;
195PRINTXML(C0QREF,C0QMNM) ; Print the XML; Private Proc
196 ; Input: C0QREF -> Global By Name
197 ; C0QMNM -> Measure Name -> Either VTE, STK, ED. For use in filenames.
198 ; Output: modified CCRs are saved in /tmp/
[1517]199 N C0QDFN,C0QMS,C0QM S (C0QDFN,C0QMS,C0QM)="" ; DFN, Measure Set, Measure loopers
200 F S C0QDFN=$O(@C0QREF@(C0QDFN)) Q:C0QDFN="" D ; For each patient
201 . ;
[1518]202 . N GREEN S GREEN=$C(27)_"[1;37;42m"
203 . N RESET S RESET=$C(27)_"[0m"
204 . D EN^DDIOL(GREEN_"Prosessing DFN "_C0QDFN_RESET,"","!!!")
205 . D EN^DDIOL("","","!")
[1517]206 . ;
207 . ; CCR Generatation is next; protected against crashes.
208 . ; ET set to new value then restored.
209 . N C0QCCRXML ; CCR XML
210 . N OLDTRAP S OLDTRAP=$ET
211 . ; ET: Rollback to this level, write the error in red , clear it, then quit
[1518]212 . N ETTEXT S ETTEXT=$C(27)_"[1;37;41m"_$$EC^%ZOSV_$C(27)_RESET
[1517]213 . N $ES,$ET
[1518]214 . S $ET="W ETTEXT D ^%ZTER G ROLLDOWN^C0QQRDA"
[1517]215 . D CCRRPC^C0CCCR(.C0QCCRXML,C0QDFN) ; Run CCR RPC.
216 . S $ET=OLDTRAP
217 . ;
218 . ;
219 . ; Quality XML Section generated by hand next...
220 . N C0QXML ; Generated Quality XML
221 . D XMLSTORE(.C0QXML,$$OT("QUALITY")) ; Open Tag
222 . F S C0QMS=$O(@C0QREF@(C0QDFN,C0QMS)) Q:C0QMS="" D ; For each measure set
223 . . D XMLSTORE(.C0QXML,$$OT("MEASURE_SET")) ; Open tag
224 . . D XMLSTORE(.C0QXML,$$TAG("ID",C0QMS)) ; Write out set QRDA code
225 . . D XMLSTORE(.C0QXML,$$OT("MEASURES")) ; Open tag
226 . . F S C0QM=$O(@C0QREF@(C0QDFN,C0QMS,C0QM)) Q:C0QM="" D ; for each measure
227 . . . D XMLSTORE(.C0QXML,$$TAG("MEASURE",C0QM)) ; Write <measure> and qrda code
228 . . D XMLSTORE(.C0QXML,$$CT("MEASURES")) ; Close tag
229 . . D XMLSTORE(.C0QXML,$$CT("MEASURE_SET")) ; Close tag
230 . D XMLSTORE(.C0QXML,$$CT("QUALITY")) ; Close tag
231 . ;
232 . ;
[1518]233 . ; Insert Quality XML under the root of the CCR document
[1517]234 . D INSERT^C0CXPATH($NA(C0QCCRXML),$NA(C0QXML),"//ContinuityOfCareRecord")
235 . ;
236 . ;
237 . ; Get Kernel Default Directory
238 . N DEFDIR S DEFDIR=$$DEFDIR^%ZISH()
239 . ;
240 . ;
241 . ; Write out to a file.
[1518]242 . N FN S FN=C0QMNM_"_QRDA_CCR_DFN"_$$RJ^XLFSTR(C0QDFN,10,"0")_".XML" ; File Name
243 . K C0QCCRXML(0) ; remove zero node; API doesn't support it.
[1517]244 . D EN^DDIOL($$OUTPUT^C0CXPATH($NA(C0QCCRXML(1)),FN,DEFDIR))
[1516]245 QUIT
246 ;
[1517]247 ; Quick XML stuff ; All Private
248OT(STR) Q "<"_STR_">" ; $$ Open Tag
249CT(STR) Q "</"_STR_">" ; $$ Close Tag
250TAG(NM,CONTENT) Q "<"_NM_">"_CONTENT_"</"_NM_">" ; $$ Whole tag
251 ;
252XMLSTORE(REF,STR) ; Priv Proc - Store XML
253 ; REF -> Save Array. Pass by Reference.
254 ; STR -> What to store. Pass by Value.
255 ; Use like this: D XMLSTORE(.STORE,"<tag>")
256 ; Output: STORE(1)="<tag>"
257 N L ; Number Subscript to use
258 S L=$O(REF(" "),-1) S L=L+1 ; Get last number and increment
259 S REF(L)=STR,REF(0)=L ; Store string in numbered sub, store last number in 0 node (not used here)
260 QUIT
261 ;
262 ; Following is for formatting printed XML. L passed in Symbol Table and starts at 0.
[1516]263L1 D WS S L=L+1 Q ; Write space and increment
264L2 S L=L-1 D WS Q ; Decrement and Write space
265WS X "F I=1:1:L W "" """ Q ; Write Space
[1518]266 ; This is for rolling down the stack to the $ES level
267ROLLDOWN S $ET="Q:$ES S $EC=""""",$EC=",U99," QUIT
Note: See TracBrowser for help on using the repository browser.