Module

fARTAllgy

Path

C:\CPRS\CPRS30\fARTAllgy.pas

Last Modified

7/15/2014 3:26:36 PM

Open Todo-items for fARTAllgy (1)

Text Category Owner Priority Status
Change to calendar entry fields and prior entries button? ART/Allergy Rich V. - Open

Units Used in Interface

Name Comments
fAutoSz -
fODBase -
fOMAction -
rODAllergy -
uConst -
uOrders -

Units Used in Implementation

Name Comments
fAllgyFind -
fCover -
fPtCWAD -
fRptBox -
rCore -
rCover -
rODBase -
uCore -

Classes

Name Comments
TfrmARTAllergy -

Procedures

Name Owner Declaration Scope Comments
btnAgent1Click TfrmARTAllergy procedure btnAgent1Click(Sender: TObject); Public/Published -
btnCurrentClick TfrmARTAllergy procedure btnCurrentClick(Sender: TObject); Public/Published -
btnRemoveClick TfrmARTAllergy procedure btnRemoveClick(Sender: TObject); Public/Published -
btnSevHelpClick TfrmARTAllergy procedure btnSevHelpClick(Sender: TObject); Public/Published -
calObservedDateExit TfrmARTAllergy procedure calObservedDateExit(Sender: TObject); Public/Published -
cboOriginatorNeedData TfrmARTAllergy procedure cboOriginatorNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboSymptomsClick TfrmARTAllergy procedure cboSymptomsClick(Sender: TObject); Public/Published -
cboSymptomsKeyDown TfrmARTAllergy procedure cboSymptomsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboSymptomsMouseClick TfrmARTAllergy procedure cboSymptomsMouseClick(Sender: TObject); Public/Published -
cboSymptomsNeedData TfrmARTAllergy procedure cboSymptomsNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboVerifierNeedData TfrmARTAllergy procedure cboVerifierNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
ckNoKnownAllergiesClick TfrmARTAllergy procedure ckNoKnownAllergiesClick(Sender: TObject); Public/Published -
cmdCancelClick TfrmARTAllergy procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmARTAllergy procedure cmdOKClick(Sender: TObject); Public/Published -
cmdPrevCmtsClick TfrmARTAllergy procedure cmdPrevCmtsClick(Sender: TObject); Public/Published -
cmdPrevObsClick TfrmARTAllergy procedure cmdPrevObsClick(Sender: TObject); Public/Published -
ControlChange TfrmARTAllergy procedure ControlChange(Sender: TObject); Public/Published -
EnableDisableControls TfrmARTAllergy procedure EnableDisableControls(EnabledStatus: boolean); Protected -
FormClose TfrmARTAllergy procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCloseQuery TfrmARTAllergy procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); Public/Published -
FormCreate TfrmARTAllergy procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmARTAllergy procedure FormDestroy(Sender: TObject); Public/Published -
grpObsHistClick TfrmARTAllergy procedure grpObsHistClick(Sender: TObject); Public/Published -
InitDialog TfrmARTAllergy procedure InitDialog; override; Protected ErrMsg: string;
lstAllergyClick TfrmARTAllergy procedure lstAllergyClick(Sender: TObject); Public/Published -
lstAllergySelect TfrmARTAllergy procedure lstAllergySelect(Sender: TObject); Public/Published -
lstSelectedSymptomsChange TfrmARTAllergy procedure lstSelectedSymptomsChange(Sender: TObject); Public/Published -
memCommentsExit TfrmARTAllergy procedure memCommentsExit(Sender: TObject); Public/Published -
memErrCmtsExit TfrmARTAllergy procedure memErrCmtsExit(Sender: TObject); Public/Published -
SetDate TfrmARTAllergy procedure SetDate; Private -
SetError - procedure SetError(const x: string); Local -
SetupDialog TfrmARTAllergy procedure SetupDialog; Protected -
SetUpEnteredInErrorFields TfrmARTAllergy procedure SetUpEnteredInErrorFields(ARec: TAllergyRec); Protected -
SetupVerifyFields TfrmARTAllergy procedure SetupVerifyFields(ARec: TAllergyRec); Protected -
SymptomDateBoxDateDialogClosed TfrmARTAllergy procedure SymptomDateBoxDateDialogClosed(Sender: TObject); Public/Published -
SymptomDateBoxExit TfrmARTAllergy procedure SymptomDateBoxExit(Sender: TObject); Public/Published -
VA508ComponentAccessibility1StateQuery TfrmARTAllergy procedure VA508ComponentAccessibility1StateQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility2CaptionQuery TfrmARTAllergy procedure VA508ComponentAccessibility2CaptionQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility2ComponentNameQuery TfrmARTAllergy procedure VA508ComponentAccessibility2ComponentNameQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility2InstructionsQuery TfrmARTAllergy procedure VA508ComponentAccessibility2InstructionsQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility2ItemInstructionsQuery TfrmARTAllergy procedure VA508ComponentAccessibility2ItemInstructionsQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility2ItemQuery TfrmARTAllergy procedure VA508ComponentAccessibility2ItemQuery(Sender: TObject; var Item: TObject); Public/Published -
VA508ComponentAccessibility2StateQuery TfrmARTAllergy procedure VA508ComponentAccessibility2StateQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility2ValueQuery TfrmARTAllergy procedure VA508ComponentAccessibility2ValueQuery(Sender: TObject; var Text: string); Public/Published -
VA508ComponentAccessibility3StateQuery TfrmARTAllergy procedure VA508ComponentAccessibility3StateQuery(Sender: TObject; var Text: string); Public/Published -
Validate TfrmARTAllergy procedure Validate(var AnErrMsg: string); Protected -

