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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fPCEBase, ORDtTm, StdCtrls, ORCtrls, ExtCtrls, Buttons, fAutoSz, ORFn,
  rvitals, ComCtrls, ORNet, uVitals
  , TRPCB, DKLang // Vitals Lite 2004-05-21 ===========================================
  ;
{== Vitals Lite 2004-05-21 ===================================================}
type
  TGMV_GetInputPanel = function(
    var anApp: TApplication;
    aB: TRPCBroker;
    aP,         // Patient DFN
    aL,         // Hospitals IEN
    aSig,       // Application signature
    aTemplate   // Vitals Input template
        : String;
    aNow        // Input Date/Time
        :TDateTime):TCustomForm;
{== Vitals Lite 2004-05-21 ===================================================}

type
  TfrmEncVitals = class(TfrmPCEBase)
    pnlmain: TPanel;
    lblDate: TStaticText;
    lblDateBP: TStaticText;
    lblDateTemp: TStaticText;
    lblDateResp: TStaticText;
    lblDatePulse: TStaticText;
    lblDateHeight: TStaticText;
    lblDateWeight: TStaticText;
    lblLstMeas: TStaticText;
    lbllastBP: TStaticText;
    lblLastTemp: TStaticText;
    lblLastResp: TStaticText;
    lblLastPulse: TStaticText;
    lblLastHeight: TStaticText;
    lblLastWeight: TStaticText;
    lblVitPointer: TOROffsetLabel;
    lblVital: TStaticText;
    lblVitBP: TStaticText;
    lnlVitTemp: TStaticText;
    lblVitResp: TStaticText;
    lblVitPulse: TStaticText;
    lblVitHeight: TStaticText;
    lblVitWeight: TStaticText;
    txtMeasBP: TCaptionEdit;
    cboTemp: TCaptionComboBox;
    txtMeasTemp: TCaptionEdit;
    txtMeasResp: TCaptionEdit;
    cboHeight: TCaptionComboBox;
    txtMeasWt: TCaptionEdit;
    cboWeight: TCaptionComboBox;
    txtMeasDate: TORDateBox;
    lblVitPain: TStaticText;
    lblLastPain: TStaticText;
    lblDatePain: TStaticText;
    cboPain: TORComboBox;
    txtMeasPulse: TCaptionEdit;
    txtMeasHt: TCaptionEdit;
    pnlBottom: TPanel;
    btnEnterVitals: TButton;
    lvVitals: TCaptionListView;
    procedure SetVitPointer(Sender: TObject);
    procedure txtMeasBPExit(Sender: TObject);
    procedure cboTempChange(Sender: TObject);
    procedure cboTempExit(Sender: TObject);
    procedure txtMeasRespExit(Sender: TObject);
    procedure txtMeasPulseExit(Sender: TObject);
    procedure cboHeightChange(Sender: TObject);
    procedure cboHeightExit(Sender: TObject);
    procedure cboWeightChange(Sender: TObject);
    procedure cboWeightExit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lbllastClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    function HasData: Boolean;
    function AssignVitals: boolean;
    procedure cboPainChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure txtMeasTempExit(Sender: TObject);
    procedure txtMeasHtExit(Sender: TObject);
    procedure txtMeasWtExit(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnEnterVitalsClick(Sender: TObject); //vitals lite
  private
    FDataLoaded: boolean;
    FChangingFocus: boolean;
    UvitalNew: TStringList;
    uVitalOld: TSTringList;
    procedure InitVitalPanel;
    procedure PopulateLastVital;
    function GetVitHTRate: String;
    procedure CheckVitalUnit;
    procedure ChangeFocus(Control: TWinControl);
    procedure ClearData;
    procedure LoadVitalView(VitalsList : TStringList); //Vitals Lite
    procedure LoadVitalsList;
  public
    function OK2SaveVitals: boolean;
    property VitalNew: TStringList read uVitalNew;
    property VitalOld: TStringList read uVitalOld;
  end;

var
  frmEncVitals: TfrmEncVitals;
//  uVitalLocation: Real;

implementation

{$R *.DFM}

uses UCore, rCore, rPCE, fPCELex, fPCEOther, fVitals,fVisit, fFrame, fEncnt,
     fEncounterFrame, uInit
  //   , fGMV_InputTemp // Vitals Lite 2004-05-21
     ;

var
    TX_VDATE_REQ1  : string;  //kt
    TC_VDATE_REQ   : string;  //kt
    TX_KILLDATA    : string;  //kt

const
//TX_VDATE_REQ1 = 'Entered vitals information can not be saved without a Date.' + CRLF +  <-- original line.  //kt 8/8/2007
//                'Do you wish to use the encounter date of ';  <-- original line.  //kt 8/8/2007
  TX_VDATE_REQ2 = '?';
//TC_VDATE_REQ = 'Missing Vitals Entry Date';  <-- original line.  //kt 8/8/2007

//TX_KILLDATA = 'Discard entered vitals information?';  <-- original line.  //kt 8/8/2007


procedure SetupVars;
//kt Added entire function to replace constant declarations 8/8/2007
begin
  TX_VDATE_REQ1 := DKLangConstW('fEncVitals_Entered_vitals_information_can_not_be_saved_without_a_Datex') + CRLF +
                  DKLangConstW('fEncVitals_Do_you_wish_to_use_the_encounter_date_of');
  TC_VDATE_REQ := DKLangConstW('fEncVitals_Missing_Vitals_Entry_Date');
  TX_KILLDATA := DKLangConstW('fEncVitals_Discard_entered_vitals_informationx');
end;

var
  UcboVitChanging:      Boolean = False;

function TfrmEncVitals.HasData: Boolean;
begin
  result := False;
  if ((txtMeasBP.text <> '') or (txtMeasTemp.text <> '') or (txtMeasResp.text <> '') or
    (txtMeasPulse.text <> '') or (txtMeasHt.text <> '') or (txtMeasWt.text <> '')) or
    (cboPain.text <>'') then
    result := True;
end;

procedure TfrmEncVitals.InitVitalPanel;
begin
  lblDate.font.Style := [fsBold];
  lblDateBP.font.Style := [fsBold];
  lblDateTemp.font.Style := [fsBold];
  lblDateResp.font.Style := [fsBold];
  lblDatePulse.font.Style := [fsBold];
  lblDateHeight.font.Style := [fsBold];
  lblDateWeight.font.Style := [fsBold];
  lblDatePain.font.style := [fsBold];
  lblLstMeas.font.Style := [fsBold];
  lblLastBP.font.Style := [fsBold];
  lblLastTemp.font.Style := [fsBold];
  lblLastResp.font.Style := [fsBold];
  lblLastPulse.font.Style := [fsBold];
  lblLastHeight.font.Style := [fsBold];
  lblLastWeight.font.Style := [fsBold];
  lblLastPain.font.style := [fsBold];
  lblVital.font.Style := [fsbold];

  {Use this area to read parameter for units and set apropriately
   after parameter is defined. in next version
  }
  UcboVitchanging := true; //prevents entering code in CheckVitalUnit

  try
    InitPainCombo(cboPain);
    cboTemp.Text := cboTemp.Items[0];
    cboHeight.Text := cboHeight.Items[0];
    cboWeight.Text := cboWeight.Items[0];
  finally
    UcboVitchanging := False; //prevents entering code in CheckVitalUnit
  end;

  if txtMeasDate.Text = '' then
    txtMeasDate.Text := FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.VisitDateTime);
  if (UvitalOld.text = '') then
    PopulateLastVital;
