source: ccr/trunk/p/GPLCCR.m@ 121

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

rename GPLVITALS and GPLACTORS to GPLVITAL and GPLACTOR for kids build

File size: 8.6 KB
Line 
1GPLCCR ; CCDCCR/GPL - CCR 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 D XPAT(DFN,"","") ; EXPORT TO A FILE
28 Q
29 ;
30XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
31 ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("GPLCCR","ODIR")
32 ; FN IS FILE NAME, DEFAULTS IF NULL
33 N CCRGLO
34 D CCRRPC(.CCRGLO,DFN,"CCR","","","")
35 S OARY=$NA(^TMP("GPLCCR",$J,DFN,"CCR",1))
36 S ONAM=FN
37 I FN="" S ONAM="PAT_"_DFN_"_CCR_V1.xml"
38 S ODIRGLB=$NA(^TMP("GPLCCR","ODIR"))
39 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
40 . ;S @ODIRGLB="/home/glilly/CCROUT"
41 . ;S @ODIRGLB="/home/cedwards/"
42 . S @ODIRGLB="/opt/wv/p/"
43 S ODIR=DIR
44 I DIR="" S ODIR=@ODIRGLB
45 D OUTPUT^GPLXPATH(OARY,ONAM,ODIR)
46 Q
47 ;
48CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
49 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
50 ; DFN IS PATIENT IEN
51 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
52 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
53 ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
54 ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
55 ; - NULL MEANS NOW
56 ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
57 ; "TO" VARIABLES
58 ; IF NULL WILL DEFAULT TO "FROM" DUZ AND "TO" DFN
59 I '$D(DEBUG) S DEBUG=0
60 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
61 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
62 S TGLOBAL=$NA(^TMP("GPLCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
63 S CCRGLO=$NA(^TMP("GPLCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
64 S ACTGLO=$NA(^TMP("GPLCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
65 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
66 S CCRGRTN=$NA(^TMP("GPLCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
67 D LOAD^GPLCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
68 D CP^GPLXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
69 ;
70 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
71 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
72 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
73 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
74 D REPLACE^GPLXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
75 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
76 ;
77 D HDRMAP(CCRGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
78 ;
79 K ^TMP("GPLCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
80 S CCRXTAB=$NA(^TMP("GPLCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
81 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
82 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
83 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
84 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
85 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
86 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
87 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
88 . D QUERY^GPLXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
89 . S IXML="INXML"
90 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
91 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
92 . ; W OXML,!
93 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
94 . W "RUNNING ",CALL,!
95 . X CALL
96 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
97 . I @OXML@(0)'=0 D ; THERE IS A RESULT
98 . . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
99 . . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
100 D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
101 D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
102 D EXTRACT^GPLACTOR("ACTT",ACTGLO,"ACTT2")
103 D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
104 N TRIMI,J,DONE S DONE=0
105 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
106 . S J=$$TRIM^GPLXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
107 . W "TRIMMED",J,!
108 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
109 Q
110 ;
111INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
112 ; TAB IS PASSED BY NAME
113 W "TAB= ",TAB,!
114 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
115 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""GPLCCR"",$J,DFN,""PROBLEMS"")")
116 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""GPLCCR"",$J,DFN,""MEDICATIONS"")")
117 D PUSH^GPLXPATH(TAB,"EXTRACT;GPLVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""GPLCCR"",$J,DFN,""VITALS"")")
118 I TESTLAB D PUSH^GPLXPATH(TAB,"EXTRACT;GPLLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""GPLCCR"",$J,DFN,""RESULTS"")")
119 Q
120 ;
121HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
122 N VMAP S VMAP=$NA(^TMP("GPLCCR",$J,DFN,"HEADER"))
123 ; K @VMAP
124 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
125 I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
126 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
127 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
128 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
129 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
130 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
131 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
132 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
133 I IHDR'="" D ; HEADER VALUES ARE PROVIDED
134 . D CP^GPLXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
135 N CTMP
136 D MAP^GPLXPATH(CXML,VMAP,"CTMP")
137 D CP^GPLXPATH("CTMP",CXML)
138 Q
139 ;
140ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
141 ; AXML AND ACTRTN ARE PASSED BY NAME
142 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
143 ; P1= OBJECTID - ACTORPATIENT_2
144 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
145 ;OR INSTITUTION
146 ; OR PERSON(IN PATIENT FILE IE NOK)
147 ; P3= IEN RECORD NUMBER FOR ACTOR - 2
148 N I,J,K,L
149 K @ACTRTN ; CLEAR RETURN ARRAY
150 F I=1:1:@AXML@(0) D ; SCAN ALL LINES
151 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
152 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
153 . . W "<ActorID>=>",J,!
154 . . I J'="" S K(J)="" ; HASHING ACTOR
155 . . ; TO GET RID OF DUPLICATES
156 S I="" ; GOING TO $O THROUGH THE HASH
157 F J=0:0 D Q:$O(K(I))=""
158 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
159 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
160 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
161 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
162 . D PUSH^GPLXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
163 Q
164 ;
165TEST ; RUN ALL THE TEST CASES
166 D TESTALL^GPLUNIT("GPLCCR")
167 Q
168 ;
169ZTEST(WHICH) ; RUN ONE SET OF TESTS
170 N ZTMP
171 D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
172 D ZTEST^GPLUNIT(.ZTMP,WHICH)
173 Q
174 ;
175TLIST ; LIST THE TESTS
176 N ZTMP
177 D ZLOAD^GPLUNIT("ZTMP","GPLCCR")
178 D TLIST^GPLUNIT(.ZTMP)
179 Q
180 ;
181 ;;><TEST>
182 ;;><PROBLEMS>
183 ;;>>>K GPL S GPL=""
184 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","PROBLEMS","","","")
185 ;;>>?@GPL@(@GPL@(0))["</Problems>"
186 ;;><VITALS>
187 ;;>>>K GPL S GPL=""
188 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","VITALS","","","")
189 ;;>>?@GPL@(@GPL@(0))["</VitalSigns>"
190 ;;><CCR>
191 ;;>>>K GPL S GPL=""
192 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
193 ;;>>?@GPL@(@GPL@(0))["</ContinuityOfCareRecord>"
194 ;;><ACTLST>
195 ;;>>>K GPL S GPL=""
196 ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
197 ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
198 ;;><ACTORS>
199 ;;>>>D ZTEST^GPLCCR("ACTLST")
200 ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
201 ;;>>>D EXTRACT^GPLACTOR("G2","ACTTEST","G3")
202 ;;>>?G3(G3(0))["</Actors>"
203 ;;><TRIM>
204 ;;>>>D ZTEST^GPLCCR("CCR")
205 ;;>>>W $$TRIM^GPLXPATH(CCRGLO)
Note: See TracBrowser for help on using the repository browser.