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

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

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