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 ;