source: cprs/branches/tmg-cprs/CPRS-Chart/fARTAllgy.pas@ 1156

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

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