VistA-ccr/p/GPLACTORS.m

GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
 ;;0.3;CCDCCR;nopatch;noreleasedate
 ;Copyright 2008 WorldVistA.  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
           ;
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
           ; IPXML is the Input Actor Template into which we are going to substitute values
                   ; This is straight XML. Values to be substituted are in @@VAL@@ format.

                   ; ALST is the actor list global generated by ACTLST^GPLCCR and is in the following 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^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
           D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
           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 ATYP="" Q  ; NOT A VALID ACTOR
           . ;
           . W AOID_" "_ATYP_" "_AIEN,!
           . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
           . . D PATIENT("ATMP",@ALST@(I),"ATMP2")
           . ;
           . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
           . . D SYSTEM("ATMP",@ALST@(I),"ATMP2")
           . ;
           . I ATYP="NOK" D  ; NOK ACTOR TYPE
           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
           . . D NOK("ATMP",@ALST@(I),"ATMP2")
           . ;
           . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
           . . D PROVIDER("ATMP",@ALST@(I),"ATMP2")
           . ;
           . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
           . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
           . . D ORG("ATMP",@ALST@(I),"ATMP2")
           . ;
           . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
           ;
           D MISSING^GPLXPATH(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,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
     ;
     W "PROCESSING ACTOR PATIENT ",ACTREC,!
     ; N AMAP
     S AMAP=$NA(^TMP($J,"AMAP"))
         D INIT^CCRDPT(AIEN)
     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
     S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
     S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
     S @AMAP@("ACTORSSN")=$$SSN^CCRDPT
     S @AMAP@("ACTORSSNSOURCEID")=AOID
     S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
     S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
     S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
     S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
     S @AMAP@("ACTORRESTEL")=$$RESTEL^CCRDPT
     S @AMAP@("ACTORWORKTEL")=$$WORKTEL^CCRDPT
         S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT
     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
     S @AMAP@("ACTORADDRESSSOURCEID")=AOID
         D DESTROY^CCRDPT
     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     Q
     ;
SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
     ;
     ; N AMAP
     S AMAP=$NA(^TMP($J,"AMAP"))
     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
         S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
     S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     Q
     ;
NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
     ;
     ; N AMAP
     S AMAP=$NA(^TMP($J,"AMAP"))
     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     S @AMAP@("ACTORDISPLAYNAME")=""
     S @AMAP@("ACTORRELATION")=""
     S @AMAP@("ACTORRELATIONSOURCEID")=""
     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     Q
     ;
ORG(INXML,ACTREC,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
     ;
     ; N AMAP
     S AMAP=$NA(^TMP($J,"AMAP"))
     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     S @AMAP@("ORGANIZATIONNAME")="WORLDVISTA EHR CLINIC"
     S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     Q
     ;
PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
     ;
     ; N AMAP
     S AMAP=$NA(^TMP($J,"AMAP"))
     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
     S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
     S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
	 S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
	 S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
	 S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
	 S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
     S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
     S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
     S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
     S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
     S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
     S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
     S @AMAP@("ACTORTELEPHONE")=$$TEL^CCRVA200(AIEN)
     S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
     S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
     S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
     D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     Q
     ;