unit fOrdersSign;

{.$define debug}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fAutoSz, StdCtrls, ORFn, ORCtrls, AppEvnts, mCoPayDesc, XUDIGSIGSC_TLB,
  ComCtrls, CheckLst, ExtCtrls, uConsults, UBAGlobals,UBACore, UBAMessages, UBAConst,
  Menus, ORClasses, fBase508Form, fPrintLocation, VA508AccessibilityManager;

type
  TfrmSignOrders = class(TfrmBase508Form)
    cmdOK: TButton;
    cmdCancel: TButton;
    lblESCode: TLabel;
    txtESCode: TCaptionEdit;
    clstOrders: TCaptionCheckListBox;
    laDiagnosis: TLabel;
    gbdxLookup: TGroupBox;
    buOrdersDiagnosis: TButton;
    poBACopyPaste: TPopupMenu;
    Copy1: TMenuItem;
    Paste1: TMenuItem; 
    Diagnosis1: TMenuItem;
    Exit1: TMenuItem;
    lblOrderList: TStaticText;
    fraCoPay: TfraCoPayDesc;
    procedure FormCreate(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure cmdCancelClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure clstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure clstOrdersMeasureItem(Control: TWinControl; Index: Integer; var AHeight: Integer);
    procedure clstOrdersClickCheck(Sender: TObject);
    procedure clstOrdersMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure buOrdersDiagnosisClick(Sender: TObject);
    function IsSignatureRequired:boolean;
    procedure Exit1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject); 
    procedure clstOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure clstOrdersClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer); 
    procedure fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure fraCoPayLabel23Enter(Sender: TObject);
    procedure fraCoPayLabel23Exit(Sender: TObject);
    procedure clstOrdersKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
  private
    OKPressed: Boolean;
    ESCode: string;
    FLastHintItem: integer;
    FOldHintPause: integer;
    FOldHintHidePause: integer;
    function ItemsAreChecked: Boolean;
    function GetNumberOfSelectedOrders : byte;
    procedure ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
    procedure SetItemTextToState;
    procedure FormatListForScreenReader;
  public
    procedure SetCheckBoxStatus(thisOrderID: string);
    function GetCheckBoxStatus(sourceOrderID : string) : string; overload; 
    
end;

{Begin BillingAware}
    TarRect = array[MIN_RECT..MAX_RECT] of TRect;

  var
    thisRect: TRect;
    j: shortint;
    ARect: TRect;
    arRect: TarRect;
    ProvDx:  TProvisionalDiagnosis;
    FOSTFHintWndActive: boolean;
    FOSTFhintWindow: THintWindow;
    tempList : TList;

{End BillingAware}

{Forward} function ExecuteSignOrders(SelectedList: TList): Boolean;

var
  crypto: IXuDigSigS;
  rectIndex: Integer;

  {Begin BillingAware}
    frmSignOrders: TfrmSignOrders;
    chkBoxStatus: string;
    srcOrderID: string;
    targetOrderID: string;
    tempStrList: TStringList;
    srcDx: string;
    tempBillableList :TStringList;
    tempOrderList: TStringList;
    copyOrderID: string;
    srcIndex: integer;
    CopyBuffer: TBADxRecord;
  {End BillingAware}

implementation

{$R *.DFM}

uses
  Hash, rCore, rOrders, uConst, fOrdersPrint, uCore, uOrders, uSignItems, fOrders,
  fPCELex, rPCE, fODConsult, fBALocalDiagnoses, fClinicWardMeds, fFrame, rODLab, fRptBox,
  VAUtils;

const
  TX_SAVERR1 = 'The error, ';
  TX_SAVERR2 = ', occurred while trying to save:' + CRLF + CRLF;
  TC_SAVERR  = 'Error Saving Order';

function TfrmSignOrders.GetNumberOfSelectedOrders : byte;
{
 - Return the number of orders in clstOrders that are currently selected.
}
var
  i: integer;
  numSelected: byte;
begin
  Result := 0;
  if BILLING_AWARE then
     begin
      numSelected := 0;

        try
            for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
                if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
                   Inc(numSelected);
        except
           on EListError do
              begin
              {$ifdef debug}Show508Message('EListError in frmSignOrders.GetNumberOfSelectedOrders()');{$endif}
              raise;
              end;
        end;

      Result := numSelected;
     end;
end;

procedure TfrmSignOrders.SetCheckBoxStatus(thisOrderID: string);
{
 - Set the current GRID checkboxes status
}
begin
  if BILLING_AWARE then
     begin
        uSignItems.uSigItems.SetSigItems(clstOrders, thisOrderID);
     end;
end;

function TfrmSignOrders.GetCheckBoxStatus(sourceOrderID: string) : string;  //PASS IN ORDER ID - NOT GRID INDEX
{
- Obtain checkbox status for selected order - BY ORDER ID
}
var
  itemsList: TStringList;
  i: smallint;
  thisOrderID: string;
begin
  Result := '';
  itemsList := TStringList.Create;
  itemsList.Clear;
  itemsList := uSigItems.GetSigItems; //Get FItems list
  if BILLING_AWARE then
     begin
        try
           for i := 0 to itemsList.Count-1 do
              begin
              thisOrderID := Piece(itemsList[i],'^',1); //get the order ID
              if thisOrderID = sourceOrderID then   //compare to order ID of source order
                 begin
                 Result := Piece(itemsList[i],U,4);  //return TF status'
                 Break;
                 end;
              end;
        except
           on EListError do
              begin
              {$ifdef debug}Show508Message('EListError in frmSignOrders.GetCheckBoxStatus()');{$endif}
              raise;
              end;
        end;
     end;
end;

function ExecuteSignOrders(SelectedList: TList): Boolean;
const
  VERT_SPACING = 6;

