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

Last change on this file since 67 was 67, checked in by Sam Habiel, 16 years ago

Updated GPLACTORS to use CCRVA200 for provider data
File size: 7.1 KB
Line 
1GPLACTORS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
2 ;;0.3;CCDCCR;nopatch;noreleasedate
3 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 ;
20 ; PROCESS THE ACTORS SECTION OF THE CCR
21 ;
22 ; ===Revision History===
23 ; 0.1 Initial Writing of Skeleton--GPL
24 ; 0.2 Patient Data Extraction--SMH
25 ; 0.3 Information System Info Extraction--SMH
26 ;
27EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
28 ; IPXML is the Input Actor Template into which we are going to substitute values
29 ; This is straight XML. Values to be substituted are in @@VAL@@ format.
30
31 ; ALST is the actor list global generated by ACTLST^GPLCCR and is in the following format
32 ; ^TMP(7542,1,"ACTORS",0)=Count
33 ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
34 ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
35
36 ; AXML is the output arrary, to contain XML.
37
38 N I,J,AMAP,AOID,ATYP,AIEN
39 D CP^GPLXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
40 D REPLACE^GPLXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
41 W "PROCESSING ACTORS ",!
42 F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
43 . I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
44 . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
45 . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
46 . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
47 . I ATYP="" Q ; NOT A VALID ACTOR
48 . ;
49 . W AOID_" "_ATYP_" "_AIEN,!
50 . I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
51 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
52 . . D PATIENT("ATMP",@ALST@(I),"ATMP2")
53 . ;
54 . I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
55 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
56 . . D SYSTEM("ATMP",@ALST@(I),"ATMP2")
57 . ;
58 . I ATYP="NOK" D ; NOK ACTOR TYPE
59 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
60 . . D NOK("ATMP",@ALST@(I),"ATMP2")
61 . ;
62 . I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
63 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
64 . . D PROVIDER("ATMP",@ALST@(I),"ATMP2")
65 . ;
66 . I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
67 . . D QUERY^GPLXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
68 . . D ORG("ATMP",@ALST@(I),"ATMP2")
69 . ;
70 . D INSINNER^GPLXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
71 ;
72 D MISSING^GPLXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
73 I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
74 . ; STRINGS MARKED AS @@X@@
75 . W "ACTORS Missing list: ",!
76 . F I=1:1:ACTTMP(0) W ACTTMP(I),!
77 Q
78 ;
79PATIENT(INXML,ACTREC,OUTXML) ; PROCESS A PATIENT ACTOR
80 ;
81 W "PROCESSING ACTOR PATIENT ",ACTREC,!
82 ; N AMAP
83 S AMAP=$NA(^TMP($J,"AMAP"))
84 D INIT^CCRDPT(AIEN)
85 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
86 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRDPT
87 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRDPT
88 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRDPT
89 S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^CCRDPT
90 S @AMAP@("ACTORGENDER")=$$GENDER^CCRDPT
91 S @AMAP@("ACTORSSN")=$$SSN^CCRDPT
92 S @AMAP@("ACTORSSNSOURCEID")=AOID
93 S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^CCRDPT
94 S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^CCRDPT
95 S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^CCRDPT
96 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRDPT
97 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRDPT
98 S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^CCRDPT
99 S @AMAP@("ACTORRESTEL")=$$RESTEL^CCRDPT
100 S @AMAP@("ACTORWORKTEL")=$$WORKTEL^CCRDPT
101 S @AMAP@("ACTORCELLTEL")=$$CELLTEL^CCRDPT
102 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRDPT
103 S @AMAP@("ACTORADDRESSSOURCEID")=AOID
104 D DESTROY^CCRDPT
105 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
106 Q
107 ;
108SYSTEM(INXML,ACTREC,OUTXML) ; PROCESS A SYSTEM ACTOR
109 ;
110 ; N AMAP
111 S AMAP=$NA(^TMP($J,"AMAP"))
112 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
113 S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^CCRSYS
114 S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^CCRSYS
115 S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
116 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
117 Q
118 ;
119NOK(INXML,ACTREC,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
120 ;
121 ; N AMAP
122 S AMAP=$NA(^TMP($J,"AMAP"))
123 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
124 S @AMAP@("ACTORDISPLAYNAME")=""
125 S @AMAP@("ACTORRELATION")=""
126 S @AMAP@("ACTORRELATIONSOURCEID")=""
127 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
128 Q
129 ;
130ORG(INXML,ACTREC,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
131 ;
132 ; N AMAP
133 S AMAP=$NA(^TMP($J,"AMAP"))
134 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
135 S @AMAP@("ORGANIZATIONNAME")="WORLDVISTA EHR CLINIC"
136 S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
137 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
138 Q
139 ;
140PROVIDER(INXML,ACTREC,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
141 ;
142 ; N AMAP
143 S AMAP=$NA(^TMP($J,"AMAP"))
144 S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
145 S @AMAP@("ACTORGIVENNAME")=$$GIVEN^CCRVA200(AIEN)
146 S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^CCRVA200(AIEN)
147 S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^CCRVA200(AIEN)
148 S @AMAP@("ACTORTITLE")=$$TITLE^CCRVA200(AIEN)
149 S @AMAP@("IDTYPE")=$P($$NPI^CCRVA200(AIEN),U,1)
150 S @AMAP@("ID")=$P($$NPI^CCRVA200(AIEN),U,2)
151 S @AMAP@("IDDESC")=$P($$NPI^CCRVA200(AIEN),U,3)
152 S @AMAP@("ACTORSPECIALITY")=$$SPEC^CCRVA200(AIEN)
153 S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^CCRVA200(AIEN)
154 S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^CCRVA200(AIEN)
155 S @AMAP@("ACTORADDRESSCITY")=$$CITY^CCRVA200(AIEN)
156 S @AMAP@("ACTORADDRESSSTATE")=$$STATE^CCRVA200(AIEN)
157 S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^CCRVA200(AIEN)
158 S @AMAP@("ACTORTELEPHONE")=$$TEL^CCRVA200(AIEN)
159 S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^CCRVA200(AIEN)
160 S @AMAP@("ACTOREMAIL")=$$EMAIL^CCRVA200(AIEN)
161 S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
162 D MAP^GPLXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
163 Q
164 ;
Note: See TracBrowser for help on using the repository browser.