Module

fProbflt

Path

C:\CPRS\CPRS30\fProbFlt.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -
uConst -
uProbs -

Units Used in Implementation

Name Comments
fProbs -
rCore -
rProbs -

Classes

Name Comments
TfrmPlVuFilt -

Procedures

Name Owner Declaration Scope Comments
cboProviderNeedData TfrmPlVuFilt procedure cboProviderNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboSourceChange TfrmPlVuFilt procedure cboSourceChange(Sender: TObject); Public/Published -
cboSourceEnter TfrmPlVuFilt procedure cboSourceEnter(Sender: TObject); Public/Published -
cboSourceExit TfrmPlVuFilt procedure cboSourceExit(Sender: TObject); Public/Published -
cboSourceNeedData TfrmPlVuFilt procedure cboSourceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cmdAddClick TfrmPlVuFilt procedure cmdAddClick(Sender: TObject); Public/Published -
cmdCancelClick TfrmPlVuFilt procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdDefaultViewClick TfrmPlVuFilt procedure cmdDefaultViewClick(Sender: TObject); Public/Published
Var
 Alist:TStringList;
 i: integer;
 tmpProv: Int64;
cmdOKClick TfrmPlVuFilt procedure cmdOKClick(Sender: TObject); Public/Published -
cmdRemoveAllClick TfrmPlVuFilt procedure cmdRemoveAllClick(Sender: TObject); Public/Published -
cmdRemoveClick TfrmPlVuFilt procedure cmdRemoveClick(Sender: TObject); Public/Published -
cmdSaveClick TfrmPlVuFilt procedure cmdSaveClick(Sender: TObject); Public/Published -
FormClose TfrmPlVuFilt procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmPlVuFilt procedure FormCreate(Sender: TObject); Public/Published -
FormShow TfrmPlVuFilt procedure FormShow(Sender: TObject); Public/Published -
GetClinicList TfrmPlVuFilt procedure GetClinicList; Private -
GetLocationList TfrmPlVuFilt procedure GetLocationList; Private -
GetServiceList TfrmPlVuFilt procedure GetServiceList; Private -
GetViewFilters - procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean); Interfaced -
lstDestClick TfrmPlVuFilt procedure lstDestClick(Sender: TObject); Public/Published -
rgVuClick TfrmPlVuFilt procedure rgVuClick(Sender: TObject); Public/Published -
SetButtons TfrmPlVuFilt procedure SetButtons; Public/Published -
SetVu - procedure SetVu(vulist:TstringList; vu:string); Local -

Functions

Name Owner Declaration Scope Comments
CreateContextString TfrmPlVuFilt function CreateContextString: string; Private -
CreateFilterString TfrmPlVuFilt function CreateFilterString: string; Private -

Global Variables

Name Type Declaration Comments
frmPlVuFilt TfrmPlVuFilt frmPlVuFilt: TfrmPlVuFilt; -


Module Source

