source: cprs/trunk/CPRS-Chart/fEncnt.pas@ 1679

Last change on this file since 1679 was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28
File size: 18.3 KB
Line 
1unit fEncnt;
2
3//Modifed: 7/26/99
4//By: Robert Bott
5//Location: ISL
6//Description of Mod:
7// Moved asignment of historical visit category from the cboNewVisitChange event
8// to the ckbHistoricalClick event.
9
10
11interface
12
13uses
14 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
15 StdCtrls, ORCtrls, ORDtTm, ORFn, ExtCtrls, ComCtrls, ORDtTmRng, fAutoSz, rOptions, fBase508Form,
16 VA508AccessibilityManager, fFrame;
17
18type
19 TfrmEncounter = class(TfrmBase508Form)
20 cboPtProvider: TORComboBox;
21 lblProvider: TLabel;
22 cmdOK: TButton;
23 cmdCancel: TButton;
24 lblLocation: TLabel;
25 txtLocation: TCaptionEdit;
26 dlgDateRange: TORDateRangeDlg;
27 cmdDateRange: TButton;
28 lblInstruct: TLabel;
29 Panel1: TPanel;
30 pgeVisit: TPageControl;
31 tabClinic: TTabSheet;
32 lstClinic: TORListBox;
33 tabAdmit: TTabSheet;
34 lstAdmit: TORListBox;
35 tabNewVisit: TTabSheet;
36 lblVisitDate: TLabel;
37 lblNewVisit: TLabel;
38 calVisitDate: TORDateBox;
39 ckbHistorical: TORCheckBox;
40 cboNewVisit: TORComboBox;
41 Panel2: TPanel;
42 lblDateRange: TLabel;
43 lblClinic: TLabel;
44 Panel3: TPanel;
45 lblAdmit: TLabel;
46 procedure FormCreate(Sender: TObject);
47 procedure pgeVisitChange(Sender: TObject);
48 procedure cmdOKClick(Sender: TObject);
49 procedure cmdCancelClick(Sender: TObject);
50 procedure cboNewVisitNeedData(Sender: TObject; const StartFrom: String;
51 Direction, InsertAt: Integer);
52 procedure calVisitDateChange(Sender: TObject);
53 procedure cboNewVisitChange(Sender: TObject);
54 procedure calVisitDateExit(Sender: TObject);
55 procedure cboPtProviderNeedData(Sender: TObject;
56 const StartFrom: String; Direction, InsertAt: Integer);
57 procedure ckbHistoricalClick(Sender: TObject);
58 procedure cmdDateRangeClick(Sender: TObject);
59 procedure FormDestroy(Sender: TObject);
60 procedure FormClose(Sender: TObject; var Action: TCloseAction);
61 procedure lstAdmitChange(Sender: TObject);
62 procedure lstClinicChange(Sender: TObject);
63 procedure FormResize(Sender: TObject);
64 procedure FormShow(Sender: TObject);
65 procedure pgeVisitMouseDown(Sender: TObject; Button: TMouseButton;
66 Shift: TShiftState; X, Y: Integer);
67 private
68 CLINIC_TXT : String;
69 FFilter: Int64;
70 FPCDate: TFMDateTime;
71 FProvider: Int64;
72 FLocation: Integer;
73 FLocationName: string;
74 FDateTime: TFMDateTime;
75 FVisitCategory: Char;
76 FStandAlone: Boolean;
77 FFromSelf: Boolean;
78 FFromDate: TFMDateTime;
79 FThruDate: TFMDateTIme;
80 FEncFutureLimit: string;
81 FFromCreate: Boolean;
82 FOldHintEvent: TShowHintEvent;
83 OKPressed: Boolean;
84 DoNotNeedLocation: Boolean; //AGP This is used to not force a location when writing a delayed order
85 procedure AppShowHint(var HintStr: string; var CanShow: Boolean;
86 var HintInfo: THintInfo);
87 procedure SetVisitCat;
88 function AllowAutoFocusChange: Boolean;
89 public
90 { Public declarations }
91 end;
92
93procedure UpdateEncounter(PersonFilter: Int64; ADate: TFMDateTime = 0; TIULocation: integer = 0; DelayedOrder: Boolean = False);
94procedure UpdateVisit(FontSize: Integer); overload;
95procedure UpdateVisit(FontSize: Integer; TIULocation: integer); overload;
96
97implementation
98
99{$R *.DFM}
100
101uses rCore, uCore, uConst, fReview, uPCE, rPCE, VA508AccessibilityRouter,
102 VAUtils;
103
104const
105 TC_MISSING = 'Incomplete Encounter Information';
106 TX_NO_DATE = 'A valid date/time has not been entered.';
107 TX_NO_TIME = 'A valid time has not been entered.';
108 TX_NO_LOC = 'A visit location has not been selected.';
109 TC_LOCONLY = 'Location for Current Activities';
110 TX_FUTURE_WARNING = 'You have selected a visit with a date in the future. Are you sure?';
111 TC_FUTURE_WARNING = 'Visit Is In Future';
112
113var
114 uTIULocation: integer;
115 uTIULocationName: string;
116
117procedure UpdateVisit(FontSize: Integer);
118begin
119 UpdateEncounter(NPF_SUPPRESS);
120end;
121
122procedure UpdateVisit(FontSize: Integer; TIULocation: integer);
123begin
124 UpdateEncounter(NPF_SUPPRESS, 0, TIULocation);
125end;
126
127procedure UpdateEncounter(PersonFilter: Int64; ADate: TFMDateTime = 0; TIULocation: integer = 0; DelayedOrder: Boolean = False);
128const
129 UP_SHIFT = 85;
130var
131 frmEncounter: TfrmEncounter;
132 CanChange: Boolean;
133 TimedOut: Boolean;
134begin
135 uTIULocation := TIULocation;
136 if uTIULocation <> 0 then uTIULocationName := ExternalName(uTIULocation, FN_HOSPITAL_LOCATION);
137 frmEncounter := TfrmEncounter.Create(Application);
138 try
139 if DelayedOrder = True then frmEncounter.DoNotNeedLocation := True
140 else frmEncounter.DoNotNeedLocation := False;
141 TimedOut := False;
142 ResizeAnchoredFormToFont(frmEncounter);
143 with frmEncounter do
144 begin
145 FFilter := PersonFilter;
146 FPCDate := ADate;
147 if PersonFilter = NPF_SUPPRESS then // not prompting for provider
148 begin
149 lblProvider.Visible := False;
150 cboPtProvider.Visible := False;
151 lblInstruct.Visible := True;
152 Caption := TC_LOCONLY;
153 Height := frmEncounter.Height - UP_SHIFT;
154 end
155 else // also prompt for provider
156 begin
157 // InitLongList must be done AFTER FFilter is set
158 cboPtProvider.InitLongList(Encounter.ProviderName);
159 cboPtProvider.SelectByIEN(FProvider);
160 end;
161 ShowModal;
162 if OKPressed then
163 begin
164 CanChange := True;
165 // if (fframe.frmFrame.DoNotChangeEncWindow = true) and (encounter.Location <> frmEncounter.FLocation) then
166 // fframe.frmFrame.DoNotChangeEncWindow := false;
167 if (PersonFilter <> NPF_SUPPRESS) and
168 (((Encounter.Provider = User.DUZ) and (FProvider <> User.DUZ)) or
169 ((Encounter.Provider <> User.DUZ) and (FProvider = User.DUZ)))
170 then CanChange := ReviewChanges(TimedOut);
171 if CanChange then
172 begin
173 if PersonFilter <> NPF_SUPPRESS then Encounter.Provider := FProvider;
174 Encounter.Location := FLocation;
175 Encounter.DateTime := FDateTime;
176 Encounter.VisitCategory := FVisitCategory;
177 Encounter.StandAlone := FStandAlone;
178 end;
179 end;
180 end;
181 finally
182 frmEncounter.Release;
183 end;
184end;
185
186procedure TfrmEncounter.FormCreate(Sender: TObject);
187var
188 ADateFrom, ADateThru: TDateTime;
189 BDateFrom, BDateThru: Integer;
190 BDisplayFrom, BDisplayThru: String;
191begin
192 inherited;
193 FProvider := Encounter.Provider;
194 FLocation := Encounter.Location;
195 FLocationName := Encounter.LocationName;
196 FDateTime := Encounter.DateTime;
197 FVisitCategory := Encounter.VisitCategory;
198 FStandAlone := Encounter.StandAlone;
199 rpcGetEncFutureDays(FEncFutureLimit);
200 rpcGetRangeForEncs(BDateFrom, BDateThru, False); // Get user's current date range settings.
201 if BDateFrom > 0 then
202 BDisplayFrom := 'T-' + IntToStr(BDateFrom)
203 else
204 BDisplayFrom := 'T';
205 if BDateThru > 0 then
206 BDisplayThru := 'T+' + IntToStr(BDateThru)
207 else
208 BDisplayThru := 'T';
209 lblDateRange.Caption := '(' + BDisplayFrom + ' thru ' + BDisplayThru + ')';
210 ADateFrom := (FMDateTimeToDateTime(FMToday) - BDateFrom);
211 ADateThru := (FMDateTimeToDateTime(FMToday) + BDateThru);
212 FFromDate := DateTimeToFMDateTime(ADateFrom);
213 FThruDate := DateTimeToFMDateTime(ADateThru) + 0.2359;
214 FFromCreate := True;
215 with txtLocation do if Length(FLocationName) > 0 then
216 begin
217 Text := FLocationName + ' ';
218 if (FVisitCategory <> 'H') and (FDateTime <> 0) then
219 Text := Text + FormatFMDateTime('mmm dd,yy hh:nn', FDateTime);
220 end
221 else Text := '< Select a location from the tabs below.... >';
222 OKPressed := False;
223 pgeVisit.ActivePage := tabClinic;
224 pgeVisitChange(Self);
225 if lstClinic.Items.Count = 0 then
226 begin
227 pgeVisit.ActivePage := tabNewVisit;
228 pgeVisitChange(Self);
229 end;
230 ckbHistorical.Hint := 'A historical visit or encounter is a visit that occurred at some time' + CRLF +
231 'in the past or at some other location (possibly non-VA). Although these' + CRLF +
232 'are not used for workload credit, they can be used for setting up the' + CRLF +
233 'PCE reminder maintenance system, or other non-workload-related reasons.';
234 FOldHintEvent := Application.OnShowHint;
235 Application.OnShowHint := AppShowHint;
236 FFromCreate := False;
237 //JAWS will read the second caption if 2 are displayed, so Combining Labels
238 CLINIC_TXT := lblClinic.Caption+' ';
239 lblClinic.Caption := CLINIC_TXT + lblDateRange.Caption;
240 lblDateRange.Hide;
241end;
242
243procedure TfrmEncounter.cboPtProviderNeedData(Sender: TObject; const StartFrom: string;
244 Direction, InsertAt: Integer);
245begin
246 inherited;
247 case FFilter of
248 NPF_PROVIDER: cboPtProvider.ForDataUse(SubSetOfProviders(StartFrom, Direction));
249// NPF_ENCOUNTER: cboPtProvider.ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction, FloatToStr(FPCDate)));
250 else cboPtProvider.ForDataUse(SubSetOfPersons(StartFrom, Direction));
251 end;
252end;
253
254procedure TfrmEncounter.pgeVisitChange(Sender: TObject);
255begin
256 inherited;
257 cmdDateRange.Visible := pgeVisit.ActivePage = tabClinic;
258 if (pgeVisit.ActivePage = tabClinic) and (lstClinic.Items.Count = 0) then
259 begin
260 ListApptAll(lstClinic.Items, Patient.DFN, FFromDate, FThruDate);
261 if AllowAutoFocusChange then
262 ActiveControl := lstClinic;
263 end;
264 if (pgeVisit.ActivePage = tabAdmit) and (lstAdmit.Items.Count = 0) then
265 begin
266 ListAdmitAll(lstAdmit.Items, Patient.DFN);
267 if AllowAutoFocusChange then
268 ActiveControl := lstAdmit;
269 end;
270 if pgeVisit.ActivePage = tabNewVisit then
271 begin
272 if cboNewVisit.Items.Count = 0 then
273 begin
274 if FVisitCategory <> 'H' then
275 begin
276 if uTIULocation <> 0 then
277 begin
278 cboNewVisit.InitLongList(uTIULocationName);
279 cboNewVisit.SelectByIEN(uTIULocation);
280 cboNewVisitChange(Self);
281 end
282 else
283 begin
284 cboNewVisit.InitLongList(FLocationName);
285 if Encounter.Location <> 0 then cboNewVisit.SelectByIEN(FLocation);
286 end;
287 FFromSelf := True;
288 with calVisitDate do if FDateTime <> 0 then FMDateTime := FDateTime else Text := 'NOW';
289 FFromSelf := False;
290 if AllowAutoFocusChange then
291 ActiveControl := cboNewVisit;
292 end
293 else if FVisitCategory = 'E' then
294 begin
295 ckbHistorical.Checked := True;
296 if AllowAutoFocusChange then
297 ActiveControl := cboNewVisit;
298 end
299 else
300 begin
301 cboNewVisit.InitLongList('');
302 end;
303 end; {if cboNewVisit}
304 end; {if pgeVisit.ActivePage}
305 if ScreenReaderSystemActive then
306 ActiveControl := pgeVisit;
307end;
308
309procedure TfrmEncounter.pgeVisitMouseDown(Sender: TObject;
310 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
311begin
312 inherited;
313 if pgeVisit.ActivePage = tabNewVisit then
314 if cboNewVisit.CanFocus then
315 cboNewVisit.SetFocus;
316end;
317
318procedure TfrmEncounter.cboNewVisitNeedData(Sender: TObject; const StartFrom: string;
319 Direction, InsertAt: Integer);
320begin
321 inherited;
322 cboNewVisit.ForDataUse(SubSetOfNewLocs(StartFrom, Direction));
323end;
324
325procedure TfrmEncounter.cmdDateRangeClick(Sender: TObject);
326begin
327 dlgDateRange.FMDateStart := FFromDate;
328 dlgDateRange.FMDateStop := FThruDate;
329 if dlgDateRange.Execute then
330 begin
331 FFromDate := dlgDateRange.FMDateStart;
332 FThruDate := dlgDateRange.FMDateStop + 0.2359;
333 lblDateRange.Caption := '(' + dlgDateRange.RelativeStart + ' thru '
334 + dlgDateRange.RelativeStop + ')';
335 //label
336 lblClinic.Caption := CLINIC_TXT + lblDateRange.Caption;
337 //list
338 lstClinic.Caption := lblClinic.Caption + ' ' + lblDateRange.Caption;
339 lstClinic.Items.Clear;
340 ListApptAll(lstClinic.Items, Patient.DFN, FFromDate, FThruDate);
341 end;
342end;
343
344procedure TfrmEncounter.cboNewVisitChange(Sender: TObject);
345begin
346 inherited;
347 with cboNewVisit do
348 begin
349 FLocation := ItemIEN;
350 FLocationName := DisplayText[ItemIndex];
351 FDateTime := calVisitDate.FMDateTime;
352 SetVisitCat;
353 with txtLocation do
354 begin
355 Text := FLocationName + ' ';
356 if FDateTime <> 0 then Text := Text + FormatFMDateTime('mmm dd,yy hh:nn', FDateTime);
357 end;
358 end;
359end;
360
361procedure TfrmEncounter.calVisitDateChange(Sender: TObject);
362begin
363 inherited;
364 // The FFromSelf was added because without it, a new visit (minus the seconds gets created.
365 // Setting the text of calVisit caused the text to be re-evaluated & changed the FMDateTime property.
366 if FFromSelf then Exit;
367 with cboNewVisit do
368 begin
369 FLocation := ItemIEN;
370 FLocationName := DisplayText[ItemIndex];
371 FDateTime := calVisitDate.FMDateTime;
372 SetVisitCat;
373 txtLocation.Text := FLocationName + ' ' + calVisitDate.Text;
374 end;
375end;
376
377procedure TfrmEncounter.calVisitDateExit(Sender: TObject);
378begin
379 inherited;
380 with cboNewVisit do if ItemIEN > 0 then
381 begin
382 FLocation := ItemIEN;
383 FLocationName := DisplayText[ItemIndex];
384 FDateTime := calVisitDate.FMDateTime;
385 SetVisitCat;
386 with txtLocation do
387 begin
388 Text := FLocationName + ' ';
389 if FDateTime <> 0 then Text := Text + FormatFMDateTime('mmm dd,yy hh:nn', FDateTime);
390 end;
391 end;
392end;
393
394procedure TfrmEncounter.cmdOKClick(Sender: TObject);
395var
396 msg: string;
397 ADate, AMaxDate: TDateTime;
398
399begin
400 inherited;
401 msg := '';
402 if DoNotNeedLocation = False then
403 begin
404 if FLocation = 0 then msg := TX_NO_LOC;
405 if FDateTime <= 0 then msg := msg + CRLF + TX_NO_DATE
406 else if(pos('.',FloatToStr(FDateTime)) = 0) then msg := msg + CRLF + TX_NO_TIME;
407 if(msg <> '') then
408 begin
409 InfoBox(msg, TC_MISSING, MB_OK);
410 Exit;
411 end
412 else
413 begin
414 ADate := FMDateTimeToDateTime(Trunc(FDateTime));
415 AMaxDate := FMDateTimeToDateTime(FMToday) + StrToIntDef(FEncFutureLimit, 0);
416 if ADate > AMaxDate then
417 if InfoBox(TX_FUTURE_WARNING, TC_FUTURE_WARNING, MB_YESNO or MB_ICONQUESTION) = MRNO then exit;
418 end;
419 end;
420 if FFilter <> NPF_SUPPRESS then FProvider := cboPtProvider.ItemIEN;
421 OKPressed := True;
422 Close;
423end;
424
425procedure TfrmEncounter.cmdCancelClick(Sender: TObject);
426begin
427 inherited;
428 Close;
429end;
430
431procedure TfrmEncounter.ckbHistoricalClick(Sender: TObject);
432begin
433 SetVisitCat;
434end;
435
436{
437procedure TfrmEncounter.cboPtProviderChange(Sender: TObject);
438var
439 txt: string;
440 AIEN: Int64;
441
442begin
443 if(FFilter <> NPF_ENCOUNTER) then exit;
444 AIEN := cboPtProvider.ItemIEN;
445 if(AIEN <> 0) then
446 begin
447 txt := InvalidPCEProviderTxt(AIEN, FPCDate);
448 if(txt <> '') then
449 begin
450 InfoBox(cboPtProvider.text + txt, TX_BAD_PROV, MB_OK);
451 cboPtProvider.ItemIndex := -1;
452 end;
453 end;
454end;
455 }
456
457procedure TfrmEncounter.AppShowHint(var HintStr: string;
458 var CanShow: Boolean; var HintInfo: THintInfo);
459const
460 HistHintDelay = 30000; // 30 seconds
461
462begin
463 if (not Assigned(HintInfo.HintControl)) then exit;
464 if(HintInfo.HintControl = ckbHistorical) then
465 HintInfo.HideTimeout := HistHintDelay;
466 if(assigned(FOldHintEvent)) then
467 FOldHintEvent(HintStr, CanShow, HintInfo);
468end;
469
470procedure TfrmEncounter.FormDestroy(Sender: TObject);
471begin
472 //Application.OnShowHint := FOldHintEvent; v22.11f - RV
473end;
474
475procedure TfrmEncounter.SetVisitCat;
476begin
477 if ckbHistorical.Checked then
478 FVisitCategory := 'E'
479 else
480 FVisitCategory := GetVisitCat('A', FLocation, Patient.Inpatient);
481 FStandAlone := (FVisitCategory = 'A');
482end;
483
484function TfrmEncounter.AllowAutoFocusChange: Boolean;
485begin
486 if ScreenReaderSystemActive or
487 Boolean(Hi(GetKeyState(VK_TAB))) or
488 Boolean(Hi(GetKeyState(VK_LEFT))) or
489 Boolean(Hi(GetKeyState(VK_RIGHT))) then
490 Result := FALSE
491 else
492 Result := TRUE;
493end;
494
495procedure TfrmEncounter.FormClose(Sender: TObject;
496 var Action: TCloseAction);
497begin
498 Application.OnShowHint := FOldHintEvent;
499end;
500
501procedure TfrmEncounter.lstAdmitChange(Sender: TObject);
502begin
503 inherited;
504 with lstAdmit do
505 begin
506 FLocation := StrToIntDef(Piece(Items[ItemIndex], U, 2), 0);
507 FLocationName := Piece(Items[ItemIndex], U, 3);
508 FDateTime := MakeFMDateTime(ItemID);
509 FVisitCategory := 'H';
510 FStandAlone := False;
511 txtLocation.Text := FLocationName; // don't show admit date (could confuse user)
512 end;
513end;
514
515procedure TfrmEncounter.lstClinicChange(Sender: TObject);
516// V|A;DateTime;LocIEN^DateTime^LocName^Status
517begin
518 inherited;
519 with lstClinic do
520 begin
521 FLocation := StrToIntDef(Piece(ItemID, ';', 3), 0);
522 FLocationName := Piece(Items[ItemIndex], U, 3);
523 FDateTime := MakeFMDateTime(Piece(ItemID,';', 2));
524 FVisitCategory := 'A';
525 FStandAlone := CharAt(ItemID, 1) = 'V';
526 with txtLocation do
527 begin
528 Text := FLocationName + ' ';
529 if FDateTime <> 0 then Text := Text + FormatFMDateTime('mmm dd,yy hh:nn', FDateTime);
530 end;
531 end;
532end;
533
534procedure TfrmEncounter.FormResize(Sender: TObject);
535begin
536 //CQ7118
537 if cboPtProvider.Visible then
538 begin
539 cmdOK.Left := cboPtProvider.Left + cboPtProvider.Width + 1;
540 cmdCancel.Left := cboPtProvider.Left + cboPtProvider.Width + 1;
541 end
542 else
543 begin
544 cmdOK.Left := cmdDateRange.Left;
545 cmdCancel.Left := cmdDateRange.Left;
546 end;
547
548 cmdCancel.Top := cmdDateRange.Top - cmdCancel.Height - 10;
549 cmdOK.Top := cmdCancel.Top - cmdOK.Height - 1;
550
551 cmdCancel.Top := cmdOK.Top + cmdOK.Height + 1;
552 cmdCancel.Width := cmdOK.Width;
553 //end CQ7118
554end;
555
556procedure TfrmEncounter.FormShow(Sender: TObject);
557begin
558 //CQ7118
559 if cboPtProvider.Visible then
560 begin
561 cmdOK.Left := cboPtProvider.Left + cboPtProvider.Width + 1;
562 cmdCancel.Left := cboPtProvider.Left + cboPtProvider.Width + 1;
563 end
564 else
565 begin
566 cmdOK.Left := cmdDateRange.Left;
567 cmdCancel.Left := cmdDateRange.Left;
568 end;
569
570 cmdCancel.Top := cmdDateRange.Top - cmdCancel.Height - 10;
571 cmdOK.Top := cmdCancel.Top - cmdOK.Height - 1;
572 cmdCancel.Top := cmdOK.Top + cmdOK.Height + 1;
573 //end CQ7118
574 if Not User.IsProvider then
575 if cboPtProvider.CanFocus then
576 cboPtProvider.SetFocus;
577end;
578
579end.
Note: See TracBrowser for help on using the repository browser.