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