1     unit fProbflt;
2     
3     interface
4     
5     uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
6       StdCtrls, SysUtils, ORCtrls, ExtCtrls, uProbs, uConst, Dialogs, fBase508Form,
7       VA508AccessibilityManager;
8     
9     type
10      TfrmPlVuFilt = class(TfrmBase508Form)
11        pnlBase: TORAutoPanel;
12        SrcLabel: TLabel;
13        DstLabel: TLabel;
14        lblProvider: TLabel;
15        Bevel1: TBevel;
16        OROffsetLabel1: TOROffsetLabel;
17        cmdAdd: TButton;
18        cmdRemove: TButton;
19        cmdRemoveAll: TButton;
20        cmdOK: TBitBtn;
21        cmdCancel: TBitBtn;
22        lstDest: TORListBox;
23        rgVu: TRadioGroup;
24        cboProvider: TORComboBox;
25        cmdDefaultView: TBitBtn;
26        cboSource: TORComboBox;
27        cmdSave: TButton;
28        chkComments: TCheckBox;
29        cboStatus: TORComboBox;
30        procedure cmdAddClick(Sender: TObject);
31        procedure cmdRemoveClick(Sender: TObject);
32        procedure cmdRemoveAllClick(Sender: TObject);
33        procedure SetButtons;
34        procedure FormClose(Sender: TObject; var Action: TCloseAction);
35        procedure rgVuClick(Sender: TObject);
36        procedure cmdCancelClick(Sender: TObject);
37        procedure cmdOKClick(Sender: TObject);
38        procedure FormShow(Sender: TObject);
39        procedure cmdDefaultViewClick(Sender: TObject);
40        procedure cboProviderNeedData(Sender: TObject; const StartFrom: String;
41          Direction, InsertAt: Integer);
42        procedure cboSourceNeedData(Sender: TObject; const StartFrom: String;
43          Direction, InsertAt: Integer);
44        procedure lstDestClick(Sender: TObject);
45        procedure cboSourceChange(Sender: TObject);
46        procedure cboSourceEnter(Sender: TObject);
47        procedure cboSourceExit(Sender: TObject);
48        procedure cmdSaveClick(Sender: TObject);
49        procedure FormCreate(Sender: TObject);
50      private
51        FContextString: string;
52        FFilterString: string;
53        FFilterChanged: boolean;
54        function CreateContextString: string;
55        function CreateFilterString: string;
56        procedure GetClinicList;
57        procedure GetServiceList;
58        procedure GetLocationList;
59      end;
60    
61    var
62      frmPlVuFilt: TfrmPlVuFilt;
63    
64    procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean);
65    
66    implementation
67    
68    {$R *.DFM}
69    uses
70     ORFn, fProbs, rProbs, rCore;
71    
72    procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean);
73    var
74      frmPlVuFilt: TfrmPlVuFilt;
75      W, H: Integer;
76    begin
77      frmPlVuFilt := TfrmPlVuFilt.Create(Application);
78      try
79        with frmPlVuFilt do
80        begin
81          Font.Size := FontSize;
82          W := ClientWidth;
83          H := ClientHeight;
84          ResizeToFont(FontSize, W, H);
85          ClientWidth  := W; pnlBase.Width  := W;
86          ClientHeight := H; pnlBase.Height := H;
87          FContextString := ContextString;
88          ShowModal;
89          FilterChanged := FFilterChanged;
90          ContextString := FContextString;
91          FilterString  := FFilterString;
92        end; {with frmPlVuFilt}
93      finally
94        frmPlVuFilt.Release;
95      end;
96    end;
97    
98    procedure TfrmPlVuFilt.FormCreate(Sender: TObject);
99    begin
100     FastAssign(frmProblems.lstView.Items, cboStatus.Items);
101     cboStatus.SelectByID(PLUser.usViewAct);
102   end;
103   
104   procedure TfrmPlVuFilt.FormShow(Sender: TObject);
105   begin
106       if PLUser.usCurrentView = PL_OP_VIEW then
107         rgVu.itemindex := 0
108       else if PLUser.usCurrentView = PL_IP_VIEW then
109         rgVu.itemindex := 1
110       else
111         rgVu.itemindex := -1;  //2;
112       rgVuClick(Self);
113       cboSource.ItemIndex := -1;
114       if PlUser.usViewProv = '0^All' then
115         begin
116           cboProvider.InitLongList('');
117           cboProvider.ItemIndex := 0;
118         end
119       else
120         begin
121           cboProvider.InitLongList(Piece(PLUser.usViewProv, U, 2));
122           cboProvider.SelectByID(Piece(PLUser.usViewProv, U, 1));
123         end;
124       chkComments.Checked := (PLUser.usViewComments = '1');
125   end;
126   
127   procedure TfrmPlVuFilt.cmdAddClick(Sender: TObject);
128   var
129     textindex: integer;
130   begin
131     textindex := lstDest.Items.Count;
132     if cboSource.ItemIndex > -1 then
133       if lstDest.SelectById(cboSource.ItemID) = -1 then
134         lstDest.Items.Add(cboSource.Items[cboSource.ItemIndex]);
135     lstDest.ItemIndex := textindex;
136     SetButtons;
137   end;
138   
139   procedure TfrmPlVuFilt.cmdRemoveClick(Sender: TObject);
140   var
141     newindex: integer;
142   begin
143     if lstDest.Items.Count > 0 then
144     begin
145       if lstDest.ItemIndex = (lstDest.Items.Count -1 ) then
146         newindex := lstDest.ItemIndex - 1
147       else
148         newindex := lstDest.ItemIndex;
149       lstDest.Items.Delete(lstDest.ItemIndex);
150       if lstDest.Items.Count > 0 then lstDest.ItemIndex := newindex;
151     end;
152     SetButtons;
153   end;
154   
155   procedure TfrmPlVuFilt.cmdRemoveAllClick(Sender: TObject);
156   begin
157     lstDest.Clear;
158     SetButtons;
159   end;
160   
161   procedure TfrmPlVuFilt.SetButtons;
162   var
163     SrcEmpty, DstEmpty: Boolean;
164   begin
165     SrcEmpty := cboSource.Items.Count = 0;
166     DstEmpty := lstDest.Items.Count = 0;
167     cmdAdd.Enabled := (not SrcEmpty) and (cboSource.ItemIndex > -1) ;
168     cmdRemove.Enabled := not DstEmpty;
169     cmdRemoveAll.Enabled := not DstEmpty;
170   end;
171   
172   procedure TfrmPlVuFilt.rgVuClick(Sender: TObject);
173   var
174     AList: TStringList;
175     i: integer;
176   begin
177    AList := TStringList.Create;
178    try
179      cboSource.clear;
180      lstDest.clear;
181      cboSource.enabled:=true;
182      lstDest.enabled:=true;
183      cboSource.color:=clWindow;
184      lstDest.color:=clWindow;
185      case rgVu.itemindex of
186       0:  {out patient view} begin
187                                GetClinicList;
188                                GetListforOP(Alist, frmProblems.wgProbData);
189                                FastAssign(ClinicFilterList(Alist), cboSource.Items);
190                                cboSource.InsertSeparator;
191                                cboSource.InitLongList('') ;
192                                for i := 0 to PLFilters.ClinicList.Count - 1 do
193                                  begin
194                                    cboSource.SelectByID(PLFilters.ClinicList[i]);
195                                    cmdAddClick(Self);
196                                  end;
197                              end;
198       1:  {in-patient View}  begin
199                                GetServiceList;
200                                GetListforIP(Alist, frmProblems.wgProbData);
201                                FastAssign(ServiceFilterList(Alist), cboSource.Items);
202                                cboSource.InsertSeparator;
203                                cboSource.InitLongList('') ;
204                                for i := 0 to PLFilters.ServiceList.Count - 1 do
205                                  begin
206                                    cboSource.SelectByID(PLFilters.ServiceList[i]);
207                                    cmdAddClick(Self);
208                                  end;
209                              end;
210      else {unfiltered view}  GetLocationList;
211      end;
212      SetButtons ;
213    finally
214      AList.Free;
215    end;
216   end;
217   
218   procedure TfrmPlVuFilt.lstDestClick(Sender: TObject);
219   begin
220     SetButtons ;
221   end;
222   
223   procedure TfrmPlVuFilt.cboSourceChange(Sender: TObject);
224   begin
225     SetButtons ;
226   end;
227   
228   procedure TfrmPlVuFilt.cboSourceEnter(Sender: TObject);
229   begin
230     cmdAdd.Default := true;
231   end;
232   
233   procedure TfrmPlVuFilt.cboSourceExit(Sender: TObject);
234   begin
235     cmdAdd.Default := false;
236   end;
237   
238   procedure TfrmPlVuFilt.cmdCancelClick(Sender: TObject);
239   begin
240     FFilterChanged := False;
241     close;
242   end;
243   
244   procedure TfrmPlVuFilt.cmdOKClick(Sender: TObject);
245   var
246     Alist:TstringList;
247   
248     procedure SetVu(vulist:TstringList; vu:string);
249       var
250         alist:TstringList;
251       begin
252         alist:=TStringList.create;
253       try
254         vuList.clear;
255         if lstDest.Items.Count=0 then
256           begin
257             AList.Clear;
258             AList.Add('0');
259           end
260         else
261           FastAssign(lstDest.Items, alist); {conserve only selected items}
262         LoadFilterList(Alist,VuList);
263         PLUser.usCurrentView:=vu;
264       finally
265         alist.free;
266       end;
267     end;
268   
269   begin {BODY of procedure}
270     Alist:=TStringList.create;
271     try
272        PlFilters.ProviderList.clear;
273        if (uppercase(cboProvider.text)='ALL') or (cboProvider.Text='') then
274         begin
275           Alist.clear;
276           AList.Add('0');
277           PLUser.usViewProv := '0^All';
278           AList.Add('-1');
279           LoadFilterList(Alist,PLFilters.ProviderList);
280         end
281        else
282         begin
283          AList.clear;
284          Alist.add(IntToStr(cboProvider.ItemIEN));
285          PLUser.usViewProv := cboProvider.Items[cboProvider.ItemIndex];
286          LoadFilterList(Alist, PLFilters.ProviderList);
287         end;
288        case rgVu.itemindex of
289         0: SetVu(PLFilters.clinicList, PL_OP_VIEW); {OP view}
290         1: SetVu(PLFilters.ServiceList, PL_IP_VIEW); {IP view}
291        else
292            SetVu(PLFilters.clinicList, PL_UF_VIEW);
293         end;
294        //ShowFilterStatus(PLUser.usCurrentView);
295        //PostMessage(frmProblems.Handle, UM_PLFILTER, 0, 0);
296        FContextString := CreateContextString;
297        FFilterString  := CreateFilterString;
298        FFilterChanged := True;
299        close;
300     finally
301        alist.free;
302     end;
303   end;
304   
305   procedure TfrmPlVuFilt.cmdDefaultViewClick(Sender: TObject);
306   {var
307    Alist:TStringList;
308    i: integer;
309    tmpProv: Int64;}
310   begin
311   {  Alist:=TStringList.create;
312     try
313       lstDest.Clear;
314       PlUser.usCurrentView:=PLUser.usDefaultView;
315       tmpProv := StrToInt64Def(Piece(PLUser.usDefaultContext, ';', 5), 0);
316       if tmpProv > 0 then
317         PLUser.usViewProv := IntToStr(tmpProv) + ExternalName(tmpProv, 200);
318       with cboStatus do
319         begin
320           for i := 0 to Items.Count - 1 do
321             if Copy(Items[i], 1, 1) = Piece(PLUser.usDefaultContext, ';', 3) then
322               ItemIndex := i;
323         end;
324       chkComments.Checked := (Piece(PLUser.usDefaultContext, ';', 4) = '1');
325       PLFilters.ProviderList.Clear;
326       PLFilters.ProviderList.Add(Piece(PLUser.usViewProv, U, 1));
327       FastAssign(plUser.usClinList, PLFilters.ClinicList);
328       FastAssign(plUser.usServList, PlFilters.ServiceList);
329       cboProvider.InitLongList(Piece(PLUser.usViewProv, U, 2));
330       cboProvider.SelectByID(Piece(PLUser.usViewProv, U, 1));
331       //InitViewFilters(Alist);
332     finally
333       Alist.free;
334     end;
335     //FormShow(Self);
336     FContextString := PLUser.usDefaultContext;
337     FFilterChanged := True;
338     Close;
339     //ModalResult := mrOK ; }
340   end;
341   
342   procedure TfrmPlVuFilt.FormClose(Sender: TObject;
343     var Action: TCloseAction);
344   begin
345    Release;
346   end;
347   
348   procedure TfrmPlVuFilt.GetClinicList;
349   begin
350     PLFilters.ServiceList.clear;
351     SrcLabel.caption:='Source Clinic(s)';
352     DstLabel.caption:='Selected Clinic(s)';
353     cboSource.Caption := 'Source Clinics';
354     lstDest.Caption := 'Selected Clinic or Clinics';
355     lstDest.Clear;
356     SetButtons ;
357   end;
358   
359   procedure TfrmPlVuFilt.GetServiceList;
360   begin
361    PLFilters.ClinicList.clear;
362    SrcLabel.caption:='Source Service(s)';
363    DstLabel.caption:='Selected Service(s)';
364    cboSource.Caption := 'Source Services';
365    lstDest.Caption := 'Selected Service or Services';
366    lstDest.Clear;
367    SetButtons ;
368   end;
369   
370   procedure TfrmPlVuFilt.GetLocationList;
371   begin
372    cboSource.Clear;
373    lstDest.Clear;
374    PLFilters.ClinicList.clear;
375    PLFilters.ServiceList.clear;
376    SrcLabel.caption:='All Locations/Services';
377    DstLabel.caption:='Selected Locations/Services';
378    cboSource.Caption := 'All Locations/Services';
379    lstDest.Caption := 'Selected Locations/Services';
380    cboSource.color:=clBtnFace;
381    cboSource.enabled:=false;
382    lstDest.color:=clBtnFace;
383    lstDest.enabled:=false;
384   end;
385   
386   procedure TfrmPlVuFilt.cboProviderNeedData(Sender: TObject;
387     const StartFrom: String; Direction, InsertAt: Integer);
388   begin
389     cboProvider.ForDataUse(SubSetOfActiveAndInactivePersons(StartFrom, Direction));
390     cboProvider.Items.insert(0,'0^All');
391   end;
392   
393   procedure TfrmPlVuFilt.cboSourceNeedData(Sender: TObject;
394     const StartFrom: String; Direction, InsertAt: Integer);
395   begin
396    case rgVu.itemindex of
397     0:  {out patient view} cboSource.ForDataUse(SubSetOfClinics(StartFrom,Direction));
398     1:  {in-patient View}  cboSource.ForDataUse(ServiceSearch(StartFrom,Direction));
399    else {unfiltered view}  GetLocationList;
400    end;
401   end;
402   
403   function TfrmPlVuFilt.CreateContextString: string;
404   var
405     Status, Comments, Provider: string;
406   begin
407     if cboStatus.ItemIndex > -1 then
408       Status := cboStatus.ItemID
409     else
410       Status := 'A';
411     Comments := BOOLCHAR[chkComments.Checked];
412     if cboProvider.ItemIEN > 0 then Provider := cboProvider.ItemID else Provider := '';
413     Result := ';;' + Status + ';' + Comments + ';' + Provider;
414   end;
415   
416   function TfrmPlVuFilt.CreateFilterString: string;
417   var
418     FilterString: string;
419     i: integer;
420   begin
421     case rgVu.ItemIndex of
422       0:  FilterString := PL_OP_VIEW + '/';
423       1:  FilterString := PL_IP_VIEW + '/';
424     else  FilterString := '';
425     end;
426     if rgVu.ItemIndex <> -1 then
427       for i := 0 to lstDest.Items.Count - 1 do
428         if Piece(lstDest.Items[i], U, 1) <> '-1' then
429           FilterString := FilterString + Piece(lstDest.Items[i], U, 1) + '/';
430     Result := FilterString;
431   end;
432   
433   procedure TfrmPlVuFilt.cmdSaveClick(Sender: TObject);
434   begin
435     {FContextString := CreateContextString;
436     FFilterString  := CreateFilterString;
437     if InfoBox('Replace current defaults?','Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
438       begin
439         with PLUser do
440           begin
441             usDefaultContext := FContextString;
442             usDefaultView    := Piece(FFilterString, '/', 1);
443           end;
444         SaveViewPreferences(FFilterString + U + FContextString);
445       end;       }
446   end;
447   
448   end.

Module Calls (2 levels)


fProbflt
 ├uProbs
 │ ├uConst
 │ ├rCore
 │ └uCore
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├fProbs
 │ ├fHSplit
 │ ├uProbs...
 │ ├uCore...
 │ ├fProbEdt
 │ ├uConst
 │ ├fBase508Form...
 │ ├fFrame
 │ ├fProbflt...
 │ ├fProbLex
 │ ├rProbs
 │ ├rCover
 │ ├fRptBox
 │ ├rCore...
 │ ├fProbCmt
 │ ├fEncnt
 │ ├fReportsPrint
 │ ├fReports
 │ └rPCE
 ├rProbs...
 └rCore...

Module Called-By (2 levels)


       fProbflt
       fProbs┘ 
     fFrame┤   
   fProbEdt┤   
fProbflt...┤   
   fProbLex┘