source: ccr/trunk/p/C0CACTOR.m@ 699

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

support for incoming CCDs
File size: 8.7 KB
RevLine 
[601]1C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
2 ;;1.0;C0C;;May 19, 2009;
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 ;
29EXTRACT(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 ;
85PATIENT(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 D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
94 K @AMAP ; CLEAN UP BEHIND US
95 Q
96 ;
97PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
98 N ZX
99 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
100 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
101 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
102 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
103 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
104 S @AMAP@("ACTORGENDER")=$$GENDER^C0CDPT(AIEN)
105 S @AMAP@("ACTORSSN")=""
106 S @AMAP@("ACTORSSNTEXT")=""
107 S @AMAP@("ACTORSSNSOURCEID")=""
108 S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
109 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
110 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
111 I $G(MRN)'="" D ; IF MRN IS PRESENT
112 . S @AMAP@("ACTORSSN")=MRN
113 . S @AMAP@("ACTORSSNTEXT")="MRN"
114 . S @AMAP@("ACTORSSNSOURCEID")=AOID
115 E D ; NO MRN, USE SSN
116 . S ZX=$$SSN^C0CDPT(AIEN)
117 . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
118 . . S @AMAP@("ACTORSSN")=ZX
119 . . S @AMAP@("ACTORSSNTEXT")="SSN"
120 . . S @AMAP@("ACTORSSNSOURCEID")=AOID
121 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
122 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
123 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
124 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
125 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
126 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
127 S @AMAP@("ACTORRESTEL")=""
128 S @AMAP@("ACTORRESTELTEXT")=""
129 S ZX=$$RESTEL^C0CDPT(AIEN)
130 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
131 . S @AMAP@("ACTORRESTEL")=ZX
132 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
133 S @AMAP@("ACTORWORKTEL")=""
134 S @AMAP@("ACTORWORKTELTEXT")=""
135 S ZX=$$WORKTEL^C0CDPT(AIEN)
136 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
137 . S @AMAP@("ACTORWORKTEL")=ZX
138 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
139 S @AMAP@("ACTORCELLTEL")=""
140 S @AMAP@("ACTORCELLTELTEXT")=""
141 S ZX=$$CELLTEL^C0CDPT(AIEN)
142 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
143 . S @AMAP@("ACTORCELLTEL")=ZX
144 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
145 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
146 S @AMAP@("ACTORADDRESSSOURCEID")=AOID
147 S @AMAP@("ACTORIEN")=AIEN
148 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
149 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
150 Q
151 ;
152MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
153 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
154 Q
155 ;
156SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
157 ;
158 ; N AMAP
159 S AMAP=$NA(^TMP($J,"AMAP"))
160 K @AMAP
161 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
162 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
163 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
164 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
165 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
166 Q
167 ;
168NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
169 ;
170 ; N AMAP
171 S AMAP=$NA(^TMP($J,"AMAP"))
172 K @AMAP
173 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
174 S @AMAP@("ACTORDISPLAYNAME")=""
175 S @AMAP@("ACTORRELATION")=""
176 S @AMAP@("ACTORRELATIONSOURCEID")=""
177 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
178 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
179 Q
180 ;
181ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
182 ;
183 ; N AMAP
184 S AMAP=$NA(^TMP($J,"AMAP"))
185 K @AMAP
186 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
187 S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
188 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
189 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
190 Q
191 ;
192PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
193 ;
194 ; N AMAP
195 S AMAP=$NA(^TMP($J,"AMAP"))
196 K @AMAP
197 I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
198 . W "WARNING - MISSING PROVIDER: ",AIEN,!
199 . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
200 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
201 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
202 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
203 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
204 S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
205 S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
206 S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
207 S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
208 S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
209 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
210 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
211 S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
212 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
213 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
214 S @AMAP@("ACTORTELEPHONE")=""
215 S @AMAP@("ACTORTELEPHONETYPE")=""
216 S ZX=$$TEL^C0CVA200(AIEN)
217 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
218 . S @AMAP@("ACTORTELEPHONE")=ZX
219 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
220 S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
221 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
222 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
223 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
224 Q
225 ;
Note: See TracBrowser for help on using the repository browser.