source: cprs/trunk/CPRS-Chart/fProbFlt.pas@ 484

Last change on this file since 484 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76
File size: 13.1 KB
RevLine 
[456]1unit fProbflt;
2
3interface
4
5uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
6 StdCtrls, SysUtils, ORCtrls, ExtCtrls, uProbs, uConst, Dialogs;
7
8type
9 TfrmPlVuFilt = class(TForm)
10 pnlBase: TORAutoPanel;
11 SrcLabel: TLabel;
12 DstLabel: TLabel;
13 lblProvider: TLabel;
14 Bevel1: TBevel;
15 OROffsetLabel1: TOROffsetLabel;
16 cmdAdd: TButton;
17 cmdRemove: TButton;
18 cmdRemoveAll: TButton;
19 cmdOK: TBitBtn;
20 cmdCancel: TBitBtn;
21 lstDest: TORListBox;
22 rgVu: TRadioGroup;
23 cboProvider: TORComboBox;
24 cmdDefaultView: TBitBtn;
25 cboSource: TORComboBox;
26 cmdSave: TButton;
27 chkComments: TCheckBox;
28 cboStatus: TORComboBox;
29 procedure cmdAddClick(Sender: TObject);
30 procedure cmdRemoveClick(Sender: TObject);
31 procedure cmdRemoveAllClick(Sender: TObject);
32 procedure SetButtons;
33 procedure FormClose(Sender: TObject; var Action: TCloseAction);
34 procedure rgVuClick(Sender: TObject);
35 procedure cmdCancelClick(Sender: TObject);
36 procedure cmdOKClick(Sender: TObject);
37 procedure FormShow(Sender: TObject);
38 procedure cmdDefaultViewClick(Sender: TObject);
39 procedure cboProviderNeedData(Sender: TObject; const StartFrom: String;
40 Direction, InsertAt: Integer);
41 procedure cboSourceNeedData(Sender: TObject; const StartFrom: String;
42 Direction, InsertAt: Integer);
43 procedure lstDestClick(Sender: TObject);
44 procedure cboSourceChange(Sender: TObject);
45 procedure cboSourceEnter(Sender: TObject);
46 procedure cboSourceExit(Sender: TObject);
47 procedure cmdSaveClick(Sender: TObject);
48 procedure FormCreate(Sender: TObject);
49 private
50 FContextString: string;
51 FFilterString: string;
52 FFilterChanged: boolean;
53 function CreateContextString: string;
54 function CreateFilterString: string;
55 procedure GetClinicList;
56 procedure GetServiceList;
57 procedure GetLocationList;
58 end;
59
60var
61 frmPlVuFilt: TfrmPlVuFilt;
62
63procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean);
64
65implementation
66
67{$R *.DFM}
68uses
69 ORFn, fProbs, rProbs, rCore;
70
71procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean);
72var
73 frmPlVuFilt: TfrmPLVuFilt;
74 W, H: Integer;
75begin
76 frmPlVuFilt := TfrmPLVuFilt.create(Application);
77 try
78 with frmPlVuFilt do
79 begin
80 Font.Size := FontSize;
81 W := ClientWidth;
82 H := ClientHeight;
83 ResizeToFont(FontSize, W, H);
84 ClientWidth := W; pnlBase.Width := W;
85 ClientHeight := H; pnlBase.Height := H;
86 FContextString := ContextString;
87 ShowModal;
88 FilterChanged := FFilterChanged;
89 ContextString := FContextString;
90 FilterString := FFilterString;
91 end; {with frmPlVuFilt}
92 finally
93 frmPlVuFilt.Release;
94 end;
95end;
96
97procedure TfrmPlVuFilt.FormCreate(Sender: TObject);
98begin
99 with cboStatus do
100 begin
101 Items.Assign(frmProblems.lstView.Items);
102 SelectByID(PLUser.usViewAct);
103 end;
104end;
105
106procedure TfrmPlVuFilt.FormShow(Sender: TObject);
107begin
108 if PLUser.usCurrentView = PL_OP_VIEW then
109 rgVu.itemindex := 0
110 else if PLUser.usCurrentView = PL_IP_VIEW then
111 rgVu.itemindex := 1
112 else
113 rgVu.itemindex := -1; //2;
114 rgVuClick(Self);
115 cboSource.ItemIndex := -1;
116 if PlUser.usViewProv = '0^All' then
117 begin
118 cboProvider.InitLongList('');
119 cboProvider.ItemIndex := 0;
120 end
121 else
122 begin
123 cboProvider.InitLongList(Piece(PLUser.usViewProv, U, 2));
124 cboProvider.SelectByID(Piece(PLUser.usViewProv, U, 1));
125 end;
126 chkComments.Checked := (PLUser.usViewComments = '1');
127end;
128
129procedure TfrmPlVuFilt.cmdAddClick(Sender: TObject);
130var
131 textindex: integer;
132begin
133 textindex := lstDest.Items.Count;
134 if cboSource.ItemIndex > -1 then
135 if lstDest.SelectById(cboSource.ItemID) = -1 then
136 lstDest.Items.Add(cboSource.Items[cboSource.ItemIndex]);
137 lstDest.ItemIndex := textindex;
138 SetButtons;
139end;
140
141procedure TfrmPlVuFilt.cmdRemoveClick(Sender: TObject);
142var
143 newindex: integer;
144begin
145 if lstDest.Items.Count > 0 then
146 begin
147 if lstDest.ItemIndex = (lstDest.Items.Count -1 ) then
148 newindex := lstDest.ItemIndex - 1
149 else
150 newindex := lstDest.ItemIndex;
151 lstDest.Items.Delete(lstDest.ItemIndex);
152 if lstDest.Items.Count > 0 then lstDest.ItemIndex := newindex;
153 end;
154 SetButtons;
155end;
156
157procedure TfrmPlVuFilt.cmdRemoveAllClick(Sender: TObject);
158begin
159 lstDest.Clear;
160 SetButtons;
161end;
162
163procedure TfrmPlVuFilt.SetButtons;
164var
165 SrcEmpty, DstEmpty: Boolean;
166begin
167 SrcEmpty := cboSource.Items.Count = 0;
168 DstEmpty := lstDest.Items.Count = 0;
169 cmdAdd.Enabled := (not SrcEmpty) and (cboSource.ItemIndex > -1) ;
170 cmdRemove.Enabled := not DstEmpty;
171 cmdRemoveAll.Enabled := not DstEmpty;
172end;
173
174procedure TfrmPlVuFilt.rgVuClick(Sender: TObject);
175var
176 AList: TStringList;
177 i: integer;
178begin
179 AList := TStringList.Create;
180 try
181 cboSource.clear;
182 lstDest.clear;
183 cboSource.enabled:=true;
184 lstDest.enabled:=true;
185 cboSource.color:=clWindow;
186 lstDest.color:=clWindow;
187 case rgVu.itemindex of
188 0: {out patient view} begin
189 GetClinicList;
190 GetListForOP(Alist, frmProblems.wgProbData);
191 cboSource.Items.Assign(ClinicFilterList(Alist));
192 cboSource.InsertSeparator;
193 cboSource.InitLongList('') ;
194 for i := 0 to PLFilters.ClinicList.Count - 1 do
195 begin
196 cboSource.SelectByID(PLFilters.ClinicList[i]);
197 cmdAddClick(Self);
198 end;
199 end;
200 1: {in-patient View} begin
201 GetServiceList;
202 GetListForIP(Alist, frmProblems.wgProbData);
203 cboSource.Items.Assign(ServiceFilterList(Alist));
204 cboSource.InsertSeparator;
205 cboSource.InitLongList('') ;
206 for i := 0 to PLFilters.ServiceList.Count - 1 do
207 begin
208 cboSource.SelectByID(PLFilters.ServiceList[i]);
209 cmdAddClick(Self);
210 end;
211 end;
212 else {unfiltered view} GetLocationList;
213 end;
214 SetButtons ;
215 finally
216 AList.Free;
217 end;
218end;
219
220procedure TfrmPlVuFilt.lstDestClick(Sender: TObject);
221begin
222 SetButtons ;
223end;
224
225procedure TfrmPlVuFilt.cboSourceChange(Sender: TObject);
226begin
227 SetButtons ;
228end;
229
230procedure TfrmPlVuFilt.cboSourceEnter(Sender: TObject);
231begin
232 cmdAdd.Default := true;
233end;
234
235procedure TfrmPlVuFilt.cboSourceExit(Sender: TObject);
236begin
237 cmdAdd.Default := false;
238end;
239
240procedure TfrmPlVuFilt.cmdCancelClick(Sender: TObject);
241begin
242 FFilterChanged := False;
243 close;
244end;
245
246procedure TfrmPlVuFilt.cmdOKClick(Sender: TObject);
247var
248 Alist:TstringList;
249
250 procedure SetVu(vulist:TstringList; vu:string);
251 var
252 alist:TstringList;
253 begin
254 alist:=TStringList.create;
255 try
256 vuList.clear;
257 if lstDest.Items.Count=0 then
258 begin
259 AList.Clear;
260 AList.Add('0');
261 end
262 else
263 alist.assign(lstDest.Items); {conserve only selected items}
264 LoadFilterList(Alist,VuList);
265 PLUser.usCurrentView:=vu;
266 finally
267 alist.free;
268 end;
269 end;
270
271begin {BODY of procedure}
272 Alist:=TStringList.create;
273 try
274 PlFilters.ProviderList.clear;
275 if (uppercase(cboProvider.text)='ALL') or (cboProvider.Text='') then
276 begin
277 Alist.clear;
278 AList.Add('0');
279 PLUser.usViewProv := '0^All';
280 AList.Add('-1');
281 LoadFilterList(Alist,PLFilters.ProviderList);
282 end
283 else
284 begin
285 AList.clear;
286 Alist.add(IntToStr(cboProvider.ItemIEN));
287 PLUser.usViewProv := cboProvider.Items[cboProvider.ItemIndex];
288 LoadFilterList(Alist, PLFilters.ProviderList);
289 end;
290 case rgVu.itemindex of
291 0: SetVu(PLFilters.clinicList, PL_OP_VIEW); {OP view}
292 1: SetVu(PLFilters.ServiceList, PL_IP_VIEW); {IP view}
293 else
294 SetVu(PLFilters.clinicList, PL_UF_VIEW);
295 end;
296 //ShowFilterStatus(PLUser.usCurrentView);
297 //PostMessage(frmProblems.Handle, UM_PLFILTER, 0, 0);
298 FContextString := CreateContextString;
299 FFilterString := CreateFilterString;
300 FFilterChanged := True;
301 close;
302 finally
303 alist.free;
304 end;
305end;
306
307procedure TfrmPlVuFilt.cmdDefaultViewClick(Sender: TObject);
308{var
309 Alist:TStringList;
310 i: integer;
311 tmpProv: Int64;}
312begin
313{ Alist:=TStringList.create;
314 try
315 lstDest.Clear;
316 PlUser.usCurrentView:=PLUser.usDefaultView;
317 tmpProv := StrToInt64Def(Piece(PLUser.usDefaultContext, ';', 5), 0);
318 if tmpProv > 0 then
319 PLUser.usViewProv := IntToStr(tmpProv) + ExternalName(tmpProv, 200);
320 with cboStatus do
321 begin
322 for i := 0 to Items.Count - 1 do
323 if Copy(Items[i], 1, 1) = Piece(PLUser.usDefaultContext, ';', 3) then
324 ItemIndex := i;
325 end;
326 chkComments.Checked := (Piece(PLUser.usDefaultContext, ';', 4) = '1');
327 PLFilters.ProviderList.Clear;
328 PLFilters.ProviderList.Add(Piece(PLUser.usViewProv, U, 1));
329 PLFilters.ClinicList.Assign(plUser.usClinList);
330 PlFilters.ServiceList.Assign(plUser.usServList);
331 cboProvider.InitLongList(Piece(PLUser.usViewProv, U, 2));
332 cboProvider.SelectByID(Piece(PLUser.usViewProv, U, 1));
333 //InitViewFilters(Alist);
334 finally
335 Alist.free;
336 end;
337 //FormShow(Self);
338 FContextString := PLUser.usDefaultContext;
339 FFilterChanged := True;
340 Close;
341 //ModalResult := mrOK ; }
342end;
343
344procedure TfrmPlVuFilt.FormClose(Sender: TObject;
345 var Action: TCloseAction);
346begin
347 Release;
348end;
349
350procedure TfrmPlVuFilt.GetClinicList;
351begin
352 PLFilters.ServiceList.clear;
353 SrcLabel.caption:='Source Clinic(s)';
354 DstLabel.caption:='Selected Clinic(s)';
355 cboSource.Caption := 'Source Clinics';
356 lstDest.Caption := 'Selected Clinic or Clinics';
357 lstDest.Clear;
358 SetButtons ;
359end;
360
361procedure TfrmPlVuFilt.GetServiceList;
362begin
363 PLFilters.ClinicList.clear;
364 SrcLabel.caption:='Source Service(s)';
365 DstLabel.caption:='Selected Service(s)';
366 cboSource.Caption := 'Source Services';
367 lstDest.Caption := 'Selected Service or Services';
368 lstDest.Clear;
369 SetButtons ;
370end;
371
372procedure TfrmPlVuFilt.GetLocationList;
373begin
374 cboSource.Clear;
375 lstDest.Clear;
376 PLFilters.ClinicList.clear;
377 PLFilters.ServiceList.clear;
378 SrcLabel.caption:='All Locations/Services';
379 DstLabel.caption:='Selected Locations/Services';
380 cboSource.Caption := 'All Locations/Services';
381 lstDest.Caption := 'Selected Locations/Services';
382 cboSource.color:=clBtnFace;
383 cboSource.enabled:=false;
384 lstDest.color:=clBtnFace;
385 lstDest.enabled:=false;
386end;
387
388procedure TfrmPlVuFilt.cboProviderNeedData(Sender: TObject;
389 const StartFrom: String; Direction, InsertAt: Integer);
390begin
391 cboProvider.ForDataUse(SubSetOfActiveAndInactivePersons(StartFrom, Direction));
392 cboProvider.Items.insert(0,'0^All');
393end;
394
395procedure TfrmPlVuFilt.cboSourceNeedData(Sender: TObject;
396 const StartFrom: String; Direction, InsertAt: Integer);
397begin
398 case rgVu.itemindex of
399 0: {out patient view} cboSource.ForDataUse(SubsetOfClinics(StartFrom,Direction));
400 1: {in-patient View} cboSource.ForDataUse(ServiceSearch(StartFrom,Direction));
401 else {unfiltered view} GetLocationList;
402 end;
403end;
404
405function TfrmPlVuFilt.CreateContextString: string;
406var
407 Status, Comments, Provider: string;
408begin
409 if cboStatus.ItemIndex > -1 then
410 Status := cboStatus.ItemID
411 else
412 Status := 'A';
413 Comments := BOOLCHAR[chkComments.Checked];
414 if cboProvider.ItemIEN > 0 then Provider := cboProvider.ItemID else Provider := '';
415 Result := ';;' + Status + ';' + Comments + ';' + Provider;
416end;
417
418function TfrmPlVuFilt.CreateFilterString: string;
419var
420 FilterString: string;
421 i: integer;
422begin
423 case rgVu.ItemIndex of
424 0: FilterString := PL_OP_VIEW + '/';
425 1: FilterString := PL_IP_VIEW + '/';
426 else FilterString := '';
427 end;
428 if rgVu.ItemIndex <> -1 then
429 for i := 0 to lstDest.Items.Count - 1 do
430 if Piece(lstDest.Items[i], U, 1) <> '-1' then
431 FilterString := FilterString + Piece(lstDest.Items[i], U, 1) + '/';
432 Result := FilterString;
433end;
434
435procedure TfrmPlVuFilt.cmdSaveClick(Sender: TObject);
436begin
437 {FContextString := CreateContextString;
438 FFilterString := CreateFilterString;
439 if InfoBox('Replace current defaults?','Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
440 begin
441 with PLUser do
442 begin
443 usDefaultContext := FContextString;
444 usDefaultView := Piece(FFilterString, '/', 1);
445 end;
446 SaveViewPreferences(FFilterString + U + FContextString);
447 end; }
448end;
449
450end.
Note: See TracBrowser for help on using the repository browser.