Actor processing shell is operational

p/GPLACTORS.m

@@ -3,10 +3,12 @@ GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
            ;
            ;  PROCESS THE ACTORS SECTION OF THE CCR
            ;
-EXTRACT(IPXML,ALST,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
+EXTRACT(IPXML,ALST,AXML) ; 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
+           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
@@ -14,6 +16,7 @@ EXTRACT(IPXML,ALST,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
            . 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")
@@ -30,13 +33,9 @@ EXTRACT(IPXML,ALST,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
            . . 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 INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
            ;
-           D MISSING^GPLXPATH(OUTXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
+           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: ",!
@@ -45,7 +44,9 @@ EXTRACT(IPXML,ALST,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
            ;
 PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
      ;
-     N AMAP
+     W "PROCESSING ACTOR PATIENT ",ACTREC,!
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
      S @AMAP@("ACTORGIVENNAME")=""
      S @AMAP@("ACTORMIDDLENAME")=""
@@ -69,7 +70,8 @@ PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
      ;
 SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
      ;
-     N AMAP
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
      S @AMAP@("ACTORINFOSYSNAME")=""
      S @AMAP@("ACTORINFOSYSSOURCEID")=""
@@ -78,7 +80,8 @@ SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
      ;
 NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
      ;
-     N AMAP
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
      S @AMAP@("ACTORDISPLAYNAME")=""
      S @AMAP@("ACTORRELATION")=""
@@ -88,7 +91,8 @@ NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
      ;
 PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
      ;
-     N AMAP
+     ; N AMAP
+     S AMAP=$NA(^TMP($J,"AMAP"))
      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
      S @AMAP@("ACTORGIVENNAME")=""
      S @AMAP@("ACTORMIDDLENAME")=""

p/GPLCCR.m

@@ -66,6 +66,9 @@ CCRRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
     . D INSERT^GPLXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
     . I DEBUG F GPLI=1:1:@OXML@(0) W @OXML@(GPLI),!
     D ACTLST^GPLCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
+    D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
+    D EXTRACT^GPLACTORS("ACTT",ACTGLO,"ACTT2")
+    D INSINNER^GPLXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
     Q
     ;
 INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
@@ -82,7 +85,7 @@ HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
     I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
     . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
     . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - ???
-    . S @VMAP@("ACTORFROM2")="ACTORPROVIDER_"_DUZ ; NEED BETTER WAY
+    . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
     . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES,
     . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
     I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
@@ -150,4 +153,8 @@ TLIST  ; LIST THE TESTS
  ;;>>>K GPL S GPL=""
  ;;>>>D CCRRPC^GPLCCR(.GPL,"2","CCR","","","")
  ;;>>>D ACTLST^GPLCCR(GPL,"ACTTEST")
+ ;;><ACTORS>
+ ;;>>>D ZTEST^GPLCCR("ACTLST")
+ ;;>>>D QUERY^GPLXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
+ ;;>>>D EXTRACT^GPLACTORS("G2","ACTTEST","G3")
  ;;></TEST>