source: cprs/trunk/CPRS-Chart/fARTAllgy.pas@ 1693

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

Updating the working copy to CPRS version 28
File size: 43.1 KB
Line 
1unit fARTAllgy;
2
3interface
4
5uses
6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7 Forms, Dialogs, StdCtrls, ORCtrls, ORfn, ExtCtrls, ComCtrls, uConst,
8 Menus, ORDtTm, Buttons, fODBase, fAutoSz, fOMAction, rODAllergy,
9 VA508AccessibilityManager;
10
11type
12 TfrmARTAllergy = class(TfrmOMAction)
13 pnlBase: TORAutoPanel;
14 cmdOK: TButton;
15 cmdCancel: TButton;
16 pgAllergy: TPageControl;
17 tabGeneral: TTabSheet;
18 tabVerify: TTabSheet;
19 ckNoKnownAllergies: TCheckBox;
20 btnCurrent: TButton;
21 lblAgent: TOROffsetLabel;
22 lstAllergy: TORListBox;
23 btnAgent1: TSpeedButton;
24 lblOriginator: TOROffsetLabel;
25 cboOriginator: TORComboBox;
26 lblOriginateDate: TOROffsetLabel;
27 calOriginated: TORDateBox;
28 ckChartMarked: TCheckBox;
29 ckIDBand: TCheckBox;
30 lblVerifier: TOROffsetLabel;
31 ckVerified: TCheckBox;
32 cboVerifier: TORComboBox;
33 calVerifyDate: TORDateBox;
34 lblVerifyDate: TOROffsetLabel;
35 Bevel1: TBevel;
36 lblSymptoms: TOROffsetLabel;
37 cboSymptoms: TORComboBox;
38 lblSelectedSymptoms: TOROffsetLabel;
39 lstSelectedSymptoms: TORListBox;
40 btnRemove: TButton;
41 grpObsHist: TRadioGroup;
42 lblSeverity: TOROffsetLabel;
43 cboSeverity: TORComboBox;
44 lblObservedDate: TOROffsetLabel;
45 calObservedDate: TORDateBox;
46 cmdPrevObs: TButton;
47 lblComments: TOROffsetLabel;
48 memComments: TRichEdit;
49 cmdPrevCmts: TButton;
50 tabEnteredInError: TTabSheet;
51 ckEnteredInError: TCheckBox;
52 memErrCmts: TRichEdit;
53 lblErrCmts: TLabel;
54 lblEnteredInError: TLabel;
55 lblAllergyType: TOROffsetLabel;
56 cboAllergyType: TORComboBox;
57 cboNatureOfReaction: TORComboBox;
58 lblNatureOfReaction: TOROffsetLabel;
59 btnSevHelp: TORAlignButton;
60 VA508ComponentAccessibility1: TVA508ComponentAccessibility;
61 VA508ComponentAccessibility2: TVA508ComponentAccessibility;
62 origlbl508: TVA508StaticText;
63 origdtlbl508: TVA508StaticText;
64 SymptomDateBox: TORDateBox;
65 btnAgent: TButton;
66 VA508ComponentAccessibility3: TVA508ComponentAccessibility;
67 NoAllergylbl508: TVA508StaticText;
68 procedure btnAgent1Click(Sender: TObject);
69 procedure FormCreate(Sender: TObject);
70 procedure cboOriginatorNeedData(Sender: TObject; const StartFrom: String;
71 Direction, InsertAt: Integer);
72 procedure cboSymptomsNeedData(Sender: TObject; const StartFrom: String;
73 Direction, InsertAt: Integer);
74 procedure lstAllergySelect(Sender: TObject);
75 procedure grpObsHistClick(Sender: TObject);
76 procedure ControlChange(Sender: TObject);
77 procedure memCommentsExit(Sender: TObject);
78 procedure cboSymptomsClick(Sender: TObject);
79 procedure FormDestroy(Sender: TObject);
80 procedure ckNoKnownAllergiesClick(Sender: TObject);
81 procedure cmdOKClick(Sender: TObject);
82 procedure btnCurrentClick(Sender: TObject);
83 procedure btnRemoveClick(Sender: TObject);
84 procedure lstAllergyClick(Sender: TObject);
85 procedure cboSymptomsMouseClick(Sender: TObject);
86 procedure cboSymptomsKeyDown(Sender: TObject; var Key: Word;
87 Shift: TShiftState);
88 procedure cmdCancelClick(Sender: TObject);
89 procedure cmdPrevCmtsClick(Sender: TObject);
90 procedure cmdPrevObsClick(Sender: TObject);
91 procedure lstSelectedSymptomsChange(Sender: TObject);
92 procedure cboVerifierNeedData(Sender: TObject; const StartFrom: String;
93 Direction, InsertAt: Integer);
94 procedure FormClose(Sender: TObject; var Action: TCloseAction);
95 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
96 procedure btnSevHelpClick(Sender: TObject);
97 procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
98 var Text: string);
99 procedure VA508ComponentAccessibility2ValueQuery(Sender: TObject;
100 var Text: string);
101 procedure VA508ComponentAccessibility2StateQuery(Sender: TObject;
102 var Text: string);
103 procedure VA508ComponentAccessibility2ItemInstructionsQuery(Sender: TObject;
104 var Text: string);
105 procedure VA508ComponentAccessibility2ItemQuery(Sender: TObject;
106 var Item: TObject);
107 procedure VA508ComponentAccessibility2InstructionsQuery(Sender: TObject;
108 var Text: string);
109 procedure VA508ComponentAccessibility2ComponentNameQuery(Sender: TObject;
110 var Text: string);
111 procedure VA508ComponentAccessibility2CaptionQuery(Sender: TObject;
112 var Text: string);
113 procedure SymptomDateBoxExit(Sender: TObject);
114 procedure SymptomDateBoxDateDialogClosed(Sender: TObject);
115 procedure calObservedDateExit(Sender: TObject);
116 procedure VA508ComponentAccessibility3StateQuery(Sender: TObject;
117 var Text: string);
118 procedure memErrCmtsExit(Sender: TObject);
119 private
120 FLastAllergyID: string;
121 FEditAllergyIEN: integer;
122 FNKAOrder: boolean;
123 FChanged: Boolean;
124 FOldHintPause : integer;
125 procedure SetDate;
126 protected
127 procedure EnableDisableControls(EnabledStatus: boolean);
128 procedure InitDialog; override;
129 procedure Validate(var AnErrMsg: string);
130 function ValidSave: Boolean;
131 procedure SetupDialog;
132 procedure SetupVerifyFields(ARec: TAllergyRec);
133 procedure SetUpEnteredInErrorFields(ARec: TAllergyRec);
134 end;
135
136function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean; AnOwner: TComponent = nil; ARefNum: Integer = -1): boolean;
137function MarkEnteredInError(AllergyIEN: integer): boolean;
138function EnterNKAForPatient: boolean;
139
140var
141 frmARTAllergy: TfrmARTAllergy;
142 AllergyList: TStringList;
143 OldRec, NewRec: TAllergyRec;
144 Defaults: TStringList;
145 Changing: Boolean;
146 FAbort: Boolean;
147 uAddingNew: boolean = FALSE;
148 uEditing: Boolean = FALSE;
149 uEnteredInError: Boolean = FALSE;
150 uUserCanVerify: boolean = FALSE;
151 uDeletedSymptoms: TStringList;
152
153implementation
154
155{$R *.DFM}
156
157uses
158 rODBase, uCore, rCore, rCover, fCover, fAllgyFind, fPtCWAD, fRptBox, VA508AccessibilityRouter;
159
160const
161 TX_NO_ALLERGY = 'A causative agent must be specified.' ;
162 TX_NO_ALLGYTYPE = 'An allergy type must be entered for this causative agent.' ;
163 TX_NO_NATURE_OF_REACTION = 'A Nature of Reaction must be entered for this causative agent.' ;
164 TX_NO_SYMPTOMS = 'Symptoms must be selected for this observed allergy and reaction.';
165 TX_NO_OBSERVER = 'An observer must be selected for this allergy and reaction .';
166 TX_NO_ORIGINATOR = 'An originator must be selected for this allergy and reaction .';
167 TX_NO_FUTURE_DATES = 'Reaction dates in the future are not allowed.';
168 TX_BAD_OBS_DATE = 'Observation date must be in the format m/d/y or m/y or y, or T-d.';
169 TX_MISSING_OBS_DATE = 'Observation date is required for observed reactions.';
170 TX_MISSING_OBS_HIST = 'You must select either OBSERVED or HISTORICAL for this reaction.';
171 TX_BAD_VER_DATE = 'Verify date must be in the format m/d/y or m/y or y, or T-d.';
172 TX_BAD_ORIG_DATE = 'Origination date must be in the format m/d/y or m/y or y, or T-d.';
173 TX_NO_FUTURE_ORIG_DATES = 'An origination date in the future is not allowed.';
174 TX_MISSING_ORIG_DATE = 'Origination date is required.';
175 TX_CAP_FUTURE = 'Invalid date';
176 TX_NO_SAVE = 'This item cannot be saved for the following reason(s):' + CRLF + CRLF;
177 TX_NO_SAVE_CAP = 'Unable to Save Allergy/Adverse Reaction';
178 TX_SAVE_ERR = 'Unexpected error - it was not possible to save this request.';
179 TX_CAP_EDITING = 'Edit Allergy/Adverse Reaction';
180 TX_STS_EDITING = 'Loading Allergy/Adverse Reaction for Edit';
181 TX_CAP_ERROR = 'Mark Allergy/Adverse Reaction Entered In Error';
182 TX_STS_ERROR = 'Loading Allergy/Adverse Reaction';
183 TX_ORIG_CMTS_REQD = 'Comments are required for ''Observed'' reactions.';
184 TX_EDIT_ERROR = 'Unable to load record for editing';
185 TC_EDIT_ERROR = 'Error Encountered';
186 TX_NKA_SUCCESS = 'Patient''s record has been updated.';
187 TC_NKA_SUCCESS = 'No Known Allergies';
188 TX_OBHX_HINT = 'OBSERVED: directly observed or occurring while the patient was' + CRLF +
189 'on the suspected causative agent. Use for new information about' + CRLF +
190 'an allergy/adverse reaction and for recent reactions caused by' + CRLF +
191 'VA-prescribed medications.' + CRLF + CRLF +
192 'HISTORICAL: reported by the patient as occurring in the past;' + CRLF +
193 'no longer requires intervention' ;
194
195 NEW_ALLERGY = True;
196 ENTERED_IN_ERROR = True;
197
198function EnterNKAForPatient: boolean;
199var
200 x: string;
201begin
202 x := RPCEnterNKAForPatient;
203 if not (Piece(x, U, 1) = '0') then
204 InfoBox(Piece(x, U, 2), TC_EDIT_ERROR, MB_ICONERROR or MB_OK)
205 else
206 InfoBox(TX_NKA_SUCCESS, TC_NKA_SUCCESS, MB_ICONINFORMATION or MB_OK);
207 Result := (Piece(x, U, 1) = '0');
208end;
209
210function MarkEnteredInError(AllergyIEN: integer): boolean;
211begin
212 Result := EnterEditAllergy(AllergyIEN, not NEW_ALLERGY, ENTERED_IN_ERROR);
213end;
214
215function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean; AnOwner: TComponent = nil; ARefNum: Integer = -1): boolean;
216var
217 Allergy: string;
218begin
219 Result := False;
220 if AnOwner = nil then AnOwner := Application;
221
222 if frmARTAllergy <> nil then
223 begin
224 InfoBox('You are already entering/editing an Allergy.', 'Information', MB_OK);
225 exit;
226 end;
227 uAddingNew := AddNew;
228 uEditing := (not AddNew) and (not MarkAsEnteredInError);
229 uEnteredInError := MarkAsEnteredInError;
230 frmARTAllergy := TfrmARTAllergy.Create(AnOwner);
231 if ARefNum <> -1 then frmARTAllergy.RefNum := ARefNum;
232 if frmARTAllergy.AbortAction then exit;
233 with frmARTAllergy do
234 try
235 ResizeFormToFont(TForm(frmARTAllergy));
236 FChanged := False;
237 Changing := True;
238 if uEditing then
239 begin
240 frmARTAllergy.Caption := TX_CAP_EDITING;
241 FEditAllergyIEN := AllergyIEN;
242 if FEditAllergyIEN = 0 then exit;
243 StatusText(TX_STS_EDITING);
244 OldRec := LoadAllergyForEdit(FEditAllergyIEN);
245 NewRec.IEN := OldRec.IEN;
246 SetupDialog;
247 end
248 else if uEnteredInError then
249 begin
250 frmARTAllergy.Caption := TX_CAP_ERROR;
251 FEditAllergyIEN := AllergyIEN;
252 if FEditAllergyIEN = 0 then exit;
253 StatusText(TX_STS_ERROR);
254 OldRec := LoadAllergyForEdit(FEditAllergyIEN);
255 NewRec.IEN := OldRec.IEN;
256 SetupDialog;
257 end
258 else if uAddingNew then
259 begin
260 SetupVerifyFields(NewRec);
261 SetupEnteredInErrorFields(NewRec);
262 AllergyLookup(Allergy, ckNoKnownAllergies.Enabled);
263 if Piece(Allergy, U, 1) = '-1' then
264 begin
265 ckNoKnownAllergies.Checked := True;
266 Result := EnterNKAForPatient;
267 frmARTAllergy.Close;
268 Exit;
269 end
270 else if Allergy <> '' then
271 begin
272 lstAllergy.Clear;
273 lstAllergy.Items.Add(Allergy);
274 cboAllergyType.SelectByID(Piece(Allergy, U, 4));
275 end
276 else
277 begin
278 Result := False;
279 Close;
280 exit;
281 end;
282 calOriginated.FMDateTime := FMNow;
283 Changing := False;
284 ControlChange(lstAllergy);
285 end;
286 StatusText('');
287 if OldRec.IEN = -1 then
288 begin
289 Result := False;
290 Close;
291 Exit;
292 end;
293
294 origlbl508.Caption := 'Originator. Read Only. Value is ' + cboOriginator.SelText;
295 origdtlbl508.Caption := 'Origination Date. Read Only. Value is '+ calOriginated.Text;
296 Show;
297 Result := FChanged;
298 finally
299// uAddingNew := FALSE;
300// uEditing := FALSE;
301// uEnteredInError := FALSE;
302// uUserCanVerify := FALSE;
303 //frmARTAllergy.Release;
304 end;
305end;
306
307procedure TfrmARTAllergy.FormCreate(Sender: TObject);
308begin
309 inherited; // what to do here? How to set up dialog defaults without order dialog to supply prompts?
310 Changing := True;
311 FAbort := True;
312 AbortAction := False;
313 AllergyList := TStringList.Create;
314 uDeletedSymptoms := TStringList.Create;
315 FillChar(OldRec, SizeOf(OldRec), 0);
316 FillChar(NewRec, SizeOf(NewRec), 0);
317 with NewRec do
318 begin
319 SignsSymptoms := TStringList.Create ;
320 IDBandMarked := TStringList.Create;
321 ChartMarked := TStringList.Create;
322 Observations := TStringList.Create;
323 Comments := TStringList.Create ;
324 NewComments := TStringList.Create ;
325 ErrorComments := TStringList.Create ;
326 end;
327 Defaults := TStringList.Create;
328 StatusText('Loading Default Values');
329 uUserCanVerify := FALSE; //HasSecurityKey('GMRA-ALLERGY VERIFY');
330 FastAssign(ODForAllergies, Defaults);
331 StatusText('Initializing Long List');
332 ExtractItems(cboSymptoms.Items, Defaults, 'Top Ten');
333 if ScreenReaderSystemActive then cboSymptoms.Items.Add('^----Separator for end of Top Ten signs and symptoms------')
334 else cboSymptoms.InsertSeparator;
335 cboSymptoms.InitLongList('');
336 cboOriginator.InitLongList(User.Name) ;
337 cboOriginator.SelectByIEN(User.DUZ);
338 pgAllergy.ActivePage := tabGeneral;
339 InitDialog;
340 Changing := False;
341 if AbortAction then
342 begin
343 Close;
344 Exit;
345 end;
346end;
347
348procedure TfrmARTAllergy.InitDialog;
349var
350 Allergy: string;
351 i: Integer;
352 //ErrMsg: string;
353begin
354 inherited;
355 // since this only allows entry of new allergies, key check is irrelevant, eff. v26.12
356(* if not IsARTClinicalUser(ErrMsg) then
357 begin
358 InfoBox(ErrMsg, 'No Authorization', MB_ICONWARNING or MB_OK);
359 AbortAction := True;
360 Close;
361 Exit;
362 end;*)
363 Changing := True;
364 FOldHintPause := Application.HintHidePause;
365 Application.HintHidePause := 15000;
366 ExtractItems(cboAllergyType.Items, Defaults, 'Allergy Types');
367 ExtractItems(cboSeverity.Items, Defaults, 'Severity');
368 ExtractItems(cboNatureOfReaction.Items, Defaults, 'Nature of Reaction');
369 lstAllergy.Items.Add('-1^Click button to search ---->');
370 grpObsHist.ItemIndex := -1; // CQ 11775 - v27.10 - RV (was '1')
371 calObservedDate.Text := '';
372 cboSeverity.ItemIndex := -1;
373 cboSeverity.Visible := False;
374 lblSeverity.Visible := False;
375 btnSevHelp.Visible := False;
376 calObservedDate.Visible := False;
377 lblObservedDate.Visible := False;
378 cboSymptoms.ItemIndex := -1;
379 memComments.Clear;
380 cmdPrevCmts.Visible := (uEditing and (OldRec.Comments <> nil) and (OldRec.Comments.Text <> ''));
381 cmdPrevObs.Visible := (uEditing and (OldRec.Observations <> nil) and (OldRec.Observations.Text <> ''));
382 btnAgent.Enabled := (not uEditing) and (not uEnteredInError);
383 ckEnteredInError.Enabled := uEditing or uEnteredInError;
384 grpObsHist.Enabled := (not uEditing) and (not uEnteredInError);
385 grpObsHist.Hint := TX_OBHX_HINT;
386 grpObsHist.ShowHint := grpObsHist.Enabled;
387 ckIDBand.Enabled := Patient.Inpatient and MarkIDBand;
388 ckChartMarked.Checked := ckChartMarked.Checked or uAddingNew;
389 ListAllergies(AllergyList);
390 for i:=0 to grpObsHist.ControlCount -1 do
391 TWinControl(grpObsHist.Controls[i]).TabStop := true;
392 with AllergyList do
393 if Count > 0 then
394 begin
395 if (Piece(Strings[0], U, 1) = '') and (Piece(Strings[0], U, 2) <> 'No Known Allergies') then
396 begin
397 ckNoKnownAllergies.Enabled := True;
398 //TDP - CQ#19731 make sure NoAllergylbl508 is not enabled or visible if
399 // ckNoKnownAllergies is enabled
400 NoAllergylbl508.Enabled := False;
401 NoAllergylbl508.Visible := False;
402 end
403 else
404 begin
405 ckNoKnownAllergies.Enabled := False;
406 btnCurrent.Enabled := True;
407 //TDP - CQ#19731 make sure NoAllergylbl508 is enabled and visible if
408 // ckNoKnownAllergies is disabled
409 if ScreenReaderSystemActive then
410 begin
411 NoAllergylbl508.Enabled := True;
412 NoAllergylbl508.Visible := True;
413 end;
414 end;
415 end
416 else
417 begin
418 btnCurrent.Enabled := False;
419 ckNoKnownAllergies.Enabled := True;
420 //TDP - CQ#19731 make sure NoAllergylbl508 is not enabled or visible if
421 // ckNoKnownAllergies is enabled
422 NoAllergylbl508.Enabled := False;
423 NoAllergylbl508.Visible := False;
424 end;
425 if (not uEditing) and (not uEnteredInError) and (not uAddingNew) then
426 begin
427 SetupVerifyFields(NewRec);
428 SetupEnteredInErrorFields(NewRec);
429 AllergyLookup(Allergy, ckNoKnownAllergies.Enabled);
430 if Piece(Allergy, U, 1) = '-1' then
431 begin
432 ckNoKnownAllergies.Checked := True;
433 //Exit;
434 end
435 else if Allergy <> '' then
436 begin
437 lstAllergy.Clear;
438 lstAllergy.Items.Add(Allergy);
439 cboAllergyType.SelectByID(Piece(Allergy, U, 4));
440 end
441 else
442 begin
443 AbortAction := True;
444 Close;
445 exit;
446 end;
447 calOriginated.FMDateTime := FMNow;
448 end;
449 StatusText('');
450 Changing := False;
451 ControlChange(lstAllergy);
452 origlbl508.Visible := False;
453 origdtlbl508.Visible := False;
454 if ScreenReaderSystemActive then
455 begin
456 origlbl508.Enabled := True;
457 origdtlbl508.Enabled := True;
458 origlbl508.Visible := True;
459 origdtlbl508.Visible := True;
460// cboOriginator.Enabled := True;
461// calOriginated.Enabled := True;
462// calOriginated.ReadOnly := True;
463 end;
464end;
465
466procedure TfrmARTAllergy.SetDate;
467var
468 x: string;
469begin
470 Changing := True;
471 with lstSelectedSymptoms do
472 begin
473 if (Items.Count = 0) or (ItemIndex = -1) or (not SymptomDateBox.IsValid) then exit;
474
475 if SymptomDateBox.FMDateTime > FMNow then
476 InfoBox(TX_NO_FUTURE_DATES, TX_CAP_FUTURE, MB_OK)
477 else
478 begin
479 x := Items[ItemIndex];
480 x := ORFn.Pieces(x, U, 1, 2) + U + FloatToStr(SymptomDateBox.FMDateTime) + U +
481 FormatFMDateTime('mmm dd,yyyy@hh:nn', SymptomDateBox.FMDateTime);
482 Items[ItemIndex] := x;
483 end;
484 end;
485 Changing := False;
486 ControlChange(SymptomDateBox);
487end;
488
489procedure TfrmARTAllergy.SetupDialog;
490begin
491 if AbortAction then exit;
492 if OldRec.IEN = -1 then
493 begin
494 InfoBox(TX_EDIT_ERROR, TC_EDIT_ERROR, MB_ICONERROR or MB_OK);
495 Exit;
496 end;
497 if uEditing then with OldRec do
498 begin
499 Changing := True;
500 ckNoKnownAllergies.Checked := NoKnownAllergies;
501 btnAgent.Enabled := FALSE; //not Verified;
502 lstAllergy.Items.Clear;
503 lstAllergy.Items.Insert(0, U + CausativeAgent);
504 lstAllergy.ItemIndex := 0;
505 lstAllergySelect(Self);
506 cboAllergyType.SelectByID(Piece(AllergyType, U, 1));
507 cboNatureOfReaction.SelectByID(Piece(NatureOfReaction, U, 1));
508 FastAssign(SignsSymptoms, lstSelectedSymptoms.Items);
509 calOriginated.FMDateTime := Originated;
510 cboOriginator.InitLongList(OriginatorName);
511 cboOriginator.SelectByIEN(Originator);
512 { TODO -oRich V. -cART/Allergy : Change to calendar entry fields and prior entries button? }
513 ckIDBand.Checked := IDBandMarked.Count > 0;
514 ckChartMarked.Checked := ChartMarked.Count > 0;
515 if Piece(Observed_Historical, U, 1) <> '' then
516 case UpperCase(Piece(Observed_Historical, U, 1))[1] of
517 'O': grpObsHist.ItemIndex := 0;
518 'H': grpObsHist.ItemIndex := 1;
519 end
520 else grpObsHist.ItemIndex := -1;
521 calObservedDate.FMDateTime := ReactionDate;
522 cmdPrevObs.Enabled := (OldRec.Observations.Text <> '');
523 cboSeverity.SelectByID(Piece(Severity, U, 1));
524 cmdPrevCmts.Enabled := Comments.Text <> '';
525 SetupVerifyFields(OldRec);
526 SetUpEnteredInErrorFields(OldRec);
527 Changing := False;
528 ControlChange(Self);
529 end
530 else if uEnteredInError then with OldRec do
531 begin
532 Changing := True;
533 SetupVerifyFields(OldRec);
534 SetUpEnteredInErrorFields(OldRec);
535 Changing := False;
536 end;
537
538end;
539
540procedure TfrmARTAllergy.VA508ComponentAccessibility1StateQuery(Sender: TObject;
541 var Text: string);
542begin
543 inherited;
544Text := 'Comments ' + memComments.Text;
545end;
546
547procedure TfrmARTAllergy.VA508ComponentAccessibility2CaptionQuery(
548 Sender: TObject; var Text: string);
549begin
550 inherited;
551
552 Text := 'Causative Agent';
553end;
554
555procedure TfrmARTAllergy.VA508ComponentAccessibility2ComponentNameQuery(
556 Sender: TObject; var Text: string);
557begin
558 inherited;
559
560 Text := 'List Box';
561end;
562
563procedure TfrmARTAllergy.VA508ComponentAccessibility2InstructionsQuery(
564 Sender: TObject; var Text: string);
565begin
566 //inherited;
567
568 Text := 'Read Only';
569end;
570
571procedure TfrmARTAllergy.VA508ComponentAccessibility2ItemInstructionsQuery(
572 Sender: TObject; var Text: string);
573begin
574 //inherited;
575 Text := ' ';
576end;
577
578procedure TfrmARTAllergy.VA508ComponentAccessibility2ItemQuery(Sender: TObject;
579 var Item: TObject);
580begin
581 inherited;
582 Text := ' ';
583end;
584
585procedure TfrmARTAllergy.VA508ComponentAccessibility2StateQuery(Sender: TObject;
586 var Text: string);
587begin
588// inherited;
589 Text := ' ';
590end;
591
592procedure TfrmARTAllergy.VA508ComponentAccessibility2ValueQuery(Sender: TObject;
593 var Text: string);
594begin
595 inherited;
596 Text := Piece(lstAllergy.Items[0],U,2);
597end;
598
599procedure TfrmARTAllergy.VA508ComponentAccessibility3StateQuery(Sender: TObject;
600 var Text: string);
601begin
602 inherited;
603 Text := memErrCmts.Text;
604end;
605
606procedure TfrmARTAllergy.Validate(var AnErrMsg: string);
607var
608 tmpDate: TFMDateTime;
609
610 procedure SetError(const x: string);
611 begin
612 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
613 AnErrMsg := AnErrMsg + x;
614 end;
615
616begin
617 AnErrMsg := '';
618 if tabEnteredInError.TabVisible then exit;
619 if not ckNoKnownAllergies.Checked then
620 begin
621 if lstAllergy.Items.Count = 0 then SetError(TX_NO_ALLERGY)
622 else if (Length(lstAllergy.DisplayText[0]) = 0) or
623 (Piece(lstAllergy.Items[0], U, 1) = '-1') then SetError(TX_NO_ALLERGY);
624 if (grpObsHist.ItemIndex = -1) then
625 SetError(TX_MISSING_OBS_HIST);
626 if (grpObsHist.ItemIndex = 0) then
627 begin
628 if (lstSelectedSymptoms.Items.Count = 0) then SetError(TX_NO_SYMPTOMS);
629 if (grpObsHist.Enabled) and RequireOriginatorComments and (not ContainsVisibleChar(memComments.Text)) then
630 SetError(TX_ORIG_CMTS_REQD);
631 if (grpObsHist.Enabled) and (calObservedDate.Text = '') then
632 SetError(TX_MISSING_OBS_DATE);
633 end;
634 if cboAllergyType.ItemID = '' then SetError(TX_NO_ALLGYTYPE);
635 with cboNatureOfReaction do
636 if (ItemID = '') or (ItemIndex < 0) or (Text = '') then
637 SetError(TX_NO_NATURE_OF_REACTION)
638 else
639 NewRec.NatureOfReaction := ItemID + U + Text;
640 end;
641 if (cboOriginator.ItemIEN = 0) or (cboOriginator.Text = '') then SetError(TX_NO_ORIGINATOR);
642 with NewRec do
643 begin
644 if calObservedDate.Text <> '' then
645 begin
646 tmpDate := ValidDateTimeStr(calObservedDate.Text, 'TS');
647 if tmpDate > 0 then
648 begin
649 if tmpDate > FMNow then SetError(TX_NO_FUTURE_DATES)
650 else ReactionDate := tmpDate;
651 end
652 else
653 begin
654 SetError(TX_BAD_OBS_DATE);
655 pgAllergy.ActivePage := tabGeneral;
656 end;
657 end;
658 if tabVerify.TabVisible then
659 if calVerifyDate.Text <> '' then
660 begin
661 tmpDate := ValidDateTimeStr(calVerifyDate.Text, 'TS');
662 if tmpDate > 0 then VerifiedDateTime := tmpDate
663 else
664 begin
665 SetError(TX_BAD_VER_DATE);
666 pgAllergy.ActivePage := tabVerify;
667 end;
668 end;
669 if calOriginated.Text <> '' then
670 begin
671 tmpDate := ValidDateTimeStr(calOriginated.Text, 'TS');
672 if tmpDate > 0 then
673 begin
674 if tmpDate > FMNow then SetError(TX_NO_FUTURE_ORIG_DATES)
675 else Originated := tmpDate;
676 end
677 else
678 begin
679 SetError(TX_BAD_ORIG_DATE);
680 pgAllergy.ActivePage := tabGeneral;
681 end;
682 end
683 else
684 begin
685 SetError(TX_MISSING_ORIG_DATE);
686 pgAllergy.ActivePage := tabGeneral;
687 end;
688 end;
689end;
690
691procedure TfrmARTAllergy.calObservedDateExit(Sender: TObject);
692var
693 x: string;
694begin
695 inherited;
696 calObservedDate.Validate(x);
697 calObservedDate.FMDateTime := calObservedDate.FMDateTime;
698end;
699
700procedure TfrmARTAllergy.cboOriginatorNeedData(Sender: TObject;
701 const StartFrom: string; Direction, InsertAt: Integer);
702begin
703 inherited;
704 cboOriginator.ForDataUse(SubSetOfPersons(StartFrom, Direction));
705end;
706
707procedure TfrmARTAllergy.cboSymptomsNeedData(Sender: TObject;
708 const StartFrom: string; Direction, InsertAt: Integer);
709begin
710 inherited;
711 cboSymptoms.ForDataUse(SubSetOfSymptoms(StartFrom, Direction));
712end;
713
714procedure TfrmARTAllergy.grpObsHistClick(Sender: TObject);
715begin
716 inherited;
717 Changing := True;
718 cboSeverity.ItemIndex := 1;
719 case grpObsHist.ItemIndex of
720 0: begin
721 cboSeverity.Visible := True;
722 lblSeverity.Visible := True;
723 btnSevHelp.Visible := True;
724 calObservedDate.Visible := True;
725 lblObservedDate.Visible := True;
726 calObservedDate.FMDateTime := FMToday;
727 end;
728 1: begin
729 cboSeverity.Visible := False;
730 lblSeverity.Visible := False;
731 btnSevHelp.Visible := False;
732 calObservedDate.Visible := False;
733 lblObservedDate.Visible := False;
734 end;
735 end;
736 Changing := False;
737 ControlChange(Self);
738end;
739
740procedure TfrmARTAllergy.ControlChange(Sender: TObject);
741var
742 MyFMNow: TFMDateTime;
743 i: integer;
744 SourceGlobalRoot, x: string;
745begin
746 inherited;
747 if Changing then Exit;
748 MyFMNow := FMNow;
749 with NewRec do
750 begin
751 if (not uEditing) and (not uEnteredInError) then IEN := 0;
752 if ckNoKnownAllergies.Checked then
753 begin
754 with cboOriginator do if ItemIEN > 0 then
755 begin
756 Originator := ItemIEN;
757 OriginatorName := Text;
758 end;
759 NoKnownAllergies := True;
760 end
761 else if tabEnteredInError.TabVisible then
762 begin
763 EnteredInError := ckEnteredInError.Checked;
764 if EnteredInError then
765 begin
766 DateEnteredInError := MyFMNow; {***}
767 UserEnteringInError := User.DUZ;
768 with memErrCmts do if GetTextLen > 0 then QuickCopy(memErrCmts, ErrorComments);
769 end;
770 end
771 else
772 with lstAllergy do if (Items.Count > 0) then
773 if (Piece(Items[0], U, 1) <> '-1') and (Length(DisplayText[0]) > 0) then
774 begin
775 SourceGlobalRoot := Piece(Piece(Items[0], U, 3), ',', 1) + ',';
776 if Pos('PSDRUG', SourceGlobalRoot) > 0 then
777 SourceGlobalRoot := Piece(SourceGlobalRoot, '"', 1);
778 x := Piece(Items[0], U, 2);
779 if ((Pos('GMRD', SourceGlobalRoot) > 0) or (Pos('PSDRUG', SourceGlobalRoot) > 0))
780 and (Pos('<', x) > 0) then
781 x := Copy(x, 1, Length(Piece(x, '<', 1)) - 1);
782 //x := Trim(Piece(x, '<', 1));
783 CausativeAgent := x + U + Piece(Items[0], U, 1) + ';' + SourceGlobalRoot;
784 with cboAllergyType do
785 if ItemID <> '' then
786 AllergyType := ItemID + U + Text;
787 with cboNatureOfReaction do
788 if ItemID <> '' then
789 NatureOfReaction := ItemID + U + Text;
790 with cboOriginator do
791 if ItemIEN > 0 then
792 begin
793 Originator := ItemIEN;
794 OriginatorName := Text;
795 end;
796 SignsSymptoms.Clear;
797 for i := 0 to uDeletedSymptoms.Count - 1 do
798 SignsSymptoms.Add(uDeletedSymptoms[i]);
799 with lstSelectedSymptoms do
800 for i := 0 to Items.Count - 1 do
801 SignsSymptoms.Add(Items[i]);
802 if tabVerify.TabVisible then
803 begin
804 Verified := ckVerified.Checked;
805 with cboVerifier do
806 if ItemIEN > 0 then
807 begin
808 Verifier := ItemIEN;
809 VerifierName := Text;
810 end;
811 end;
812 NewRec.ChartMarked.Clear;
813 if ckChartMarked.Checked then
814 ChartMarked.Add(FloatToStr(MyFMNow));
815 NewRec.IDBandMarked.Clear;
816 if ckIDBand.Checked then
817 IDBandMarked.Add(FloatToStr(MyFMNow));
818 with grpObsHist do
819 if ItemIndex > -1 then
820 begin
821 if ItemIndex = 0 then
822 Observed_Historical := 'o^OBSERVED'
823 else
824 Observed_Historical := 'h^HISTORICAL';
825 end;
826(* tmpDate := ValidDateTimeStr(calObservedDate.Text, 'TS'); {***}
827 if tmpDate > 0 then ReactionDate := tmpDate;*)
828 with cboSeverity do
829 if (ItemID <> '') and (Text <> '') then
830 Severity := ItemID
831 else
832 Severity := '';
833 with memComments do
834 if GetTextLen > 0 then
835 QuickCopy(memComments, NewComments);
836 end;
837 end;
838end;
839
840procedure TfrmARTAllergy.lstAllergySelect(Sender: TObject);
841begin
842 inherited;
843 with lstAllergy do
844 begin
845 if Items.Count = 0 then
846 Exit
847 else if Piece(Items[0], U, 1) = '-1' then
848 Exit;
849 if Piece(Items[0], U, 1) <> FLastAllergyID then
850 FLastAllergyID := Piece(Items[0], U, 1)
851 else
852 Exit;
853 Changing := True;
854 //if Sender <> Self then FillChar(NewRec, SizeOf(NewRec), 0); // Sender=Self when called from SetupDialog
855 Changing := False;
856 end;
857 ControlChange(Self) ;
858end;
859
860procedure TfrmARTAllergy.memCommentsExit(Sender: TObject);
861var
862 AStringList: TStringList;
863begin
864 inherited;
865 AStringList := TStringList.Create;
866 try
867 QuickCopy(memComments, AStringList);
868 LimitStringLength(AStringList, 74);
869 QuickCopy(AstringList, memComments);
870 ControlChange(Self);
871 finally
872 AStringList.Free;
873 end;
874end;
875
876procedure TfrmARTAllergy.memErrCmtsExit(Sender: TObject);
877var
878 AStringList: TStringList;
879begin
880 inherited;
881 AStringList := TStringList.Create;
882 try
883 QuickCopy(memErrCmts, AStringList);
884 LimitStringLength(AStringList, 74);
885 QuickCopy(AstringList, memErrCmts);
886 ControlChange(Self);
887 finally
888 AStringList.Free;
889 end;
890end;
891
892procedure TfrmARTAllergy.SymptomDateBoxDateDialogClosed(Sender: TObject);
893begin
894 inherited;
895 SetDate;
896end;
897
898procedure TfrmARTAllergy.SymptomDateBoxExit(Sender: TObject);
899begin
900 inherited;
901 SetDate;
902end;
903
904procedure TfrmARTAllergy.btnAgent1Click(Sender: TObject);
905var
906 Allergy: string;
907begin
908 inherited;
909 AllergyLookup(Allergy, ckNoKnownAllergies.Enabled);
910 if Piece(Allergy, U, 1) = '-1' then
911 ckNoKnownAllergies.Checked := True
912 else if Allergy <> '' then
913 begin
914 lstAllergy.Clear;
915 lstAllergy.Items.Add(Allergy);
916 cboAllergyType.SelectByID(Piece(Allergy, U, 4));
917 end
918 else
919 begin
920 Close;
921 exit;
922 end;
923 ControlChange(lstAllergy);
924end;
925
926procedure TfrmARTAllergy.cboSymptomsClick(Sender: TObject);
927begin
928 inherited;
929 if cboSymptoms.ItemIndex < 0 then exit;
930 Changing := True;
931 if lstSelectedSymptoms.SelectByID(cboSymptoms.ItemID) > -1 then exit;
932 with lstSelectedSymptoms do
933 begin
934 Items.Add(cboSymptoms.Items[cboSymptoms.ItemIndex]);
935 SelectByID(cboSymptoms.ItemID);
936 end;
937 Changing := False;
938 ControlChange(Self)
939end;
940
941procedure TfrmARTAllergy.FormDestroy(Sender: TObject);
942begin
943 OldRec.SignsSymptoms.Free;
944 OldRec.IDBandMarked.Free;
945 OldRec.ChartMarked.Free;
946 OldRec.Observations.Free;
947 OldRec.Comments.Free;
948 OldRec.NewComments.Free;
949 OldRec.ErrorComments.Free;
950 NewRec.SignsSymptoms.Free;
951 NewRec.IDBandMarked.Free;
952 NewRec.ChartMarked.Free;
953 NewRec.Observations.Free;
954 NewRec.Comments.Free;
955 NewRec.NewComments.Free;
956 NewRec.ErrorComments.Free;
957 Defaults.Free;
958 uDeletedSymptoms.Free;
959 AllergyList.Free;
960 frmARTAllergy := NIL;
961
962 uAddingNew := FALSE;
963 uEditing := FALSE;
964 uEnteredInError := FALSE;
965 uUserCanVerify := FALSE;
966 frmCover.UpdateAllergiesList;
967
968 inherited;
969end;
970
971procedure TfrmARTAllergy.ckNoKnownAllergiesClick(Sender: TObject);
972begin
973 inherited;
974 Changing := True;
975 FNKAOrder := ckNoKnownAllergies.Checked;
976 EnableDisableControls(not FNKAOrder);
977 Changing := False;
978 ControlChange(Self);
979end;
980
981procedure TfrmARTAllergy.EnableDisableControls(EnabledStatus: boolean);
982begin
983 //InitDialog;
984 with pgAllergy do
985 begin
986 tabVerify.TabVisible := FALSE; //EnabledStatus; per Dave, leave out for now.
987 tabEnteredInError.TabVisible := uEnteredInError;
988 tabGeneral.TabVisible := not uEnteredInError;
989 end;
990 btnAgent.Enabled := EnabledStatus;
991 cboAllergyType.Enabled := EnabledStatus;
992 cboNatureOfReaction.Enabled := EnabledStatus;
993 lblAllergyType.Enabled := EnabledStatus;
994 lblAgent.Enabled := EnabledStatus;
995 lblSymptoms.Enabled := EnabledStatus;
996 lblSelectedSymptoms.Enabled := EnabledStatus;
997 grpObsHist.Enabled := EnabledStatus;
998 memComments.Enabled := EnabledStatus;
999 lblComments.Enabled := EnabledStatus;
1000 lstSelectedSymptoms.Enabled := EnabledStatus;
1001 lblObservedDate.Enabled := EnabledStatus;
1002 calObservedDate.Enabled := EnabledStatus;
1003 lblSeverity.Enabled := EnabledStatus;
1004 cboSeverity.Enabled := EnabledStatus;
1005 btnSevHelp.Enabled := EnabledStatus;
1006 lstAllergy.Enabled := EnabledStatus;
1007 cboSymptoms.Enabled := EnabledStatus;
1008 SymptomDateBox.Enabled := EnabledStatus;
1009end;
1010
1011procedure TfrmARTAllergy.cmdOKClick(Sender: TObject);
1012const
1013 TX_ENTERED_IN_ERROR = 'Mark this entry as ''Entered in Error''?';
1014 TC_ENTERED_IN_ERROR = 'Are you sure?';
1015var
1016 Saved: string;
1017begin
1018 if ValidSave then
1019 begin
1020 if uEnteredInError then
1021 if not (InfoBox(TX_ENTERED_IN_ERROR, TC_ENTERED_IN_ERROR, MB_YESNO or MB_ICONQUESTION) = ID_YES) then
1022 begin
1023 FChanged := False;
1024 FAbort := False;
1025 Close;
1026 Exit;
1027 end;
1028 Saved := SaveAllergy(NewRec);
1029 FChanged := (Piece(Saved, U, 1) = '0');
1030 if not FChanged then
1031 InfoBox(TX_NO_SAVE + Piece(Saved, U, 2), TX_NO_SAVE_CAP, MB_OK)
1032 else
1033 begin
1034 SendMessage(Application.MainForm.Handle, UM_NEWORDER, ORDER_SIGN, 0);
1035 Application.ProcessMessages;
1036 end;
1037 FAbort := False;
1038 Close;
1039 end;
1040end;
1041
1042function TfrmARTAllergy.ValidSave: Boolean;
1043var
1044 ErrMsg: string;
1045begin
1046 Result := True;
1047 Validate(ErrMsg);
1048 if Length(ErrMsg) > 0 then
1049 begin
1050 InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
1051 Result := False;
1052 end;
1053end;
1054
1055procedure TfrmARTAllergy.btnCurrentClick(Sender: TObject);
1056const
1057 VIEW_CURRENT = 'Current Allergies/Adverse Reactions for ';
1058begin
1059 inherited;
1060 ReportBox(DetailPosting('A'), VIEW_CURRENT + Patient.Name, True)
1061end;
1062
1063procedure TfrmARTAllergy.btnRemoveClick(Sender: TObject);
1064var
1065 i: integer;
1066 x: string;
1067begin
1068 inherited;
1069 Changing := True;
1070 with lstSelectedSymptoms do
1071 begin
1072 if (Items.Count = 0) or (ItemIndex = -1) then exit;
1073 i := ItemIndex;
1074 if uEditing then
1075 begin
1076 if OldRec.SignsSymptoms.IndexOf(Items[ItemIndex]) > -1 then
1077 begin
1078 x := Items[i];
1079 SetPiece(x, U, 5, '@');
1080 uDeletedSymptoms.Add(x);
1081 end;
1082 end;
1083 Items.Delete(ItemIndex);
1084 ItemIndex := i - 1;
1085 if (Items.Count > 0) and (ItemIndex = -1) then ItemIndex := 0;
1086 end;
1087 Changing := False;
1088 ControlChange(btnRemove);
1089end;
1090
1091procedure TfrmARTAllergy.lstAllergyClick(Sender: TObject);
1092begin
1093 inherited;
1094 lstAllergy.ItemIndex := -1;
1095end;
1096
1097procedure TfrmARTAllergy.cboSymptomsMouseClick(Sender: TObject);
1098const
1099 TC_SS_MAX = 'Too many signs/symptoms';
1100 TX_SS_MAX = 'A maximum of 38 signs/symptoms may be selected.';
1101var
1102 x: string;
1103begin
1104 inherited;
1105 with cboSymptoms do if (ItemIndex < 0) or (Text = '') or (ItemID = '') then exit;
1106 if (lstSelectedSymptoms.SelectByID(cboSymptoms.ItemID) > -1) or
1107 (lstSelectedSymptoms.Items.IndexOf(cboSymptoms.Text) > -1) then exit;
1108 if (lstSelectedSymptoms.Count + 1) > 38 then
1109 begin
1110 InfoBox(TX_SS_MAX, TC_SS_MAX, MB_ICONERROR or MB_OK);
1111 exit;
1112 end;
1113 Changing := True;
1114 if cboSymptoms.ItemIndex > -1 then
1115 begin
1116 with cboSymptoms do
1117 if Piece(Items[ItemIndex], U, 3) <> '' then
1118 x := ItemID + U + Piece(Items[ItemIndex], U, 3)
1119 else
1120 x := ItemID + U + Piece(Items[ItemIndex], U, 2);
1121 with lstSelectedSymptoms do
1122 begin
1123 Items.Add(x);
1124 SelectByID(cboSymptoms.ItemID);
1125 end;
1126 end ;
1127(* else Free-text entries no longer allowed.
1128 with lstSelectedSymptoms do
1129 begin
1130 Items.Add('FT' + U + cboSymptoms.Text);
1131 ItemIndex := Items.Count - 1;
1132 end;*)
1133 Changing := False;
1134 ControlChange(Self)
1135end;
1136
1137procedure TfrmARTAllergy.cboSymptomsKeyDown(Sender: TObject; var Key: Word;
1138 Shift: TShiftState);
1139begin
1140 inherited;
1141 if Key = VK_RETURN then cboSymptomsMouseClick(Self);
1142end;
1143
1144procedure TfrmARTAllergy.cmdCancelClick(Sender: TObject);
1145begin
1146 inherited;
1147 FChanged := False;
1148 Close;
1149end;
1150
1151procedure TfrmARTAllergy.cmdPrevCmtsClick(Sender: TObject);
1152const
1153 CMT_CAPTION = 'View previous comments';
1154begin
1155 inherited;
1156 ReportBox(OldRec.Comments, CMT_CAPTION, False);
1157end;
1158
1159procedure TfrmARTAllergy.cmdPrevObsClick(Sender: TObject);
1160const
1161 OBS_CAPTION = 'View previous observations';
1162begin
1163 inherited;
1164 ReportBox(OldRec.Observations, OBS_CAPTION, False);
1165end;
1166
1167procedure TfrmARTAllergy.lstSelectedSymptomsChange(Sender: TObject);
1168var
1169 AFMDateTime: TFMDateTime;
1170begin
1171 inherited;
1172 with lstSelectedSymptoms do
1173 begin
1174 SymptomDateBox.Enabled := (ItemIndex <> -1);
1175 btnRemove.Enabled := (ItemIndex <> -1);
1176
1177 if SymptomDateBox.Enabled then begin
1178 AFMDateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 3));
1179 if AFMDateTime > 0 then
1180 SymptomDateBox.FMDateTime := AFMDateTime
1181 end;
1182 end;
1183end;
1184
1185procedure TfrmARTAllergy.cboVerifierNeedData(Sender: TObject;
1186 const StartFrom: String; Direction, InsertAt: Integer);
1187begin
1188 inherited;
1189 cboVerifier.ForDataUse(SubSetOfPersons(StartFrom, Direction));
1190end;
1191
1192procedure TfrmARTAllergy.SetupVerifyFields(ARec: TAllergyRec);
1193var
1194 CanBeVerified: boolean;
1195begin
1196 tabVerify.TabVisible := False; // FOR NOW
1197 if not tabVerify.TabVisible then exit;
1198 if not uUserCanVerify then
1199 begin
1200 tabVerify.TabVisible := False;
1201 exit;
1202 end;
1203 Changing := True;
1204 with ARec do
1205 begin
1206 ckVerified.Checked := Verified;
1207 CanBeVerified := (not Verified) and uUserCanVerify;
1208 if CanBeVerified then
1209 begin
1210 cboVerifier.InitLongList(User.Name);
1211 cboVerifier.SelectByIEN(User.DUZ);
1212 cboVerifier.Font.Color := clWindowText;
1213 calVerifyDate.FMDateTime := FMNow;
1214 end
1215 else
1216 begin
1217 cboVerifier.InitLongList(VerifierName);
1218 cboVerifier.SelectByIEN(Verifier);
1219 cboVerifier.Font.Color := clGrayText;
1220 calVerifyDate.FMDateTime := VerifiedDateTime;
1221 end;
1222 cboVerifier.Enabled := CanBeVerified;
1223 calVerifyDate.Enabled := CanBeVerified;
1224 ckVerified.Enabled := CanBeVerified;
1225 lblVerifier.Enabled := CanBeVerified;
1226 lblVerifyDate.Enabled := CanBeVerified;
1227 end;
1228 Changing := False;
1229 ControlChange(ckVerified);
1230end;
1231
1232procedure TfrmARTAllergy.SetUpEnteredInErrorFields(ARec: TAllergyRec);
1233const
1234 TC_ERR_CMTS_OPTIONAL = 'Comments (optional)';
1235 TC_ERR_CMTS_DISABLED = 'Comments (disabled)';
1236 TX_ENTERED_IN_ERROR1 = 'Clicking ''OK'' will mark ';
1237 TX_ENTERED_IN_ERROR2 = ' as ''Entered in Error''.';
1238
1239begin
1240 tabEnteredInError.TabVisible := uEnteredInError;
1241 tabGeneral.TabVisible := not uEnteredInError;
1242 tabVerify.TabVisible := FALSE; // not uEnteredInError;
1243 Changing := True;
1244 ckEnteredInError.Checked := uEnteredInError;
1245 if uEnteredInError then
1246 begin
1247 lblEnteredInError.Caption := TX_ENTERED_IN_ERROR1 + UpperCase(OldRec.CausativeAgent) + TX_ENTERED_IN_ERROR2;
1248 if EnableErrorComments then
1249 begin
1250 memErrCmts.Enabled := True;
1251 memErrCmts.Color := clWindow;
1252 lblErrCmts.Enabled := True;
1253 lblErrCmts.Caption := TC_ERR_CMTS_OPTIONAL;
1254 ActiveControl := memErrCmts;
1255 end
1256 else
1257 begin
1258 memErrCmts.Enabled := False;
1259 memErrCmts.Color := clBtnFace;
1260 lblErrCmts.Enabled := False;
1261 lblErrCmts.Caption := TC_ERR_CMTS_DISABLED;
1262 ActiveControl := cmdOK;
1263 end;
1264 end;
1265 Changing := False;
1266 ControlChange(ckEnteredInError);
1267end;
1268
1269
1270procedure TfrmARTAllergy.FormClose(Sender: TObject;
1271 var Action: TCloseAction);
1272begin
1273 inherited;
1274 Release;
1275 uEditing := False;
1276 uEnteredInError := False;
1277 uAddingNew := False;
1278 Application.HintHidePause := FOldHintPause;
1279 Action := caFree;
1280
1281end;
1282
1283procedure TfrmARTAllergy.FormCloseQuery(Sender: TObject;
1284 var CanClose: Boolean);
1285begin
1286 inherited;
1287 if FAbort and frmARTAllergy.Visible then
1288 begin
1289 if InfoBox('Are you sure you want to cancel Entering/Editing this allergy?', 'Exiting Allergy Enter/Edit form', MB_YESNO) = ID_NO then
1290 begin
1291 CanClose := false;
1292 exit;
1293 end;
1294 end;
1295 if AbortAction then exit;
1296end;
1297
1298procedure TfrmARTAllergy.btnSevHelpClick(Sender: TObject);
1299const
1300 TX_SEV_DEFINITION = 'MILD - Requires minimal therapeutic intervention '+#13+#10+
1301 'such as discontinuation of drug(s)'+#13+#10+''+#13+#10+
1302 'MODERATE - Requires active treatment of adverse reaction, '+#13+#10+
1303 'or further testing or evaluation to assess extent of non-serious'+#13+#10+
1304 'outcome (see SEVERE for definition of serious).'+#13+#10+''+#13+#10+
1305 'SEVERE - Includes any serious outcome, resulting in life- or'+#13+#10+
1306 'organ-threatening situation or death, significant or permanent'+#13+#10+
1307 'disability, requiring intervention to prevent permanent impairment '+#13+#10+
1308 'or damage, or requiring/prolonging hospitalization.';
1309 TC_SEV_CAPTION = 'Severity Levels';
1310begin
1311 inherited;
1312 InfoBox(TX_SEV_DEFINITION, TC_SEV_CAPTION, MB_ICONINFORMATION or MB_OK);
1313end;
1314
1315end.
Note: See TracBrowser for help on using the repository browser.