source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fSkinTest.pas@ 1156

//kt -- Modified with SourceScanner on 8/8/2007
unit fSkinTest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fPCEBase, ORCtrls, StdCtrls, ComCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
  fPCELex, fPCEOther, rCore, fPCEBaseMain, DKLang;

type
  TfrmSkinTests = class(TfrmPCEBaseMain)
    lblSkinResults: TLabel;
    lblDTRead: TLabel;
    lblReading: TLabel;
    lblDTGiven: TLabel;
    UpDnReading: TUpDown;
    EdtReading: TCaptionEdit;
    edtDtRead: TCaptionEdit;
    edtDTGiven: TCaptionEdit;
    cboSkinResults: TORComboBox;
    procedure cboSkinResultsChange(Sender: TObject);
    procedure EdtReadingChange(Sender: TObject);
    procedure edtDtReadChange(Sender: TObject);
    procedure edtDTGivenChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure UpDnReadingChanging(Sender: TObject;
      var AllowChange: Boolean);
  private
  protected
    procedure UpdateNewItemStr(var x: string); override;
    procedure UpdateControls; override;
  public
  end;

var
  frmSkinTests: TfrmSkinTests;

implementation

{$R *.DFM}

uses
  fEncounterFrame;

procedure TfrmSkinTests.cboSkinResultsChange(Sender: TObject);
var
  i: integer;

begin
  if(NotUpdating) and (cboSkinResults.Text <> '') then
  begin
    for i := 0 to lbGrid.Items.Count-1 do
      if(lbGrid.Selected[i]) then
        TPCESkin(lbGrid.Items.Objects[i]).Results := cboSkinResults.ItemID;
    GridChanged;
  end;
end;

{///////////////////////////////////////////////////////////////////////////////
//Name:procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description:Change the reading assigned to the skin test.
///////////////////////////////////////////////////////////////////////////////}
procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
var
  x, i: integer;

begin
  if(NotUpdating) then
  begin
    x := StrToIntDef(EdtReading.Text, 0);
    for i := 0 to lbGrid.Items.Count-1 do
      if(lbGrid.Selected[i]) then
        TPCESkin(lbGrid.Items.Objects[i]).Reading := x;
    GridChanged;
  end;
end;

procedure TfrmSkinTests.edtDtReadChange(Sender: TObject);
begin
end;
(*
var
  DtRead: TFMDateTime;
  ASkinTest: TPCESkin;
begin
  inherited;
  if lstSkinSelect.ItemIndex < 0 then Exit;

  with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
  DtRead := StrToFMDateTime(edtReading.text);
  with lstSkinSelect do if (ItemIndex > -1) then
  begin
    ASkinTest.DTRead := DTRead;
    Items[ItemIndex] := ASkinTest.ItemStr;
  end;
end;
*)

procedure TfrmSkinTests.edtDTGivenChange(Sender: TObject);
begin
end;
(*
var
  DtGiven: TFMDateTime;
  ASkinTest: TPCESkin;
begin
  inherited;
  if lstSkinSelect.ItemIndex < 0 then Exit;

  with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
  DtGiven := StrToFMDateTime(edtDTGiven.text);
  with lstSkinSelect do if (ItemIndex > -1) then
  begin
    ASkinTest.DTGiven := DTGIven;
    Items[ItemIndex] := ASkinTest.ItemStr;
  end;
end;
*)
(*
procedure TfrmSkinTests.CheckSkinRules;
begin
  //Results must be between 0 and 40
  if StrToInt(EdtReading.Text) < 0 then EdtReading.text := '0';
  if StrToInt(EdtReading.Text) > 40 then EdtReading.text := '40';

(*  //if reading >10, result must be "positive"
  if (StrToInt(EdtReading.Text) > 9) and
    (CompareText(Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1),'P') <> 0) then
    begin
      if (Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1) = '@') then    // not selected
      begin
        cboSkinResults.SelectById('P');
      end
      else
      begin
//      Showmessage('If the reading is over 9, the results are required to be positive.');  <-- original line.  //kt 8/8/2007
        Showmessage(DKLangConstW('fSkinTest_If_the_reading_is_over_9x_the_results_are_required_to_be_positivex')); //kt added 8/8/2007
        cboSkinResults.SelectById('P');
       end;
    end;
end;
*)

procedure TfrmSkinTests.FormCreate(Sender: TObject);
begin
  inherited;
  FTabName := CT_SkinNm;
  FPCEListCodesProc := ListSkinCodes;
  FPCEItemClass := TPCESkin;
  FPCECode := 'SK';
  PCELoadORCombo(cboSkinResults);
end;

procedure TfrmSkinTests.UpdateNewItemStr(var x: string);
begin
  SetPiece(x, U, pnumSkinResults, NoPCEValue);
  SetPiece(x, U, pnumSkinReading, '0');
//  SetPiece(x, U, pnumSkinDTRead);
//  SetPiece(x, U, pnumSkinDTGiven);
end;

procedure TfrmSkinTests.UpdateControls;
var
  ok, First: boolean;
  SameRes, SameRead: boolean;
  i: integer;
  Res: string;
  Read: integer;
  Obj: TPCESkin;

begin
  inherited;
  if(NotUpdating) then
  begin
    BeginUpdate;
    try
      ok := (lbGrid.SelCount > 0);
      lblSkinResults.Enabled := ok;
      lblReading.Enabled := ok;
      cboSkinResults.Enabled := ok;
      EdtReading.Enabled := ok;
      UpDnReading.Enabled := ok;
      if(ok) then
      begin
        First := TRUE;
        SameRes := TRUE;
        SameRead := TRUE;
        Res := NoPCEValue;
        Read := 0;
        for i := 0 to lbGrid.Items.Count-1 do
        begin
          if lbGrid.Selected[i] then
          begin
            Obj := TPCESkin(lbGrid.Items.Objects[i]);
            if(First) then
            begin
              First := FALSE;
              Res := Obj.Results;
              Read := Obj.Reading;
            end
            else
            begin
              if(SameRes) then
                SameRes := (Res = Obj.Results);
              if(SameRead) then
                SameRead := (Read = Obj.Reading);
            end;
          end;
        end;
        if(SameRes) then
          cboSkinResults.SelectByID(Res)
        else
          cboSkinResults.Text := '';
        if(SameRead) then
        begin
          UpDnReading.Position := Read;
          EdtReading.Text := IntToStr(Read);
          EdtReading.SelStart := length(EdtReading.Text);
        end
        else
        begin
          UpDnReading.Position := 0;
          EdtReading.Text := '';
        end;
      end
      else
      begin
        cboSkinResults.Text := '';
        EdtReading.Text := '';
      end;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TfrmSkinTests.UpDnReadingChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  inherited;
  if(UpDnReading.Position = 0) then
    EdtReadingChange(Sender);
end;

end.