unit fPCELex;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fAutoSz, StdCtrls, ORFn, ORCtrls, ExtCtrls, ComCtrls, Contnrs, ImgList,
  Buttons, ActnList, Menus
  , CommCtrl
  ;

type

  TfrmPCELex = class(TfrmAutoSz)
    pnlDialog: TPanel;
    pnlStatus: TPanel;
    lblStatus: TStaticText;
    btnPanel: TPanel;
    cmdCancel: TButton;
    cmdOK: TButton;
    pnlSearch: TPanel;
    lblSearch: TLabel;
    pnlList: TPanel;
    lblSelect: TLabel;
    pnlSearchButton: TPanel;
    cmdSearch: TButton;
    Panel2: TPanel;
    txtSearch: TCaptionEdit;
    listViewImages: TImageList;
    OpenDialog1: TOpenDialog;
    tv: TTreeView;
    ActionList1: TActionList;
    acLoadFromFile: TAction;
    ppmDebug: TPopupMenu;
    N1: TMenuItem;
    LoadFromFile1: TMenuItem;
    hcTerms: THeaderControl;
    Panel3: TPanel;
    Bevel1: TBevel;
    acSearch: TAction;
    acAlwaysShowHint: TAction;
    AlwaysShowTreeHint1: TMenuItem;
    acShowHintDebugInfo: TAction;
    acSelect: TAction;
    acHighlightSelectedLine: TAction;
    ShowHintDebugInfo2: TMenuItem;
    acSaveForm: TAction;
    SaveForm1: TMenuItem;
    N2: TMenuItem;
    acSearchByString: TAction;
    acShowSearchButton: TAction;
    procedure cmdCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure txtSearchChange(Sender: TObject);
    procedure updateStatus(status: string);
    procedure CenterForm(lv: TListView; w: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tvExpanded(Sender: TObject; Node: TTreeNode);
    procedure acLoadFromFileExecute(Sender: TObject);
    procedure tvMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure tvAdvancedCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
      State: TCustomDrawState; Stage: TCustomDrawStage; var PaintImages,
      DefaultDraw: Boolean);
    procedure hcTermsResize(Sender: TObject);
    procedure tvChange(Sender: TObject; Node: TTreeNode);
    procedure acSearchExecute(Sender: TObject);
    procedure acAlwaysShowHintExecute(Sender: TObject);
    procedure acShowHintDebugInfoExecute(Sender: TObject);
    procedure tvDblClick(Sender: TObject);
    procedure acSelectExecute(Sender: TObject);
    procedure acHighlightSelectedLineExecute(Sender: TObject);
    procedure tvClick(Sender: TObject);
    procedure acSaveFormExecute(Sender: TObject);
    procedure tvCompare(Sender: TObject; Node1, Node2: TTreeNode; Data: Integer;
      var Compare: Integer);
    procedure pnlStatusResize(Sender: TObject);
    procedure hcTermsSectionClick(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure hcTermsSectionResize(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure txtSearchKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure txtSearchEnter(Sender: TObject);
    procedure acSearchByStringExecute(Sender: TObject);
    procedure tvEnter(Sender: TObject);
    procedure acShowSearchButtonExecute(Sender: TObject);
    procedure txtSearchExit(Sender: TObject);
    procedure tvExit(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    fHintColorOld: TColor;
    fHintHidePause: Integer;
    fHintPause: Integer;
    fTreeWndProc: TWndMethod;
    FLexApp: Integer;
    FCode: string;
    FDate: TFMDateTime;
 //   FSingleCodeSys: Boolean;
    FCodeSys: string;
    lastSection: Integer;
    lastSort: Array[0..1] of char;
    lastHintNode: TTreeNode;
    procedure SetApp(LexApp: Integer);
    procedure SetDate(ADate: TFMDateTime);
    procedure SetResultsTree(aNode: TTreeNode;aResults:TStringList;CleanUp:Boolean=False);
    procedure ClearResultsTree(aTV: TTreeView);
    function NodeTerm(aNode: TTreeNode):String;
    function NodeHint(aNode: TTreeNode):String;
    procedure TreeWndProc(var MSG: TMessage);
    procedure setOKStatus;
    procedure ProcessSearchResults(aTarget:String;aResults:TStringList);
  end;

  TItem = class
  private
    fIEN: string;
    fTerm: string;
    fCode: string;
    fCodeSys: string;
    fFullText: string;
    fsHint: string;
    fListItem: TListItem; {CB}
  public
    constructor Create(const Term, Code, CodeSys, FullText, IEN, sHint: string);
    constructor CreateByString(aString:String); // ICD10 Remediation
    property IEN: string read fIEN;
    property Term: string read fTerm;
    property Code: string read fCode;
    property CodeSys: string read fCodeSys;
    property FullText: string read fFullText;
    property sHint: string read fsHint;
    property ListItem: TListItem read fListItem write fListItem; {CB}
  end;

procedure LexiconLookup(var Code: string; LexApp: Integer; ADate: TFMDateTime = 0);

implementation

{$R *.DFM}

uses rPCE, rMisc, rGroupNote, uUtils;
// ICD-10 ================================================================ begin
// values for parsing RPC results
const
  posIEN = 1;       // was set to 5 by rbk 4/18/2012;
  posIENParent = 9; // was6;
  posTerm = 2;
  posTerm2 = 3;
  posCode = 4;      // was 5;
  posCodeSys = 3;   // was 4;
  posHint = 2;      // was 3;
var
  CodeTextWidth: Integer = 72;
// ICD-10 ================================================================== end
var
  frmPCELex: TfrmPCELex;

procedure LexiconLookup(var Code: string; LexApp: Integer; ADate: TFMDateTime = 0);
begin
  if not Assigned(frmPCELex) then
    frmPCELex := TfrmPCELex.Create(Application);
  try
    ResizeFormToFont(TForm(frmPCELex));
    frmPCELex.SetApp(LexApp);
    frmPCELex.SetDate(ADate);
    frmPCELex.ShowModal;
    Code := frmPCELex.FCode;
  finally
    if not frmPCELex.acSaveForm.Checked then
      begin
        frmPCELex.Free;
        frmPCELex := nil;
      end;
  end;
end;

procedure TfrmPCELex.FormCreate(Sender: TObject);
begin
  inherited;
  FCode := '';
  FCodeSys := '';
 // FSingleCodeSys := True;
  fTreeWndProc := tv.WindowProc;
  tv.WindowProc := TreeWndProc;

  BorderStyle := bsSizeable;

  fHintColorOld := Application.HintColor;
  fHintHidePause := Application.HintHidePause;
  fHintPause := Application.HintPause;

  Application.HintPause := 200;
  Application.HintHidePause := 15000;
  lastSection := 0;
  lastSort[0] := 'a';
  lastSort[1] := 'a';

{$IFDEF ICD10DEBUG}
  Application.HintColor := clLime;
  PopupMenu := ppmDebug;
{$ENDIF}
end;

procedure TfrmPCELex.SetApp(LexApp: Integer);
begin
  FLexApp := LexApp;
  case LexApp of
    LX_ICD: begin
        Caption := 'Lookup Diagnosis';
        lblSearch.Caption := '&Search for Diagnosis';
      end;
    LX_CPT: begin
        Caption := 'Lookup Procedure';
        lblSearch.Caption := '&Search for Procedure';
      end;
  end;
end;

procedure TfrmPCELex.SetDate(ADate: TFMDateTime);
begin
  FDate := ADate;
end;

procedure TfrmPCELex.tvEnter(Sender: TObject);
begin
  inherited;
  tv.Color := clCream;
  tv.Repaint;
end;

procedure TfrmPCELex.tvExit(Sender: TObject);
begin
  inherited;
  tv.Color := clWindow;
  tv.Repaint;
end;

procedure TfrmPCELex.tvExpanded(Sender: TObject; Node: TTreeNode);
var
  tn: TTreeNode;
  LexResults: TStringList;
  anItem: TItem;
  SearchStr: String;
// CodeCR CPRS171 -------------------------------------------------------- begin
  implDate: Extended;
  ExtendedSearch,
  AI10Active: Boolean;
// CodeCR CPRS171 ---------------------------------------------------------- end
begin
  inherited;
  tv.Enabled := False; // 2013-12-06
  if (Node.Count = 1) then
    begin
      tn := Node.getFirstChild;
      if tn.Text = 'test' then
        begin
          anItem := TItem(Node.Data);
          LexResults := TStringList.Create;
          try
            Screen.Cursor := crDefault;
            updateStatus('Searching ' + anItem.fCode + '...');
            hcTerms.Sections[1].Text := anItem.CodeSys;
            SearchStr := anItem.fCode;
// CodeCR CPRS171 -------------------------------------------------------- begin
// adding parameters to ListLexicon call to fix the CPRS171
  implDate := StrToFloat(GImplementationDate);
  AI10Active := Trunc(implDate)<=FDate;
  ExtendedSearch:= True;
// C0deCR CPRS171 ---------------------------------------------------------- end
            ListLexicon(LexResults, SearchStr, FLexApp, FDate,ExtendedSearch,AI10Active);
            SetResultsTree(Node,LexResults,True);
          finally
            updateStatus('');
            LexResults.Free;
          end;
        end;
      Node.Expand(false);
    end;
  tv.Enabled := True;  // 2013-12-06
end;

procedure TfrmPCELex.txtSearchChange(Sender: TObject);
begin
  inherited;
//  cmdSearch.Default := True;
  cmdOK.Default := False;
  cmdCancel.Default := False;
  ClearResultsTree(tv);
  CenterForm(nil, Constraints.MinWidth);
end;

procedure TfrmPCELex.txtSearchEnter(Sender: TObject);
begin
  inherited;
//  cmdSearch.Default := True;
  cmdOK.Default := False;
  cmdCancel.Default := False;
  txtSearch.Color := clCream;
end;

procedure TfrmPCELex.txtSearchExit(Sender: TObject);
begin
  inherited;
  txtSearch.Color := clWindow;
end;

procedure TfrmPCELex.txtSearchKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = VK_RETURN then
    acSearchByString.Execute;
end;

procedure TfrmPCELex.acAlwaysShowHintExecute(Sender: TObject);
begin
  inherited;
  acAlwaysShowHint.Checked := not acAlwaysShowHint.Checked;
end;

procedure TfrmPCELex.acHighlightSelectedLineExecute(Sender: TObject);
begin
  inherited;
  acHighlightSelectedLine.Checked := not  acHighlightSelectedLine.Checked;
  tv.RowSelect := acHighlightSelectedLine.Checked;
  tv.Repaint;
end;

procedure TfrmPCELex.acLoadFromFileExecute(Sender: TObject);
begin
  inherited;
  acLoadFromFile.Checked := not acLoadFromFile.Checked;
end;

procedure TfrmPCELex.acShowHintDebugInfoExecute(Sender: TObject);
begin
  inherited;
  acShowHintDebugInfo.Checked := not acShowHintDebugInfo.Checked;
end;

procedure TfrmPCELex.acShowSearchButtonExecute(Sender: TObject);
begin
  inherited;
  acShowSearchButton.Checked := not acShowSearchButton.Checked;
  pnlSearchButton.Visible := acShowSearchButton.Checked;
end;

procedure TfrmPCELex.acSaveFormExecute(Sender: TObject);
begin
  inherited;
  acSaveForm.Checked := not acSaveForm.Checked;
end;

procedure TfrmPCELex.acSearchByStringExecute(Sender: TObject);
begin
  inherited;
  ClearResultsTree(tv);
  acSearchExecute(nil);
end;

procedure TfrmPCELex.acSearchExecute(Sender: TObject);
var
  SearchStr,subset, MaxICD10, SrchFrq: String;
  implDate, Num: Extended;
  LexResults: TStringList;
  ExtendedSearch,
  AI10Active: Boolean;

begin
  inherited;
  FCodeSys := '';
//  FSingleCodeSys := True;

  if Length(txtSearch.Text) = 0 then begin
    InfoBox('Enter a term to search for, then click "SEARCH"', 'Information', MB_OK or MB_ICONINFORMATION);
    txtSearch.SetFocus;
    Exit;
  end;

  SearchStr := Uppercase(txtSearch.Text);
  implDate := StrToFloat(GImplementationDate);
  AI10Active := Trunc(implDate)<=FDate;

  if (FLexApp = LX_ICD) then begin
    ExtendedSearch := True;
    if FDate < Trunc(implDate) then // rpk 2/16/2012
      subset := 'ICD-9-CM Diagnoses'
    else
    begin
      { TDP - 9/11/2012 - Modified to provide user continuation dialog if
              search term frequency is greater than system max allowed for
              ICD-10 searches.}
      MaxICD10 := IsMaxICD10(SearchStr);

      if (Piece(MaxICD10, u, 1) = '1') then
      begin
        Num := StrToFloatDef(Piece(MaxICD10, u, 2),0);
        SrchFrq := Format('%.0n',[Num]);
        if MessageDlg(
          'Searching for "' + SearchStr + '" requires inspecting ' + SrchFrq + ' records ' + CRLF +
          'to determine if they match the search criteria. ' + CRLF +
          'This could take quite some time. ' + CRLF+
          'Suggest refining the search by further specifying "' + SearchStr + '".' + CRLF + CRLF +
          '(WARNING: If you do continue with the current search, ' + CRLF+
          '          the Group Notes application could time out.)' + CRLF + CRLF +
          'Do you wish to continue?', mtWarning,[mbYes,mbNo],0) = mrNo then
        begin
          // If user quits search, then reset for new search
          lblSelect.Visible := False;
          txtSearch.SetFocus;
          txtSearch.text := '';
          cmdOK.Default := False;
//          cmdSearch.Default := True;
          Exit;
        end;
      end;
      subset := 'ICD-10-CM Diagnoses';
    end;
  end
  else if FLexApp = LX_CPT then
    subset := 'Current Procedural Terminology (CPT)'
  else
    subset := 'Clinical Lexicon';

  LexResults := TStringList.Create;
  try
    Screen.Cursor := crDefault;
    updateStatus('Searching ' + subset + '...');
    if FLexApp = LX_CPT then
        subset := 'CPT-Code';
{$IFDEF ICD10DEBUG}
    if acLoadFromFile.Checked then
      begin
        if OpenDialog1.Execute then
          LexResults.LoadFromFile(OpenDialog1.FileName);
      end
    else
{$ENDIF}
    ListLexicon(LexResults, SearchStr, FLexApp, FDate,ExtendedSearch,AI10Active);
    ProcessSearchResults(subset,LexResults);

  finally
    LexResults.Free;
    Screen.Cursor := crDefault;
  end;
end;

procedure TfrmPCELex.acSelectExecute(Sender: TObject);
var
  Item: TItem;
begin
  inherited;
  if not assigned(tv.Selected) then Exit;
  if not assigned(tv.Selected.Data) then Exit;

  Item := TItem(tv.Selected.Data);

// ICD-10 Remediation. Updateing results selection to include code in the item description. SPEC 30 Begin
  if Item.Code <> '+' then
    FCode := Item.Code + U + Item.Term + ' ('+hcTerms.Sections[1].Text + ' '+Item.Code + ')'+
             U + U + Item.sHint + ' ('+hcTerms.Sections[1].Text + ' '+Item.Code + ')'
  ;
//  if Item.Code <> '+' then FCode := Item.Code + U + Item.Term + U + U + Item.sHint
//  ;
////  else FCode := LexiconToCode(StrToInt(Item.IEN), FLexApp, FDate) + U + Item.Term + U + U + Item.sHint;
// ICD-10 Remediation. Updateing results selection to include code in the item description. SPEC 30. End

  Close;
end;

procedure TfrmPCELex.cmdCancelClick(Sender: TObject);
begin
  inherited;
  FCode := '';
  Close;
end;

procedure TfrmPCELex.updateStatus(status: string);
begin
  lblStatus.caption := ' ' +status;
  lblStatus.Invalidate;
  lblStatus.Update;
end;

procedure TfrmPCELex.CenterForm(lv: TListView; w: Integer);
var
  wdiff, mainw
//  , gw
  : Integer;
begin
  mainw := Application.MainForm.Width;
  self.Constraints.MaxWidth := 0;
//  if w > mainw then
//    w := mainw;
//  self.ClientWidth := w + (lv.Width - lv.ClientWidth);
//  gw := lvLexGridWidth(lvLex);
//  if (lv.ClientWidth > gw) then
//    lv.Columns[0].Width := lv.Columns[0].Width + (lv.ClientWidth - gw);
  wdiff := ((mainw - self.Width) div 2);
  self.Left := Application.MainForm.Left + wdiff;
  self.Constraints.MaxWidth := self.Width;
  invalidate;
end;

procedure TfrmPCELex.FormShow(Sender: TObject);
begin
  inherited;
  txtSearch.setfocus;                                             // SDD 3.3.82
  CenterForm(nil, tv.ClientWidth);
end;

procedure TfrmPCELex.hcTermsResize(Sender: TObject);
begin
  inherited;
  hcTerms.Sections[1].Width := CodeTextWidth+24;
  hcTerms.Sections[0].Width := hcTerms.Width - hcTerms.Sections[1].width;
end;

procedure TfrmPCELex.hcTermsSectionClick(HeaderControl: THeaderControl;
  Section: THeaderSection);
var
  newSection: Integer;
  i: integer;

begin
  inherited;
  newSection := 0;
  if Section = hcTerms.Sections[1] then
    newSection := 1;
  if newSection = LastSection then
    begin
      if lastSort[lastSection] = 'a' then
        lastSort[lastSection] := 'd'
      else
        lastSort[lastSection] := 'a';
    end
  else
    lastSection := newSection;

  for i := 0 to 1 do
    begin
      if i = lastSection then
        case lastSort[i] of
          'a': hcTerms.Sections[i].ImageIndex := 3;
          'd': hcTerms.Sections[i].ImageIndex := 4;
        else
           hcTerms.Sections[i].ImageIndex := -1;
        end
      else
        hcTerms.Sections[i].ImageIndex := -1;

    end;

  tv.AlphaSort(True);
end;

procedure TfrmPCELex.hcTermsSectionResize(HeaderControl: THeaderControl;
  Section: THeaderSection);
begin
  inherited;
//  CodeTextWidth := hcTerms.Sections[1].Width -24;
  tv.Repaint;
  hcTermsResize(nil);
end;

////////////////////////////////////////////////////////////////////////////////

constructor TItem.Create(const Term, Code, CodeSys, FullText, IEN, sHint: string);
begin
  fIEN := IEN;
  fTerm := Term;
  fCode := Code;
  fCodeSys := CodeSys;
  fsHint := sHint;
  fFullText := FullText;
end;

constructor TItem.CreateByString(aString: string);
var
  sIEN,sTerm,sCode,sCodeSys,sHint,sFullText:String;
begin
  sIEN := piece(aString, u, posIEN);
  sTerm := Piece(aString, u, posTerm);
  sCode := piece(aString, u, posCode);
  sCodeSys := piece(aString, u, posCodeSys);
  sHint := piece(aString, u, posHint);
  sFullText := aString;
  Create(sTerm,sCode,sCodeSys,sFullText,sIEN,sHint);
end;

procedure TfrmPCELex.tvMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Tree: TTreeView;
  HoverNode: TTreeNode;
//  hitTest: THitTests;
begin
  inherited;

  if Sender  is TTreeView then
      Tree := TTreeView(Sender)
  else
    exit;

  hoverNode := Tree.GetNodeAt(X,Y);
//  hitTest := Tree.getHitTestInfoAt(X,Y);

  if lastHintNode <> hoverNode then
    begin
      Application.CancelHint;
//      if (hitTest <= [htOnItem, htOnIcon, htOnLabel, htOnStateIcon]) then
        begin
          lastHintNode := hoverNode;
          tree.Hint := NodeHint(hoverNode);
        end;
    end;
end;

procedure TfrmPCELex.FormDestroy(Sender: TObject);
begin
  inherited;
  if not acSaveForm.Checked then
    ClearResultsTree(tv);
  Application.HintColor := fHintColorOld;
  Application.HintHidePause := fHintHidePause;
  Application.HintPause := fHintPause;
  tv.WindowProc :=   fTreeWndProc;
  fTreeWndProc := nil;
end;

procedure TfrmPCELex.FormResize(Sender: TObject);
begin
  inherited;
end;

////////////////////////////////////////////////////////////////////////////////

procedure TfrmPCELex.SetResultsTree(aNode: TTreeNode;aResults:TStringList;CleanUp:Boolean=False);
var
  i: Integer;
  tn: TTreeNode;
  anItem:TItem;
begin
  if CleanUp and (aNode<>nil) then
    begin
      tn := aNode.getFirstChild;
      while tn <> nil do
        begin
          if tn.Data <> nil then
            TItem(tn.Data).Free;
          tn := aNode.GetNextChild(tn);
        end;
      aNode.DeleteChildren;
    end;
  if pos('-1',aResults.Text) = 1 then
    Exit;
  for i  := 0 to aResults.Count - 1 do
    begin
      anItem := TItem.CreateByString(aResults[i]);
      tn := tv.Items.AddChild(aNode,''{anItem.fCode + ' '+ anItem.fTerm});
      if anItem.fIEN = '+' then
        begin
          tv.Items.AddChild(tn,'test');
        end;
      tn.Data := anItem;
    end;
end;

procedure TfrmPCELex.ClearResultsTree(aTV: TTreeView);
var
  i: Integer;
  anObject: TObject;
begin
  with aTV do
    for i  := 0 to Items.Count - 1 do
      begin
      if Items[i].Data <> nil then
        begin
          anObject := TItem(Items[i].Data);
          if anObject is TItem then
            TItem(anObject).Free;
        end;
      end;
  aTV.Items.Clear;
end;

function TfrmPCELex.NodeHint(aNode:TTreeNode):String;
var
  r,rf: TRect;
  w: Integer;
begin
  Result := '';
  if Assigned(aNode) and Assigned(aNode.Data) then
    begin
      r := aNode.DisplayRect(True);
      rf := aNode.DisplayRect(False);
      w := tv.Canvas.TextWidth(NodeTerm(aNode));
      if acShowHintDebugInfo.Checked then
        begin
          Result :=
            'Text: '+ NodeTerm(aNode) + #13#10 +
            'Width: '+ IntToStr(w) + #13#10 +
            'Space: '+ IntToStr(rf.Right-r.Left-CodeTextWidth)+#13#10;
        end
      else
        Result := '';
      if (not acAlwaysShowHint.Checked) and // available only for debug build
        (w < (rf.Right-r.Left-CodeTextWidth)) then  //ICD-10 SPEC....
        exit
      else
        begin
          Result := Result + TItem(aNode.Data).fCode + ' ';
          Result := Result + TItem(aNode.Data).fTerm;
//          Result := StringReplace(Result,'^',#13#10,[rfReplaceAll,rfIgnoreCase]);
        end;
      Result := HintString(Result);
    end;
end;

function TfrmPCELex.NodeTerm(aNode:TTreeNode):String;
begin
  Result := '';
  if Assigned(aNode.Data) then
    Result := TItem(aNode.Data).fTerm;
end;

procedure TfrmPCELex.pnlStatusResize(Sender: TObject);
begin
  inherited;
  lblStatus.Top := (pnlStatus.Height - lblStatus.Height) div 2;
end;

procedure TfrmPCELex.tvAdvancedCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
  var PaintImages, DefaultDraw: Boolean);
var
  txtItem,txtCode,
  txtRect,fullRect: TRect;
  DC: HDC;
  itemIEN,
  itemTxt,
  itemCode: String;

begin
  inherited;

  if stage = cdPostPaint then
    begin
      if Assigned(Node.Data) then
        begin
          itemTxt := TItem(Node.Data).fTerm;
          itemCode := TItem(Node.Data).fCode;
          itemIEN := TItem(Node.Data).fIEN;
        end
      else
        begin
          itemTxt := '';
          itemCode := '';
          itemIEN := '';
        end;

      DC := tv.Canvas.Handle;
      txtRect := Node.DisplayRect(True);
      fullRect := Node.DisplayRect(False);

      tv.Canvas.FillRect(txtRect);
      if (cdsFocused in State) and (cdsSelected in State) then
        DrawFocusRect(DC,fullRect);

      txtRect.Left := txtRect.Left + 1;
      txtRect.Top := txtRect.Top + 1;
      txtRect.Right := txtRect.Right - 1;
      txtRect.Bottom := txtRect.Bottom - 1;

      txtItem := txtRect;
      txtCode := txtRect;

      txtItem.Right := fullRect.Right - CodeTextWidth + 1;
      txtCode.Left := fullRect.Right - CodeTextWidth + 1;
      txtCode.Right := fullRect.Right;
(*
      if Assigned(anItem) then
        begin
          DrawText(DC,PChar(anItem.fTerm),-1,txtItem,
            DT_LEFT or DT_CALCRECT or DT_VCENTER or DT_END_ELLIPSIS);
          tv.Canvas.Brush.Color := $00BFF2FB;
          tv.Canvas.FillRect(txtCode);
          DrawText(DC,PChar(anItem.fCode),-1,txtCode,DT_LEFT or DT_VCENTER);
        end;
*)
      if itemIEN = '+' then
        SetTextColor(DC,clBlack)
      else
        setTextColor(DC,clNavy);

      DrawText(DC,PChar(itemTxt),length(itemTxt),txtItem,
        DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
      DrawText(DC,PChar(itemCode),-1,txtCode,DT_LEFT or DT_VCENTER);
    end;
end;

procedure TfrmPCELex.tvChange(Sender: TObject; Node: TTreeNode);
begin
  inherited;
  tv.Repaint;
  setOkStatus;
end;

procedure TfrmPCELex.tvClick(Sender: TObject);
begin
  if Assigned(lastHintNode) then
    tv.Selected := lastHintNode;
end;

procedure TfrmPCELex.tvCompare(Sender: TObject; Node1, Node2: TTreeNode;
  Data: Integer; var Compare: Integer);
var
  Item1,Item2: TItem;
  str1,str2:String;

  function ItemStr(anItem:TItem):String;
  begin
    result := '';
    if not Assigned(anItem) then
      Exit;
    case lastSection of
    0: Result := anItem.fTerm;
    1: Result := anItem.fCode;
    end;
  end;

begin
  inherited;

  str1 := '';
  str2 := '';
  Item1 := nil;
  Item2 := nil;
  if Assigned(Node1.Data) then Item1 := TItem(Node1.Data);
  if Assigned(Node2.Data) then Item2 := TItem(Node2.Data);

  str1 := ItemStr(Item1);
  str2 := ItemStr(Item2);

  if Assigned(Item1) and Assigned(Item2) then
    Compare := CompareStr(str1,str2)
  else if Assigned(Item2) then
    Compare := -1
  else if Assigned(Item1) then
    Compare := 1
  else
    Compare := 0;

  if lastSort[lastSection]='d' then
    Compare := - Compare;

end;

procedure TfrmPCELex.tvDblClick(Sender: TObject);
begin
  inherited;
  if Assigned(tv.Selected) and Assigned(tv.Selected.Data) then
    if  (TItem(tv.Selected.Data).fIEN <> '+') then
      acSelect.Execute // double click will enforce selection only for nodes with valid code
    else
      tv.Selected.Expand(false);
end;

procedure TfrmPCELex.TreeWndProc(var MSG: TMessage);
begin
  // hiding horizontal scroll bar
  ShowScrollBar(tv.Handle,SB_HORZ,false);
  ShowScrollBar(tv.Handle,SB_VERT,true);
  fTreeWndProc(Msg);
end;

procedure TfrmPCELex.setOKStatus;
var
  bStatus: Boolean;
begin
  bStatus := False;
  if assigned(tv.Selected) and Assigned(tv.Selected.Data) then
    bStatus := (TItem(tv.Selected.Data).fIEN <> '+');
  acSelect.Enabled := bStatus;
  acSearch.Enabled := not bStatus;
  cmdOK.Default := bStatus;
//  cmdSearch.Default := not bStatus;
end;

procedure TfrmPCELex.ProcessSearchResults(aTarget: String;aResults:TStringList);
begin
  if copy(aResults.Text,1,1)='-' then
    begin
      UpdateStatus(piece(aResults.Text,U,2));
      lblSelect.Visible := False;
      updateStatus(' 0 matches found');
    end
  else
    begin
      tv.SetFocus;
      if tv.Items.Count > 0  then
        tv.Items[0].Focused := True;

      lblSelect.Visible := True;
      hcTerms.Sections[1].Text := Piece(aTarget,' ',1);
      SetResultsTree(nil,aResults);
      updateStatus(Format(' %d matches found',[aResults.Count]));
      setOkStatus;
    end;
end;

end.

