//kt -- Modified with SourceScanner on 9/5/2007
unit fPtSelOptns;

interface

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

type
  TSetCaptionTopProc = procedure of object;
  TSetPtListTopProc = procedure(IEN: Int64) of object;

  TfrmPtSelOptns = class(TForm)
    orapnlMain: TORAutoPanel;
    bvlPtList: TORAutoPanel;
    lblPtList: TLabel;
    lblDateRange: TLabel;
    cboList: TORComboBox;
    cboDateRange: TORComboBox;
    calApptRng: TORDateRangeDlg;
    radDflt: TRadioButton;
    radProviders: TRadioButton;
    radTeams: TRadioButton;
    radSpecialties: TRadioButton;
    radClinics: TRadioButton;
    radWards: TRadioButton;
    radAll: TRadioButton;
    DKLanguageController1: TDKLanguageController;
    procedure radHideSrcClick(Sender: TObject);
    procedure radShowSrcClick(Sender: TObject);
    procedure radLongSrcClick(Sender: TObject);
    procedure cboListExit(Sender: TObject);
    procedure cboListKeyPause(Sender: TObject);
    procedure cboListMouseClick(Sender: TObject);
    procedure cboListNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure cboDateRangeExit(Sender: TObject);
    procedure cboDateRangeMouseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FLastTopList: string;
    FLastDateIndex: Integer;
    FSrcType: Integer;
    FSetCaptionTop: TSetCaptionTopProc;
    FSetPtListTop: TSetPtListTopProc;
    procedure HideDateRange;
    procedure ShowDateRange;
  public
    function IsLast5(x: string): Boolean;
    function IsFullSSN(x: string): Boolean;
    //vwpt voe
    function IsEnhanced(x: String) : Boolean ;
    function IsPatientName(x: String) :Boolean;
    //end
    procedure cmdSaveListClick(Sender: TObject);
    procedure SetDefaultPtList(Dflt: string);
    procedure UpdateDefault;

    property LastTopList: string read FLastTopList write FLastTopList;
    property SrcType: Integer read FSrcType write FSrcType;
    property SetCaptionTopProc: TSetCaptionTopProc read FSetCaptionTop write FSetCaptionTop;
    property SetPtListTopProc: TSetPtListTopProc   read FSetPtListTop  write FSetPtListTop;
  end;

const
{ constants referencing the value of the tag property in components }
  TAG_SRC_DFLT = 11;                             // default patient list
  TAG_SRC_PROV = 12;                             // patient list by provider
  TAG_SRC_TEAM = 13;                             // patient list by team
  TAG_SRC_SPEC = 14;                             // patient list by treating specialty
  TAG_SRC_CLIN = 16;                             // patient list by clinic
  TAG_SRC_WARD = 17;                             // patient list by ward
  TAG_SRC_ALL  = 18;                             // all patients

var
   frmPtSelOptns: TfrmPtSelOptns;
  //frmPtSelOptns: TfrmPtSelOptns;
  clinDoSave, clinSaveToday: boolean;
  clinDefaults: string;

implementation

{$R *.DFM}

uses
  rCore, fPtSelOptSave,fPtSel;

//const
//TX_LS_DFLT = 'This is already saved as your default patient list settings.';  <-- original line.  //kt 9/5/2007
//TX_LS_PROV = 'A provider must be selected to save patient list settings.';  <-- original line.  //kt 9/5/2007
//TX_LS_TEAM = 'A team must be selected to save patient list settings.';  <-- original line.  //kt 9/5/2007
//TX_LS_SPEC = 'A specialty must be selected to save patient list settings.';  <-- original line.  //kt 9/5/2007
//TX_LS_CLIN = 'A clinic and a date range must be selected to save settings for a clinic.';  <-- original line.  //kt 9/5/2007
//TX_LS_WARD = 'A ward must be selected to save patient list settings.';  <-- original line.  //kt 9/5/2007
//TC_LS_FAIL = 'Unable to Save Patient List Settings';  <-- original line.  //kt 9/5/2007
//TX_LS_SAV1 = 'Save ';  <-- original line.  //kt 9/5/2007
//TX_LS_SAV2 = CRLF + 'as your default patient list setting?';  <-- original line.  //kt 9/5/2007
//TC_LS_SAVE = 'Save Patient List Settings';  <-- original line.  //kt 9/5/2007