end;


procedure TfrmEncVitals.PopulateLastVital;
var
 i: integer;
begin
  GetLastVital(uVitalOld,Patient.DFN);
  //populate labels from UVitalOld;
  with UVitalOld do
  for i := 0 to count-1 do
  begin
    if piece(strings[i],U,2) = 'T' then
    begin
      lblLastTemp.Caption := ConvertVitalData(piece(strings[i],U,3), vtTemp);
      lblDateTemp.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));
    end;
    if piece(strings[i],U,2) = 'P' then
    begin
      lblLastPulse.Caption := piece(strings[i],U,3);
      lblDatePulse.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));
    end;
    if piece(strings[i],U,2) = 'R' then
    begin
      lblLastResp.Caption := piece(strings[i],U,3);
      lblDateResp.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));
    end;
    if piece(strings[i],U,2) = 'BP' then
    begin
      lblLastBP.Caption := piece(strings[i],U,3);
      lblDateBP.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));
    end;
    if piece(strings[i],U,2) = 'HT' then
    begin
      lblLastHeight.Caption := ConvertVitalData(piece(strings[i],U,3), vtHeight);
      lblDateHeight.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));
    end;
    if piece(strings[i],U,2) = 'WT' then
    begin
      lblLastWeight.Caption := ConvertVitalData(piece(strings[i],U,3), vtWeight);
      lblDateWeight.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));

    end;
   if piece(strings[i],U,2) = 'PN' then
    begin
      lblLastPain.Caption := piece(strings[i],U,3);
      lblDatePain.Caption := FormatFMDateTime('mmm dd,yy',
        StrToFloat(piece(strings[i],U,4)));
    end;
  end;
