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

Last change on this file since 43 was 43, checked in by George Lilly, 16 years ago

Format changes for SAC compliance
File size: 4.1 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,OUTXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
7 ;
8 N I,J,ATMP,FIRST,AMAP,AOID,ATYP,AIEN
9 S FIRST=1 ; NEED TO KNOW WHICH IS THE FIRST ACTOR
10 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
11 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
12 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
13 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
14 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
15 . I ATYP="" Q ; NOT A VALID ACTOR
16 . ;
17 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
18 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
19 . . D PATIENT("ATMP",@ALST@(I),"ATMP2")
20 . ;
21 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
22 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
23 . . D SYSTEM("ATMP",@ALST@(I),"ATMP2")
24 . ;
25 . I ATYP="NOK" D ; NOK ACTOR TYPE
26 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
27 . . D NOK("ATMP",@ALST@(I),"ATMP2")
28 . ;
29 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
30 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
31 . . D PROVIDER("ATMP",@ALST@(I),"ATMP2")
32 . ;
33 . I FIRST D ; FIRST TIME , ONLY COPY THE ARRAY
34 . . D CP^GPLXPATH("ATMP",OUTXML) ;
35 . . S FIRST=0 ; NO LONGER THE FIRST TIME
36 . I 'FIRST D ; ALL NON-FIRST ACTORS MUST BE INSERTED
37 . . D INSERT^GPLXPATH("ATMP","//",OUTXML) ; INSERT AT ROOT
38 ;
39 D MISSING^GPLXPATH(OUTXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
40 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
41 . ; STRINGS MARKED AS @@X@@
42 . W "ACTORS Missing list: ",!
43 . F I=1:1:ACTTMP(0) W ACTTMP(I),!
44 Q
45 ;
46PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
47 ;
48 N AMAP
49 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
50 S @AMAP@("ACTORGIVENNAME")=""
51 S @AMAP@("ACTORMIDDLENAME")=""
52 S @AMAP@("ACTORFAMILYNAME")=""
53 S @AMAP@("ACTORDATEOFBIRTH")=""
54 S @AMAP@("ACTORGENDER")=""
55 S @AMAP@("ACTORSSN")=""
56 S @AMAP@("ACTORSSNSOURCEID")=""
57 S @AMAP@("ACTORADDRESSTYPE")=""
58 S @AMAP@("ACTORADDRESSLINE1")=""
59 S @AMAP@("ACTORADDRESSLINE2")=""
60 S @AMAP@("ACTORADDRESSCITY")=""
61 S @AMAP@("ACTORADDRESSSTATE")=""
62 S @AMAP@("ACTORADDRESSZIPCODE")=""
63 S @AMAP@("ACTORTELEPHONE")=""
64 S @AMAP@("ACTORTELEPHONETYPE")=""
65 S @AMAP@("ACTOREMAIL")=""
66 S @AMAP@("ACTORADDRESSSOURCEID")=""
67 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
68 Q
69 ;
70SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
71 ;
72 N AMAP
73 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
74 S @AMAP@("ACTORINFOSYSNAME")=""
75 S @AMAP@("ACTORINFOSYSSOURCEID")=""
76 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
77 Q
78 ;
79NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
80 ;
81 N AMAP
82 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
83 S @AMAP@("ACTORDISPLAYNAME")=""
84 S @AMAP@("ACTORRELATION")=""
85 S @AMAP@("ACTORRELATIONSOURCEID")=""
86 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
87 Q
88 ;
89PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
90 ;
91 N AMAP
92 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
93 S @AMAP@("ACTORGIVENNAME")=""
94 S @AMAP@("ACTORMIDDLENAME")=""
95 S @AMAP@("ACTORFAMILYNAME")=""
96 S @AMAP@("ACTORSPECIALITY")=""
97 S @AMAP@("ACTORADDRESSTYPE")=""
98 S @AMAP@("ACTORADDRESSLINE1")=""
99 S @AMAP@("ACTORADDRESSLINE2")=""
100 S @AMAP@("ACTORADDRESSCITY")=""
101 S @AMAP@("ACTORADDRESSSTATE")=""
102 S @AMAP@("ACTORADDRESSZIPCODE")=""
103 S @AMAP@("ACTORTELEPHONE")=""
104 S @AMAP@("ACTORTELEPHONETYPE")=""
105 S @AMAP@("ACTOREMAIL")=""
106 S @AMAP@("ACTORADDRESSSOURCEID")=""
107 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
108 Q
109 ;
Note: See TracBrowser for help on using the repository browser.