source: ccr/trunk/p/GPLCCD.m@ 391

Last change on this file since 391 was 391, checked in by George Lilly, 15 years ago

name spacing the package to C0C ... removing all GPL references
File size: 11.8 KB
Line 
1C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
2 ;;0.1;CCDCCR;nopatch;noreleasedate
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,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 CCDGLO
35 D CCDRPC(.CCDGLO,DFN,"CCD","","","")
36 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
37 S ONAM=FN
38 I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
39 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
40 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
41 . S @ODIRGLB="/home/glilly/CCROUT"
42 . ;S @ODIRGLB="/home/cedwards/"
43 . ;S @ODIRGLB="/opt/wv/p/"
44 S ODIR=DIR
45 I DIR="" S ODIR=@ODIRGLB
46 N ZY
47 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
48 W $P(ZY,U,2)
49 Q
50 ;
51CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
52 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
53 ; DFN IS PATIENT IEN
54 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
55 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
56 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
57 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
58 ; - NULL MEANS NOW
59 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
60 ; "TO" VARIABLES
61 ; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
62 I '$D(DEBUG) S DEBUG=0
63 N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
64 I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
65 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
66 I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
67 E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
68 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
69 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
70 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
71 I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE
72 E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
73 D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
74 N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
75 S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
76 S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
77 S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
78 S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
79 S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
80 S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
81 ;
82 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
83 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
84 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
85 D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
86 I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
87 I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
88 ;
89 I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
90 ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
91 S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
92 D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
93 D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
94 I DEBUG D PARY^C0CXPATH("ACTT2")
95 D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
96 I DEBUG D PARY^C0CXPATH(CCDGLO)
97 K ACTT1 K ACCT2
98 ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
99 ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
100 D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
101 D CP^C0CXPATH("ACTT2",CCDGLO)
102 ;
103 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
104 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
105 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
106 N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
107 F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
108 . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
109 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
110 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
111 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
112 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
113 . S IXML="INXML"
114 . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
115 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
116 . ; W OXML,!
117 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
118 . W "RUNNING ",CALL,!
119 . X CALL
120 . I @OXML@(0)'=0 D ; THERE IS A RESULT
121 . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
122 . . I CCD D UNSHAVE("ITMP",OXML)
123 . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
124 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
125 . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
126 . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
127 ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
128 ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
129 ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
130 ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
131 ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
132 N I,J,DONE S DONE=0
133 F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
134 . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
135 . W "TRIMMED",J,!
136 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
137 I CCD D ; TURN THE BODY INTO A CCD COMPONENT
138 . N I
139 . F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
140 . . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
141 . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
142 . . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
143 . . . S @CCDGLO@(I)="</structuredBody></component>"
144 S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
145 S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
146 Q
147 ;
148INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
149 ; TAB IS PASSED BY NAME
150 W "TAB= ",TAB,!
151 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
152 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
153 ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
154 I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
155 Q
156 ;
157SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
158 ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
159 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
160 W SHXML,!
161 W @SHXML@(1),!
162 D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
163 D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
164 D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
165 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
166 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
167 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
168 Q
169 ;
170UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
171 ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
172 N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
173 W SHXML,!
174 W @SHXML@(1),!
175 D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
176 D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
177 D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
178 D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
179 D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
180 D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
181 Q
182 ;
183HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
184 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
185 ; K @VMAP
186 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
187 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
188 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
189 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
190 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
191 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
192 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
193 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
194 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
195 I IHDR'="" D ; HEADER VALUES ARE PROVIDED
196 . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
197 N CTMP
198 D MAP^C0CXPATH(CXML,VMAP,"CTMP")
199 D CP^C0CXPATH("CTMP",CXML)
200 Q
201 ;
202ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
203 ; AXML AND ACTRTN ARE PASSED BY NAME
204 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
205 ; P1= OBJECTID - ACTORPATIENT_2
206 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
207 ;OR INSTITUTION
208 ; OR PERSON(IN PATIENT FILE IE NOK)
209 ; P3= IEN RECORD NUMBER FOR ACTOR - 2
210 N I,J,K,L
211 K @ACTRTN ; CLEAR RETURN ARRAY
212 F I=1:1:@AXML@(0) D ; SCAN ALL LINES
213 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
214 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
215 . . W "<ActorID>=>",J,!
216 . . I J'="" S K(J)="" ; HASHING ACTOR
217 . . ; TO GET RID OF DUPLICATES
218 S I="" ; GOING TO $O THROUGH THE HASH
219 F J=0:0 D Q:$O(K(I))="" ;
220 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
221 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
222 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
223 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
224 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
225 Q
226 ;
227TEST ; RUN ALL THE TEST CASES
228 D TESTALL^C0CUNIT("C0CCCR")
229 Q
230 ;
231ZTEST(WHICH) ; RUN ONE SET OF TESTS
232 N ZTMP
233 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
234 D ZTEST^C0CUNIT(.ZTMP,WHICH)
235 Q
236 ;
237TLIST ; LIST THE TESTS
238 N ZTMP
239 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
240 D TLIST^C0CUNIT(.ZTMP)
241 Q
242 ;
243 ;;><TEST>
244 ;;><PROBLEMS>
245 ;;>>>K C0C S C0C=""
246 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
247 ;;>>?@C0C@(@C0C@(0))["</Problems>"
248 ;;><VITALS>
249 ;;>>>K C0C S C0C=""
250 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
251 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
252 ;;><CCR>
253 ;;>>>K C0C S C0C=""
254 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
255 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
256 ;;><ACTLST>
257 ;;>>>K C0C S C0C=""
258 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
259 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
260 ;;><ACTORS>
261 ;;>>>D ZTEST^C0CCCR("ACTLST")
262 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
263 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
264 ;;>>?G3(G3(0))["</Actors>"
265 ;;><TRIM>
266 ;;>>>D ZTEST^C0CCCR("CCR")
267 ;;>>>W $$TRIM^C0CXPATH(CCDGLO)
268 ;;><CCD>
269 ;;>>>K C0C S C0C=""
270 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
271 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
272 ;;></TEST>
Note: See TracBrowser for help on using the repository browser.