var
  i, cidx,cnt, theSts, WardIEN: Integer;
  ShrinkHeight: integer;
  SignList: TStringList;
  Obj: TOrder;
  DigSigErr, DigStoreErr, ContainsIMOOrders, DoNotPrint: Boolean;
  x, SigData, SigUser, SigDrugSch, SigDEA: string;
  cSignature, cHashData, cCrlUrl, cErr, WardName: string;
  cProvDUZ: Int64;
  OrderText, ASvc: string;
  PrintLoc: Integer;
  AList, ClinicList, DCList, OrderPrintList, WardList: TStringList;
  EncLocName, EncLocText: string;
  EncLocIEN: integer;
  EncDT: TFMDateTime;
  EncVC: Char;

  function FindOrderText(const AnID: string): string;
  var
    i: Integer;
  begin
    Result := '';
    fOrdersSign.tempList := selectedList;
    with SelectedList do for i := 0 to Count - 1 do
      with TOrder(Items[i]) do if ID = AnID then
      begin
        Result := Text;
        Break;
      end;
  end;

  function SignNotRequired: Boolean;
  var
    i: Integer;
  begin
    Result := True;
    tempList := SelectedList;
    with SelectedList do for i := 0 to Pred(Count) do
    begin
      with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then Result := False;
    end;
  end;

  function DigitalSign: Boolean;
  var
    i: Integer;
  begin
    Result := False;

    with SelectedList do for i := 0 to Pred(Count) do
    begin
      with TOrder(Items[i]) do if Copy(DigSigReq,1,1) = '2' then Result := True;
    end;
  end;

