source: ccr/trunk/p/C0CCCR.m@ 663

Last change on this file since 663 was 576, checked in by Christopher Edwards, 15 years ago

Rearranged INITSTPS so that CCR body would be in the correct order

File size: 9.9 KB
Line 
1C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
2 ;;1.0;C0C;;May 19, 2009;
3 ;Copyright 2008,2009 George Lilly, University of Minnesota.
4 ;Licensed under the terms of the GNU General Public License.
5 ;See attached copy of the License.
6 ;
7 ;This program is free software; you can redistribute it and/or modify
8 ;it under the terms of the GNU General Public License as published by
9 ;the Free Software Foundation; either version 2 of the License, or
10 ;(at your option) any later version.
11 ;
12 ;This program is distributed in the hope that it will be useful,
13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;GNU General Public License for more details.
16 ;
17 ;You should have received a copy of the GNU General Public License along
18 ;with this program; if not, write to the Free Software Foundation, Inc.,
19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 ;
21 ; EXPORT A CCR
22 ;
23EXPORT ; EXPORT ENTRY POINT FOR CCR
24 ; Select a patient.
25 S DIC=2,DIC(0)="AEMQ" D ^DIC
26 I Y<1 Q ; EXIT
27 S DFN=$P(Y,U,1) ; SET THE PATIENT
28 D XPAT(DFN) ; EXPORT TO A FILE
29 Q
30 ;
31XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
32 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
33 ; FN IS FILE NAME, DEFAULTS IF NULL
34 N CCRGLO,UDIR,UFN
35 S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
36 I '$D(DIR) S UDIR=""
37 E S UDIR=DIR
38 I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
39 E S UFN=FN
40 I '$D(XPARMS) S XPARMS=""
41 N C0CRTN ; RETURN ARRAY
42 D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
43 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
44 S ONAM=UFN
45 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
46 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
47 S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
48 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
49 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
50 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
51 . ;S @ODIRGLB="/home/glilly/CCROUT"
52 . ;S @ODIRGLB="/home/cedwards/"
53 . S @ODIRGLB="/opt/wv/p/"
54 S ODIR=UDIR
55 I UDIR="" S ODIR=@ODIRGLB
56 N ZY
57 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
58 W !,$P(ZY,U,2),!
59 Q
60 ;
61DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
62 ;
63 N G1
64 S G1=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
65 I $D(@G1@(0)) D ; CCR EXISTS
66 . D PARY^C0CXPATH(G1)
67 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
68 Q
69 ;
70CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT
71 ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
72 ; DFN IS PATIENT IEN
73 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
74 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
75 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
76 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
77 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
78 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
79 I '$D(DEBUG) S DEBUG=0
80 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
81 I '$D(CCRPARMS) S CCRPARMS=""
82 I '$D(CCRPART) S CCRPART="CCR"
83 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
84 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
85 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
86 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
87 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
88 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
89 S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
90 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
91 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
92 ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
93 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
94 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
95 ;
96 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
97 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
98 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
99 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
100 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
101 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
102 ;
103 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
104 ;
105 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
106 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
107 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
108 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
109 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
110 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
111 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
112 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
113 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
114 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
115 . S IXML="INXML"
116 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
117 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
118 . ; W OXML,!
119 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
120 . W "RUNNING ",CALL,!
121 . X CALL
122 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
123 . I $G(@OXML@(0))>0 D ; THERE IS A RESULT
124 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
125 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
126 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
127 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
128 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
129 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
130 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
131 N TRIMI,J,DONE S DONE=0
132 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
133 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
134 . I DEBUG W "TRIMMED",J,!
135 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
136 ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
137 M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
138 I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
139 Q
140 ;
141INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
142 ; TAB IS PASSED BY NAME
143 I DEBUG W "TAB= ",TAB,!
144 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
145 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
146 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
147 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
148 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
149 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
150 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
151 Q
152 ;
153HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
154 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
155 ; K @VMAP
156 S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
157 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
158 D ; ALWAYS MAP THESE VARIABLES
159 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
160 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
161 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
162 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
163 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
164 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
165 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
166 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED
167 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
168 N CTMP
169 D MAP^C0CXPATH(CXML,VMAP,"CTMP")
170 D CP^C0CXPATH("CTMP",CXML)
171 N HRIMVARS ;
172 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
173 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
174 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
175 Q
176 ;
177ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
178 ; AXML AND ACTRTN ARE PASSED BY NAME
179 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
180 ; P1= OBJECTID - ACTORPATIENT_2
181 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
182 ;OR INSTITUTION
183 ; OR PERSON(IN PATIENT FILE IE NOK)
184 ; P3= IEN RECORD NUMBER FOR ACTOR - 2
185 N I,J,K,L
186 K @ACTRTN ; CLEAR RETURN ARRAY
187 F I=1:1:@AXML@(0) D ; SCAN ALL LINES
188 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
189 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
190 . . I DEBUG W "<ActorID>=>",J,!
191 . . I J'="" S K(J)="" ; HASHING ACTOR
192 . . ; TO GET RID OF DUPLICATES
193 S I="" ; GOING TO $O THROUGH THE HASH
194 F J=0:0 D Q:$O(K(I))=""
195 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
196 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
197 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
198 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
199 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
200 Q
201 ;
202TEST ; RUN ALL THE TEST CASES
203 D TESTALL^C0CUNIT("C0CCCR")
204 Q
205 ;
206ZTEST(WHICH) ; RUN ONE SET OF TESTS
207 N ZTMP
208 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
209 D ZTEST^C0CUNIT(.ZTMP,WHICH)
210 Q
211 ;
212TLIST ; LIST THE TESTS
213 N ZTMP
214 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
215 D TLIST^C0CUNIT(.ZTMP)
216 Q
217 ;
218 ;;><TEST>
219 ;;><PROBLEMS>
220 ;;>>>K C0C S C0C=""
221 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
222 ;;>>?@C0C@(@C0C@(0))["</Problems>"
223 ;;><VITALS>
224 ;;>>>K C0C S C0C=""
225 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
226 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
227 ;;><CCR>
228 ;;>>>K C0C S C0C=""
229 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
230 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
231 ;;><ACTLST>
232 ;;>>>K C0C S C0C=""
233 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
234 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
235 ;;><ACTORS>
236 ;;>>>D ZTEST^C0CCCR("ACTLST")
237 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
238 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
239 ;;>>?G3(G3(0))["</Actors>"
240 ;;><TRIM>
241 ;;>>>D ZTEST^C0CCCR("CCR")
242 ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
243 ;;><ALERTS>
244 ;;>>>S TESTALERT=1
245 ;;>>>K C0C S C0C=""
246 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
247 ;;>>?@C0C@(@C0C@(0))["</Alerts>"
248
249
Note: See TracBrowser for help on using the repository browser.