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

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

Uploading from OR_30_258
File size: 36.1 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 ComCtrls, Buttons;
9
10type
11 {This object holds a List of Actions as Returned VIA the RPCBroker}
12 TPRFActions = class(TObject)
13 private
14 FPRFActionList : TStringList;
15 public
16 //procedure to show the Action in a ListView, requires a listview parameter
17 procedure ShowActionsOnList(DisplayList : TCaptionListView);
18 //procedure to load the actions, this will call the RPC
19 procedure Load(TitleIEN : Int64; DFN : String);
20 //returns true if the Action at the Index passed is associated with a note
21 function SelActionHasNote(lstIndex : integer) : boolean;
22 //return the Action IEN at the Index passed
23 function GetActionIEN(lstIndex : integer) : String;
24 //return the PRF IEN at the Index passed
25 function GetPRF_IEN(lstIndex : integer) : integer;
26 constructor Create();
27 destructor Destroy(); override;
28 end;
29
30 TfrmNoteProperties = class(TForm)
31 lblNewTitle: TLabel;
32 cboNewTitle: TORComboBox;
33 lblDateTime: TLabel;
34 calNote: TORDateBox;
35 lblAuthor: TLabel;
36 cboAuthor: TORComboBox;
37 lblCosigner: TLabel;
38 cboCosigner: TORComboBox;
39 cmdOK: TButton;
40 cmdCancel: TButton;
41 pnlConsults: TORAutoPanel;
42 lblConsult1: TLabel;
43 lblConsult2: TLabel;
44 lblCsltDate: TLabel;
45 lblCsltServ: TLabel;
46 lblCsltProc: TLabel;
47 lblCsltStat: TLabel;
48 lblCsltNotes: TLabel;
49 lstRequests: TORListBox;
50 bvlConsult: TBevel;
51 pnlSurgery: TORAutoPanel;
52 lblSurgery1: TStaticText;
53 lblSurgery2: TStaticText;
54 lblSurgDate: TLabel;
55 lblSurgProc: TLabel;
56 lblSurgeon: TLabel;
57 lstSurgery: TORListBox;
58 bvlSurgery: TBevel;
59 cboProcSummCode: TORComboBox;
60 lblProcSummCode: TOROffsetLabel;
61 calProcDateTime: TORDateBox;
62 lblProcDateTime: TOROffsetLabel;
63 btnShowList: TButton;
64 pnlPRF: TORAutoPanel;
65 lblPRF: TLabel;
66 Bevel1: TBevel;
67 lvPRF: TCaptionListView;
68 btnDetails: TButton;
69 procedure FormShow(Sender: TObject);
70 procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String;
71 Direction, InsertAt: Integer);
72 procedure NewPersonNeedData(Sender: TObject; const StartFrom: String;
73 Direction, InsertAt: Integer);
74 procedure cmdOKClick(Sender: TObject);
75 procedure cmdCancelClick(Sender: TObject);
76 procedure cboNewTitleExit(Sender: TObject);
77 procedure cboNewTitleMouseClick(Sender: TObject);
78 procedure cboNewTitleEnter(Sender: TObject);
79 procedure cboCosignerExit(Sender: TObject);
80 procedure cboAuthorExit(Sender: TObject);
81 procedure cboAuthorMouseClick(Sender: TObject);
82 procedure cboAuthorEnter(Sender: TObject);
83 procedure cboNewTitleDropDownClose(Sender: TObject);
84 procedure cboNewTitleDblClick(Sender: TObject);
85 procedure cboCosignerNeedData(Sender: TObject; const StartFrom: String;
86 Direction, InsertAt: Integer);
87 procedure btnShowListClick(Sender: TObject);
88 procedure FormResize(Sender: TObject);
89 procedure calNoteEnter(Sender: TObject);
90 procedure FormDestroy(Sender: TObject);
91 procedure btnDetailsClick(Sender: TObject);
92 procedure lstRequestsChange(Sender: TObject);
93 private
94 FCosignIEN: Int64; // store cosigner that was passed in
95 FCosignName: string; // store cosigner that was passed in
96 FDocType: Integer; // store document type that was passed in
97 FAddend: Integer; // store IEN of note being addended (if make addendum)
98 FLastAuthor: Int64; // set by mouseclick to avoid redundant call on exit
99 FLastTitle: Integer; // set by mouseclick to avoid redundant call on exit
100 //FFixCursor: Boolean; // to fix the problem where the list box is an I-bar
101 FLastCosigner: Int64; // holds cosigner from previous note (for defaulting)
102 FLastCosignerName: string; // holds cosigner from previous note (for defaulting)
103 FCallingTab: integer;
104 FIDNoteTitlesOnly: boolean;
105 FToday: string;
106 FClassName: string;
107 FIsClinProcNote: boolean;
108 FProcSummCode: integer;
109 FProcDateTime: TFMDateTime;
110 FCPStatusFlag: integer;
111 FPRFActions : TPRFActions;
112 FStarting: boolean;
113 procedure SetCosignerRequired(DoSetup: boolean);
114 procedure FormatRequestList;
115 procedure ShowRequestList(ShouldShow: Boolean);
116 procedure ShowSurgCaseList(ShouldShow: Boolean);
117 procedure ShowPRFList(ShouldShow: Boolean);
118 procedure ShowClinProcFields(YesNo: boolean);
119 procedure SetGenericFormSize;
120 procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
121 public
122 { Public declarations }
123
124 end;
125
126
127function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
128 IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
129
130const
131
132 TX_USER_INACTIVE = 'This entry can be selected, however their system account has been' +CRLF +
133 ' temporarily inactivated and that person should be contacted to resolve the issue.';
134
135 TC_INACTIVE_USER = 'Inactive User Alert';
136
137 PIXEL_SPACE = 6;
138
139implementation
140
141{$R *.DFM}
142
143uses uCore, rCore, rConsults, uConsults, rSurgery, uAccessibleListBox, fRptBox;
144
145{ Initial values in ANote
146
147 Title Type Author DateTime Cosigner Location Consult NeedCPT
148 New Note dflt 3 DUZ NOW dflt Encnt 0 ?
149 New DCSumm dflt 244 DUZ NOW dflt Encnt 0 ?
150 Edit Note ien 3 ien DtTm ien ien ien fld
151 Edit DCSumm ien 244 ien DtTm ien ien ien fld
152 Addend Note ien 81 DUZ NOW 0 N/A N/A? no
153 Addend DCSumm ien 81 DUZ NOW 0 N/A N/A? no
154
155 New Note - setup as much as possible, then call ExecuteNoteProperties if necessary.
156
157}
158
159const
160 TX_CP_CAPTION = 'Clinical Procedure Document Properties';
161 TX_CP_TITLE = 'Document Title:';
162 TX_SR_CAPTION = 'Surgical Report Properties';
163 TX_SR_TITLE = 'Report Title:';
164 TC_REQ_FIELDS = 'Required Information';
165 TX_REQ_TITLE = CRLF + 'A title must be selected.';
166 TX_REQ_AUTHOR = CRLF + 'The author of the note must be identified.';
167 TX_REQ_REFDATE = CRLF + 'A valid date/time for the note must be entered.';
168 TX_REQ_COSIGNER = CRLF + 'A cosigner must be identified.';
169 TX_REQ_REQUEST = CRLF + 'This title requires the selection of an associated consult request.';
170 TX_REQ_SURGCASE = CRLF + 'This title requires the selection of an associated surgery case.';
171 TX_REQ_PRF_ACTION = CRLF + 'Notes of this title require the selection of a patient record flag action.';
172 TX_REQ_PRF_NOTE = CRLF + 'This action has already been assigned to another note.';
173 TX_NO_FUTURE = CRLF + 'A reference date/time in the future is not allowed.';
174 TX_COS_SELF = CRLF + 'You cannot make yourself a cosigner.';
175 TX_COS_AUTH = CRLF + ' is not authorized to cosign this document.';
176 TX_REQ_PROCSUMMCODE = CRLF + 'A procedure summary code for this procedure must be entered.';
177 TX_REQ_PROCDATETIME = CRLF + 'A valid date/time for the procedure must be entered.';
178 TX_INVALID_PROCDATETIME = CRLF + 'If entered, the date/time for the procedure must be in a valid format.';
179 TX_NO_PROC_FUTURE = CRLF + 'A procedure date/time in the future is not allowed.';
180 TX_NO_TITLE_CHANGE = 'Interdisciplinary entries may not have their titles changed.';
181 TC_NO_TITLE_CHANGE = 'Title Change Not Allowed';
182 TX_NO_NEW_SURGERY = 'New surgery reports can only be entered via the Surgery package.';
183 TC_NO_NEW_SURGERY = 'Choose another title';
184 TX_UNRESOLVED_CONSULTS = 'You currently have consults awaiting resolution for this patient.' + CRLF +
185 'Would you like to see a list of these consults?';
186 TX_ONE_NOTE_PER_VISIT1 = 'There is already a ';
187 TX_ONE_NOTE_PER_VISIT2 = CRLF + 'Only ONE record of this type per Visit is allowed...'+
188 CRLF + CRLF + 'You can addend the existing record.';
189
190
191 ACTIVE_STATUS = 'ACTIVE,PENDING,SCHEDULED';
192
193 PRF_LABEL = 'Which Patient Record Flag Action should this Note be linked to?';
194
195 FLAG_NAME = 1;
196 PRF_IEN = 2;
197 ACTION_NAME = 3;
198 ACTION_IEN = 4;
199 ACTION_DATE_I = 5;
200 ACTION_DATE = 6;
201 NOTE_IEN = 7;
202
203
204var
205 uConsultsList: TStringList;
206 uShowUnresolvedOnly: boolean;
207
208function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
209 IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
210var
211 frmNoteProperties: TfrmNoteProperties;
212begin
213 frmNoteProperties := TfrmNoteProperties.Create(Application);
214 uConsultsList := TStringList.Create;
215 try
216 ResizeAnchoredFormToFont(frmNoteProperties);
217 with frmNoteProperties do
218 begin
219 // setup common fields (title, reference date, author)
220 FToday := FloatToStr(FMToday);
221 FCallingTab := CallingTab;
222 FIDNoteTitlesOnly := IDNoteTitlesOnly;
223 FClassName := AClassName;
224 FIsClinProcNote := (AClassName = DCL_CLINPROC);
225 FCPStatusFlag := CPStatusFlag;
226 //uShowUnresolvedOnly := False; //v26.5 (RV)
227 uShowUnresolvedOnly := True; //v26.5 (RV)
228 if ANote.DocType <> TYP_ADDENDUM then
229 begin
230 case FCallingTab of
231 CT_CONSULTS: begin
232 Caption := 'Consult Note Properties';
233 cboNewTitle.InitLongList('');
234 if FIsClinProcNote then
235 begin
236 Caption := TX_CP_CAPTION;
237 lblNewTitle.Caption := TX_CP_TITLE;
238 ListClinProcTitlesShort(cboNewTitle.Items);
239 cboAuthor.InitLongList(User.Name);
240 cboAuthor.SelectByIEN(User.DUZ);
241 cboProcSummCode.SelectByIEN(ANote.ClinProcSummCode);
242 calProcDateTime.FMDateTime := ANote.ClinProcDateTime;
243 end
244 else // not CP note
245 begin
246 ListConsultTitlesShort(cboNewTitle.Items);
247 cboAuthor.InitLongList(ANote.AuthorName);
248 if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
249 end;
250 end ;
251 CT_SURGERY: begin
252 Caption := TX_SR_CAPTION;
253 lblNewTitle.Caption := TX_SR_TITLE;
254 cboNewTitle.InitLongList('');
255 cboAuthor.InitLongList(ANote.AuthorName);
256 if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
257 ListSurgeryTitlesShort(cboNewTitle.Items, FClassName);
258 end;
259 CT_NOTES: begin
260 Caption := 'Progress Note Properties';
261 if ANote.IsNewNote then
262 begin
263 GetUnresolvedConsultsInfo; // v26.5 (RV) removed nag screen
264 end;
265 cboNewTitle.InitLongList('');
266 cboAuthor.InitLongList(ANote.AuthorName);
267 if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
268 ListNoteTitlesShort(cboNewTitle.Items);
269 // HOW TO PREVENT TITLE CHANGE ON ID CHILD, BUT NOT ON INITIAL CREATE?????
270 cboNewTitle.Enabled := not ((ANote.IDParent > 0) and (ANote.Title > 0) and (not IsNewIDEntry));
271 if not cboNewTitle.Enabled then
272 begin
273 cboNewTitle.Color := clBtnFace;
274 InfoBox(TX_NO_TITLE_CHANGE, TC_NO_TITLE_CHANGE, MB_OK);
275 end;
276 end;
277 end;
278 end
279 else //if addendum
280 begin
281 Caption := 'Addendum Properties';
282 cboNewTitle.Items.Insert(0, IntToStr(ANote.Title) + U + ANote.TitleName);
283 cboAuthor.InitLongList(ANote.AuthorName);
284 if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
285 end;
286 ShowClinProcFields(FIsClinProcNote);
287 FStarting := True;
288 if ANote.Title > 0 then cboNewTitle.SelectByIEN(ANote.Title);
289 if (ANote.Title > 0) and (cboNewTitle.ItemIndex < 0)
290 then cboNewTitle.SetExactByIEN(ANote.Title, ANote.TitleName);
291 FStarting := False;
292 calNote.FMDateTime := ANote.DateTime;
293 // setup cosigner fields
294 FAddend := ANote.Addend;
295 FCosignIEN := ANote.Cosigner;
296 FCosignName := ANote.CosignerName;
297 FDocType := ANote.DocType;
298 FLastCosigner := ANote.LastCosigner;
299 FLastCosignerName := ANote.LastCosignerName;
300 SetCosignerRequired(True);
301 // setup package fields
302 SetGenericFormSize;
303 case FCallingTab of
304 CT_CONSULTS: begin
305 ShowRequestList(False);
306 ShowSurgCaseList(False);
307 ShowPRFList(False);
308 end;
309 CT_SURGERY : begin
310 ShowRequestList(False);
311 ShowSurgCaseList(False);
312 ShowPRFList(False);
313 end;
314 CT_NOTES : begin
315 with uUnresolvedConsults do // v26.5 (RV)
316 ShowRequestList(IsConsultTitle(ANote.Title) or
317 (UnresolvedConsultsExist and ShowNagScreen)); // v26.5 (RV)
318 ShowSurgCaseList(IsSurgeryTitle(ANote.Title));
319 ShowPRFList(IsPRFTitle(ANote.Title));
320 end;
321 end;
322 // restrict edit of title if addendum
323 if FDocType = TYP_ADDENDUM then
324 begin
325 lblNewTitle.Caption := 'Addendum to:';
326 cboNewTitle.Enabled := False;
327 cboNewTitle.Color := clBtnFace;
328 end;
329 cboNewTitle.Caption := lblNewTitle.Caption;
330 FStarting := True;
331 cboNewTitleExit(frmNoteProperties); // force display of request/case list
332 FStarting := False;
333 if uShowUnresolvedOnly then // override previous display if SHOW ME clicked on entrance
334 begin
335 //cboNewTitle.ItemIndex := -1; CQ#7587, v26.25 - RV
336 uShowUnresolvedOnly := not uShowUnresolvedOnly;
337 FormatRequestList;
338 end ;
339 TAccessibleListBox.WrapControl(cboNewTitle);
340 try
341 Result := ShowModal = idOK; // display the form
342 finally
343 TAccessibleListBox.UnwrapControl(cboNewTitle);
344 end;
345 if Result then with ANote do
346 begin
347 if FDocType <> TYP_ADDENDUM then
348 begin
349 Title := cboNewTitle.ItemIEN;
350 TitleName := PrintNameForTitle(Title);
351 end;
352 IsNewNote := False;
353 DateTime := calNote.FMDateTime;
354 Author := cboAuthor.ItemIEN;
355 AuthorName := Piece(cboAuthor.Items[cboAuthor.ItemIndex], U, 2);
356 if cboCosigner.Visible then
357 begin
358 Cosigner := cboCosigner.ItemIEN;
359 CosignerName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
360 // The LastCosigner fields are used to default the cosigner in subsequent notes.
361 // These fields are not reset with new notes & not passed into TIU.
362 LastCosigner := Cosigner;
363 LastCosignerName := CosignerName;
364 end else
365 begin
366 Cosigner := 0;
367 CosignerName := '';
368 end;
369 if FIsClinProcNote then
370 begin
371 ClinProcSummCode := FProcSummCode;
372 ClinProcDateTime := FProcDateTime;
373 if Location <= 0 then
374 begin
375 Location := Encounter.Location;
376 LocationName := Encounter.LocationName;
377 end;
378 if VisitDate <= 0 then VisitDate := Encounter.DateTime;
379 end;
380 case FCallingTab of
381 CT_CONSULTS: ;// no action required
382 CT_SURGERY : ;// no action required
383 (*begin
384 PkgIEN := lstSurgery.ItemIEN;
385 PkgPtr := PKG_SURGERY;
386 PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
387 end;*)
388 CT_NOTES : begin
389 if pnlConsults.Visible then
390 begin
391 PkgIEN := lstRequests.ItemIEN;
392 PkgPtr := PKG_CONSULTS;
393 PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
394 end
395 else if pnlSurgery.Visible then
396 begin
397 PkgIEN := lstSurgery.ItemIEN;
398 PkgPtr := PKG_SURGERY;
399 PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
400 end
401 else if pnlPRF.Visible then //PRF
402 begin
403 PRF_IEN := FPRFActions.GetPRF_IEN(lvPRF.ItemIndex);
404 ActionIEN := FPRFActions.GetActionIEN(lvPRF.ItemIndex);
405 end;
406 end;
407 end;
408 end;
409 end;
410 finally
411 if Assigned(uConsultsList) then uConsultsList.Free;
412 frmNoteProperties.Free;
413 end;
414end;
415
416{ Form events }
417
418procedure TfrmNoteProperties.FormShow(Sender: TObject);
419begin
420 //if cboNewTitle.Text = '' then PostMessage(Handle, UM_DELAYEVENT, 0, 0);
421end;
422
423procedure TfrmNoteProperties.UMDelayEvent(var Message: TMessage);
424{ let the window finish displaying before dropping list box, otherwise listbox drop
425 in the design position rather then new windows position (ORCtrls bug?) }
426begin
427// Screen.Cursor := crArrow;
428// FFixCursor := TRUE;
429// cboNewTitle.DroppedDown := True;
430// lblDateTime.Visible := False;
431// lblAuthor.Visible := False;
432// lblCosigner.Visible := False;
433end;
434
435{ General calls }
436
437procedure TfrmNoteProperties.SetCosignerRequired(DoSetup: boolean);
438{ called initially & whenever title or author changes }
439begin
440 if FDocType = TYP_ADDENDUM then
441 begin
442 lblCosigner.Visible := AskCosignerForDocument(FAddend, cboAuthor.ItemIEN)
443 end else
444 begin
445 if cboNewTitle.ItemIEN = 0
446 then lblCosigner.Visible := AskCosignerForTitle(FDocType, cboAuthor.ItemIEN, calNote.FMDateTime)
447 else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN, calNote.FMDateTime);
448 end;
449 cboCosigner.Visible := lblCosigner.Visible;
450 if DoSetup then
451 begin
452 if lblCosigner.Visible then
453 begin
454 if FCosignIEN = 0 then
455 begin
456 FCosignIEN := FLastCosigner;
457 FCosignName := FLastCosignerName;
458 end;
459 if FCosignIEN = 0 then DefaultCosigner(FCosignIEN, FCosignName);
460 cboCosigner.InitLongList(FCosignName);
461 if FCosignIEN > 0 then cboCosigner.SelectByIEN(FCosignIEN);
462 end
463 else // if lblCosigner not visible, clear values {v19.10 - RV}
464 begin
465 FCosignIEN := 0;
466 FCosignName := '';
467 cboCosigner.ItemIndex := -1;
468 end;
469 end;
470end;
471
472procedure TfrmNoteProperties.ShowRequestList(ShouldShow: Boolean);
473{ called initially & whenever title changes }
474const
475 ALL_CONSULTS = 'The following consults are currently available for selection:';
476 UNRESOLVED_CONSULTS = 'The following consults are currently awaiting resolution:';
477var
478 i: Integer;
479 SavedIEN: integer;
480begin
481 ShouldShow := ShouldShow and (FCallingTab = CT_NOTES);
482 if FDocType = TYP_ADDENDUM then ShouldShow := False;
483 pnlConsults.Visible := ShouldShow;
484 if ShouldShow then
485 begin
486 SavedIEN := lstRequests.ItemIEN;
487 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlConsults.Height;
488 lstRequests.Items.Clear;
489 if uConsultsList.Count = 0 then ListConsultRequests(uConsultsList);
490 if uShowUnresolvedOnly then
491 begin
492 for i := 0 to uConsultsList.Count - 1 do
493 if Pos(Piece(uConsultsList[i], U, 5), ACTIVE_STATUS) > 0 then
494 lstRequests.Items.Add(uConsultsList[i]);
495 lblConsult2.Caption := UNRESOLVED_CONSULTS;
496 end
497 else
498 begin
499 lblConsult2.Caption := ALL_CONSULTS;
500 lstRequests.Items.Assign(uConsultsList);
501 end;
502 lblConsult1.Visible := (cboNewTitle.ItemIndex > -1);
503 lstRequests.SelectByIEN(SavedIEN);
504 btnDetails.Enabled := (lstRequests.ItemIndex > -1);
505 end
506end;
507
508procedure TfrmNoteProperties.ShowSurgCaseList(ShouldShow: Boolean);
509{ called initially & whenever title changes }
510begin
511 pnlSurgery.Visible := ShouldShow;
512 if FDocType = TYP_ADDENDUM then ShouldShow := False;
513 if ShouldShow then
514 begin
515 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlSurgery.Height;
516 if lstSurgery.Items.Count = 0 then ListSurgeryCases(lstSurgery.Items);
517 end
518end;
519
520{ cboNewTitle events }
521
522procedure TfrmNoteProperties.cboNewTitleNeedData(Sender: TObject; const StartFrom: string;
523 Direction, InsertAt: Integer);
524begin
525 case FCallingTab of
526 CT_CONSULTS: begin
527 if FIsClinProcNote then
528 cboNewTitle.ForDataUse(SubSetOfClinProcTitles(StartFrom, Direction, FIDNoteTitlesOnly))
529 else
530 cboNewTitle.ForDataUse(SubSetOfConsultTitles(StartFrom, Direction, FIDNoteTitlesOnly));
531 end;
532 CT_SURGERY: cboNewTitle.ForDataUse(SubSetOfSurgeryTitles(StartFrom, Direction, FClassName));
533 CT_NOTES: cboNewTitle.ForDataUse(SubSetOfNoteTitles(StartFrom, Direction, FIDNoteTitlesOnly));
534 end;
535end;
536
537procedure TfrmNoteProperties.cboNewTitleEnter(Sender: TObject);
538begin
539 FLastTitle := 0;
540end;
541
542procedure TfrmNoteProperties.cboNewTitleMouseClick(Sender: TObject);
543const
544 TX_NEED_CONSULT_TITLE = 'You currently have unresolved consults awaiting completion.' + CRLF +
545 'The selected title cannot be used to complete consults.' + CRLF +
546 'You must select a Consults title to complete a consult.' + CRLF + CRLF +
547 'Answer "YES" to continue with this title and not complete a consult.' + CRLF +
548 'Answer "NO" to select a different title.' + CRLF + CRLF +
549 'Do you want to use this title and continue?';
550 TC_NOT_CONSULT_TITLE = 'Not a consult title';
551var
552 WantsToCompleteConsult: boolean;
553 ConsultTitle: boolean;
554begin
555 with cboNewTitle do
556 if (ItemIEN > 0) and (ItemIEN = FLastTitle) then Exit
557 else if ItemIEN = 0 then
558 begin
559 if FLastTitle > 0 then SelectByIEN(FLastTitle)
560 else ItemIndex := -1;
561 //Exit;
562 end;
563 case FCallingTab of
564 CT_CONSULTS: ; // no action
565 CT_SURGERY : ; // no action
566 CT_NOTES : begin // v26.5 (RV) main changes here
567 WantsToCompleteConsult := False;
568 ConsultTitle := IsConsultTitle(cboNewTitle.ItemIEN);
569 if (pnlConsults.Visible) and
570 (lstRequests.Items.Count > 0) and
571 (not FStarting) and
572 (*(lstRequests.ItemID <> '') and*)
573 (not ConsultTitle) then
574 WantsToCompleteConsult := (InfoBox(TX_NEED_CONSULT_TITLE,
575 TC_NOT_CONSULT_TITLE,
576 MB_ICONWARNING or MB_YESNO or MB_DEFBUTTON2) = IDNO);
577 if WantsToCompleteConsult and (not ConsultTitle) then cboNewTitle.ItemIndex := -1;
578 SetGenericFormSize;
579 ShowRequestList(WantsToCompleteConsult or ConsultTitle);
580 ShowSurgCaseList(IsSurgeryTitle(cboNewTitle.ItemIEN));
581 ShowPRFList(IsPRFTitle(cboNewTitle.ItemIEN));
582 end;
583 end;
584 SetCosignerRequired(True);
585 FLastTitle := cboNewTitle.ItemIEN;
586end;
587
588procedure TfrmNoteProperties.cboNewTitleExit(Sender: TObject);
589begin
590 if cboNewTitle.ItemIEN <> FLastTitle then cboNewTitleMouseClick(Self);
591end;
592
593procedure TfrmNoteProperties.cboNewTitleDblClick(Sender: TObject);
594begin
595 cmdOKClick(Self);
596end;
597
598{ cboAuthor & cboCosigner events }
599
600procedure TfrmNoteProperties.NewPersonNeedData(Sender: TObject; const StartFrom: String;
601 Direction, InsertAt: Integer);
602begin
603 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
604end;
605
606procedure TfrmNoteProperties.cboAuthorEnter(Sender: TObject);
607begin
608 FLastAuthor := 0;
609end;
610
611procedure TfrmNoteProperties.cboAuthorMouseClick(Sender: TObject);
612begin
613 SetCosignerRequired(True);
614 FLastAuthor := cboAuthor.ItemIEN;
615end;
616
617procedure TfrmNoteProperties.cboAuthorExit(Sender: TObject);
618begin
619 if cboAuthor.ItemIEN <> FLastAuthor then cboAuthorMouseClick(Self);
620end;
621
622procedure TfrmNoteProperties.cboCosignerExit(Sender: TObject);
623{ make sure FCosign fields stay up to date in case SetCosigner gets called again }
624//var x: string;
625begin
626 with cboCosigner do if ((Text = '') or (ItemIEN = 0)) then
627 begin
628 ItemIndex := -1;
629 FCosignIEN := 0;
630 FCosignName := '';
631 exit;
632 end;
633 FCosignIEN := cboCosigner.ItemIEN;
634 FCosignName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
635end;
636
637{ Command Button events }
638
639procedure TfrmNoteProperties.cmdOKClick(Sender: TObject);
640var
641 ErrMsg, WhyNot, AlertMsg: string;
642begin
643 cmdOK.SetFocus; // make sure cbo exit events fire
644 Application.ProcessMessages;
645(* case FCallingTab of
646 CT_CONSULTS: ; //no action
647 CT_SURGERY : ; //no action
648 CT_NOTES : if IsConsultTitle(cboNewTitle.ItemIEN) then
649 ShowRequestList(True)
650 else if IsSurgeryTitle(cboNewTitle.ItemIEN) then
651{ TODO -oRich V. -cSurgery/TIU : Disallow new surgery notes here - MUST be business rule for "BE ENTERED": }
652 // New TIU RPC required, to check user and title against business rules.
653 // Must allow OK button click if surgery title on edit of surgery original.
654 // Can't pre-screen titles because need to allow change on edit.
655 // May need additional logic here to distinguish between NEW or EDITED document.
656 ShowSurgCaseList(True)
657 else
658 begin
659 ShowRequestList(False);
660 ShowSurgCaseList(False);
661 ShowPRFList(False);
662 end;
663 end;*)
664 SetCosignerRequired(False);
665 ErrMsg := '';
666 if cboNewTitle.ItemIEN = 0 then
667 ErrMsg := ErrMsg + TX_REQ_TITLE ;
668 if ErrMsg = '' then
669 begin
670 if FDocType = TYP_ADDENDUM then
671 begin
672 if OneNotePerVisit(TYP_ADDENDUM, Patient.DFN, Encounter.VisitStr)then
673 ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1
674 + 'Addendum to ' + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2)
675 + TX_ONE_NOTE_PER_VISIT2;
676 end
677 //code added 12/2002 check note parm - one per visit GRE
678 else if OneNotePerVisit(CboNewTitle.ItemIEN, Patient.DFN, Encounter.VisitStr)then
679 ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1
680 + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2)
681 + TX_ONE_NOTE_PER_VISIT2;
682 end;
683 if ErrMsg = '' then
684 begin
685 if FIDNoteTitlesOnly then
686 begin
687 if (not CanTitleBeIDChild(cboNewTitle.ItemIEN, WhyNot)) then
688 ErrMsg := ErrMsg + CRLF + WhyNot;
689 end
690 else
691 begin
692 if ((pnlConsults.Visible) and (lstRequests.ItemIndex < 0)) then
693 ErrMsg := ErrMsg + TX_REQ_REQUEST
694 else if ((pnlSurgery.Visible) and (lstSurgery.ItemIndex < 0)) then
695 ErrMsg := ErrMsg + TX_REQ_SURGCASE
696 else if (pnlPRF.Visible) then
697 begin
698 if (lvPRF.ItemIndex < 0) then
699 ErrMsg := ErrMsg + TX_REQ_PRF_ACTION
700 else if FPRFActions.SelActionHasNote(lvPRF.ItemIndex) then
701 ErrMsg := ErrMsg + TX_REQ_PRF_NOTE;
702 end;
703 end;
704 end;
705 if cboAuthor.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_AUTHOR;
706 if not calNote.IsValid then ErrMsg := ErrMsg + TX_REQ_REFDATE;
707 if calNote.IsValid and (calNote.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_FUTURE;
708 if cboCosigner.Visible then
709 begin
710 if (cboCosigner.ItemIEN = 0) then ErrMsg := ErrMsg + TX_REQ_COSIGNER;
711 //if (cboCosigner.ItemIEN = User.DUZ) then ErrMsg := TX_COS_SELF; // (CanCosign will do this check)
712 if (cboCosigner.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboCosigner.ItemIEN, calNote.FMDateTime)
713 then ErrMsg := cboCosigner.Text + TX_COS_AUTH;
714 //code added 02/2003 check if User is Inactive GRE
715 if UserInactive(IntToStr(cboCosigner.ItemIEN)) then
716 if (InfoBox(fNoteProps.TX_USER_INACTIVE, TC_INACTIVE_USER, MB_OKCANCEL)= IDCANCEL) then exit;
717 end;
718 if FIsClinProcNote then
719 begin
720 if (FCPStatusFlag = CP_INSTR_INCOMPLETE) then
721 begin
722 if cboProcSummCode.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_PROCSUMMCODE
723 else FProcSummCode := cboProcSummCode.ItemIEN;
724 if not calProcDateTime.IsValid then ErrMsg := ErrMsg + TX_REQ_PROCDATETIME
725 else if calProcDateTime.IsValid and (calProcDateTime.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_PROC_FUTURE
726 else FProcDateTime := calProcDateTime.FMDateTime;
727 end
728 else
729 begin
730 FProcSummCode := cboProcSummCode.ItemIEN;
731 if (calProcDateTime.FMDateTime > 0) then
732 begin
733 if (not calProcDateTime.IsValid) then ErrMsg := ErrMsg + TX_INVALID_PROCDATETIME
734 else if calProcDateTime.IsValid and (calProcDateTime.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_PROC_FUTURE
735 else FProcDateTime := calProcDateTime.FMDateTime;
736 end;
737 end;
738 end;
739 if ShowMsgOn(Length(ErrMsg) > 0, ErrMsg, TC_REQ_FIELDS)
740 then Exit
741 else ModalResult := mrOK;
742
743 //Code added to handle inactive users. 2/26/03
744 if ShowMsgOn(Length(AlertMsg) > 0, AlertMsg, TC_INACTIVE_USER ) then
745 ModalResult := mrOK;
746end;
747
748procedure TfrmNoteProperties.cmdCancelClick(Sender: TObject);
749begin
750 ModalResult := mrCancel;
751 //Close;
752end;
753
754procedure TfrmNoteProperties.cboNewTitleDropDownClose(Sender: TObject);
755begin
756// if FFixCursor then
757// begin
758// Screen.Cursor := crDefault;
759// FFixCursor := FALSE;
760// end;
761// lblDateTime.Visible := True;
762// lblAuthor.Visible := True;
763// lblCosigner.Visible := True;
764end;
765
766procedure TfrmNoteProperties.cboCosignerNeedData(Sender: TObject;
767 const StartFrom: String; Direction, InsertAt: Integer);
768begin
769 (Sender as TORComboBox).ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction, FToday));
770end;
771
772procedure TfrmNoteProperties.ShowClinProcFields(YesNo: boolean);
773begin
774 lblProcSummCode.Visible := YesNo;
775 cboProcSummCode.Visible := YesNo;
776 lblProcDateTime.Visible := YesNo;
777 calProcDateTime.Visible := YesNo;
778end;
779
780procedure TfrmNoteProperties.btnShowListClick(Sender: TObject);
781begin
782 FormatRequestList;
783end;
784
785procedure TfrmNoteProperties.FormatRequestList;
786const
787 SHOW_UNRESOLVED = 'Show Unresolved';
788 SHOW_ALL = 'Show All';
789begin
790 uShowUnresolvedOnly := not uShowUnresolvedOnly;
791 with btnShowList do
792 if uShowUnresolvedOnly then
793 Caption := SHOW_ALL
794 else
795 Caption := SHOW_UNRESOLVED;
796 with uUnresolvedConsults do if (UnresolvedConsultsExist and ShowNagScreen) then pnlConsults.Visible := TRUE; //v26.27 (RV)
797 ShowRequestList(pnlConsults.Visible); //v26.5 (RV)
798 //ShowRequestList(True); //v26.5 (RV)
799end;
800
801procedure TfrmNoteProperties.FormResize(Sender: TObject);
802const
803 SPACE: integer = 10;
804begin
805 cboNewTitle.Width := Self.ClientWidth - cboNewTitle.Left - cmdOK.Width - SPACE * 2;
806 cmdOK.Left := Self.ClientWidth - cmdOK.Width - SPACE;
807 cmdCancel.Left := Self.ClientWidth - cmdCancel.Width - SPACE;
808 if (cboAuthor.Width + cboAuthor.Left) > Self.ClientWidth then
809 cboAuthor.Width := Self.ClientWidth - cboAuthor.Left - SPACE;
810end;
811
812procedure TfrmNoteProperties.calNoteEnter(Sender: TObject);
813begin
814 if Sender is TORDateBox then
815 (Sender as TORDateBox).SelectAll;
816end;
817
818procedure TfrmNoteProperties.ShowPRFList(ShouldShow: Boolean);
819begin
820 pnlPRF.Visible := ShouldShow and not (FDocType = TYP_ADDENDUM);
821 if pnlPRF.Visible then
822 begin
823 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlPRF.Height;
824 if FPRFActions = nil then
825 FPRFActions := TPRFActions.Create;
826 FPRFActions.Load(cboNewTitle.ItemIEN,Patient.DFN);
827 if RPCBrokerV.Results.Count <> 0 then
828 lblPRF.Caption := PRF_LABEL
829 else
830 lblPRF.Caption := 'No Linkable Actions for this Patient and/or Title.';
831 FPRFActions.ShowActionsOnList(lvPRF);
832 //Fix for CQ: 6926
833 lvPRF.Columns.BeginUpdate;
834 lvPRF.Columns.EndUpdate;
835 //End Fix for CQ: 6926
836 end
837end;
838
839procedure TfrmNoteProperties.SetGenericFormSize;
840begin
841 ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE;
842end;
843
844{ TPRFActions }
845
846constructor TPRFActions.Create;
847begin
848 inherited;
849 FPRFActionList := TStringList.Create;
850end;
851
852destructor TPRFActions.Destroy;
853begin
854 FPRFActionList.Free;
855 inherited;
856end;
857
858function TPRFActions.GetActionIEN(lstIndex: integer): String;
859begin
860 Result := Piece(FPRFActionList[lstIndex],U,ACTION_IEN);
861end;
862
863function TPRFActions.GetPRF_IEN(lstIndex: integer): integer;
864begin
865 Result := StrToInt(Piece(FPRFActionList[lstIndex],U,PRF_IEN));
866end;
867
868procedure TPRFActions.Load(TitleIEN : Int64; DFN : String);
869begin
870 CallV('TIU GET PRF ACTIONS', [TitleIEN,DFN]);
871 FPRFActionList.Assign(RPCBrokerV.Results);
872end;
873
874function TPRFActions.SelActionHasNote(lstIndex: integer): boolean;
875begin
876 Result := false;
877 if Piece(FPRFActionList[lstIndex],U,NOTE_IEN) <> '' then
878 Result := true;
879end;
880
881procedure TPRFActions.ShowActionsOnList(DisplayList: TCaptionListView);
882var
883 i : integer;
884 ListItem: TListItem;
885begin
886 DisplayList.Clear;
887 for i := 0 to FPRFActionList.Count-1 do
888 begin
889 //Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note
890 ListItem := DisplayList.Items.Add;
891 ListItem.Caption := PRF_LABEL; //Screen readers don't read the first column title on a listview.
892 ListItem.SubItems.Add(Piece(FPRFActionList[i],U,FLAG_NAME));
893 ListItem.SubItems.Add(Piece(FPRFActionList[i],U,ACTION_DATE));
894 ListItem.SubItems.Add(Piece(FPRFActionList[i],U,ACTION_NAME));
895 if SelActionHasNote(i) then
896 ListItem.SubItems.Add('Yes')
897 else
898 ListItem.SubItems.Add('No');
899 end;
900end;
901
902procedure TfrmNoteProperties.FormDestroy(Sender: TObject);
903begin
904 FPRFActions.Free;
905end;
906
907procedure TfrmNoteProperties.btnDetailsClick(Sender: TObject);
908var
909 ConsultDetail: TStringList;
910begin
911 if lstRequests.ItemIEN <= 0 then exit;
912 ConsultDetail := TStringList.Create;
913 try
914 LoadConsultDetail(ConsultDetail, lstRequests.ItemIEN) ;
915 ReportBox(ConsultDetail, 'Consult Details: #' + lstRequests.ItemID + ' - ' +
916 Piece(lstRequests.Items[lstRequests.ItemIndex], U, 3), TRUE);
917 finally
918 ConsultDetail.Free;
919 end;
920end;
921
922procedure TfrmNoteProperties.lstRequestsChange(Sender: TObject);
923begin
924 btnDetails.Enabled := (lstRequests.ItemIEN > 0);
925end;
926
927end.
Note: See TracBrowser for help on using the repository browser.