Changeset 1544 for ccr/trunk/p/C0CACTOR.m

Timestamp:

Oct 1, 2012, 9:32:46 PM (12 years ago)

Author:

Sam Habiel

Message:

Merged Routines in OHUM branch back in main tree

Location:

ccr/trunk/p

Files:

• . (modified) (1 prop)
• C0CACTOR.m (modified) (1 diff, 1 prop)

ccr/trunk/p/C0CACTOR.m

@@ -1 @@
-C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
- ;;1.0;C0C;;May 19, 2009;Build 38
- ;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 47
+        ;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
+            ;