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

Last change on this file since 1066 was 830, checked in by Kevin Toppenberg, 14 years ago

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