GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ;;0.1;CCDCCR;nopatch;noreleasedate ; ; PROCESS THE ACTORS SECTION OF THE CCR ; 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") . ; . 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")="" S @AMAP@("ACTORINFOSYSSOURCEID")="" 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 ; 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")="" S @AMAP@("ACTORMIDDLENAME")="" S @AMAP@("ACTORFAMILYNAME")="" S @AMAP@("ACTORSPECIALITY")="" S @AMAP@("ACTORADDRESSTYPE")="" S @AMAP@("ACTORADDRESSLINE1")="" S @AMAP@("ACTORADDRESSLINE2")="" S @AMAP@("ACTORADDRESSCITY")="" S @AMAP@("ACTORADDRESSSTATE")="" S @AMAP@("ACTORADDRESSZIPCODE")="" S @AMAP@("ACTORTELEPHONE")="" S @AMAP@("ACTORTELEPHONETYPE")="" S @AMAP@("ACTOREMAIL")="" S @AMAP@("ACTORADDRESSSOURCEID")="" D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE Q ;