function TX_LS_DFLT : string; //kt
begin Result := DKLangConstW('fPtSelOptns_This_is_already_saved_as_your_default_patient_list_settingsx'); //kt added 9/5/2007
end;

function TX_LS_PROV : string; //kt
begin Result := DKLangConstW('fPtSelOptns_A_provider_must_be_selected_to_save_patient_list_settingsx'); //kt added 9/5/2007
end;

function TX_LS_TEAM : string; //kt
begin Result := DKLangConstW('fPtSelOptns_A_team_must_be_selected_to_save_patient_list_settingsx'); //kt added 9/5/2007
end;

function TX_LS_SPEC : string; //kt
begin Result := DKLangConstW('fPtSelOptns_A_specialty_must_be_selected_to_save_patient_list_settingsx'); //kt added 9/5/2007
end;

function TX_LS_CLIN : string; //kt
begin Result := DKLangConstW('fPtSelOptns_A_clinic_and_a_date_range_must_be_selected_to_save_settings_for_a_clinicx'); //kt added 9/5/2007
end;

function TX_LS_WARD : string; //kt
begin Result := DKLangConstW('fPtSelOptns_A_ward_must_be_selected_to_save_patient_list_settingsx'); //kt added 9/5/2007
end;

function TC_LS_FAIL : string; //kt
begin Result := DKLangConstW('fPtSelOptns_Unable_to_Save_Patient_List_Settings'); //kt added 9/5/2007
end;

function TX_LS_SAV1 : string; //kt
begin Result := DKLangConstW('fPtSelOptns_Save'); //kt added 9/5/2007
end;

function TX_LS_SAV2 : string; //kt
begin Result := CRLF + DKLangConstW('fPtSelOptns_as_your_default_patient_list_settingx'); //kt added 9/5/2007
end;

function TC_LS_SAVE : string; //kt
begin Result := DKLangConstW('fPtSelOptns_Save_Patient_List_Settings'); //kt added 9/5/2007
end;

function TfrmPtSelOptns.IsLast5(x: string): Boolean;
{ returns true if string matchs patterns: A9999 or 9999 (BS & BS5 xrefs for patient lookup) }
var
  i: Integer;
begin
  Result := False;
  if not ((Length(x) = 4) or (Length(x) = 5)) then Exit;
  if Length(x) = 5 then
  begin
    if not (x[1] in ['A'..'Z', 'a'..'z']) then Exit;
    x := Copy(x, 2, 4);
  end;
  for i := 1 to 4 do if not (x[i] in ['0'..'9']) then Exit;
  Result := True;
end;
function TfrmPtSelOptns.IsPatientName(x: string):Boolean;
 { returns true if string matchs patient name pattern: all alphabetic," ",",","-","." only }
var
  i: Integer;
begin
  Result := False;

   for i := 1 to Length(x) do if not (x[i] in ['A'..'Z', 'a'..'z', ' '..' ', ','..'.']) then Exit;

  Result := True;
end;
function TfrmPtSelOptns.IsEnhanced(x: String) : boolean ;
var
  i: integer;
begin
  //Result := True;
  //for i:= 1 to Length(x) do if (x[i] in ['0'..'9']) then Exit;
  //for i:= 1 to Length(x) do
  //begin
  // if ((x[i] = '(') or (x[i] = ')') or (x[i] = '-') or (x[i] = '/') or (x[i] = ',') or (x[i] = '\')) then Exit;
  //end;
  Result := True;   //False;
  if (frmPtSelOptns.radAll.Checked <> True)and (frmPtSelOptns.radDflt.Checked <> True) then Result := False;