end;


procedure TfrmEncVitals.SetVitPointer(Sender: TObject);
begin
  if ActiveCtrl.tag in VitalTagSet then
  begin
    // move pointer to some height and five pixels to right of edit box.
    lblVitPointer.Top := ActiveCtrl.Top+((ActiveCtrl.height ) div
    (lblVitPointer.height ));

    if ActiveCtrl = txtMeasTemp then
      lblVitPointer.left := (cboTemp.left + cboTemp.Width)
    else if ActiveCtrl = txtMeasHT then
      lblVitPointer.left := (cboHeight.left + cboHeight.Width)
    else if ActiveCtrl = txtMeasWT then
      lblVitPointer.left := (cboWeight.left + cboWeight.Width)
    else
      lblVitPointer.left := (ActiveCtrl.left + ActiveCtrl.Width);

  end;
end;


function TfrmEncVitals.GetVitHTRate: String;
begin
  Result := ConvertHeight2Inches(txtMeasHT.Text);
  txtMeasHT.text := result;
end;

function TfrmEncVitals.AssignVitals: boolean;
var
  TmpDate: TFMDateTime;

begin
  TmpDate := txtMeasDate.FMDateTime;
  Result := ValidVitalsDate(TmpDate);
  if Result then
    AssignVitals2List(uVitalNew, TmpDate, FloatToStr(PCERPCEncLocation),
                       txtMeasBP.text, txtMeasTemp.text, cboTemp.text,
                       txtMeasResp.text, txtMeasPulse.text, GetVitHTRate, cboHeight.text,
                       txtMeasWT.text, cboWeight.text, cboPain.ItemID);
end;

procedure TfrmEncVitals.cboTempChange(Sender: TObject);
begin
  inherited;
  if not (cbotemp.droppeddown) then
    CheckVitalUnit;
end;


procedure TfrmEncVitals.CheckVitalUnit;
var
  len,i: integer;
  found: boolean;
  comp: string; //substring for comparing
  temp: string;
begin
  if (UcboVitchanging = true) then exit;

  UcboVitChanging := true;
  try
    with ActiveCtrl as TComboBox do
    begin
       found := False;
       temp := text;
       while (found = false) and (Length(temp) > 0) do
       begin
          i := 0;
          while (found = false) and (length(items[i]) > 0) do
          begin
          len := length(temp);
          //match text to string
          comp := copy(items[i],0,len);
          if (CompareText(comp,temp) = 0) then
          begin
             found := true;
             Text := '';
             text := items[i];

          end;
          inc(i);
          end;
          if (found = false) then Delete(temp,1,1);
       end;
       if (found = False) then
       begin
          Text := '';
       end;
    end;
  finally
    UcboVitChanging := false;
  end;