begin
  Result := False;
  DigSigErr := True;
  PrintLoc := 0;
  EncLocIEN := 0;
  DoNotPrint := False;
  if SelectedList.Count = 0 then Exit;
  if BILLING_AWARE then
  begin
     tempOrderList := TStringList.Create;
     tempOrderList.Clear;
  end;
  frmSignOrders := TfrmSignOrders.Create(Application);
  try
    ResizeAnchoredFormToFont(frmSignOrders);
    SigItems.ResetOrders;
    with SelectedList do for i := 0 to Count - 1 do
      begin
        obj := TOrder(Items[i]);
        cidx := frmSignOrders.clstOrders.Items.AddObject(Obj.Text,Obj);
        SigItems.Add(CH_ORD,Obj.ID, cidx);
        if BILLING_AWARE then
           tempOrderList.Add(Obj.ID);
        frmSignOrders.clstOrders.Checked[cidx] := TRUE;

        if (TOrder(Items[i]).DGroupName) = NonVAMedGroup then
           frmSignOrders.clstOrders.State[cidx] := cbGrayed ;
      end;

    if SigItems.UpdateListBox(frmSignOrders.clstOrders) then
      frmSignOrders.fraCoPay.Visible := TRUE
    else
      begin

      {Begin BillingAware}
        if  BILLING_AWARE then
           frmSignOrders.gbDxLookup.Visible := FALSE;
       {End BillingAware}

        with frmSignOrders do begin
          ShrinkHeight := lblOrderList.Top - VERT_SPACING;
          Height := Height - ShrinkHeight;
          lblOrderList.Top := lblOrderList.Top - ShrinkHeight;
          clstOrders.Top := clstOrders.Top - ShrinkHeight;
          clstOrders.Height := clstOrders.Height + ShrinkHeight;
        end;
      end;

    if GetPKISite and GetPKIUse and DigitalSign then //PKI setup for crypto card read
      begin
        try  //PKI object creation
          crypto := CoXuDigSigS.Create;
          crypto.GetCSP;
          StatusText(crypto.Reason);
          DigSigErr := False;
        except
          on  E: Exception do
            begin
              DigSigErr := True;
            end;
        end;
      end;

    if SignNotRequired then
      begin
        frmSignOrders.lblESCode.Visible := False;
        frmSignOrders.txtESCode.Visible := False;
      end;

    if BILLING_AWARE then
    begin
     //  build list of orders that are not billable based on order type
        UBAGlobals.NonBillableOrderList := rpcNonBillableOrders(tempOrderList);
    end;

      frmSignOrders.ShowModal;
      if frmSignOrders.OKPressed then
      begin
        Result := True;
        SignList := TStringList.Create;
        ClinicList := TStringList.Create;
        OrderPrintList := TStringList.Create;
        WardList := TStringList.Create;
        ContainsIMOOrders := false;
        try
          with SelectedList do for i := 0 to Count - 1 do with TOrder(Items[i]) do
            begin
              DigStoreErr := false;
              if (DigSigErr = False) and (Copy(TOrder(Items[i]).DigSigReq,1,1) = '2') then
                begin
                  StatusText('Retrieving DIGITAL SIGNATURE');
                  x := TOrder(Items[i]).ID;
                  SigDrugSch := GetDrugSchedule(x);
                  SigData := SetExternalText(x,SigDrugSch,User.DUZ);
                  if Length(SigData) < 1 then
                    begin
                      ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: Unable to get required data from server');
                      DigStoreErr := true;
                    end;
                  SigUser := piece(SigData,'^',18);
                  SigDEA := piece(SigData,'^',20);
                  cProvDUZ := User.DUZ;
                  if DigStoreErr = false then
                  try
                    crypto.Reset;
                    crypto.DEAsig := true;
                    crypto.UsrName := SigUser;
                    crypto.DrugSch := SigDrugSch;
                    crypto.UsrNumber := SigDEA;
                    crypto.DataBuffer := SigData;
                    if crypto.Signdata = true then
                      begin
                        cSignature := crypto.Signature;
                        cHashData := crypto.HashValue;
                        cCrlUrl := crypto.CrlUrl;
                      end
                    else
                      begin
                        ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Digital Signature failed with reason: '+ piece(Crypto.Reason, '^', 2));
                        DigStoreErr := true;
                      end;
                  except
                    on  E: Exception do
                      begin
                        ShowMsg(TOrder(SelectedList.Items[i]).Text + CRLF + CRLF + 'Crypto raised an error: '+ E.Message);
                        DigStoreErr := true;
                      end;
                  end;  //except
                  if DigStoreErr = true then //PKI
                    begin
                      //NoOp
                    end
                  else
                    begin
                      cErr := '';
                      StoreDigitalSig(ID, cHashData, cProvDUZ, cSignature, cCrlUrl, cErr);
                      cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(Items[i]));
                      if (cidx > -1 ) and (frmSignOrders.clstOrders.Checked[cidx]) and (cErr = '') then
                      begin
                        UpdateOrderDGIfNeeded(ID);
                        SignList.Add(ID + U + SS_DIGSIG + U + RS_RELEASE + U + NO_PROVIDER);
                        BAOrderList.Add(TOrder(Items[i]).ID);
                      end;
                    end;
                end
              else
                begin
                  if GetPKISite and (Copy(TOrder(SelectedList.Items[i]).DigSigReq,1,1) = '2') then
                    begin
                      ShowMsg('ORDER NOT SENT TO PHARMACY' + CRLF + CRLF + TOrder(SelectedList.Items[i]).Text + CRLF + CRLF +
                        'This Schedule II medication cannot be electronically entered without a Digital Signature. ' +
                        CRLF + 'Please discontinue/cancel this order and create a hand written order for manual processing, or digitally sign the order at a PKI-enabled workstation.');
                    end
                  else
                    begin
                      cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(Items[i]));
                      if TOrder(Items[i]).DGroupName = NonVAMedGroup  then  frmSignOrders.clstOrders.Checked[cidx] := True;    //Non VA MEDS
                      if (cidx > -1 ) and (frmSignOrders.clstOrders.Checked[cidx]) then
                      begin
                        UpdateOrderDGIfNeeded(ID);
                        SignList.Add(ID + U + SS_ESIGNED + U + RS_RELEASE + U + NO_PROVIDER);
                      end;
                    end;
                end;
            end;
          StatusText('Sending Orders to Service(s)...');
          if SignList.Count > 0 then
          begin
            //hds7591  Clinic/Ward movement.  Patient Admission IMO
            if not frmFrame.TimedOut then
            begin
               if (Patient.Inpatient = True) and (Encounter.Location <> Patient.Location) then
                   begin
                     DCList := TStringList.Create;
                     EncLocName := Encounter.LocationName;
                     EncLocIEN  := Encounter.Location;
                     EncLocText := Encounter.LocationText;
                     EncDT := Encounter.DateTime;
                     EncVC := Encounter.VisitCategory;
                     for i := 0 to SelectedList.Count - 1 do
                       begin
                         cidx := frmSignOrders.clstOrders.Items.IndexOfObject(TOrder(SelectedList.Items[i]));
                         if frmSignOrders.clstOrders.Checked[cidx] = false then continue;
                         if TOrder(SelectedList.Items[i]).DGroupName = 'Clinic Orders' then ContainsIMOOrders := true;
                         if TOrder(SelectedList.Items[i]).DGroupName = '' then continue;
                         if TOrder(SelectedList.Items[i]).EventPtr <> '' then continue;
                         if Pos('DC', TOrder(SelectedList.Items[i]).ActionOn) > 0 then
                           begin
                             DCList.Add(TOrder(SelectedList.Items[i]).ID);
                             Continue;
                           end;
                         OrderPrintList.Add(TOrder(SelectedList.Items[i]).ID + ':' + TOrder(SelectedList.Items[i]).Text);
                       end;
                      if OrderPrintList.Count > 0 then
                        begin
                          frmPrintLocation.PrintLocation(OrderPrintList, EncLocIEN, EncLocName, EncLocText, EncDT, EncVC, ClinicList,
                                                        WardList, WardIen,WardName, ContainsIMOOrders, true);
                          fframe.frmFrame.OrderPrintForm := false;
                        end
                      else DoNotPrint := True;
                      if (DCList <> nil) and (DCList.Count > 0) then
                        begin
                          for i := 0 to DCList.Count - 1 do
                             WardList.Add(DCList.Strings[i]);
                          if (WardIEN = 0) and (WardName = '') then
                          CurrentLocationForPatient(Patient.DFN, WardIEN, WardName, ASvc);
                        end;
                      if DCList <> nil then DCList.Free;
                   end;
            end;
            uCore.TempEncounterLoc := 0;
            uCore.TempEncounterLocName := '';
            //hds7591  Clinic/Ward movement  Patient Admission IMO

            SigItems.SaveSettings; // Save CoPay FIRST!
            SendOrders(SignList, frmSignOrders.ESCode);
          end;

            with SignList do if Count > 0 then for i := 0 to Count - 1 do
            begin
              if Pos('E', Piece(SignList[i], U, 2)) > 0 then
                begin
                  OrderText := FindOrderText(Piece(SignList[i], U, 1));
                  if Piece(SignList[i],U,4) = 'Invalid Pharmacy order number' then
                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText + CRLF + CRLF +
                        'The changes to this order have not been saved.  You must contact Pharmacy to complete any action on this order.',
                        TC_SAVERR, MB_OK)
                  else
                  InfoBox(TX_SAVERR1 + Piece(SignList[i], U, 4) + TX_SAVERR2 + OrderText,
                        TC_SAVERR, MB_OK);
                end;
              if Pos('R', Piece(SignList[i], U, 2)) > 0 then
                NotifyOtherApps(NAE_ORDER, 'RL' + U + Piece(SignList[i], U, 1));
            end;
          StatusText('');
          for cnt := SignList.Count - 1 downto 0 do
          begin
              if Pos('E', Piece(SignList[cnt], U, 2)) > 0 then
              begin
                SignList.Delete(cnt);
                Continue;
              end;
              theSts := GetOrderStatus(Piece(SignList[cnt],U,1));
              if theSts = 10 then  SignList.Delete(cnt);  //signed delayed order should not be printed.
          end;
          //  CQ 10226, PSI-05-048 - advise of auto-change from LC to WC on lab orders
          AList := TStringList.Create;
          try
            CheckForChangeFromLCtoWCOnRelease(AList, Encounter.Location, SignList);
            if AList.Text <> '' then
              ReportBox(AList, 'Changed Orders', TRUE);
          finally
            AList.Free;
          end;
          if(ClinicList.Count > 0) or (WardList.count > 0) then
              PrintOrdersOnSignReleaseMult(SignList, CLinicList, WardList, NO_PROVIDER, EncLocIEN, WardIEN, EncLocName, wardName)
            else if DoNotPrint = False then PrintOrdersOnSignRelease(SignList, NO_PROVIDER, PrintLoc);
        finally
          SignList.Free;
          OrderPrintList.free;
          WardList.free;
          ClinicList.free;
        end;
      end; {if frmSignOrders.OKPressed}
  finally
    frmSignOrders.Free;
    with SelectedList do for i := 0 to Count - 1 do UnlockOrder(TOrder(Items[i]).ID);
  end;
  crypto := nil;
