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

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

name spacing the package to C0C ... removing all GPL references
File size: 9.4 KB
Line 
1C0CCCR ; CCDCCR/GPL - CCR 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,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 I '$D(DIR) S UDIR=""
36 E S UDIR=DIR
37 I '$D(FN) S UFN=""
38 E S UFN=FN
39 I '$D(XPARMS) S XPARMS=""
40 D CCRRPC(.CCRGLO,DFN,XPARMS,"CCR")
41 S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
42 S ONAM=UFN
43 I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_19.xml"
44 S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
45 I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
46 I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
47 . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
48 . ;S @ODIRGLB="/home/glilly/CCROUT"
49 . ;S @ODIRGLB="/home/cedwards/"
50 . S @ODIRGLB="/opt/wv/p/"
51 S ODIR=UDIR
52 I UDIR="" S ODIR=@ODIRGLB
53 N ZY
54 S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
55 W !,$P(ZY,U,2),!
56 Q
57 ;
58DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
59 ;
60 N G1
61 S G1=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
62 I $D(@G1@(0)) D ; CCR EXISTS
63 . D PARY^C0CXPATH(G1)
64 E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
65 Q
66 ;
67CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT
68 ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
69 ; DFN IS PATIENT IEN
70 ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
71 ; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
72 ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
73 ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
74 ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
75 ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
76 I '$D(DEBUG) S DEBUG=0
77 S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
78 D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
79 I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
80 I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
81 I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING CCRMEDS SECTION
82 S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
83 S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
84 S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
85 ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
86 S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
87 D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
88 D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
89 ;
90 ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
91 ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
92 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
93 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
94 D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
95 I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
96 ;
97 D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
98 ;
99 K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
100 S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
101 D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
102 N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
103 F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
104 . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
105 . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
106 . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
107 . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
108 . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
109 . S IXML="INXML"
110 . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
111 . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
112 . ; W OXML,!
113 . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
114 . W "RUNNING ",CALL,!
115 . X CALL
116 . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
117 . I @OXML@(0)'=0 D ; THERE IS A RESULT
118 . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
119 . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
120 N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
121 D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
122 D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
123 D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
124 D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
125 N TRIMI,J,DONE S DONE=0
126 F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
127 . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
128 . I DEBUG W "TRIMMED",J,!
129 . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
130 Q
131 ;
132INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
133 ; TAB IS PASSED BY NAME
134 I DEBUG W "TAB= ",TAB,!
135 ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
136 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
137 D PUSH^C0CXPATH(TAB,"EXTRACT;CCRMEDS;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
138 D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
139 D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
140 D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
141 I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
142 Q
143 ;
144HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
145 N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
146 ; K @VMAP
147 S @VMAP@("DATETIME")=$$FMDTOUTC^CCRUTIL($$NOW^XLFDT,"DT")
148 ; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
149 D ; ALWAYS MAP THESE VARIABLES
150 . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
151 . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
152 . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
153 . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
154 . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
155 . S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
156 . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
157 ;I IHDR'="" D ; HEADER VALUES ARE PROVIDED
158 ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
159 N CTMP
160 D MAP^C0CXPATH(CXML,VMAP,"CTMP")
161 D CP^C0CXPATH("CTMP",CXML)
162 N HRIMVARS ;
163 S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
164 M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
165 S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
166 Q
167 ;
168ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
169 ; AXML AND ACTRTN ARE PASSED BY NAME
170 ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
171 ; P1= OBJECTID - ACTORPATIENT_2
172 ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
173 ;OR INSTITUTION
174 ; OR PERSON(IN PATIENT FILE IE NOK)
175 ; P3= IEN RECORD NUMBER FOR ACTOR - 2
176 N I,J,K,L
177 K @ACTRTN ; CLEAR RETURN ARRAY
178 F I=1:1:@AXML@(0) D ; SCAN ALL LINES
179 . I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
180 . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
181 . . I DEBUG W "<ActorID>=>",J,!
182 . . I J'="" S K(J)="" ; HASHING ACTOR
183 . . ; TO GET RID OF DUPLICATES
184 S I="" ; GOING TO $O THROUGH THE HASH
185 F J=0:0 D Q:$O(K(I))=""
186 . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
187 . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
188 . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
189 . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
190 . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
191 Q
192 ;
193TEST ; RUN ALL THE TEST CASES
194 D TESTALL^C0CUNIT("C0CCCR")
195 Q
196 ;
197ZTEST(WHICH) ; RUN ONE SET OF TESTS
198 N ZTMP
199 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
200 D ZTEST^C0CUNIT(.ZTMP,WHICH)
201 Q
202 ;
203TLIST ; LIST THE TESTS
204 N ZTMP
205 D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
206 D TLIST^C0CUNIT(.ZTMP)
207 Q
208 ;
209 ;;><TEST>
210 ;;><PROBLEMS>
211 ;;>>>K C0C S C0C=""
212 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
213 ;;>>?@C0C@(@C0C@(0))["</Problems>"
214 ;;><VITALS>
215 ;;>>>K C0C S C0C=""
216 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
217 ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
218 ;;><CCR>
219 ;;>>>K C0C S C0C=""
220 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
221 ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
222 ;;><ACTLST>
223 ;;>>>K C0C S C0C=""
224 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
225 ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
226 ;;><ACTORS>
227 ;;>>>D ZTEST^C0CCCR("ACTLST")
228 ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
229 ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
230 ;;>>?G3(G3(0))["</Actors>"
231 ;;><TRIM>
232 ;;>>>D ZTEST^C0CCCR("CCR")
233 ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
234 ;;><ALERTS>
235 ;;>>>S TESTALERT=1
236 ;;>>>K C0C S C0C=""
237 ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
238 ;;>>?@C0C@(@C0C@(0))["</Alerts>"
239
Note: See TracBrowser for help on using the repository browser.