source: cprs/trunk/CPRS-Chart/fDCSummProps.pas@ 820

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 19.1 KB
Line 
1unit fDCSummProps;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORDtTm, ORCtrls, ExtCtrls, uConst, rTIU, rDCSumm, uDocTree, uDCSumm, uTIU;
8
9type
10 TfrmDCSummProperties = class(TForm)
11 bvlConsult: TBevel;
12 pnlFields: TORAutoPanel;
13 lblNewTitle: TLabel;
14 lblDateTime: TLabel;
15 lblAuthor: TLabel;
16 lblCosigner: TLabel;
17 cboNewTitle: TORComboBox;
18 calSumm: TORDateBox;
19 cboAuthor: TORComboBox;
20 cboAttending: TORComboBox;
21 pnlTranscription: TORAutoPanel;
22 lblTranscriptionist: TLabel;
23 lblUrgency: TLabel;
24 cboTranscriptionist: TORComboBox;
25 cboUrgency: TORComboBox;
26 pnlAdmissions: TORAutoPanel;
27 cmdOK: TButton;
28 cmdCancel: TButton;
29 pnlLabels: TORAutoPanel;
30 lblDCSumm1: TStaticText;
31 lblDCSumm2: TStaticText;
32 lblLocation: TLabel;
33 lblDate: TLabel;
34 lblType: TLabel;
35 lblSummStatus: TLabel;
36 lstAdmissions: TORListBox;
37 procedure FormShow(Sender: TObject);
38 procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String;
39 Direction, InsertAt: Integer);
40 procedure cboAuthorNeedData(Sender: TObject; const StartFrom: String;
41 Direction, InsertAt: Integer);
42 procedure cboAttendingNeedData(Sender: TObject; const StartFrom: String;
43 Direction, InsertAt: Integer);
44 procedure cmdOKClick(Sender: TObject);
45 procedure cmdCancelClick(Sender: TObject);
46 procedure cboNewTitleExit(Sender: TObject);
47 procedure cboNewTitleMouseClick(Sender: TObject);
48 procedure cboNewTitleEnter(Sender: TObject);
49 procedure cboAttendingExit(Sender: TObject);
50 procedure cboAuthorExit(Sender: TObject);
51 procedure cboAuthorMouseClick(Sender: TObject);
52 procedure cboAuthorEnter(Sender: TObject);
53 procedure cboNewTitleDropDownClose(Sender: TObject);
54 procedure lstAdmissionsChange(Sender: TObject);
55 procedure cboNewTitleDblClick(Sender: TObject);
56 procedure FormClose(Sender: TObject; var Action: TCloseAction);
57 private
58 FCosignIEN: Int64; // store cosigner that was passed in
59 FCosignName: string; // store cosigner that was passed in
60 FDocType: Integer; // store document type that was passed in
61 FAddend: Integer; // store IEN of note being addended (if make addendum)
62 FLastAuthor: Int64; // set by mouseclick to avoid redundant call on exit
63 FLastTitle: Integer; // set by mouseclick to avoid redundant call on exit
64 FAdmitDateTime: string ;
65 FLocation: integer;
66 FLocationName: string;
67 FVisitStr: string;
68 FEditIEN: integer;
69 //FFixCursor: Boolean; // to fix the problem where the list box is an I-bar
70 FLastCosigner: Int64; // holds cosigner from previous note (for defaulting)
71 FLastCosignerName: string; // holds cosigner from previous note (for defaulting)
72 FShowAdmissions: Boolean;
73 FIDNoteTitlesOnly: boolean;
74 procedure SetCosignerRequired;
75 procedure ShowAdmissionList;
76 procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
77 public
78 { Public declarations }
79 end;
80
81function ExecuteDCSummProperties(var ASumm: TEditDCSummRec; var ListBoxItem: string; ShowAdmissions, IDNoteTitlesOnly: boolean): Boolean;
82
83var
84 EditLines: TStringList;
85
86implementation
87
88{$R *.DFM}
89
90uses ORFn, uCore, rCore, uPCE, rPCE, rMisc;
91{ Initial values in ASumm
92
93 Title Type Author DateTime Cosigner Location Consult NeedCPT
94 New DCSumm dflt 244 DUZ NOW dflt Encnt 0 ?
95 Edit DCSumm ien 244 ien DtTm ien ien ien fld
96 Addend DCSumm ien 81 DUZ NOW 0 N/A N/A? no
97
98 New Summ - setup as much as possible, then call ExecuteDCSummProperties if necessary.
99
100}
101
102const
103 TC_REQ_FIELDS = 'Required Information';
104 TX_REQ_TITLE = CRLF + 'A title must be selected.';
105 TX_REQ_AUTHOR = CRLF + 'The author of the note must be identified.';
106 TX_REQ_REFDATE = CRLF + 'A valid date/time for the note must be entered.';
107 TX_REQ_COSIGNER = CRLF + 'An attending must be identified.';
108 TX_NO_FUTURE = CRLF + 'A reference date/time in the future is not allowed.';
109 TX_COS_SELF = CRLF + 'You cannot make yourself a cosigner.';
110 TX_COS_AUTH = CRLF + ' is not authorized to cosign this document.';
111 TX_BAD_ADMISSION = CRLF + 'Admission information is missing or invalid.';
112 TX_NO_ADMISSION = CRLF + 'An admission must be selected';
113 TX_NO_MORE_SUMMS = CRLF + 'Only one discharge summary may be written for each admission.';
114 TC_NO_EDIT = 'Unable to Edit';
115 TC_EDIT_EXISTING = 'Unsigned document in progress';
116 TX_EDIT_EXISTING = 'Would you like to continue editing the existing unsigned summary for this admission?';
117
118function ExecuteDCSummProperties(var ASumm: TEditDCSummRec; var ListBoxItem: string; ShowAdmissions, IDNoteTitlesOnly: boolean): Boolean;
119var
120 frmDCSummProperties: TfrmDCSummProperties;
121 x: string;
122begin
123 frmDCSummProperties := TfrmDCSummProperties.Create(Application);
124 EditLines := TStringList.Create;
125 try
126 ResizeAnchoredFormToFont(frmDCSummProperties);
127 with frmDCSummProperties do
128 begin
129 // setup common fields (title, reference date, author)
130 FShowAdmissions := ShowAdmissions;
131 FIDNoteTitlesOnly := IDNoteTitlesOnly;
132 pnlTranscription.Visible := False; {was never used on old form}
133 if not pnlTranscription.Visible then
134 begin
135 Height := Height - pnlTranscription.Height;
136 Top := Top - pnlTranscription.Height;
137 end;
138 Height := Height - pnlAdmissions.Height - pnlLabels.Height;
139 if ASumm.DocType <> TYP_ADDENDUM then
140 begin
141 cboNewTitle.InitLongList('');
142 ListDCSummTitlesShort(cboNewTitle.Items);
143 end
144 else //if addendum
145 cboNewTitle.Items.Insert(0, IntToStr(ASumm.Title) + U + ASumm.TitleName);
146 if ASumm.Title > 0 then cboNewTitle.SelectByIEN(ASumm.Title);
147 if (ASumm.Title > 0) and (cboNewTitle.ItemIndex < 0)
148 then cboNewTitle.SetExactByIEN(ASumm.Title, ASumm.TitleName);
149 cboAuthor.InitLongList(ASumm.DictatorName);
150 if ASumm.Dictator > 0 then cboAuthor.SelectByIEN(ASumm.Dictator);
151 cboUrgency.Items.Assign(LoadDCUrgencies);
152 cboUrgency.SelectByID('R');
153 if Asumm.Attending = 0 then
154 begin
155 ASumm.Attending := FLastCosigner;
156 ASumm.AttendingName := FLastCosignerName;
157 end;
158 cboAttending.InitLongList(ASumm.AttendingName);
159 if ASumm.Attending > 0 then cboAttending.SelectByIEN(ASumm.Attending);
160 calSumm.FMDateTime := ASumm.DictDateTime;
161 if FShowAdmissions then ShowAdmissionList;
162 FAddend := ASumm.Addend;
163 FDocType := ASumm.DocType;
164 FLastCosigner := ASumm.LastCosigner;
165 FLastCosignerName := ASumm.LastCosignerName;
166 FEditIEN := 0;
167 // restrict edit of title if addendum
168 if FDocType = TYP_ADDENDUM then
169 begin
170 lblNewTitle.Caption := 'Addendum to:';
171 cboNewTitle.Caption := 'Addendum to:';
172 cboNewTitle.Enabled := False;
173 cboNewTitle.Color := clBtnFace;
174 end;
175 Result := ShowModal = idOK; // display the form
176 if Result then with ASumm do
177 begin
178 if FDocType <> TYP_ADDENDUM then
179 begin
180 Title := cboNewTitle.ItemIEN;
181 TitleName := PrintNameForTitle(Title);
182 end;
183 Urgency := cboUrgency.ItemID;
184 DictDateTime := calSumm.FMDateTime;
185 Dictator := cboAuthor.ItemIEN;
186 DictatorName := Piece(cboAuthor.Items[cboAuthor.ItemIndex], U, 2);
187 Attending := cboAttending.ItemIEN;
188 AttendingName := Piece(cboAttending.Items[cboAttending.ItemIndex], U, 2);
189 if Attending = Dictator then Cosigner := 0 else
190 begin
191 Cosigner := cboAttending.ItemIEN;
192 CosignerName := Piece(cboAttending.Items[cboAttending.ItemIndex], U, 2);
193 // The LastCosigner fields are used to default the cosigner in subsequent notes.
194 // These fields are not reset with new notes & not passed into TIU.
195 LastCosigner := Cosigner;
196 LastCosignerName := CosignerName;
197 end;
198 Transcriptionist := cboTranscriptionist.ItemIEN;
199 if FShowAdmissions then
200 begin
201 AdmitDateTime := StrToFMDateTime(FAdmitDateTime);
202 DischargeDateTime := StrToFMDateTime(GetDischargeDate(Patient.DFN, FAdmitDateTime));
203 if DischargeDateTime <= 0 then DischargeDateTime := FMNow;
204 Location := FLocation;
205 LocationName := FLocationName;
206 VisitStr := IntToStr(Location) + ';' + FloatToStr(AdmitDateTime) + ';H' ;
207 end;
208 EditIEN := FEditIEN;
209 if FEditIEN > 0 then
210 begin
211 x := GetTIUListItem(FEditIEN);
212 ListBoxItem := x;
213 if Lines = nil then Lines := TStringList.Create;
214 Lines.Assign(EditLines);
215 end
216 else
217 begin
218 ListBoxItem := '';
219 end;
220 end;
221 // The following fields in TEditDCSummRec are not set:
222 // DocType, NeedCPT, Lines (unless editing an existing summary)
223 end;
224 finally
225 EditLines.Free;
226 frmDCSummProperties.Release;
227 end;
228end;
229
230{ Form events }
231
232procedure TfrmDCSummProperties.FormShow(Sender: TObject);
233begin
234 SetFormPosition(Self);
235 //if cboNewTitle.Text = '' then PostMessage(Handle, UM_DELAYEVENT, 0, 0);
236end;
237
238procedure TfrmDCSummProperties.UMDelayEvent(var Message: TMessage);
239{ let the window finish displaying before dropping list box, otherwise listbox drop
240 in the design position rather then new windows position (ORCtrls bug?) }
241begin
242(* Screen.Cursor := crArrow;
243 FFixCursor := TRUE;
244 cboNewTitle.DroppedDown := True;
245 lblDateTime.Visible := False;
246 lblAuthor.Visible := False;
247 lblCosigner.Visible := False;*)
248end;
249
250{ General calls }
251
252procedure TfrmDCSummProperties.SetCosignerRequired;
253{ called initially & whenever title or author changes }
254begin
255(* if FDocType = TYP_ADDENDUM then
256 begin
257 lblCosigner.Visible := AskCosignerForDocument(FAddend, cboAuthor.ItemIEN)
258 end else
259 begin
260 if cboNewTitle.ItemIEN = 0
261 then lblCosigner.Visible := AskCosignerForTitle(FDocType, cboAuthor.ItemIEN)
262 else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN);
263 end;*)
264 lblCosigner.Visible := True;
265 cboAttending.Visible := lblCosigner.Visible;
266end;
267
268procedure TfrmDCSummProperties.ShowAdmissionList;
269var
270 i, Status: integer;
271 x: string;
272begin
273 with lstAdmissions do
274 begin
275 ListAdmitAll(Items, Patient.DFN);
276 if Items.Count > 0 then
277 begin
278 for i := 0 to Items.Count-1 do
279 begin
280 x := Items[i];
281 SetPiece(x, '^', 8, FormatFMDateTimeStr('mmm dd,yyyy hh:nn', Piece(Items[i],U,1)));
282 Status := StrToIntDef(Piece(Items[i],U,7),0);
283 case Status of
284 0: x := x + '^None on file';
285 1: x := x + '^Completed';
286 2: x := x + '^Unsigned';
287 end;
288 Items[i] := x;
289 end;
290 end
291 else
292 FAdmitDateTime := '-1^No admissions were found for this patient.';
293 end;
294end;
295
296{ cboNewTitle events }
297
298procedure TfrmDCSummProperties.cboNewTitleNeedData(Sender: TObject; const StartFrom: string;
299 Direction, InsertAt: Integer);
300begin
301 cboNewTitle.ForDataUse(SubSetOfDCSummTitles(StartFrom, Direction, FIDNoteTitlesOnly));
302end;
303
304procedure TfrmDCSummProperties.cboNewTitleEnter(Sender: TObject);
305begin
306 FLastTitle := 0;
307end;
308
309procedure TfrmDCSummProperties.cboNewTitleMouseClick(Sender: TObject);
310begin
311 with cboNewTitle do
312 if (ItemIEN > 0) and (ItemIEN = FLastTitle) then Exit
313 else if ItemIEN = 0 then
314 begin
315 if FLastTitle > 0 then SelectByIEN(FLastTitle)
316 else ItemIndex := -1;
317 Exit;
318 end;
319 SetCosignerRequired;
320 if FShowAdmissions and (not pnlAdmissions.Visible) then
321 begin
322 Height := Height + pnlAdmissions.Height + pnlLabels.Height;
323 pnlAdmissions.Visible := True;
324 pnlLabels.Visible := True;
325 end;
326 FLastTitle := cboNewTitle.ItemIEN;
327end;
328
329procedure TfrmDCSummProperties.cboNewTitleExit(Sender: TObject);
330begin
331 if cboNewTitle.ItemIEN <> FLastTitle then cboNewTitleMouseClick(Self);
332end;
333
334{ cboAuthor & cboAttending events }
335
336procedure TfrmDCSummProperties.cboAuthorNeedData(Sender: TObject; const StartFrom: String;
337 Direction, InsertAt: Integer);
338begin
339 (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
340end;
341
342procedure TfrmDCSummProperties.cboAttendingNeedData(Sender: TObject; const StartFrom: String;
343 Direction, InsertAt: Integer);
344begin // changed in v15.2, per BRX-1100-10981
345// (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
346 (Sender as TORComboBox).ForDataUse(SubSetOfProviders(StartFrom, Direction));
347end;
348
349procedure TfrmDCSummProperties.cboAuthorEnter(Sender: TObject);
350begin
351 FLastAuthor := 0;
352end;
353
354procedure TfrmDCSummProperties.cboAuthorMouseClick(Sender: TObject);
355begin
356 SetCosignerRequired;
357 FLastAuthor := cboAuthor.ItemIEN;
358end;
359
360procedure TfrmDCSummProperties.cboAuthorExit(Sender: TObject);
361begin
362 if cboAuthor.ItemIEN <> FLastAuthor then cboAuthorMouseClick(Self);
363end;
364
365procedure TfrmDCSummProperties.cboAttendingExit(Sender: TObject);
366{ make sure FCosign fields stay up to date in case SetCosigner gets called again }
367begin
368 with cboAttending do if Text = '' then ItemIndex := -1;
369 FCosignIEN := cboAttending.ItemIEN;
370 FCosignName := Piece(cboAttending.Items[cboAttending.ItemIndex], U, 2);
371end;
372
373{ Command Button events }
374
375procedure TfrmDCSummProperties.cmdOKClick(Sender: TObject);
376var
377 ErrMsg, x, WhyNot: string;
378begin
379 cmdOK.SetFocus; // make sure cbo exit events fire
380 Application.ProcessMessages;
381 SetCosignerRequired;
382 ErrMsg := '';
383 if cboNewTitle.ItemIEN = 0 then
384 ErrMsg := ErrMsg + TX_REQ_TITLE
385 else if FIDNoteTitlesOnly and (not CanTitleBeIDChild(cboNewTitle.ItemIEN, WhyNot)) then
386 ErrMsg := ErrMsg + CRLF + WhyNot;
387 if cboAuthor.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_AUTHOR;
388 if not calSumm.IsValid then ErrMsg := ErrMsg + TX_REQ_REFDATE;
389 if calSumm.IsValid and (calSumm.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_FUTURE;
390 if cboAttending.Visible and (cboAttending.ItemIEN = 0) then ErrMsg := ErrMsg + TX_REQ_COSIGNER;
391 //if cboAttending.ItemIEN = User.DUZ then ErrMsg := TX_COS_SELF;
392 if (cboAttending.ItemIEN > 0) and not IsUserAProvider(cboAttending.ItemIEN, FMNow) then
393 //if (cboAttending.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboAttending.ItemIEN) then
394 ErrMsg := cboAttending.Text + TX_COS_AUTH;
395 if pnlAdmissions.Visible then
396 with lstAdmissions do
397 begin
398 if ItemIndex < 0 then
399 ErrMsg := TX_NO_ADMISSION
400 else if (Piece(x, U, 7) = '1') then
401 begin
402 x := Items[ItemIndex];
403 FVisitStr := Piece(x, U, 2) + ';' + Piece(x, U, 1) + ';H';
404 if (OneNotePerVisit(cboNewTitle.ItemIEN, Patient.DFN, FVisitStr)) then
405 begin
406 FEditIEN := 0;
407 InfoBox(TX_NO_MORE_SUMMS, TC_NO_EDIT, MB_OK);
408 lstAdmissions.ItemIndex := -1;
409 end;
410 end
411 else
412 begin
413 x := Items[ItemIndex];
414 FAdmitDateTime := Piece(x,U,1);
415 FLocation := StrToIntDef(Piece(x, U, 2), 0);
416 if (MakeFMDateTime(FAdmitDateTime)= -1) or (FLocation = 0) then
417 ErrMsg := TX_BAD_ADMISSION
418 else
419 FLocationName := ExternalName(FLocation, 44);
420 end;
421 end;
422
423 if ShowMsgOn(Length(ErrMsg) > 0, ErrMsg, TC_REQ_FIELDS)
424 then Exit
425 else ModalResult := mrOK;
426end;
427
428procedure TfrmDCSummProperties.cmdCancelClick(Sender: TObject);
429begin
430 ModalResult := mrCancel;
431 Close;
432end;
433
434procedure TfrmDCSummProperties.cboNewTitleDropDownClose(Sender: TObject);
435begin
436(* if FFixCursor then
437 begin
438 Screen.Cursor := crDefault;
439 FFixCursor := FALSE;
440 end;
441 lblDateTime.Visible := True;
442 lblAuthor.Visible := True;
443 lblCosigner.Visible := True;*)
444end;
445
446procedure TfrmDCSummProperties.lstAdmissionsChange(Sender: TObject);
447var
448 x: string;
449 AnEditSumm: TEditDCSummRec;
450 ActionSts: TActionRec;
451begin
452 if lstAdmissions.ItemIndex < 0 then Exit;
453 x := lstAdmissions.Items[lstAdmissions.ItemIndex];
454 if (StrToIntDef(Piece(x, U, 7), 0) = 2) then
455 begin
456 { Prompt for edit first - proceed as below if yes, else proceed as if '1'}
457 if InfoBox(TX_EDIT_EXISTING, TC_EDIT_EXISTING, MB_YESNO) = MRYES then
458 begin
459 FillChar(AnEditSumm, SizeOf(AnEditSumm), 0);
460 FEditIEN := StrToInt(Piece(x,U,6));
461 ActOnDCDocument(ActionSts, FEditIEN, 'EDIT RECORD');
462 if not ActionSts.Success then
463 begin
464 InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
465 lstAdmissions.ItemIndex := -1;
466 Exit;
467 end;
468 GetDCSummForEdit(AnEditSumm, FEditIEN);
469 EditLines.Assign(AnEditSumm.Lines);
470 cboNewTitle.InitLongList(AnEditSumm.TitleName);
471 ListDCSummTitlesShort(cboNewTitle.Items);
472 if AnEditSumm.Title > 0 then cboNewTitle.SelectByIEN(AnEditSumm.Title);
473 cboAuthor.InitLongList(AnEditSumm.DictatorName);
474 if AnEditSumm.Dictator > 0 then cboAuthor.SelectByIEN(AnEditSumm.Dictator);
475 cboUrgency.Items.Assign(LoadDCUrgencies);
476 cboUrgency.SelectByID('R');
477 cboAttending.InitLongList(AnEditSumm.AttendingName);
478 if AnEditSumm.Attending > 0 then cboAttending.SelectByIEN(AnEditSumm.Attending);
479 calSumm.FMDateTime := AnEditSumm.DictDateTime;
480 end
481 else // if user answers NO to edit existing document, can new one be created?
482 begin
483 FVisitStr := Piece(x, U, 2) + ';' + Piece(x, U, 1) + ';H';
484 if (OneNotePerVisit(cboNewTitle.ItemIEN, Patient.DFN, FVisitStr)) then
485 begin
486 FEditIEN := 0;
487 InfoBox(TX_NO_MORE_SUMMS, TC_NO_EDIT, MB_OK);
488 lstAdmissions.ItemIndex := -1;
489 end;
490 end;
491 end
492 else if Piece(x, U, 7) = '1' then
493 begin
494 FVisitStr := Piece(x, U, 2) + ';' + Piece(x, U, 1) + ';H';
495 if (OneNotePerVisit(cboNewTitle.ItemIEN, Patient.DFN, FVisitStr)) then
496 begin
497 FEditIEN := 0;
498 InfoBox(TX_NO_MORE_SUMMS, TC_NO_EDIT, MB_OK);
499 lstAdmissions.ItemIndex := -1;
500 end;
501 end
502 else
503 begin
504 FEditIEN := 0;
505(* cboNewTitle.ItemIndex := -1;
506 cboAttending.ItemIndex := -1;
507 calSumm.FMDateTime := FMNow;*)
508 end;
509end;
510
511procedure TfrmDCSummProperties.cboNewTitleDblClick(Sender: TObject);
512begin
513 cmdOKClick(Self);
514end;
515
516procedure TfrmDCSummProperties.FormClose(Sender: TObject;
517 var Action: TCloseAction);
518begin
519 SaveUserBounds(Self);
520end;
521
522end.
Note: See TracBrowser for help on using the repository browser.