source: cprs/trunk/CPRS-Chart/fPtSelOptns.pas@ 828

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

Initial Upload of Official WV CPRS 1.0.26.76

File size: 16.6 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 //vwpt voe
51 function IsEnhanced(x: String) : Boolean ;
52 function IsPatientName(x: String) :Boolean;
53 //end
54 procedure cmdSaveListClick(Sender: TObject);
55 procedure SetDefaultPtList(Dflt: string);
56 procedure UpdateDefault;
57
58
59
60
61 property LastTopList: string read FLastTopList write FLastTopList;
62 property SrcType: Integer read FSrcType write FSrcType;
63 property SetCaptionTopProc: TSetCaptionTopProc read FSetCaptionTop write FSetCaptionTop;
64 property SetPtListTopProc: TSetPtListTopProc read FSetPtListTop write FSetPtListTop;
65 end;
66
67const
68{ constants referencing the value of the tag property in components }
69 TAG_SRC_DFLT = 11; // default patient list
70 TAG_SRC_PROV = 12; // patient list by provider
71 TAG_SRC_TEAM = 13; // patient list by team
72 TAG_SRC_SPEC = 14; // patient list by treating specialty
73 TAG_SRC_CLIN = 16; // patient list by clinic
74 TAG_SRC_WARD = 17; // patient list by ward
75 TAG_SRC_ALL = 18; // all patients
76
77var
78 frmPtSelOptns: TfrmPtSelOptns;
79 //frmPtSelOptns: TfrmPtSelOptns;
80 clinDoSave, clinSaveToday: boolean;
81 clinDefaults: string;
82
83implementation
84
85{$R *.DFM}
86
87uses
88 rCore, fPtSelOptSave,fPtSel;
89
90const
91 TX_LS_DFLT = 'This is already saved as your default patient list settings.';
92 TX_LS_PROV = 'A provider must be selected to save patient list settings.';
93 TX_LS_TEAM = 'A team must be selected to save patient list settings.';
94 TX_LS_SPEC = 'A specialty must be selected to save patient list settings.';
95 TX_LS_CLIN = 'A clinic and a date range must be selected to save settings for a clinic.';
96 TX_LS_WARD = 'A ward must be selected to save patient list settings.';
97 TC_LS_FAIL = 'Unable to Save Patient List Settings';
98 TX_LS_SAV1 = 'Save ';
99 TX_LS_SAV2 = CRLF + 'as your default patient list setting?';
100 TC_LS_SAVE = 'Save Patient List Settings';
101
102
103
104function TfrmPtSelOptns.IsLast5(x: string): Boolean;
105{ returns true if string matchs patterns: A9999 or 9999 (BS & BS5 xrefs for patient lookup) }
106var
107 i: Integer;
108begin
109 Result := False;
110 if not ((Length(x) = 4) or (Length(x) = 5)) then Exit;
111 if Length(x) = 5 then
112 begin
113 if not (x[1] in ['A'..'Z', 'a'..'z']) then Exit;
114 x := Copy(x, 2, 4);
115 end;
116 for i := 1 to 4 do if not (x[i] in ['0'..'9']) then Exit;
117 Result := True;
118end;
119function TfrmPtSelOptns.IsPatientName(x: string):Boolean;
120 { returns true if string matchs patient name pattern: all alphabetic," ",",","-","." only }
121var
122 i: Integer;
123begin
124 Result := False;
125
126 for i := 1 to Length(x) do if not (x[i] in ['A'..'Z', 'a'..'z', ' '..' ', ','..'.']) then Exit;
127
128 Result := True;
129end;
130function TfrmPtSelOptns.IsEnhanced(x: String) : boolean ;
131var
132 i: integer;
133begin
134 //Result := True;
135 //for i:= 1 to Length(x) do if (x[i] in ['0'..'9']) then Exit;
136 //for i:= 1 to Length(x) do
137 //begin
138 // if ((x[i] = '(') or (x[i] = ')') or (x[i] = '-') or (x[i] = '/') or (x[i] = ',') or (x[i] = '\')) then Exit;
139 //end;
140 Result := True; //False;
141 if (frmPtSelOptns.radAll.Checked <> True)and (frmPtSelOptns.radDflt.Checked <> True) then Result := False;
142end;
143function TfrmPtSelOptns.IsFullSSN(x: string): boolean;
144var
145 i: integer;
146begin
147 Result := False;
148 if (Length(x) < 9) or (Length(x) > 12) then Exit;
149 case Length(x) of
150 9: // no dashes, no 'P'
151 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
152 10: // no dashes, with 'P'
153 begin
154 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
155 if (Uppercase(x[10]) <> 'P') then Exit;
156 end;
157 11: // dashes, no 'P'
158 begin
159 if (x[4] <> '-') or (x[7] <> '-') then Exit;
160 x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,4);
161 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
162 end;
163 12: // dashes, with 'P'
164 begin
165 if (x[4] <> '-') or (x[7] <> '-') then Exit;
166 x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,5);
167 for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
168 if UpperCase(x[10]) <> 'P' then Exit;
169 end;
170 end;
171 Result := True;
172end;
173
174procedure TfrmPtSelOptns.radHideSrcClick(Sender: TObject);
175{ called by radDflt & radAll - hides list source combo box and refreshes patient list }
176begin
177 cboList.Pieces := '2';
178 FSrcType := TControl(Sender).Tag;
179 FLastTopList := '';
180 HideDateRange;
181 cboList.Visible := False;
182 cboList.Caption := TRadioButton(Sender).Caption;
183 FSetCaptionTop;
184 FSetPtListTop(0);
185end;
186
187procedure TfrmPtSelOptns.radShowSrcClick(Sender: TObject);
188{ called by radTeams, radSpecialties, radWards - shows items for the list source }
189begin
190 //vwpt remove other radio button selections
191 if fPtSel.radiogrp1index <> 0 then
192 begin
193 FSrcType := TControl(Sender).Tag;
194 case FSrcType of
195 TAG_SRC_TEAM: begin
196 radTeams.Checked := False;
197 radTeams.Refresh;
198 radAll.Checked := True;
199 radAll.Refresh;
200 end;
201 TAG_SRC_SPEC: begin
202 radSpecialties.Checked := False;
203 radSpecialties.Refresh;
204 radAll.Checked := True;
205 radAll.Refresh;
206 end;
207 TAG_SRC_WARD: begin
208 radWards.Checked := False;
209 radWards.Refresh;
210 radAll.Checked := True;
211 radAll.Refresh;
212 end;
213 end;
214 //frmPtSel.RadioGroup1.SetFocus;
215 //frmPtSel.RadioGroup1.Refresh;
216 end
217 else
218 begin
219 //end vwpt
220 cboList.Pieces := '2';
221 FSrcType := TControl(Sender).Tag;
222 FLastTopList := '';
223 HideDateRange;
224 FSetCaptionTop;
225 with cboList do
226 begin
227 Clear;
228 LongList := False;
229 Sorted := True;
230 case FSrcType of
231 TAG_SRC_TEAM: ListTeamAll(Items);
232 TAG_SRC_SPEC: ListSpecialtyAll(Items);
233 TAG_SRC_WARD: ListWardAll(Items);
234 end;
235 Visible := True;
236 end;
237 cboList.Caption := TRadioButton(Sender).Caption;
238 end; //else
239end;
240
241procedure TfrmPtSelOptns.radLongSrcClick(Sender: TObject);
242{ called by radProviders, radClinics - switches to long list & shows items for the list source }
243begin
244 //vwpt remove other radio button selections
245 if fPtSel.radiogrp1index <> 0 then
246 begin
247 FSrcType := TControl(Sender).Tag;
248 case FSrcType of
249 TAG_SRC_PROV: begin
250 radProviders.Checked := False;
251 radProviders.Refresh;
252 radAll.Checked := True;
253 radAll.Refresh;
254
255 end;
256 TAG_SRC_CLIN: begin
257 radClinics.Checked := False;
258 radClinics.Refresh;
259 radAll.Checked := True;
260 radAll.Refresh;
261 end;
262 end;
263 //frmPtSel.RadioGroup1.SetFocus;
264 //frmPtSel.RadioGroup1.Refresh;
265 end
266 else
267 begin
268 //end vwpt
269 cboList.Pieces := '2';
270 FSrcType := TControl(Sender).Tag;
271 FLastTopList := '';
272 FSetCaptionTop;
273 with cboList do
274 begin
275 Sorted := False;
276 LongList := True;
277 Clear;
278 case FSrcType of
279 TAG_SRC_PROV: begin
280 cboList.Pieces := '2,3';
281 HideDateRange;
282 ListProviderTop(Items);
283 end;
284 TAG_SRC_CLIN: begin
285 ShowDateRange;
286 ListClinicTop(Items);
287 end;
288 end;
289 InitLongList('');
290 Visible := True;
291 end;
292 cboList.Caption := TRadioButton(Sender).Caption;
293 end; //else
294end;
295
296procedure TfrmPtSelOptns.cboListExit(Sender: TObject);
297begin
298 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
299end;
300
301procedure TfrmPtSelOptns.cboListKeyPause(Sender: TObject);
302begin
303 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
304end;
305
306procedure TfrmPtSelOptns.cboListMouseClick(Sender: TObject);
307begin
308 with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
309end;
310
311procedure TfrmPtSelOptns.cboListNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
312{CQ6363 Notes: This procedure was altered for CQ6363, but then changed back to its original form, as it is now.
313
314The problem is that in LOM1T, there are numerous entries in the HOSPITAL LOCATION file (44) that are lower-case,
315resulting in a "B" xref that looks like this:
316
317^SC("B","module 1x",2897) =
318^SC("B","pt",3420) =
319^SC("B","read",3146) =
320^SC("B","zz GIM/WONG NEW",2902) =
321^SC("B","zz bhost/arm",3076) =
322^SC("B","zz bhost/day",2698) =
323^SC("B","zz bhost/eve/ornelas",2885) =
324^SC("B","zz bhost/resident",2710) =
325^SC("B","zz bhost/sws",2946) =
326^SC("B","zz c&P ortho/patel",3292) =
327^SC("B","zz mhc md/kelley",320) =
328^SC("B","zz/mhc/p",1076) =
329^SC("B","zzMHC MD/THRASHER",1018) =
330^SC("B","zztest clinic",3090) =
331^SC("B","zzz-hbpc-phone-jung",1830) =
332^SC("B","zzz-hbpcphone cocohran",1825) =
333^SC("B","zzz-home service",1428) =
334^SC("B","zzz-phone-deloye",1834) =
335^SC("B","zzz/gmonti impotence",2193) =
336
337ASCII sort mode puts those entries at the end of the "B" xref, but when retrieved by CPRS and upper-cased, it
338messes up the logic of the combo box. This problem has been around since there was a CPRS GUI, and the best
339possible fix is to require those entries to either be in all uppercase or be removed. If that's cleaned up,
340the logic below will work correctly.
341}
342begin
343 case frmPtSelOptns.SrcType of
344 TAG_SRC_PROV: cboList.ForDataUse(SubSetOfProviders(StartFrom, Direction));
345 TAG_SRC_CLIN: cboList.ForDataUse(SubSetOfClinics(StartFrom, Direction));
346 end;
347end;
348
349procedure TfrmPtSelOptns.HideDateRange;
350begin
351 lblDateRange.Hide;
352 cboDateRange.Hide;
353 cboList.Height := cboDateRange.Top - cboList.Top + cboDateRange.Height;
354end;
355
356procedure TfrmPtSelOptns.ShowDateRange;
357var
358 DateString, DRStart, DREnd: string;
359 TStart, TEnd: boolean;
360begin
361 with cboDateRange do if Items.Count = 0 then
362 begin
363 ListDateRangeClinic(Items);
364 ItemIndex := 0;
365 end;
366 DateString := DfltDateRangeClinic; // Returns "^T" even if no settings.
367 DRStart := piece(DateString,U,1);
368 DREnd := piece(DateString,U,2);
369 if (DRStart <> ' ') then
370 begin
371 TStart := false;
372 TEnd := false;
373 if ((DRStart = 'T') or (DRStart = 'TODAY')) then
374 TStart := true;
375 if ((DREnd = 'T') or (DREnd = 'TODAY')) then
376 TEnd := true;
377 if not (TStart and TEnd) then
378 cboDateRange.ItemIndex := cboDateRange.Items.Add(DRStart + ';' +
379 DREnd + U + DRStart + ' to ' + DREnd);
380 end;
381 cboList.Height := lblDateRange.Top - cboList.Top - 4;
382 lblDateRange.Show;
383 cboDateRange.Show;
384end;
385
386procedure TfrmPtSelOptns.cboDateRangeExit(Sender: TObject);
387begin
388 if cboDateRange.ItemIndex <> FLastDateIndex then cboDateRangeMouseClick(Self);
389end;
390
391procedure TfrmPtSelOptns.cboDateRangeMouseClick(Sender: TObject);
392begin
393 if (cboDateRange.ItemID = 'S') then
394 begin
395 with calApptRng do if Execute
396 then cboDateRange.ItemIndex := cboDateRange.Items.Add(RelativeStart + ';' +
397 RelativeStop + U + TextOfStart + ' to ' + TextOfStop)
398 else cboDateRange.ItemIndex := -1;
399 end;
400 FLastDateIndex := cboDateRange.ItemIndex;
401 if cboList.ItemIEN > 0 then FSetPtListTop(cboList.ItemIEN);
402end;
403
404procedure TfrmPtSelOptns.cmdSaveListClick(Sender: TObject);
405var
406 x: string;
407begin
408 x := '';
409 case FSrcType of
410 TAG_SRC_DFLT: InfoBox(TX_LS_DFLT, TC_LS_FAIL, MB_OK);
411 TAG_SRC_PROV: if cboList.ItemIEN <= 0
412 then InfoBox(TX_LS_PROV, TC_LS_FAIL, MB_OK)
413 else x := 'P^' + IntToStr(cboList.ItemIEN) + U + U +
414 'Provider = ' + cboList.Text;
415 TAG_SRC_TEAM: if cboList.ItemIEN <= 0
416 then InfoBox(TX_LS_TEAM, TC_LS_FAIL, MB_OK)
417 else x := 'T^' + IntToStr(cboList.ItemIEN) + U + U +
418 'Team = ' + cboList.Text;
419 TAG_SRC_SPEC: if cboList.ItemIEN <= 0
420 then InfoBox(TX_LS_SPEC, TC_LS_FAIL, MB_OK)
421 else x := 'S^' + IntToStr(cboList.ItemIEN) + U + U +
422 'Specialty = ' + cboList.Text;
423 TAG_SRC_CLIN: if (cboList.ItemIEN <= 0) or (Pos(';', cboDateRange.ItemID) = 0)
424 then InfoBox(TX_LS_CLIN, TC_LS_FAIL, MB_OK)
425 else
426 begin
427 clinDefaults := 'Clinic = ' + cboList.Text + ', ' + cboDaterange.text;
428 frmPtSelOptSave := TfrmPtSelOptSave.create(Application); // Calls dialogue form for user input.
429 frmPtSelOptSave.showModal;
430 frmPtSelOptSave.free;
431 if (not clinDoSave) then
432 Exit;
433 if clinSaveToday then
434 x := 'CT^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
435 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text
436 else
437 x := 'C^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
438 'Clinic = ' + cboList.Text + ', ' + cboDateRange.Text;
439 end;
440 TAG_SRC_WARD: if cboList.ItemIEN <= 0
441 then InfoBox(TX_LS_WARD, TC_LS_FAIL, MB_OK)
442 else x := 'W^' + IntToStr(cboList.ItemIEN) + U + U +
443 'Ward = ' + cboList.Text;
444 TAG_SRC_ALL : x := 'A';
445 end;
446 if (x <> '') then
447 begin
448 if not (FSrcType = TAG_SRC_CLIN) then // Clinics already have a "confirm" d-box.
449 begin
450 if (InfoBox(TX_LS_SAV1 + Piece(x, U, 4) + TX_LS_SAV2, TC_LS_SAVE, MB_YESNO) = IDYES) then
451 begin
452 SavePtListDflt(x);
453 UpdateDefault;
454 end;
455 end
456 else // Skip second confirmation box for clinics.
457 begin
458 SavePtListDflt(x);
459 UpdateDefault;
460 end;
461 end;
462end;
463
464procedure TfrmPtSelOptns.FormCreate(Sender: TObject);
465begin
466 FLastDateIndex := -1;
467end;
468
469procedure TfrmPtSelOptns.SetDefaultPtList(Dflt: string);
470begin
471 if Length(Dflt) > 0 then // if default patient list available, use it
472 begin
473 radDflt.Caption := '&Default: ' + Dflt;
474 radDflt.Checked := True; // causes radHideSrcClick to be called
475 end
476 else // otherwise, select from all patients
477 begin
478 radDflt.Enabled := False;
479 radAll.Checked := True; // causes radHideSrcClick to be called
480 end;
481end;
482
483procedure TfrmPtSelOptns.UpdateDefault;
484begin
485 FSrcType := TAG_SRC_DFLT;
486 fPtSel.FDfltSrc := DfltPtList; // Server side default setting: "DfltPtList" is in rCore.
487 fPtSel.FDfltSrcType := Piece(fPtSel.FDfltSrc, U, 2);
488 fPtSel.FDfltSrc := Piece(fPtSel.FDfltSrc, U, 1);
489 if (IsRPL = '1') then // Deal with restricted patient list users.
490 fPtSel.FDfltSrc := '';
491 SetDefaultPtList(fPtSel.FDfltSrc);
492end;
493
494end.
Note: See TracBrowser for help on using the repository browser.