source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fDiagnoses.pas@ 1681

//kt -- Modified with SourceScanner on 8/17/2007
unit fDiagnoses;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fPCEBase, StdCtrls, CheckLst, ORCtrls, ORNet, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
  ComCtrls, fPCEBaseMain, UBAGlobals, UBAConst, UCore, DKLang;

type
  TfrmDiagnoses = class(TfrmPCEBaseMain)
    cmdDiagPrimary: TButton;
    ckbDiagProb: TCheckBox;
    lblAdd2PL: TLabel;
    procedure cmdDiagPrimaryClick(Sender: TObject);
    procedure ckbDiagProbClicked(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure FormResize(Sender: TObject); override;
    procedure lbxSectionClickCheck(Sender: TObject; Index: Integer);
    procedure btnOKClick(Sender: TObject);  override;
    procedure lbSectionClick(Sender: TObject);
    procedure GetEncounterDiagnoses;
    procedure lbSectionDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    procedure EnsurePrimaryDiag;
  protected
    procedure UpdateNewItemStr(var x: string); override;
    procedure UpdateControls; override;
  public
  end;

//const
//TX_INACTIVE_CODE = 'The "#" character next to the code for this problem indicates that the problem' + #13#10 +  <-- original line.  //kt 8/17/2007
//                   'references an ICD code that is not active as of the date of this encounter.' + #13#10 +  <-- original line.  //kt 8/17/2007
//                   'Before you can select this problem, you must update the ICD code it contains' + #13#10 +  <-- original line.  //kt 8/17/2007
//                   'via the Problems tab.';  <-- original line.  //kt 8/17/2007
//TC_INACTIVE_CODE = 'Problem Contains Inactive Code';  <-- original line.  //kt 8/17/2007

//kt Added functions to replace constant declarations 8/17/2007
function TX_INACTIVE_CODE :string; //kt
function TC_INACTIVE_CODE :string; //kt

var
  frmDiagnoses: TfrmDiagnoses;
  dxList : TStringList;

implementation

{$R *.DFM}

uses
  fEncounterFrame, uConst, UBACore;

//kt Added entire function to replace constant declarations 8/17/2007
function TX_INACTIVE_CODE : string;
begin
  Result := DKLangConstW('fDiagnoses_The_xxx_character_next_to_the_code_for_this_problem_indicates_that_the_problem') + #13#10 +
            DKLangConstW('fDiagnoses_references_an_ICD_code_that_is_not_active_as_of_the_date_of_this_encounterx') + #13#10 +
            DKLangConstW('fDiagnoses_Before_you_can_select_this_problemx_you_must_update_the_ICD_code_it_contains') + #13#10 +
            DKLangConstW('fDiagnoses_via_the_Problems_tabx');
end;

function TC_INACTIVE_CODE : string;
begin
  Result := DKLangConstW('fDiagnoses_Problem_Contains_Inactive_Code');
end;

procedure TfrmDiagnoses.EnsurePrimaryDiag;
var
  i: Integer;
  Primary: Boolean;

begin
  with lbGrid do
  begin
    Primary := False;
    for i := 0 to Items.Count - 1 do
      if TPCEDiag(Items.Objects[i]).Primary then
        Primary := True;

    if not Primary and (Items.Count > 0) then
    begin
      GridIndex := 0;
      TPCEDiag(Items.Objects[0]).Primary := True;
      GridChanged;
    end;
  end;
end;

procedure TfrmDiagnoses.cmdDiagPrimaryClick(Sender: TObject);
var
  gi, i: Integer;
  ADiagnosis: TPCEDiag;

begin
  inherited;
  gi := GridIndex;
  with lbGrid do for i := 0 to Items.Count - 1 do
  begin
    ADiagnosis := TPCEDiag(Items.Objects[i]);
    ADiagnosis.Primary := (gi = i);
  end;
  GridChanged;
end;

procedure TfrmDiagnoses.ckbDiagProbClicked(Sender: TObject);
var
  i: integer;
//const
//PL_ITEMS = 'Problem List Items';  <-- original line.  //kt 8/17/2007
var
  PL_ITEMS : string; //kt
begin
  PL_ITEMS := DKLangConstW('fDiagnoses_Problem_List_Items'); //kt added 8/17/2007
  inherited;
  if(NotUpdating) then
  begin
    for i := 0 to lbGrid.Items.Count-1 do
      if(lbGrid.Selected[i]) then
        TPCEDiag(lbGrid.Items.Objects[i]).AddProb := (ckbDiagProb.Checked) and
                                                     (TPCEDiag(lbGrid.Items.Objects[i]).Category <> PL_ITEMS);
    GridChanged;
  end;
end;

procedure TfrmDiagnoses.FormCreate(Sender: TObject);
begin
  inherited;
  FTabName := CT_DiagNm;
  FPCEListCodesProc := ListDiagnosisCodes;
  FPCEItemClass := TPCEDiag;
  FPCECode := 'POV';
  FSectionTabCount := 3;
  FormResize(Self);
end;

procedure TfrmDiagnoses.btnRemoveClick(Sender: TObject);
begin
  inherited;
  EnsurePrimaryDiag;
end;

procedure TfrmDiagnoses.UpdateNewItemStr(var x: string);
begin
  inherited;
  if lbGrid.Items.Count = 0 then
    x := x + U + '1'
  else
    x := x + U + '0';
end;

procedure TfrmDiagnoses.UpdateControls;
var
  i, j, k, PLItemCount: integer;
  OK: boolean;

//const
//PL_ITEMS = 'Problem List Items';  <-- original line.  //kt 8/17/2007

var
  PL_ITEMS : string; //kt

begin
  PL_ITEMS := DKLangConstW('fDiagnoses_Problem_List_Items'); //kt added 8/17/2007
  inherited;
  if(NotUpdating) then
  begin
    BeginUpdate;
    try
      cmdDiagPrimary.Enabled := (lbGrid.SelCount = 1);
      OK := (lbGrid.SelCount > 0);
      PLItemCount := 0;
      if OK then
        for k := 0 to lbGrid.Items.Count - 1 do
          if (lbGrid.Selected[k]) and (TPCEDiag(lbGrid.Items.Objects[k]).Category = PL_ITEMS) then
            PLItemCount := PLItemCount + 1;
      OK := OK and (PLItemCount < lbGrid.SelCount);
      lblAdd2PL.Enabled := OK;
      ckbDiagProb.Enabled := OK;
      if(OK) then
      begin
        j := 0;
        for i := 0 to lbGrid.Items.Count-1 do
        begin
          if(lbGrid.Selected[i]) and (TPCEDiag(lbGrid.Items.Objects[i]).AddProb) then
            inc(j);
        end;
        if(j = 0) then
          ckbDiagProb.Checked := FALSE
        else
        if(j < lbGrid.SelCount) then
          ckbDiagProb.State := cbGrayed
        else
          ckbDiagProb.Checked := TRUE;
      end
      else
        ckbDiagProb.Checked := FALSE;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TfrmDiagnoses.FormResize(Sender: TObject);
begin
  inherited;
  FSectionTabs[0] := -(lbxSection.width - LBCheckWidthSpace - (8*MainFontWidth) - ScrollBarWidth);
  FSectionTabs[1] := -FSectionTabs[0]+2;
  FSectionTabs[2] := -FSectionTabs[0]+4;
  UpdateTabPos;
end;

procedure TfrmDiagnoses.lbxSectionClickCheck(Sender: TObject;
  Index: Integer);
begin
  if not FUpdatingGrid then
    if (lbxSection.Checked[Index]) and (Piece(lbxSection.Items[Index], U, 5) = '#') then
      begin
        InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
        lbxSection.Checked[Index] := False;
        exit;
      end;
  inherited;
  EnsurePrimaryDiag;
end;

procedure TfrmDiagnoses.btnOKClick(Sender: TObject);
begin
  inherited;
  if  BILLING_AWARE then
     GetEncounterDiagnoses;
end;

procedure TfrmDiagnoses.lbSectionClick(Sender: TObject);
begin
  inherited;
//
end;

procedure TfrmDiagnoses.GetEncounterDiagnoses;
var
  i: integer;
  dxCode, dxName: string;
  ADiagnosis: TPCEItem;
begin
   inherited;
  UBAGlobals.BAPCEDiagList.Clear;
  with lbGrid do for i := 0 to Items.Count - 1 do
  begin
    ADiagnosis := TPCEDiag(Items.Objects[i]);
    dxCode :=  ADiagnosis.Code;
    dxName :=  ADiagnosis.Narrative;
    if BAPCEDiagList.Count = 0 then
       UBAGlobals.BAPCEDiagList.Add(U + DX_ENCOUNTER_LIST_TXT);
    UBAGlobals.BAPCEDiagList.Add(dxCode + U + dxName);
  end;
end;


procedure TfrmDiagnoses.lbSectionDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  inherited;
  if (control as TListbox).items[index] = DX_PROBLEM_LIST_TXT then
     (Control as TListBox).Canvas.Font.Style := [fsBold]
  else
     if (control as Tlistbox).items[index] = DX_PERSONAL_LIST_TXT then
        (Control as TListBox).Canvas.Font.Style := [fsBold]
  else
     if (control as Tlistbox).items[index] =  DX_TODAYS_DX_LIST_TXT  then
        (Control as TListBox).Canvas.Font.Style := [fsBold]
  else
     if (control as Tlistbox).items[index] = DX_ENCOUNTER_LIST_TXT then
        (Control as TListBox).Canvas.Font.Style := [fsBold]
  else
     (Control as TListBox).Canvas.Font.Style := [];

  (Control as TListBox).Canvas.TextOut(Rect.Left+2, Rect.Top+1, (Control as
              TListBox).Items[Index]); {display the text }
end;

end.