end;
function TfrmPtSelOptns.IsFullSSN(x: string): boolean;
var
  i: integer;
begin
  Result := False;
  if (Length(x) < 9) or (Length(x) > 12) then Exit;
  case Length(x) of
    9:  // no dashes, no 'P'
        for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
   10:  // no dashes, with 'P'
        begin
          for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
          if (Uppercase(x[10]) <> 'P') then Exit;
        end;
   11:  // dashes, no 'P'
        begin
          if (x[4] <> '-') or (x[7] <> '-') then Exit;
          x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,4);
          for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
        end;
   12:  // dashes, with 'P'
        begin
          if (x[4] <> '-') or (x[7] <> '-') then Exit;
          x := Copy(x,1,3) + Copy(x,5,2) + Copy(x,8,5);
          for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
          if UpperCase(x[10]) <> 'P' then Exit;
        end;
  end;
  Result := True;
end;

procedure TfrmPtSelOptns.radHideSrcClick(Sender: TObject);
{ called by radDflt & radAll - hides list source combo box and refreshes patient list }
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  HideDateRange;
  cboList.Visible := False;
  cboList.Caption := TRadioButton(Sender).Caption;
  FSetCaptionTop;
  FSetPtListTop(0);
end;

procedure TfrmPtSelOptns.radShowSrcClick(Sender: TObject);
{ called by radTeams, radSpecialties, radWards - shows items for the list source }
begin
(*     Commented out until a further clarification    //kt  12/29/09
    //vwpt remove other radio button selections
 if assigned(frmPtSel) and (frmPtSel.radiogroup1.ItemIndex <> 0) then   //kt
 begin      //elh
      FSrcType := TControl(Sender).Tag;
      case FSrcType of
    TAG_SRC_TEAM: begin
                    radTeams.Checked := False;
                    radTeams.Refresh;
                    radAll.Checked := True;
                    radAll.Refresh;

                  end;
    TAG_SRC_SPEC: begin
                    radSpecialties.Checked := False;
                    radSpecialties.Refresh;
                    radAll.Checked := True;
                    radAll.Refresh;
                  end;
    TAG_SRC_WARD: begin
                    radWards.Checked := False;
                    radWards.Refresh;
                    radAll.Checked := True;
                    radAll.Refresh;
                  end;
    end;
  //frmPtSel.RadioGroup1.SetFocus;
  //frmPtSel.RadioGroup1.Refresh;
 end
 else
 begin
  //end vwpt
  *)
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  HideDateRange;
  FSetCaptionTop;
  with cboList do
  begin
    Clear;
    LongList := False;
    Sorted := True;
    case FSrcType of
    TAG_SRC_TEAM: ListTeamAll(Items);
    TAG_SRC_SPEC: ListSpecialtyAll(Items);
    TAG_SRC_WARD: ListWardAll(Items);
    end;
    Visible := True;
  end;
  cboList.Caption := TRadioButton(Sender).Caption;
 //kt end; //else
end;

