VistA-ccr/p/GPLACTORS.m

126 lines
4.9 KiB
Mathematica

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
;