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

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

rename GPLVITALS and GPLACTORS to GPLVITAL and GPLACTOR for kids build
File size: 8.2 KB
Line 
1GPLACTORS ; 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 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 . 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 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.