close Warning: Can't use blame annotator: 
svn blame failed on cprs/trunk/CPRS-Chart/fPtSelOptns.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

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

Last change on this file since 1495 was 830, checked in by Kevin Toppenberg, 14 years ago

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