end;


procedure TfrmEncVitals.cboHeightChange(Sender: TObject);
begin
  inherited;
  CheckVitalUnit;
end;

procedure TfrmEncVitals.cboWeightChange(Sender: TObject);
begin
  inherited;
  CheckVitalUnit;
end;

procedure TfrmEncVitals.txtMeasBPExit(Sender: TObject);
begin
  inherited;
  if VitalInvalid(txtMeasBP) then
    ChangeFocus(txtMeasBP);
end;

procedure TfrmEncVitals.cboTempExit(Sender: TObject);
begin
  inherited;
  if(ActiveCtrl <> txtMeasTemp) then
  begin
    if VitalInvalid(txtMeasTemp, cboTemp) then
      ChangeFocus(txtMeasTemp);
  end;
end;

procedure TfrmEncVitals.txtMeasRespExit(Sender: TObject);
begin
  inherited;
  if VitalInvalid(txtMeasResp) then
    ChangeFocus(txtMeasResp);
end;

procedure TfrmEncVitals.txtMeasPulseExit(Sender: TObject);
begin
  inherited;
  if VitalInvalid(txtMeasPulse) then
    ChangeFocus(txtMeasPulse);
end;

procedure TfrmEncVitals.cboHeightExit(Sender: TObject);
begin
  inherited;
  if(ActiveCtrl <> txtMeasHt) then
  begin
    if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
      ChangeFocus(txtMeasHt);
  end;
end;

procedure TfrmEncVitals.cboWeightExit(Sender: TObject);
begin
  inherited;
  if(ActiveCtrl <> txtMeasWt) then
  begin
    if VitalInvalid(txtMeasWt, cboWeight) then
      ChangeFocus(txtMeasWt);
  end;
end;


procedure TfrmEncVitals.FormCreate(Sender: TObject);
begin

  inherited;
  FTabName := CT_VitNm;
  //uVisitType := TPCEProc.create;
  uVitalOld  := TStringList.create;
  uVitalNew  := TStringList.create;

end;



procedure TfrmEncVitals.FormDestroy(Sender: TObject);

begin
  //uVisitType.Free;
  uVitalOld.Free;
  uVitalNew.free;

{== Vitals Lite 2004-05-21 ===================================================}
  FreeLibrary(VitalsDLLHandle);
{== Vitals Lite 2004-05-21 ===================================================}
  inherited;
end;




procedure TfrmEncVitals.lbllastClick(Sender: TObject);
begin
  inherited;
  //
  try
    frmEncVitals.Show;
  except
    with sender as TStaticText do
      SelectVital(self.Font.Size, tag);
  end; //end of try
end;


procedure TfrmEncVitals.FormShow(Sender: TObject);
var
  GMV_LibName: String;
begin
  inherited;
  //Begin Vitals Lite
  {Visit is Assumed to Be selected when Opening Encounter Dialog}
  GMV_LibName :='GMV_VitalsViewEnter.dll';
  GMV_LibName := GetProgramFilesPath + SHARE_DIR + GMV_LibName;
  VitalsDLLHandle := LoadLibrary(PChar(GMV_LibName));
  if VitalsDLLHandle = 0 then // No Handle found
//  MessageDLG('Can''t find library "'+GMV_LibName+'".',mtError,[mbok],0)  <-- original line.  //kt 8/8/2007
    MessageDLG(DKLangConstW('fEncVitals_Canxxt_find_library_x')+GMV_LibName+'".',mtError,[mbok],0) //kt added 8/8/2007
  else
    LoadVitalsList;
  //End Vitals Lite
//  frmEncVitals.caption := 'Vital entry for - '+ patient.name; {RAB 6/15/98}
  FormActivate(Sender);
