source: cprs/branches/foia-cprs/CPRS-Chart/Options/fOptionsCombinations.pas

Last change on this file was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

File size: 9.7 KB
Line 
1unit fOptionsCombinations;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, StdCtrls, ORCtrls, OrFn, ComCtrls;
8
9type
10 TfrmOptionsCombinations = class(TForm)
11 radAddByType: TRadioGroup;
12 lblInfo: TMemo;
13 lblAddby: TLabel;
14 lblCombinations: TLabel;
15 lstAddBy: TORComboBox;
16 btnAdd: TButton;
17 btnRemove: TButton;
18 pnlBottom: TPanel;
19 btnOK: TButton;
20 btnCancel: TButton;
21 bvlBottom: TBevel;
22 lvwCombinations: TCaptionListView;
23 procedure radAddByTypeClick(Sender: TObject);
24 procedure lstAddByNeedData(Sender: TObject; const StartFrom: String;
25 Direction, InsertAt: Integer);
26 procedure FormCreate(Sender: TObject);
27 procedure btnAddClick(Sender: TObject);
28 procedure lvwCombinationsColumnClick(Sender: TObject;
29 Column: TListColumn);
30 procedure lvwCombinationsCompare(Sender: TObject; Item1,
31 Item2: TListItem; Data: Integer; var Compare: Integer);
32 procedure btnRemoveClick(Sender: TObject);
33 procedure lstAddByChange(Sender: TObject);
34 procedure lstAddByKeyUp(Sender: TObject; var Key: Word;
35 Shift: TShiftState);
36 procedure btnOKClick(Sender: TObject);
37 procedure lstAddByEnter(Sender: TObject);
38 procedure lstAddByExit(Sender: TObject);
39 procedure lvwCombinationsChange(Sender: TObject; Item: TListItem;
40 Change: TItemChange);
41 procedure FormShow(Sender: TObject);
42 private
43 { Private declarations }
44 FsortCol: integer;
45 FsortAscending: boolean;
46 FDirty: boolean;
47 function Duplicate(avalueien, asource: string): boolean;
48 procedure LoadCombinations(alist: TStrings);
49 public
50 { Public declarations }
51 end;
52
53var
54 frmOptionsCombinations: TfrmOptionsCombinations;
55
56procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
57
58implementation
59
60uses rOptions, rCore;
61
62{$R *.DFM}
63
64type
65 TCombination = class
66 public
67 IEN: string;
68 Entry: string;
69 Source: string;
70end;
71
72procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
73// create the form and make it modal, return an action
74var
75 frmOptionsCombinations: TfrmOptionsCombinations;
76begin
77 frmOptionsCombinations := TfrmOptionsCombinations.Create(Application);
78 actiontype := 0;
79 try
80 with frmOptionsCombinations do
81 begin
82 if (topvalue < 0) or (leftvalue < 0) then
83 Position := poScreenCenter
84 else
85 begin
86 Position := poDesigned;
87 Top := topvalue;
88 Left := leftvalue;
89 end;
90 ResizeAnchoredFormToFont(frmOptionsCombinations);
91 ShowModal;
92 actiontype := btnOK.Tag;
93 end;
94 finally
95 frmOptionsCombinations.Release;
96 end;
97end;
98
99procedure TfrmOptionsCombinations.radAddByTypeClick(Sender: TObject);
100begin
101 with lstAddBy do
102 begin
103 case radAddByType.ItemIndex of
104 0: begin
105 ListItemsOnly := false;
106 LongList := false;
107 ListWardAll(lstAddBy.Items);
108 MixedCaseList(lstAddBy.Items);
109 lblAddby.Caption := 'Ward:';
110 end;
111 1: begin
112 ListItemsOnly := true;
113 LongList := true;
114 InitLongList('');
115 lblAddby.Caption := 'Clinic:';
116 end;
117 2: begin
118 ListItemsOnly := true;
119 LongList := true;
120 InitLongList('');
121 lblAddby.Caption := 'Provider:';
122 end;
123 3: begin
124 ListItemsOnly := false;
125 LongList := false;
126 ListSpecialtyAll(lstAddBy.Items);
127 lblAddby.Caption := 'Specialty:';
128 end;
129 4: begin
130 ListItemsOnly := false;
131 LongList := false;
132 ListTeamAll(lstAddBy.Items);
133 lblAddby.Caption := 'List:';
134 end;
135 end;
136 lstAddBy.Caption := lblAddby.Caption;
137 ItemIndex := -1;
138 Text := '';
139 btnAdd.Enabled := false;
140 end;
141end;
142
143procedure TfrmOptionsCombinations.lstAddByNeedData(Sender: TObject;
144 const StartFrom: String; Direction, InsertAt: Integer);
145begin
146 with lstAddBy do
147 begin
148 case radAddByType.ItemIndex of
149 0: begin
150 Pieces := '2';
151 end;
152 1: begin
153 Pieces := '2';
154 ForDataUse(SubSetOfClinics(StartFrom, Direction));
155 end;
156 2: begin
157 Pieces := '2,3';
158 ForDataUse(SubSetOfProviders(StartFrom, Direction));
159 end;
160 3: begin
161 Pieces := '2';
162 end;
163 4: begin
164 Pieces := '2';
165 end;
166 end;
167 end;
168end;
169
170procedure TfrmOptionsCombinations.FormCreate(Sender: TObject);
171begin
172 radAddByType.ItemIndex := 0;
173 radAddByTypeClick(self);
174 FDirty := false;
175end;
176
177procedure TfrmOptionsCombinations.btnAddClick(Sender: TObject);
178var
179 aListItem: TListItem;
180 aCombination: TCombination;
181 valueien, valuename, valuesource: string;
182begin
183 valuesource := radAddByType.Items[radAddByType.ItemIndex];
184 if copy(valuesource, 1, 1) = '&' then
185 valuesource := copy(valuesource, 2, length(valuesource) - 1);
186 valuename := Piece(lstAddBy.DisplayText[lstAddBy.ItemIndex], '-', 1);
187 valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
188 if Duplicate(valueien, valuesource) then exit; // check for duplicates
189 aListItem := lvwCombinations.Items.Add;
190 with aListItem do
191 begin
192 Caption := valuename;
193 SubItems.Add(valuesource);
194 end;
195 aCombination := TCombination.Create;
196 with aCombination do
197 begin
198 IEN := valueien;
199 Entry := valuename;
200 Source := valuesource;
201 end;
202 aListItem.SubItems.AddObject('combo object', aCombination);
203 btnAdd.Enabled := false;
204 FDirty := true;
205end;
206
207procedure TfrmOptionsCombinations.lvwCombinationsColumnClick(
208 Sender: TObject; Column: TListColumn);
209begin
210 if FsortCol = Column.Index then
211 FsortAscending := not FsortAscending
212 else
213 FsortAscending := true;
214 FsortCol := Column.Index;
215 (Sender as TListView).AlphaSort;
216end;
217
218procedure TfrmOptionsCombinations.lvwCombinationsCompare(Sender: TObject;
219 Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
220begin
221 if not(Sender is TListView) then exit;
222 if FsortAscending then
223 begin
224 if FsortCol = 0 then
225 Compare := CompareStr(Item1.Caption, Item2.Caption)
226 else
227 Compare := CompareStr(Item1.SubItems[FsortCol - 1],
228 Item2.SubItems[FsortCol - 1]);
229 end
230 else
231 begin
232 if FsortCol = 0 then
233 Compare := CompareStr(Item2.Caption, Item1.Caption)
234 else
235 Compare := CompareStr(Item2.SubItems[FsortCol - 1],
236 Item1.SubItems[FsortCol - 1]);
237 end;
238end;
239
240procedure TfrmOptionsCombinations.btnRemoveClick(Sender: TObject);
241var
242 i: integer;
243begin
244 with lvwCombinations do
245 for i := Items.Count - 1 downto 0 do
246 if Items[i].Selected then
247 Items[i].Delete;
248 btnRemove.Enabled := false;
249 FDirty := true;
250end;
251
252procedure TfrmOptionsCombinations.lstAddByChange(Sender: TObject);
253var
254 valueien, source: string;
255begin
256 if lstAddBy.ItemIndex = -1 then
257 btnAdd.Enabled := false
258 else
259 begin
260 source := radAddByType.Items[radAddByType.ItemIndex];
261 if copy(source, 1, 1) = '&' then
262 source := copy(source, 2, length(source) - 1);
263 valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
264 btnAdd.Enabled := not Duplicate(valueien, source);
265 end;
266 btnRemove.Enabled := false;
267end;
268
269function TfrmOptionsCombinations.Duplicate(avalueien,
270 asource: string): boolean;
271var
272 i: integer;
273 aCombination :TCombination;
274begin
275 result := false;
276 with lvwCombinations do
277 for i := 0 to Items.Count - 1 do
278 if asource = Items[i].Subitems[0] then
279 begin
280 aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
281 if aCombination.IEN = avalueien then
282 begin
283 Result := true;
284 end;
285 end;
286end;
287
288procedure TfrmOptionsCombinations.lstAddByKeyUp(Sender: TObject;
289 var Key: Word; Shift: TShiftState);
290begin
291 if Key = 13 then Perform(WM_NextDlgCtl, 0, 0);
292end;
293
294procedure TfrmOptionsCombinations.btnOKClick(Sender: TObject);
295var
296 i: integer;
297 alist: TStringList;
298 aCombination :TCombination;
299begin
300 if FDirty then
301 begin
302 alist := TStringList.Create;
303 with lvwCombinations do
304 for i := 0 to Items.Count - 1 do
305 begin
306 aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
307 with aCombination do alist.Add(IEN + '^' + Source);
308 end;
309 rpcSetCombo(alist);
310 alist.Free;
311 end;
312end;
313
314procedure TfrmOptionsCombinations.lstAddByEnter(Sender: TObject);
315begin
316 btnAdd.Default := true;
317end;
318
319procedure TfrmOptionsCombinations.lstAddByExit(Sender: TObject);
320begin
321 btnAdd.Default := false;
322end;
323
324procedure TfrmOptionsCombinations.lvwCombinationsChange(Sender: TObject;
325 Item: TListItem; Change: TItemChange);
326begin
327 btnRemove.Enabled := lvwCombinations.SelCount > 0;
328end;
329
330procedure TfrmOptionsCombinations.LoadCombinations(alist: TStrings);
331var
332 i: integer;
333 aListItem: TListItem;
334 aCombination: TCombination;
335 valueien, valuename, valuesource: string;
336begin
337 for i := 0 to alist.Count - 1 do
338 begin
339 valuesource := Piece(alist[i], '^', 1);
340 valuename := Piece(alist[i], '^', 2);
341 valueien := Piece(alist[i], '^', 3);
342 aListItem := lvwCombinations.Items.Add;
343 with aListItem do
344 begin
345 Caption := valuename;
346 SubItems.Add(valuesource);
347 end;
348 aCombination := TCombination.Create;
349 with aCombination do
350 begin
351 IEN := valueien;
352 Entry := valuename;
353 Source := valuesource;
354 end;
355 aListItem.SubItems.AddObject('combo object', aCombination);
356 end;
357end;
358
359procedure TfrmOptionsCombinations.FormShow(Sender: TObject);
360begin
361 LoadCombinations(rpcGetCombo);
362end;
363
364end.
Note: See TracBrowser for help on using the repository browser.