source: cprs/branches/tmg-cprs/CPRS-Chart/fVisit.pas@ 830

//kt -- Modified with SourceScanner on 8/7/2007
unit fVisit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ORCtrls, ORDtTm, ORFn, StdCtrls, rCore, uCore, DKLang;

type
  TfrmVisit = class(TForm)
    pnlBase: TORAutoPanel;
    lblInstruct: TStaticText;
    radAppt: TRadioButton;
    radAdmit: TRadioButton;
    radNewVisit: TRadioButton;
    lstVisit: TORListBox;
    lblSelect: TLabel;
    pnlVisit: TORAutoPanel;
    cboLocation: TORComboBox;
    timVisitDate: TORDateBox;
    lblVisitDate: TLabel;
    cmdOK: TButton;
    cmdCancel: TButton;
    grpCategory: TGroupBox;
    ckbHistorical: TCheckBox;
    DKLanguageController1: TDKLanguageController;
    procedure radSelectorClick(Sender: TObject);
    procedure cboLocationNeedData(Sender: TObject; const StartFrom: string;
      Direction, InsertAt: Integer);
    procedure cmdCancelClick(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FChanged: Boolean;
    FDateTime: TFMDateTime;
    FLocation: Integer;
    FLocationName: string;
    FVisitCategory: Char;
    FStandAlone: Boolean;
  public
    { Public declarations }
  end;

(*
procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
procedure UpdateVisit(FontSize: Integer);
*)

implementation

{$R *.DFM}

uses
  rOptions;

const
  TAG_SEL_CLINIC = 1;
  TAG_SEL_ADMIT  = 2;
  TAG_SEL_NEW    = 3;

type
  TVisitUpdate = record
    Changed: Boolean;
    DateTime: TFMDateTime;
    Location: Integer;
    LocationName: string;
    VisitCategory: Char;
    StandAlone: Boolean;
  end;

(*
 
 
procedure TfrmVisit.SetupVars;
//kt Added entire function to replace constant declarations 8/7/2007
begin
end;
 
procedure UpdateVisit(FontSize: Integer);
{ displays visit selection form and directly updates the visit in Encounter }
var
  VisitUpdate: TVisitUpdate;
begin
  SelectVisit(FontSize, VisitUpdate);
  if VisitUpdate.Changed then
  begin
    Encounter.Location  := VisitUpdate.Location;
    Encounter.DateTime  := VisitUpdate.DateTime;
    Encounter.VisitCategory := VisitUpdate.VisitCategory;
    Encounter.StandAlone := VisitUpdate.StandAlone;
  end;
end;

procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
{ displays visit selection form and returns a record of the updated information }
var
  frmVisit: TfrmVisit;
  W, H: Integer;
begin
  frmVisit := TfrmVisit.Create(Application);
  try
    with frmVisit do
    begin
      Font.Size := FontSize;
      lblInstruct.Font.Size := FontSize;
      W := ClientWidth;
      H := ClientHeight;
      ResizeToFont(FontSize, W, H);
      ClientWidth  := W; pnlBase.Width  := W;
      ClientHeight := H; pnlBase.Height := W;
      frmVisit.ShowModal;
      with VisitUpdate do
      begin
        Changed := FChanged;
        DateTime := FDateTime;
        Location := FLocation;
        LocationName := FLocationName;
        VisitCategory := FVisitCategory;
        StandAlone := FStandAlone;
      end; {with VisitRec}
    end; {with frmVisit}
  finally
    frmVisit.Release;
  end;
end;
*)

procedure TfrmVisit.FormCreate(Sender: TObject);
{ initialize private fields and display appropriate visit selection controls }
begin
  FChanged := False;
  radSelectorClick(radAppt);
  if lstVisit.Items.Count = 0 then
  begin
    radNewVisit.Checked := True;
    radSelectorClick(radNewVisit);
  end;
end;

procedure TfrmVisit.radSelectorClick(Sender: TObject);
{ change visit data entry according to the radiobutton selected (appts, admissions, new visit }
var
  i: Integer;
  ADateFrom, ADateThru: TDateTime;
  BDateFrom, BDateThru: Integer;
begin
  if not TRadioButton(Sender).Checked then Exit;
  lstVisit.Clear;
  lblVisitDate.Hide;
  case TRadioButton(Sender).Tag of
    TAG_SEL_CLINIC: begin
//                    lblSelect.Caption := 'Clinic Appointments';  <-- original line.  //kt 8/7/2007
                      lblSelect.Caption := DKLangConstW('fVisit_Clinic_Appointments'); //kt added 8/7/2007
                      rpcGetRangeForEncs(BDateFrom, BDateThru, False); // Get user's current date range settings.
                      ADateFrom := (FMDateTimeToDateTime(FMToday) - BDateFrom);
                      ADateThru := (FMDateTimeToDateTime(FMToday) + BDateThru);
                      ADateFrom := DateTimeToFMDateTime(ADateFrom);
                      ADateThru:= DateTimeToFMDateTime(ADateThru) + 0.2359;
                      ListApptAll(lstVisit.Items, Patient.DFN, ADateFrom, ADateThru);
                      pnlVisit.Hide;
                      lstVisit.Show;
                    end;
    TAG_SEL_ADMIT:  begin
//                    lblSelect.Caption := 'Hospital Admissions';  <-- original line.  //kt 8/7/2007
                      lblSelect.Caption := DKLangConstW('fVisit_Hospital_Admissions'); //kt added 8/7/2007
                      ListAdmitAll(lstVisit.Items, Patient.DFN);
                      pnlVisit.Hide;
                      lstVisit.Show;
                    end;
    TAG_SEL_NEW:    begin
//                    lblSelect.Caption := 'Visit Location';  <-- original line.  //kt 8/7/2007
                      lblSelect.Caption := DKLangConstW('fVisit_Visit_Location'); //kt added 8/7/2007
                      with cboLocation do
                      begin
                        InitLongList(Encounter.LocationName);
                        for i := 0 to Items.Count - 1 do
                          if StrToIntDef(Piece(Items[i], U, 1),0) = Encounter.Location then
                          begin
                            ItemIndex := i;
                            break;
                          end;
                      end;
                      lstVisit.Hide;
                      lblVisitDate.Show;
                      pnlVisit.Show;
                    end;
  end;
  lstVisit.Caption := lblSelect.Caption;
end;

procedure TfrmVisit.cboLocationNeedData(Sender: TObject; const StartFrom: string;
  Direction, InsertAt: Integer);
{ callback for location combobox to list active locations }
begin
  //cboLocation.ForDataUse(SubSetOfLocations(StartFrom, Direction));
  cboLocation.ForDataUse(SubSetOfClinics(StartFrom, Direction));
end;

procedure TfrmVisit.cmdOKClick(Sender: TObject);
{ gather and validate visit information }
//const
//VST_CAPTION  = 'Unable to Select Visit';  <-- original line.  //kt 8/7/2007
//VST_LOCATION = 'A visit LOCATION has not been selected.';  <-- original line.  //kt 8/7/2007
//VST_DATETIME = 'A valid date/time has not been entered.';  <-- original line.  //kt 8/7/2007
//VST_NOTIME   = 'A valid time has not been entered.';  <-- original line.  //kt 8/7/2007
//VST_SELECT   = 'An appointment/hospitalization has not been entered';  <-- original line.  //kt 8/7/2007
var
  VST_CAPTION  : string; //kt
  VST_LOCATION : string; //kt
  VST_DATETIME : string; //kt
  VST_NOTIME   : string; //kt
  VST_SELECT   : string; //kt
begin
  VST_CAPTION  := DKLangConstW('fVisit_Unable_to_Select_Visit'); //kt added 8/7/2007
  VST_LOCATION := DKLangConstW('fVisit_A_visit_LOCATION_has_not_been_selectedx'); //kt added 8/7/2007
  VST_DATETIME := DKLangConstW('fVisit_A_valid_datextime_has_not_been_enteredx'); //kt added 8/7/2007
  VST_NOTIME   := DKLangConstW('fVisit_A_valid_time_has_not_been_enteredx'); //kt added 8/7/2007
  VST_SELECT   := DKLangConstW('fVisit_An_appointmentxhospitalization_has_not_been_entered'); //kt added 8/7/2007
  FStandAlone := False;
  if radNewVisit.Checked then
  begin
    if cboLocation.ItemIndex < 0 then
    begin
      InfoBox(VST_LOCATION, VST_CAPTION, MB_OK);
      Exit;
    end;
    FDateTime := StrToFMDateTime(timVisitDate.Text);
    if not (FDateTime > 0) then
    begin
      InfoBox(VST_DATETIME, VST_CAPTION, MB_OK);
      Exit;
    end;
    if(pos('.',FloatToStr(FDateTime))=0) then
    begin
      InfoBox(VST_NOTIME, VST_CAPTION, MB_OK);
      Exit;
    end;
    with cboLocation do
    begin
      FLocation := ItemIEN;
      FLocationName := DisplayText[ItemIndex];
    end;

    //Changed 12/30/97 ISL/RAB
    if ckbHistorical.state = cbchecked then FVisitCategory := 'E'
    else FVisitCategory := 'A';

    FChanged := True;

    //ISL/RAB  1/15/98  The following line has been changed so procedures will
    //         not be required for historical visits.
    if (FVisitCategory = 'A') then FStandAlone := True;
  end else
  begin
    if lstVisit.ItemIndex < 0 then
    begin
      InfoBox(VST_SELECT, VST_CAPTION, MB_OK);
      Exit;
    end;
    with lstVisit do
    begin
      FDateTime := MakeFMDateTime(ItemID);
      FLocation := StrToIntDef(Piece(Items[ItemIndex], U, 2), 0);
      FLocationName := Piece(Items[ItemIndex], U, 3);
      if(radAdmit.Checked) then
        FVisitCategory := 'H'
      else
        FVisitCategory := 'A';
      FChanged := True;
    end;
  end;
  Close;
end;

procedure TfrmVisit.cmdCancelClick(Sender: TObject);
{ cancel form - no change to visit information }
begin
  FChanged := False;
  Close;
end;

end.