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