source: cprs/branches/foia-cprs/CPRS-Chart/fNoteProps.pas@ 459

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

Adding foia-cprs branch
File size: 29.2 KB
Line 
1unit fNoteProps;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORDtTm, ORCtrls, ExtCtrls, rTIU, uConst, uTIU, ORFn, ORNet;
8
9type
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
93function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
94 IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
95
96const
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
103implementation
104
105{$R *.DFM}
106
107uses 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
123const
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
156var
157 uConsultsList: TStringList;
158 uShowUnresolvedOnly: boolean;
159
160function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
161 IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
162var
163 frmNoteProperties: TfrmNoteProperties;
164begin
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;
362end;
363
364{ Form events }
365
366procedure TfrmNoteProperties.FormShow(Sender: TObject);
367begin
368 //if cboNewTitle.Text = '' then PostMessage(Handle, UM_DELAYEVENT, 0, 0);
369end;
370
371procedure 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?) }
374begin
375// Screen.Cursor := crArrow;
376// FFixCursor := TRUE;
377// cboNewTitle.DroppedDown := True;
378// lblDateTime.Visible := False;
379// lblAuthor.Visible := False;
380// lblCosigner.Visible := False;
381end;
382
383{ General calls }
384
385procedure TfrmNoteProperties.SetCosignerRequired(DoSetup: boolean);
386{ called initially & whenever title or author changes }
387begin
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;
418end;
419
420procedure TfrmNoteProperties.ShowRequestList(ShouldShow: Boolean);
421{ called initially & whenever title changes }
422const
423 ALL_CONSULTS = 'The following consults are currently available for selection:';
424 UNRESOLVED_CONSULTS = 'The following consults are currently awaiting resolution:';
425var
426 i: Integer;
427 SavedIEN: integer;
428begin
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;
459end;
460
461procedure TfrmNoteProperties.ShowSurgCaseList(ShouldShow: Boolean);
462{ called initially & whenever title changes }
463var
464 i: Integer;
465begin
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;
480end;
481
482{ cboNewTitle events }
483
484procedure TfrmNoteProperties.cboNewTitleNeedData(Sender: TObject; const StartFrom: string;
485 Direction, InsertAt: Integer);
486begin
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;
497end;
498
499procedure TfrmNoteProperties.cboNewTitleEnter(Sender: TObject);
500begin
501 FLastTitle := 0;
502end;
503
504procedure TfrmNoteProperties.cboNewTitleMouseClick(Sender: TObject);
505begin
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;
535end;
536
537procedure TfrmNoteProperties.cboNewTitleExit(Sender: TObject);
538begin
539 if cboNewTitle.ItemIEN <> FLastTitle then cboNewTitleMouseClick(Self);
540end;
541
542procedure TfrmNoteProperties.cboNewTitleDblClick(Sender: TObject);
543begin
544 cmdOKClick(Self);
545end;
546
547{ cboAuthor & cboCosigner events }
548
549procedure TfrmNoteProperties.NewPersonNeedData(Sender: TObject; const StartFrom: String;
550 Direction, InsertAt: Integer);
551begin
552 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
553end;
554
555procedure TfrmNoteProperties.cboAuthorEnter(Sender: TObject);
556begin
557 FLastAuthor := 0;
558end;
559
560procedure TfrmNoteProperties.cboAuthorMouseClick(Sender: TObject);
561begin
562 SetCosignerRequired(True);
563 FLastAuthor := cboAuthor.ItemIEN;
564end;
565
566procedure TfrmNoteProperties.cboAuthorExit(Sender: TObject);
567begin
568 if cboAuthor.ItemIEN <> FLastAuthor then cboAuthorMouseClick(Self);
569end;
570
571procedure TfrmNoteProperties.cboCosignerExit(Sender: TObject);
572{ make sure FCosign fields stay up to date in case SetCosigner gets called again }
573//var x: string;
574begin
575 with cboCosigner do if Text = '' then ItemIndex := -1;
576 FCosignIEN := cboCosigner.ItemIEN;
577 FCosignName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
578end;
579
580{ Command Button events }
581
582procedure TfrmNoteProperties.cmdOKClick(Sender: TObject);
583var
584 ErrMsg, WhyNot, AlertMsg: string;
585begin
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;
671end;
672
673procedure TfrmNoteProperties.cmdCancelClick(Sender: TObject);
674begin
675 ModalResult := mrCancel;
676 //Close;
677end;
678
679procedure TfrmNoteProperties.cboNewTitleDropDownClose(Sender: TObject);
680begin
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;
689end;
690
691procedure TfrmNoteProperties.cboCosignerNeedData(Sender: TObject;
692 const StartFrom: String; Direction, InsertAt: Integer);
693begin
694 (Sender as TORComboBox).ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction, FToday));
695end;
696
697procedure TfrmNoteProperties.ShowClinProcFields(YesNo: boolean);
698begin
699 lblProcSummCode.Visible := YesNo;
700 cboProcSummCode.Visible := YesNo;
701 lblProcDateTime.Visible := YesNo;
702 calProcDateTime.Visible := YesNo;
703end;
704
705procedure TfrmNoteProperties.btnShowListClick(Sender: TObject);
706begin
707 FormatRequestList;
708end;
709
710procedure TfrmNoteProperties.FormatRequestList;
711const
712 SHOW_UNRESOLVED = 'Show Unresolved';
713 SHOW_ALL = 'Show All';
714begin
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);
722end;
723
724procedure TfrmNoteProperties.FormResize(Sender: TObject);
725const
726 SPACE: integer = 10;
727begin
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;
733end;
734
735procedure TfrmNoteProperties.calNoteEnter(Sender: TObject);
736begin
737 if Sender is TORDateBox then
738 (Sender as TORDateBox).SelectAll;
739end;
740
741end.
Note: See TracBrowser for help on using the repository browser.