Produced by Araxis Merge on 11/2/2017 7:18:11 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CAPRI_CIF.zip\CAPRI_CIF\Source | rerouterequest.pas | Wed Nov 1 18:09:30 2017 UTC |
2 | CAPRI_CIF.zip\CAPRI_CIF\Source | rerouterequest.pas | Thu Nov 2 11:48:20 2017 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 4 | 1994 |
Changed | 3 | 44 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
2 | // Patch 1 93 JRL 5/1 1/16 | |
3 | // This sc reen was a dded for t he Re-Rout e Exam Req uest funct ion in Pat ch 193. | |
4 | // It allo ws input o f Re-Route data to a ccompany a request s ent to ano ther site. | |
5 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
6 | unit rerou terequest; | |
7 | interface | |
8 | ||
9 | uses | |
10 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | |
11 | Dialogs, StdCtrls, Fmcntrls, VA508Acce ssibilityM anager, OR Ctrls, Ext Ctrls, | |
12 | CAPRISup port, dial ogsCAPRI, Diaccess, Fmcmpnts, Trpcb, unt MiscMthds, | |
13 | CCOWRPCB roker, CCO WRPCBroker CAPRI, Com Ctrls, | |
14 | VA508Acc essibility Router; | |
15 | ||
16 | type | |
17 | TfrmReRo uteRequest = class(T Form) | |
18 | Panel1 : TPanel; | |
19 | FMReRo uteLister: TFMLister ; | |
20 | VA508A ccessibili tyManager1 : TVA508Ac cessibilit yManager; | |
21 | Panel2 : TPanel; | |
22 | btnCan celReRoute : TButton; | |
23 | btnRer outeReques t: TButton ; | |
24 | cbLoca tion: TCom boBox; | |
25 | cbxSor tByState: TCheckBox; | |
26 | Panel3 : TPanel; | |
27 | btnTes tGuestLogi n: TButton ; | |
28 | btnTes tRemoteRPC : TButton; | |
29 | Status Bar1: TSta tusBar; | |
30 | btnTes tRoutingLo cations: T Button; | |
31 | btnTes tExamList: TButton; | |
32 | btnTes tSiteComme nts: TButt on; | |
33 | edtSta tionNumber : TEdit; | |
34 | lbExam List: TLis tBox; | |
35 | cbReRo uteReason: TComboBox ; | |
36 | FMExam List: TFML istBox; | |
37 | memoRe RouteDescr iption: TM emo; | |
38 | memoDi visionComm ents: TMem o; | |
39 | lblRou tingLocati on: TLabel ; | |
40 | labelV andAandMan dC: TLabel ; | |
41 | lblSor tByState: TLabel; | |
42 | lblReR outeReason : TLabel; | |
43 | lblDes cription: TLabel; | |
44 | lblExa mList: TLa bel; | |
45 | lblSit eComments: TLabel; | |
46 | cbVAMC : TComboBo x; | |
47 | proced ure btnCan celReRoute Click(Send er: TObjec t); | |
48 | proced ure btnRer outeReques tClick(Sen der: TObje ct); | |
49 | proced ure btnTes tGuestLogi nClick(Sen der: TObje ct); | |
50 | proced ure cbLoca tionChange (Sender: T Object); | |
51 | proced ure FormCl ose(Sender : TObject; var Actio n: TCloseA ction); | |
52 | proced ure FormCr eate(Sende r: TObject ); | |
53 | proced ure btnTes tRemoteRPC Click(Send er: TObjec t); | |
54 | proced ure btnTes tRoutingLo cationsCli ck(Sender: TObject); | |
55 | proced ure btnTes tExamListC lick(Sende r: TObject ); | |
56 | proced ure btnTes tSiteComme ntsClick(S ender: TOb ject); | |
57 | proced ure cbxSor tByStateCl ick(Sender : TObject) ; | |
58 | proced ure cbVAMC Exit(Sende r: TObject ); | |
59 | proced ure memoRe RouteDescr iptionEnte r(Sender: TObject); | |
60 | proced ure memoDi visionComm entsEnter( Sender: TO bject); | |
61 | proced ure cbVAMC Enter(Send er: TObjec t); | |
62 | private | |
63 | { Priv ate declar ations } | |
64 | Routin gLocation_ IEN : Stri ng; | |
65 | VAMC_I EN : Strin g; | |
66 | VAMC_I EN_List : TStringLis t; | |
67 | VAMC_S tation_Lis t : TStrin gList; | |
68 | VAMC_N ame_List : TStringLi st; | |
69 | VAMC_S tate_List : TStringL ist; | |
70 | Routin gLocation_ IEN_List : TStringLi st; | |
71 | ReRout eReasonIEN List : TSt ringList; | |
72 | Select edStation : String; | |
73 | SaveSt ationNumbe r : String ; | |
74 | functi on CreateR eRouteRequ est : Bool ean; | |
75 | functi on CheckU serInputVa lues : Boo lean; | |
76 | proced ure GetRou tingLocati ons; | |
77 | proced ure GetVAM CLocations ; | |
78 | proced ure GetExa mLists; | |
79 | proced ure GetSit eComments; | |
80 | proced ure GetReR outeReason s; | |
81 | proced ure IsDelp hiRunning; | |
82 | functi on CheckI fVAMCCanHa ndleRerout es : Boole an; | |
83 | public | |
84 | { Publ ic declara tions } | |
85 | end; | |
86 | ||
87 | implementa tion | |
88 | uses | |
89 | Main | |
90 | , rofinder | |
91 | , unitzip | |
92 | , viewexam | |
93 | , essosele ct | |
94 | ; | |
95 | ||
96 | ||
97 | const | |
98 | CLOSE_FO RM = '1'; // Pat ch 193 JRL 9/2/16 | |
99 | DONT_CLO SE_FORM = '2'; // Pa tch 193 JR L 9/2/16 | |
100 | ||
101 | ||
102 | {$R *.dfm} | |
103 | ||
104 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
105 | // Form Cr eate | |
106 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
107 | procedure TfrmReRout eRequest.F ormCreate( Sender: TO bject); | |
108 | begin | |
109 | // Displ ay testing buttons i f Delphi I DE is runn ing. This is only f or | |
110 | // devel oper testi ng: btnTe stRoutingL ocations, btnTestGue stLogin, | |
111 | // btnTe stRemoteRP C. | |
112 | IsDelphi Running; | |
113 | // Creat e string l ists | |
114 | VAMC_IEN _List := T StringList .Create; | |
115 | RoutingL ocation_IE N_List := TStringLis t.Create; | |
116 | VAMC_Sta tion_List := TString List.Creat e; | |
117 | VAMC_Nam e_List := TStringLis t.Create; | |
118 | VAMC_Sta te_List := TStringLi st.Create; | |
119 | ReRouteR easonIENLi st := TStr ingList.Cr eate; | |
120 | cbLocati on.Items.C lear; | |
121 | // Popul ate initia l fields | |
122 | GetReRou teReasons; // Popula te Re-Rout ing Reason s dropdown | |
123 | GetVAMCL ocations; // Popula te VAMC Lo cations dr opdown | |
124 | SaveStat ionNumber := ''; | |
125 | end; | |
126 | ||
127 | ||
128 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
129 | // Form Cl ose | |
130 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
131 | procedure TfrmReRout eRequest.F ormClose(S ender: TOb ject; | |
132 | var Acti on: TClose Action); | |
133 | begin | |
134 | // Destr oy string lists | |
135 | FreeAndN il(VAMC_IE N_List); | |
136 | FreeAndN il(Routing Location_I EN_List); | |
137 | FreeAndN il(VAMC_St ation_List ); | |
138 | FreeAndN il(VAMC_Na me_List); | |
139 | FreeAndN il(VAMC_St ate_List); | |
140 | FreeAndN il(ReRoute ReasonIENL ist); | |
141 | end; | |
142 | ||
143 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
144 | // Cancel Re-Route B utton Clic ked | |
145 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
146 | procedure TfrmReRout eRequest.b tnCancelRe RouteClick (Sender: T Object); | |
147 | begin | |
148 | // No ac tion neede d except t o close th e form | |
149 | frmViewE xam.Return Value := D ONT_CLOSE_ FORM; | |
150 | Close; | |
151 | end; | |
152 | ||
153 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
154 | // Re-Rout e Request button cli cked | |
155 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
156 | procedure TfrmReRout eRequest.b tnRerouteR equestClic k(Sender: TObject); | |
157 | var | |
158 | request_ rerouted : Boolean; | |
159 | CloseFor m : Boolea n; | |
160 | begin | |
161 | if Check UserInputV alues then // if all inputs ar e satisfie d, allow r e-routing | |
162 | begin | |
163 | Statu sBar1.Simp leText := 'Re-Routin g Request' ; | |
164 | reque st_reroute d := Creat eReRouteRe quest; // send t he re-rout ed request | |
165 | if re quest_rero uted = TRU E then // re-route w as success ful | |
166 | fr mViewExam. ReturnValu e := CLOSE _FORM | |
167 | else | |
168 | fr mViewExam. ReturnValu e := DONT_ CLOSE_FORM ; | |
169 | Close ; | |
170 | end; // CheckUser InputValue s | |
171 | ||
172 | end; | |
173 | ||
174 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
175 | // Create Re-Route R equest | |
176 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
177 | // RPC Inp ut: | |
178 | // Reque st IEN | |
179 | // Patie nt IEN | |
180 | // VAMC IEN (Stati on Number) | |
181 | // Routi ng Locatio n IEN | |
182 | // Re-Ro ute Reason IEN | |
183 | // Re-Ro ute Descri ption | |
184 | // | |
185 | // RPC Out put: | |
186 | // 1^Transmit ted as mes sage # 909 761 from t his site t o S E R V ER . D O
|
|
187 | // 0^Mes sage trans mission er ror! Reque st WILL NO T be rerou ted | |
188 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
189 | // FROM TH E AMIE TRA NSFER DOCU MENTATION: | |
190 | // If th e mail mes sage is se nt out suc cessfully, the user will see: | |
191 | // "Tran smitted as message # {number} from this site to {s ite name}. VA.GOV." | |
192 | // | |
193 | // If th e message fails (and therefore the trans fer fails) the user will be so informed: | |
194 | // "Mess age transm ission err or! Requ est WILL N OT be sent !" | |
195 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
196 | function T frmReRoute Request.Cr eateReRout eRequest : Boolean; | |
197 | CONST | |
198 | RPCNAME = 'DVBA CA PRI SEND R EROUTE'; | |
199 | var | |
200 | MailmanR PCStatus : Integer; | |
201 | MailmanM essage : S tring; | |
202 | buffer : string; | |
203 | begin | |
204 | Result : = FALSE; / / default to re-rout e failed | |
205 | try | |
206 | Screen .Cursor := crHourGla ss; | |
207 | // Set up RPC | |
208 | frmMai n.RPCBroke r1.Results .Clear; | |
209 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPCNAME; | |
210 | frmMai n.RPCBroke r1.Param[0 ].Value := frmViewEx am.edExamR eferenceNu mber.Text; // Reque st IEN | |
211 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
212 | frmMai n.RPCBroke r1.Param[1 ].Value := PatientIE N; // Patie nt IEN | |
213 | frmMai n.RPCBroke r1.Param[1 ].PType := literal; | |
214 | frmMai n.RPCBroke r1.Param[2 ].Value := VAMC_IEN; | |
215 | frmMai n.RPCBroke r1.Param[2 ].PType := literal; | |
216 | frmMai n.RPCBroke r1.Param[3 ].Value := RoutingLo cation_IEN ; | |
217 | frmMai n.RPCBroke r1.Param[3 ].PType := literal; | |
218 | frmMai n.RPCBroke r1.Param[4 ].Value := ReRouteRe asonIENLis t[cbReRout eReason.It emIndex]; | |
219 | frmMai n.RPCBroke r1.Param[4 ].PType := literal; | |
220 | frmMai n.RPCBroke r1.Param[5 ].Value := memoReRou teDescript ion.Text; | |
221 | frmMai n.RPCBroke r1.Param[5 ].Ptype := literal; | |
222 | ||
223 | frmMai n.RPCBroke rCall; | |
224 | Try | |
225 | frmM ain.RPCBro ker1.Call; | |
226 | Except | |
227 | On e : EBrokerE rror Do | |
228 | begi n | |
229 | bu ffer := RP CNAME + ' could not be accesse d! '+#10# 13 + E.Mes sage + '.' ; | |
230 | Sh owMessageC APRI(buffe r); | |
231 | end; | |
232 | End; | |
233 | finally | |
234 | Screen .Cursor := crDefault ; | |
235 | end; | |
236 | ||
237 | // Check RPC resul ts | |
238 | If frmMa in.RPCBrok er1.Result s.Count > 0 Then | |
239 | begin | |
240 | Mailma nRPCStatus := StrToI ntDef(Piec e(frmMain. RPCBroker1 .Results[0 ], '^', 1) ,0); | |
241 | Mailma nMessage : = Piece(fr mMain.RPCB roker1.Res ults[0], ' ^', 2); | |
242 | Status Bar1.Simpl eText := M ailmanMess age; | |
243 | ||
244 | if Mai lmanRPCSta tus > 0 th en // Succ ess, reque st was re- routed | |
245 | begin | |
246 | // F YI: An ema il is sent to the or iginal req uester upo n successf ul re-rout ing (all M code) | |
247 | Show MessageCAP RI(Mailman Message); | |
248 | Resu lt := TRUE ; | |
249 | Clos e; | |
250 | end | |
251 | end; | |
252 | // if Re -Route mes sage faile d | |
253 | if not R esult then | |
254 | ShowMe ssageCAPRI (RPCNAME + ' returne d a failur e.'+#10#13 +MailmanMe ssage); | |
255 | end; | |
256 | ||
257 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
258 | // Get VAM C Location s | |
259 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
260 | // VAMCs a re located in the In stitution File. Fil tering and sorting m ust be | |
261 | // done to get an ac curate sel ection lis t. | |
262 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
263 | // RPC Inp ut: Sor ting Flag (NAME or S TATE) | |
264 | // RPC Out put: Sta te ^ VAMC sites ^ VA MC IEN ^ V AMC Statio n Number | |
265 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
266 | procedure TfrmReRout eRequest.G etVAMCLoca tions; | |
267 | var | |
268 | i : Inte ger; | |
269 | CONST | |
270 | RPCNAME = 'DVBA CA PRI REROUT E VAMC'; | |
271 | STRINGFO RMAT = '%- 28s%-15s%- 6s'; | |
272 | begin | |
273 | // updat e status | |
274 | StatusBa r1.SimpleT ext := 'Re trieving R outing Loc ations.'; | |
275 | // setup and call RPC | |
276 | frmMain. RPCBroker1 .Results.C lear; | |
277 | frmMain. RPCBroker1 .RemotePro cedure := RPCNAME; | |
278 | if cbxSo rtByState. Checked th en | |
279 | frmMa in.RPCBrok er1.Param[ 0].Value : = 'STATE' | |
280 | else | |
281 | frmMa in.RPCBrok er1.Param[ 0].Value : = 'NAME'; | |
282 | frmMain. RPCBroker1 .Param[0]. PType := l iteral; | |
283 | frmMain. RPCBrokerC all; | |
284 | Try | |
285 | frmMai n.RPCBroke r1.Call; | |
286 | Except | |
287 | On E: EBrokerErr or Do | |
288 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed!'+# 13#10+E.Me ssage); | |
289 | End; | |
290 | // clear all lists | |
291 | //FMVAMC.I tems.Clear ; | |
292 | cbVAMC.I tems.Clear ; | |
293 | VAMC_Nam e_List.Cle ar; | |
294 | VAMC_Sta te_List.Cl ear; | |
295 | VAMC_IEN _List.Clea r; | |
296 | VAMC_Sta tion_List. Clear; | |
297 | // popul ate all li sts | |
298 | If frmMa in.RPCBrok er1.Result s.Count > 0 Then | |
299 | begin | |
300 | For i := 0 To fr mMain.RPCB roker1.Res ults.Count - 1 Do | |
301 | begin | |
302 | VAMC _Name_List .Add(Piece (frmMain.R PCBroker1. Results[i] , '^', 2)) ; | |
303 | VAMC _State_Lis t.Add(Piec e(frmMain. RPCBroker1 .Results[i ], '^', 1) ); | |
304 | VAMC _IEN_List. Add(Piece( frmMain.RP CBroker1.R esults[i], '^', 3)); | |
305 | VAMC _Station_L ist.Add(Pi ece(frmMai n.RPCBroke r1.Results [i], '^', 4)); | |
306 | end; | |
307 | end; | |
308 | // Add d ata to lis tbox and f ormat it i nto column s | |
309 | for i := 0 to VAMC _Name_List .Count - 1 do | |
310 | cbVAMC .Items.Add (Format(ST RINGFORMAT ,[VAMC_Nam e_List[i], VAMC_State _List[i],V AMC_Statio n_List[i]] )); | |
311 | ||
312 | // clear status ba r | |
313 | StatusBa r1.SimpleT ext := ''; | |
314 | end; | |
315 | ||
316 | ||
317 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
318 | // Get Re- Route Reas ons | |
319 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
320 | // RPC: D VBA CAPRI REROUTEREA SONS | |
321 | // Input : None | |
322 | // Outpu t: Re-Rou te Code^IE N | |
323 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
324 | procedure TfrmReRout eRequest.G etReRouteR easons; | |
325 | const | |
326 | RPCNAME = 'DVBA CA PRI GET RE ROUTE CODE '; | |
327 | var | |
328 | i : Inte ger; | |
329 | begin | |
330 | frmMain. RPCBroker1 .Results.C lear; | |
331 | frmMain. RPCBroker1 .RemotePro cedure := RPCNAME; | |
332 | frmMain. RPCBrokerC all; | |
333 | try | |
334 | frmMai n.RPCBroke r1.Call; | |
335 | except | |
336 | On EBr okerError Do | |
337 | Sho wMessageCA PRI('RPC: '+RPCNAME + ' could not be acc essed!'); | |
338 | end; | |
339 | cbReRout eReason.It ems.Clear; | |
340 | ReRouteR easonIENLi st := TStr ingList.Cr eate; | |
341 | if frmMa in.RPCBrok er1.Result s.Count > 0 then | |
342 | begin | |
343 | for i := 0 To fr mMain.RPCB roker1.Res ults.Count - 1 do | |
344 | begin | |
345 | cbRe RouteReaso n.Items.Ad d(Piece(fr mMain.RPCB roker1.Res ults[i], ' ^', 2)); | |
346 | ReRo uteReasonI ENList.Add (Piece(frm Main.RPCBr oker1.Resu lts[i], '^ ', 1)); | |
347 | end; | |
348 | end; | |
349 | end; | |
350 | ||
351 | ||
352 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
353 | // Get Rou ting Locat ions | |
354 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
355 | // Call RP C on remot e VistA si te specifi ed by Stat ion Number passed to RPC. | |
356 | // Input: | |
357 | // RPC: XW B DIRECT R PC | |
358 | // RPC: St ation Numb er of remo te VistA i nstance (V AMC) | |
359 | // Local R PC: DVBA CAPRI GET DIVISION | |
360 | // Local R PC Version : Not spe cified her e, sending blank | |
361 | // Local R PC Paramet er: Stati on Number | |
362 | // Output: List of Routing L ocations ( Divisions) for the i nput Stati on Number | |
363 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
364 | procedure TfrmReRout eRequest.G etRoutingL ocations; | |
365 | CONST | |
366 | RPC_DIRE CT = 'XWB DIRECT RPC '; | |
367 | RPCNAME = 'DVBA CA PRI GET DI VISION'; | |
368 | var | |
369 | i : Inte ger; | |
370 | begin | |
371 | StatusBa r1.SimpleT ext := 'Re trieving R outing Loc ations.'; | |
372 | Screen.C ursor := c rHourGlass ; | |
373 | Applicat ion.Proces sMessages; | |
374 | lbExamLi st.Items.C lear; | |
375 | ||
376 | // deter mine if we are re-ro uting loca lly versus to a remo te VistA s ite | |
377 | if frmVi ewExam.Cur rentStatio nNumber = SelectedSt ation then | |
378 | begin // Call RPC locally | |
379 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPCNAME; | |
380 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
381 | frmMai n.RPCBroke r1.Param[0 ].Value := SelectedS tation; | |
382 | end | |
383 | else | |
384 | begin // Call RPC via XWB DI RECT RPC | |
385 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPC_DIRE CT; | |
386 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
387 | frmMai n.RPCBroke r1.Param[0 ].Value := SelectedS tation; | |
388 | frmMai n.RPCBroke r1.Param[1 ].PType := literal; | |
389 | frmMai n.RPCBroke r1.Param[1 ].Value := RPCNAME; | |
390 | frmMai n.RPCBroke r1.Param[2 ].PType := literal; | |
391 | frmMai n.RPCBroke r1.Param[2 ].Value := ''; // R PC version parameter (Optional ) | |
392 | frmMai n.RPCBroke r1.Param[3 ].PType := literal; | |
393 | frmMai n.RPCBroke r1.Param[3 ].Value := SelectedS tation; | |
394 | end; | |
395 | ||
396 | try | |
397 | frmMai n.RPCBroke rCall; | |
398 | frmMai n.RPCBroke r1.Call; | |
399 | cbLoca tion.Items .Clear; | |
400 | Routin gLocation_ IEN_List.C lear; | |
401 | If frm Main.RPCBr oker1.Resu lts.Count > 0 Then | |
402 | begin | |
403 | For i := 0 To frmMain.RP CBroker1.R esults.Cou nt - 1 Do | |
404 | begi n | |
405 | cb Location.I tems.Add(P iece(frmMa in.RPCBrok er1.Result s[i], '^', 1)); | |
406 | Ro utingLocat ion_IEN_Li st.Add(Pie ce(frmMain .RPCBroker 1.Results[ i], '^', 2 )); | |
407 | end; | |
408 | end; | |
409 | except | |
410 | On E: EBrokerErr or Do | |
411 | begin | |
412 | Scre en.Cursor := crDefau lt; | |
413 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed at Station Nu mber ' + S electedSta tion + '!' +#13#10 + E.Message ); | |
414 | end; | |
415 | end; | |
416 | Screen.C ursor := c rDefault; | |
417 | StatusBa r1.SimpleT ext := ''; | |
418 | end; | |
419 | ||
420 | ||
421 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
422 | // Get Exa m Lists | |
423 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
424 | // Input: | |
425 | // RPC: XW B DIRECT R PC | |
426 | // RPC: St ation Numb er of remo te VistA i nstance (V AMC) | |
427 | // Local R PC: DVBA CAPRI GET DIV EXAM | |
428 | // Local R PC Version : Not spe cified her e, sending blank | |
429 | // Local R PC Paramet er: Routi ng Locatio n (Divisio n) IEN | |
430 | // Output: List of Exams Ava ilable at selected s ite | |
431 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
432 | procedure TfrmReRout eRequest.G etExamList s; | |
433 | CONST | |
434 | RPC_DIRE CT = 'XWB DIRECT RPC '; | |
435 | RPCNAME = 'DVBA CA PRI GET DI V EXAM'; | |
436 | var | |
437 | i : Inte ger; | |
438 | begin | |
439 | StatusBa r1.SimpleT ext := 'Re trieving E xam Lists. '; | |
440 | Screen.C ursor := c rHourGlass ; | |
441 | Applicat ion.Proces sMessages; | |
442 | lbExamLi st.Items.C lear; | |
443 | if frmVi ewExam.Cur rentStatio nNumber = SelectedSt ation then | |
444 | begin | |
445 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPCNAME; | |
446 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
447 | frmMai n.RPCBroke r1.Param[0 ].Value := RoutingLo cation_IEN ; // rout ing locati on (divisi on) select ed | |
448 | end | |
449 | else | |
450 | begin | |
451 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPC_DIRE CT; | |
452 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
453 | frmMai n.RPCBroke r1.Param[0 ].Value := SelectedS tation; | |
454 | frmMai n.RPCBroke r1.Param[1 ].PType := literal; | |
455 | frmMai n.RPCBroke r1.Param[1 ].Value := RPCNAME; | |
456 | frmMai n.RPCBroke r1.Param[2 ].PType := literal; | |
457 | frmMai n.RPCBroke r1.Param[2 ].Value := ''; // R PC version parameter (Optional ) | |
458 | frmMai n.RPCBroke r1.Param[3 ].PType := literal; | |
459 | frmMai n.RPCBroke r1.Param[3 ].Value := RoutingLo cation_IEN ; // rout ing locati on (divisi on) select ed | |
460 | end; | |
461 | try | |
462 | frmMai n.RPCBroke rCall; | |
463 | frmMai n.RPCBroke r1.Call; | |
464 | If frm Main.RPCBr oker1.Resu lts.Count > 0 Then | |
465 | Quic kCopy(frmM ain.RPCBro ker1.Resul ts, lbExam List.Items ); | |
466 | except | |
467 | On EBr okerError Do | |
468 | begin | |
469 | Scre en.Cursor := crHourG lass; | |
470 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed at Station Nu mber ' + S electedSta tion + '!' ); | |
471 | end; | |
472 | end; | |
473 | Screen.C ursor := c rDefault; | |
474 | StatusBa r1.SimpleT ext := ''; | |
475 | end; | |
476 | ||
477 | ||
478 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
479 | // Get Sit e Comments | |
480 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
481 | // Routing Locations are locat ed in the Institutio n File. F iltering a nd sorting | |
482 | // must be done to g et an accu rate selec tion list. | |
483 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
484 | // Input: | |
485 | // RPC: XW B DIRECT R PC | |
486 | // RPC: St ation Numb er of remo te VistA i nstance (V AMC) | |
487 | // Local R PC: DVBA CAPRI GET DIV COMMEN T | |
488 | // Local R PC Version : Not spe cified her e, sending blank | |
489 | // Local R PC Paramet er: Routi ng Locatio n (Divisio n) IEN | |
490 | // Output: List of Re-Route sites | |
491 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
492 | procedure TfrmReRout eRequest.G etSiteComm ents; | |
493 | CONST | |
494 | RPC_DIRE CT = 'XWB DIRECT RPC '; | |
495 | RPCNAME = 'DVBA CA PRI GET DI V COMMENT' ; | |
496 | begin | |
497 | StatusBa r1.SimpleT ext := 'Re trieving S ite Commen ts.'; | |
498 | Screen.C ursor := c rHourGlass ; | |
499 | Applicat ion.Proces sMessages; | |
500 | memoDivi sionCommen ts.Lines.C lear; | |
501 | if frmVi ewExam.Cur rentStatio nNumber = SelectedSt ation then | |
502 | begin | |
503 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPCNAME; | |
504 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
505 | frmMai n.RPCBroke r1.Param[0 ].Value := RoutingLo cation_IEN ; // rout ing locati on (divisi on) select ed | |
506 | end | |
507 | else | |
508 | begin | |
509 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPC_DIRE CT; | |
510 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
511 | frmMai n.RPCBroke r1.Param[0 ].Value := SelectedS tation; | |
512 | frmMai n.RPCBroke r1.Param[1 ].PType := literal; | |
513 | frmMai n.RPCBroke r1.Param[1 ].Value := RPCNAME; | |
514 | frmMai n.RPCBroke r1.Param[2 ].PType := literal; | |
515 | frmMai n.RPCBroke r1.Param[2 ].Value := ''; // R PC version parameter (Optional ) | |
516 | frmMai n.RPCBroke r1.Param[3 ].PType := literal; | |
517 | frmMai n.RPCBroke r1.Param[3 ].Value := RoutingLo cation_IEN ; // rout ing locati on (divisi on) select ed | |
518 | end; | |
519 | try | |
520 | frmMai n.RPCBroke rCall; | |
521 | frmMai n.RPCBroke r1.Call; | |
522 | If frm Main.RPCBr oker1.Resu lts.Count > 0 Then | |
523 | Quic kCopy(frmM ain.RPCBro ker1.Resul ts, memoDi visionComm ents.Lines ); | |
524 | except | |
525 | On EBr okerError Do | |
526 | begin | |
527 | Scre en.Cursor := crDefau lt; | |
528 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed at Station Nu mber ' + S electedSta tion + '!' ); | |
529 | end; | |
530 | end; | |
531 | Screen.C ursor := c rDefault; | |
532 | StatusBa r1.SimpleT ext := ''; | |
533 | end; | |
534 | ||
535 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
536 | // Check U ser Input Values | |
537 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
538 | // Check a ll user in put values . If valu es are inp ut correct ly, return TRUE. | |
539 | // If valu es are mis sing, rout ine short circuits b ack to inp ut form. | |
540 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
541 | function T frmReRoute Request.Ch eckUserInp utValues: Boolean; | |
542 | begin | |
543 | if cbReR outeReason .Text = '' then | |
544 | begin | |
545 | ShowM essageCAPR I('Please enter a Re -Routing R eason.'); | |
546 | Resul t := FALSE ; | |
547 | exit; // make user compl ete form b efore send ing | |
548 | end; | |
549 | if cbReR outeReason .Text = 'O THER' then | |
550 | begin | |
551 | if Len gth(memoRe RouteDescr iption.Lin es.Text) = 0 then | |
552 | begin | |
553 | Sho wMessageCA PRI('Pleas e enter a Re-Routing Descripti on.'); | |
554 | Res ult := FAL SE; | |
555 | exi t; // mak e user com plete form before se nding | |
556 | end; | |
557 | end; | |
558 | if cbVAM C.ItemInde x = -1 the n | |
559 | begin | |
560 | ShowMe ssageCAPRI ('Please e nter a VAM C.'); | |
561 | Result := FALSE; | |
562 | exit; // make u ser comple te form be fore sendi ng | |
563 | end; | |
564 | if cbLoc ation.Item Index = -1 then | |
565 | begin | |
566 | ShowM essageCAPR I('Please enter a Ro uting Loca tion.'); | |
567 | Resul t := FALSE ; | |
568 | exit; // make user compl ete form b efore send ing | |
569 | end; | |
570 | Result : = TRUE; | |
571 | end; | |
572 | ||
573 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
574 | // Check i f VAMC Can Handle Re -Routes | |
575 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
576 | // If the destinatio n site doe sn't have Patch 193 installed, then it w ill not | |
577 | // know ho w to recei ve a re-ro uted reque st. Don't allow the user to r e-route | |
578 | // to a si te where P atch 193 i sn't insta lled. | |
579 | // Input: Station Number at distant s ite | |
580 | // Output: | |
581 | // TRUE : ok to r e-route | |
582 | // FALS E: cannot re-route t o this sit e | |
583 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
584 | function T frmReRoute Request.Ch eckIfVAMCC anHandleRe routes: Bo olean; | |
585 | const | |
586 | RPC_DIR ECT = 'XWB DIRECT RP C'; | |
587 | RPCNAME = 'DVBA C HECK PATCH '; | |
588 | PATCHNU M = 'DVBA* 2.7*193'; | |
589 | begin | |
590 | ||
591 | Result : = FALSE; | |
592 | // if It emIndex is not selec ted (or fo rced to -1 ), don't t est. Just fail | |
593 | if cbVAM C.ItemInde x = -1 the n | |
594 | exit; | |
595 | // if we are re-ro uting with in the sam e VAMC, do not check the patch . | |
596 | // if we got this far, the p atch is in stalled. | |
597 | if Selec tedStation = frmView Exam.Curre ntStationN umber then | |
598 | begin | |
599 | Resul t := TRUE; | |
600 | Exit; | |
601 | end; | |
602 | ||
603 | try | |
604 | Screen .Cursor := crHourGla ss; | |
605 | // che ck patch n umber at s elected si te. If Pa tch 193 is not insta lled, erro r | |
606 | frmMai n.RPCBroke r1.RemoteP rocedure : = RPC_DIRE CT; | |
607 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
608 | frmMai n.RPCBroke r1.Param[0 ].Value := SelectedS tation; | |
609 | frmMai n.RPCBroke r1.Param[1 ].PType := literal; | |
610 | frmMai n.RPCBroke r1.Param[1 ].Value := RPCNAME; | |
611 | frmMai n.RPCBroke r1.Param[2 ].PType := literal; | |
612 | frmMai n.RPCBroke r1.Param[2 ].Value := ''; // R PC version parameter (Optional ) | |
613 | frmMai n.RPCBroke r1.Param[3 ].PType := literal; | |
614 | frmMai n.RPCBroke r1.Param[3 ].Value := PATCHNUM; | |
615 | try | |
616 | frmM ain.RPCBro kerCall; | |
617 | frmM ain.RPCBro ker1.Call; | |
618 | if f rmMain.RPC Broker1.Re sults.Coun t > 0 then | |
619 | if piece(frm Main.RPCBr oker1.Resu lts[0], '^ ', 1) = '1 ' then | |
620 | Result := TRUE; | |
621 | except | |
622 | begi n | |
623 | Sh owMessageC APRI(RPCNA ME + ' cou ld not be accessed a t Station Number ' + SelectedS tation + ' !'); | |
624 | Re sult := FA LSE; | |
625 | end | |
626 | end; | |
627 | finally | |
628 | Screen .Cursor := crDefault ; | |
629 | end; | |
630 | end; | |
631 | ||
632 | ||
633 | ||
634 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
635 | // Select Routing Lo cation | |
636 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
637 | procedure TfrmReRout eRequest.c bLocationC hange(Send er: TObjec t); | |
638 | begin | |
639 | Applicat ion.Proces sMessages; | |
640 | ||
641 | if cbLoc ation.Item Index <> - 1 then | |
642 | begin | |
643 | Routi ngLocation _IEN := Ro utingLocat ion_IEN_Li st[cbLocat ion.ItemIn dex]; | |
644 | Statu sBar1.Simp leText := 'Retrievin g Exam Inf o'; | |
645 | GetEx amLists; | |
646 | GetSi teComments ; | |
647 | Statu sBar1.Simp leText := ''; | |
648 | end; | |
649 | end; | |
650 | ||
651 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
652 | // Sort By State / N ame | |
653 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
654 | // Reload VAMC list and sort b y State if checkbox is set, na me if chec kbox is | |
655 | // empty. | |
656 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
657 | procedure TfrmReRout eRequest.c bxSortBySt ateClick(S ender: TOb ject); | |
658 | begin | |
659 | GetVAMC Locations; | |
660 | end; | |
661 | ||
662 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
663 | // Select VAMC | |
664 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
665 | procedure TfrmReRout eRequest.c bVAMCExit( Sender: TO bject); | |
666 | var | |
667 | buffer : string; | |
668 | begin | |
669 | Applicat ion.Proces sMessages; | |
670 | if cbVAM C.ItemInde x <> -1 th en | |
671 | VAMC_ IEN := VAM C_IEN_list [cbVAMC.It emIndex] | |
672 | else | |
673 | exit; | |
674 | ||
675 | Selected Station := VAMC_Stat ion_List[c bVAMC.Item Index]; | |
676 | if Selec tedStation = SaveSta tionNumber then | |
677 | Exit // no nee d to repop ulate thin gs if just tabbing t hrough con trols | |
678 | else | |
679 | SaveS tationNumb er := Sele ctedStatio n; | |
680 | ||
681 | // If we can't re- route to t he selecte d VAMC, se t the VAMC to blank and | |
682 | // give the user a message. | |
683 | if Check IfVAMCCanH andleRerou tes = FALS E then | |
684 | begin | |
685 | buffer := Copy(c bVAMC.Text ,1,28); | |
686 | cbVAMC .ItemIndex := -1; | |
687 | ShowMe ssageCAPRI (trim(buff er) + ' ca nnot accep t re-route d requests at this t ime.'); | |
688 | cbVAMC .SetFocus; | |
689 | end | |
690 | else | |
691 | GetRou tingLocati ons; | |
692 | ||
693 | end; | |
694 | ||
695 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
696 | // Is Delp hi Running ? | |
697 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
698 | // If Delp hi is runn ing, we ar e in the I DE and ope rating in a testing mode. | |
699 | // Display testing b uttons. I f Delphi i s not runn ing, do no t display test | |
700 | // buttons . | |
701 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
702 | procedure TfrmReRout eRequest.I sDelphiRun ning; | |
703 | begin | |
704 | if Debug Hook <> 0 then | |
705 | begin | |
706 | btnTes tGuestLogi n.Visible := TRUE; | |
707 | btnTes tRemoteRPC .Visible : = TRUE; | |
708 | btnTes tRoutingLo cations.Vi sible := T RUE; | |
709 | btnTes tExamList. Visible := TRUE; | |
710 | btnTes tSiteComme nts.Visibl e := TRUE; | |
711 | edtSta tionNumber .Visible : = TRUE; | |
712 | end | |
713 | else | |
714 | begin | |
715 | btnTes tGuestLogi n.Visible := FALSE; | |
716 | btnTes tRemoteRPC .Visible : = FALSE; | |
717 | btnTes tRoutingLo cations.Vi sible := F ALSE; | |
718 | btnTes tExamList. Visible := FALSE; | |
719 | btnTes tSiteComme nts.Visibl e := FALSE ; | |
720 | edtSta tionNumber .Visible : = FALSE; | |
721 | end; | |
722 | ||
723 | end; | |
724 | ||
725 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
726 | // 508 Hel p | |
727 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
728 | procedure TfrmReRout eRequest.m emoDivisio nCommentsE nter(Sende r: TObject ); | |
729 | begin | |
730 | GetScree nReader.Sp eak('Site Comments:' ); | |
731 | GetScree nReader.Sp eak(memoDi visionComm ents.Text) ; | |
732 | end; | |
733 | ||
734 | procedure TfrmReRout eRequest.m emoReRoute Descriptio nEnter(Sen der: TObje ct); | |
735 | begin | |
736 | GetScree nReader.Sp eak('Descr iption'); | |
737 | GetScree nReader.Sp eak(memoRe RouteDescr iption.Tex t); | |
738 | end; | |
739 | ||
740 | procedure TfrmReRout eRequest.c bVAMCEnter (Sender: T Object); | |
741 | begin | |
742 | if cbVAM C.ItemInde x <> -1 th en | |
743 | GetSc reenReader .Speak('VA MC'); | |
744 | end; | |
745 | ||
746 | ||
747 | ||
748 | ||
749 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
750 | // TEST RO UTINE - TE ST GUEST L OGIN TO TE ST CLAIMS SERVER | |
751 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
752 | // This ro utine logs a "local user" sile ntly onto the TEST C LAIMS syst em and | |
753 | // retriev es data vi a a Filema n control as well as via a RPC . Proof o f concept | |
754 | // for log ging in si lently to TEST CLAIM S which is a directi on not use d in CAPRI | |
755 | // up to t his point. The audi t log will login to CLAIMS, bu t that is not done | |
756 | // on a te st account . | |
757 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
758 | // TEST CL AIMS DATA: | |
759 | // FIL E: 396.97 , FIELD .0 1 | |
760 | // SERVER | |
761 | // SERVER | |
762 | // SERVER | |
763 | // SERVER | |
764 | // SERVER | |
765 | // SERVER | |
766 | // SERVER | |
767 | // SERVER | |
768 | // SERVER | |
769 | // SERVER | |
770 | // SERVER | |
771 | // SERVER | |
772 | // SERVER | |
773 | // SERVER | |
774 | // SERVER | |
775 | //
|
|
776 | //
|
|
777 | // SERVER | |
778 | // SERVER | |
779 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
780 | procedure TfrmReRout eRequest.b tnTestGues tLoginClic k(Sender: TObject); | |
781 | var | |
782 | tempServ er : Strin g; | |
783 | tempPort : Integer ; | |
784 | tempTest Mode : Boo lean; | |
785 | const | |
786 | TESTCLAIMS SERVER = '
|
|
787 | TESTPORT = ' PORT '; | |
788 | begin | |
789 | ||
790 | Applicat ion.Proces sMessages; | |
791 | try | |
792 | Screen .Cursor := crHourGla ss; | |
793 | Status Bar1.Simpl eText := ' Connecting to TEST C LAIMS serv er'; | |
794 | tempSe rver := fr mMain.RPCB roker1.Ser ver; | |
795 | tempPo rt := frmM ain.RPCBro ker1.Liste nerPort; | |
796 | tempTe stMode := frmMain.RP CBroker1.A NUTestMode ; | |
797 | frmMai n.RPCBroke r1.Connect ed := Fals e; | |
798 | frmMai n.RPCBroke r1.Server := TESTCLA IMSSERVER; | |
799 | frmMai n.RPCBroke r1.Listene rPort := S trToInt(TE STPORT); | |
800 | frmMai n.RPCBroke r1.ANUTest Mode := TR UE; | |
801 | if not frmMain.C onnectToSe rver('DVBA CAPRI GUI ') then | |
802 | begin | |
803 | Sho wMessageCA PRI('Canno t connect to ' + TES TCLAIMSSER VER); | |
804 | exi t; | |
805 | end; | |
806 | Status Bar1.Simpl eText := ' Connected to TEST CL AIMS serve r'; | |
807 | ||
808 | // Pop ulate list with File man contro l data | |
809 | FMExam List.Clear ; | |
810 | memoDi visionComm ents.Clear ; | |
811 | // Pop ulate list with RPC data | |
812 | Status Bar1.Simpl eText := ' Get Filema n Control Data.'; | |
813 | FMExam List.FMLis ter := FMR eRouteList er; | |
814 | FMReRo uteLister. GetList(FM ExamList.I tems); | |
815 | ||
816 | Status Bar1.Simpl eText := ' Get RPC Da ta.'; | |
817 | frmMai n.RPCBroke r1.RemoteP rocedure : = 'DVBA CH ECK PATCH' ; | |
818 | frmMai n.RPCBroke r1.Param[0 ].PType := literal; | |
819 | frmMai n.RPCBroke r1.Param[0 ].Value := 'DVBA*2.7 *190'; | |
820 | try | |
821 | frmM ain.RPCBro kerCall; | |
822 | frmM ain.RPCBro ker1.Call; | |
823 | if f rmMain.RPC Broker1.Re sults.Coun t > 0 then | |
824 | if piece(frm Main.RPCBr oker1.Resu lts[0], '^ ', 1) = '1 ' then | |
825 | memoDivis ionComment s.Lines.Ad d('Patch 1 90 install ed') | |
826 | el se | |
827 | memoDivis ionComment s.Lines.Ad d('Patch 1 90 in not installed' ) | |
828 | except on E: Exc eption do | |
829 | mem oDivisionC omments.Li nes.Add('E xception o n GetData: ' + E.Mes sage); | |
830 | end; | |
831 | ||
832 | finally | |
833 | Status Bar1.Simpl eText := ' Disconnect from TEST CLAIMS. Reconnect to local s erver.'; | |
834 | frmMai n.RPCBroke r1.Connect ed := Fals e; | |
835 | frmMai n.RPCBroke r1.Server := TempSer ver; | |
836 | frmMai n.RPCBroke r1.ANUTest Mode := te mpTestMode ; | |
837 | frmMai n.RPCBroke r1.Listene rPort := T empPort; | |
838 | frmMai n.ConnectT oServer('D VBA CAPRI GUI'); | |
839 | Status Bar1.Simpl eText := ' Reconnecte d to local server.'; | |
840 | Screen .Cursor := crDefault ; | |
841 | end; | |
842 | ||
843 | end; | |
844 | ||
845 | ||
846 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
847 | // TEST RO UTINE - TE ST ROUTING LOCATIONS | |
848 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
849 | // This ro utine call s DVBA CAP RI GET DIV ISION usin g the stat ion number input in | |
850 | // the TES T STATION / DIVISION input fie ld. Only used durin g developm ent on | |
851 | // the loc al station number. | |
852 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
853 | procedure TfrmReRout eRequest.b tnTestRout ingLocatio nsClick(Se nder: TObj ect); | |
854 | const | |
855 | RPCNAME = 'DVBA CA PRI GET DI VISION'; | |
856 | var | |
857 | i : Inte ger; | |
858 | begin | |
859 | StatusBa r1.SimpleT ext := 'Re trieving R outing Loc ations.'; | |
860 | Screen.C ursor := c rHourGlass ; | |
861 | Applicat ion.Proces sMessages; | |
862 | cbLocati on.Items.C lear; | |
863 | RoutingL ocation_IE N_List.Cle ar; | |
864 | frmMain. RPCBroker1 .RemotePro cedure := RPCNAME; | |
865 | frmMain. RPCBroker1 .Param[0]. PType := l iteral; | |
866 | frmMain. RPCBroker1 .Param[0]. Value := e dtStationN umber.Text ; | |
867 | try | |
868 | frmMai n.RPCBroke rCall; | |
869 | frmMai n.RPCBroke r1.Call; | |
870 | If frm Main.RPCBr oker1.Resu lts.Count > 0 Then | |
871 | begin | |
872 | For i := 0 To frmMain.RP CBroker1.R esults.Cou nt - 1 Do | |
873 | begi n | |
874 | cb Location.I tems.Add(P iece(frmMa in.RPCBrok er1.Result s[i], '^', 1)); | |
875 | Ro utingLocat ion_IEN_Li st.Add(Pie ce(frmMain .RPCBroker 1.Results[ i], '^', 2 )); | |
876 | end; | |
877 | end; | |
878 | except | |
879 | On EBr okerError Do | |
880 | begin | |
881 | Scre en.Cursor := crDefau lt; | |
882 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed!'); | |
883 | end; | |
884 | end; | |
885 | Screen.C ursor := c rDefault; | |
886 | StatusBa r1.SimpleT ext := ''; | |
887 | end; | |
888 | ||
889 | ||
890 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
891 | // TEST RO UTINE - TE ST SITE CO MMENTS | |
892 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
893 | // Calls D VBA CAPRI GET DIV CO MMENT from the local VistA ins tance. Th e value | |
894 | // input i n the TEST STATION/D IVISION in put should be a loca l division IEN. | |
895 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
896 | procedure TfrmReRout eRequest.b tnTestSite CommentsCl ick(Sender : TObject) ; | |
897 | CONST | |
898 | RPCNAME = 'DVBA CA PRI GET DI V COMMENT' ; | |
899 | DIVISION = '3'; / / ALBANY O N DEVFEX | |
900 | var | |
901 | i : Inte ger; | |
902 | begin | |
903 | StatusBa r1.SimpleT ext := 'Re trieving S ite Commen ts.'; | |
904 | Screen.C ursor := c rHourGlass ; | |
905 | Applicat ion.Proces sMessages; | |
906 | memoDivi sionCommen ts.Clear; | |
907 | frmMain. RPCBroker1 .RemotePro cedure := RPCNAME; | |
908 | frmMain. RPCBroker1 .Param[0]. Value := D IVISION; | |
909 | frmMain. RPCBroker1 .Param[0]. PType := l iteral; | |
910 | try | |
911 | frmMai n.RPCBroke rCall; | |
912 | frmMai n.RPCBroke r1.Call; | |
913 | If frm Main.RPCBr oker1.Resu lts.Count > 0 Then | |
914 | Quic kCopy(frmM ain.RPCBro ker1.Resul ts, FMExam List.Items ); | |
915 | except | |
916 | On EBr okerError Do | |
917 | begin | |
918 | Scre en.Cursor := crDefau lt; | |
919 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed at Division ' + DIVISIO N + '!'); | |
920 | end; | |
921 | end; | |
922 | Screen.C ursor := c rDefault; | |
923 | StatusBa r1.SimpleT ext := ''; | |
924 | end; | |
925 | ||
926 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
927 | // TEST RO UTINE - TE ST EXAM LI ST | |
928 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
929 | // Calls D VBA CAPRI GET DIV EX AM from th e local Vi stA instan ce. The v alue | |
930 | // input i n the TEST STATION/D IVISION in put should be a loca l division IEN. | |
931 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
932 | procedure TfrmReRout eRequest.b tnTestExam ListClick( Sender: TO bject); | |
933 | CONST | |
934 | RPCNAME = 'DVBA CA PRI GET DI V EXAM'; | |
935 | DIVISION = '3'; / / ALBANY O N DEVFEX | |
936 | begin | |
937 | StatusBa r1.SimpleT ext := 'Re trieving E xam Lists. '; | |
938 | Screen.C ursor := c rHourGlass ; | |
939 | Applicat ion.Proces sMessages; | |
940 | FMExamLi st.Items.C lear; | |
941 | frmMain. RPCBroker1 .RemotePro cedure := RPCNAME; | |
942 | frmMain. RPCBroker1 .Param[0]. PType := l iteral; | |
943 | frmMain. RPCBroker1 .Param[0]. Value := D IVISION; | |
944 | try | |
945 | frmMai n.RPCBroke rCall; | |
946 | frmMai n.RPCBroke r1.Call; | |
947 | If frm Main.RPCBr oker1.Resu lts.Count > 0 Then | |
948 | Quick Copy(frmMa in.RPCBrok er1.Result s, FMExamL ist.Items) ; | |
949 | except | |
950 | On EBr okerError Do | |
951 | begin | |
952 | Scre en.Cursor := crHourG lass; | |
953 | Show MessageCAP RI(RPCNAME + ' could not be ac cessed at Division ' + DIVISIO N + '!'); | |
954 | end; | |
955 | end; | |
956 | Screen.C ursor := c rDefault; | |
957 | StatusBa r1.SimpleT ext := ''; | |
958 | ||
959 | end; | |
960 | ||
961 | ||
962 | ||
963 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
964 | // TEST RO UTINE - XW B DIRECT R PC | |
965 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
966 | // This ro utine call s an RPC t hat uses H L7 to comm unicate be tween Vist A | |
967 | // instanc es. It wa s exactly what we ne eded, but our test a ccounts do not have | |
968 | // this HL 7 interfac e installe d. In add ition, TES T CLAIMS d oes not ha ve a | |
969 | // unique station nu mber that is publish ed that al so causes issues. L eaving | |
970 | // this ro utine here in case w e come bac k to it. | |
971 | // | |
972 | // Update: HL7 was added to o ur test en vironments between D EVFEX and TEST | |
973 | // CLAIMS. Other de v environm ents may b e added. Our dev en vironment has | |
974 | // unique station nu mbers betw een the sy stems it k nows about (only dev , not | |
975 | // product ion) so HL 7 can comm unicate. HL7 is cur rently dep loyed in a ll | |
976 | // product ion enviro nments so no worries about usi ng the RPC in produc tion. | |
977 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
978 | // XWB DIR ECT RPC | |
979 | // Param 0: Statio n Number | |
980 | // Param 1: Name o f RPC | |
981 | // Param 2: RPC VE RSION PARA METER (Opt ional) | |
982 | // Param 3: Remote RPC Param eters | |
983 | // ------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
984 | procedure TfrmReRout eRequest.b tnTestRemo teRPCClick (Sender: T Object); | |
985 | const | |
986 | RPCNAME = 'DVBA C HECK PATCH '; | |
987 | PATCH = 'DVBA*2.7 *193'; | |
988 | var | |
989 | ReturnVa lue : Stri ng; | |
990 | begin | |
991 | FMExamLi st.Items.C lear; | |
992 | frmMain. RPCBroker1 .RemotePro cedure := 'XWB DIREC T RPC'; | |
993 | frmMain. RPCBroker1 .Param[0]. PType := l iteral; | |
994 | frmMain. RPCBroker1 .Param[0]. Value := e dtStationN umber.Text ; | |
995 | frmMain. RPCBroker1 .Param[1]. PType := l iteral; | |
996 | frmMain. RPCBroker1 .Param[1]. Value := R PCNAME; | |
997 | frmMain. RPCBroker1 .Param[2]. PType := l iteral; | |
998 | frmMain. RPCBroker1 .Param[2]. Value := ' '; | |
999 | frmMain. RPCBroker1 .Param[3]. PType := l iteral; | |
1000 | frmMain. RPCBroker1 .Param[3]. Value := P ATCH; | |
1001 | try | |
1002 | frmMai n.RPCBroke rCall; | |
1003 | frmMai n.RPCBroke r1.Call; | |
1004 | if frm Main.RPCBr oker1.Resu lts.Count > 0 then | |
1005 | Quick Copy(frmMa in.RPCBrok er1.Result s, FMExamL ist.Items) ; | |
1006 | except | |
1007 | ShowMe ssage('Exc eption'); | |
1008 | end; | |
1009 | end; | |
1010 | ||
1011 | ||
1012 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
1013 | // Initial ization | |
1014 | //-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- | |
1015 | initializa tion | |
1016 | SpecifyFor mIsNotADia log(TfrmRe RouteReque st); | |
1017 | ||
1018 | ||
1019 | end. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.