end;

procedure TfrmSignOrders.FormCreate(Sender: TObject);
begin
  inherited;
  FLastHintItem := -1;
  OKPressed := False;
  FOldHintPause := Application.HintPause;
  Application.HintPause := 250;
  FOldHintHidePause := Application.HintHidePause;
  Application.HintHidePause := 30000;
  tempList := TList.Create;

  {Begin BillingAware}
  //This is the DIAGNOSIS label above the Dx column
  if  BILLING_AWARE then
      begin
        clstOrders.Height := 228;
        clstOrders.Top :=  (gbdxLookup.top + 65);
        gbDxLookup.Visible := TRUE;
        lblOrderList.Top := (gbdxLookup.Top +  gbdxLookup.Height);
        laDiagnosis.Top :=  lblOrderList.Top;
        laDiagnosis.Left := 270;
        laDiagnosis.Visible := TRUE;
        rectIndex := 0;
      end
   else
      begin
         lblOrderList.Top := 158;
         lblOrderList.Left := 8;
     end;
 {End BillingAware}

end;

function TfrmSignOrders.IsSignatureRequired:boolean;
var
   i: Integer;
begin
    Result := FALSE;

    with tempList do for i := 0 to Pred(Count) do
    begin
      if frmSignOrders.clstOrders.Checked[i] then
      begin
      with TOrder(Items[i]) do if Signature <> OSS_NOT_REQUIRE then
         Result := TRUE;
      end;
    end;
end;

procedure TfrmSignOrders.cmdOKClick(Sender: TObject);
const
  TX_NO_CODE  = 'An electronic signature code must be entered to sign orders.';
  TC_NO_CODE  = 'Electronic Signature Code Required';
  TX_BAD_CODE = 'The electronic signature code entered is not valid.';
  TC_BAD_CODE = 'Invalid Electronic Signature Code';
  TC_NO_DX   =  'Incomplete Diagnosis Entry';
  TX_NO_DX   = 'A Diagnosis must be selected prior to signing any of the following order types:'
                + CRLF + 'Lab, Radiology, Outpatient Medications, Prosthetics.';
begin
  inherited;

  if txtESCode.Visible and (Length(txtESCode.Text) = 0) then
  begin
    InfoBox(TX_NO_CODE, TC_NO_CODE, MB_OK);
    Exit;
  end;

  if txtESCode.Visible and not ValidESCode(txtESCode.Text) then
  begin
    InfoBox(TX_BAD_CODE, TC_BAD_CODE, MB_OK);
    txtESCode.SetFocus;
    txtESCode.SelectAll;
    Exit;
  end;

{Begin BillingAware}
  if  BILLING_AWARE then
  begin
    if SigItems.OK2SaveSettings then
   
      if Not UBACore.BADxEntered then   //  if Dx have been entered and OK is pressed
         begin                     // billing data will be saved. otherwise error message!
            InfoBox(TX_NO_DX, 'Sign Orders', MB_OK);
            Exit;
         end;
    end;
{End BillingAware}

  if not SigItems.OK2SaveSettings then
  begin
    InfoBox(TX_Order_Error, 'Sign Orders', MB_OK);
    Exit;
  end;

  if txtESCode.Visible then
     ESCode := Encrypt(txtESCode.Text) else ESCode := '';
     
  OKPressed := True;
  Close;
end;

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

procedure TfrmSignOrders.FormDestroy(Sender: TObject);
begin
  inherited;
  Application.HintPause := FOldHintPause;
  Application.HintHidePause := FOldHintHidePause;
  Crypto := nil;  //PKI object destroy
end;

procedure TfrmSignOrders.clstOrdersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
{Begin BillingAware}
  str: String;
  tempID: string;
  thisRec: UBAGlobals.TBADxRecord;
 {End BillingAware}

  X: string;
  ARect: TRect;
begin
  inherited;
  X := '';
  ARect := Rect;

