[459] | 1 | unit fNoteProps;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 7 | StdCtrls, ORDtTm, ORCtrls, ExtCtrls, rTIU, uConst, uTIU, ORFn, ORNet;
|
---|
| 8 |
|
---|
| 9 | type
|
---|
| 10 | TfrmNoteProperties = class(TForm)
|
---|
| 11 | lblNewTitle: TLabel;
|
---|
| 12 | cboNewTitle: TORComboBox;
|
---|
| 13 | lblDateTime: TLabel;
|
---|
| 14 | calNote: TORDateBox;
|
---|
| 15 | lblAuthor: TLabel;
|
---|
| 16 | cboAuthor: TORComboBox;
|
---|
| 17 | lblCosigner: TLabel;
|
---|
| 18 | cboCosigner: TORComboBox;
|
---|
| 19 | cmdOK: TButton;
|
---|
| 20 | cmdCancel: TButton;
|
---|
| 21 | pnlConsults: TORAutoPanel;
|
---|
| 22 | lblConsult1: TLabel;
|
---|
| 23 | lblConsult2: TLabel;
|
---|
| 24 | lblCsltDate: TLabel;
|
---|
| 25 | lblCsltServ: TLabel;
|
---|
| 26 | lblCsltProc: TLabel;
|
---|
| 27 | lblCsltStat: TLabel;
|
---|
| 28 | lblCsltNotes: TLabel;
|
---|
| 29 | lstRequests: TORListBox;
|
---|
| 30 | bvlConsult: TBevel;
|
---|
| 31 | pnlSurgery: TORAutoPanel;
|
---|
| 32 | lblSurgery1: TStaticText;
|
---|
| 33 | lblSurgery2: TStaticText;
|
---|
| 34 | lblSurgDate: TLabel;
|
---|
| 35 | lblSurgProc: TLabel;
|
---|
| 36 | lblSurgeon: TLabel;
|
---|
| 37 | lstSurgery: TORListBox;
|
---|
| 38 | bvlSurgery: TBevel;
|
---|
| 39 | cboProcSummCode: TORComboBox;
|
---|
| 40 | lblProcSummCode: TOROffsetLabel;
|
---|
| 41 | calProcDateTime: TORDateBox;
|
---|
| 42 | lblProcDateTime: TOROffsetLabel;
|
---|
| 43 | btnShowList: TButton;
|
---|
| 44 | procedure FormShow(Sender: TObject);
|
---|
| 45 | procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 46 | Direction, InsertAt: Integer);
|
---|
| 47 | procedure NewPersonNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 48 | Direction, InsertAt: Integer);
|
---|
| 49 | procedure cmdOKClick(Sender: TObject);
|
---|
| 50 | procedure cmdCancelClick(Sender: TObject);
|
---|
| 51 | procedure cboNewTitleExit(Sender: TObject);
|
---|
| 52 | procedure cboNewTitleMouseClick(Sender: TObject);
|
---|
| 53 | procedure cboNewTitleEnter(Sender: TObject);
|
---|
| 54 | procedure cboCosignerExit(Sender: TObject);
|
---|
| 55 | procedure cboAuthorExit(Sender: TObject);
|
---|
| 56 | procedure cboAuthorMouseClick(Sender: TObject);
|
---|
| 57 | procedure cboAuthorEnter(Sender: TObject);
|
---|
| 58 | procedure cboNewTitleDropDownClose(Sender: TObject);
|
---|
| 59 | procedure cboNewTitleDblClick(Sender: TObject);
|
---|
| 60 | procedure cboCosignerNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 61 | Direction, InsertAt: Integer);
|
---|
| 62 | procedure btnShowListClick(Sender: TObject);
|
---|
| 63 | procedure FormResize(Sender: TObject);
|
---|
| 64 | procedure calNoteEnter(Sender: TObject);
|
---|
| 65 | private
|
---|
| 66 | FCosignIEN: Int64; // store cosigner that was passed in
|
---|
| 67 | FCosignName: string; // store cosigner that was passed in
|
---|
| 68 | FDocType: Integer; // store document type that was passed in
|
---|
| 69 | FAddend: Integer; // store IEN of note being addended (if make addendum)
|
---|
| 70 | FLastAuthor: Int64; // set by mouseclick to avoid redundant call on exit
|
---|
| 71 | FLastTitle: Integer; // set by mouseclick to avoid redundant call on exit
|
---|
| 72 | //FFixCursor: Boolean; // to fix the problem where the list box is an I-bar
|
---|
| 73 | FLastCosigner: Int64; // holds cosigner from previous note (for defaulting)
|
---|
| 74 | FLastCosignerName: string; // holds cosigner from previous note (for defaulting)
|
---|
| 75 | FCallingTab: integer;
|
---|
| 76 | FIDNoteTitlesOnly: boolean;
|
---|
| 77 | FToday: string;
|
---|
| 78 | FClassName: string;
|
---|
| 79 | FIsClinProcNote: boolean;
|
---|
| 80 | FProcSummCode: integer;
|
---|
| 81 | FProcDateTime: TFMDateTime;
|
---|
| 82 | FCPStatusFlag: integer;
|
---|
| 83 | procedure SetCosignerRequired(DoSetup: boolean);
|
---|
| 84 | procedure FormatRequestList;
|
---|
| 85 | procedure ShowRequestList(ShouldShow: Boolean);
|
---|
| 86 | procedure ShowSurgCaseList(ShouldShow: Boolean);
|
---|
| 87 | procedure ShowClinProcFields(YesNo: boolean);
|
---|
| 88 | procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
|
---|
| 89 | public
|
---|
| 90 | { Public declarations }
|
---|
| 91 | end;
|
---|
| 92 |
|
---|
| 93 | function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
|
---|
| 94 | IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
|
---|
| 95 |
|
---|
| 96 | const
|
---|
| 97 |
|
---|
| 98 | TX_USER_INACTIVE = 'This entry can be selected, however their system account has been' +CRLF +
|
---|
| 99 | ' temporarily inactivated and that person should be contacted to resolve the issue.';
|
---|
| 100 |
|
---|
| 101 | TC_INACTIVE_USER = 'Inactive User Alert';
|
---|
| 102 |
|
---|
| 103 | implementation
|
---|
| 104 |
|
---|
| 105 | {$R *.DFM}
|
---|
| 106 |
|
---|
| 107 | uses uCore, rCore, rConsults, uConsults, rSurgery, uAccessibleListBox;
|
---|
| 108 |
|
---|
| 109 | { Initial values in ANote
|
---|
| 110 |
|
---|
| 111 | Title Type Author DateTime Cosigner Location Consult NeedCPT
|
---|
| 112 | New Note dflt 3 DUZ NOW dflt Encnt 0 ?
|
---|
| 113 | New DCSumm dflt 244 DUZ NOW dflt Encnt 0 ?
|
---|
| 114 | Edit Note ien 3 ien DtTm ien ien ien fld
|
---|
| 115 | Edit DCSumm ien 244 ien DtTm ien ien ien fld
|
---|
| 116 | Addend Note ien 81 DUZ NOW 0 N/A N/A? no
|
---|
| 117 | Addend DCSumm ien 81 DUZ NOW 0 N/A N/A? no
|
---|
| 118 |
|
---|
| 119 | New Note - setup as much as possible, then call ExecuteNoteProperties if necessary.
|
---|
| 120 |
|
---|
| 121 | }
|
---|
| 122 |
|
---|
| 123 | const
|
---|
| 124 | TX_CP_CAPTION = 'Clinical Procedure Document Properties';
|
---|
| 125 | TX_CP_TITLE = 'Document Title:';
|
---|
| 126 | TX_SR_CAPTION = 'Surgical Report Properties';
|
---|
| 127 | TX_SR_TITLE = 'Report Title:';
|
---|
| 128 | TC_REQ_FIELDS = 'Required Information';
|
---|
| 129 | TX_REQ_TITLE = CRLF + 'A title must be selected.';
|
---|
| 130 | TX_REQ_AUTHOR = CRLF + 'The author of the note must be identified.';
|
---|
| 131 | TX_REQ_REFDATE = CRLF + 'A valid date/time for the note must be entered.';
|
---|
| 132 | TX_REQ_COSIGNER = CRLF + 'A cosigner must be identified.';
|
---|
| 133 | TX_REQ_REQUEST = CRLF + 'This title requires the selection of an associated consult request.';
|
---|
| 134 | TX_REQ_SURGCASE = CRLF + 'This title requires the selection of an associated surgery case.';
|
---|
| 135 | TX_NO_FUTURE = CRLF + 'A reference date/time in the future is not allowed.';
|
---|
| 136 | TX_COS_SELF = CRLF + 'You cannot make yourself a cosigner.';
|
---|
| 137 | TX_COS_AUTH = CRLF + ' is not authorized to cosign this document.';
|
---|
| 138 | TX_REQ_PROCSUMMCODE = CRLF + 'A procedure summary code for this procedure must be entered.';
|
---|
| 139 | TX_REQ_PROCDATETIME = CRLF + 'A valid date/time for the procedure must be entered.';
|
---|
| 140 | TX_INVALID_PROCDATETIME = CRLF + 'If entered, the date/time for the procedure must be in a valid format.';
|
---|
| 141 | TX_NO_PROC_FUTURE = CRLF + 'A procedure date/time in the future is not allowed.';
|
---|
| 142 | TX_NO_TITLE_CHANGE = 'Interdisciplinary entries may not have their titles changed.';
|
---|
| 143 | TC_NO_TITLE_CHANGE = 'Title Change Not Allowed';
|
---|
| 144 | TX_NO_NEW_SURGERY = 'New surgery reports can only be entered via the Surgery package.';
|
---|
| 145 | TC_NO_NEW_SURGERY = 'Choose another title';
|
---|
| 146 | TX_UNRESOLVED_CONSULTS = 'You currently have consults awaiting resolution for this patient.' + CRLF +
|
---|
| 147 | 'Would you like to see a list of these consults?';
|
---|
| 148 | TX_ONE_NOTE_PER_VISIT1 = 'There is already a ';
|
---|
| 149 | TX_ONE_NOTE_PER_VISIT2 = CRLF + 'Only ONE record of this type per Visit is allowed...'+
|
---|
| 150 | CRLF + CRLF + 'You can addend the existing record.';
|
---|
| 151 |
|
---|
| 152 |
|
---|
| 153 | ACTIVE_STATUS = 'ACTIVE,PENDING,SCHEDULED';
|
---|
| 154 |
|
---|
| 155 |
|
---|
| 156 | var
|
---|
| 157 | uConsultsList: TStringList;
|
---|
| 158 | uShowUnresolvedOnly: boolean;
|
---|
| 159 |
|
---|
| 160 | function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
|
---|
| 161 | IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
|
---|
| 162 | var
|
---|
| 163 | frmNoteProperties: TfrmNoteProperties;
|
---|
| 164 | begin
|
---|
| 165 | frmNoteProperties := TfrmNoteProperties.Create(Application);
|
---|
| 166 | uConsultsList := TStringList.Create;
|
---|
| 167 | try
|
---|
| 168 | ResizeAnchoredFormToFont(frmNoteProperties);
|
---|
| 169 | with frmNoteProperties do
|
---|
| 170 | begin
|
---|
| 171 | // setup common fields (title, reference date, author)
|
---|
| 172 | FToday := FloatToStr(FMToday);
|
---|
| 173 | FCallingTab := CallingTab;
|
---|
| 174 | FIDNoteTitlesOnly := IDNoteTitlesOnly;
|
---|
| 175 | FClassName := AClassName;
|
---|
| 176 | FIsClinProcNote := (AClassName = DCL_CLINPROC);
|
---|
| 177 | FCPStatusFlag := CPStatusFlag;
|
---|
| 178 | uShowUnresolvedOnly := False;
|
---|
| 179 | if ANote.DocType <> TYP_ADDENDUM then
|
---|
| 180 | begin
|
---|
| 181 | case FCallingTab of
|
---|
| 182 | CT_CONSULTS: begin
|
---|
| 183 | Caption := 'Consult Note Properties';
|
---|
| 184 | cboNewTitle.InitLongList('');
|
---|
| 185 | if FIsClinProcNote then
|
---|
| 186 | begin
|
---|
| 187 | Caption := TX_CP_CAPTION;
|
---|
| 188 | lblNewTitle.Caption := TX_CP_TITLE;
|
---|
| 189 | ListClinProcTitlesShort(cboNewTitle.Items);
|
---|
| 190 | cboAuthor.InitLongList(User.Name);
|
---|
| 191 | cboAuthor.SelectByIEN(User.DUZ);
|
---|
| 192 | cboProcSummCode.SelectByIEN(ANote.ClinProcSummCode);
|
---|
| 193 | calProcDateTime.FMDateTime := ANote.ClinProcDateTime;
|
---|
| 194 | end
|
---|
| 195 | else // not CP note
|
---|
| 196 | begin
|
---|
| 197 | ListConsultTitlesShort(cboNewTitle.Items);
|
---|
| 198 | cboAuthor.InitLongList(ANote.AuthorName);
|
---|
| 199 | if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
|
---|
| 200 | end;
|
---|
| 201 | end ;
|
---|
| 202 | CT_SURGERY: begin
|
---|
| 203 | Caption := TX_SR_CAPTION;
|
---|
| 204 | lblNewTitle.Caption := TX_SR_TITLE;
|
---|
| 205 | cboNewTitle.InitLongList('');
|
---|
| 206 | cboAuthor.InitLongList(ANote.AuthorName);
|
---|
| 207 | if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
|
---|
| 208 | ListSurgeryTitlesShort(cboNewTitle.Items, FClassName);
|
---|
| 209 | end;
|
---|
| 210 | CT_NOTES: begin
|
---|
| 211 | Caption := 'Progress Note Properties';
|
---|
| 212 | if ANote.IsNewNote and UnresolvedConsultsExist then
|
---|
| 213 | uShowUnresolvedOnly := InfoBox(TX_UNRESOLVED_CONSULTS, 'Unresolved Consults Exist',
|
---|
| 214 | MB_YESNO or MB_ICONQUESTION) = IDYES;
|
---|
| 215 | cboNewTitle.InitLongList('');
|
---|
| 216 | cboAuthor.InitLongList(ANote.AuthorName);
|
---|
| 217 | if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
|
---|
| 218 | ListNoteTitlesShort(cboNewTitle.Items);
|
---|
| 219 | // HOW TO PREVENT TITLE CHANGE ON ID CHILD, BUT NOT ON INITIAL CREATE?????
|
---|
| 220 | cboNewTitle.Enabled := not ((ANote.IDParent > 0) and (ANote.Title > 0) and (not IsNewIDEntry));
|
---|
| 221 | if not cboNewTitle.Enabled then
|
---|
| 222 | begin
|
---|
| 223 | cboNewTitle.Color := clBtnFace;
|
---|
| 224 | InfoBox(TX_NO_TITLE_CHANGE, TC_NO_TITLE_CHANGE, MB_OK);
|
---|
| 225 | end;
|
---|
| 226 | end;
|
---|
| 227 | end;
|
---|
| 228 | end
|
---|
| 229 | else //if addendum
|
---|
| 230 | begin
|
---|
| 231 | Caption := 'Addendum Properties';
|
---|
| 232 | cboNewTitle.Items.Insert(0, IntToStr(ANote.Title) + U + ANote.TitleName);
|
---|
| 233 | cboAuthor.InitLongList(ANote.AuthorName);
|
---|
| 234 | if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
|
---|
| 235 | end;
|
---|
| 236 | ShowClinProcFields(FIsClinProcNote);
|
---|
| 237 | if ANote.Title > 0 then cboNewTitle.SelectByIEN(ANote.Title);
|
---|
| 238 | if (ANote.Title > 0) and (cboNewTitle.ItemIndex < 0)
|
---|
| 239 | then cboNewTitle.SetExactByIEN(ANote.Title, ANote.TitleName);
|
---|
| 240 | calNote.FMDateTime := ANote.DateTime;
|
---|
| 241 | // setup cosigner fields
|
---|
| 242 | FAddend := ANote.Addend;
|
---|
| 243 | FCosignIEN := ANote.Cosigner;
|
---|
| 244 | FCosignName := ANote.CosignerName;
|
---|
| 245 | FDocType := ANote.DocType;
|
---|
| 246 | FLastCosigner := ANote.LastCosigner;
|
---|
| 247 | FLastCosignerName := ANote.LastCosignerName;
|
---|
| 248 | SetCosignerRequired(True);
|
---|
| 249 | // setup package fields
|
---|
| 250 | case FCallingTab of
|
---|
| 251 | CT_CONSULTS: begin
|
---|
| 252 | ShowRequestList(False);
|
---|
| 253 | ShowSurgCaseList(False);
|
---|
| 254 | end;
|
---|
| 255 | CT_SURGERY : begin
|
---|
| 256 | ShowRequestList(False);
|
---|
| 257 | ShowSurgCaseList(False);
|
---|
| 258 | end;
|
---|
| 259 | CT_NOTES : begin
|
---|
| 260 | if IsConsultTitle(ANote.Title) then
|
---|
| 261 | begin
|
---|
| 262 | ShowRequestList(True);
|
---|
| 263 | ShowSurgCaseList(False);
|
---|
| 264 | end
|
---|
| 265 | else if IsSurgeryTitle(ANote.Title) then
|
---|
| 266 | begin
|
---|
| 267 | ShowSurgCaseList(True);
|
---|
| 268 | ShowRequestList(False);
|
---|
| 269 | end
|
---|
| 270 | else
|
---|
| 271 | begin
|
---|
| 272 | ShowRequestList(False);
|
---|
| 273 | ShowSurgCaseList(False);
|
---|
| 274 | end;
|
---|
| 275 | end;
|
---|
| 276 | end;
|
---|
| 277 | // restrict edit of title if addendum
|
---|
| 278 | if FDocType = TYP_ADDENDUM then
|
---|
| 279 | begin
|
---|
| 280 | lblNewTitle.Caption := 'Addendum to:';
|
---|
| 281 | cboNewTitle.Enabled := False;
|
---|
| 282 | cboNewTitle.Color := clBtnFace;
|
---|
| 283 | end;
|
---|
| 284 | cboNewTitle.Caption := lblNewTitle.Caption;
|
---|
| 285 | cboNewTitleExit(frmNoteProperties); // force display of request/case list
|
---|
| 286 | if uShowUnresolvedOnly then // override previous display if SHOW ME clicked on entrance
|
---|
| 287 | begin
|
---|
| 288 | cboNewTitle.ItemIndex := -1;
|
---|
| 289 | uShowUnresolvedOnly := not uShowUnresolvedOnly;
|
---|
| 290 | FormatRequestList;
|
---|
| 291 | end ;
|
---|
| 292 | TAccessibleListBox.WrapControl(cboNewTitle);
|
---|
| 293 | try
|
---|
| 294 | Result := ShowModal = idOK; // display the form
|
---|
| 295 | finally
|
---|
| 296 | TAccessibleListBox.UnwrapControl(cboNewTitle);
|
---|
| 297 | end;
|
---|
| 298 | if Result then with ANote do
|
---|
| 299 | begin
|
---|
| 300 | if FDocType <> TYP_ADDENDUM then
|
---|
| 301 | begin
|
---|
| 302 | Title := cboNewTitle.ItemIEN;
|
---|
| 303 | TitleName := PrintNameForTitle(Title);
|
---|
| 304 | end;
|
---|
| 305 | IsNewNote := False;
|
---|
| 306 | DateTime := calNote.FMDateTime;
|
---|
| 307 | Author := cboAuthor.ItemIEN;
|
---|
| 308 | AuthorName := Piece(cboAuthor.Items[cboAuthor.ItemIndex], U, 2);
|
---|
| 309 | if cboCosigner.Visible then
|
---|
| 310 | begin
|
---|
| 311 | Cosigner := cboCosigner.ItemIEN;
|
---|
| 312 | CosignerName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
|
---|
| 313 | // The LastCosigner fields are used to default the cosigner in subsequent notes.
|
---|
| 314 | // These fields are not reset with new notes & not passed into TIU.
|
---|
| 315 | LastCosigner := Cosigner;
|
---|
| 316 | LastCosignerName := CosignerName;
|
---|
| 317 | end else
|
---|
| 318 | begin
|
---|
| 319 | Cosigner := 0;
|
---|
| 320 | CosignerName := '';
|
---|
| 321 | end;
|
---|
| 322 | if FIsClinProcNote then
|
---|
| 323 | begin
|
---|
| 324 | ClinProcSummCode := FProcSummCode;
|
---|
| 325 | ClinProcDateTime := FProcDateTime;
|
---|
| 326 | if Location <= 0 then
|
---|
| 327 | begin
|
---|
| 328 | Location := Encounter.Location;
|
---|
| 329 | LocationName := Encounter.LocationName;
|
---|
| 330 | end;
|
---|
| 331 | if VisitDate <= 0 then VisitDate := Encounter.DateTime;
|
---|
| 332 | end;
|
---|
| 333 | case FCallingTab of
|
---|
| 334 | CT_CONSULTS: ;// no action required
|
---|
| 335 | CT_SURGERY : ;// no action required
|
---|
| 336 | (*begin
|
---|
| 337 | PkgIEN := lstSurgery.ItemIEN;
|
---|
| 338 | PkgPtr := PKG_SURGERY;
|
---|
| 339 | PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
|
---|
| 340 | end;*)
|
---|
| 341 | CT_NOTES : begin
|
---|
| 342 | if pnlConsults.Visible then
|
---|
| 343 | begin
|
---|
| 344 | PkgIEN := lstRequests.ItemIEN;
|
---|
| 345 | PkgPtr := PKG_CONSULTS;
|
---|
| 346 | PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
|
---|
| 347 | end
|
---|
| 348 | else if pnlSurgery.Visible then
|
---|
| 349 | begin
|
---|
| 350 | PkgIEN := lstSurgery.ItemIEN;
|
---|
| 351 | PkgPtr := PKG_SURGERY;
|
---|
| 352 | PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
|
---|
| 353 | end;
|
---|
| 354 | end;
|
---|
| 355 | end;
|
---|
| 356 | end;
|
---|
| 357 | end;
|
---|
| 358 | finally
|
---|
| 359 | if Assigned(uConsultsList) then uConsultsList.Free;
|
---|
| 360 | frmNoteProperties.Free;
|
---|
| 361 | end;
|
---|
| 362 | end;
|
---|
| 363 |
|
---|
| 364 | { Form events }
|
---|
| 365 |
|
---|
| 366 | procedure TfrmNoteProperties.FormShow(Sender: TObject);
|
---|
| 367 | begin
|
---|
| 368 | //if cboNewTitle.Text = '' then PostMessage(Handle, UM_DELAYEVENT, 0, 0);
|
---|
| 369 | end;
|
---|
| 370 |
|
---|
| 371 | procedure TfrmNoteProperties.UMDelayEvent(var Message: TMessage);
|
---|
| 372 | { let the window finish displaying before dropping list box, otherwise listbox drop
|
---|
| 373 | in the design position rather then new windows position (ORCtrls bug?) }
|
---|
| 374 | begin
|
---|
| 375 | // Screen.Cursor := crArrow;
|
---|
| 376 | // FFixCursor := TRUE;
|
---|
| 377 | // cboNewTitle.DroppedDown := True;
|
---|
| 378 | // lblDateTime.Visible := False;
|
---|
| 379 | // lblAuthor.Visible := False;
|
---|
| 380 | // lblCosigner.Visible := False;
|
---|
| 381 | end;
|
---|
| 382 |
|
---|
| 383 | { General calls }
|
---|
| 384 |
|
---|
| 385 | procedure TfrmNoteProperties.SetCosignerRequired(DoSetup: boolean);
|
---|
| 386 | { called initially & whenever title or author changes }
|
---|
| 387 | begin
|
---|
| 388 | if FDocType = TYP_ADDENDUM then
|
---|
| 389 | begin
|
---|
| 390 | lblCosigner.Visible := AskCosignerForDocument(FAddend, cboAuthor.ItemIEN)
|
---|
| 391 | end else
|
---|
| 392 | begin
|
---|
| 393 | if cboNewTitle.ItemIEN = 0
|
---|
| 394 | then lblCosigner.Visible := AskCosignerForTitle(FDocType, cboAuthor.ItemIEN)
|
---|
| 395 | else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN);
|
---|
| 396 | end;
|
---|
| 397 | cboCosigner.Visible := lblCosigner.Visible;
|
---|
| 398 | if DoSetup then
|
---|
| 399 | begin
|
---|
| 400 | if lblCosigner.Visible then
|
---|
| 401 | begin
|
---|
| 402 | if FCosignIEN = 0 then
|
---|
| 403 | begin
|
---|
| 404 | FCosignIEN := FLastCosigner;
|
---|
| 405 | FCosignName := FLastCosignerName;
|
---|
| 406 | end;
|
---|
| 407 | if FCosignIEN = 0 then DefaultCosigner(FCosignIEN, FCosignName);
|
---|
| 408 | cboCosigner.InitLongList(FCosignName);
|
---|
| 409 | if FCosignIEN > 0 then cboCosigner.SelectByIEN(FCosignIEN);
|
---|
| 410 | end
|
---|
| 411 | else // if lblCosigner not visible, clear values {v19.10 - RV}
|
---|
| 412 | begin
|
---|
| 413 | FCosignIEN := 0;
|
---|
| 414 | FCosignName := '';
|
---|
| 415 | cboCosigner.ItemIndex := -1;
|
---|
| 416 | end;
|
---|
| 417 | end;
|
---|
| 418 | end;
|
---|
| 419 |
|
---|
| 420 | procedure TfrmNoteProperties.ShowRequestList(ShouldShow: Boolean);
|
---|
| 421 | { called initially & whenever title changes }
|
---|
| 422 | const
|
---|
| 423 | ALL_CONSULTS = 'The following consults are currently available for selection:';
|
---|
| 424 | UNRESOLVED_CONSULTS = 'The following consults are currently awaiting resolution:';
|
---|
| 425 | var
|
---|
| 426 | i: Integer;
|
---|
| 427 | SavedIEN: integer;
|
---|
| 428 | begin
|
---|
| 429 | if FDocType = TYP_ADDENDUM then ShouldShow := False;
|
---|
| 430 | if ShouldShow then
|
---|
| 431 | begin
|
---|
| 432 | SavedIEN := lstRequests.ItemIEN;
|
---|
| 433 | for i := 0 to Pred(ControlCount) do
|
---|
| 434 | if Controls[i].Tag = 1 then Controls[i].Visible := True;
|
---|
| 435 | pnlConsults.Align := alBottom;
|
---|
| 436 | ClientHeight := cboCosigner.Top + cboCosigner.Height + 6 + pnlConsults.Height;
|
---|
| 437 | lstRequests.Items.Clear;
|
---|
| 438 | if uConsultsList.Count = 0 then ListConsultRequests(uConsultsList);
|
---|
| 439 | if uShowUnresolvedOnly then
|
---|
| 440 | begin
|
---|
| 441 | for i := 0 to uConsultsList.Count - 1 do
|
---|
| 442 | if Pos(Piece(uConsultsList[i], U, 5), ACTIVE_STATUS) > 0 then
|
---|
| 443 | lstRequests.Items.Add(uConsultsList[i]);
|
---|
| 444 | lblConsult2.Caption := UNRESOLVED_CONSULTS;
|
---|
| 445 | end
|
---|
| 446 | else
|
---|
| 447 | begin
|
---|
| 448 | lblConsult2.Caption := ALL_CONSULTS;
|
---|
| 449 | lstRequests.Items.Assign(uConsultsList);
|
---|
| 450 | end;
|
---|
| 451 | lblConsult1.Visible := (cboNewTitle.ItemIndex > -1);
|
---|
| 452 | lstRequests.SelectByIEN(SavedIEN);
|
---|
| 453 | end else
|
---|
| 454 | begin
|
---|
| 455 | for i := 0 to Pred(ControlCount) do
|
---|
| 456 | if Controls[i].Tag = 1 then Controls[i].Visible := False;
|
---|
| 457 | ClientHeight := cboCosigner.Top + cboCosigner.Height + 6;
|
---|
| 458 | end;
|
---|
| 459 | end;
|
---|
| 460 |
|
---|
| 461 | procedure TfrmNoteProperties.ShowSurgCaseList(ShouldShow: Boolean);
|
---|
| 462 | { called initially & whenever title changes }
|
---|
| 463 | var
|
---|
| 464 | i: Integer;
|
---|
| 465 | begin
|
---|
| 466 | if FDocType = TYP_ADDENDUM then ShouldShow := False;
|
---|
| 467 | if ShouldShow then
|
---|
| 468 | begin
|
---|
| 469 | for i := 0 to Pred(ControlCount) do
|
---|
| 470 | if Controls[i].Tag = 2 then Controls[i].Visible := True;
|
---|
| 471 | pnlSurgery.Align := alBottom;
|
---|
| 472 | ClientHeight := cboCosigner.Top + cboCosigner.Height + 6 + pnlSurgery.Height;
|
---|
| 473 | if lstSurgery.Items.Count = 0 then ListSurgeryCases(lstSurgery.Items);
|
---|
| 474 | end else
|
---|
| 475 | begin
|
---|
| 476 | for i := 0 to Pred(ControlCount) do
|
---|
| 477 | if Controls[i].Tag = 2 then Controls[i].Visible := False;
|
---|
| 478 | ClientHeight := cboCosigner.Top + cboCosigner.Height + 6;
|
---|
| 479 | end;
|
---|
| 480 | end;
|
---|
| 481 |
|
---|
| 482 | { cboNewTitle events }
|
---|
| 483 |
|
---|
| 484 | procedure TfrmNoteProperties.cboNewTitleNeedData(Sender: TObject; const StartFrom: string;
|
---|
| 485 | Direction, InsertAt: Integer);
|
---|
| 486 | begin
|
---|
| 487 | case FCallingTab of
|
---|
| 488 | CT_CONSULTS: begin
|
---|
| 489 | if FIsClinProcNote then
|
---|
| 490 | cboNewTitle.ForDataUse(SubSetOfClinProcTitles(StartFrom, Direction, FIDNoteTitlesOnly))
|
---|
| 491 | else
|
---|
| 492 | cboNewTitle.ForDataUse(SubSetOfConsultTitles(StartFrom, Direction, FIDNoteTitlesOnly));
|
---|
| 493 | end;
|
---|
| 494 | CT_SURGERY: cboNewTitle.ForDataUse(SubSetOfSurgeryTitles(StartFrom, Direction, FClassName));
|
---|
| 495 | CT_NOTES: cboNewTitle.ForDataUse(SubSetOfNoteTitles(StartFrom, Direction, FIDNoteTitlesOnly));
|
---|
| 496 | end;
|
---|
| 497 | end;
|
---|
| 498 |
|
---|
| 499 | procedure TfrmNoteProperties.cboNewTitleEnter(Sender: TObject);
|
---|
| 500 | begin
|
---|
| 501 | FLastTitle := 0;
|
---|
| 502 | end;
|
---|
| 503 |
|
---|
| 504 | procedure TfrmNoteProperties.cboNewTitleMouseClick(Sender: TObject);
|
---|
| 505 | begin
|
---|
| 506 | with cboNewTitle do
|
---|
| 507 | if (ItemIEN > 0) and (ItemIEN = FLastTitle) then Exit
|
---|
| 508 | else if ItemIEN = 0 then
|
---|
| 509 | begin
|
---|
| 510 | if FLastTitle > 0 then SelectByIEN(FLastTitle)
|
---|
| 511 | else ItemIndex := -1;
|
---|
| 512 | //Exit;
|
---|
| 513 | end;
|
---|
| 514 | case FCallingTab of
|
---|
| 515 | CT_CONSULTS: ; // no action
|
---|
| 516 | CT_SURGERY : ; // no action
|
---|
| 517 | CT_NOTES : if IsConsultTitle(cboNewTitle.ItemIEN) then
|
---|
| 518 | begin
|
---|
| 519 | ShowSurgCaseList(False);
|
---|
| 520 | ShowRequestList(True);
|
---|
| 521 | end
|
---|
| 522 | else if IsSurgeryTitle(cboNewTitle.ItemIEN) then
|
---|
| 523 | begin
|
---|
| 524 | ShowRequestList(False);
|
---|
| 525 | ShowSurgCaseList(True);
|
---|
| 526 | end
|
---|
| 527 | else
|
---|
| 528 | begin
|
---|
| 529 | ShowRequestList(False);
|
---|
| 530 | ShowSurgCaseList(False);
|
---|
| 531 | end;
|
---|
| 532 | end;
|
---|
| 533 | SetCosignerRequired(True);
|
---|
| 534 | FLastTitle := cboNewTitle.ItemIEN;
|
---|
| 535 | end;
|
---|
| 536 |
|
---|
| 537 | procedure TfrmNoteProperties.cboNewTitleExit(Sender: TObject);
|
---|
| 538 | begin
|
---|
| 539 | if cboNewTitle.ItemIEN <> FLastTitle then cboNewTitleMouseClick(Self);
|
---|
| 540 | end;
|
---|
| 541 |
|
---|
| 542 | procedure TfrmNoteProperties.cboNewTitleDblClick(Sender: TObject);
|
---|
| 543 | begin
|
---|
| 544 | cmdOKClick(Self);
|
---|
| 545 | end;
|
---|
| 546 |
|
---|
| 547 | { cboAuthor & cboCosigner events }
|
---|
| 548 |
|
---|
| 549 | procedure TfrmNoteProperties.NewPersonNeedData(Sender: TObject; const StartFrom: String;
|
---|
| 550 | Direction, InsertAt: Integer);
|
---|
| 551 | begin
|
---|
| 552 | (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
|
---|
| 553 | end;
|
---|
| 554 |
|
---|
| 555 | procedure TfrmNoteProperties.cboAuthorEnter(Sender: TObject);
|
---|
| 556 | begin
|
---|
| 557 | FLastAuthor := 0;
|
---|
| 558 | end;
|
---|
| 559 |
|
---|
| 560 | procedure TfrmNoteProperties.cboAuthorMouseClick(Sender: TObject);
|
---|
| 561 | begin
|
---|
| 562 | SetCosignerRequired(True);
|
---|
| 563 | FLastAuthor := cboAuthor.ItemIEN;
|
---|
| 564 | end;
|
---|
| 565 |
|
---|
| 566 | procedure TfrmNoteProperties.cboAuthorExit(Sender: TObject);
|
---|
| 567 | begin
|
---|
| 568 | if cboAuthor.ItemIEN <> FLastAuthor then cboAuthorMouseClick(Self);
|
---|
| 569 | end;
|
---|
| 570 |
|
---|
| 571 | procedure TfrmNoteProperties.cboCosignerExit(Sender: TObject);
|
---|
| 572 | { make sure FCosign fields stay up to date in case SetCosigner gets called again }
|
---|
| 573 | //var x: string;
|
---|
| 574 | begin
|
---|
| 575 | with cboCosigner do if Text = '' then ItemIndex := -1;
|
---|
| 576 | FCosignIEN := cboCosigner.ItemIEN;
|
---|
| 577 | FCosignName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
|
---|
| 578 | end;
|
---|
| 579 |
|
---|
| 580 | { Command Button events }
|
---|
| 581 |
|
---|
| 582 | procedure TfrmNoteProperties.cmdOKClick(Sender: TObject);
|
---|
| 583 | var
|
---|
| 584 | ErrMsg, WhyNot, AlertMsg: string;
|
---|
| 585 | begin
|
---|
| 586 | cmdOK.SetFocus; // make sure cbo exit events fire
|
---|
| 587 | Application.ProcessMessages;
|
---|
| 588 | (* case FCallingTab of
|
---|
| 589 | CT_CONSULTS: ; //no action
|
---|
| 590 | CT_SURGERY : ; //no action
|
---|
| 591 | CT_NOTES : if IsConsultTitle(cboNewTitle.ItemIEN) then
|
---|
| 592 | ShowRequestList(True)
|
---|
| 593 | else if IsSurgeryTitle(cboNewTitle.ItemIEN) then
|
---|
| 594 | { TODO -oRich V. -cSurgery/TIU : Disallow new surgery notes here - MUST be business rule for "BE ENTERED": }
|
---|
| 595 | // New TIU RPC required, to check user and title against business rules.
|
---|
| 596 | // Must allow OK button click if surgery title on edit of surgery original.
|
---|
| 597 | // Can't pre-screen titles because need to allow change on edit.
|
---|
| 598 | // May need additional logic here to distinguish between NEW or EDITED document.
|
---|
| 599 | ShowSurgCaseList(True)
|
---|
| 600 | else
|
---|
| 601 | begin
|
---|
| 602 | ShowRequestList(False);
|
---|
| 603 | ShowSurgCaseList(False);
|
---|
| 604 | end;
|
---|
| 605 | end;*)
|
---|
| 606 | SetCosignerRequired(False);
|
---|
| 607 | ErrMsg := '';
|
---|
| 608 | if cboNewTitle.ItemIEN = 0 then
|
---|
| 609 | ErrMsg := ErrMsg + TX_REQ_TITLE
|
---|
| 610 | //code added 12/2002 check note parm - one per visit GRE
|
---|
| 611 | else if OneNotePerVisit(CboNewTitle.ItemIEN, Patient.DFN, Encounter.VisitStr)then
|
---|
| 612 | ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1
|
---|
| 613 | + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2)
|
---|
| 614 | + TX_ONE_NOTE_PER_VISIT2
|
---|
| 615 | else
|
---|
| 616 | begin
|
---|
| 617 | if FIDNoteTitlesOnly then
|
---|
| 618 | begin
|
---|
| 619 | if (not CanTitleBeIDChild(cboNewTitle.ItemIEN, WhyNot)) then
|
---|
| 620 | ErrMsg := ErrMsg + CRLF + WhyNot;
|
---|
| 621 | end
|
---|
| 622 | else
|
---|
| 623 | begin
|
---|
| 624 | if ((pnlConsults.Visible) and (lstRequests.ItemIndex < 0)) then
|
---|
| 625 | ErrMsg := ErrMsg + TX_REQ_REQUEST
|
---|
| 626 | else if ((pnlSurgery.Visible) and (lstSurgery.ItemIndex < 0)) then
|
---|
| 627 | ErrMsg := ErrMsg + TX_REQ_SURGCASE
|
---|
| 628 | end;
|
---|
| 629 | end;
|
---|
| 630 | if cboAuthor.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_AUTHOR;
|
---|
| 631 | if not calNote.IsValid then ErrMsg := ErrMsg + TX_REQ_REFDATE;
|
---|
| 632 | if calNote.IsValid and (calNote.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_FUTURE;
|
---|
| 633 | if cboCosigner.Visible then
|
---|
| 634 | begin
|
---|
| 635 | if (cboCosigner.ItemIEN = 0) then ErrMsg := ErrMsg + TX_REQ_COSIGNER;
|
---|
| 636 | //if (cboCosigner.ItemIEN = User.DUZ) then ErrMsg := TX_COS_SELF; // (CanCosign will do this check)
|
---|
| 637 | if (cboCosigner.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboCosigner.ItemIEN)
|
---|
| 638 | then ErrMsg := cboCosigner.Text + TX_COS_AUTH;
|
---|
| 639 | //code added 02/2003 check if User is Inactive GRE
|
---|
| 640 | if UserInactive(IntToStr(cboCosigner.ItemIEN)) then
|
---|
| 641 | if (InfoBox(fNoteProps.TX_USER_INACTIVE, TC_INACTIVE_USER, MB_OKCANCEL)= IDCANCEL) then exit;
|
---|
| 642 | end;
|
---|
| 643 | if FIsClinProcNote then
|
---|
| 644 | begin
|
---|
| 645 | if (FCPStatusFlag = CP_INSTR_INCOMPLETE) then
|
---|
| 646 | begin
|
---|
| 647 | if cboProcSummCode.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_PROCSUMMCODE
|
---|
| 648 | else FProcSummCode := cboProcSummCode.ItemIEN;
|
---|
| 649 | if not calProcDateTime.IsValid then ErrMsg := ErrMsg + TX_REQ_PROCDATETIME
|
---|
| 650 | else if calProcDateTime.IsValid and (calProcDateTime.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_PROC_FUTURE
|
---|
| 651 | else FProcDateTime := calProcDateTime.FMDateTime;
|
---|
| 652 | end
|
---|
| 653 | else
|
---|
| 654 | begin
|
---|
| 655 | FProcSummCode := cboProcSummCode.ItemIEN;
|
---|
| 656 | if (calProcDateTime.FMDateTime > 0) then
|
---|
| 657 | begin
|
---|
| 658 | if (not calProcDateTime.IsValid) then ErrMsg := ErrMsg + TX_INVALID_PROCDATETIME
|
---|
| 659 | else if calProcDateTime.IsValid and (calProcDateTime.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_PROC_FUTURE
|
---|
| 660 | else FProcDateTime := calProcDateTime.FMDateTime;
|
---|
| 661 | end;
|
---|
| 662 | end;
|
---|
| 663 | end;
|
---|
| 664 | if ShowMsgOn(Length(ErrMsg) > 0, ErrMsg, TC_REQ_FIELDS)
|
---|
| 665 | then Exit
|
---|
| 666 | else ModalResult := mrOK;
|
---|
| 667 |
|
---|
| 668 | //Code added to handle inactive users. 2/26/03
|
---|
| 669 | if ShowMsgOn(Length(AlertMsg) > 0, AlertMsg, TC_INACTIVE_USER ) then
|
---|
| 670 | ModalResult := mrOK;
|
---|
| 671 | end;
|
---|
| 672 |
|
---|
| 673 | procedure TfrmNoteProperties.cmdCancelClick(Sender: TObject);
|
---|
| 674 | begin
|
---|
| 675 | ModalResult := mrCancel;
|
---|
| 676 | //Close;
|
---|
| 677 | end;
|
---|
| 678 |
|
---|
| 679 | procedure TfrmNoteProperties.cboNewTitleDropDownClose(Sender: TObject);
|
---|
| 680 | begin
|
---|
| 681 | // if FFixCursor then
|
---|
| 682 | // begin
|
---|
| 683 | // Screen.Cursor := crDefault;
|
---|
| 684 | // FFixCursor := FALSE;
|
---|
| 685 | // end;
|
---|
| 686 | // lblDateTime.Visible := True;
|
---|
| 687 | // lblAuthor.Visible := True;
|
---|
| 688 | // lblCosigner.Visible := True;
|
---|
| 689 | end;
|
---|
| 690 |
|
---|
| 691 | procedure TfrmNoteProperties.cboCosignerNeedData(Sender: TObject;
|
---|
| 692 | const StartFrom: String; Direction, InsertAt: Integer);
|
---|
| 693 | begin
|
---|
| 694 | (Sender as TORComboBox).ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction, FToday));
|
---|
| 695 | end;
|
---|
| 696 |
|
---|
| 697 | procedure TfrmNoteProperties.ShowClinProcFields(YesNo: boolean);
|
---|
| 698 | begin
|
---|
| 699 | lblProcSummCode.Visible := YesNo;
|
---|
| 700 | cboProcSummCode.Visible := YesNo;
|
---|
| 701 | lblProcDateTime.Visible := YesNo;
|
---|
| 702 | calProcDateTime.Visible := YesNo;
|
---|
| 703 | end;
|
---|
| 704 |
|
---|
| 705 | procedure TfrmNoteProperties.btnShowListClick(Sender: TObject);
|
---|
| 706 | begin
|
---|
| 707 | FormatRequestList;
|
---|
| 708 | end;
|
---|
| 709 |
|
---|
| 710 | procedure TfrmNoteProperties.FormatRequestList;
|
---|
| 711 | const
|
---|
| 712 | SHOW_UNRESOLVED = 'Show Unresolved';
|
---|
| 713 | SHOW_ALL = 'Show All';
|
---|
| 714 | begin
|
---|
| 715 | uShowUnresolvedOnly := not uShowUnresolvedOnly;
|
---|
| 716 | with btnShowList do
|
---|
| 717 | if uShowUnresolvedOnly then
|
---|
| 718 | Caption := SHOW_ALL
|
---|
| 719 | else
|
---|
| 720 | Caption := SHOW_UNRESOLVED;
|
---|
| 721 | ShowRequestList(True);
|
---|
| 722 | end;
|
---|
| 723 |
|
---|
| 724 | procedure TfrmNoteProperties.FormResize(Sender: TObject);
|
---|
| 725 | const
|
---|
| 726 | SPACE: integer = 10;
|
---|
| 727 | begin
|
---|
| 728 | cboNewTitle.Width := Self.ClientWidth - cboNewTitle.Left - cmdOK.Width - SPACE * 2;
|
---|
| 729 | cmdOK.Left := Self.ClientWidth - cmdOK.Width - SPACE;
|
---|
| 730 | cmdCancel.Left := Self.ClientWidth - cmdCancel.Width - SPACE;
|
---|
| 731 | if (cboAuthor.Width + cboAuthor.Left) > Self.ClientWidth then
|
---|
| 732 | cboAuthor.Width := Self.ClientWidth - cboAuthor.Left - SPACE;
|
---|
| 733 | end;
|
---|
| 734 |
|
---|
| 735 | procedure TfrmNoteProperties.calNoteEnter(Sender: TObject);
|
---|
| 736 | begin
|
---|
| 737 | if Sender is TORDateBox then
|
---|
| 738 | (Sender as TORDateBox).SelectAll;
|
---|
| 739 | end;
|
---|
| 740 |
|
---|
| 741 | end.
|
---|