source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fGAF.pas@ 1709

//kt -- Modified with SourceScanner on 8/25/2007
unit fGAF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fPCEBase, StdCtrls, Buttons, ExtCtrls, Grids, ORFn, ORNet, ORCtrls,
  ORDtTm, ComCtrls, fPCEBaseGrid, Menus, DKLang;

type
  TfrmGAF = class(TfrmPCEBaseGrid)
    lblGAF: TStaticText;
    edtScore: TCaptionEdit;
    udScore: TUpDown;
    dteGAF: TORDateBox;
    lblEntry: TStaticText;
    lblScore: TLabel;
    lblDate: TLabel;
    lblDeterminedBy: TLabel;
    cboGAFProvider: TORComboBox;
    btnURL: TButton;
    Spacer1: TLabel;
    Spacer2: TLabel;
    procedure cboGAFProviderNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure edtScoreChange(Sender: TObject);
    procedure dteGAFExit(Sender: TObject);
    procedure cboGAFProviderExit(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnURLClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FDataLoaded: boolean;
    procedure LoadScores;
    function BADData(ShowMessage: boolean): boolean;
  public
    procedure AllowTabChange(var AllowChange: boolean); override;
    procedure GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64);
  end;

function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean;

var
  frmGAF: TfrmGAF;

implementation

uses rPCE, rCore, uCore, uPCE, fEncounterFrame;

{$R *.DFM}

function ValidGAFData(Score: integer; Date: TFMDateTime; Staff: Int64): boolean;
begin
  if(Score < 1) or (Score > 100) or (Date <= 0) or (Staff = 0) then
    Result := FALSE
  else
    Result := ((Patient.DateDied <= 0) or (Date <= Patient.DateDied));
end;

procedure TfrmGAF.LoadScores;
var
  i: integer;
  tmp: string;

begin
  RecentGafScores(3);
  if(RPCBrokerV.Results.Count > 0) and (RPCBrokerV.Results[0] = '[DATA]') then
  begin
    for i := 1 to RPCBrokerV.Results.Count-1 do
    begin
      tmp := RPCBrokerV.Results[i];
      lbGrid.Items.Add(Piece(tmp,U,5) + U + Piece(Piece(tmp,U,2),NoPCEValue,1) + U +
                                Piece(tmp,U,7) + U + Piece(tmp,U,8));
    end;
  end;
  if(lbGrid.Items.Count > 0) then
    SyncGridData
  else
//  lbGrid.Items.Add('No GAF scores found.');  <-- original line.  //kt 8/25/2007
    lbGrid.Items.Add(DKLangConstW('fGAF_No_GAF_scores_foundx')); //kt added 8/25/2007
end;

procedure TfrmGAF.cboGAFProviderNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
  inherited;
  cboGAFProvider.ForDataUse(SubSetOfPersons(StartFrom, Direction));
end;

function TfrmGAF.BADData(ShowMessage: boolean): boolean;
var
  PName, msg: string;
  GAFDate: TFMDateTime;
  UIEN: Int64;

begin
  GAFDate := dteGAF.FMDateTime;
  msg := ValidateGAFDate(GAFDate);
  if(dteGAF.FMDateTime <> GAFDate) then
    dteGAF.FMDateTime := GAFDate;

  if(cboGAFProvider.ItemID = '') then
  begin
    if(msg <> '') then
      msg := msg + CRLF;
//  msg := msg + 'A determining party is required to enter a GAF score.';  <-- original line.  //kt 8/25/2007
    msg := msg + DKLangConstW('fGAF_A_determining_party_is_required_to_enter_a_GAF_scorex'); //kt added 8/25/2007
    UIEN := uProviders.PCEProvider;
    if(UIEN <> 0) then
    begin
      PName := uProviders.PCEProviderName;
//    msg := msg + '  Determined By changed to ' + PName + '.';  <-- original line.  //kt 8/25/2007
      msg := msg + DKLangConstW('fGAF_Determined_By_changed_to') + PName + '.'; //kt added 8/25/2007
      cboGAFProvider.SelectByIEN(UIEN);
      if(cboGAFProvider.ItemID = '') then
      begin
        cboGAFProvider.InitLongList(PName);
        cboGAFProvider.SelectByIEN(UIEN);
      end;
    end;
  end;

  if(ShowMessage and (msg <> '')) then
//  InfoBox(msg, 'Invalid GAF Data', MB_OK);  <-- original line.  //kt 8/25/2007
    InfoBox(msg, DKLangConstW('fGAF_Invalid_GAF_Data'), MB_OK); //kt added 8/25/2007

  if(udScore.Position > udScore.Min) then
    Result := (msg <> '')
  else
    Result := FALSE;
end;

procedure TfrmGAF.edtScoreChange(Sender: TObject);
var
  i: integer;

begin
  inherited;
  i := StrToIntDef(edtScore.Text,udScore.Min);
  if(i < udScore.Min) or (i > udScore.Max) then
    i := udScore.Min;
  udScore.Position := i;
  edtScore.Text := IntToStr(i);
  edtScore.SelStart := length(edtScore.Text);
end;

procedure TfrmGAF.dteGAFExit(Sender: TObject);
begin
  inherited;
//  BadData(TRUE);
end;

procedure TfrmGAF.cboGAFProviderExit(Sender: TObject);
begin
  inherited;
  BadData(TRUE);
end;

procedure TfrmGAF.AllowTabChange(var AllowChange: boolean);
begin
  AllowChange := (not BadData(TRUE));
end;

procedure TfrmGAF.GetGAFScore(var Score: integer; var Date: TFMDateTime; var Staff: Int64);
begin
  Score := udScore.Position;
  if(Score > 0) then BadData(TRUE);
  Date := dteGAF.FMDateTime;
  Staff := cboGAFProvider.ItemIEN;
  if(not ValidGAFData(Score, Date, Staff)) then
  begin
    Score := 0;
    Date := 0;
    Staff := 0
  end;
end;

procedure TfrmGAF.FormActivate(Sender: TObject);
begin
  inherited;
  if(not FDataLoaded) then
  begin
    FDataLoaded := TRUE;
    LoadScores;
    cboGAFProvider.InitLongList(Encounter.ProviderName);
    BadData(FALSE);
  end;
end;

procedure TfrmGAF.FormShow(Sender: TObject);
begin
  inherited;
  FormActivate(Sender);
end;

procedure TfrmGAF.btnURLClick(Sender: TObject);
begin
  inherited;
  GotoWebPage(GAFURL);
end;

procedure TfrmGAF.FormCreate(Sender: TObject);
begin
  inherited;
  FTabName := CT_GAFNm;
  btnURL.Visible := (User.WebAccess and (GAFURL <> ''));
end;

end.