{Begin BillingAware}
  if  BILLING_AWARE then
  begin
     with clstOrders do
     begin
       if Index < Items.Count then
       begin
          Canvas.FillRect(ARect);
          Canvas.Pen.Color := Get508CompliantColor(clSilver);
          Canvas.MoveTo(ARect.Left, ARect.Bottom);
          Canvas.LineTo(ARect.Right, ARect.Bottom);
          x := FilteredString(Items[Index]);
          ARect.Right := ARect.Right - 50;    //50 to 40
          //Vertical column line
          Canvas.MoveTo(ARect.Right, Rect.Top);
          Canvas.LineTo(ARect.Right, Rect.Bottom);
          //Adjust position of 'Diagnosis' column label for font size
          laDiagnosis.Left := ARect.Right + 14;
          if uSignItems.GetAllBtnLeftPos > 0 then
             laDiagnosis.left := uSignItems.GetAllBtnLeftPos - (laDiagnosis.Width +5);
              // ARect.Right below controls the right-hand side of the Dx Column
              // Adjust ARect.Right in conjunction with procedure uSignItems.TSigItems.lbDrawItem(), because the
              // two rectangles overlap each other.
           if  BILLING_AWARE then
           begin
              arRect[Index] := Classes.Rect(ARect.Right+2, ARect.Top, ARect.Right + 108, ARect.Bottom);
              Canvas.FillRect(arRect[Index]);
           end;

              //Win32 API - This call to DrawText draws the text of the ORDER - not the diagnosis code
               DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
       if  BILLING_AWARE then
         begin
             if Assigned(UBAGlobals.tempDxList) then
                begin
                   tempID := TOrder(clstOrders.Items.Objects[Index]).ID;

                if UBAGlobals.tempDxNodeExists(tempID) then
                    begin
                       thisRec := TBADxRecord.Create;
                       UBAGlobals.GetBADxListForOrder(thisRec, tempID);
                       str := Piece(thisRec.FBADxCode,'^',1);
                       {v25 BA}
                       str := Piece(str,':',1);
                       DrawText(Canvas.handle, PChar(str), Length(str), arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
                       if Not UBACore.IsOrderBillable(tempID) then
                       begin
                            Canvas.Font.Color := clBlue;
                            DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE), {Length(str),} arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
                       end;
                    end
                 else
                    begin
                      //   determine if order is billable, if NOT then insert NA in Dx field
                     if Not UBACore.IsOrderBillable(tempID) then
                        begin
                            Canvas.Font.Color := clBlue;
                            DrawText(Canvas.handle, PChar(NOT_APPLICABLE), Length(NOT_APPLICABLE), {Length(str),} arRect[Index], DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
                        end;
                    end;
                end;
            end;
  
        end;
       end;
  end
  else
     begin
        X := '';
        ARect := Rect;
        with clstOrders do
           begin
             if Index < Items.Count then
                begin
                  Canvas.FillRect(ARect);
                  Canvas.Pen.Color := Get508CompliantColor(clSilver);
                  Canvas.MoveTo(ARect.Left, ARect.Bottom - 1);
                  Canvas.LineTo(ARect.Right, ARect.Bottom - 1);
                  X := FilteredString(Items[Index]);
                  DrawText(Canvas.handle, PChar(x), Length(x), ARect, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
                end;
           end;
     end;
{End BillingAware}
end;

procedure TfrmSignOrders.clstOrdersMeasureItem(Control: TWinControl;
  Index: Integer; var AHeight: Integer);
var
  X: string;
  ARect: TRect;
begin
  inherited;
  AHeight := SigItemHeight;
  with clstOrders do if Index < Items.Count then
  begin
    ARect := ItemRect(Index);
    Canvas.FillRect(ARect);
    x := FilteredString(Items[Index]);
    AHeight := WrappedTextHeightByFont(Canvas, Font, x, ARect);
    if AHeight > 255 then AHeight := 255;
    //-------------------
    {Bug fix-HDS00001627}
    //if AHeight <  13 then AHeight := 13; {ORIG}
    if AHeight <  13 then AHeight := 15;
    //-------------------
  end;
end;

procedure TfrmSignOrders.clstOrdersClickCheck(Sender: TObject);

   procedure updateAllChilds(CheckedStatus: boolean; ParentOrderId: string);
   var
     idx: integer;
   begin
     for idx := 0 to clstOrders.Items.Count - 1 do
        if TOrder(clstOrders.Items.Objects[idx]).ParentID = ParentOrderId then
        begin
           if clstOrders.Checked[idx] <> CheckedStatus then
           begin
              clstOrders.Checked[idx] := CheckedStatus;
              SigItems.EnableSettings(idx, clstOrders.checked[Idx]);
           end;
        end;
   end;

begin
  with clstOrders do
  begin
    if Length(TOrder(Items.Objects[ItemIndex]).ParentID)>0 then
    begin
      SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
      updateAllChilds(checked[ItemIndex],TOrder(Items.Objects[ItemIndex]).ParentID);
    end else
      SigItems.EnableSettings(ItemIndex, checked[ItemIndex]);
  end;
  if ItemsAreChecked then
  begin
     lblESCode.Visible := IsSignatureRequired;
     txtESCode.Visible := IsSignatureRequired
  end
  else
  begin
    lblESCode.Visible := ItemsAreChecked;
    txtESCode.Visible := ItemsAreChecked;
  end;
end;

function TfrmSignOrders.ItemsAreChecked: Boolean;
{ return true if any items in the Review List are checked for applying signature }
var
  i: Integer;
begin
  Result := False;

  with clstOrders do
     for i := 0 to Items.Count - 1 do
        if Checked[i] then
           begin
             Result := True;
             break;
           end;
end;

procedure TfrmSignOrders.clstOrdersMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  Itm: integer;
{Begin BillingAware}
  thisRec: UBAGlobals.TBADxRecord;
  i: smallint;
  thisOrderID: string;
{End BillingAware}
begin
  inherited;
  Itm := clstOrders.ItemAtPos(Point(X, Y), TRUE);
  if (Itm >= 0) then
  begin
    if (Itm <> FLastHintItem) then
    begin
      Application.CancelHint;
   {Begin BillingAware}
    if  BILLING_AWARE then
    begin
       //Billing Awareness 'flyover' hint includes Dx code(s) when Dx code(s) have been assigned to an order
           thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[Itm]).ID;

           if UBAGlobals.tempDxNodeExists(thisOrderID) then
                 begin
                 if Assigned(tempDxList) then
                 try
                      for i := 0 to (tempDxList.Count - 1) do
                         begin
                           thisRec := TBADxRecord(tempDxList.Items[i]);

                          if Assigned(thisRec) then
                            if (thisRec.FOrderID = thisOrderID) then
                                begin
                                with thisRec do
                                   begin
                                      FBADxCode := StringReplace(thisrec.FBADxCode,'^',':',[rfReplaceAll]);
                                      FBASecDx1 := StringReplace(thisrec.FBASecDx1,'^',':',[rfReplaceAll]);
                                      FBASecDx2 := StringReplace(thisrec.FBASecDx2,'^',':',[rfReplaceAll]);;
                                      FBASecDx3 := StringReplace(thisrec.FBASecDx3,'^',':',[rfReplaceAll]);
                                   end;

                                clstOrders.Hint := TrimRight(clstOrders.Items[Itm] + #13 +
                                                             thisRec.FBADxCode + #13 + thisRec.FBASecDx1 + #13 + thisRec.FBASecDx2 + #13 + thisRec.FBASecDx3);
                                end
                          end
                 except
                    on EListError do
                       begin
                       {$ifdef debug}Show508Message('EListError in frmSignOrders.clstOrdersMouseMove()');{$endif}
                       raise;
                       end;
                 end;

                 end
           else
               clstOrders.Hint := TrimRight(clstOrders.Items[Itm]);
  end;
  {End BillingAware}
    FLastHintItem := Itm;
    Application.ActivateHint(Point(X, Y));
   end;
  end
  else
  begin
    clstOrders.Hint := '';
    FLastHintItem := -1;
    Application.CancelHint;
  end;
end;

procedure TfrmSignOrders.FormShow(Sender: TObject);
begin
{Begin BillingAware}

  if (clstOrders.Top + clstOrders.Height) > (lblESCode.Top - 4) then
      clstOrders.Height := lblESCode.Top - clstOrders.Top - 4;

  //INITIALIZATIONS
  Paste1.Enabled := false;
  fOrdersSign.srcOrderID := '';
  fOrdersSign.srcDx := '';
  if txtESCode.Visible then
     frmSignOrders.txtESCode.SetFocus;

    if  BILLING_AWARE then
       begin
         //List to contain loading OrderID's
        if not Assigned(UBAGlobals.OrderIDList) then
           UBAGlobals.OrderIDList := TStringList.Create;

        if  BILLING_AWARE then
           clstOrders.Multiselect := true;

         with fraCoPay do
           begin
            lblSC2.Caption := 'Service &Connected Condition';
            lblCV2.Caption := 'Combat &Vet (Combat Related)';
            lblAO2.Caption := 'Agent &Orange Exposure';
            lblIR2.Caption := 'Ionizing &Radiation Exposure';
            lblSWAC2.Caption := '&Environmental Contaminants';
            lblMST2.Caption := '&MST';
            lblHNC2.Caption := '&Head and/or Neck Cancer';
            lblSHAD2.Caption := 'Shi&pboard Hazard and Defense';
            lblSC2.ShowAccelChar := true;
            lblCV2.ShowAccelChar := true;
            lblAO2.ShowAccelChar := true;
            lblIR2.ShowAccelChar := true;
            lblSWAC2.ShowAccelChar := true;
            lblMST2.ShowAccelChar := true;
            lblHNC2.ShowAccelChar := true;
            lblSHAD2.ShowAccelChar := true;
           end;
        end;  //BILLING_AWARE

  clstOrders.TabOrder := 0; //CQ5057
  FormatListForScreenReader;

  //CQ5172
  if clstOrders.Count = 1 then
  begin
     clstOrders.Selected[0] := true;
     buOrdersDiagnosis.Enabled := True;
     Diagnosis1.Enabled := True;
     // if number of orders is 1 and order is billable select order and disable diagnosis button
     if NOT UBACore.IsOrderBillable(TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[0]).ID) then
     begin
        buOrdersDiagnosis.Enabled := False;
        Diagnosis1.Enabled := False;
        clstOrders.Selected[0] := False;
     end
     else
        if Piece(TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[0]).ID,';',2) = DISCONTINUED_ORDER then
        begin
           buOrdersDiagnosis.Enabled := False;
           Diagnosis1.Enabled := False;
        end;
  end;
 //end CQ5172
