VistA-ccr/p/GPLACTORS.m

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,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
           ;
           N I,J,ATMP,FIRST,AMAP,AOID,ATYP,AIEN
           S FIRST=1 ; NEED TO KNOW WHICH IS THE FIRST ACTOR
           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
           . ;
           . 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 FIRST D  ; FIRST TIME , ONLY COPY THE ARRAY
           . . D CP^GPLXPATH("ATMP",OUTXML) ;
           . . S FIRST=0 ; NO LONGER THE FIRST TIME
           . I 'FIRST D  ; ALL NON-FIRST ACTORS MUST BE INSERTED
           . . D INSERT^GPLXPATH("ATMP","//",OUTXML) ; INSERT AT ROOT
           ;
           D MISSING^GPLXPATH(OUTXML,"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
     ;
     N AMAP
     S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     S @AMAP@("ACTORGIVENNAME")=""
     S @AMAP@("ACTORMIDDLENAME")=""
     S @AMAP@("ACTORFAMILYNAME")=""
     S @AMAP@("ACTORDATEOFBIRTH")=""
     S @AMAP@("ACTORGENDER")=""
     S @AMAP@("ACTORSSN")=""
     S @AMAP@("ACTORSSNSOURCEID")=""
     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
     ;
SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
     ;
     N 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@("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@("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
     ;