source: cprs/branches/foia-cprs/CPRS-Chart/fEncntKEEP.pas@ 1376

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

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