unit fProbflt; interface uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, StdCtrls, SysUtils, ORCtrls, ExtCtrls, uProbs, uConst, Dialogs, fBase508Form, VA508AccessibilityManager; type TfrmPlVuFilt = class(TfrmBase508Form) pnlBase: TORAutoPanel; SrcLabel: TLabel; DstLabel: TLabel; lblProvider: TLabel; Bevel1: TBevel; OROffsetLabel1: TOROffsetLabel; cmdAdd: TButton; cmdRemove: TButton; cmdRemoveAll: TButton; cmdOK: TBitBtn; cmdCancel: TBitBtn; lstDest: TORListBox; rgVu: TRadioGroup; cboProvider: TORComboBox; cmdDefaultView: TBitBtn; cboSource: TORComboBox; cmdSave: TButton; chkComments: TCheckBox; cboStatus: TORComboBox; procedure cmdAddClick(Sender: TObject); procedure cmdRemoveClick(Sender: TObject); procedure cmdRemoveAllClick(Sender: TObject); procedure SetButtons; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure rgVuClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure cmdOKClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure cmdDefaultViewClick(Sender: TObject); procedure cboProviderNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure cboSourceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure lstDestClick(Sender: TObject); procedure cboSourceChange(Sender: TObject); procedure cboSourceEnter(Sender: TObject); procedure cboSourceExit(Sender: TObject); procedure cmdSaveClick(Sender: TObject); procedure FormCreate(Sender: TObject); private FContextString: string; FFilterString: string; FFilterChanged: boolean; function CreateContextString: string; function CreateFilterString: string; procedure GetClinicList; procedure GetServiceList; procedure GetLocationList; end; var frmPlVuFilt: TfrmPlVuFilt; procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean); implementation {$R *.DFM} uses ORFn, fProbs, rProbs, rCore; procedure GetViewFilters(FontSize: Integer; var PLFilters: TPLFilters; var ContextString, FilterString: string; var FilterChanged: boolean); var frmPlVuFilt: TfrmPLVuFilt; W, H: Integer; begin frmPlVuFilt := TfrmPLVuFilt.create(Application); try with frmPlVuFilt do begin Font.Size := FontSize; W := ClientWidth; H := ClientHeight; ResizeToFont(FontSize, W, H); ClientWidth := W; pnlBase.Width := W; ClientHeight := H; pnlBase.Height := H; FContextString := ContextString; ShowModal; FilterChanged := FFilterChanged; ContextString := FContextString; FilterString := FFilterString; end; {with frmPlVuFilt} finally frmPlVuFilt.Release; end; end; procedure TfrmPlVuFilt.FormCreate(Sender: TObject); begin FastAssign(frmProblems.lstView.Items, cboStatus.Items); cboStatus.SelectByID(PLUser.usViewAct); end; procedure TfrmPlVuFilt.FormShow(Sender: TObject); begin if PLUser.usCurrentView = PL_OP_VIEW then rgVu.itemindex := 0 else if PLUser.usCurrentView = PL_IP_VIEW then rgVu.itemindex := 1 else rgVu.itemindex := -1; //2; rgVuClick(Self); cboSource.ItemIndex := -1; if PlUser.usViewProv = '0^All' then begin cboProvider.InitLongList(''); cboProvider.ItemIndex := 0; end else begin cboProvider.InitLongList(Piece(PLUser.usViewProv, U, 2)); cboProvider.SelectByID(Piece(PLUser.usViewProv, U, 1)); end; chkComments.Checked := (PLUser.usViewComments = '1'); end; procedure TfrmPlVuFilt.cmdAddClick(Sender: TObject); var textindex: integer; begin textindex := lstDest.Items.Count; if cboSource.ItemIndex > -1 then if lstDest.SelectById(cboSource.ItemID) = -1 then lstDest.Items.Add(cboSource.Items[cboSource.ItemIndex]); lstDest.ItemIndex := textindex; SetButtons; end; procedure TfrmPlVuFilt.cmdRemoveClick(Sender: TObject); var newindex: integer; begin if lstDest.Items.Count > 0 then begin if lstDest.ItemIndex = (lstDest.Items.Count -1 ) then newindex := lstDest.ItemIndex - 1 else newindex := lstDest.ItemIndex; lstDest.Items.Delete(lstDest.ItemIndex); if lstDest.Items.Count > 0 then lstDest.ItemIndex := newindex; end; SetButtons; end; procedure TfrmPlVuFilt.cmdRemoveAllClick(Sender: TObject); begin lstDest.Clear; SetButtons; end; procedure TfrmPlVuFilt.SetButtons; var SrcEmpty, DstEmpty: Boolean; begin SrcEmpty := cboSource.Items.Count = 0; DstEmpty := lstDest.Items.Count = 0; cmdAdd.Enabled := (not SrcEmpty) and (cboSource.ItemIndex > -1) ; cmdRemove.Enabled := not DstEmpty; cmdRemoveAll.Enabled := not DstEmpty; end; procedure TfrmPlVuFilt.rgVuClick(Sender: TObject); var AList: TStringList; i: integer; begin AList := TStringList.Create; try cboSource.clear; lstDest.clear; cboSource.enabled:=true; lstDest.enabled:=true; cboSource.color:=clWindow; lstDest.color:=clWindow; case rgVu.itemindex of 0: {out patient view} begin GetClinicList; GetListForOP(Alist, frmProblems.wgProbData); FastAssign(ClinicFilterList(Alist), cboSource.Items); cboSource.InsertSeparator; cboSource.InitLongList('') ; for i := 0 to PLFilters.ClinicList.Count - 1 do begin cboSource.SelectByID(PLFilters.ClinicList[i]); cmdAddClick(Self); end; end; 1: {in-patient View} begin GetServiceList; GetListForIP(Alist, frmProblems.wgProbData); FastAssign(ServiceFilterList(Alist), cboSource.Items); cboSource.InsertSeparator; cboSource.InitLongList('') ; for i := 0 to PLFilters.ServiceList.Count - 1 do begin cboSource.SelectByID(PLFilters.ServiceList[i]); cmdAddClick(Self); end; end; else {unfiltered view} GetLocationList; end; SetButtons ; finally AList.Free; end; end; procedure TfrmPlVuFilt.lstDestClick(Sender: TObject); begin SetButtons ; end; procedure TfrmPlVuFilt.cboSourceChange(Sender: TObject); begin SetButtons ; end; procedure TfrmPlVuFilt.cboSourceEnter(Sender: TObject); begin cmdAdd.Default := true; end; procedure TfrmPlVuFilt.cboSourceExit(Sender: TObject); begin cmdAdd.Default := false; end; procedure TfrmPlVuFilt.cmdCancelClick(Sender: TObject); begin FFilterChanged := False; close; end; procedure TfrmPlVuFilt.cmdOKClick(Sender: TObject); var Alist:TstringList; procedure SetVu(vulist:TstringList; vu:string); var alist:TstringList; begin alist:=TStringList.create; try vuList.clear; if lstDest.Items.Count=0 then begin AList.Clear; AList.Add('0'); end else FastAssign(lstDest.Items, alist); {conserve only selected items} LoadFilterList(Alist,VuList); PLUser.usCurrentView:=vu; finally alist.free; end; end; begin {BODY of procedure} Alist:=TStringList.create; try PlFilters.ProviderList.clear; if (uppercase(cboProvider.text)='ALL') or (cboProvider.Text='') then begin Alist.clear; AList.Add('0'); PLUser.usViewProv := '0^All'; AList.Add('-1'); LoadFilterList(Alist,PLFilters.ProviderList); end else begin AList.clear; Alist.add(IntToStr(cboProvider.ItemIEN)); PLUser.usViewProv := cboProvider.Items[cboProvider.ItemIndex]; LoadFilterList(Alist, PLFilters.ProviderList); end; case rgVu.itemindex of 0: SetVu(PLFilters.clinicList, PL_OP_VIEW); {OP view} 1: SetVu(PLFilters.ServiceList, PL_IP_VIEW); {IP view} else SetVu(PLFilters.clinicList, PL_UF_VIEW); end; //ShowFilterStatus(PLUser.usCurrentView); //PostMessage(frmProblems.Handle, UM_PLFILTER, 0, 0); FContextString := CreateContextString; FFilterString := CreateFilterString; FFilterChanged := True; close; finally alist.free; end; end; procedure TfrmPlVuFilt.cmdDefaultViewClick(Sender: TObject); {var Alist:TStringList; i: integer; tmpProv: Int64;} begin { Alist:=TStringList.create; try lstDest.Clear; PlUser.usCurrentView:=PLUser.usDefaultView; tmpProv := StrToInt64Def(Piece(PLUser.usDefaultContext, ';', 5), 0); if tmpProv > 0 then PLUser.usViewProv := IntToStr(tmpProv) + ExternalName(tmpProv, 200); with cboStatus do begin for i := 0 to Items.Count - 1 do if Copy(Items[i], 1, 1) = Piece(PLUser.usDefaultContext, ';', 3) then ItemIndex := i; end; chkComments.Checked := (Piece(PLUser.usDefaultContext, ';', 4) = '1'); PLFilters.ProviderList.Clear; PLFilters.ProviderList.Add(Piece(PLUser.usViewProv, U, 1)); FastAssign(plUser.usClinList, PLFilters.ClinicList); FastAssign(plUser.usServList, PlFilters.ServiceList); cboProvider.InitLongList(Piece(PLUser.usViewProv, U, 2)); cboProvider.SelectByID(Piece(PLUser.usViewProv, U, 1)); //InitViewFilters(Alist); finally Alist.free; end; //FormShow(Self); FContextString := PLUser.usDefaultContext; FFilterChanged := True; Close; //ModalResult := mrOK ; } end; procedure TfrmPlVuFilt.FormClose(Sender: TObject; var Action: TCloseAction); begin Release; end; procedure TfrmPlVuFilt.GetClinicList; begin PLFilters.ServiceList.clear; SrcLabel.caption:='Source Clinic(s)'; DstLabel.caption:='Selected Clinic(s)'; cboSource.Caption := 'Source Clinics'; lstDest.Caption := 'Selected Clinic or Clinics'; lstDest.Clear; SetButtons ; end; procedure TfrmPlVuFilt.GetServiceList; begin PLFilters.ClinicList.clear; SrcLabel.caption:='Source Service(s)'; DstLabel.caption:='Selected Service(s)'; cboSource.Caption := 'Source Services'; lstDest.Caption := 'Selected Service or Services'; lstDest.Clear; SetButtons ; end; procedure TfrmPlVuFilt.GetLocationList; begin cboSource.Clear; lstDest.Clear; PLFilters.ClinicList.clear; PLFilters.ServiceList.clear; SrcLabel.caption:='All Locations/Services'; DstLabel.caption:='Selected Locations/Services'; cboSource.Caption := 'All Locations/Services'; lstDest.Caption := 'Selected Locations/Services'; cboSource.color:=clBtnFace; cboSource.enabled:=false; lstDest.color:=clBtnFace; lstDest.enabled:=false; end; procedure TfrmPlVuFilt.cboProviderNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin cboProvider.ForDataUse(SubSetOfActiveAndInactivePersons(StartFrom, Direction)); cboProvider.Items.insert(0,'0^All'); end; procedure TfrmPlVuFilt.cboSourceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin case rgVu.itemindex of 0: {out patient view} cboSource.ForDataUse(SubsetOfClinics(StartFrom,Direction)); 1: {in-patient View} cboSource.ForDataUse(ServiceSearch(StartFrom,Direction)); else {unfiltered view} GetLocationList; end; end; function TfrmPlVuFilt.CreateContextString: string; var Status, Comments, Provider: string; begin if cboStatus.ItemIndex > -1 then Status := cboStatus.ItemID else Status := 'A'; Comments := BOOLCHAR[chkComments.Checked]; if cboProvider.ItemIEN > 0 then Provider := cboProvider.ItemID else Provider := ''; Result := ';;' + Status + ';' + Comments + ';' + Provider; end; function TfrmPlVuFilt.CreateFilterString: string; var FilterString: string; i: integer; begin case rgVu.ItemIndex of 0: FilterString := PL_OP_VIEW + '/'; 1: FilterString := PL_IP_VIEW + '/'; else FilterString := ''; end; if rgVu.ItemIndex <> -1 then for i := 0 to lstDest.Items.Count - 1 do if Piece(lstDest.Items[i], U, 1) <> '-1' then FilterString := FilterString + Piece(lstDest.Items[i], U, 1) + '/'; Result := FilterString; end; procedure TfrmPlVuFilt.cmdSaveClick(Sender: TObject); begin {FContextString := CreateContextString; FFilterString := CreateFilterString; if InfoBox('Replace current defaults?','Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then begin with PLUser do begin usDefaultContext := FContextString; usDefaultView := Piece(FFilterString, '/', 1); end; SaveViewPreferences(FFilterString + U + FContextString); end; } end; end.