procedure TfrmPtSelOptns.radLongSrcClick(Sender: TObject);
{ called by radProviders, radClinics - switches to long list & shows items for the list source }
begin
  //vwpt remove other radio button selections
 (*     Commented out until a further clarification    //kt  12/29/09
 if frmPtSel.RadioGroup1.ItemIndex <> 0 then
 begin
      FSrcType := TControl(Sender).Tag;
      case FSrcType of
    TAG_SRC_PROV: begin
                    radProviders.Checked := False;
                    radProviders.Refresh;
                    radAll.Checked := True;
                    radAll.Refresh;

                  end;
    TAG_SRC_CLIN: begin
                    radClinics.Checked := False;
                    radClinics.Refresh;
                    radAll.Checked := True;
                    radAll.Refresh;
                  end;
    end;
  //frmPtSel.RadioGroup1.SetFocus;
  //frmPtSel.RadioGroup1.Refresh;
 end
 else
 begin
  //end vwpt  *)
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  FSetCaptionTop;
  with cboList do
  begin
    Sorted := False;
    LongList := True;
    Clear;
    case FSrcType of
    TAG_SRC_PROV: begin
                    cboList.Pieces := '2,3';
                    HideDateRange;
                    ListProviderTop(Items);
                  end;
    TAG_SRC_CLIN: begin
                    ShowDateRange;
                    ListClinicTop(Items);
                  end;
    end;
    InitLongList('');
    Visible := True;
  end;
  cboList.Caption := TRadioButton(Sender).Caption;
 //kt end; //else
end;

procedure TfrmPtSelOptns.cboListExit(Sender: TObject);
begin
  with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
end;

procedure TfrmPtSelOptns.cboListKeyPause(Sender: TObject);
begin
  with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
end;

procedure TfrmPtSelOptns.cboListMouseClick(Sender: TObject);
begin
  with cboList do if ItemIEN > 0 then FSetPtListTop(ItemIEN);
end;

procedure TfrmPtSelOptns.cboListNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer);
{CQ6363 Notes: This procedure was altered for CQ6363, but then changed back to its original form, as it is now.

The problem is that in LOM1T, there are numerous entries in the HOSPITAL LOCATION file (44) that are lower-case,
resulting in a "B" xref that looks like this:

^SC("B","module 1x",2897) = 
^SC("B","pt",3420) = 
^SC("B","read",3146) = 
^SC("B","zz GIM/WONG NEW",2902) = 
^SC("B","zz bhost/arm",3076) = 
^SC("B","zz bhost/day",2698) = 
^SC("B","zz bhost/eve/ornelas",2885) = 
^SC("B","zz bhost/resident",2710) = 
^SC("B","zz bhost/sws",2946) = 
^SC("B","zz c&P ortho/patel",3292) =
^SC("B","zz mhc md/kelley",320) = 
^SC("B","zz/mhc/p",1076) = 
^SC("B","zzMHC MD/THRASHER",1018) =
^SC("B","zztest clinic",3090) = 
^SC("B","zzz-hbpc-phone-jung",1830) = 
^SC("B","zzz-hbpcphone cocohran",1825) = 
^SC("B","zzz-home service",1428) = 
^SC("B","zzz-phone-deloye",1834) = 
^SC("B","zzz/gmonti impotence",2193) =

ASCII sort mode puts those entries at the end of the "B" xref, but when retrieved by CPRS and upper-cased, it
messes up the logic of the combo box.  This problem has been around since there was a CPRS GUI, and the best
possible fix is to require those entries to either be in all uppercase or be removed.  If that's cleaned up,
the logic below will work correctly.
}
begin
  case frmPtSelOptns.SrcType of
  TAG_SRC_PROV: cboList.ForDataUse(SubSetOfProviders(StartFrom, Direction));
  TAG_SRC_CLIN: cboList.ForDataUse(SubSetOfClinics(StartFrom, Direction));
  end;
end;

procedure TfrmPtSelOptns.HideDateRange;
begin
  lblDateRange.Hide;
  cboDateRange.Hide;
  cboList.Height := cboDateRange.Top - cboList.Top + cboDateRange.Height;
end;

procedure TfrmPtSelOptns.ShowDateRange;
var
  DateString, DRStart, DREnd: string;
  TStart, TEnd: boolean;
