source: cprs/branches/tmg-cprs/CPRS-Chart/fEncntKEEP.pas@ 1699

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

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