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

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

name spacing the package to C0C ... removing all GPL references
File size: 8.4 KB
Line 
1C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
2 ;;0.4;CCDCCR;nopatch;noreleasedate
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 N AMAP,ZX
88 S AMAP=$NA(^TMP($J,"AMAP"))
89 K @AMAP
90 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
91 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT(AIEN)
92 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT(AIEN)
93 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT(AIEN)
94 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT(AIEN)
95 S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT(AIEN)
96 S @AMAP@("ACTORSSN")=""
97 S @AMAP@("ACTORSSNTEXT")=""
98 S @AMAP@("ACTORSSNSOURCEID")=""
99 S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
100 X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
101 I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
102 I $D(MRN) D ; IF MRN IS PRESENT
103 . S @AMAP@("ACTORSSN")=MRN
104 . S @AMAP@("ACTORSSNTEXT")="MRN"
105 . S @AMAP@("ACTORSSNSOURCEID")=AOID
106 E D ; NO MRN, USE SSN
107 . S ZX=$$SSN^CCRDPT(AIEN)
108 . I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
109 . . S @AMAP@("ACTORSSN")=ZX
110 . . S @AMAP@("ACTORSSNTEXT")="SSN"
111 . . S @AMAP@("ACTORSSNSOURCEID")=AOID
112 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT(AIEN)
113 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT(AIEN)
114 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT(AIEN)
115 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT(AIEN)
116 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT(AIEN)
117 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT(AIEN)
118 S @AMAP@("ACTORRESTEL")=""
119 S @AMAP@("ACTORRESTELTEXT")=""
120 S ZX=$$RESTEL^CCRDPT(AIEN)
121 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
122 . S @AMAP@("ACTORRESTEL")=ZX
123 . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
124 S @AMAP@("ACTORWORKTEL")=""
125 S @AMAP@("ACTORWORKTELTEXT")=""
126 S ZX=$$WORKTEL^CCRDPT(AIEN)
127 I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
128 . S @AMAP@("ACTORWORKTEL")=ZX
129 . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
130 S @AMAP@("ACTORCELLTEL")=""
131 S @AMAP@("ACTORCELLTELTEXT")=""
132 S ZX=$$CELLTEL^CCRDPT(AIEN)
133 I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
134 . S @AMAP@("ACTORCELLTEL")=ZX
135 . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
136 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT(AIEN)
137 S @AMAP@("ACTORADDRESSSOURCEID")=AOID
138 S @AMAP@("ACTORIEN")=AIEN
139 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
140 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
141 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
142 Q
143 ;
144SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM 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@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
151 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
152 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
153 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
154 Q
155 ;
156NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE 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@("ACTORDISPLAYNAME")=""
163 S @AMAP@("ACTORRELATION")=""
164 S @AMAP@("ACTORRELATIONSOURCEID")=""
165 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
166 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
167 Q
168 ;
169ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
170 ;
171 ; N AMAP
172 S AMAP=$NA(^TMP($J,"AMAP"))
173 K @AMAP
174 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
175 S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
176 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
177 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
178 Q
179 ;
180PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
181 ;
182 ; N AMAP
183 S AMAP=$NA(^TMP($J,"AMAP"))
184 K @AMAP
185 I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
186 . W "WARNING - MISSING PROVIDER: ",AIEN,!
187 . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
188 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
189 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
190 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
191 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
192 S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
193 S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
194 S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
195 S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
196 S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
197 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
198 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
199 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
200 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
201 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
202 S @AMAP@("ACTORTELEPHONE")=""
203 S @AMAP@("ACTORTELEPHONETYPE")=""
204 S ZX=$$TEL^CCRVA200(AIEN)
205 I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
206 . S @AMAP@("ACTORTELEPHONE")=ZX
207 . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
208 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
209 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
210 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
211 D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
212 Q
213 ;
Note: See TracBrowser for help on using the repository browser.