source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptionsCombinations.pas@ 667

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

Initial upload of TMG-CPRS 1.0.26.69

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