source: cprs/branches/tmg-cprs/CPRS-Chart/fProbFlt.pas@ 1099

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

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