source: ccr/trunk/p/GPLACTOR.m@ 171

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

removed debugging writes and check for Merged Patients
File size: 8.2 KB
Line 
1GPLACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
2 ;;0.3;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 ; PROCESS THE ACTORS SECTION OF THE CCR
21 ;
22 ; ===Revision History===
23 ; 0.1 Initial Writing of Skeleton--GPL
24 ; 0.2 Patient Data Extraction--SMH
25 ; 0.3 Information System Info Extraction--SMH
26 ;
27EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
28 ; IPXML is the Input Actor Template into which we substitute values
29 ; This is straight XML. Values to be substituted are in @@VAL@@ format.
30 ; ALST is the actor list global generated by ACTLST^GPLCCR and has format:
31 ; ^TMP(7542,1,"ACTORS",0)=Count
32 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
33 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
34 ; AXML is the output arrary, to contain XML.
35 ;
36 N I,J,AMAP,AOID,ATYP,AIEN
37 D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
38 D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
39 I DEBUG W "PROCESSING ACTORS ",!
40 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
41 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
42 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
43 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
44 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
45 . I ATYP="" Q ; NOT A VALID ACTOR
46 . ;
47 . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
48 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
49 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
50 . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
51 . ;
52 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
53 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
54 . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
55 . ;
56 . I ATYP="NOK" D ; NOK ACTOR TYPE
57 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
58 . . D NOK("ATMP",AIEN,AOID,"ATMP2")
59 . ;
60 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
61 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
62 . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
63 . ;
64 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
65 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
66 . . D ORG("ATMP",AIEN,AOID,"ATMP2")
67 . ;
68 . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
69 ;
70 N ACTTMP
71 D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
72 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
73 . ; STRINGS MARKED AS @@X@@
74 . W "ACTORS Missing list: ",!
75 . F I=1:1:ACTTMP(0) W ACTTMP(I),!
76 Q
77 ;
78PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
79 ;
80 I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
81 N AMAP,ZX
82 S AMAP=$NA(^TMP($J,"AMAP"))
83 K @AMAP
84 D INIT^CCRDPT(AIEN)
85 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
86 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
87 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
88 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
89 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
90 S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
91 S @AMAP@("ACTORSSN")=""
92 S @AMAP@("ACTORSSNTEXT")=""
93 S @AMAP@("ACTORSSNSOURCEID")=""
94 S ZX=$$SSN^CCRDPT
95 I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
96 . S @AMAP@("ACTORSSN")=ZX
97 . S @AMAP@("ACTORSSNTEXT")="SSN"
98 . S @AMAP@("ACTORSSNSOURCEID")=AOID
99 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
100 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
101 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
102 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
103 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
104 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
105 S @AMAP@("ACTORRESTEL")=""
106 S @AMAP@("ACTORRESTELTEXT")=""
107 S ZX=$$RESTEL^CCRDPT
108 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
109 . S @AMAP@("ACTORRESTEL")=ZX
110 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
111 S @AMAP@("ACTORWORKTEL")=""
112 S @AMAP@("ACTORWORKTELTEXT")=""
113 S ZX=$$WORKTEL^CCRDPT
114 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
115 . S @AMAP@("ACTORWORKTEL")=ZX
116 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
117 S @AMAP@("ACTORCELLTEL")=""
118 S @AMAP@("ACTORCELLTELTEXT")=""
119 S ZX=$$CELLTEL^CCRDPT
120 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
121 . S @AMAP@("ACTORCELLTEL")=ZX
122 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
123 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
124 S @AMAP@("ACTORADDRESSSOURCEID")=AOID
125 S @AMAP@("ACTORIEN")=AIEN
126 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
127 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
128 D DESTROY^CCRDPT
129 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
130 Q
131 ;
132SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
133 ;
134 ; N AMAP
135 S AMAP=$NA(^TMP($J,"AMAP"))
136 K @AMAP
137 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
138 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
139 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
140 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
141 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
142 Q
143 ;
144NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
145 ;
146 ; N AMAP
147 S AMAP=$NA(^TMP($J,"AMAP"))
148 K @AMAP
149 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
150 S @AMAP@("ACTORDISPLAYNAME")=""
151 S @AMAP@("ACTORRELATION")=""
152 S @AMAP@("ACTORRELATIONSOURCEID")=""
153 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
154 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
155 Q
156 ;
157ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
158 ;
159 ; N AMAP
160 S AMAP=$NA(^TMP($J,"AMAP"))
161 K @AMAP
162 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
163 S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
164 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
165 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
166 Q
167 ;
168PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER 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@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
175 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
176 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
177 S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
178 S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
179 S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
180 S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
181 S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
182 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
183 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
184 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
185 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
186 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
187 S @AMAP@("ACTORTELEPHONE")=""
188 S @AMAP@("ACTORTELEPHONETYPE")=""
189 S ZX=$$TEL^CCRVA200(AIEN)
190 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
191 . S @AMAP@("ACTORTELEPHONE")=ZX
192 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
193 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
194 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
195 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
196 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
197 Q
198 ;
Note: See TracBrowser for help on using the repository browser.