Functions

Name Owner Declaration Scope Comments
EnterEditAllergy - function EnterEditAllergy(AllergyIEN: integer; AddNew, MarkAsEnteredInError: boolean; AnOwner: TComponent = nil; ARefNum: Integer = -1): boolean; Interfaced -
EnterNKAForPatient - function EnterNKAForPatient: boolean; Interfaced -
MarkEnteredInError - function MarkEnteredInError(AllergyIEN: integer): boolean; Interfaced -
ValidSave TfrmARTAllergy function ValidSave: Boolean; Protected -

Global Variables

Name Type Declaration Comments
AllergyList TStringList AllergyList: TStringList; -
Changing Boolean Changing: Boolean; -
Defaults TStringList Defaults: TStringList; -
FAbort Boolean FAbort: Boolean; -
frmARTAllergy TfrmARTAllergy frmARTAllergy: TfrmARTAllergy; -
NewRec OldRec, NewRec: TAllergyRec; -
OldRec OldRec, NewRec: TAllergyRec; -
uAddingNew Boolean uAddingNew: boolean = FALSE; -
uDeletedSymptoms TStringList uDeletedSymptoms: TStringList; -
uEditing Boolean uEditing: Boolean = FALSE; -
uEnteredInError Boolean uEnteredInError: Boolean = FALSE; -
uUserCanVerify Boolean uUserCanVerify: boolean = FALSE; -

Constants

Name Declaration Scope Comments
ENTERED_IN_ERROR True Global -
NEW_ALLERGY True Global -
TC_EDIT_ERROR 'Error Encountered' Global -
TC_NKA_SUCCESS 'No Known Allergies' Global -
TX_BAD_OBS_DATE 'Observation date must be in the format m/d/y or m/y or y, or T-d.' Global -
TX_BAD_ORIG_DATE 'Origination date must be in the format m/d/y or m/y or y, or T-d.' Global -
TX_BAD_VER_DATE 'Verify date must be in the format m/d/y or m/y or y, or T-d.' Global -
TX_CAP_EDITING 'Edit Allergy/Adverse Reaction' Global -
TX_CAP_ERROR 'Mark Allergy/Adverse Reaction Entered In Error' Global -
TX_CAP_FUTURE 'Invalid date' Global -
TX_EDIT_ERROR 'Unable to load record for editing' Global -
TX_MISSING_OBS_DATE 'Observation date is required for observed reactions.' Global -
TX_MISSING_OBS_HIST 'You must select either OBSERVED or HISTORICAL for this reaction.' Global -
TX_MISSING_ORIG_DATE 'Origination date is required.' Global -
TX_MISSING_SEVERITY 'You must select a Severity.' Global -
TX_NKA_SUCCESS 'Patient''s record has been updated.' Global -
TX_NO_ALLERGY 'A causative agent must be specified.' Global -
TX_NO_ALLGYTYPE 'An allergy type must be entered for this causative agent.' Global -
TX_NO_FUTURE_DATES 'Reaction dates in the future are not allowed.' Global -
TX_NO_FUTURE_ORIG_DATES 'An origination date in the future is not allowed.' Global -
TX_NO_NATURE_OF_REACTION 'A Nature of Reaction must be entered for this causative agent.' Global -
TX_NO_OBSERVER 'An observer must be selected for this allergy and reaction .' Global -
TX_NO_ORIGINATOR 'An originator must be selected for this allergy and reaction .' Global -
TX_NO_SAVE 'This item cannot be saved for the following reason(s):' + CRLF + CRLF Global -
TX_NO_SAVE_CAP 'Unable to Save Allergy/Adverse Reaction' Global -
TX_NO_SYMPTOMS 'Symptoms must be selected for this observed allergy and reaction.' Global -
TX_OBHX_HINT 'OBSERVED: directly observed or occurring while the patient was' + CRLF + Global -
TX_ORIG_CMTS_REQD 'Comments are required for ''Observed'' reactions.' Global -
TX_SAVE_ERR 'Unexpected error - it was not possible to save this request.' Global -
TX_STS_EDITING 'Loading Allergy/Adverse Reaction for Edit' Global -
TX_STS_ERROR 'Loading Allergy/Adverse Reaction' Global -


