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

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

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