end;

 {Begin BillingAware}
 //   New BA Button....
procedure TfrmSignOrders.buOrdersDiagnosisClick(Sender: TObject);
var
  i: smallint;
  thisOrderID: string;
  match: boolean;
  allBlank: boolean;
  numSelected: smallint;
begin
{Begin BillingAware}

  match := false;
  allBlank := false;
  if Assigned (orderIDList) then orderIDList.Clear;
  if Assigned(UBAGlobals.PLFactorsIndexes) then UBAGlobals.PLFactorsIndexes.Clear;
  if Assigned (BAtmpOrderList) then BAtmpOrderList.Clear;

   try
     // User has selected no orders to sign
        for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
           begin
            if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
               begin
               thisOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;
               orderIDList.Add(thisOrderID);
               {BAV25 Code}
               BAtmpOrderList.Add(TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).TEXT);
               // stringlist holding index and stsFactors
               UBAGlobals.PLFactorsIndexes.Add(IntToStr(i)+ U + GetCheckBoxStatus(thisOrderID) );  // store indexes and flags of selected orders
               {BAV25 Code}
               // Test for blank Dx on current grid item
                if not (tempDxNodeExists(thisOrderID)) then
                   if Assigned(UBAGlobals.globalDxRec) then
                   InitializeNewDxRec(UBAGlobals.globalDxRec);
               if (tempDxNodeExists(thisOrderID)) then
               begin
                   // Create UBAGlobals.globalDxRec with loaded fields
                  if not Assigned(UBAGlobals.globalDxRec) then
                     begin
                        UBAGlobals.globalDxRec := UBAGlobals.TBADxRecord.Create;
                        InitializeNewDxRec(UBAGlobals.globalDxRec);
                        GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);
                     end
                 else
                    GetBADxListForOrder(UBAGlobals.globalDxRec, thisOrderID);

                 {$ifdef debug}
                 with UBAGlobals.globalDxRec do
                    //Show508Message('globalDxRec:'+#13+FOrderID+#13+FBADxCode+#13+FBASecDx1+#13+FBASecDx2+#13+FBASecDx3);
                 {$endif}
                  end;
           end; //if
        end; //for
     except
        on E: Exception  do
           ShowMsg(E.ClassName+' error raised, with message : '+E.Message);
   end;

  numSelected  := CountSelectedOrders(UBAConst.F_ORDERS_SIGN);
  
  if numSelected = 0 then
     begin
     ShowMsg(UBAMessages.BA_NO_ORDERS_SELECTED);
     Exit;
     end
  else
     if numSelected = 1 then
        match := true;

  if (UBAGlobals.CompareOrderDx(UBAConst.F_ORDERS_SIGN)) then
     match := true;


  if UBAGlobals.AllSelectedDxBlank(UBAConst.F_ORDERS_SIGN) then
     allBlank := true;

  if ((match and allBlank) or (match and (not allBlank))) then  // All selected are blank or matching-not-blank
        frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList)
   else
     begin
     //Warning message
     //If 'Yes' on warning message then open localDiagnosis
     if (not allBlank) then
         if MessageDlg(UBAMessages.BA_CONFIRM_DX_OVERWRITE, mtConfirmation, [mbYes, mbNo], 0) = mrNo then
              Exit
         else
              if Assigned(UBAGlobals.globalDxRec) then
                 InitializeNewDxRec(UBAGlobals.globalDxRec);
              frmBALocalDiagnoses.Enter(UBAConst.F_ORDERS_SIGN, orderIDList);
     end;
 // TFactors come from FBALocalDiagnoses(Problem List Dx's Only).
    if Length(UBAGlobals.TFactors) > 0 then
    begin
       UBACore.SetTreatmentFactors(UBAGlobals.TFactors);
       SigItems.DisplayPlTreatmentFactors;
    end;
 {End BillingAware}
 txtESCode.SetFocus;
end;