begin
  with cboDateRange do if Items.Count = 0 then
  begin
    ListDateRangeClinic(Items);
    ItemIndex := 0;
  end;
  DateString := DfltDateRangeClinic; // Returns "^T" even if no settings.
  DRStart := piece(DateString,U,1);
  DREnd := piece(DateString,U,2);
  if (DRStart <> ' ') then
    begin
      TStart := false;
      TEnd := false;
      if ((DRStart = 'T') or (DRStart = 'TODAY')) then
        TStart := true;
      if ((DREnd = 'T') or (DREnd = 'TODAY')) then
        TEnd := true;
      if not (TStart and TEnd) then
        cboDateRange.ItemIndex := cboDateRange.Items.Add(DRStart + ';' +
//        DREnd + U + DRStart + ' to ' + DREnd);  <-- original line.  //kt 9/5/2007
          DREnd + U + DRStart + DKLangConstW('fPtSelOptns_to') + DREnd); //kt added 9/5/2007
    end;
  cboList.Height := lblDateRange.Top - cboList.Top - 4;
  lblDateRange.Show;
  cboDateRange.Show;
end;

procedure TfrmPtSelOptns.cboDateRangeExit(Sender: TObject);
begin
  if cboDateRange.ItemIndex <> FLastDateIndex then cboDateRangeMouseClick(Self);
end;

procedure TfrmPtSelOptns.cboDateRangeMouseClick(Sender: TObject);
begin
  if (cboDateRange.ItemID = 'S') then
  begin
    with calApptRng do if Execute
      then cboDateRange.ItemIndex := cboDateRange.Items.Add(RelativeStart + ';' +
//         RelativeStop + U + TextOfStart + ' to ' + TextOfStop)  <-- original line.  //kt 9/5/2007
           RelativeStop + U + TextOfStart + DKLangConstW('fPtSelOptns_to') + TextOfStop) //kt added 9/5/2007
      else cboDateRange.ItemIndex := -1;
  end;
  FLastDateIndex := cboDateRange.ItemIndex;
  if cboList.ItemIEN > 0 then FSetPtListTop(cboList.ItemIEN);
end;

procedure TfrmPtSelOptns.cmdSaveListClick(Sender: TObject);
var
  x: string;
begin
  x := '';
  case FSrcType of
  TAG_SRC_DFLT: InfoBox(TX_LS_DFLT, TC_LS_FAIL, MB_OK);
  TAG_SRC_PROV: if cboList.ItemIEN <= 0
                  then InfoBox(TX_LS_PROV, TC_LS_FAIL, MB_OK)
                  else x := 'P^' + IntToStr(cboList.ItemIEN) + U + U +
//                          'Provider = ' + cboList.Text;  <-- original line.  //kt 9/5/2007
                            DKLangConstW('fPtSelOptns_Provider_x') + cboList.Text; //kt added 9/5/2007
  TAG_SRC_TEAM: if cboList.ItemIEN <= 0
                  then InfoBox(TX_LS_TEAM, TC_LS_FAIL, MB_OK)
                  else x := 'T^' + IntToStr(cboList.ItemIEN) + U + U +
//                          'Team = ' + cboList.Text;  <-- original line.  //kt 9/5/2007
                            DKLangConstW('fPtSelOptns_Team_x') + cboList.Text; //kt added 9/5/2007
  TAG_SRC_SPEC: if cboList.ItemIEN <= 0
                  then InfoBox(TX_LS_SPEC, TC_LS_FAIL, MB_OK)
                  else x := 'S^' + IntToStr(cboList.ItemIEN) + U + U +
//                          'Specialty = ' + cboList.Text;  <-- original line.  //kt 9/5/2007
                            DKLangConstW('fPtSelOptns_Specialty_x') + cboList.Text; //kt added 9/5/2007
  TAG_SRC_CLIN: if (cboList.ItemIEN <= 0) or (Pos(';', cboDateRange.ItemID) = 0)
                  then InfoBox(TX_LS_CLIN, TC_LS_FAIL, MB_OK)
                  else
                    begin
