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

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

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