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

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

Uploading from OR_30_258
File size: 14.0 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; const StartFrom: String; Direction, InsertAt: Integer);
221{CQ6363 Notes: This procedure was altered for CQ6363, but then changed back to its original form, as it is now.
222
223The problem is that in LOM1T, there are numerous entries in the HOSPITAL LOCATION file (44) that are lower-case,
224resulting in a "B" xref that looks like this:
225
226^SC("B","module 1x",2897) =
227^SC("B","pt",3420) =
228^SC("B","read",3146) =
229^SC("B","zz GIM/WONG NEW",2902) =
230^SC("B","zz bhost/arm",3076) =
231^SC("B","zz bhost/day",2698) =
232^SC("B","zz bhost/eve/ornelas",2885) =
233^SC("B","zz bhost/resident",2710) =
234^SC("B","zz bhost/sws",2946) =
235^SC("B","zz c&P ortho/patel",3292) =
236^SC("B","zz mhc md/kelley",320) =
237^SC("B","zz/mhc/p",1076) =
238^SC("B","zzMHC MD/THRASHER",1018) =
239^SC("B","zztest clinic",3090) =
240^SC("B","zzz-hbpc-phone-jung",1830) =
241^SC("B","zzz-hbpcphone cocohran",1825) =
242^SC("B","zzz-home service",1428) =
243^SC("B","zzz-phone-deloye",1834) =
244^SC("B","zzz/gmonti impotence",2193) =
245
246ASCII sort mode puts those entries at the end of the "B" xref, but when retrieved by CPRS and upper-cased, it
247messes up the logic of the combo box. This problem has been around since there was a CPRS GUI, and the best
248possible fix is to require those entries to either be in all uppercase or be removed. If that's cleaned up,
249the logic below will work correctly.
250}
251begin
252 case frmPtSelOptns.SrcType of
253 TAG_SRC_PROV: cboList.ForDataUse(SubSetOfProviders(StartFrom, Direction));
254 TAG_SRC_CLIN: cboList.ForDataUse(SubSetOfClinics(StartFrom, Direction));
255 end;
256end;
257
258procedure TfrmPtSelOptns.HideDateRange;
259begin
260 lblDateRange.Hide;
261 cboDateRange.Hide;
262 cboList.Height := cboDateRange.Top - cboList.Top + cboDateRange.Height;
263end;
264
265procedure TfrmPtSelOptns.ShowDateRange;
266var
267 DateString, DRStart, DREnd: string;
268 TStart, TEnd: boolean;
269begin
270 with cboDateRange do if Items.Count = 0 then
271 begin
272 ListDateRangeClinic(Items);
273 ItemIndex := 0;
274 end;
275 DateString := DfltDateRangeClinic; // Returns "^T" even if no settings.
276 DRStart := piece(DateString,U,1);
277 DREnd := piece(DateString,U,2);
278 if (DRStart <> ' ') then
279 begin
280 TStart := false;
281 TEnd := false;
282 if ((DRStart = 'T') or (DRStart = 'TODAY')) then
283 TStart := true;
284 if ((DREnd = 'T') or (DREnd = 'TODAY')) then
285 TEnd := true;
286 if not (TStart and TEnd) then
287 cboDateRange.ItemIndex := cboDateRange.Items.Add(DRStart + ';' +
288 DREnd + U + DRStart + ' to ' + DREnd);
289 end;
290 cboList.Height := lblDateRange.Top - cboList.Top - 4;
291 lblDateRange.Show;
292 cboDateRange.Show;
293end;
294
295procedure TfrmPtSelOptns.cboDateRangeExit(Sender: TObject);
296begin
297 if cboDateRange.ItemIndex <> FLastDateIndex then cboDateRangeMouseClick(Self);
298end;
299
300procedure TfrmPtSelOptns.cboDateRangeMouseClick(Sender: TObject);
301begin
302 if (cboDateRange.ItemID = 'S') then
303 begin
304 with calApptRng do if Execute
305 then cboDateRange.ItemIndex := cboDateRange.Items.Add(RelativeStart + ';' +
306 RelativeStop + U + TextOfStart + ' to ' + TextOfStop)
307 else cboDateRange.ItemIndex := -1;
308 end;
309 FLastDateIndex := cboDateRange.ItemIndex;
310 if cboList.ItemIEN > 0 then FSetPtListTop(cboList.ItemIEN);
311end;
312
313procedure TfrmPtSelOptns.cmdSaveListClick(Sender: TObject);
314var
315 x: string;
316begin
317 x := '';
318 case FSrcType of
319 TAG_SRC_DFLT: InfoBox(TX_LS_DFLT, TC_LS_FAIL, MB_OK);
320 TAG_SRC_PROV: if cboList.ItemIEN <= 0
321 then InfoBox(TX_LS_PROV, TC_LS_FAIL, MB_OK)
322 else x := 'P^' + IntToStr(cboList.ItemIEN) + U + U +
323 'Provider = ' + cboList.Text;
324 TAG_SRC_TEAM: if cboList.ItemIEN <= 0
325 then InfoBox(TX_LS_TEAM, TC_LS_FAIL, MB_OK)
326 else x := 'T^' + IntToStr(cboList.ItemIEN) + U + U +
327 'Team = ' + cboList.Text;
328 TAG_SRC_SPEC: if cboList.ItemIEN <= 0
329 then InfoBox(TX_LS_SPEC, TC_LS_FAIL, MB_OK)
330 else x := 'S^' + IntToStr(cboList.ItemIEN) + U + U +
331 'Specialty = ' + cboList.Text;
332 TAG_SRC_CLIN: if (cboList.ItemIEN <= 0) or (Pos(';', cboDateRange.ItemID) = 0)
333 then InfoBox(TX_LS_CLIN, TC_LS_FAIL, MB_OK)
334 else
335 begin
336 clinDefaults := 'Clinic = ' + cboList.Text + ', ' + cboDaterange.text;
337 frmPtSelOptSave := TfrmPtSelOptSave.create(Application); // Calls dialogue form for user input.
338 frmPtSelOptSave.showModal;
339 frmPtSelOptSave.free;
340 if (not clinDoSave) then
341 Exit;
342 if clinSaveToday then
343 x := 'CT^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
344 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text
345 else
346 x := 'C^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
347 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text;
348 end;
349 TAG_SRC_WARD: if cboList.ItemIEN <= 0
350 then InfoBox(TX_LS_WARD, TC_LS_FAIL, MB_OK)
351 else x := 'W^' + IntToStr(cboList.ItemIEN) + U + U +
352 'Ward = ' + cboList.Text;
353 TAG_SRC_ALL : x := 'A';
354 end;
355 if (x <> '') then
356 begin
357 if not (FSrcType = TAG_SRC_CLIN) then // Clinics already have a "confirm" d-box.
358 begin
359 if (InfoBox(TX_LS_SAV1 + Piece(x, U, 4) + TX_LS_SAV2, TC_LS_SAVE, MB_YESNO) = IDYES) then
360 begin
361 SavePtListDflt(x);
362 UpdateDefault;
363 end;
364 end
365 else // Skip second confirmation box for clinics.
366 begin
367 SavePtListDflt(x);
368 UpdateDefault;
369 end;
370 end;
371end;
372
373procedure TfrmPtSelOptns.FormCreate(Sender: TObject);
374begin
375 FLastDateIndex := -1;
376end;
377
378procedure TfrmPtSelOptns.SetDefaultPtList(Dflt: string);
379begin
380 if Length(Dflt) > 0 then // if default patient list available, use it
381 begin
382 radDflt.Caption := '&Default: ' + Dflt;
383 radDflt.Checked := True; // causes radHideSrcClick to be called
384 end
385 else // otherwise, select from all patients
386 begin
387 radDflt.Enabled := False;
388 radAll.Checked := True; // causes radHideSrcClick to be called
389 end;
390end;
391
392procedure TfrmPtSelOptns.UpdateDefault;
393begin
394 FSrcType := TAG_SRC_DFLT;
395 fPtSel.FDfltSrc := DfltPtList; // Server side default setting: "DfltPtList" is in rCore.
396 fPtSel.FDfltSrcType := Piece(fPtSel.FDfltSrc, U, 2);
397 fPtSel.FDfltSrc := Piece(fPtSel.FDfltSrc, U, 1);
398 if (IsRPL = '1') then // Deal with restricted patient list users.
399 fPtSel.FDfltSrc := '';
400 SetDefaultPtList(fPtSel.FDfltSrc);
401end;
402
403end.
Note: See TracBrowser for help on using the repository browser.