//                    clinDefaults := 'Clinic = ' + cboList.Text + ',  ' + cboDaterange.text;  <-- original line.  //kt 9/5/2007
                      clinDefaults := DKLangConstW('fPtSelOptns_Clinic') + ' = ' + cboList.Text + DKLangConstW('fPtSelOptns_x') + cboDaterange.text; //kt added 9/5/2007
                      frmPtSelOptSave := TfrmPtSelOptSave.create(Application); // Calls dialogue form for user input.
                      frmPtSelOptSave.showModal;
                      frmPtSelOptSave.free;
                      if (not clinDoSave) then
                        Exit;
                      if clinSaveToday then
                        x := 'CT^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
//                          'Clinic = ' + cboList.Text + ',  ' +  cboDateRange.Text  <-- original line.  //kt 9/5/2007
                            DKLangConstW('fPtSelOptns_Clinic') + ' = ' + cboList.Text + DKLangConstW('fPtSelOptns_x') +  cboDateRange.Text //kt added 9/5/2007
                      else
                        x := 'C^' + IntToStr(cboList.ItemIEN) + U + cboDateRange.ItemID + U +
//                          'Clinic = ' + cboList.Text + ',  ' +  cboDateRange.Text;  <-- original line.  //kt 9/5/2007
                            DKLangConstW('fPtSelOptns_Clinic') + ' = ' + cboList.Text + DKLangConstW('fPtSelOptns_x') +  cboDateRange.Text; //kt added 9/5/2007
                    end;
  TAG_SRC_WARD: if cboList.ItemIEN <= 0
                  then InfoBox(TX_LS_WARD, TC_LS_FAIL, MB_OK)
                  else x := 'W^' + IntToStr(cboList.ItemIEN) + U + U +
//                          'Ward = ' + cboList.Text;  <-- original line.  //kt 9/5/2007
                            DKLangConstW('fPtSelOptns_Ward_x') + cboList.Text; //kt added 9/5/2007
  TAG_SRC_ALL : x := 'A';
  end;
  if (x <> '') then
    begin
      if not (FSrcType = TAG_SRC_CLIN) then // Clinics already have a "confirm" d-box.
        begin
          if (InfoBox(TX_LS_SAV1 + Piece(x, U, 4) + TX_LS_SAV2, TC_LS_SAVE, MB_YESNO) = IDYES) then
            begin
              SavePtListDflt(x);
              UpdateDefault;
            end;
        end
      else // Skip second confirmation box for clinics.
        begin
          SavePtListDflt(x);
          UpdateDefault;
        end;
    end;
end;

procedure TfrmPtSelOptns.FormCreate(Sender: TObject);
begin
  FLastDateIndex := -1;
end;

procedure TfrmPtSelOptns.SetDefaultPtList(Dflt: string);
begin
  if Length(Dflt) > 0 then                   // if default patient list available, use it
  begin
//  radDflt.Caption := '&Default: ' + Dflt;  <-- original line.  //kt 9/5/2007
    radDflt.Caption := DKLangConstW('fPtSelOptns_xDefaultx') + Dflt; //kt added 9/5/2007
    radDflt.Checked := True;                 // causes radHideSrcClick to be called
  end
  else                                       // otherwise, select from all patients
  begin
    radDflt.Enabled := False;
    radAll.Checked := True;                  // causes radHideSrcClick to be called
  end;
end;

procedure TfrmPtSelOptns.UpdateDefault;
begin
  FSrcType := TAG_SRC_DFLT;
  fPtSel.FDfltSrc := DfltPtList; // Server side default setting: "DfltPtList" is in rCore.
  fPtSel.FDfltSrcType := Piece(fPtSel.FDfltSrc, U, 2);
  fPtSel.FDfltSrc := Piece(fPtSel.FDfltSrc, U, 1);
  if (IsRPL = '1') then // Deal with restricted patient list users.
    fPtSel.FDfltSrc := '';
  SetDefaultPtList(fPtSel.FDfltSrc);
end;

end.