end;

procedure TfrmEncVitals.FormActivate(Sender: TObject);
begin
  inherited;
  if(not FChangingFocus) and (not FDataLoaded) then
  begin
    FDataLoaded := TRUE;
    InitVitalPanel;
//    txtMeasTemp.setfocus;  //added 3/30/99 after changing tab order.
                         //The date is now first in tab order, but it shouldn't default there.
  end;
end;



procedure TfrmEncVitals.cboPainChange(Sender: TObject);
begin
  inherited;
  CheckVitalUnit;
end;

procedure TfrmEncVitals.FormResize(Sender: TObject);
begin
  inherited;
  //added to make things austo size that do not heave the property.
  cboTemp.height := txtmeastemp.height;
  cboPain.height := txtmeastemp.height;
  cboheight.height := txtmeastemp.height;
  cboweight.height := txtmeastemp.height;
end;

procedure TfrmEncVitals.txtMeasTempExit(Sender: TObject);
begin
  inherited;
  if(ActiveCtrl <> cboTemp) then
  begin
    if VitalInvalid(txtMeasTemp, cboTemp) then
      ChangeFocus(txtMeasTemp);
  end;
end;

procedure TfrmEncVitals.txtMeasHtExit(Sender: TObject);
begin
  inherited;
  if(ActiveCtrl <> cboHeight) then
  begin
    if VitalInvalid(txtMeasHt, cboHeight, GetVitHTRate) then
      ChangeFocus(txtMeasHt);
  end;
end;

procedure TfrmEncVitals.txtMeasWtExit(Sender: TObject);
begin
  inherited;
  if(ActiveCtrl <> cboWeight) then
  begin
    if VitalInvalid(txtMeasWt, cboWeight) then
      ChangeFocus(txtMeasWt);
  end;
end;

procedure TfrmEncVitals.ChangeFocus(Control: TWinControl);
begin
  FChangingFocus := TRUE;
  try
    Control.SetFocus;
  finally
    FChangingFocus := FALSE;
  end;
end;