procedure TfrmSignOrders.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmSignOrders.Copy1Click(Sender: TObject);
{
   - Copy contents of the 'source' order for copy/paste operation
}
var
  i : byte;
  numSelected: byte;
  thisChangeItem: TChangeItem;
begin
   try
     if BILLING_AWARE then
        begin
        Paste1.Enabled := true;

         numSelected := GetNumberOfSelectedOrders;

         if numSelected > 1 then
           begin
           ShowMsg('Only 1 order at a time may be selected for ''Copying''');
           Exit;
           end;

         for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Items.Count-1 do
             if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
               begin
               thisChangeItem := TChangeItem.Create;
               thisChangeItem := nil;
               thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);
               //Skip this one if it's a "header" on the grid
                 if (thisChangeItem = nil) then //or (thisChangeItem.ItemType <> CH_ORD)) then
                    begin
                    FreeAndNil(thisChangeItem);
                    Exit;
                    end;

               fOrdersSign.srcOrderID := TChangeItem(frmSignOrders.clstOrders.Items.Objects[i]).ID;

               //Copy source order to COPY BUFFER and add it to the Dx List
               CopyBuffer := TBADxRecord.Create;
               InitializeNewDxRec(CopyBuffer);
               GetBADxListForOrder(CopyBuffer, fOrdersSign.srcOrderID);
               fOrdersSign.CopyBuffer.FOrderID := BUFFER_ORDER_ID;
               UBAGlobals.tempDxList.Add(CopyBuffer);

               //*************************************************************************
               if (NOT UBACore.IsOrderBillable(fOrdersSign.srcOrderID) ) then //and
               // added to allow copy to NON CIDC consult order the requires a DX. then
                 begin
                   ShowMsg(BA_NA_COPY_DISALLOWED);
                   fOrdersSign.srcOrderID := '';
                   Exit;
                 end;
               //*************************************************************************

               fOrdersSign.srcIndex := clstOrders.ItemIndex;
               fOrdersSign.chkBoxStatus := GetCheckBoxStatus(fOrdersSign.srcOrderID);
               Break;
               end;
         end; //if BILLING_AWARE
   except
     on EListError do
        begin
          ShowMsg('EListError in frmSignOrders.Copy1Click()');
        raise;
        end;
   end;
end;

procedure TfrmSignOrders.Paste1Click(Sender: TObject);
{
 - Populate 'target' orders of a copy/paste operation with contents of 'source' order
}  
var
  i: byte;
  newRec: TBADxRecord;
begin
  if BILLING_AWARE then
     begin
      if not Assigned(fOrdersSign.CopyBuffer) then //CQ5414
        fOrdersSign.CopyBuffer := TBADxRecord.Create; //CQ5414

     try
         for i := 0 to clstOrders.Count - 1 do
               begin
               if (fOrdersSign.frmSignOrders.clstOrders.Selected[i]) then
                 begin
                   fOrdersSign.targetOrderID := TChangeItem(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).ID;

                  if fOrdersSign.targetOrderID = fOrdersSign.srcOrderID then //disallow copying an order to itself
                     Continue
                  else
                     begin
                       fOrdersSign.CopyBuffer.FOrderID := BUFFER_ORDER_ID;

                     //***************************************************************
                     if Not UBACore.IsOrderBillable(targetOrderID) then
                       begin
                         ShowMsg(BA_NA_PASTE_DISALLOWED);
                         fOrdersSign.targetOrderID := '';
                         Continue;
                       end;
                     //***************************************************************

                     newRec := TBADxRecord.Create;
                     with newRec do
                       begin
                         FOrderID :=  fOrdersSign.targetOrderID;
                         FBADxCode := CopyBuffer.FBADxCode;
                         FBASecDx1 := CopyBuffer.FBASecDx1;
                         FBASecDx2 := CopyBuffer.FBASecDx2;
                         FBASecDx3 := CopyBuffer.FBASecDx3;
                       end;

                    tempDxList.Add(newRec);

                    CopyTFCIToTargetOrder( fOrdersSign.targetOrderID, fOrdersSign.chkBoxStatus);
                    SetCheckBoxStatus( fOrdersSign.targetOrderID);  //calls uSignItems.SetSigItems()
                  end;
                 end;
               end;
     except
        on EListError do
           begin
             ShowMsg('EListError in frmSignOrders.Paste1Click()'+#13+'for i := 0 to clstOrders.Count - 1 do');
           raise;
           end;
     end;
         clstOrders.Refresh; //Update grid to show pasted Dx
     end;
end;

procedure TfrmSignOrders.clstOrdersMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{
 - Open copy/paste popup menu.
}
var
  ClientPoint: TPoint;
  ScreenPoint: TPoint;
begin
  if not BILLING_AWARE then clstOrders.PopupMenu := nil;
  
  if BILLING_AWARE then
     begin
     try
        if Button = mbRight then  //Right-click to open copy/paste popup menu
           begin
           //CQ3325
           if fOrdersSign.frmSignOrders.clstOrders.Items.Count = 1 then
              begin
                Copy1.Enabled := false;
                Paste1.Enabled := false
              end
           else
              begin
                Copy1.Enabled := true;
              end;
           //End CQ3325

           if not frmSignOrders.clstOrders.Selected[clstOrders.ItemIndex] then
              (Sender as TCheckListBox).Selected[clstOrders.ItemIndex] := true;

           ClientPoint.X := X;
           ClientPoint.Y := Y;
           ScreenPoint := clstOrders.ClientToScreen(ClientPoint);
           poBACopyPaste.Popup(ScreenPoint.X, ScreenPoint.Y);
           end;
     except
        on EListError do
           begin
             ShowMsg('EListError in frmSignOrders.clstOrdersMouseDown()');
           raise;
           end;
     end;
     end;
end;


procedure TfrmSignOrders.clstOrdersClick(Sender: TObject);
//If grid item is an order-able item, then enable the Diagnosis button
// else disable the Diagnosis button.
var
  thisChangeItem: TChangeItem;
  i: smallint;
  thisOrderList: TStringList;
begin
  thisOrderList := TStringList.Create;

 {Begin BillingAware}
 if  BILLING_AWARE then
 begin

 if clstOrders.Items.Count > 1 then
        copy1.Enabled := True
     else
        copy1.Enabled := False;

     for i := 0 to clstOrders.Items.Count - 1 do
        begin
           if clstOrders.Selected[i] then
              begin
                thisChangeItem := TChangeItem(clstOrders.Items.Objects[i]);

                //Disallow copying of a grid HEADER item on LEFT MOUSE CLICK
              if thisChangeItem = nil then
                 begin
                   Copy1.Enabled := false;
                   buOrdersDiagnosis.Enabled := false;
                   Exit;
                 end;

              if (thisChangeItem <> nil) then //Blank row - not an order item
                 begin
                   thisOrderList.Clear;
                   thisOrderList.Add(thisChangeItem.ID);

                   if IsAllOrdersNA(thisOrderList) then
                   begin
                     Diagnosis1.Enabled := false;
                     buOrdersDiagnosis.Enabled := false;
                  end
                 else
                 begin
                    Diagnosis1.Enabled := true;
                    buOrdersDiagnosis.Enabled := true;
                 end
              end
              else
              begin
                 buOrdersDiagnosis.Enabled := false;
                 Diagnosis1.Enabled := False;
                 Break;
              end;
           end;
        end;

  if Assigned(thisOrderList) then thisOrderList.Free;
  end;        
end;

procedure TfrmSignOrders.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  j: integer; //CQ5054
begin
  inherited;
  if FOSTFHintWndActive then
  begin
    FOSTFhintWindow.ReleaseHandle ;
    FOSTFHintWndActive := False ;
  end;

  case Key of
     67,99:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSC,fraCoPay.lblSC2); //C,c
     86,118: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorCV,fraCoPay.lblCV2); //V,v
     79,111: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorAO,fraCoPay.lblAO2); //O,o
     82,114: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorIR,fraCoPay.lblIR2); //R,r
     65,97:  if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorEC,fraCoPay.lblSWAC2); //A,a
     77,109: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorMST,fraCoPay.lblMST2); //M,m
     78,110: if (ssAlt in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorHNC,fraCoPay.lblHNC2); //N,n
     72,104: if (ssALT in Shift) then ShowTreatmentFactorHints(BAFactorsRec.FBAFactorSHAD,fraCopay.lblSHAD2); // H,h
     //CQ5054
     83,115: if (ssAlt in Shift) then
          begin
            for j := 0 to clstOrders.Items.Count-1 do
                clstOrders.Selected[j] := false;
            clstOrders.Selected[0] := true;
            clstOrders.SetFocus;
          end;
     //end CQ5054
  end;
