source: cprs/trunk/CPRS-Chart/fNoteProps.pas

Last change on this file was 830, checked in by Kevin Toppenberg, 14 years ago

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