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