1 | GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
---|
2 | ;;0.3;CCDCCR;nopatch;noreleasedate
|
---|
3 | ;
|
---|
4 | ; PROCESS THE ACTORS SECTION OF THE CCR
|
---|
5 | ;
|
---|
6 | ;===Revision History===
|
---|
7 | ; 0.1 Initial Writing of Skeleton--GPL
|
---|
8 | ; 0.2 Patient Data Extraction--SMH
|
---|
9 | ; 0.3 Information System Info Extraction--SMH
|
---|
10 | ;
|
---|
11 | EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
---|
12 | ; IPXML is the Input Actor Template into which we are going to substitute values
|
---|
13 | ; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
---|
14 |
|
---|
15 | ; ALST is the actor list global generated by ACTLST^GPLCCR and is in the following format
|
---|
16 | ; ^TMP(7542,1,"ACTORS",0)=Count
|
---|
17 | ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
---|
18 | ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
---|
19 |
|
---|
20 | ; AXML is the output arrary, to contain XML.
|
---|
21 |
|
---|
22 | N I,J,AMAP,AOID,ATYP,AIEN
|
---|
23 | D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
---|
24 | D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
---|
25 | W "PROCESSING ACTORS ",!
|
---|
26 | F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
---|
27 | . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
---|
28 | . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
---|
29 | . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
---|
30 | . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
---|
31 | . I ATYP="" Q ; NOT A VALID ACTOR
|
---|
32 | . ;
|
---|
33 | . W AOID_" "_ATYP_" "_AIEN,!
|
---|
34 | . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
---|
35 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
---|
36 | . . D PATIENT("ATMP",@ALST@(I),"ATMP2")
|
---|
37 | . ;
|
---|
38 | . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
---|
39 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
---|
40 | . . D SYSTEM("ATMP",@ALST@(I),"ATMP2")
|
---|
41 | . ;
|
---|
42 | . I ATYP="NOK" D ; NOK ACTOR TYPE
|
---|
43 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
---|
44 | . . D NOK("ATMP",@ALST@(I),"ATMP2")
|
---|
45 | . ;
|
---|
46 | . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
---|
47 | . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
---|
48 | . . D PROVIDER("ATMP",@ALST@(I),"ATMP2")
|
---|
49 | . ;
|
---|
50 | . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
---|
51 | ;
|
---|
52 | D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
---|
53 | I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
---|
54 | . ; STRINGS MARKED AS @@X@@
|
---|
55 | . W "ACTORS Missing list: ",!
|
---|
56 | . F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
---|
57 | Q
|
---|
58 | ;
|
---|
59 | PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
|
---|
60 | ;
|
---|
61 | W "PROCESSING ACTOR PATIENT ",ACTREC,!
|
---|
62 | ; N AMAP
|
---|
63 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
64 | D INIT^CCRDPT(AIEN)
|
---|
65 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
66 | S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
|
---|
67 | S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
|
---|
68 | S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
|
---|
69 | S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
|
---|
70 | S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
|
---|
71 | S @AMAP@("ACTORSSN")=$$SSN^CCRDPT
|
---|
72 | S @AMAP@("ACTORSSNSOURCEID")=AOID
|
---|
73 | S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
|
---|
74 | S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
|
---|
75 | S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
|
---|
76 | S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
|
---|
77 | S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
|
---|
78 | S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
|
---|
79 | S @AMAP@("ACTORRESTEL")=$$RESTEL^CCRDPT
|
---|
80 | S @AMAP@("ACTORWORKTEL")=$$WORKTEL^CCRDPT
|
---|
81 | S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT
|
---|
82 | S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
|
---|
83 | S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
---|
84 | D DESTROY^CCRDPT
|
---|
85 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
86 | Q
|
---|
87 | ;
|
---|
88 | SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
|
---|
89 | ;
|
---|
90 | ; N AMAP
|
---|
91 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
92 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
93 | S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
|
---|
94 | S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
|
---|
95 | S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
---|
96 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
---|
100 | ;
|
---|
101 | ; N AMAP
|
---|
102 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
103 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
104 | S @AMAP@("ACTORDISPLAYNAME")=""
|
---|
105 | S @AMAP@("ACTORRELATION")=""
|
---|
106 | S @AMAP@("ACTORRELATIONSOURCEID")=""
|
---|
107 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
108 | Q
|
---|
109 | ;
|
---|
110 | PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
---|
111 | ;
|
---|
112 | ; N AMAP
|
---|
113 | S AMAP=$NA(^TMP($J,"AMAP"))
|
---|
114 | S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
---|
115 | S @AMAP@("ACTORGIVENNAME")=""
|
---|
116 | S @AMAP@("ACTORMIDDLENAME")=""
|
---|
117 | S @AMAP@("ACTORFAMILYNAME")=""
|
---|
118 | S @AMAP@("ACTORSPECIALITY")=""
|
---|
119 | S @AMAP@("ACTORADDRESSTYPE")=""
|
---|
120 | S @AMAP@("ACTORADDRESSLINE1")=""
|
---|
121 | S @AMAP@("ACTORADDRESSLINE2")=""
|
---|
122 | S @AMAP@("ACTORADDRESSCITY")=""
|
---|
123 | S @AMAP@("ACTORADDRESSSTATE")=""
|
---|
124 | S @AMAP@("ACTORADDRESSZIPCODE")=""
|
---|
125 | S @AMAP@("ACTORTELEPHONE")=""
|
---|
126 | S @AMAP@("ACTORTELEPHONETYPE")=""
|
---|
127 | S @AMAP@("ACTOREMAIL")=""
|
---|
128 | S @AMAP@("ACTORADDRESSSOURCEID")=""
|
---|
129 | D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
---|
130 | Q
|
---|
131 | ;
|
---|