source: cprs/branches/foia-cprs/CPRS-Chart/fPtSelOptns.pas@ 459

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

Adding foia-cprs branch
File size: 12.7 KB
Line 
1unit fPtSelOptns;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ORDtTmRng, ORCtrls, StdCtrls, ExtCtrls, ORFn;
8
9type
10 TSetCaptionTopProc = procedure of object;
11 TSetPtListTopProc = procedure(IEN: Int64) of object;
12
13 TfrmPtSelOptns = class(TForm)
14 orapnlMain: TORAutoPanel;
15 bvlPtList: TORAutoPanel;
16 lblPtList: TLabel;
17 lblDateRange: TLabel;
18 cboList: TORComboBox;
19 cboDateRange: TORComboBox;
20 calApptRng: TORDateRangeDlg;
21 radDflt: TRadioButton;
22 radProviders: TRadioButton;
23 radTeams: TRadioButton;
24 radSpecialties: TRadioButton;
25 radClinics: TRadioButton;
26 radWards: TRadioButton;
27 radAll: TRadioButton;
28 procedure radHideSrcClick(Sender: TObject);
29 procedure radShowSrcClick(Sender: TObject);
30 procedure radLongSrcClick(Sender: TObject);
31 procedure cboListExit(Sender: TObject);
32 procedure cboListKeyPause(Sender: TObject);
33 procedure cboListMouseClick(Sender: TObject);
34 procedure cboListNeedData(Sender: TObject; const StartFrom: String;
35 Direction, InsertAt: Integer);
36 procedure cboDateRangeExit(Sender: TObject);
37 procedure cboDateRangeMouseClick(Sender: TObject);
38 procedure FormCreate(Sender: TObject);
39 private
40 FLastTopList: string;
41 FLastDateIndex: Integer;
42 FSrcType: Integer;
43 FSetCaptionTop: TSetCaptionTopProc;
44 FSetPtListTop: TSetPtListTopProc;
45 procedure HideDateRange;
46 procedure ShowDateRange;
47 public
48 function IsLast5(x: string): Boolean;
49 function IsFullSSN(x: string): Boolean;
50 procedure cmdSaveListClick(Sender: TObject);
51 procedure SetDefaultPtList(Dflt: string);
52 procedure UpdateDefault;
53 property LastTopList: string read FLastTopList write FLastTopList;
54 property SrcType: Integer read FSrcType write FSrcType;
55 property SetCaptionTopProc: TSetCaptionTopProc read FSetCaptionTop write FSetCaptionTop;
56 property SetPtListTopProc: TSetPtListTopProc read FSetPtListTop write FSetPtListTop;
57 end;
58
59const
60{ constants referencing the value of the tag property in components }
61 TAG_SRC_DFLT = 11; // default patient list
62 TAG_SRC_PROV = 12; // patient list by provider
63 TAG_SRC_TEAM = 13; // patient list by team
64 TAG_SRC_SPEC = 14; // patient list by treating specialty
65 TAG_SRC_CLIN = 16; // patient list by clinic
66 TAG_SRC_WARD = 17; // patient list by ward
67 TAG_SRC_ALL = 18; // all patients
68
69var
70 frmPtSelOptns: TfrmPtSelOptns;
71 clinDoSave, clinSaveToday: boolean;
72 clinDefaults: string;
73
74implementation
75
76{$R *.DFM}
77
78uses
79 rCore, fPtSelOptSave, fPtSel;
80
81const
82 TX_LS_DFLT = 'This is already saved as your default patient list settings.';
83 TX_LS_PROV = 'A provider must be selected to save patient list settings.';
84 TX_LS_TEAM = 'A team must be selected to save patient list settings.';
85 TX_LS_SPEC = 'A specialty must be selected to save patient list settings.';
86 TX_LS_CLIN = 'A clinic and a date range must be selected to save settings for a clinic.';
87 TX_LS_WARD = 'A ward must be selected to save patient list settings.';
88 TC_LS_FAIL = 'Unable to Save Patient List Settings';
89 TX_LS_SAV1 = 'Save ';
90 TX_LS_SAV2 = CRLF + 'as your default patient list setting?';
91 TC_LS_SAVE = 'Save Patient List Settings';
92
93function TfrmPtSelOptns.IsLast5(x: string): Boolean;
94{ returns true if string matchs patterns: A9999 or 9999 (BS & BS5 xrefs for patient lookup) }
95var
96 i: Integer;
97begin
98 Result := False;
99 if not ((Length(x) = 4) or (Length(x) = 5)) then Exit;
100 if Length(x) = 5 then
101 begin
102 if not (x[1] in ['A'..'Z', 'a'..'z']) then Exit;
103 x := Copy(x, 2, 4);
104 end;
105 for i := 1 to 4 do if not (x[i] in ['0'..'9']) then Exit;
106 Result := True;
107end;
108
109function TfrmPtSelOptns.IsFullSSN(x: string): boolean;
110var
111 i: integer;
112begin
113 Result := False;
114 if (Length(x) < 9) or (Length(x) > 12) then Exit;
115 case Length(x) of
116 9: // no dashes, no 'P'
117 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
118 10: // no dashes, with 'P'
119 begin
120 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
121 if (Uppercase(x[10]) <> 'P') then Exit;
122 end;
123 11: // dashes, no 'P'
124 begin
125 if (x[4] <> '-') or (x[7] <> '-') then Exit;
126 x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,4);
127 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
128 end;
129 12: // dashes, with 'P'
130 begin
131 if (x[4] <> '-') or (x[7] <> '-') then Exit;
132 x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,5);
133 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
134 if UpperCase(x[10]) <> 'P' then Exit;
135 end;
136 end;
137 Result := True;
138end;
139
140procedure TfrmPtSelOptns.radHideSrcClick(Sender: TObject);
141{ called by radDflt & radAll - hides list source combo box and refreshes patient list }
142begin
143 cboList.Pieces := '2';
144 FSrcType := TControl(Sender).Tag;
145 FLastTopList := '';
146 HideDateRange;
147 cboList.Visible := False;
148 cboList.Caption := TRadioButton(Sender).Caption;
149 FSetCaptionTop;
150 FSetPtListTop(0);
151end;
152
153procedure TfrmPtSelOptns.radShowSrcClick(Sender: TObject);
154{ called by radTeams, radSpecialties, radWards - shows items for the list source }
155begin
156 cboList.Pieces := '2';
157 FSrcType := TControl(Sender).Tag;
158 FLastTopList := '';
159 HideDateRange;
160 FSetCaptionTop;
161 with cboList do
162 begin
163 Clear;
164 LongList := False;
165 Sorted := True;
166 case FSrcType of
167 TAG_SRC_TEAM: ListTeamAll(Items);
168 TAG_SRC_SPEC: ListSpecialtyAll(Items);
169 TAG_SRC_WARD: ListWardAll(Items);
170 end;
171 Visible := True;
172 end;
173 cboList.Caption := TRadioButton(Sender).Caption;
174end;
175
176procedure TfrmPtSelOptns.radLongSrcClick(Sender: TObject);
177{ called by radProviders, radClinics - switches to long list & shows items for the list source }
178begin
179 cboList.Pieces := '2';
180 FSrcType := TControl(Sender).Tag;
181 FLastTopList := '';
182 FSetCaptionTop;
183 with cboList do
184 begin
185 Sorted := False;
186 LongList := True;
187 Clear;
188 case FSrcType of
189 TAG_SRC_PROV: begin
190 cboList.Pieces := '2,3';
191 HideDateRange;
192 ListProviderTop(Items);
193 end;
194 TAG_SRC_CLIN: begin
195 ShowDateRange;
196 ListClinicTop(Items);
197 end;
198 end;
199 InitLongList('');
200 Visible := True;
201 end;
202 cboList.Caption := TRadioButton(Sender).Caption;
203end;
204
205procedure TfrmPtSelOptns.cboListExit(Sender: TObject);
206begin
207 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
208end;
209
210procedure TfrmPtSelOptns.cboListKeyPause(Sender: TObject);
211begin
212 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
213end;
214
215procedure TfrmPtSelOptns.cboListMouseClick(Sender: TObject);
216begin
217 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
218end;
219
220procedure TfrmPtSelOptns.cboListNeedData(Sender: TObject;
221 const StartFrom: String; Direction, InsertAt: Integer);
222begin
223 case frmPtSelOptns.SrcType of
224 TAG_SRC_PROV: cboList.ForDataUse(SubSetOfProviders(StartFrom, Direction));
225 TAG_SRC_CLIN: cboList.ForDataUse(SubSetOfClinics(StartFrom, Direction));
226 end;
227end;
228
229procedure TfrmPtSelOptns.HideDateRange;
230begin
231 lblDateRange.Hide;
232 cboDateRange.Hide;
233 cboList.Height := cboDateRange.Top - cboList.Top + cboDateRange.Height;
234end;
235
236procedure TfrmPtSelOptns.ShowDateRange;
237var
238 DateString, DRStart, DREnd: string;
239 TStart, TEnd: boolean;
240begin
241 with cboDateRange do if Items.Count = 0 then
242 begin
243 ListDateRangeClinic(Items);
244 ItemIndex := 0;
245 end;
246 DateString := DfltDateRangeClinic; // Returns "^T" even if no settings.
247 DRStart := piece(DateString,U,1);
248 DREnd := piece(DateString,U,2);
249 if (DRStart <> ' ') then
250 begin
251 TStart := false;
252 TEnd := false;
253 if ((DRStart = 'T') or (DRStart = 'TODAY')) then
254 TStart := true;
255 if ((DREnd = 'T') or (DREnd = 'TODAY')) then
256 TEnd := true;
257 if not (TStart and TEnd) then
258 cboDateRange.ItemIndex := cboDateRange.Items.Add(DRStart + ';' +
259 DREnd + U + DRStart + ' to ' + DREnd);
260 end;
261 cboList.Height := lblDateRange.Top - cboList.Top - 4;
262 lblDateRange.Show;
263 cboDateRange.Show;
264end;
265
266procedure TfrmPtSelOptns.cboDateRangeExit(Sender: TObject);
267begin
268 if cboDateRange.ItemIndex <> FLastDateIndex then cboDateRangeMouseClick(Self);
269end;
270
271procedure TfrmPtSelOptns.cboDateRangeMouseClick(Sender: TObject);
272begin
273 if (cboDateRange.ItemID = 'S') then
274 begin
275 with calApptRng do if Execute
276 then cboDateRange.ItemIndex := cboDateRange.Items.Add(RelativeStart + ';' +
277 RelativeStop + U + TextOfStart + ' to ' + TextOfStop)
278 else cboDateRange.ItemIndex := -1;
279 end;
280 FLastDateIndex := cboDateRange.ItemIndex;
281 if cboList.ItemIEN > 0 then FSetPtListTop(cboList.ItemIEN);
282end;
283
284procedure TfrmPtSelOptns.cmdSaveListClick(Sender: TObject);
285var
286 x: string;
287begin
288 x := '';
289 case FSrcType of
290 TAG_SRC_DFLT: InfoBox(TX_LS_DFLT, TC_LS_FAIL, MB_OK);
291 TAG_SRC_PROV: if cboList.ItemIEN <= 0
292 then InfoBox(TX_LS_PROV, TC_LS_FAIL, MB_OK)
293 else x := 'P^' + IntToStr(cboList.ItemIEN) + U + U +
294 'Provider = ' + cboList.Text;
295 TAG_SRC_TEAM: if cboList.ItemIEN <= 0
296 then InfoBox(TX_LS_TEAM, TC_LS_FAIL, MB_OK)
297 else x := 'T^' + IntToStr(cboList.ItemIEN) + U + U +
298 'Team = ' + cboList.Text;
299 TAG_SRC_SPEC: if cboList.ItemIEN <= 0
300 then InfoBox(TX_LS_SPEC, TC_LS_FAIL, MB_OK)
301 else x := 'S^' + IntToStr(cboList.ItemIEN) + U + U +
302 'Specialty = ' + cboList.Text;
303 TAG_SRC_CLIN: if (cboList.ItemIEN <= 0) or (Pos(';', cboDateRange.ItemID) = 0)
304 then InfoBox(TX_LS_CLIN, TC_LS_FAIL, MB_OK)
305 else
306 begin
307 clinDefaults := 'Clinic = ' + cboList.Text + ', ' + cboDaterange.text;
308 frmPtSelOptSave := TfrmPtSelOptSave.create(Application); // Calls dialogue form for user input.
309 frmPtSelOptSave.showModal;
310 frmPtSelOptSave.free;
311 if (not clinDoSave) then
312 Exit;
313 if clinSaveToday then
314 x := 'CT^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
315 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text
316 else
317 x := 'C^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
318 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text;
319 end;
320 TAG_SRC_WARD: if cboList.ItemIEN <= 0
321 then InfoBox(TX_LS_WARD, TC_LS_FAIL, MB_OK)
322 else x := 'W^' + IntToStr(cboList.ItemIEN) + U + U +
323 'Ward = ' + cboList.Text;
324 TAG_SRC_ALL : x := 'A';
325 end;
326 if (x <> '') then
327 begin
328 if not (FSrcType = TAG_SRC_CLIN) then // Clinics already have a "confirm" d-box.
329 begin
330 if (InfoBox(TX_LS_SAV1 + Piece(x, U, 4) + TX_LS_SAV2, TC_LS_SAVE, MB_YESNO) = IDYES) then
331 begin
332 SavePtListDflt(x);
333 UpdateDefault;
334 end;
335 end
336 else // Skip second confirmation box for clinics.
337 begin
338 SavePtListDflt(x);
339 UpdateDefault;
340 end;
341 end;
342end;
343
344procedure TfrmPtSelOptns.FormCreate(Sender: TObject);
345begin
346 FLastDateIndex := -1;
347end;
348
349procedure TfrmPtSelOptns.SetDefaultPtList(Dflt: string);
350begin
351 if Length(Dflt) > 0 then // if default patient list available, use it
352 begin
353 radDflt.Caption := '&Default: ' + Dflt;
354 radDflt.Checked := True; // causes radHideSrcClick to be called
355 end
356 else // otherwise, select from all patients
357 begin
358 radDflt.Enabled := False;
359 radAll.Checked := True; // causes radHideSrcClick to be called
360 end;
361end;
362
363procedure TfrmPtSelOptns.UpdateDefault;
364begin
365 FSrcType := TAG_SRC_DFLT;
366 fPtSel.FDfltSrc := DfltPtList; // Server side default setting: "DfltPtList" is in rCore.
367 fPtSel.FDfltSrcType := Piece(fPtSel.FDfltSrc, U, 2);
368 fPtSel.FDfltSrc := Piece(fPtSel.FDfltSrc, U, 1);
369 if (IsRPL = '1') then // Deal with restricted patient list users.
370 fPtSel.FDfltSrc := '';
371 SetDefaultPtList(fPtSel.FDfltSrc);
372end;
373
374end.
Note: See TracBrowser for help on using the repository browser.