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
RevLine 
[98]1GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
[60]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.
[78]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 ;
[45]27EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
[78]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.
[98]35 ;
[45]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 ",!
[37]40 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
[48]41 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
[37]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
[48]45 . I ATYP="" Q ; NOT A VALID ACTOR
[37]46 . ;
[45]47 . W AOID_" "_ATYP_" "_AIEN,!
[43]48 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
49 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
[75]50 . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
[37]51 . ;
[43]52 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
53 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
[75]54 . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
[37]55 . ;
[43]56 . I ATYP="NOK" D ; NOK ACTOR TYPE
57 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
[75]58 . . D NOK("ATMP",AIEN,AOID,"ATMP2")
[37]59 . ;
[43]60 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
61 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
[75]62 . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
[43]63 . ;
[57]64 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
65 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
[75]66 . . D ORG("ATMP",AIEN,AOID,"ATMP2")
[57]67 . ;
[45]68 . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
[37]69 ;
[98]70 N ACTTMP
[45]71 D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
[43]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),!
[37]76 Q
77 ;
[75]78PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
[43]79 ;
[75]80 W "PROCESSING ACTOR PATIENT ",AIEN,!
[98]81 N AMAP,ZX
[45]82 S AMAP=$NA(^TMP($J,"AMAP"))
[75]83 K @AMAP
[57]84 D INIT^CCRDPT(AIEN)
[43]85 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
[48]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
[78]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
[48]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
[78]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"
[48]123 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
124 S @AMAP@("ACTORADDRESSSOURCEID")=AOID
[75]125 S @AMAP@("ACTORIEN")=AIEN
[78]126 S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
127 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
[57]128 D DESTROY^CCRDPT
[43]129 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
130 Q
131 ;
[75]132SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
[43]133 ;
[45]134 ; N AMAP
135 S AMAP=$NA(^TMP($J,"AMAP"))
[75]136 K @AMAP
[43]137 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
[49]138 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
[57]139 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
[49]140 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
[43]141 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
142 Q
143 ;
[75]144NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
[43]145 ;
[45]146 ; N AMAP
147 S AMAP=$NA(^TMP($J,"AMAP"))
[75]148 K @AMAP
[43]149 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
150 S @AMAP@("ACTORDISPLAYNAME")=""
151 S @AMAP@("ACTORRELATION")=""
152 S @AMAP@("ACTORRELATIONSOURCEID")=""
[78]153 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
[43]154 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
155 Q
156 ;
[75]157ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
[57]158 ;
159 ; N AMAP
160 S AMAP=$NA(^TMP($J,"AMAP"))
[75]161 K @AMAP
[57]162 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
[71]163 S @AMAP@("ORGANIZATIONNAME")=$P($$SITE^VASITE,U,2)
[57]164 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
165 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
166 Q
167 ;
[75]168PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
[43]169 ;
[45]170 ; N AMAP
171 S AMAP=$NA(^TMP($J,"AMAP"))
[75]172 K @AMAP
[43]173 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
[67]174 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
175 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
176 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
[71]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)
[67]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)
[78]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)
[67]193 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
194 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
[78]195 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
[43]196 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
197 Q
198 ;
Note: See TracBrowser for help on using the repository browser.