end;

//BILLING AWARE Procedure
procedure TfrmSignOrders.ShowTreatmentFactorHints(var pHintText: string; var pCompName: TVA508StaticText); // 508
var
 HRect: TRect;
 thisRect: TRect;
 x,y: integer;

begin
  try
     if FOSTFhintWndActive then
        begin
          FOSTFhintWindow.ReleaseHandle;
          FOSTFhintWndActive := False;
        end;
  except
     on E: Exception do
        begin
        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
        raise;
        end;
  end;

  try
      FOSTFhintWindow := THintWindow.Create(frmSignOrders);
      FOSTFhintWindow.Color := clInfoBk;
      GetWindowRect(pCompName.Handle,thisRect);
      x := thisRect.Left;
      y := thisRect.Top;
      hrect := FOSTFhintWindow.CalcHintRect(Screen.Width, pHintText,nil);
      hrect.Left   := hrect.Left + X;
      hrect.Right  := hrect.Right + X;
      hrect.Top    := hrect.Top + Y;
      hrect.Bottom := hrect.Bottom + Y;

      fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive);

      FOSTFhintWindow.ActivateHint(hrect, pHintText);
      FOSTFHintWndActive := True;
  except
     on E: Exception do
        begin
        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.ShowTreatmentFactorHints()');{$endif}
        raise;
        end;
  end;
end;

procedure TfrmSignOrders.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
   try
      if FOSTFhintWndActive then
      begin
         FOSTFhintWindow.ReleaseHandle;
         FOSTFHintWndActive := False;
         Application.ProcessMessages;
      end;
  except
     on E: Exception do
        begin
        {$ifdef debug}Show508Message('Unhandled exception in procedure TfrmSignOrders.FormMouseMove()');{$endif}
        raise;
        end;
  end;
end;

procedure TfrmSignOrders.FormResize(Sender: TObject);
begin
  inherited;
  clstOrders.invalidate;
end;

procedure TfrmSignOrders.fraCoPaylblHNCMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  fraCoPay.LabelCaptionsOn(not FOSTFHintWndActive)
end;

procedure TfrmSignOrders.fraCoPayLabel23Enter(Sender: TObject);
begin
    (Sender as TVA508StaticText).Font.Style := [fsBold];
end;

procedure TfrmSignOrders.fraCoPayLabel23Exit(Sender: TObject);
begin
    (Sender as TVA508StaticText).Font.Style := [];
end;

procedure TfrmSignOrders.SetItemTextToState;
var
  i : integer;
begin
  //The with statement below would cause access violations on other Delphi machines.
  {  with clstOrders do
    begin }
  //Must use fully qualifying path includeing the unit... very wierd!

  if fOrdersSign.frmSignOrders.clstOrders.Count < 1 then Exit;
  for i := 0 to fOrdersSign.frmSignOrders.clstOrders.Count-1 do
    if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] <> nil then //Not a Group Title
    begin
      if fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i] is TOrder then
      if fOrdersSign.frmSignOrders.clstOrders.Checked[i] then
        fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text
      else
        fOrdersSign.frmSignOrders.clstOrders.Items[i] := 'Not Checked '+TOrder(fOrdersSign.frmSignOrders.clstOrders.Items.Objects[i]).Text;
    end;
  if fOrdersSign.frmSignOrders.clstOrders.ItemIndex >= 0 then
    fOrdersSign.frmSignOrders.clstOrders.Selected[fOrdersSign.frmSignOrders.clstOrders.ItemIndex] := True;
//    end;
end;

procedure TfrmSignOrders.clstOrdersKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Space) then
    FormatListForScreenReader
end;

procedure TfrmSignOrders.FormatListForScreenReader;
begin
  if ScreenReaderActive then
    SetItemTextToState;
end;

end.