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

Last change on this file since 111 was 111, checked in by George Lilly, 16 years ago

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