source: cprs/trunk/CPRS-Chart/Consults/fConsultsView.pas@ 1008

unit fConsultsView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
  StdCtrls, ExtCtrls, ORCtrls, ComCtrls, ORDtTm, uConsults, Menus, fBase508Form,
  VA508AccessibilityManager;

type
  TfrmConsultsView = class(TfrmBase508Form)
    pnlBase: TORAutoPanel;
    lblBeginDate: TLabel;
    calBeginDate: TORDateBox;
    lblEndDate: TLabel;
    calEndDate: TORDateBox;
    radSort: TRadioGroup;
    lblStatus: TLabel;
    lstStatus: TORListBox;
    lblService: TLabel;
    cmdOK: TButton;
    cmdCancel: TButton;
    treService: TORTreeView;
    cboService: TORComboBox;
    cboGroupBy: TORComboBox;
    Label1: TLabel;
    popStatus: TPopupMenu;
    popStatusSelectNone: TMenuItem;
    procedure cmdOKClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure treServiceChange(Sender: TObject; Node: TTreeNode);
    procedure cboServiceSelect(Sender: TObject);
    procedure popStatusSelectNoneClick(Sender: TObject);
  private
    FChanged: Boolean;
    FBeginDate: string;
    FEndDate: string;
    FGroupBy: string;
    FAscending: Boolean;
    FService: string;
    FServiceName: string;
    FConsultUser: boolean ;
    FStatus: string;
    FStatusName: string;
  end;

function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ;

var
  uChanging: Boolean;
  
implementation

{$R *.DFM}

uses rCore, uCore, rConsults;

var
  SvcList: TStrings ;
  SvcInfo: string ;

const
   TX_DATE_ERR = 'Enter valid beginning and ending dates or press Cancel.';
   TX_DATE_ERR_CAP = 'Error in Date Range';

function SelectConsultsView(FontSize: Integer; CurrentContext: TSelectContext; var SelectContext: TSelectContext): boolean ;
{ displays select form for Consults and returns a record of the selection }
var
  frmConsultsView: TfrmConsultsView;
  W, H, i, j: Integer;
  CurrentStatus, CurrentBegin, CurrentEnd, CurrentService: string;
begin
  frmConsultsView := TfrmConsultsView.Create(Application);
  try
    with frmConsultsView do
    begin
      Font.Size := FontSize;
      W := ClientWidth;
      H := ClientHeight;
      ResizeToFont(FontSize, W, H);
      ClientWidth  := W; pnlBase.Width  := W;
      ClientHeight := H; pnlBase.Height := H;
      FChanged := False;
      with radSort do ItemIndex := 1;
      //FastAssign(LoadServiceList(CN_SVC_LIST_DISP), SvcList);                         {RV}
      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_DISP), SvcList);           {RV}
      SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
      for i := 0 to SvcList.Count - 1 do
        if cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1 then   {RV}
        //if cboService.SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
          cboService.Items.Add(SvcList.Strings[i]);
      BuildServiceTree(treService, SvcList, '0', nil) ;
      with treService do
        for i:=0 to Items.Count-1 do
          begin
            if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
            TopItem := Items[0] ;
            Selected := Items[0] ;
          end ;
      CurrentService := CurrentContext.Service;
      if StrToIntDef(CurrentService, 0) > 0 then
        begin
          cboservice.SelectByID(CurrentService);
          cboServiceSelect(frmConsultsView);
        end;
      FastAssign(SubSetOfStatus, lstStatus.Items);
      CurrentStatus := CurrentContext.Status;
      if CurrentStatus <> '' then with lstStatus do
        begin
          i := 1;
          while Piece(CurrentStatus, ',', i) <> '' do
            begin
              j := SelectByID(Piece(CurrentStatus, ',', i));
              if j > -1 then Selected[j] := True;
              Inc(i);
            end;
        end;
      CurrentBegin := CurrentContext.BeginDate;
      CurrentEnd := CurrentContext.EndDate;
      if CurrentBegin <> '' then
        calBeginDate.Text := CurrentBegin;
      if CurrentEnd <> '' then
        calEndDate.Text := CurrentEnd;
      if calEndDate.Text = '' then calEndDate.Text := 'TODAY';
      cboGroupBy.SelectByID(CurrentContext.GroupBy);
      ShowModal;

      with SelectContext do
       begin
        Changed := FChanged;
        BeginDate := FBeginDate;
        EndDate := FEndDate;
        Ascending := FAscending;
        Service := FService;
        ServiceName := FServiceName;
        ConsultUser := FConsultUser ;
        Status := FStatus;
        StatusName := FStatusName;
        GroupBy := FGroupBy;
        Result := Changed ;
      end;

    end; {with frmConsultsView}
  finally
    frmConsultsView.Release;
  end;
