source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS1071A.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1EAS1071A ;ALB/PJH - ESR and HEC Messaging ; 11/27/07 3:01pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**;15-MAR-01;Build 18
3 ;
4 ;PROTOCOL FILE access through DBIA 3173
5 ;
6TAG(RETURN,MODE) ; Called from EAS ESR MESSAGING RPC (triggered from HEC)
7 N STOP
8 S STOP=0
9 ;Enable ESR
10 I MODE=1 D EN1(.RETURN) D:STOP RESET(.RETURN) Q
11 ;Set ESR as system of record
12 I MODE=2 D QRY(.RETURN,"ESR") D:STOP QRY(.RETURN,"HEC") Q
13 ;Remove HEC
14 I MODE=3 D EN^EAS1071B(.RETURN) D:STOP RESET^EAS1071B(.RETURN) Q
15 ;Remove ESR
16 I MODE=4 D RESET(.RETURN) D:STOP EN1(.RETURN) Q
17 ;Set HEC as system of record
18 I MODE=5 D QRY(.RETURN,"HEC") D:STOP QRY(.RETURN,"ESR") Q
19 ;Enable HEC
20 I MODE=6 D RESET^EAS1071B(.RETURN) Q
21 ;
22 S RETURN="-1^RPC Called with invalid MODE parameter"
23 Q
24 ;
25EN1(ARR) ;Enable ESR messaging
26 ;
27 N ADDR,PORT,STATION,TCPDATA,SLLN,VER,DA,FILE,RET,ERROR
28 ;
29 S:MODE=1 ARR="ESR messaging NOT enabled"
30 ;
31 ; Get site's Station #
32 S STATION=$P($$SITE^VASITE,"^",3)
33 ;
34 ;Activate EAS ESR event driver server protocols
35 D PROTOCOL Q:STOP
36 ;Update VAMC event driver protocols (outgoing)
37 D DRIVERS(STATION) Q:STOP
38 ;Set production IP address and port on Logical Links
39 D SETLL16 Q:STOP
40 ;
41 S:MODE=1 ARR="ESR messaging enabled"
42 ;
43 Q
44 ;
45SETLL16 ;Update Sending Logical Link
46 ;
47 N ADDR,PORT,SHUTDOWN,SLLN,RET
48 ;
49 ;Production Install
50 I $$PROD^XUPROD D Q:STOP
51 .S PORT=8090 ;Vitria production port#
52 .S ADDR=$$IPLIVE ;ESR production (from dental package)
53 .S SHUTDOWN="" ;Shutdown LLP set to No
54 .;Abort if no IP address found for production account
55 .I ADDR="" D ABORT1 Q
56 ;Test/development account values to null
57 E S PORT="",ADDR="00.0.000.00",SHUTDOWN=1
58 ;Update value in logical link file
59 S SLLN="LLESROUT",RET=$$LL16(SLLN,ADDR,PORT,SHUTDOWN)
60 I +RET<0 D ABORT2(RET,"ESR Send Link:"_SLLN)
61 Q
62 ;
63 ;
64PROTOCOL ;Remove Disable Text from EAS ESR server protocols
65 ;
66 N RESULT,SIEN,V,N,N1,LNCNT,LINE,PROTRET,NAM
67 S NAM="EAS ESR"
68 F S NAM=$O(^ORD(101,"B",NAM)) Q:NAM'["EAS ESR" D Q:STOP
69 . Q:NAM'["SERVER" Q:NAM["QRY-Z10" Q:NAM["QRY-Z11"
70 . S RESULT=$$EDP(NAM,"")
71 . I +RESULT<0 D ABORT2(RESULT,"Event Driver:"_NAM)
72 ;
73 Q
74 ;
75DRIVERS(STATION) ;Add EAS ESR client to VAMC event driver
76 ;
77 N ERROR,FILE,IEN101,LINE,LNCNT,RETURN,SIEN101,SNAM
78 S LNCNT=1
79 F S LINE=$T(PROTDAT+LNCNT) Q:$P(LINE,";",3)="END" D Q:STOP
80 .S NAM="VAMC "_STATION_" "_$P(LINE,";",3)_" SERVER"
81 .S IEN101=$O(^ORD(101,"B",NAM,0))
82 .I +IEN101=0 D Q
83 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
84 ..S RETURN=-1_"^"_ERROR
85 ..D ABORT2(RETURN,"Event Driver:"_NAM)
86 .;
87 .;Client Protocol
88 .S SNAM="EAS ESR "_STATION_" "_$P(LINE,";",3)_" CLIENT"
89 .S SIEN101=$O(^ORD(101,"B",SNAM,0))
90 .I +SIEN101=0 D Q
91 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
92 ..S RETURN=-1_"^"_ERROR
93 ..D ABORT2(RETURN,"Subscriber:"_SNAM)
94 .;Skip if already present
95 .I $D(^ORD(101,IEN101,775,"B",SIEN101)) D Q
96 ..D WARN(NAM,SNAM)
97 ..S LNCNT=LNCNT+1
98 .;Add subscriber to event driver
99 .S RETURN=$$SUBSCR(IEN101,SIEN101)
100 .I +RETURN<0 D ABORT2(RETURN,"driver with Subscriber:"_SNAM) Q
101 .S LNCNT=LNCNT+1
102 ;
103 Q
104 ;
105WARN(EDP,SP) ;Display Warning Message
106 ;
107 N ARR
108 ;
109 S ARR(1)="===================================================="
110 S ARR(2)="= WARNING ="
111 S ARR(3)="===================================================="
112 S ARR(4)="When updating "_EDP
113 S ARR(5)="===================================================="
114 S ARR(5)="**"_SP_" is already defined**"
115 ;
116 Q
117 ;
118ABORT1 ;Warning and mail message in case of no IP address
119 ;
120 S STOP=1
121 S ARR(1)="===================================================="
122 S ARR(2)="= ABORTED ="
123 S ARR(3)="===================================================="
124 S ARR(4)="No IP address for VIE was found on the system"
125 S ARR(5)="The IP address must be entered on the LLESROUT"
126 S ARR(6)="logical link (file #870) before ESR transmissions"
127 S ARR(7)="can begin"
128 Q
129 ;
130ABORT2(ERRMSG,SUBJ) ;Display Install Error message and set STOP
131 ;
132 S STOP=1
133 S ARR(1)="===================================================="
134 S ARR(2)="= ABORTED ="
135 S ARR(3)="===================================================="
136 S ARR(4)="When updating "_SUBJ
137 S ARR(5)="===================================================="
138 S ARR(5)="**ERROR MSG: "_$P(ERRMSG,"^",2)
139 Q
140 ;
141LL16(LLNAME,TCPADDR,TCPPORT,SHUTDOWN) ;Update Logical Link Port and Address
142 ;
143 N FILE,DATA,RETURN,DEFINED,ERROR,DA,DGENDA
144 S FILE=870
145 S IEN870=$O(^HLCS(870,"B",LLNAME,0))
146 I 'IEN870 D Q RETURN
147 . S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
148 . S RETURN=-1_"^"_ERROR
149 ;
150 S DATA(400.01)=TCPADDR ;TCP/IP ADDRESS
151 S DATA(400.02)=TCPPORT ;TCP/IP PORT
152 S DATA(4.5)=1 ;AUTOSTART
153 S DATA(14)=SHUTDOWN ;SHUTDOWN LLP
154 ;
155 S RETURN=$$UPD^DGENDBS(FILE,IEN870,.DATA,.ERROR)
156 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
157 ;
158 Q RETURN
159 ;
160EDP(PNAME,DTXT) ;Remove Disable Text from Event Driver Protocols
161 ;
162 N DATA,FILE,DGENDA,RETURN,ERROR,DA
163 S FILE=101
164 ; If already exists then skip
165 S IEN101=$O(^ORD(101,"B",PNAME,0))
166 I 'IEN101 D Q RETURN
167 . S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
168 . S RETURN=-1_"^"_ERROR
169 ;
170 S DATA(2)=DTXT
171 S RETURN=$$UPD^DGENDBS(FILE,IEN101,.DATA,.ERROR)
172 I ERROR'=""!(+RETURN=0) S RETURN=-1_"^"_ERROR
173 ;
174 Q RETURN
175 ;
176SUBSCR(IEN101,SIEN101) ;Add client to event driver as a subscriber
177 ;
178 N DATA,DGENDA,ERROR,FILE,RETURN
179 S DGENDA(1)=IEN101
180 S FILE=101.0775
181 S DATA(.01)=SIEN101
182 S RETURN=$$ADD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
183 S:ERROR'=""!(+RETURN=0) RETURN=-1_"^"_ERROR
184 ;
185 Q RETURN
186 ;
187IPLIVE() ;Get IP address for production system
188 ;
189 ;Search for DENTVHLAAC logical link
190 S IENS=$$FIND1^DIC(870,"","X","DENTVHLAAC","","","ERR")
191 ;If not found return null IP address
192 I 'IENS Q ""
193 ;Otherwise return TCP/IP ADDRESS
194 Q $$GET1^DIQ(870,IENS_",",400.01)
195 ;
196RESET(ARR) ;Disable or Remove ESR protocols
197 N DA,DIK,ERROR,IEN101,LINE,LCT,NAM
198 N PREFHEC,PREFESR,SIEN101,SNAM,STOP,SITE
199 ;
200 I MODE=4 S ARR="ESR messaging NOT disabled"
201 ;
202 ; Get site's Station #
203 S SITE=$P($$SITE^VASITE,"^",3)
204 S PREFHEC="VAMC "_SITE_" "
205 S PREFESR="EAS ESR "_SITE_" "
206 S STOP=0
207 ;
208 I $$SOR^EAS1071C(PREFESR,PREFHEC) D Q
209 .S ARR="Unable to disable messaging, ESR is SOR"
210 ;
211 ;Disable to Vista to ESR servers
212 S NAM="EAS ESR"
213 F S NAM=$O(^ORD(101,"B",NAM)) Q:NAM'["EAS ESR" D Q:STOP
214 .Q:NAM'["SERVER" Q:NAM["QRY-Z10" Q:NAM["QRY-Z11"
215 .;Insert disable text
216 .S RESULT=$$EDP(NAM,"ESR-to-Site Messaging Inactive")
217 .I +RESULT<0 D ABORT2(RESULT,"Event Driver:"_NAM)
218 ;
219 ;Remove ESR client subscriber protocols from shared servers
220 F LCT=1:1 S LINE=$T(PROTDAT+LCT) Q:$P(LINE,";",3)="END" D Q:STOP
221 .S NAM=PREFESR_$P(LINE,";",3)_" CLIENT"
222 .S SIEN101=$O(^ORD(101,"B",NAM,0))
223 .I +SIEN101=0 D Q
224 ..S ERROR="IEN OF RECORD TO BE UPDATED NOT FOUND"
225 ..S RETURN=-1_"^"_ERROR
226 ..D ABORT2(RETURN,"Event Driver:"_NAM)
227 .;If this is a SUBSCRIBER remove from SERVER
228 .I $O(^ORD(101,"AB",SIEN101,0)) D REMOVE(SIEN101,NAM)
229 ;
230 ;
231 I MODE=4,'STOP S ARR="ESR messaging disabled"
232 Q
233 ;
234REMOVE(CLIENT,CNAM) ;Remove clients from server
235 N DA,DIK,SERV,SNAM,SUB
236 S SERV=0
237 F S SERV=$O(^ORD(101,"AB",CLIENT,SERV)) Q:'SERV D
238 .S SUB=0,SNAM=$P($G(^ORD(101,SERV,0)),U)
239 .F S SUB=$O(^ORD(101,"AB",CLIENT,SERV,SUB)) Q:'SUB D
240 ..S DA(1)=SERV,DA=SUB,DIK="^ORD(101,"_DA(1)_",775," D ^DIK
241 Q
242 ;
243PROTDAT ;
244 ;;ORU-Z07
245 ;;ORU-Z09
246 ;;ORF-Z07
247 ;;END
248 ;
249QRY(ARR,SYS) ;Switch system of record (moves QRY-Z10/Z11 Protocols)
250 ;
251 N PREFHEC,PREFESR,RESULT,SIEN,SITE,V,N,N1,LNCNT,LINE,PROTRET,NAM
252 ; Get site's Station #
253 S SITE=$P($$SITE^VASITE,"^",3)
254 S PREFHEC="VAMC "_SITE_" "
255 S PREFESR="EAS ESR "_SITE_" "
256 S STOP=0,ARR="SOR unchanged"
257 ;
258 N ERROR,PREF,RETURN
259 ;System being made SOR
260 S PREF=$S(SYS="HEC":PREFHEC,1:PREFESR)
261 ;Check messaging is settup for system being added
262 I '$$Z07^EAS1071C(PREF,PREFHEC) D Q
263 .S ERROR="MESSAGING NOT ENABLED FOR "_SYS
264 .S RETURN=-1_"^"_ERROR
265 .D ABORT2(RETURN,SYS_" as system of record")
266 .S STOP=0
267 ;
268 I SYS="ESR" D Q
269 .;Disable HEC Z10/Z11 protocols
270 .D UNLINK^EAS1071C(PREFHEC) Q:STOP
271 .;Enable ESR Z10/Z11 protocols
272 .D LINK^EAS1071C Q:STOP
273 .;Return message
274 .S ARR="ESR set as SOR"
275 ;
276 I SYS="HEC" D Q
277 .;Disable ESR Z10/Z11 protocols
278 .D UNLINK^EAS1071C(PREFESR) Q:STOP
279 .;Enable HEC Z10/Z11 protocols
280 .D LINK^EAS1071C Q:STOP
281 .;Return message
282 .S ARR="HEC set as SOR"
283 Q
Note: See TracBrowser for help on using the repository browser.