source: cprs/trunk/CPRS-Chart/Options/fOptionsCombinations.pas@ 1672

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

Upgrade to version 27

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