1 | C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
---|
2 | ;;1.0;C0C;;May 19, 2009;Build 39
|
---|
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 | ; PROCESS THE ACTORS SECTION OF THE CCR
|
---|
22 | ;
|
---|
23 | ; ===Revision History===
|
---|
24 | ; 0.1 Initial Writing of Skeleton--GPL
|
---|
25 | ; 0.2 Patient Data Extraction--SMH
|
---|
26 | ; 0.3 Information System Info Extraction--SMH
|
---|
27 | ; 0.4 Patient data rouine refactored; adjustments here--SMH
|
---|
28 | ;
|
---|
29 | EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
---|
30 | ; IPXML is the Input Actor Template into which we substitute values
|
---|
31 | ; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
---|
32 | ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
|
---|
33 | ; ^TMP(7542,1,"ACTORS",0)=Count
|
---|
34 | ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
---|
35 | ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
---|
36 | ; AXML is the output arrary, to contain XML.
|
---|
37 | ;
|
---|
38 | N I,J,AMAP,AOID,ATYP,AIEN
|
---|
39 | D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
---|
40 | D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
---|
41 | I DEBUG W "PROCESSING ACTORS ",!
|
---|
42 | F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
---|
43 | . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
---|
44 | . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
---|
45 | . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
---|
46 | . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
---|
47 | . I AIEN="" D Q ; IEN CAN'T BE NULL
|
---|
48 | . . W "WARING NUL ACTOR: ",ATYP,!
|
---|
49 | . I ATYP="" Q ; NOT A VALID ACTOR
|
---|
50 | . ;
|
---|
51 | . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
---|
52 | . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
---|
53 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
---|
54 | . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
---|
55 | . ;
|
---|
56 | . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
---|
57 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
---|
58 | . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
---|
59 | . ;
|
---|
60 | . I ATYP="NOK" D ; NOK ACTOR TYPE
|
---|
61 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
---|
62 | . . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
---|
63 | . ;
|
---|
64 | . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
---|
65 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
---|
66 | . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
---|
67 | . ;
|
---|
68 | . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
---|
69 | . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
---|
70 | . . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
---|
71 | . ;
|
---|
72 | . W "PROCESSING:",ATYP," ",AIEN,!
|
---|
73 | . ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE
|
---|
74 | . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
---|
75 | . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
|
---|
76 | ;
|
---|
77 | N ACTTMP
|
---|
78 | D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
---|
79 | I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
---|
80 | . ; STRINGS MARKED AS @@X@@
|
---|
81 | . W "ACTORS Missing list: ",!
|
---|
82 | . F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
---|
83 | Q
|
---|
84 | ;
|
---|
85 | PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
---|
86 | I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
---|
87 | ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
|
---|
88 | ; CODE REUSABLE FROM ERX
|
---|
89 | N AMAP
|
---|
90 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
91 | K @AMAP
|
---|
92 | D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
|
---|
93 | I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
|
---|
94 | I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
|
---|
95 | D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
|
---|
96 | K @AMAP ; CLEAN UP BEHIND US
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
|
---|
100 | S @GPL@("ACTORADDRESSCITY")="ALTON"
|
---|
101 | S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
|
---|
102 | S @GPL@("ACTORADDRESSLINE2")=""
|
---|
103 | S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
|
---|
104 | S @GPL@("ACTORADDRESSSTATE")="KANSAS"
|
---|
105 | S @GPL@("ACTORADDRESSTYPE")="Home"
|
---|
106 | S @GPL@("ACTORADDRESSZIPCODE")=67623
|
---|
107 | S @GPL@("ACTORCELLTEL")=""
|
---|
108 | S @GPL@("ACTORCELLTELTEXT")=""
|
---|
109 | S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
|
---|
110 | S @GPL@("ACTOREMAIL")=""
|
---|
111 | S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
|
---|
112 | ;S @GPL@("ACTORGENDER")="MALE"
|
---|
113 | S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
|
---|
114 | S @GPL@("ACTORIEN")=2
|
---|
115 | S @GPL@("ACTORMIDDLENAME")="TWO"
|
---|
116 | S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
|
---|
117 | S @GPL@("ACTORRESTEL")="888-555-1212"
|
---|
118 | S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
|
---|
119 | S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
---|
120 | S @GPL@("ACTORSSN")="769122557P"
|
---|
121 | S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
|
---|
122 | S @GPL@("ACTORSSNTEXT")="SSN"
|
---|
123 | S @GPL@("ACTORSUFFIXNAME")=""
|
---|
124 | S @GPL@("ACTORWORKTEL")="888-121-1212"
|
---|
125 | S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
|
---|
126 | Q
|
---|
127 | ;
|
---|
128 | PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
|
---|
129 | N ZX
|
---|
130 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
131 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
|
---|
132 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
|
---|
133 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
|
---|
134 | S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
|
---|
135 | S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
|
---|
136 | S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
|
---|
137 | S @AMAP@("ACTORSSN")=""
|
---|
138 | S @AMAP@("ACTORSSNTEXT")=""
|
---|
139 | S @AMAP@("ACTORSSNSOURCEID")=""
|
---|
140 | S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
|
---|
141 | X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
|
---|
142 | I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
|
---|
143 | I $G(MRN)'="" D ; IF MRN IS PRESENT
|
---|
144 | . S @AMAP@("ACTORSSN")=MRN
|
---|
145 | . S @AMAP@("ACTORSSNTEXT")="MRN"
|
---|
146 | . S @AMAP@("ACTORSSNSOURCEID")=AOID
|
---|
147 | E D ; NO MRN, USE SSN
|
---|
148 | . S ZX=$$SSN^C0CDPT(AIEN)
|
---|
149 | . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
---|
150 | . . S @AMAP@("ACTORSSN")=ZX
|
---|
151 | . . S @AMAP@("ACTORSSNTEXT")="SSN"
|
---|
152 | . . S @AMAP@("ACTORSSNSOURCEID")=AOID
|
---|
153 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
|
---|
154 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
|
---|
155 | S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
|
---|
156 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
|
---|
157 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
|
---|
158 | S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
|
---|
159 | S @AMAP@("ACTORRESTEL")=""
|
---|
160 | S @AMAP@("ACTORRESTELTEXT")=""
|
---|
161 | S ZX=$$RESTEL^C0CDPT(AIEN)
|
---|
162 | I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
---|
163 | . S @AMAP@("ACTORRESTEL")=ZX
|
---|
164 | . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
---|
165 | S @AMAP@("ACTORWORKTEL")=""
|
---|
166 | S @AMAP@("ACTORWORKTELTEXT")=""
|
---|
167 | S ZX=$$WORKTEL^C0CDPT(AIEN)
|
---|
168 | I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
---|
169 | . S @AMAP@("ACTORWORKTEL")=ZX
|
---|
170 | . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
---|
171 | S @AMAP@("ACTORCELLTEL")=""
|
---|
172 | S @AMAP@("ACTORCELLTELTEXT")=""
|
---|
173 | S ZX=$$CELLTEL^C0CDPT(AIEN)
|
---|
174 | I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
---|
175 | . S @AMAP@("ACTORCELLTEL")=ZX
|
---|
176 | . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
---|
177 | S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
|
---|
178 | S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
---|
179 | S @AMAP@("ACTORIEN")=AIEN
|
---|
180 | S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
---|
181 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
---|
182 | Q
|
---|
183 | ;
|
---|
184 | MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
|
---|
185 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
186 | Q
|
---|
187 | ;
|
---|
188 | SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
---|
189 | ;
|
---|
190 | ; N AMAP
|
---|
191 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
192 | K @AMAP
|
---|
193 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
194 | S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
|
---|
195 | S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
|
---|
196 | S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
---|
197 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
198 | Q
|
---|
199 | ;
|
---|
200 | NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
---|
201 | ;
|
---|
202 | ; N AMAP
|
---|
203 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
204 | K @AMAP
|
---|
205 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
206 | S @AMAP@("ACTORDISPLAYNAME")=""
|
---|
207 | S @AMAP@("ACTORRELATION")=""
|
---|
208 | S @AMAP@("ACTORRELATIONSOURCEID")=""
|
---|
209 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
---|
210 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
211 | Q
|
---|
212 | ;
|
---|
213 | ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
|
---|
214 | ;
|
---|
215 | N AMAP,ZIEN,ZSITE
|
---|
216 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
217 | K @AMAP
|
---|
218 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
219 | S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
|
---|
220 | S ZIEN=$P(ZSITE,"^",1)
|
---|
221 | S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
|
---|
222 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
---|
223 | S @AMAP@("ACTORADDRESSTYPE")="Office"
|
---|
224 | S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
|
---|
225 | S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
|
---|
226 | S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
|
---|
227 | S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
|
---|
228 | S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
|
---|
229 | S @AMAP@("ACTORTELEPHONE")=""
|
---|
230 | S @AMAP@("ACTORTELEPHONETYPE")=""
|
---|
231 | S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
|
---|
232 | I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
---|
233 | . S @AMAP@("ACTORTELEPHONE")=ZX
|
---|
234 | . S @AMAP@("ACTORTELEPHONETYPE")="Office"
|
---|
235 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
236 | K @AMAP
|
---|
237 | Q
|
---|
238 | ;
|
---|
239 | PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
---|
240 | ;
|
---|
241 | ; N AMAP
|
---|
242 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
243 | K @AMAP
|
---|
244 | I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
|
---|
245 | . W "WARNING - MISSING PROVIDER: ",AIEN,!
|
---|
246 | . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
|
---|
247 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
248 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
|
---|
249 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
|
---|
250 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
|
---|
251 | S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
|
---|
252 | S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
|
---|
253 | S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
|
---|
254 | S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
|
---|
255 | S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
|
---|
256 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
|
---|
257 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
|
---|
258 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
|
---|
259 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
|
---|
260 | S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
|
---|
261 | S @AMAP@("ACTORTELEPHONE")=""
|
---|
262 | S @AMAP@("ACTORTELEPHONETYPE")=""
|
---|
263 | S ZX=$$TEL^C0CVA200(AIEN)
|
---|
264 | I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
---|
265 | . S @AMAP@("ACTORTELEPHONE")=ZX
|
---|
266 | . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
|
---|
267 | S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
|
---|
268 | S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
---|
269 | S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
---|
270 | S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
|
---|
271 | D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
272 | Q
|
---|
273 | ;
|
---|