source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODAllgy.pas@ 471

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 21.4 KB
RevLine 
[453]1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODAllgy;
3//kt Note: This unit wasn't part of the the CPRS project for some reason. I added it.
4//
5{$O-}
6interface
7
8
9uses
10 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
11 Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
12 Menus, ORDtTm, Buttons, DKLang;
13
14type
15 TfrmODAllergy = class(TfrmODBase)
16 btnAgent: TSpeedButton;
17 cboReactionType: TORComboBox;
18 lblReactionType: TOROffsetLabel;
19 lblAgent: TOROffsetLabel;
20 lblSymptoms: TOROffsetLabel;
21 lblSelectedSymptoms: TOROffsetLabel;
22 grpObsHist: TRadioGroup;
23 memComments: TRichEdit;
24 lblComments: TOROffsetLabel;
25 lstSelectedSymptoms: TORListBox;
26 ckNoKnownAllergies: TCheckBox;
27 cboOriginator: TORComboBox;
28 lblOriginator: TOROffsetLabel;
29 Bevel1: TBevel;
30 lstAllergy: TORListBox;
31 cboSymptoms: TORComboBox;
32 dlgReactionDateTime: TORDateTimeDlg;
33 btnCurrent: TButton;
34 lblObservedDate: TOROffsetLabel;
35 calObservedDate: TORDateBox;
36 lblSeverity: TOROffsetLabel;
37 cboSeverity: TORComboBox;
38 btnRemove: TButton;
39 btnDateTime: TButton;
40 procedure btnAgentClick(Sender: TObject);
41 procedure FormCreate(Sender: TObject);
42 procedure cboOriginatorNeedData(Sender: TObject; const StartFrom: String;
43 Direction, InsertAt: Integer);
44 procedure cboSymptomsNeedData(Sender: TObject; const StartFrom: String;
45 Direction, InsertAt: Integer);
46 procedure lstAllergySelect(Sender: TObject);
47 procedure grpObsHistClick(Sender: TObject);
48 procedure ControlChange(Sender: TObject);
49 procedure memCommentsExit(Sender: TObject);
50 procedure cboSymptomsClick(Sender: TObject);
51 procedure FormDestroy(Sender: TObject);
52 procedure ckNoKnownAllergiesClick(Sender: TObject);
53 procedure EnableControls;
54 procedure DisableControls;
55 procedure cmdAcceptClick(Sender: TObject);
56 procedure btnCurrentClick(Sender: TObject);
57 procedure btnRemoveClick(Sender: TObject);
58 procedure lstAllergyClick(Sender: TObject);
59 procedure btnDateTimeClick(Sender: TObject);
60 procedure cboSymptomsKeyDown(Sender: TObject; var Key: Word;
61 Shift: TShiftState);
62 procedure cboSymptomsMouseClick(Sender: TObject);
63 procedure memCommentsKeyUp(Sender: TObject; var Key: Word;
64 Shift: TShiftState);
65 private
66 FLastAllergyID: string;
67 FNKAOrder: boolean;
68 protected
69 procedure InitDialog; override;
70 procedure Validate(var AnErrMsg: string); override;
71 public
72 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
73 end;
74
75var
76 frmODAllergy: TfrmODAllergy;
77 AllergyList: TStringList;
78
79implementation
80
81{$R *.DFM}
82
83uses
84 rODBase, uCore, rCore, rCover, rODAllergy, fAllgyFind, fPtCWAD;
85
86//const
87//TX_NO_ALLERGY = 'An allergy must be specified.' ; <-- original line. //kt 8/8/2007
88//TX_NO_REACTION = 'A reaction type must be entered for this allergy.' ; <-- original line. //kt 8/8/2007
89//TX_NO_SYMPTOMS = 'Symptoms must be selected for this observed allergy and reaction.'; <-- original line. //kt 8/8/2007
90//TX_NO_OBSERVER = 'An observer must be selected for this allergy and reaction .'; <-- original line. //kt 8/8/2007
91//TX_NO_FUTURE_DATES = 'Dates in the future are not allowed.'; <-- original line. //kt 8/8/2007
92//TX_BAD_DATE = 'Dates must be in the format m/d/y or m/y or y, or T-d.'; <-- original line. //kt 8/8/2007
93//TX_CAP_FUTURE = 'Invalid date'; <-- original line. //kt 8/8/2007
94
95var
96 TX_NO_ALLERGY : string; //kt
97 TX_NO_REACTION : string; //kt
98 TX_NO_SYMPTOMS : string; //kt
99 TX_NO_OBSERVER : string; //kt
100 TX_NO_FUTURE_DATES : string; //kt
101 TX_BAD_DATE : string; //kt
102 TX_CAP_FUTURE : string; //kt
103
104
105procedure SetupVars;
106//kt Added entire function to replace constant declarations 8/8/2007
107begin
108 TX_NO_ALLERGY := DKLangConstW('fODAllgy_An_allergy_must_be_specifiedx') ;
109 TX_NO_REACTION := DKLangConstW('fODAllgy_A_reaction_type_must_be_entered_for_this_allergyx') ;
110 TX_NO_SYMPTOMS := DKLangConstW('fODAllgy_Symptoms_must_be_selected_for_this_observed_allergy_and_reactionx');
111 TX_NO_OBSERVER := DKLangConstW('fODAllgy_An_observer_must_be_selected_for_this_allergy_and_reaction_x');
112 TX_NO_FUTURE_DATES := DKLangConstW('fODAllgy_Dates_in_the_future_are_not_allowedx');
113 TX_BAD_DATE := DKLangConstW('fODAllgy_Dates_must_be_in_the_format_mxdxy_or_mxy_or_yx_or_Txdx');
114 TX_CAP_FUTURE := DKLangConstW('fODAllgy_Invalid_date');
115end;
116
117procedure TfrmODAllergy.FormCreate(Sender: TObject);
118begin
119 inherited;
120 AllergyList := TStringList.Create;
121 AllowQuickOrder := False;
122 FillerID := 'GMRD'; // does 'on Display' order check **KCM**
123//StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
124 StatusText(DKLangConstW('fODAllgy_Loading_Dialog_Definition')); //kt added 8/8/2007
125 Responses.Dialog := 'GMRAOR ALLERGY ENTER/EDIT'; // loads formatting info
126//StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007
127 StatusText(DKLangConstW('fODAllgy_Loading_Default_Values')); //kt added 8/8/2007
128 CtrlInits.LoadDefaults(ODForAllergies); // returns TStrings with defaults
129//StatusText('Initializing Long List'); <-- original line. //kt 8/8/2007
130 StatusText(DKLangConstW('fODAllgy_Initializing_Long_List')); //kt added 8/8/2007
131//CtrlInits.SetControl(cboSymptoms, 'Top Ten'); <-- original line. //kt 8/8/2007
132 CtrlInits.SetControl(cboSymptoms, DKLangConstW('fODAllgy_Top_Ten')); //kt added 8/8/2007
133 cboSymptoms.InsertSeparator;
134 cboOriginator.InitLongList(User.Name) ;
135 cboOriginator.SelectByIEN(User.DUZ);
136 PreserveControl(cboSymptoms);
137 PreserveControl(cboOriginator);
138 InitDialog;
139 //kt 6/18/08 Removing. Why was this here??? --> btnAgentClick(Self);
140end;
141
142procedure TfrmODAllergy.InitDialog;
143begin
144 inherited;
145 Changing := True;
146 with CtrlInits do
147 begin
148// SetControl(cboReactionType, 'Reactions'); <-- original line. //kt 8/8/2007
149 SetControl(cboReactionType, DKLangConstW('fODAllgy_Reactions')); //kt added 8/8/2007
150// SetControl(cboSeverity, 'Severity'); <-- original line. //kt 8/8/2007
151 SetControl(cboSeverity, DKLangConstW('fODAllgy_Severity')); //kt added 8/8/2007
152 end;
153 lstAllergy.Items.Add('-1^Click button to search ---->');
154 grpObsHist.ItemIndex := 1;
155 calObservedDate.Text := ''; //FMDateTime := FMNow;
156 cboSeverity.ItemIndex := -1;
157 cboSymptoms.ItemIndex := -1;
158 memComments.Clear;
159 ListAllergies(AllergyList);
160 with AllergyList do
161 if Count > 0 then
162 begin
163 if Piece(Strings[0], U, 1) = '' then
164 ckNoKnownAllergies.Enabled := True
165 else
166 ckNoKnownAllergies.Enabled := False;
167 end
168 else
169 ckNoKnownAllergies.Enabled := True;
170 StatusText('');
171 memOrder.Clear ;
172 Changing := False;
173end;
174
175procedure TfrmODAllergy.SetupDialog(OrderAction: Integer; const ID: string);
176begin
177 inherited;
178 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
179 begin
180 SetControl(lstAllergy, 'ITEM', 1);
181 lstAllergySelect(Self);
182 Changing := True;
183 SetControl(cboReactionType, 'TYPE', 1);
184 SetControl(lstSelectedSymptoms, 'REACTION', 1); // need dates concatenated - see cboSymptomsClick
185 SetControl(grpObsHist, 'OBSERVED', 1);
186 SetControl(calObservedDate, 'START', 1);
187 SetControl(cboSeverity, 'SEVERITY', 1);
188 SetControl(memComments, 'COMMENT', 1);
189 SetControl(ckNoKnownAllergies, 'NKA', 1);
190 SetControl(cboOriginator, 'PROVIDER', 1);
191 Changing := False;
192 ControlChange(Self);
193 end;
194end;
195
196procedure TfrmODAllergy.Validate(var AnErrMsg: string);
197var
198 tmpDate: TFMDateTime;
199//const
200//TX_NO_LOCATION = 'A location must be identified.' + CRLF + <-- original line. //kt 8/8/2007
201// '(Select File | Update Provider/Location)'; <-- original line. //kt 8/8/2007
202//TX_NO_PROVIDER = 'A provider who is authorized to write orders must be indentified.' + CRLF + <-- original line. //kt 8/8/2007
203// '(Select File | Update Provider/Location)'; <-- original line. //kt 8/8/2007
204
205var
206 TX_NO_LOCATION : string; //kt
207 TX_NO_PROVIDER : string; //kt
208
209 procedure SetError(const x: string);
210 begin
211 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
212 AnErrMsg := AnErrMsg + x;
213 end;
214
215begin
216 SetupVars; //kt added 8/8/2007 to replace constants with vars.
217 TX_NO_LOCATION := DKLangConstW('fODAllgy_A_location_must_be_identifiedx') + CRLF + //kt added 8/8/2007
218 DKLangConstW('fODAllgy_xSelect_File_x_Update_ProviderxLocationx'); //kt added 8/8/2007
219 TX_NO_PROVIDER := DKLangConstW('fODAllgy_A_provider_who_is_authorized_to_write_orders_must_be_indentifiedx') + CRLF + //kt added 8/8/2007
220 DKLangConstW('fODAllgy_xSelect_File_x_Update_ProviderxLocationx'); //kt added 8/8/2007
221// inherited; v14a - do not reject past dates - historical would not be allowed
222 AnErrMsg := '';
223//if User.NoOrdering then AnErrMsg := 'Ordering has been disabled. Press Quit.'; <-- original line. //kt 8/8/2007
224 if User.NoOrdering then AnErrMsg := DKLangConstW('fODAllgy_Ordering_has_been_disabledx__Press_Quitx'); //kt added 8/8/2007
225 if not ckNoKnownAllergies.Checked then
226 begin
227 if lstAllergy.Items.Count = 0 then SetError(TX_NO_ALLERGY)
228 else if (Length(lstAllergy.DisplayText[0]) = 0) or
229 (Piece(lstAllergy.Items[0], U, 1) = '-1') then SetError(TX_NO_ALLERGY);
230 if (grpObsHist.ItemIndex = 0) and (lstSelectedSymptoms.Items.Count = 0) then SetError(TX_NO_SYMPTOMS);
231 if cboReactionType.ItemID = '' then
232 SetError(TX_NO_REACTION)
233 else
234 Responses.Update('TYPE', 1, cboReactionType.ItemID, cboReactionType.Text);
235 end;
236 if cboOriginator.ItemIEN = 0 then SetError(TX_NO_OBSERVER);
237 if calObservedDate.Text <> '' then
238 begin
239 tmpDate := ValidDateTimeStr(calObservedDate.Text, 'TS');
240 if tmpDate > FMNow then SetError(TX_NO_FUTURE_DATES);
241 if tmpDate < 0 then SetError(TX_BAD_DATE);
242 end;
243 if (Encounter.Location = 0) and not(Self.EvtID>0) then AnErrMsg := TX_NO_LOCATION;
244 if (Encounter.Provider = 0) or (PersonHasKey(Encounter.Provider, 'PROVIDER') = False)
245 then AnErrMsg := TX_NO_PROVIDER;
246end;
247
248procedure TfrmODAllergy.cboOriginatorNeedData(Sender: TObject;
249 const StartFrom: string; Direction, InsertAt: Integer);
250begin
251 inherited;
252 cboOriginator.ForDataUse(SubSetOfPersons(StartFrom, Direction));
253end;
254
255procedure TfrmODAllergy.cboSymptomsNeedData(Sender: TObject;
256 const StartFrom: string; Direction, InsertAt: Integer);
257begin
258 inherited;
259 cboSymptoms.ForDataUse(SubSetOfSymptoms(StartFrom, Direction));
260end;
261
262procedure TfrmODAllergy.grpObsHistClick(Sender: TObject);
263begin
264 inherited;
265 Changing := True;
266 cboSeverity.ItemIndex := -1;
267 case grpObsHist.ItemIndex of
268 0: begin
269 cboSeverity.Visible := True;
270 lblSeverity.Visible := True;
271 end;
272 1: begin
273 cboSeverity.Visible := False;
274 lblSeverity.Visible := False;
275 end;
276 end;
277 Changing := False;
278 ControlChange(Self);
279end;
280
281procedure TfrmODAllergy.ControlChange(Sender: TObject);
282var
283 i: integer;
284 tmpDate: TFMDateTime;
285begin
286 inherited;
287 if Changing then Exit;
288 Responses.Clear;
289 if ckNoKnownAllergies.Checked then
290 begin
291// Responses.Update('NKA', 1, 'NKA', 'No Known Allergies'); <-- original line. //kt 8/8/2007
292 Responses.Update(DKLangConstW('fODAllgy_NKA'), 1, DKLangConstW('fODAllgy_NKA'), DKLangConstW('fODAllgy_No_Known_Allergies')); //kt added 8/8/2007
293 with cboOriginator do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text);
294 end
295 else
296 with lstAllergy do
297 if (Items.Count > 0) then
298 if (Piece(Items[0], U, 1) <> '-1') and (Length(DisplayText[0]) > 0) then
299 begin
300 Responses.Update('ITEM', 1, DisplayText[0], DisplayText[0]);
301 with cboReactionType do if ItemID <> '' then Responses.Update('TYPE', 1, ItemID, Text);
302 with lstSelectedSymptoms do for i := 0 to Items.Count - 1 do
303 begin
304 Responses.Update('REACTION', i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
305 Responses.Update('REACTDT', i+1, Piece(Items[i],U,3), Piece(Items[i],U,4));
306 end;
307 with grpObsHist do if ItemIndex > -1 then
308// if ItemIndex = 0 then Responses.Update('OBSERVED', 1, 'o', 'Observed') <-- original line. //kt 8/8/2007
309 if ItemIndex = 0 then Responses.Update(DKLangConstW('fODAllgy_OBSERVED'), 1, 'o', DKLangConstW('fODAllgy_Observed')) //kt added 8/8/2007
310// else Responses.Update('OBSERVED', 1, 'h', 'Historical'); <-- original line. //kt 8/8/2007
311 else Responses.Update(DKLangConstW('fODAllgy_OBSERVED'), 1, 'h', DKLangConstW('fODAllgy_Historical')); //kt added 8/8/2007
312 with calObservedDate do
313 begin
314 tmpDate := ValidDateTimeStr(calObservedDate.Text, 'TS');
315 if tmpDate > 0 then Responses.Update('START', 1, FloatToStr(tmpDate), Text);
316 end;
317 with cboSeverity do if ItemID <> '' then Responses.Update('SEVERITY', 1, ItemID, Text);
318 with cboOriginator do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text);
319 with memComments do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
320 end;
321 memOrder.Text := Responses.OrderText;
322end;
323
324procedure TfrmODAllergy.lstAllergySelect(Sender: TObject);
325begin
326 inherited;
327 with lstAllergy do
328 begin
329 if Items.Count = 0 then
330 Exit
331 else if Piece(Items[0], U, 1) = '-1' then
332 Exit;
333 if Piece(Items[0], U, 1) <> FLastAllergyID then FLastAllergyID := Piece(Items[0], U, 1) else Exit;
334 Changing := True;
335 if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
336 Changing := False;
337 if CharAt(Piece(Items[0], U, 1), 1) = 'Q' then
338 begin
339 Responses.QuickOrder := ExtractInteger(Piece(Items[0], U, 1));
340 Responses.SetControl(lstAllergy, 'ITEM', 1);
341 FLastAllergyID := Piece(Items[0], U, 1);
342 end;
343 end;
344 with Responses do if QuickOrder > 0 then
345 begin
346 SetControl(lstAllergy, 'ITEM', 1);
347 lstAllergySelect(Self);
348 Changing := True;
349 SetControl(cboReactionType, 'TYPE', 1);
350 SetControl(lstSelectedSymptoms, 'REACTION', 1);
351 SetControl(grpObsHist, 'OBSERVED', 1);
352 SetControl(calObservedDate, 'START', 1);
353 SetControl(cboSeverity, 'SEVERITY', 1);
354 SetControl(memComments, 'COMMENT', 1);
355 SetControl(ckNoKnownAllergies, 'NKA', 1);
356 SetControl(cboOriginator, 'PROVIDER', 1);
357 end;
358 ControlChange(Self) ;
359end;
360
361procedure TfrmODAllergy.memCommentsExit(Sender: TObject);
362var
363 AStringList: TStringList;
364begin
365 inherited;
366 AStringList := TStringList.Create;
367 try
368 AStringList.Assign(memComments.Lines);
369 LimitStringLength(AStringList, 74);
370 memComments.Lines.Assign(AstringList);
371 ControlChange(Self);
372 finally
373 AStringList.Free;
374 end;
375end;
376
377procedure TfrmODAllergy.btnAgentClick(Sender: TObject);
378var
379 Allergy: string;
380begin
381 inherited;
382 AllergyLookup(Allergy, ckNoKnownAllergies.Enabled);
383 if Piece(Allergy, U, 1) = '-1' then
384 ckNoKnownAllergies.Checked := True
385 else
386 if Allergy <> '' then
387 begin
388 lstAllergy.Clear;
389 lstAllergy.Items.Add(Allergy);
390 cboReactionType.SelectByID(Piece(Allergy, U, 4));
391 end
392 else
393 Close;
394 ControlChange(lstAllergy);
395end;
396
397procedure TfrmODAllergy.cboSymptomsClick(Sender: TObject);
398begin
399 inherited;
400 if cboSymptoms.ItemIndex < 0 then exit;
401 Changing := True;
402 if lstSelectedSymptoms.SelectByID(cboSymptoms.ItemID) > -1 then exit;
403 with lstSelectedSymptoms do
404 begin
405 Items.Add(cboSymptoms.Items[cboSymptoms.ItemIndex]);
406 SelectByID(cboSymptoms.ItemID);
407 end;
408 Changing := False;
409 ControlChange(Self)
410end;
411
412procedure TfrmODAllergy.FormDestroy(Sender: TObject);
413begin
414 AllergyList.Free;
415 inherited;
416end;
417
418procedure TfrmODAllergy.ckNoKnownAllergiesClick(Sender: TObject);
419begin
420 inherited;
421 if ckNoKnownAllergies.Checked then
422 begin
423 DisableControls;
424 FNKAOrder := True;
425 end
426 else
427 begin
428 EnableControls;
429 FNKAOrder := False;
430 end;
431 ControlChange(Self);
432end;
433
434procedure TfrmODAllergy.DisableControls;
435begin
436 InitDialog;
437 btnAgent.Enabled := False;
438 cboReactionType.Enabled := False;
439 lblReactionType.Enabled := False;
440 lblAgent.Enabled := False;
441 lblSymptoms.Enabled := False;
442 lblSelectedSymptoms.Enabled := False;
443 grpObsHist.Enabled := False;
444 memComments.Enabled := False;
445 lblComments.Enabled := False;
446 lstSelectedSymptoms.Enabled := False;
447 lblObservedDate.Enabled := False;
448 calObservedDate.Enabled := False;
449 lblSeverity.Enabled := False;
450 cboSeverity.Enabled := False;
451 lstAllergy.Enabled := False;
452 cboSymptoms.Enabled := False;
453 btnDateTime.Enabled := False;
454end;
455
456procedure TfrmODAllergy.EnableControls;
457begin
458 InitDialog;
459 btnAgent.Enabled := True;
460 cboReactionType.Enabled := True;
461 lblReactionType.Enabled := True;
462 lblAgent.Enabled := True;
463 lblSymptoms.Enabled := True;
464 lblSelectedSymptoms.Enabled := True;
465 grpObsHist.Enabled := True;
466 memComments.Enabled := True;
467 lblComments.Enabled := True;
468 lstSelectedSymptoms.Enabled := True;
469 lblObservedDate.Enabled := True;
470 calObservedDate.Enabled := True;
471 lblSeverity.Enabled := True;
472 cboSeverity.Enabled := True;
473 lstAllergy.Enabled := True;
474 cboSymptoms.Enabled := True;
475 btnDateTime.Enabled := True;
476end;
477
478procedure TfrmODAllergy.cmdAcceptClick(Sender: TObject);
479begin
480 if not FNKAOrder then
481 inherited
482 else
483 if ValidSave then
484 begin
485 ckNoKnownAllergies.Checked := False;
486 memOrder.Clear;
487 Responses.Clear; // to allow form to close without prompting to save order
488 Close;
489 end;
490end;
491
492procedure TfrmODAllergy.btnCurrentClick(Sender: TObject);
493begin
494 inherited;
495 ShowCWAD;
496end;
497
498
499procedure TfrmODAllergy.btnRemoveClick(Sender: TObject);
500var
501 i: integer;
502begin
503 inherited;
504 with lstSelectedSymptoms do
505 begin
506 if (Items.Count = 0) or (ItemIndex = -1) then exit;
507 i := ItemIndex;
508 Items.Delete(ItemIndex);
509 ItemIndex := i - 1;
510 if (Items.Count > 0) and (ItemIndex = -1) then ItemIndex := 0;
511 end;
512end;
513
514procedure TfrmODAllergy.lstAllergyClick(Sender: TObject);
515begin
516 inherited;
517 lstAllergy.ItemIndex := -1;
518end;
519
520procedure TfrmODAllergy.btnDateTimeClick(Sender: TObject);
521begin
522 SetupVars; //kt added 8/8/2007 to replace constants with vars.
523 inherited;
524 with lstSelectedSymptoms do
525 begin
526 if (Items.Count = 0) or (ItemIndex = -1) then exit;
527 dlgReactionDateTime.FMDateTime := FMNow;
528 if not dlgReactionDateTime.Execute then exit;
529 if dlgReactionDateTime.FMDateTime > FMNow then
530 InfoBox(TX_NO_FUTURE_DATES, TX_CAP_FUTURE, MB_OK)
531 else
532 Items[ItemIndex] := Items[ItemIndex] + U + FloatToStr(dlgReactionDateTime.FMDateTime) + U + FormatFMDateTime('mmm dd,yyyy@hh:nn', dlgReactionDateTime.FMDateTime);
533 end;
534end;
535
536procedure TfrmODAllergy.cboSymptomsKeyDown(Sender: TObject; var Key: Word;
537 Shift: TShiftState);
538begin
539 inherited;
540 if Key = VK_RETURN then cboSymptomsMouseClick(Self);
541end;
542
543procedure TfrmODAllergy.cboSymptomsMouseClick(Sender: TObject);
544var
545 x: string;
546begin
547 inherited;
548 if cboSymptoms.ItemIndex < 0 then exit;
549 Changing := True;
550 if lstSelectedSymptoms.SelectByID(cboSymptoms.ItemID) > -1 then exit;
551 with cboSymptoms do
552 if Piece(Items[ItemIndex], U, 3) <> '' then
553 x := ItemID + U + Piece(Items[ItemIndex], U, 3)
554 else
555 x := ItemID + U + Piece(Items[ItemIndex], U, 2);
556 with lstSelectedSymptoms do
557 begin
558 Items.Add(x);
559 SelectByID(cboSymptoms.ItemID);
560 end;
561 Changing := False;
562 ControlChange(Self)
563end;
564
565procedure TfrmODAllergy.memCommentsKeyUp(Sender: TObject; var Key: Word;
566 Shift: TShiftState);
567begin
568 inherited;
569 if (Key = VK_TAB) then
570 begin
571 if ssShift in Shift then
572 begin
573 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
574 Key := 0;
575 end
576 else if ssCtrl in Shift then
577 begin
578 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
579 Key := 0;
580 end;
581 end;
582 if (key = VK_ESCAPE) then begin
583 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
584 key := 0;
585 end;
586end;
587
588end.
Note: See TracBrowser for help on using the repository browser.