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

Last change on this file since 1742 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28

File size: 10.0 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 { if radAddByType.ItemIndex = 2 then
188 valuename := Piece(lstAddBy.DisplayText[lstAddBy.ItemIndex], '-', 1)
189 else } //Removed per PTM 274 - should not peice by the "-" at all
190 valuename := lstAddBy.DisplayText[lstAddBy.ItemIndex];
191 valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
192 if Duplicate(valueien, valuesource) then exit; // check for duplicates
193 aListItem := lvwCombinations.Items.Add;
194 with aListItem do
195 begin
196 Caption := valuename;
197 SubItems.Add(valuesource);
198 end;
199 aCombination := TCombination.Create;
200 with aCombination do
201 begin
202 IEN := valueien;
203 Entry := valuename;
204 Source := valuesource;
205 end;
206 aListItem.SubItems.AddObject('combo object', aCombination);
207 btnAdd.Enabled := false;
208 FDirty := true;
209end;
210
211procedure TfrmOptionsCombinations.lvwCombinationsColumnClick(
212 Sender: TObject; Column: TListColumn);
213begin
214 if FsortCol = Column.Index then
215 FsortAscending := not FsortAscending
216 else
217 FsortAscending := true;
218 FsortCol := Column.Index;
219 (Sender as TListView).AlphaSort;
220end;
221
222procedure TfrmOptionsCombinations.lvwCombinationsCompare(Sender: TObject;
223 Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
224begin
225 if not(Sender is TListView) then exit;
226 if FsortAscending then
227 begin
228 if FsortCol = 0 then
229 Compare := CompareStr(Item1.Caption, Item2.Caption)
230 else
231 Compare := CompareStr(Item1.SubItems[FsortCol - 1],
232 Item2.SubItems[FsortCol - 1]);
233 end
234 else
235 begin
236 if FsortCol = 0 then
237 Compare := CompareStr(Item2.Caption, Item1.Caption)
238 else
239 Compare := CompareStr(Item2.SubItems[FsortCol - 1],
240 Item1.SubItems[FsortCol - 1]);
241 end;
242end;
243
244procedure TfrmOptionsCombinations.btnRemoveClick(Sender: TObject);
245var
246 i: integer;
247begin
248 with lvwCombinations do
249 for i := Items.Count - 1 downto 0 do
250 if Items[i].Selected then
251 Items[i].Delete;
252 btnRemove.Enabled := false;
253 FDirty := true;
254end;
255
256procedure TfrmOptionsCombinations.lstAddByChange(Sender: TObject);
257var
258 valueien, source: string;
259begin
260 if lstAddBy.ItemIndex = -1 then
261 btnAdd.Enabled := false
262 else
263 begin
264 source := radAddByType.Items[radAddByType.ItemIndex];
265 if copy(source, 1, 1) = '&' then
266 source := copy(source, 2, length(source) - 1);
267 valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
268 btnAdd.Enabled := not Duplicate(valueien, source);
269 end;
270 btnRemove.Enabled := false;
271end;
272
273function TfrmOptionsCombinations.Duplicate(avalueien,
274 asource: string): boolean;
275var
276 i: integer;
277 aCombination :TCombination;
278begin
279 result := false;
280 with lvwCombinations do
281 for i := 0 to Items.Count - 1 do
282 if asource = Items[i].Subitems[0] then
283 begin
284 aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
285 if aCombination.IEN = avalueien then
286 begin
287 Result := true;
288 end;
289 end;
290end;
291
292procedure TfrmOptionsCombinations.lstAddByKeyUp(Sender: TObject;
293 var Key: Word; Shift: TShiftState);
294begin
295 if Key = 13 then Perform(WM_NextDlgCtl, 0, 0);
296end;
297
298procedure TfrmOptionsCombinations.btnOKClick(Sender: TObject);
299var
300 i: integer;
301 alist: TStringList;
302 aCombination :TCombination;
303begin
304 if FDirty then
305 begin
306 alist := TStringList.Create;
307 with lvwCombinations do
308 for i := 0 to Items.Count - 1 do
309 begin
310 aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
311 with aCombination do alist.Add(IEN + '^' + Source);
312 end;
313 rpcSetCombo(alist);
314 alist.Free;
315 end;
316end;
317
318procedure TfrmOptionsCombinations.lstAddByEnter(Sender: TObject);
319begin
320 btnAdd.Default := true;
321end;
322
323procedure TfrmOptionsCombinations.lstAddByExit(Sender: TObject);
324begin
325 btnAdd.Default := false;
326end;
327
328procedure TfrmOptionsCombinations.lvwCombinationsChange(Sender: TObject;
329 Item: TListItem; Change: TItemChange);
330begin
331 btnRemove.Enabled := lvwCombinations.SelCount > 0;
332end;
333
334procedure TfrmOptionsCombinations.LoadCombinations(alist: TStrings);
335var
336 i: integer;
337 aListItem: TListItem;
338 aCombination: TCombination;
339 valueien, valuename, valuesource: string;
340begin
341 for i := 0 to alist.Count - 1 do
342 begin
343 valuesource := Piece(alist[i], '^', 1);
344 valuename := Piece(alist[i], '^', 2);
345 valueien := Piece(alist[i], '^', 3);
346 aListItem := lvwCombinations.Items.Add;
347 with aListItem do
348 begin
349 Caption := valuename;
350 SubItems.Add(valuesource);
351 end;
352 aCombination := TCombination.Create;
353 with aCombination do
354 begin
355 IEN := valueien;
356 Entry := valuename;
357 Source := valuesource;
358 end;
359 aListItem.SubItems.AddObject('combo object', aCombination);
360 end;
361end;
362
363procedure TfrmOptionsCombinations.FormShow(Sender: TObject);
364begin
365 LoadCombinations(rpcGetCombo);
366end;
367
368end.
Note: See TracBrowser for help on using the repository browser.