source: cprs/trunk/CPRS-Chart/Options/fOptionsCombinations.pas@ 456

unit fOptionsCombinations;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ORCtrls, OrFn, ComCtrls;

type
  TfrmOptionsCombinations = class(TForm)
    radAddByType: TRadioGroup;
    lblInfo: TMemo;
    lblAddby: TLabel;
    lblCombinations: TLabel;
    lstAddBy: TORComboBox;
    btnAdd: TButton;
    btnRemove: TButton;
    pnlBottom: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    bvlBottom: TBevel;
    lvwCombinations: TCaptionListView;
    procedure radAddByTypeClick(Sender: TObject);
    procedure lstAddByNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure FormCreate(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure lvwCombinationsColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure lvwCombinationsCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure btnRemoveClick(Sender: TObject);
    procedure lstAddByChange(Sender: TObject);
    procedure lstAddByKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnOKClick(Sender: TObject);
    procedure lstAddByEnter(Sender: TObject);
    procedure lstAddByExit(Sender: TObject);
    procedure lvwCombinationsChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FsortCol: integer;
    FsortAscending: boolean;
    FDirty: boolean;
    function Duplicate(avalueien, asource: string): boolean;
    procedure LoadCombinations(alist: TStrings);
  public
    { Public declarations }
  end;

var
  frmOptionsCombinations: TfrmOptionsCombinations;

procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);

implementation

uses rOptions, rCore;

{$R *.DFM}

type
  TCombination = class
  public
    IEN: string;
    Entry: string;
    Source: string;
end;

procedure DialogOptionsCombinations(topvalue, leftvalue, fontsize: integer; var actiontype: Integer);
// create the form and make it modal, return an action
var
  frmOptionsCombinations: TfrmOptionsCombinations;
begin
  frmOptionsCombinations := TfrmOptionsCombinations.Create(Application);
  actiontype := 0;
  try
    with frmOptionsCombinations do
    begin
      if (topvalue < 0) or (leftvalue < 0) then
        Position := poScreenCenter
      else
      begin
        Position := poDesigned;
        Top := topvalue;
        Left := leftvalue;
      end;
      ResizeAnchoredFormToFont(frmOptionsCombinations);
      ShowModal;
      actiontype := btnOK.Tag;
    end;
  finally
    frmOptionsCombinations.Release;
  end;
end;

procedure TfrmOptionsCombinations.radAddByTypeClick(Sender: TObject);
begin
  with lstAddBy do
  begin
    case radAddByType.ItemIndex of
      0: begin
           ListItemsOnly := false;
           LongList := false;
           ListWardAll(lstAddBy.Items);
           MixedCaseList(lstAddBy.Items);
           lblAddby.Caption := 'Ward:';
         end;
      1: begin
           ListItemsOnly := true;
           LongList := true;
           InitLongList('');
           lblAddby.Caption := 'Clinic:';
         end;
      2: begin
           ListItemsOnly := true;
           LongList := true;
           InitLongList('');
           lblAddby.Caption := 'Provider:';
         end;
      3: begin
           ListItemsOnly := false;
           LongList := false;
           ListSpecialtyAll(lstAddBy.Items);
           lblAddby.Caption := 'Specialty:';
         end;
      4: begin
           ListItemsOnly := false;
           LongList := false;
           ListTeamAll(lstAddBy.Items);
           lblAddby.Caption := 'List:';
         end;
    end;
    lstAddBy.Caption := lblAddby.Caption;
    ItemIndex := -1;
    Text := '';
    btnAdd.Enabled := false;
  end;
end;

procedure TfrmOptionsCombinations.lstAddByNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
  with lstAddBy do
  begin
    case radAddByType.ItemIndex of
      0: begin
           Pieces := '2';
         end;
      1: begin
           Pieces := '2';
           ForDataUse(SubSetOfClinics(StartFrom, Direction));
         end;
      2: begin
           Pieces := '2,3';
           ForDataUse(SubSetOfProviders(StartFrom, Direction));
         end;
      3: begin
           Pieces := '2';
         end;
      4: begin
           Pieces := '2';
         end;
    end;
  end;
end;

procedure TfrmOptionsCombinations.FormCreate(Sender: TObject);
begin
  radAddByType.ItemIndex := 0;
  radAddByTypeClick(self);
  FDirty := false;
end;

procedure TfrmOptionsCombinations.btnAddClick(Sender: TObject);
var
  aListItem: TListItem;
  aCombination: TCombination;
  valueien, valuename, valuesource: string;
begin
  valuesource := radAddByType.Items[radAddByType.ItemIndex];
  if copy(valuesource, 1, 1) = '&' then
    valuesource := copy(valuesource, 2, length(valuesource) - 1);
  valuename := Piece(lstAddBy.DisplayText[lstAddBy.ItemIndex], '-', 1);
  valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
  if Duplicate(valueien, valuesource) then exit; // check for duplicates
  aListItem := lvwCombinations.Items.Add;
  with aListItem do
  begin
    Caption := valuename;
    SubItems.Add(valuesource);
  end;
  aCombination := TCombination.Create;
  with aCombination do
  begin
    IEN := valueien;
    Entry := valuename;
    Source := valuesource;
  end;
  aListItem.SubItems.AddObject('combo object', aCombination);
  btnAdd.Enabled := false;
  FDirty := true;