Module Source

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

Module Calls (2 levels)


fARTAllgy
 ├uConst
 ├fOMAction
 │ ├fAutoSz
 │ └uConst
 ├rODAllergy
 │ ├rCore
 │ ├uCore
 │ └rMisc
 ├uOrders
 │ ├uConst
 │ ├rConsults
 │ ├rOrders
 │ ├fODBase
 │ ├XuDsigS
 │ ├fODDiet
 │ ├fODMisc
 │ ├fODGen
 │ ├fODMedIn
 │ ├fODMedOut
 │ ├fODText
 │ ├fODConsult
 │ ├fODProc
 │ ├fODRad
 │ ├fODLab
 │ ├fODBBank
 │ ├fODMeds
 │ ├fODMedIV
 │ ├fODVitals
 │ ├fODAuto
 │ ├fOMNavA
 │ ├rCore...
 │ ├uCore...
 │ ├fFrame
 │ ├fEncnt
 │ ├fOMVerify
 │ ├fOrderSaveQuick
 │ ├fOMSet
 │ ├rMisc...
 │ ├uODBase
 │ ├rODMeds
 │ ├fLkUpLocation
 │ ├fOrdersPrint
 │ ├fOMAction...
 │ ├fARTAllgy...
 │ ├fOMHTML
 │ ├fOrders
 │ ├rODBase
 │ ├fODChild
 │ ├fMeds
 │ ├rMeds
 │ ├rPCE
 │ ├fRptBox
 │ ├fODMedNVA
 │ ├fODChangeUnreleasedRenew
 │ ├rODAllergy...
 │ ├UBAGlobals
 │ └uTemplateFields
 ├uCore...
 ├rCore...
 ├rCover
 │ ├uConst
 │ ├fFrame...
 │ ├uCore...
 │ ├rMeds...
 │ └uReminders
 ├fCover
 │ ├fPage
 │ ├rOrders...
 │ ├rCover...
 │ ├fAllgyBox
 │ ├fRptBox...
 │ ├fVitals
 │ ├fFrame...
 │ ├uCore...
 │ ├uConst
 │ ├uInit
 │ ├uReminders...
 │ ├rReminders
 │ ├fARTAllgy...
 │ ├fPatientFlagMulti
 │ └rODAllergy...
 ├fAllgyFind
 │ ├fAutoSz...
 │ ├rODAllergy...
 │ └fARTFreeTextMsg
 └fRptBox...

Module Called-By (2 levels)


                   fARTAllgy
                   uOrders┤ 
                   uCore┤ │ 
                 fODBase┤ │ 
                 rODBase┤ │ 
                  fFrame┤ │ 
                 fOrders┤ │ 
             fOrdersSign┤ │ 
                   fMeds┤ │ 
            fARTAllgy...┤ │ 
                  fNotes┤ │ 
               fConsults┤ │ 
         fReminderDialog┤ │ 
                 fReview┤ │ 
            fOrdersRenew┤ │ 
               fOrdersCV┤ │ 
                 fODMeds┤ │ 
                 fOMNavA┤ │ 
         fOrderSaveQuick┤ │ 
                  fOMSet┤ │ 
          fOrdersRelease┤ │ 
                 fOMHTML┤ │ 
               fODMedNVA┤ │ 
fODChangeUnreleasedRenew┤ │ 
          fOrdersOnChart┤ │ 
         fODReleaseEvent┤ │ 
               fODActive┘ │ 
                    fCover┤ 
               fFrame...┤ │ 
            fARTAllgy...┘ │ 
                 fAllgyBox┘ 
               fCover...┘