end;

procedure TfrmConsultsView.cmdOKClick(Sender: TObject);
var
  bdate, edate: TFMDateTime;
  i: integer;
begin
  if calBeginDate.Text <> '' then
     bdate := StrToFMDateTime(calBeginDate.Text)
  else
     bdate := 0 ;

  if calEndDate.Text <> '' then
     edate   := StrToFMDateTime(calEndDate.Text)
  else
     edate := 0 ;

  if (bdate <= edate) then
    begin
      FAscending := radSort.ItemIndex = 0;
      FBeginDate := calBeginDate.Text;
      FEndDate := calEndDate.Text;
    end
  else
    begin
      InfoBox(TX_DATE_ERR, TX_DATE_ERR_CAP, MB_OK or MB_ICONWARNING);
      Exit;
    end;

  if treService.Selected <> nil then
   begin
     FService := Piece(SvcInfo,u,1) ;
     FServiceName := Piece(SvcInfo,u,2) ;
     FConsultUser := ConsultServiceUser(StrToIntDef(FService, 0), User.DUZ) ;
   end
  else
     FService := '' ;

  if lstStatus.SelCount > 0 then
   begin
      with lstStatus do for i := 0 to Items.Count-1 do if Selected[i] then
        begin
          if Piece(Items[i], U, 1) <> '999' then
            FStatus := FStatus + Piece(Items[i], U, 1) + ','
          else
            FStatus := FStatus + Piece(Items[i],U,3) ;
          FStatusName := FStatusName + DisplayText[i] + ',' ;
        end;
      FStatus := Copy(FStatus, 1, Length(FStatus)-1);
      FStatusName := Copy(FStatusName, 1, Length(FStatusName)-1);
   end
  else
     FStatus := '' ;

  if cboGroupBy.ItemID <> '' then
    FGroupBy := cboGroupBy.ItemID
  else
    FGroupBy := '';

  FChanged := True;
  Close;
end;

procedure TfrmConsultsView.cmdCancelClick(Sender: TObject);
begin
  Close;
end;


procedure TfrmConsultsView.treServiceChange(Sender: TObject; Node: TTreeNode);
begin
   if uChanging then Exit;
   SvcInfo  := TORTreeNode(treService.Selected).StringData ;
   cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text));  {RV}
   //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
end;

procedure TfrmConsultsView.cboServiceSelect(Sender: TObject);
var                                                                      
  i: integer;                                                            
begin                                                                    
  uChanging := True;
  with treService do for i := 0 to Items.Count-1 do
    begin                                                                
      if Piece(TORTreeNode(Items[i]).StringData,U,1) = cboService.ItemID then
        begin                                                            
          Selected := Items[i];                                          
          //treServiceChange(Self, Items[i]);
          break;                                                         
        end;                                                             
    end;
  uChanging := False;
  SvcInfo  := TORTreeNode(treService.Selected).StringData ;
end;                                                                     

procedure TfrmConsultsView.popStatusSelectNoneClick(Sender: TObject);
var
  i: integer;
begin
  with lstStatus do
    begin
      for i := 0 to Items.Count - 1 do
        Selected[i] := False;
      ItemIndex := -1;
    end;
end;

initialization
   SvcList := TStringList.Create ;

finalization
   SvcList.Free ;

end.