source: cprs/trunk/CPRS-Chart/fLabTestGroups.pas@ 872

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

Upgrading to version 27
File size: 12.7 KB
Line 
1unit fLabTestGroups;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, Buttons, ORCtrls, StdCtrls, fBase508Form, VA508AccessibilityManager;
8
9type
10 TfrmLabTestGroups = class(TfrmBase508Form)
11 pnlLabTestGroups: TORAutoPanel;
12 cmdOK: TButton;
13 cmdCancel: TButton;
14 cmdClear: TButton;
15 cmdRemove: TButton;
16 lstList: TORListBox;
17 cboTests: TORComboBox;
18 cmdUp: TSpeedButton;
19 pnlUpButton: TKeyClickPanel;
20 cmdDown: TSpeedButton;
21 pnlDownButton: TKeyClickPanel;
22 bvlTestGroups: TBevel;
23 cboUsers: TORComboBox;
24 lstTestGroups: TORListBox;
25 cmdReplace: TButton;
26 lblTests: TLabel;
27 lblList: TLabel;
28 cboSpecimen: TORComboBox;
29 lblSpecimen: TLabel;
30 lblTestGroups: TLabel;
31 lblUsers: TLabel;
32 lblOrder: TLabel;
33 cmdDelete: TButton;
34 cmdAdd: TButton;
35 cmdAddTest: TButton;
36 lblDefine: TVA508StaticText;
37 lblTestGroup: TLabel;
38 procedure FormCreate(Sender: TObject);
39 procedure cboTestsNeedData(Sender: TObject; const StartFrom: string;
40 Direction, InsertAt: Integer);
41 procedure cmdOKClick(Sender: TObject);
42 procedure cmdClearClick(Sender: TObject);
43 procedure cmdRemoveClick(Sender: TObject);
44 procedure cmdUpClick(Sender: TObject);
45 procedure cmdDownClick(Sender: TObject);
46 procedure lstListClick(Sender: TObject);
47 procedure cboUsersNeedData(Sender: TObject; const StartFrom: string;
48 Direction, InsertAt: Integer);
49 procedure cboSpecimenNeedData(Sender: TObject; const StartFrom: string;
50 Direction, InsertAt: Integer);
51 procedure cboUsersClick(Sender: TObject);
52 procedure cmdReplaceClick(Sender: TObject);
53 procedure cmdAddClick(Sender: TObject);
54 procedure cmdDeleteClick(Sender: TObject);
55 procedure cboTestsChange(Sender: TObject);
56 procedure cboTestsEnter(Sender: TObject);
57 procedure cboTestsExit(Sender: TObject);
58 procedure cmdAddTestClick(Sender: TObject);
59 procedure pnlUpButtonEnter(Sender: TObject);
60 procedure pnlUpButtonExit(Sender: TObject);
61 procedure pnlDownButtonEnter(Sender: TObject);
62 procedure pnlDownButtonExit(Sender: TObject);
63 procedure pnlUpButtonResize(Sender: TObject);
64 procedure pnlDownButtonResize(Sender: TObject);
65 procedure lstTestGroupsChange(Sender: TObject);
66 private
67 { Private declarations }
68 procedure AddTests(tests: TStrings);
69 procedure TestGroupEnable;
70 public
71 { Public declarations }
72 end;
73
74procedure SelectTestGroups(FontSize: Integer);
75
76implementation
77
78uses fLabs, ORFn, rLabs, uCore, VAUtils, VA508AccessibilityRouter;
79
80{$R *.DFM}
81
82procedure SelectTestGroups(FontSize: Integer);
83var
84 frmLabTestGroups: TfrmLabTestGroups;
85 W, H: integer;
86begin
87 frmLabTestGroups := TfrmLabTestGroups.Create(Application);
88 try
89 with frmLabTestGroups do
90 begin
91 Font.Size := FontSize;
92 W := ClientWidth;
93 H := ClientHeight;
94 ResizeToFont(FontSize, W, H);
95 ClientWidth := W; pnlLabTestGroups.Width := W;
96 ClientHeight := H; pnlLabTestGroups.Height := H;
97 with lblTestGroup do begin
98 AutoSize := False;
99 Height := lstList.Height div 3;
100 Width := cmdAddTest.Width * 4 div 3;
101 AutoSize := True;
102 end;
103 with lblOrder do begin
104 AutoSize := False;
105 Height := lstList.Height div 3;
106 Width := cmdAddTest.Width div 2 + 10;
107 AutoSize := True;
108 end;
109 FastAssign(frmLabs.lstTests.Items, lstList.Items);
110 if lstList.Items.Count > 0 then lstList.ItemIndex := 0;
111 lstListClick(frmLabTestGroups);
112 ShowModal;
113 end;
114 finally
115 frmLabTestGroups.Release;
116 end;
117end;
118
119procedure TfrmLabTestGroups.FormCreate(Sender: TObject);
120var
121 i: integer;
122 blood, urine, serum, plasma: string;
123begin
124 RedrawSuspend(cboTests.Handle);
125 cboTests.InitLongList('');
126 RedrawActivate(cboTests.Handle);
127 RedrawSuspend(cboSpecimen.Handle);
128 cboSpecimen.InitLongList('');
129 SpecimenDefaults(blood, urine, serum, plasma);
130 cboSpecimen.Items.Add('0^Any');
131 cboSpecimen.Items.Add(serum + '^Serum');
132 cboSpecimen.Items.Add(blood + '^Blood');
133 cboSpecimen.Items.Add(plasma + '^Plasma');
134 cboSpecimen.Items.Add(urine + '^Urine');
135 cboSpecimen.Items.Add(LLS_LINE);
136 cboSpecimen.Items.Add(LLS_SPACE);
137 cboSpecimen.ItemIndex := 0;
138 RedrawActivate(cboSpecimen.Handle);
139 RedrawSuspend(cboTests.Handle);
140 cboUsers.InitLongList(User.Name);
141 for i := 0 to cboUsers.Items.Count - 1 do
142 if StrToInt64Def(Piece(cboUsers.Items[i], '^', 1), 0) = User.DUZ then
143 begin
144 cboUsers.ItemIndex := i;
145 break;
146 end;
147 if cboUsers.ItemIndex > -1 then cboUsersClick(self);
148 RedrawActivate(cboTests.Handle);
149 cmdUp.Enabled := false;
150 pnlUpButton.TabStop := false;
151 cmdDown.Enabled := false;
152 pnlDownButton.TabStop := false;
153 lstList.Clear;
154end;
155
156procedure TfrmLabTestGroups.cboTestsNeedData(Sender: TObject;
157 const StartFrom: string; Direction, InsertAt: Integer);
158begin
159 cboTests.ForDataUse(ChemTest(StartFrom, Direction));
160end;
161
162procedure TfrmLabTestGroups.cmdOKClick(Sender: TObject);
163begin
164 if lstList.Items.Count = 0 then
165 ShowMsg('No tests were selected.')
166 else
167 begin
168 FastAssign(lstList.Items, frmLabs.lstTests.Items);
169 frmLabs.lblSpecimen.Caption := cboSpecimen.Items[cboSpecimen.ItemIndex];
170 Close;
171 end;
172end;
173
174procedure TfrmLabTestGroups.cmdClearClick(Sender: TObject);
175begin
176 lstList.Clear;
177 lstListClick(self);
178end;
179
180procedure TfrmLabTestGroups.cmdRemoveClick(Sender: TObject);
181var
182 newindex: integer;
183begin
184 if lstList.Items.Count > 0 then
185 begin
186 if lstList.ItemIndex = (lstList.Items.Count -1 ) then
187 newindex := lstList.ItemIndex - 1
188 else
189 newindex := lstList.ItemIndex;
190 lstList.Items.Delete(lstList.ItemIndex);
191 if lstList.Items.Count > 0 then lstList.ItemIndex := newindex;
192 end;
193 lstListClick(self);
194end;
195
196procedure TfrmLabTestGroups.cmdUpClick(Sender: TObject);
197var
198 newindex: integer;
199 templine: string;
200begin
201 if cmdUp.Enabled then begin
202 newindex := lstList.ItemIndex - 1;
203 templine := lstList.Items[lstList.ItemIndex - 1];
204 lstList.Items[lstList.ItemIndex - 1] := lstList.Items[lstList.ItemIndex];
205 lstList.Items[lstList.ItemIndex] := templine;
206 lstList.ItemIndex := newindex;
207 lstListClick(self);
208 if ScreenReaderSystemActive then
209 GetScreenReader.Speak('Test Moved Up');
210 end;
211end;
212
213procedure TfrmLabTestGroups.cmdDownClick(Sender: TObject);
214var
215 newindex: integer;
216 templine: string;
217begin
218 if cmdDown.Enabled then begin
219 newindex := lstList.ItemIndex + 1;
220 templine := lstList.Items[lstList.ItemIndex + 1];
221 lstList.Items[lstList.ItemIndex + 1] := lstList.Items[lstList.ItemIndex];
222 lstList.Items[lstList.ItemIndex] := templine;
223 lstList.ItemIndex := newindex;
224 lstListClick(self);
225 if ScreenReaderSystemActive then
226 GetScreenReader.Speak('Test Moved Down');
227 end;
228end;
229
230procedure TfrmLabTestGroups.lstListClick(Sender: TObject);
231begin
232 cmdUp.Enabled := not (lstList.ItemIndex = 0);
233 pnlUpButton.TabStop := not (lstList.ItemIndex = 0);
234 cmdDown.Enabled := not (lstList.ItemIndex = lstList.Items.Count - 1);
235 pnlDownButton.TabStop := not (lstList.ItemIndex = lstList.Items.Count - 1);
236 if lstList.Items.Count = 0 then
237 begin
238 cmdUp.Enabled := false;
239 pnlUpButton.TabStop := false;
240 cmdDown.Enabled := false;
241 pnlDownButton.TabStop := false;
242 cmdClear.Enabled := false;
243 cmdRemove.Enabled := false;
244 end
245 else
246 begin
247 cmdClear.Enabled := true;
248 cmdRemove.Enabled := true;
249 end;
250 TestGroupEnable;
251end;
252
253procedure TfrmLabTestGroups.cboUsersNeedData(Sender: TObject;
254 const StartFrom: string; Direction, InsertAt: Integer);
255begin
256 cboUsers.ForDataUse(Users(StartFrom, Direction));
257end;
258
259procedure TfrmLabTestGroups.cboSpecimenNeedData(Sender: TObject;
260 const StartFrom: string; Direction, InsertAt: Integer);
261begin
262 cboSpecimen.ForDataUse(Specimens(StartFrom, Direction));
263end;
264
265procedure TfrmLabTestGroups.cboUsersClick(Sender: TObject);
266begin
267 FastAssign(TestGroups(cboUsers.ItemIEN), lstTestGroups.Items);
268 TestGroupEnable;
269end;
270
271procedure TfrmLabTestGroups.AddTests(tests: TStrings);
272var
273 i, j, textindex: integer;
274 ok: boolean;
275begin
276 textindex := lstList.Items.Count;
277 for i := 0 to tests.Count - 1 do
278 begin
279 ok := true;
280 for j := 0 to lstList.Items.Count - 1 do
281 if lstList.Items[j] = tests[i] then
282 begin
283 ok := false;
284 textindex := j;
285 end;
286 if ok then
287 begin
288 lstList.Items.Add(tests[i]);
289 textindex := lstList.Items.Count - 1;
290 end;
291 end;
292 lstList.ItemIndex := textindex;
293 lstListClick(self);
294end;
295
296procedure TfrmLabTestGroups.lstTestGroupsChange(Sender: TObject);
297begin
298 if lstTestGroups.ItemIEN > 0 then
299 begin
300 AddTests(ATestGroup(lstTestGroups.ItemIEN, cboUsers.ItemIEN));
301 end;
302end;
303
304procedure TfrmLabTestGroups.TestGroupEnable;
305begin
306 cmdAdd.Enabled := (lstList.Items.Count > 0) and (lstList.Items.Count < 8);
307 cmdDelete.Enabled := (cboUsers.ItemIEN = User.DUZ) and (lstTestGroups.ItemIndex > -1);
308 cmdReplace.Enabled := cmdAdd.Enabled and cmdDelete.Enabled;
309end;
310
311procedure TfrmLabTestGroups.cmdReplaceClick(Sender: TObject);
312var
313 text: string;
314 i: integer;
315begin
316 text := 'Do you want to REPLACE your test group -' + #13 + ' ';
317 text := text + lstTestGroups.DisplayText[lstTestGroups.ItemIndex] + #13;
318 text := text + ' with:' + #13 + ' ';
319 for i := 0 to lstList.Items.Count -1 do
320 text := text + lstList.DisplayText[i] + #13 + ' ';
321 if InfoBox(text,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
322 begin
323 UTGReplace(lstList.Items, lstTestGroups.ItemIEN); //Show508Message('Replace'); //Replace
324 if ScreenReaderSystemActive then
325 GetScreenReader.Speak('test group replaced');
326 end;
327 cboUsersClick(self);
328 lstTestGroups.SetFocus;
329end;
330
331procedure TfrmLabTestGroups.cmdAddClick(Sender: TObject);
332var
333 text: string;
334 i: integer;
335begin
336 text := 'Do you wish to create a NEW test group with these tests: ' + #13 + ' ';
337 for i := 0 to lstList.Items.Count -1 do
338 text := text + lstList.DisplayText[i] + #13 + ' ';
339 if InfoBox(text,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
340 begin
341 UTGAdd(lstList.Items);
342 if ScreenReaderSystemActive then
343 GetScreenReader.Speak('New test group created');
344 cboUsers.InitLongList(User.Name);
345 for i := 0 to cboUsers.Items.Count - 1 do
346 if StrToInt64Def(Piece(cboUsers.Items[i], '^', 1), 0) = User.DUZ then
347 begin
348 cboUsers.ItemIndex := i;
349 break;
350 end;
351 end;
352 if cboUsers.ItemIndex > -1 then cboUsersClick(self);
353 lstTestGroups.SetFocus;
354end;
355
356procedure TfrmLabTestGroups.cmdDeleteClick(Sender: TObject);
357var
358 text: string;
359 i: integer;
360begin
361 text := 'Do you wish to DELETE your test group:' + #13 + ' ';
362 text := text + lstTestGroups.DisplayText[lstTestGroups.ItemIndex] + #13 + ' ';
363 if InfoBox(text,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
364 begin
365 UTGDelete(lstTestGroups.ItemIEN);
366 if ScreenReaderSystemActive then
367 GetScreenReader.Speak('Test group deleted');
368 cboUsers.Text := '';
369 lstTestGroups.Clear;
370 cboUsers.InitLongList(User.Name);
371 for i := 0 to cboUsers.Items.Count - 1 do
372 if StrToInt64Def(Piece(cboUsers.Items[i], '^', 1), 0) = User.DUZ then
373 begin
374 cboUsers.ItemIndex := i;
375 break;
376 end;
377 end;
378 if cboUsers.ItemIndex > -1 then cboUsersClick(self);
379 lstTestGroups.SetFocus;
380end;
381
382procedure TfrmLabTestGroups.cboTestsChange(Sender: TObject);
383begin
384 cmdAddTest.Enabled := cboTests.ItemIndex > -1;
385end;
386
387procedure TfrmLabTestGroups.cboTestsEnter(Sender: TObject);
388begin
389 cmdAddTest.Default := true;
390end;
391
392procedure TfrmLabTestGroups.cboTestsExit(Sender: TObject);
393begin
394 cmdAddTest.Default := false;
395end;
396
397procedure TfrmLabTestGroups.cmdAddTestClick(Sender: TObject);
398begin
399 AddTests(ATest(cboTests.ItemIEN));
400end;
401
402procedure TfrmLabTestGroups.pnlUpButtonEnter(Sender: TObject);
403begin
404 pnlUpButton.BevelOuter := bvLowered;
405end;
406
407procedure TfrmLabTestGroups.pnlUpButtonExit(Sender: TObject);
408begin
409 pnlUpButton.BevelOuter := bvNone;
410end;
411
412procedure TfrmLabTestGroups.pnlDownButtonEnter(Sender: TObject);
413begin
414 pnlDownButton.BevelOuter := bvLowered;
415end;
416
417procedure TfrmLabTestGroups.pnlDownButtonExit(Sender: TObject);
418begin
419 pnlDownButton.BevelOuter := bvNone;
420end;
421
422procedure TfrmLabTestGroups.pnlUpButtonResize(Sender: TObject);
423begin
424 cmdUp.Width := pnlUpButton.Width;
425end;
426
427procedure TfrmLabTestGroups.pnlDownButtonResize(Sender: TObject);
428begin
429 cmdDown.Width := pnlDownButton.Width;
430end;
431
432end.
Note: See TracBrowser for help on using the repository browser.