source: ccr/trunk/p/GPLACTORS.m@ 45

Last change on this file since 45 was 45, checked in by George Lilly, 17 years ago

Actor processing shell is operational
File size: 4.2 KB
Line 
1GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
2 ;;0.1;CCDCCR;nopatch;noreleasedate
3 ;
4 ; PROCESS THE ACTORS SECTION OF THE CCR
5 ;
6EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
7 ;
8 N I,J,AMAP,AOID,ATYP,AIEN
9 D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
10 D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
11 W "PROCESSING ACTORS ",!
12 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
13 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
14 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
15 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
16 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
17 . I ATYP="" Q ; NOT A VALID ACTOR
18 . ;
19 . W AOID_" "_ATYP_" "_AIEN,!
20 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
21 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
22 . . D PATIENT("ATMP",@ALST@(I),"ATMP2")
23 . ;
24 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
25 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
26 . . D SYSTEM("ATMP",@ALST@(I),"ATMP2")
27 . ;
28 . I ATYP="NOK" D ; NOK ACTOR TYPE
29 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
30 . . D NOK("ATMP",@ALST@(I),"ATMP2")
31 . ;
32 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
33 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
34 . . D PROVIDER("ATMP",@ALST@(I),"ATMP2")
35 . ;
36 . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
37 ;
38 D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
39 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
40 . ; STRINGS MARKED AS @@X@@
41 . W "ACTORS Missing list: ",!
42 . F I=1:1:ACTTMP(0) W ACTTMP(I),!
43 Q
44 ;
45PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
46 ;
47 W "PROCESSING ACTOR PATIENT ",ACTREC,!
48 ; N AMAP
49 S AMAP=$NA(^TMP($J,"AMAP"))
50 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
51 S @AMAP@("ACTORGIVENNAME")=""
52 S @AMAP@("ACTORMIDDLENAME")=""
53 S @AMAP@("ACTORFAMILYNAME")=""
54 S @AMAP@("ACTORDATEOFBIRTH")=""
55 S @AMAP@("ACTORGENDER")=""
56 S @AMAP@("ACTORSSN")=""
57 S @AMAP@("ACTORSSNSOURCEID")=""
58 S @AMAP@("ACTORADDRESSTYPE")=""
59 S @AMAP@("ACTORADDRESSLINE1")=""
60 S @AMAP@("ACTORADDRESSLINE2")=""
61 S @AMAP@("ACTORADDRESSCITY")=""
62 S @AMAP@("ACTORADDRESSSTATE")=""
63 S @AMAP@("ACTORADDRESSZIPCODE")=""
64 S @AMAP@("ACTORTELEPHONE")=""
65 S @AMAP@("ACTORTELEPHONETYPE")=""
66 S @AMAP@("ACTOREMAIL")=""
67 S @AMAP@("ACTORADDRESSSOURCEID")=""
68 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
69 Q
70 ;
71SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
72 ;
73 ; N AMAP
74 S AMAP=$NA(^TMP($J,"AMAP"))
75 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
76 S @AMAP@("ACTORINFOSYSNAME")=""
77 S @AMAP@("ACTORINFOSYSSOURCEID")=""
78 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
79 Q
80 ;
81NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
82 ;
83 ; N AMAP
84 S AMAP=$NA(^TMP($J,"AMAP"))
85 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
86 S @AMAP@("ACTORDISPLAYNAME")=""
87 S @AMAP@("ACTORRELATION")=""
88 S @AMAP@("ACTORRELATIONSOURCEID")=""
89 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
90 Q
91 ;
92PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
93 ;
94 ; N AMAP
95 S AMAP=$NA(^TMP($J,"AMAP"))
96 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
97 S @AMAP@("ACTORGIVENNAME")=""
98 S @AMAP@("ACTORMIDDLENAME")=""
99 S @AMAP@("ACTORFAMILYNAME")=""
100 S @AMAP@("ACTORSPECIALITY")=""
101 S @AMAP@("ACTORADDRESSTYPE")=""
102 S @AMAP@("ACTORADDRESSLINE1")=""
103 S @AMAP@("ACTORADDRESSLINE2")=""
104 S @AMAP@("ACTORADDRESSCITY")=""
105 S @AMAP@("ACTORADDRESSSTATE")=""
106 S @AMAP@("ACTORADDRESSZIPCODE")=""
107 S @AMAP@("ACTORTELEPHONE")=""
108 S @AMAP@("ACTORTELEPHONETYPE")=""
109 S @AMAP@("ACTOREMAIL")=""
110 S @AMAP@("ACTORADDRESSSOURCEID")=""
111 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
112 Q
113 ;
Note: See TracBrowser for help on using the repository browser.