110 lines
4.1 KiB
Mathematica
110 lines
4.1 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,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
|
|
;
|