end;

procedure TfrmOptionsCombinations.lvwCombinationsColumnClick(
  Sender: TObject; Column: TListColumn);
begin
  if FsortCol = Column.Index then
    FsortAscending := not FsortAscending
  else
    FsortAscending := true;
  FsortCol := Column.Index;
  (Sender as TListView).AlphaSort;
end;

procedure TfrmOptionsCombinations.lvwCombinationsCompare(Sender: TObject;
  Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  if not(Sender is TListView) then exit;
  if FsortAscending then
  begin
    if FsortCol = 0 then
      Compare := CompareStr(Item1.Caption, Item2.Caption)
    else
      Compare := CompareStr(Item1.SubItems[FsortCol - 1],
        Item2.SubItems[FsortCol - 1]);
  end
  else
  begin
    if FsortCol = 0 then
      Compare := CompareStr(Item2.Caption, Item1.Caption)
    else
      Compare := CompareStr(Item2.SubItems[FsortCol - 1],
        Item1.SubItems[FsortCol - 1]);
  end;
end;

procedure TfrmOptionsCombinations.btnRemoveClick(Sender: TObject);
var
  i: integer;
begin
  with lvwCombinations do
  for i := Items.Count - 1 downto 0 do
    if Items[i].Selected then
      Items[i].Delete;
  btnRemove.Enabled := false;
  FDirty := true;
end;

procedure TfrmOptionsCombinations.lstAddByChange(Sender: TObject);
var
  valueien, source: string;
begin
  if lstAddBy.ItemIndex = -1 then
    btnAdd.Enabled := false
  else
  begin
    source := radAddByType.Items[radAddByType.ItemIndex];
    if copy(source, 1, 1) = '&' then
      source := copy(source, 2, length(source) - 1);
    valueien := Piece(lstAddBy.Items[lstAddBy.ItemIndex], '^', 1);
    btnAdd.Enabled :=  not Duplicate(valueien, source);
  end;
  btnRemove.Enabled := false;
end;

function TfrmOptionsCombinations.Duplicate(avalueien,
  asource: string): boolean;
var
  i: integer;
  aCombination :TCombination;
begin
  result := false;
  with lvwCombinations do
  for i := 0 to Items.Count - 1 do
    if asource = Items[i].Subitems[0] then
    begin
      aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
      if aCombination.IEN = avalueien then
      begin
        Result := true;
      end;
    end;
end;

procedure TfrmOptionsCombinations.lstAddByKeyUp(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key = 13 then Perform(WM_NextDlgCtl, 0, 0);
end;

procedure TfrmOptionsCombinations.btnOKClick(Sender: TObject);
var
  i: integer;
  alist: TStringList;
  aCombination :TCombination;
begin
  if FDirty then
  begin
    alist := TStringList.Create;
    with lvwCombinations do
    for i := 0 to Items.Count - 1 do
    begin
      aCombination := TCombination(Items.Item[i].SubItems.Objects[1]);
      with aCombination do alist.Add(IEN + '^' + Source);
    end;
    rpcSetCombo(alist);
    alist.Free;
  end;
end;

procedure TfrmOptionsCombinations.lstAddByEnter(Sender: TObject);
begin
  btnAdd.Default := true;
end;

procedure TfrmOptionsCombinations.lstAddByExit(Sender: TObject);
begin
  btnAdd.Default := false;
end;

procedure TfrmOptionsCombinations.lvwCombinationsChange(Sender: TObject;
  Item: TListItem; Change: TItemChange);
begin
  btnRemove.Enabled := lvwCombinations.SelCount > 0;
end;

procedure TfrmOptionsCombinations.LoadCombinations(alist: TStrings);
var
  i: integer;
  aListItem: TListItem;
  aCombination: TCombination;
  valueien, valuename, valuesource: string;
begin
  for i := 0 to alist.Count - 1 do
  begin
    valuesource := Piece(alist[i], '^', 1);
    valuename := Piece(alist[i], '^', 2);
    valueien := Piece(alist[i], '^', 3);
    aListItem := lvwCombinations.Items.Add;
    with aListItem do
    begin
      Caption := valuename;
      SubItems.Add(valuesource);
    end;
    aCombination := TCombination.Create;
    with aCombination do
    begin
      IEN := valueien;
      Entry := valuename;
      Source := valuesource;
    end;
    aListItem.SubItems.AddObject('combo object', aCombination);
  end;
end;

procedure TfrmOptionsCombinations.FormShow(Sender: TObject);
begin
  LoadCombinations(rpcGetCombo);
end;

end.