Index: ccr/branches/ohum/p/C0CACTOR.m
===================================================================
--- ccr/branches/ohum/p/C0CACTOR.m	(revision 1342)
+++ ccr/branches/ohum/p/C0CACTOR.m	(revision 1428)
@@ -1,273 +1,273 @@
-C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
- ;;1.0;C0C;;May 19, 2009;Build 2
- ;Copyright 2008,2009 George Lilly, University of Minnesota.
- ;Licensed under the terms of the GNU General Public License.
- ;See attached copy of the License.
- ;
- ; This program is free software; you can redistribute it and/or modify
- ; it under the terms of the GNU General Public License as published by
- ; the Free Software Foundation; either version 2 of the License, or
- ; (at your option) any later version.
- ;
- ; This program is distributed in the hope that it will be useful,
- ; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- ; GNU General Public License for more details.
- ;
- ; You should have received a copy of the GNU General Public License along
- ; with this program; if not, write to the Free Software Foundation, Inc.,
- ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- ;
- ;  PROCESS THE ACTORS SECTION OF THE CCR
- ;
- ; ===Revision History===
- ; 0.1 Initial Writing of Skeleton--GPL
- ; 0.2 Patient Data Extraction--SMH
- ; 0.3 Information System Info Extraction--SMH
- ; 0.4 Patient data rouine refactored; adjustments here--SMH
- ;
-EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
- ; IPXML is the Input Actor Template into which we  substitute values
- ; This is straight XML. Values to be substituted are in @@VAL@@ format.
- ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
- ; ^TMP(7542,1,"ACTORS",0)=Count
- ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
- ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
- ; AXML is the output arrary, to contain XML.
- ;
- N I,J,AMAP,AOID,ATYP,AIEN
- D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
- D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
- I DEBUG W "PROCESSING ACTORS ",!
- F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
- . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
- . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
- . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
- . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
- . I AIEN="" D  Q  ; IEN CAN'T BE NULL
- . . W "WARING NUL ACTOR: ",ATYP,!
- . I ATYP="" Q  ; NOT A VALID ACTOR
- . ;
- . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
- . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
- . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
- . ;
- . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
- . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
- . ;
- . I ATYP="NOK" D  ; NOK ACTOR TYPE
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
- . . D NOK("ATMP",AIEN,AOID,"ATMP2")
- . ;
- . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
- . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
- . ;
- . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
- . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
- . . D ORG("ATMP",AIEN,AOID,"ATMP2")
- . ;
- . W "PROCESSING:",ATYP," ",AIEN,!
- . ;I @ATMP2@(0)=0 Q  ; NOTHING RETURNED, SKIP THIS ONE
- . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
- . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
- ;
- N ACTTMP
- D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
- I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
- . ; STRINGS MARKED AS @@X@@
- . W "ACTORS Missing list: ",!
- . F I=1:1:ACTTMP(0) W ACTTMP(I),!
- Q
- ;
-PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
- I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
- ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
- ; CODE REUSABLE FROM ERX
- N AMAP
- S AMAP=$NA(^TMP($J,"AMAP"))
- K @AMAP
- D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
- I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
- I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
- D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
- K @AMAP ; CLEAN UP BEHIND US
- Q
- ;
-DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
- S @GPL@("ACTORADDRESSCITY")="ALTON"
- S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
- S @GPL@("ACTORADDRESSLINE2")=""
- S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
- S @GPL@("ACTORADDRESSSTATE")="KANSAS"
- S @GPL@("ACTORADDRESSTYPE")="Home"
- S @GPL@("ACTORADDRESSZIPCODE")=67623
- S @GPL@("ACTORCELLTEL")=""
- S @GPL@("ACTORCELLTELTEXT")=""
- S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
- S @GPL@("ACTOREMAIL")=""
- S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
- ;S @GPL@("ACTORGENDER")="MALE"
- S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
- S @GPL@("ACTORIEN")=2
- S @GPL@("ACTORMIDDLENAME")="TWO"
- S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
- S @GPL@("ACTORRESTEL")="888-555-1212"
- S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
- S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
- S @GPL@("ACTORSSN")="769122557P"
- S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
- S @GPL@("ACTORSSNTEXT")="SSN"
- S @GPL@("ACTORSUFFIXNAME")=""
- S @GPL@("ACTORWORKTEL")="888-121-1212"
- S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
- Q
- ;
-PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
- N ZX
- S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
- S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
- S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
- S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
- S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
- S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
- S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
- S @AMAP@("ACTORSSN")=""
- S @AMAP@("ACTORSSNTEXT")=""
- S @AMAP@("ACTORSSNSOURCEID")=""
- S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
- X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
- I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
- I $G(MRN)'="" D  ; IF MRN IS PRESENT
- . S @AMAP@("ACTORSSN")=MRN
- . S @AMAP@("ACTORSSNTEXT")="MRN"
- . S @AMAP@("ACTORSSNSOURCEID")=AOID
- E  D  ; NO MRN, USE SSN
- . S ZX=$$SSN^C0CDPT(AIEN)
- . I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
- . . S @AMAP@("ACTORSSN")=ZX
- . . S @AMAP@("ACTORSSNTEXT")="SSN"
- . . S @AMAP@("ACTORSSNSOURCEID")=AOID
- S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
- S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
- S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
- S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
- S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
- S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
- S @AMAP@("ACTORRESTEL")=""
- S @AMAP@("ACTORRESTELTEXT")=""
- S ZX=$$RESTEL^C0CDPT(AIEN)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
- . S @AMAP@("ACTORRESTEL")=ZX
- . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
- S @AMAP@("ACTORWORKTEL")=""
- S @AMAP@("ACTORWORKTELTEXT")=""
- S ZX=$$WORKTEL^C0CDPT(AIEN)
- I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
- . S @AMAP@("ACTORWORKTEL")=ZX
- . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
- S @AMAP@("ACTORCELLTEL")=""
- S @AMAP@("ACTORCELLTELTEXT")=""
- S ZX=$$CELLTEL^C0CDPT(AIEN)
- I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
- . S @AMAP@("ACTORCELLTEL")=ZX
- . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
- S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
- S @AMAP@("ACTORADDRESSSOURCEID")=AOID
- S @AMAP@("ACTORIEN")=AIEN
- S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
- S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
- Q
- ;
-MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
- D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
- Q
- ;
-SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
-     S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
-     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
-     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
-NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORDISPLAYNAME")=""
-     S @AMAP@("ACTORRELATION")=""
-     S @AMAP@("ACTORRELATIONSOURCEID")=""
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
-ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
-     ;
-     N AMAP,ZIEN,ZSITE
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
-     S ZIEN=$P(ZSITE,"^",1)
-     S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
-     S @AMAP@("ACTORADDRESSTYPE")="Office"
-     S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
-     S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
-     S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
-     S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
-     S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
-     S @AMAP@("ACTORTELEPHONE")=""
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-     S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-     . S @AMAP@("ACTORTELEPHONETYPE")="Office"
-     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     K @AMAP
-     Q
-     ;
-PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
-     ;
-     ; N AMAP
-     S AMAP=$NA(^TMP($J,"AMAP"))
-     K @AMAP
-     I '$D(^VA(200,AIEN,0)) D  Q  ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
-     . W "WARNING - MISSING PROVIDER: ",AIEN,!
-     . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
-     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
-     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
-     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
-     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
-     S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
-     S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
-     S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
-     S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
-     S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
-     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
-     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
-     S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
-     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
-     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
-     S @AMAP@("ACTORTELEPHONE")=""
-     S @AMAP@("ACTORTELEPHONETYPE")=""
-     S ZX=$$TEL^C0CVA200(AIEN)
-     I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
-     . S @AMAP@("ACTORTELEPHONE")=ZX
-     . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
-     S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
-     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
-     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
-     S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
-     D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
-     Q
-     ;
+C0CACTOR	 ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
+	;;1.2;C0C;;May 11, 2012;Build 46
+	;Copyright 2008,2009 George Lilly, University of Minnesota.
+	;Licensed under the terms of the GNU General Public License.
+	;See attached copy of the License.
+	;
+	; This program is free software; you can redistribute it and/or modify
+	; it under the terms of the GNU General Public License as published by
+	; the Free Software Foundation; either version 2 of the License, or
+	; (at your option) any later version.
+	;
+	; This program is distributed in the hope that it will be useful,
+	; but WITHOUT ANY WARRANTY; without even the implied warranty of
+	; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	; GNU General Public License for more details.
+	;
+	; You should have received a copy of the GNU General Public License along
+	; with this program; if not, write to the Free Software Foundation, Inc.,
+	; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+	;
+	;  PROCESS THE ACTORS SECTION OF THE CCR
+	;
+	; ===Revision History===
+	; 0.1 Initial Writing of Skeleton--GPL
+	; 0.2 Patient Data Extraction--SMH
+	; 0.3 Information System Info Extraction--SMH
+	; 0.4 Patient data rouine refactored; adjustments here--SMH
+	;
+EXTRACT(IPXML,ALST,AXML)	; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+	; IPXML is the Input Actor Template into which we  substitute values
+	; This is straight XML. Values to be substituted are in @@VAL@@ format.
+	; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
+	; ^TMP(7542,1,"ACTORS",0)=Count
+	; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
+	; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
+	; AXML is the output arrary, to contain XML.
+	;
+	N I,J,AMAP,AOID,ATYP,AIEN
+	D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
+	D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
+	I DEBUG W "PROCESSING ACTORS ",!
+	F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
+	. I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
+	. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
+	. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
+	. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
+	. I AIEN="" D  Q  ; IEN CAN'T BE NULL
+	. . W "WARING NUL ACTOR: ",ATYP,!
+	. I ATYP="" Q  ; NOT A VALID ACTOR
+	. ;
+	. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
+	. I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
+	. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
+	. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
+	. ;
+	. I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
+	. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
+	. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
+	. ;
+	. I ATYP="NOK" D  ; NOK ACTOR TYPE
+	. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
+	. . D NOK("ATMP",AIEN,AOID,"ATMP2")
+	. ;
+	. I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
+	. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
+	. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
+	. ;
+	. I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
+	. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
+	. . D ORG("ATMP",AIEN,AOID,"ATMP2")
+	. ;
+	. W "PROCESSING:",ATYP," ",AIEN,!
+	. ;I @ATMP2@(0)=0 Q  ; NOTHING RETURNED, SKIP THIS ONE
+	. D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
+	. K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
+	;
+	N ACTTMP
+	D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+	I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
+	. ; STRINGS MARKED AS @@X@@
+	. W "ACTORS Missing list: ",!
+	. F I=1:1:ACTTMP(0) W ACTTMP(I),!
+	Q
+	;
+PATIENT(INXML,AIEN,AOID,OUTXML)	; PROCESS A PATIENT ACTOR
+	I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
+	;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
+	; CODE REUSABLE FROM ERX
+	N AMAP
+	S AMAP=$NA(^TMP($J,"AMAP"))
+	K @AMAP
+	D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
+	I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
+	I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
+	D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
+	K @AMAP ; CLEAN UP BEHIND US
+	Q
+	;
+DEIDENT(GPL,ZDFN)	; QUICK WAY TO DEIDENTIFY THE CCR
+	S @GPL@("ACTORADDRESSCITY")="ALTON"
+	S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
+	S @GPL@("ACTORADDRESSLINE2")=""
+	S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
+	S @GPL@("ACTORADDRESSSTATE")="KANSAS"
+	S @GPL@("ACTORADDRESSTYPE")="Home"
+	S @GPL@("ACTORADDRESSZIPCODE")=67623
+	S @GPL@("ACTORCELLTEL")=""
+	S @GPL@("ACTORCELLTELTEXT")=""
+	S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
+	S @GPL@("ACTOREMAIL")=""
+	S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
+	;S @GPL@("ACTORGENDER")="MALE"
+	S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
+	S @GPL@("ACTORIEN")=2
+	S @GPL@("ACTORMIDDLENAME")="TWO"
+	S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
+	S @GPL@("ACTORRESTEL")="888-555-1212"
+	S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
+	S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
+	S @GPL@("ACTORSSN")="769122557P"
+	S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
+	S @GPL@("ACTORSSNTEXT")="SSN"
+	S @GPL@("ACTORSUFFIXNAME")=""
+	S @GPL@("ACTORWORKTEL")="888-121-1212"
+	S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
+	Q
+	;
+PEXTRACT(AMAP,AIEN,AOID)	; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
+	N ZX
+	S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+	S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
+	S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
+	S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
+	S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
+	S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
+	S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
+	S @AMAP@("ACTORSSN")=""
+	S @AMAP@("ACTORSSNTEXT")=""
+	S @AMAP@("ACTORSSNSOURCEID")=""
+	S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
+	X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
+	I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
+	I $G(MRN)'="" D  ; IF MRN IS PRESENT
+	. S @AMAP@("ACTORSSN")=MRN
+	. S @AMAP@("ACTORSSNTEXT")="MRN"
+	. S @AMAP@("ACTORSSNSOURCEID")=AOID
+	E  D  ; NO MRN, USE SSN
+	. S ZX=$$SSN^C0CDPT(AIEN)
+	. I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
+	. . S @AMAP@("ACTORSSN")=ZX
+	. . S @AMAP@("ACTORSSNTEXT")="SSN"
+	. . S @AMAP@("ACTORSSNSOURCEID")=AOID
+	S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
+	S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
+	S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
+	S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
+	S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
+	S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
+	S @AMAP@("ACTORRESTEL")=""
+	S @AMAP@("ACTORRESTELTEXT")=""
+	S ZX=$$RESTEL^C0CDPT(AIEN)
+	I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+	. S @AMAP@("ACTORRESTEL")=ZX
+	. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
+	S @AMAP@("ACTORWORKTEL")=""
+	S @AMAP@("ACTORWORKTELTEXT")=""
+	S ZX=$$WORKTEL^C0CDPT(AIEN)
+	I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
+	. S @AMAP@("ACTORWORKTEL")=ZX
+	. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
+	S @AMAP@("ACTORCELLTEL")=""
+	S @AMAP@("ACTORCELLTELTEXT")=""
+	S ZX=$$CELLTEL^C0CDPT(AIEN)
+	I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
+	. S @AMAP@("ACTORCELLTEL")=ZX
+	. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
+	S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
+	S @AMAP@("ACTORADDRESSSOURCEID")=AOID
+	S @AMAP@("ACTORIEN")=AIEN
+	S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
+	S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+	Q
+	;
+MAP(INXML,AMAP,OUTXML)	;MAP ANY ACTOR TO XML
+	D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+	Q
+	;
+SYSTEM(INXML,AIEN,AOID,OUTXML)	; PROCESS A SYSTEM ACTOR
+	    ;
+	    ; N AMAP
+	    S AMAP=$NA(^TMP($J,"AMAP"))
+	    K @AMAP
+	    S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+	    S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
+	    S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
+	    S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
+	    D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+	    Q
+	    ;
+NOK(INXML,AIEN,AOID,OUTXML)	; PROCESS A NEXT OF KIN TYPE ACTOR
+	    ;
+	    ; N AMAP
+	    S AMAP=$NA(^TMP($J,"AMAP"))
+	    K @AMAP
+	    S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+	    S @AMAP@("ACTORDISPLAYNAME")=""
+	    S @AMAP@("ACTORRELATION")=""
+	    S @AMAP@("ACTORRELATIONSOURCEID")=""
+	    S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+	    D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+	    Q
+	    ;
+ORG(INXML,AIEN,AOID,OUTXML)	; PROCESS AN ORGANIZATION TYPE ACTOR
+	    ;
+	    N AMAP,ZIEN,ZSITE
+	    S AMAP=$NA(^TMP($J,"AMAP"))
+	    K @AMAP
+	    S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+	    S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
+	    S ZIEN=$P(ZSITE,"^",1)
+	    S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
+	    S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
+	    S @AMAP@("ACTORADDRESSTYPE")="Office"
+	    S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
+	    S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
+	    S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
+	    S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
+	    S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
+	    S @AMAP@("ACTORTELEPHONE")=""
+	    S @AMAP@("ACTORTELEPHONETYPE")=""
+	    S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
+	    I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+	    . S @AMAP@("ACTORTELEPHONE")=ZX
+	    . S @AMAP@("ACTORTELEPHONETYPE")="Office"
+	    D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+	    K @AMAP
+	    Q
+	    ;
+PROVIDER(INXML,AIEN,AOID,OUTXML)	; PROCESS A PROVIDER TYPE ACTOR
+	    ;
+	    ; N AMAP
+	    S AMAP=$NA(^TMP($J,"AMAP"))
+	    K @AMAP
+	    I '$D(^VA(200,AIEN,0)) D  Q  ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
+	    . W "WARNING - MISSING PROVIDER: ",AIEN,!
+	    . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
+	    S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
+	    S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
+	    S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
+	    S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
+	    S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
+	    S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
+	    S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
+	    S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
+	    S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
+	    S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
+	    S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
+	    S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
+	    S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
+	    S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
+	    S @AMAP@("ACTORTELEPHONE")=""
+	    S @AMAP@("ACTORTELEPHONETYPE")=""
+	    S ZX=$$TEL^C0CVA200(AIEN)
+	    I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
+	    . S @AMAP@("ACTORTELEPHONE")=ZX
+	    . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
+	    S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
+	    S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
+	    S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
+	    S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
+	    D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
+	    Q
+	    ;
