Changeset 45 for ccr/trunk/p/GPLACTORS.m

Timestamp:

Jul 5, 2008, 7:57:32 PM (16 years ago)

Author:

George Lilly

Message:

Actor processing shell is operational

File:

• ccr/trunk/p/GPLACTORS.m (modified) (7 diffs)

ccr/trunk/p/GPLACTORS.m

@@ -4 +4 @@
            ;  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
@@ -15 +17 @@
            . 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")
@@ -31 +34 @@
            . . 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@@
@@ -46 +45 @@
 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")=""
@@ -70 +71 @@
 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")=""
@@ -79 +81 @@
 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")=""
@@ -89 +92 @@
 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")=""