function TfrmEncVitals.OK2SaveVitals: boolean;
begin
  SetupVars;  //kt added 8/8/2007 to replace constants with vars.
  Result := TRUE;
  if(HasData and (abs(txtMeasDate.FMDateTime) <= 0.0000000000001)) then
  begin
    Result := (InfoBox(TX_VDATE_REQ1 + FormatFMDateTime('mmm dd,yy@hh:nn', uEncPCEData.DateTime) +
                       TX_VDATE_REQ2, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
    if Result then
      txtMeasDate.FMDateTime := uEncPCEData.DateTime
    else
    begin
      Result := (InfoBox(TX_KILLDATA, TC_VDATE_REQ, MB_YESNO or MB_ICONWARNING) = IDYES);
      if(Result) then
        ClearData;
    end;
  end;
end;

procedure TfrmEncVitals.ClearData;
begin
  txtMeasBP.text    := '';
  txtMeasTemp.text  := '';
  txtMeasResp.text  := '';
  txtMeasPulse.text := '';
  txtMeasHt.text    := '';
  txtMeasWt.text    := '';
  cboPain.text      := '';
end;

procedure TfrmEncVitals.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  {capture return key press if on the vital screen}
  begin
    inherited;
    if (ActiveCtrl.tag in VitalDateTagSet)then
    begin
      if Key = VK_RETURN then
      begin
        Key := 0;
        if (ActiveCtrl.Tag = TAG_VITPAIN) then
          ChangeFocus(btnOK)
        else
        begin
          GetParentForm(Self).Perform(WM_NEXTDLGCTL,0,0);
          SetVitPointer(Sender);
        end;
      end;
    end;
  end;
end;

//Begin Vitals Lite
procedure TfrmEncVitals.LoadVitalView(VitalsList: TStringList);
var
  i : integer;
  curCol : TListColumn;
  curItem : TListItem;
  HeadingList,tmpList : TStringList;
begin
  HeadingList := TStringList.Create;
  tmpList := TStringList.Create;
  lvVitals.ShowColumnHeaders := false;                //CQ: 10069 - the column display becomes squished.
  lvVitals.Items.Clear;
  lvVitals.Columns.Clear;
  PiecesToList(VitalsList[0],U,HeadingList);
  for i := 0 to HeadingList.Count-1 do
  begin
    curCol := lvVitals.Columns.Add;
    curCol.Caption := HeadingList[i];
    curCol.AutoSize := true;
  end;
  for i := 1 to VitalsList.Count-1 do
  begin
    curItem := lvVitals.Items.Add;
    PiecesToList(VitalsList[i],U,tmpList);
    curItem.Caption := tmpList[0];
    tmpList.Delete(0);
    curItem.SubItems.Assign(tmpList);
  end;
  lvVitals.ShowColumnHeaders := true;                 //CQ: 10069 - the column display becomes squished.
  HeadingList.Free;
  tmpList.Free;
end;

procedure TfrmEncVitals.btnEnterVitalsClick(Sender: TObject);
var
  VLPtVitals : TGMV_VitalsEnterDLG;
  GMV_FName : String;
begin
  inherited;
  if VitalsDLLHandle = 0 then Exit;//The DLL was initialized on Create, but just in case....
//GMV_FName := 'GMV_VitalsEnterDLG';  <-- original line.  //kt 8/8/2007
  GMV_FName := DKLangConstW('fEncVitals_GMV_VitalsEnterDLG'); //kt added 8/8/2007
  @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
  if assigned(VLPtVitals) then
  begin
    VLPtVitals(
      RPCBrokerV,
      Patient.DFN,
      FloatToStr(uEncPCEData.Location),
      GMV_DEFAULT_TEMPLATE,
      GMV_APP_SIGNATURE,
      FMDateTimeToDateTime(uEncPCEData.DateTime),
      Patient.Name,
      frmFrame.lblPtSSN.Caption + '    ' + frmFrame.lblPtAge.Caption
    );
  end
  else
//  MessageDLG('Can not find function "'+GMV_FName+'".',mtError,[mbok],0);  <-- original line.  //kt 8/8/2007
    MessageDLG(DKLangConstW('fEncVitals_Can_not_find_function_x')+GMV_FName+'".',mtError,[mbok],0); //kt added 8/8/2007
  @VLPtVitals := nil;
  LoadVitalsList;
end;

procedure TfrmEncVitals.LoadVitalsList;
var
  VitalsList : TStringList;
  VLPtVitals : TGMV_LatestVitalsList;
  GMV_FName : String;
begin
  if VitalsDLLHandle = 0 then Exit;//The DLL was initialized on Create, but just in case....
//GMV_FName := 'GMV_LatestVitalsList';  <-- original line.  //kt 8/8/2007
  GMV_FName := DKLangConstW('fEncVitals_GMV_LatestVitalsList'); //kt added 8/8/2007
  @VLPtVitals := GetProcAddress(VitalsDLLHandle,PChar(GMV_FName));
  if assigned(VLPtVitals) then
  begin
    frmFrame.VitalsDLLActive := True;  // need this flag for CCOW (RV)
    VitalsList := VLPtVitals(RPCBrokerV,Patient.DFN,U,false);
    if assigned(VitalsList) then
      LoadVitalView(VitalsList);
  end
  else
//  MessageDLG('Can''t find function "'+GMV_FName+'".',mtError,[mbok],0);  <-- original line.  //kt 8/8/2007
    MessageDLG(DKLangConstW('fEncVitals_Canxxt_find_function_x')+GMV_FName+'".',mtError,[mbok],0); //kt added 8/8/2007
  @VLPtVitals := nil;
  frmFrame.VitalsDLLActive := False;  // need this flag for CCOW (RV)
end;
//End Vitals Lite

end.
