source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fPtSelOptns.pas

Last change on this file was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch
File size: 14.4 KB
Line 
1unit fPtSelOptns;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ORDtTmRng, ORCtrls, StdCtrls, ExtCtrls, ORFn, fBase508Form,
8 VA508AccessibilityManager;
9
10type
11 TSetCaptionTopProc = procedure of object;
12 TSetPtListTopProc = procedure(IEN: Int64) of object;
13
14 TfrmPtSelOptns = class(TfrmBase508Form)
15 orapnlMain: TORAutoPanel;
16 bvlPtList: TORAutoPanel;
17 lblPtList: TLabel;
18 lblDateRange: TLabel;
19 cboList: TORComboBox;
20 cboDateRange: TORComboBox;
21 calApptRng: TORDateRangeDlg;
22 radDflt: TRadioButton;
23 radProviders: TRadioButton;
24 radTeams: TRadioButton;
25 radSpecialties: TRadioButton;
26 radClinics: TRadioButton;
27 radWards: TRadioButton;
28 radAll: TRadioButton;
29 procedure radHideSrcClick(Sender: TObject);
30 procedure radShowSrcClick(Sender: TObject);
31 procedure radLongSrcClick(Sender: TObject);
32 procedure cboListExit(Sender: TObject);
33 procedure cboListKeyPause(Sender: TObject);
34 procedure cboListMouseClick(Sender: TObject);
35 procedure cboListNeedData(Sender: TObject; const StartFrom: String;
36 Direction, InsertAt: Integer);
37 procedure cboDateRangeExit(Sender: TObject);
38 procedure cboDateRangeMouseClick(Sender: TObject);
39 procedure FormCreate(Sender: TObject);
40 private
41 FLastTopList: string;
42 FLastDateIndex: Integer;
43 FSrcType: Integer;
44 FSetCaptionTop: TSetCaptionTopProc;
45 FSetPtListTop: TSetPtListTopProc;
46 procedure HideDateRange;
47 procedure ShowDateRange;
48 public
49 function IsLast5(x: string): Boolean;
50 function IsFullSSN(x: string): Boolean;
51 procedure cmdSaveListClick(Sender: TObject);
52 procedure SetDefaultPtList(Dflt: string);
53 procedure UpdateDefault;
54 property LastTopList: string read FLastTopList write FLastTopList;
55 property SrcType: Integer read FSrcType write FSrcType;
56 property SetCaptionTopProc: TSetCaptionTopProc read FSetCaptionTop write FSetCaptionTop;
57 property SetPtListTopProc: TSetPtListTopProc read FSetPtListTop write FSetPtListTop;
58 end;
59
60const
61{ constants referencing the value of the tag property in components }
62 TAG_SRC_DFLT = 11; // default patient list
63 TAG_SRC_PROV = 12; // patient list by provider
64 TAG_SRC_TEAM = 13; // patient list by team
65 TAG_SRC_SPEC = 14; // patient list by treating specialty
66 TAG_SRC_CLIN = 16; // patient list by clinic
67 TAG_SRC_WARD = 17; // patient list by ward
68 TAG_SRC_ALL = 18; // all patients
69
70var
71 frmPtSelOptns: TfrmPtSelOptns;
72 clinDoSave, clinSaveToday: boolean;
73 clinDefaults: string;
74
75implementation
76
77{$R *.DFM}
78
79uses
80 rCore, fPtSelOptSave, fPtSel, VA508AccessibilityRouter;
81
82const
83 TX_LS_DFLT = 'This is already saved as your default patient list settings.';
84 TX_LS_PROV = 'A provider must be selected to save patient list settings.';
85 TX_LS_TEAM = 'A team must be selected to save patient list settings.';
86 TX_LS_SPEC = 'A specialty must be selected to save patient list settings.';
87 TX_LS_CLIN = 'A clinic and a date range must be selected to save settings for a clinic.';
88 TX_LS_WARD = 'A ward must be selected to save patient list settings.';
89 TC_LS_FAIL = 'Unable to Save Patient List Settings';
90 TX_LS_SAV1 = 'Save ';
91 TX_LS_SAV2 = CRLF + 'as your default patient list setting?';
92 TC_LS_SAVE = 'Save Patient List Settings';
93
94function TfrmPtSelOptns.IsLast5(x: string): Boolean;
95{ returns true if string matchs patterns: A9999 or 9999 (BS & BS5 xrefs for patient lookup) }
96var
97 i: Integer;
98begin
99 Result := False;
100 if not ((Length(x) = 4) or (Length(x) = 5)) then Exit;
101 if Length(x) = 5 then
102 begin
103 if not (x[1] in ['A'..'Z', 'a'..'z']) then Exit;
104 x := Copy(x, 2, 4);
105 end;
106 for i := 1 to 4 do if not (x[i] in ['0'..'9']) then Exit;
107 Result := True;
108end;
109
110function TfrmPtSelOptns.IsFullSSN(x: string): boolean;
111var
112 i: integer;
113begin
114 Result := False;
115 if (Length(x) < 9) or (Length(x) > 12) then Exit;
116 case Length(x) of
117 9: // no dashes, no 'P'
118 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
119 10: // no dashes, with 'P'
120 begin
121 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
122 if (Uppercase(x[10]) <> 'P') then Exit;
123 end;
124 11: // dashes, no 'P'
125 begin
126 if (x[4] <> '-') or (x[7] <> '-') then Exit;
127 x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,4);
128 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
129 end;
130 12: // dashes, with 'P'
131 begin
132 if (x[4] <> '-') or (x[7] <> '-') then Exit;
133 x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,5);
134 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
135 if UpperCase(x[10]) <> 'P' then Exit;
136 end;
137 end;
138 Result := True;
139end;
140
141procedure TfrmPtSelOptns.radHideSrcClick(Sender: TObject);
142{ called by radDflt & radAll - hides list source combo box and refreshes patient list }
143begin
144 cboList.Pieces := '2';
145 FSrcType := TControl(Sender).Tag;
146 FLastTopList := '';
147 HideDateRange;
148 cboList.Visible := False;
149 cboList.Caption := TRadioButton(Sender).Caption;
150 FSetCaptionTop;
151 FSetPtListTop(0);
152end;
153
154procedure TfrmPtSelOptns.radShowSrcClick(Sender: TObject);
155{ called by radTeams, radSpecialties, radWards - shows items for the list source }
156begin
157 cboList.Pieces := '2';
158 FSrcType := TControl(Sender).Tag;
159 FLastTopList := '';
160 HideDateRange;
161 FSetCaptionTop;
162 with cboList do
163 begin
164 Clear;
165 LongList := False;
166 Sorted := True;
167 case FSrcType of
168 TAG_SRC_TEAM: ListTeamAll(Items);
169 TAG_SRC_SPEC: ListSpecialtyAll(Items);
170 TAG_SRC_WARD: ListWardAll(Items);
171 end;
172 Visible := True;
173 end;
174 cboList.Caption := TRadioButton(Sender).Caption;
175end;
176
177procedure TfrmPtSelOptns.radLongSrcClick(Sender: TObject);
178{ called by radProviders, radClinics - switches to long list & shows items for the list source }
179begin
180 cboList.Pieces := '2';
181 FSrcType := TControl(Sender).Tag;
182 FLastTopList := '';
183 FSetCaptionTop;
184 with cboList do
185 begin
186 Sorted := False;
187 LongList := True;
188 Clear;
189 case FSrcType of
190 TAG_SRC_PROV: begin
191 cboList.Pieces := '2,3';
192 HideDateRange;
193 ListProviderTop(Items);
194 end;
195 TAG_SRC_CLIN: begin
196 ShowDateRange;
197 ListClinicTop(Items);
198 end;
199 end;
200 InitLongList('');
201 Visible := True;
202 end;
203 cboList.Caption := TRadioButton(Sender).Caption;
204end;
205
206procedure TfrmPtSelOptns.cboListExit(Sender: TObject);
207begin
208 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
209end;
210
211procedure TfrmPtSelOptns.cboListKeyPause(Sender: TObject);
212begin
213 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
214end;
215
216procedure TfrmPtSelOptns.cboListMouseClick(Sender: TObject);
217begin
218 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
219end;
220
221procedure TfrmPtSelOptns.cboListNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
222{CQ6363 Notes: This procedure was altered for CQ6363, but then changed back to its original form, as it is now.
223
224The problem is that in LOM1T, there are numerous entries in the HOSPITAL LOCATION file (44) that are lower-case,
225resulting in a "B" xref that looks like this:
226
227^SC("B","module 1x",2897) =
228^SC("B","pt",3420) =
229^SC("B","read",3146) =
230^SC("B","zz GIM/WONG NEW",2902) =
231^SC("B","zz bhost/arm",3076) =
232^SC("B","zz bhost/day",2698) =
233^SC("B","zz bhost/eve/ornelas",2885) =
234^SC("B","zz bhost/resident",2710) =
235^SC("B","zz bhost/sws",2946) =
236^SC("B","zz c&P ortho/patel",3292) =
237^SC("B","zz mhc md/kelley",320) =
238^SC("B","zz/mhc/p",1076) =
239^SC("B","zzMHC MD/THRASHER",1018) =
240^SC("B","zztest clinic",3090) =
241^SC("B","zzz-hbpc-phone-jung",1830) =
242^SC("B","zzz-hbpcphone cocohran",1825) =
243^SC("B","zzz-home service",1428) =
244^SC("B","zzz-phone-deloye",1834) =
245^SC("B","zzz/gmonti impotence",2193) =
246
247ASCII sort mode puts those entries at the end of the "B" xref, but when retrieved by CPRS and upper-cased, it
248messes up the logic of the combo box. This problem has been around since there was a CPRS GUI, and the best
249possible fix is to require those entries to either be in all uppercase or be removed. If that's cleaned up,
250the logic below will work correctly.
251}
252begin
253 case frmPtSelOptns.SrcType of
254 TAG_SRC_PROV: cboList.ForDataUse(SubSetOfProviders(StartFrom, Direction));
255 TAG_SRC_CLIN: cboList.ForDataUse(SubSetOfClinics(StartFrom, Direction));
256 end;
257end;
258
259procedure TfrmPtSelOptns.HideDateRange;
260begin
261 lblDateRange.Hide;
262 cboDateRange.Hide;
263 cboList.Height := cboDateRange.Top - cboList.Top + cboDateRange.Height;
264end;
265
266procedure TfrmPtSelOptns.ShowDateRange;
267var
268 DateString, DRStart, DREnd: string;
269 TStart, TEnd: boolean;
270begin
271 with cboDateRange do if Items.Count = 0 then
272 begin
273 ListDateRangeClinic(Items);
274 ItemIndex := 0;
275 end;
276 DateString := DfltDateRangeClinic; // Returns "^T" even if no settings.
277 DRStart := piece(DateString,U,1);
278 DREnd := piece(DateString,U,2);
279 if (DRStart <> ' ') then
280 begin
281 TStart := false;
282 TEnd := false;
283 if ((DRStart = 'T') or (DRStart = 'TODAY')) then
284 TStart := true;
285 if ((DREnd = 'T') or (DREnd = 'TODAY')) then
286 TEnd := true;
287 if not (TStart and TEnd) then
288 cboDateRange.ItemIndex := cboDateRange.Items.Add(DRStart + ';' +
289 DREnd + U + DRStart + ' to ' + DREnd);
290 end;
291 cboList.Height := lblDateRange.Top - cboList.Top - 4;
292 lblDateRange.Show;
293 cboDateRange.Show;
294end;
295
296procedure TfrmPtSelOptns.cboDateRangeExit(Sender: TObject);
297begin
298 if cboDateRange.ItemIndex <> FLastDateIndex then cboDateRangeMouseClick(Self);
299end;
300
301procedure TfrmPtSelOptns.cboDateRangeMouseClick(Sender: TObject);
302begin
303 if (cboDateRange.ItemID = 'S') then
304 begin
305 with calApptRng do if Execute
306 then cboDateRange.ItemIndex := cboDateRange.Items.Add(RelativeStart + ';' +
307 RelativeStop + U + TextOfStart + ' to ' + TextOfStop)
308 else cboDateRange.ItemIndex := -1;
309 end;
310 FLastDateIndex := cboDateRange.ItemIndex;
311 if cboList.ItemIEN > 0 then FSetPtListTop(cboList.ItemIEN);
312end;
313
314procedure TfrmPtSelOptns.cmdSaveListClick(Sender: TObject);
315var
316 x: string;
317begin
318 x := '';
319 case FSrcType of
320 TAG_SRC_DFLT: InfoBox(TX_LS_DFLT, TC_LS_FAIL, MB_OK);
321 TAG_SRC_PROV: if cboList.ItemIEN <= 0
322 then InfoBox(TX_LS_PROV, TC_LS_FAIL, MB_OK)
323 else x := 'P^' + IntToStr(cboList.ItemIEN) + U + U +
324 'Provider = ' + cboList.Text;
325 TAG_SRC_TEAM: if cboList.ItemIEN <= 0
326 then InfoBox(TX_LS_TEAM, TC_LS_FAIL, MB_OK)
327 else x := 'T^' + IntToStr(cboList.ItemIEN) + U + U +
328 'Team = ' + cboList.Text;
329 TAG_SRC_SPEC: if cboList.ItemIEN <= 0
330 then InfoBox(TX_LS_SPEC, TC_LS_FAIL, MB_OK)
331 else x := 'S^' + IntToStr(cboList.ItemIEN) + U + U +
332 'Specialty = ' + cboList.Text;
333 TAG_SRC_CLIN: if (cboList.ItemIEN <= 0) or (Pos(';', cboDateRange.ItemID) = 0)
334 then InfoBox(TX_LS_CLIN, TC_LS_FAIL, MB_OK)
335 else
336 begin
337 clinDefaults := 'Clinic = ' + cboList.Text + ', ' + cboDaterange.text;
338 frmPtSelOptSave := TfrmPtSelOptSave.create(Application); // Calls dialogue form for user input.
339 frmPtSelOptSave.showModal;
340 frmPtSelOptSave.free;
341 if (not clinDoSave) then
342 Exit;
343 if clinSaveToday then
344 x := 'CT^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
345 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text
346 else
347 x := 'C^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
348 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text;
349 end;
350 TAG_SRC_WARD: if cboList.ItemIEN <= 0
351 then InfoBox(TX_LS_WARD, TC_LS_FAIL, MB_OK)
352 else x := 'W^' + IntToStr(cboList.ItemIEN) + U + U +
353 'Ward = ' + cboList.Text;
354 TAG_SRC_ALL : x := 'A';
355 end;
356 if (x <> '') then
357 begin
358 if not (FSrcType = TAG_SRC_CLIN) then // Clinics already have a "confirm" d-box.
359 begin
360 if (InfoBox(TX_LS_SAV1 + Piece(x, U, 4) + TX_LS_SAV2, TC_LS_SAVE, MB_YESNO) = IDYES) then
361 begin
362 SavePtListDflt(x);
363 UpdateDefault;
364 end;
365 end
366 else // Skip second confirmation box for clinics.
367 begin
368 SavePtListDflt(x);
369 UpdateDefault;
370 end;
371 end;
372end;
373
374procedure TfrmPtSelOptns.FormCreate(Sender: TObject);
375begin
376 FLastDateIndex := -1;
377end;
378
379procedure TfrmPtSelOptns.SetDefaultPtList(Dflt: string);
380begin
381 if Length(Dflt) > 0 then // if default patient list available, use it
382 begin
383 radDflt.Caption := '&Default: ' + Dflt;
384 radDflt.Checked := True; // causes radHideSrcClick to be called
385 end
386 else // otherwise, select from all patients
387 begin
388 radDflt.Enabled := False;
389 radAll.Checked := True; // causes radHideSrcClick to be called
390 bvlPtList.TabStop := True;
391 bvlPtList.Hint := 'No default radio button unavailable 1 of 7 to move to the other patient list categories press tab';
392 // fixes CQ #4716: 508 - No Default rad btn on Patient Selection screen doesn't read in JAWS. [CPRS v28.1] (TC).
393 end;
394end;
395
396procedure TfrmPtSelOptns.UpdateDefault;
397begin
398 FSrcType := TAG_SRC_DFLT;
399 fPtSel.FDfltSrc := DfltPtList; // Server side default setting: "DfltPtList" is in rCore.
400 fPtSel.FDfltSrcType := Piece(fPtSel.FDfltSrc, U, 2);
401 fPtSel.FDfltSrc := Piece(fPtSel.FDfltSrc, U, 1);
402 if (IsRPL = '1') then // Deal with restricted patient list users.
403 fPtSel.FDfltSrc := '';
404 SetDefaultPtList(fPtSel.FDfltSrc);
405end;
406
407initialization
408 SpecifyFormIsNotADialog(TfrmPtSelOptns);
409
410end.
Note: See TracBrowser for help on using the repository browser.