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

Last change on this file since 73 was 70, checked in by Christopher Edwards, 16 years ago

added placeholders in GPLMEDS.m for values
added comment in GPLCCR.m describing order of CCR Body
added processing of MEDS in GPLCCR.m (commented out)

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