unit fGNPtSel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ORCtrls, ORDtTmRng, ExtCtrls, ComCtrls, Buttons, ORFn,
  rGroupNote,ORNet, ORDtTm, fPage, fMainFrame, uCore, uPCE;

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

  TfrmGNPtSel = class(TfrmPage)
    pnlTop: TPanel;
    pnlPtOptions: TPanel;
    lblDateRange: TLabel;
    grpPatient: TGroupBox;
    radProviders: TRadioButton;
    radTeams: TRadioButton;
    radSpecialties: TRadioButton;
    radClinics: TRadioButton;
    radWards: TRadioButton;
    radAll: TRadioButton;
    cboDateRange: TORComboBox;
    calApptRng: TORDateRangeDlg;
    pnlRight: TPanel;
    pnlGnPtInfo: TORAutoPanel;
    Memo: TCaptionMemo;
    lblSSN: TStaticText;
    lblPtSSN: TStaticText;
    lblDOB: TStaticText;
    lblPtDOB: TStaticText;
    lblPtSex: TStaticText;
    lblPtVet: TStaticText;
    lblPtSC: TStaticText;
    lblLocation: TStaticText;
    lblPtRoomBed: TStaticText;
    lblPtLocation: TStaticText;
    lblRoomBed: TStaticText;
    lblPtName: TStaticText;
    btnInquiry: TBitBtn;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    cboNewVisit: TORComboBox;
    Label2: TLabel;
    dtVisit: TORDateBox;
    pnlVeryBtm: TPanel;
    Splitter1: TSplitter;
    pnlBottom: TPanel;
    lvGnPtList: TListView;
    Label3: TLabel;
    cboPtProvider: TORComboBox;
    pnlPtSel: TPanel;
    lblPatient: TLabel;
    cboPatient: TORComboBox;
    Splitter3: TSplitter;
    Label4: TLabel;
    btnRemove: TButton;
    btnRemoveAll: TButton;
    cboList: TORComboBox;
    btnNext: TBitBtn;
    Panel1: TPanel;
    procedure radProvidersClick(Sender: TObject);
    procedure cboListNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure radTeamsClick(Sender: TObject);
    procedure radSpecialtiesClick(Sender: TObject);
    procedure radClinicsClick(Sender: TObject);
    procedure radWardsClick(Sender: TObject);
    procedure cboPatientNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure FormCreate(Sender: TObject);
    procedure cboListMouseClick(Sender: TObject);
    procedure radAllClick(Sender: TObject);
    procedure radDfltClick(Sender: TObject);
    procedure cboPatientChange(Sender: TObject);
    procedure cboPatientDblClick(Sender: TObject);
    procedure cboPatientClick(Sender: TObject);
    procedure btnInquiryClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure lvGnPtListDblClick(Sender: TObject);
    procedure btnRemoveAllClick(Sender: TObject);
    procedure lvGnPtListClick(Sender: TObject);
    procedure cboNewVisitNeedData(Sender: TObject; const StartFrom: String;
      Direction, InsertAt: Integer);
    procedure lvGnPtListColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvGnPtListCompare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure btnNextClick(Sender: TObject);
    procedure cboPtProviderNeedData(Sender: TObject;
      const StartFrom: String; Direction, InsertAt: Integer);
    procedure cboPatientKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure cboNewVisitChange(Sender: TObject);
    procedure dtVisitChange(Sender: TObject);
    procedure cboDateRangeExit(Sender: TObject);
    procedure cboDateRangeMouseClick(Sender: TObject);
    procedure cboNewVisitExit(Sender: TObject);
  private
    FLastTopList: string;
    FSrcType: Integer;
    FSetPtListTop: TSetPtListTopProc;
    FDfltSrc: string;
    FDfltSrcType: string;
    FLastDFN: string;
    FsortCol: integer;
    FsortAscending: boolean;
    FLastDateIndex: Integer;
    procedure HideDateRange;
    procedure ShowDateRange;
    procedure SetPtListTop(IEN: Int64);
    procedure ShowDemog(ItemID: string);
    procedure AddToGNPtList(APtData:TPatientData);
    procedure ClearIDInfo;
    function IsLast5(x: string): Boolean;
    function IsFullSSN(x: string): Boolean;
    function DupLastSSN(var DFN: string): Boolean;
    function DupPtInList(APtDFN: string): Boolean;
    function HasSelectedItem: boolean;
  public
    property LastTopList: string read FLastTopList write FLastTopList;
    property SrcType: Integer read FSrcType write FSrcType;
    property SetPtListTopProc: TSetPtListTopProc   read FSetPtListTop  write FSetPtListTop;
    procedure SetFontSize( FontSize: integer); override;
  end;

const
  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
  ALIASSTRING = ' -- ALIAS';
  TX_DGSR_ERR    = 'Unable to perform sensitive record checks';
  TC_DGSR_ERR    = 'Error';
  TC_DGSR_SHOW   = 'Restricted Record';
  TC_DGSR_DENY   = 'Access Denied';
  TX_DGSR_YESNO  = CRLF + 'Do you want to continue processing this patient record?';
  DLG_CANCEL = False;
  DGSR_FAIL = -1;
  DGSR_NONE =  0;
  DGSR_SHOW =  1;
  DGSR_ASK  =  2;
  DGSR_DENY =  3;

var
  frmGNPtSel: TfrmGNPtSel;
  IsRPL, RPLJob, DupDFN: string;
  RPLProblem: boolean;

implementation
{$R *.dfm}

uses fDupPts, fPtDemo, fGNEncounter, rPCE;

const
  TAG_HIDE     =  1;
  TAG_CLEAR    =  2;

procedure TfrmGNPtSel.radProvidersClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  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;
end;

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

procedure TfrmGNPtSel.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;
  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);
    end;
  cboList.Height := lblDateRange.Top - cboList.Top - 4;
  lblDateRange.Show;
  cboDateRange.Show;
end;

procedure TfrmGNPtSel.cboListNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
  case Self.SrcType of
  TAG_SRC_PROV: cboList.ForDataUse(SubSetOfProviders(StartFrom, Direction));
  TAG_SRC_CLIN: cboList.ForDataUse(SubSetOfClinics(StartFrom, Direction));
  end;
end;

procedure TfrmGNPtSel.radTeamsClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  HideDateRange;
  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;
end;

procedure TfrmGNPtSel.radSpecialtiesClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  HideDateRange;
  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;
end;

procedure TfrmGNPtSel.radClinicsClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  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;
end;

procedure TfrmGNPtSel.radWardsClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  HideDateRange;
  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;
end;

procedure TfrmGNPtSel.cboPatientNeedData(Sender: TObject; const StartFrom: string;
  Direction, InsertAt: Integer);
var
  i: Integer;
  NoAlias, ThePatient: String;
  PatientList: TStringList;
begin
  NoAlias := StartFrom;
  with Sender as TORComboBox do
  begin
    if Items.Count > ShortCount then
      NoAlias := Piece(Items[Items.Count-1], U, 1) + U + NoAlias;
  end;
  if pos(AliasString, NoAlias)> 0 then
    NoAlias := Copy(NoAlias, 1, pos(AliasString, NoAlias)-1);
  PatientList := TStringList.Create;
  try
    begin
      if (IsRPL  = '1') then
        PatientList.Assign(ReadRPLPtList(RPLJob, NoAlias, Direction))
      else
      begin
        PatientList.Assign(SubSetOfPatients(NoAlias, Direction));
        for i := 0 to PatientList.Count-1 do
        begin
          ThePatient := PatientList[i];
          if (Uppercase(Piece(ThePatient, U, 2)) <> Uppercase(Piece(ThePatient, U, 6))) then
          begin
            SetPiece(ThePatient, U, 2, Piece(ThePatient, U, 2) + AliasString);
            PatientList[i] := ThePatient;
          end;
        end;
      end;
      cboPatient.ForDataUse(PatientList);
    end;
  finally
    PatientList.Free;
  end;
end;

procedure TfrmGNPtSel.FormCreate(Sender: TObject);
var
  i : integer;
  PtAdmit, PtDob: string;
  AdmitDT: TDateTime;
  AnItem: TListItem;
  APtData: TPatientData;
begin
  RPLProblem := false;
  FDfltSrc := DfltPtList;
  FDfltSrcType := Piece(FDfltSrc, U, 2);
  FDfltSrc := Piece(FDfltSrc, U, 1);
  FLastDateIndex := -1;  
  if (IsRPL = '1') then             // Deal with restricted patient list users.
    FDfltSrc := '';
  ClearIDInfo;
  if RPLProblem then exit;
  if (IsRPL = '1') then             // Deal with restricted patient list users.
    pnlPtOptions.Visible := False;  // Removes unnecessary components from view.
  if not Assigned(GNPtList) then
    GNPtList := TList.Create;
  if (GNPtList.Count > 0) then
  begin
    for i := 0 to GNPtList.Count - 1 do
    begin
      APtData := TPatientData(GNPtList.Items[i]);
      ptDob := '';
      if (APtData.Patient.DOB > 0) then
      begin
        ptDob := FloatToStr(APtData.Patient.DOB);
        if IsFMDate(ptDob) then ptDob := FormatFMDateTimeStr('mmm dd,yyyy', ptDob);
      end;
      PtAdmit := '';
      if (APtData.Patient.AdmitTime > 0) then
      begin
        AdmitDT := FMDateTimeToDateTime(APtData.Patient.AdmitTime);
        PtAdmit := DateToStr(AdmitDT);
      end;
      AnItem := lvGNPtList.Items.Add;
      AnItem.Data := APtData;
      AnItem.Caption := APtData.Patient.Name;
      AnItem.SubItems.Add(APtData.Patient.SSN);
      AnItem.SubItems.Add(IntToStr(APtData.Patient.Age));
      AnItem.SubItems.Add(APtData.Patient.Sex);
      AnItem.SubItems.Add(lblPtLocation.Caption);
      AnItem.SubItems.Add(PtAdmit);
      AnItem.SubItems.Add(APtData.Patient.PrimaryTeam);
      AnItem.SubItems.Add(APtData.Patient.PrimaryProvider);
    end;
  end;
  if (lvGNPtList.Items.Count>0) and (not btnRemove.Enabled) then
    btnRemoveAll.Enabled := True;
  cboNewVisit.LongList := True;
  cboNewVisit.InitLongList('');
  if (Encounter.Location > 0) then
    cboNewVisit.SelectByIEN(Encounter.Location);
  cboPtProvider.LongList := True;
  cboPtProvider.InitLongList(Encounter.ProviderName);
  cboPtProvider.SelectByIEN(Encounter.Provider);
  dtVisit.FMDateTime := FMNow;
  cboList.Visible := False;
  lblDateRange.Hide;
  cboDateRange.Hide;
end;

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

procedure TfrmGNPtSel.SetPtListTop(IEN: Int64);
var
  NewTopList: string;
  FirstDate, LastDate: string;
begin
  IsRPL := User.IsRPL;
  if (IsRPL = '') then
  begin
    InfoBox('Patient selection list flag not set.', 'Incomplete User Information', MB_OK);
    RPLProblem := true;
    exit;
  end;
  cboPatient.pieces := '2,3'; // This line and next: defaults set - exceptions modifield next.
  cboPatient.tabPositions := '20,28';
  if ((Self.SrcType = TAG_SRC_DFLT) and (FDfltSrc = 'Combination')) then
  begin
    cboPatient.pieces := '2,3,4,5,9';
    cboPatient.tabPositions := '20,28,35,45';
  end;
  if ((Self.SrcType = TAG_SRC_DFLT) and
      (FDfltSrcType = 'Ward')) or (Self.SrcType = TAG_SRC_WARD) then
    cboPatient.tabPositions := '35';
  if ((Self.SrcType = TAG_SRC_DFLT) and
      (AnsiStrPos(pChar(FDfltSrcType), 'Clinic') <> nil)) or (Self.SrcType = TAG_SRC_CLIN) then
  begin
    cboPatient.pieces := '2,3';
    cboPatient.tabPositions := '24,45';
  end;
  NewTopList := IntToStr(Self.SrcType) + U + IntToStr(IEN); // Default setting.
  if (Self.SrcType = TAG_SRC_CLIN) then with Self.cboDateRange do
  begin
    if ItemID = '' then Exit;                        // Need both clinic & date range.
    FirstDate := Piece(ItemID, ';', 1);
    LastDate  := Piece(ItemID, ';', 2);
    NewTopList := IntToStr(Self.SrcType) + U + IntToStr(IEN) + U + ItemID; // Modified for clinics.
  end;
  if NewTopList = Self.LastTopList then Exit; // Only continue if new top list.
  Self.LastTopList := NewTopList;
  RedrawSuspend(cboPatient.Handle);
  ClearIDInfo;
  cboPatient.ClearTop;
  cboPatient.Text := '';
  if (IsRPL = '1') then                                // Deal with restricted patient list users.
  begin
    RPLJob := MakeRPLPtList(User.RPLList);           // MakeRPLPtList is in rCore, writes global "B" x-ref list.
    if (RPLJob = '') then
      begin
        InfoBox('Assignment of valid OE/RR Team List Needed.', 'Unable to build Patient List', MB_OK);
        RPLProblem := true;
        exit;
      end;
  end  else
  begin
    case Self.SrcType of
    TAG_SRC_DFLT: ListPtByDflt(cboPatient.Items);
    TAG_SRC_PROV: ListPtByProvider(cboPatient.Items, IEN);
    TAG_SRC_TEAM: ListPtByTeam(cboPatient.Items, IEN);
    TAG_SRC_SPEC: ListPtBySpecialty(cboPatient.Items, IEN);
    TAG_SRC_CLIN: ListPtByClinic(cboPatient.Items, cboList.ItemIEN, FirstDate, LastDate);
    TAG_SRC_WARD: ListPtByWard(cboPatient.Items, IEN);
    TAG_SRC_ALL:  ListPtTop(cboPatient.Items);
    end;
  end;
  if cboList.Visible then
    lblPatient.Caption := 'Patients (' + cboList.Text + ')'
  else if radAll.Checked then
    lblPatient.Caption := 'Patients (all)';
  with cboPatient do if ShortCount > 0 then
  begin
    Items.Add(LLS_LINE);
    Items.Add(LLS_SPACE);
  end;
  cboPatient.Caption := lblPatient.Caption;
  cboPatient.InitLongList('');
  RedrawActivate(cboPatient.Handle);
end;

procedure TfrmGNPtSel.radAllClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  cboList.Visible := False;
  FLastTopList := '';
  HideDateRange;
  SetPtListTop(0);
end;

procedure TfrmGNPtSel.radDfltClick(Sender: TObject);
begin
  cboList.Pieces := '2';
  FSrcType := TControl(Sender).Tag;
  FLastTopList := '';
  HideDateRange;
  cboList.Visible := False;
  cboList.Caption := TRadioButton(Sender).Caption;
end;

procedure TfrmGNPtSel.ShowDemog(ItemID: string);
{ gets a record of patient indentifying information from the server and displays it }
var
  PtRec: TPtIDInfo;
  i: Integer;
begin
  if ItemID = FLastDFN then Exit;
  if (StrToInt64Def(ItemID, 0)<1) then exit;
  pnlGNPtInfo.BevelOuter := bvRaised;
  Memo.Clear;
  FLastDFN := ItemID;
  Memo.Hint := ItemID;
  PtRec := GetPtIDInfo(ItemID);
  with PtRec do
  begin
    Memo.Lines.Add(Name);
    Memo.Lines.Add(lblSSN.Caption + ' ' + SSN + '.');
    Memo.Lines.Add(lblDOB.Caption + ' ' + DOB + '.');
    if Sex <> '' then
      Memo.Lines.Add(Sex + '.');
    if Vet <> '' then
      Memo.Lines.Add(Vet + '.');
    if SCsts <> '' then
      Memo.Lines.Add(SCsts + '.');
    if Location <> '' then
      Memo.Lines.Add(lblLocation.Caption + ' ' + Location + '.');
    if RoomBed <> '' then
      Memo.Lines.Add(lblRoomBed.Caption + ' ' + RoomBed + '.');

    lblPtName.Caption     := Name;
    lblPtSSN.Caption      := SSN;
    lblPtDOB.Caption      := DOB;
    lblPtSex.Caption      := Sex {+ ', age ' + Age};
    lblPtSC.Caption       := SCSts;
    lblPtVet.Caption      := Vet;
    lblPtLocation.Caption := Location;
    lblPtRoomBed.Caption  := RoomBed;
  end;
  with pnlGnPtInfo do for i := 0 to ControlCount - 1 do
    if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := True;
  if lblPtLocation.Caption = '' then
    lblLocation.Hide
  else
    lblLocation.Show;
  if lblPtRoomBed.Caption = ''  then
    lblRoomBed.Hide
  else
    lblRoomBed.Show;
  Memo.SelectAll;
  btnInquiry.Visible := True;
end;

procedure TfrmGNPtSel.ClearIDInfo;
var
  i: Integer;
begin
  FLastDFN := '';
  with pnlGnPtInfo do
  for i := 0 to ControlCount - 1 do
  begin
    if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := False;
    if Controls[i].Tag = TAG_CLEAR then with Controls[i] as TStaticText do Caption := '';
  end;
  pnlGNPtInfo.BevelOuter := bvNone;
  Memo.Clear;
  Memo.Hint := '';
  btnInquiry.Visible := false;
end;

procedure TfrmGNPtSel.cboPatientChange(Sender: TObject);

  procedure ShowMatchingPatients;
  begin
    with cboPatient do
    begin
      ClearIDInfo;
      if ShortCount > 0 then
      begin
        if ShortCount = 1 then
        begin
          ItemIndex := 0;
          ShowDemog(cboPatient.ItemID);
        end;
        Items.Add(LLS_LINE);
        Items.Add(LLS_SPACE);
      end;
      InitLongList('');
    end;
  end;

begin
  with cboPatient do
  begin
    if IsLast5(Text) then
    begin
      if (IsRPL = '1') then ListPtByRPLLast5(Items, Text)
      else ListPtByLast5(Items, Text);
      ShowMatchingPatients;
    end
    else if IsFullSSN(Text) then
    begin
      if (IsRPL = '1') then ListPtByRPLFullSSN(Items, Text)
      else ListPtByFullSSN(Items, Text);
      ShowMatchingPatients;
    end;
  end;
end;

function TfrmGNPtSel.IsLast5(x: string): Boolean;
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 TfrmGNPtSel.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:  for i := 1 to 9 do if not (x[i] in ['0'..'9']) then Exit;
   10:  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:  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:  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;

function TfrmGNPtSel.DupLastSSN(var DFN: string): Boolean;
var
  i: integer;
  PtStrs: TStringList;
begin
  Result := False;
  CallV('DG CHK BS5 XREF ARRAY', [DFN]);
  if (RPCBrokerV.Results[0] <> '1') then
    Exit;
  Result := True;
  PtStrs := TStringList.Create;
  with RPCBrokerV do if Results.Count > 0 then
  begin
    for i := 1 to Results.Count - 1 do
    begin
      if Piece(Results[i], U, 1) = '1' then
        PtStrs.Add(Piece(Results[i], U, 2) + U + Piece(Results[i], U, 3) + U +
                   FormatFMDateTimeStr('mmm dd,yyyy', Piece(Results[i], U, 4)) + U +
                   Piece(Results[i], U, 5));
    end;
  end;
  SelectDupPt(DFN,PtStrs);
end;

procedure TfrmGNPtSel.cboPatientDblClick(Sender: TObject);
var
  NewDFN, AMsg: string;
  AccessStatus: Integer;
  DateDied: TFMDateTime;
  APtData: TPatientData;
begin
  ShowDemog(cboPatient.ItemID);
  NewDFN := cboPatient.ItemID;
  if StrToInt64Def(NewDFN,0) < 1 then
    Exit;
  if DupLastSSN(NewDFN) then
    if ( Length(NewDFN)=0 ) then Exit;
  CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg);
  if AccessStatus = DGSR_ASK then btnInquiry.Enabled := False
  else btnInquiry.Enabled := True;
  case AccessStatus of
  DGSR_FAIL: begin
               InfoBox(TX_DGSR_ERR, TC_DGSR_ERR, MB_OK);
               Exit;
             end;
  DGSR_NONE: { Nothing - allow access to the patient. };
  DGSR_SHOW: InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
  DGSR_ASK:  if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
               MB_DEFBUTTON2) = IDYES then
               begin
                LogSensitiveRecordAccess(NewDFN);
                btnInquiry.Enabled := True;
               end else Exit;
  else       begin
               InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
               Exit;
             end;
  end;
  DateDied := DateOfDeath(NewDFN);
  if (DateDied > 0) and
    (InfoBox('This patient died ' + FormatFMDateTime('mmm dd,yyyy hh:nn', DateDied) + CRLF +
     'Do you wish to continue?', 'Deceased Patient', MB_YESNO or MB_DEFBUTTON2) = ID_NO)
     then Exit;
  APtData := TPatientData.Create;
  APtData.PCEData := TPCEData.Create;
  APtData.Patient.DFN := NewDFN;
  AddToGNPtList(APtData);
end;

procedure TfrmGNPtSel.cboPatientClick(Sender: TObject);
var
  NewDFN, AMsg: string;
  AccessStatus: Integer;
  DateDied: TFMDateTime;
  APtData: TPatientData;
begin
  ShowDemog(cboPatient.ItemID);
  NewDFN := cboPatient.ItemID;
  if StrToInt64Def(NewDFN,0) < 1 then
    Exit;
  if DupLastSSN(NewDFN) then
    if ( Length(NewDFN)=0 ) then Exit;
  CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg);
  if AccessStatus = DGSR_ASK then btnInquiry.Enabled := False
  else btnInquiry.Enabled := True;
  case AccessStatus of
  DGSR_FAIL: begin
               InfoBox(TX_DGSR_ERR, TC_DGSR_ERR, MB_OK);
               Exit;
             end;
  DGSR_NONE: { Nothing - allow access to the patient. };
  DGSR_SHOW: InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
  DGSR_ASK:  if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
               MB_DEFBUTTON2) = IDYES then
             begin
               LogSensitiveRecordAccess(NewDFN);
               btnInquiry.Enabled := True;
             end else Exit;
  else       begin
               InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
               Exit;
             end;
  end;
  DateDied := DateOfDeath(NewDFN);
  if (DateDied > 0) and
    (InfoBox('This patient died ' + FormatFMDateTime('mmm dd,yyyy hh:nn', DateDied) + CRLF +
     'Do you wish to continue?', 'Deceased Patient', MB_YESNO or MB_DEFBUTTON2) = ID_NO)
     then Exit;
  APtData := TPatientData.Create;
  APtData.PCEData := TPCEData.Create;
  APtData.Patient.DFN := NewDFN;
  AddToGNPtList(APtData);
end;

procedure TfrmGNPtSel.AddToGNPtList(APtData:TPatientData);
var
  AnItem: TListItem;
  AdmitDT: TDateTime;
  ptDob,ptAdmit: string;
begin
  if DupPtInList(APtData.Patient.DFN) then exit;
  ptDob := '';
  if (APtData.Patient.DOB > 0) then
  begin
    ptDob := FloatToStr(APtData.Patient.DOB);
    if IsFMDate(ptDob) then ptDob := FormatFMDateTimeStr('mmm dd,yyyy', ptDob);
  end;
  PtAdmit := '';
  if (APtData.Patient.AdmitTime > 0) then
  begin
    AdmitDT := FMDateTimeToDateTime(APtData.Patient.AdmitTime);
    PtAdmit := DateToStr(AdmitDT);
  end;
  AnItem := lvGNPtList.Items.Add;
  AnItem.Data := APtData;
  AnItem.Caption := APtData.Patient.Name;
  AnItem.SubItems.Add(APtData.Patient.SSN);
  AnItem.SubItems.Add(IntToStr(APtData.Patient.Age));
  AnItem.SubItems.Add(APtData.Patient.Sex);
  AnItem.SubItems.Add(lblPtLocation.Caption);
  AnItem.SubItems.Add(PtAdmit);
  AnItem.SubItems.Add(APtData.Patient.PrimaryTeam);
  AnItem.SubItems.Add(APtData.Patient.PrimaryProvider);
  GnPtList.Add(APtData);
  if (lvGNPtList.Items.Count>0) and (not btnRemove.Enabled) then
    btnRemoveAll.Enabled := True;
end;

procedure TfrmGNPtSel.btnInquiryClick(Sender: TObject);
begin
  PatientInquiry(Memo.Hint);
end;

function TfrmGNPtSel.DupPtInList(APtDFN: string): Boolean;
var
  i: integer;
  APatient: TPatient;
begin
  Result := False;
  for i := 0 to (lvGnPtList.Items.Count - 1) do
  begin
    APatient := TPatientData(lvGnPtList.Items[i].Data).Patient;
    if APatient.DFN = APtDFN then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure TfrmGNPtSel.btnAddClick(Sender: TObject);
var
  NewDFN, AMsg: string;
  AccessStatus: Integer;
  DateDied: TFMDateTime;
  APtData: TPatientData;
begin
  NewDFN := cboPatient.ItemID;
  if StrToInt64Def(NewDFN,0) < 1 then
    Exit;
  if DupLastSSN(NewDFN) then
    if ( Length(NewDFN)=0 ) then Exit;
  CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg);
  if AccessStatus = DGSR_ASK then btnInquiry.Enabled := False
  else btnInquiry.Enabled := True;
  case AccessStatus of
  DGSR_FAIL: begin
               InfoBox(TX_DGSR_ERR, TC_DGSR_ERR, MB_OK);
               Exit;
             end;
  DGSR_NONE: { Nothing - allow access to the patient. };
  DGSR_SHOW: InfoBox(AMsg, TC_DGSR_SHOW, MB_OK);
  DGSR_ASK:  if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or
               MB_DEFBUTTON2) = IDYES then
               begin
                LogSensitiveRecordAccess(NewDFN);
                btnInquiry.Enabled := True;
               end else Exit;
  else       begin
               InfoBox(AMsg, TC_DGSR_DENY, MB_OK);
               Exit;
             end;
  end;
  DateDied := DateOfDeath(NewDFN);
  if (DateDied > 0) and
    (InfoBox('This patient died ' + FormatFMDateTime('mmm dd,yyyy hh:nn', DateDied) + CRLF +
     'Do you wish to continue?', 'Deceased Patient', MB_YESNO or MB_DEFBUTTON2) = ID_NO)
     then Exit;
  APtData := TPatientData.Create;
  APtData.Patient.DFN := NewDFN;
  AddToGNPtList(APtData);
end;

procedure TfrmGNPtSel.btnRemoveClick(Sender: TObject);
var
  idx,idy: integer;
begin
  if not hasSelectedItem then
  begin
    InfoBox('There is no selected patient', 'Warning', MB_OK or MB_ICONWARNING);
    Exit;
  end;
  for idx := 0 to lvGNPtList.Items.Count - 1 do
  begin
    if lvGNPtList.Items[idx].Selected  then
    begin
      idy := GNPtList.IndexOf(lvGNPtList.Items[idx].Data);
      if idy >= 0 then
      begin
        TPatient(GNPtList.Items[idy]).Free;
        GNPtList.Delete(idy);
      end;
    end;
  end;
  lvGnPtList.DeleteSelected;
  if (lvGnPtList.Items.Count = 0) then
  begin
    btnRemove.Enabled := False;
    btnRemoveall.Enabled := False;
  end;
end;

procedure TfrmGNPtSel.lvGnPtListDblClick(Sender: TObject);
begin
  btnRemoveClick(Self);
end;

procedure TfrmGNPtSel.btnRemoveAllClick(Sender: TObject);
begin
  btnRemove.Enabled := False;
  btnRemoveall.Enabled := False;
  if (lvGnPtlist.Items.Count = 0) then
    Exit;
  lvGnPtList.Items.Clear;
  CleanGNPtList;
end;

procedure TfrmGNPtSel.lvGnPtListClick(Sender: TObject);
begin
  btnRemove.Enabled := hasSelectedItem;
end;

function TfrmGNPtSel.HasSelectedItem: boolean;
var
  idx: integer;
begin
  Result := False;
  for idx := 0 to lvGNPtList.Items.Count - 1 do
  begin
    if lvGNPtList.Items[idx].Selected  then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure TfrmGNPtSel.cboNewVisitNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
  inherited;
  cboNewVisit.ForDataUse(SubSetOfNewLocs(StartFrom, Direction));
end;

procedure TfrmGNPtSel.lvGnPtListColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  if ((FsortCol = Column.Index))  then
        FsortAscending := not FsortAscending;
  FsortCol := Column.Index;
  lvGnPtList.AlphaSort;
end;

procedure TfrmGNPtSel.lvGnPtListCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
begin
  if not(Sender is TListView) then Exit;
  if FsortAscending then
    begin
      if FsortCol = 0 then Compare := CompareStr(Item1.Caption, Item2.Caption)
      else Compare := CompareStr(Item1.SubItems[FsortCol - 1], Item2.SubItems[FsortCol - 1]);
    end
  else
    begin
      if FsortCol = 0 then Compare := CompareStr(Item2.Caption, Item1.Caption)
      else Compare := CompareStr(Item2.SubItems[FsortCol - 1], Item1.SubItems[FsortCol - 1]);
    end;
end;

procedure TfrmGNPtSel.SetFontSize(FontSize: integer);
begin
  inherited;

end;

procedure TfrmGNPtSel.btnNextClick(Sender: TObject);
begin
  inherited;
  if lvGNPtList.Items.Count = 0 then
  begin
    MessageDlg(TXT_NOSELECT, mtWarning, [mbOK], 0);
    Exit;
  end;
  inherited;
  if trim(cboNewVisit.Text) = '' then
    cboNewvisit.ItemIndex := -1;
  if (cboNewVisit.ItemIndex > -1) then
  begin
    Encounter.Location := cboNewVisit.ItemIEN;
    Encounter.LocationName := cboNewVisit.Text;
    Encounter.VisitCategory := GetVisitCat('A', Encounter.Location, False);
  end
  else begin
    Encounter.Location := 0;
    Encounter.LocationName := '';
  end;
  if dtVisit.FMDateTime > 0 then
    Encounter.DateTime := dtVisit.FMDateTime;
  if cboPtProvider.ItemIEN > 0 then
  begin
    Encounter.Provider := cboPtProvider.ItemIEN;
    Encounter.ProviderName := cboPtProvider.Text;
  end;
  frmMainFrame.SwitchTo(frmGnEncounter, PG_GNECTER);
  StartOver := False;
end;

procedure TfrmGNPtSel.cboPtProviderNeedData(Sender: TObject;
  const StartFrom: String; Direction, InsertAt: Integer);
begin
  inherited;
  cboPtProvider.ForDataUse(SubSetOfProviders(StartFrom, Direction));
end;

procedure TfrmGNPtSel.cboPatientKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = VK_RETURN then
    cboPatientDblClick(Sender);
end;

procedure TfrmGNPtSel.FormShow(Sender: TObject);
begin
  inherited;
  if StartOver then lvGNPtList.Items.Clear;
  radAll.Checked := True;
end;

procedure TfrmGNPtSel.FormResize(Sender: TObject);
begin
  inherited;
  btnRemoveAll.Left := pnlBottom.Width - btnRemoveAll.Width - 4;
  btnRemove.Left := btnRemoveAll.Left - btnRemove.Width - 2;
  //btnNext.Left := pnlVeryBtm.Width - btnNext.Width - 8;
end;

procedure TfrmGNPtSel.cboNewVisitChange(Sender: TObject);
begin
  inherited;
{  if not IsValidLocation(cboNewVisit.ItemIEN) then
  begin
    ShowMessage('Invalid location for Group Notes.');
    cboNewVisit.ItemIndex := -1;
    Exit;
  end;}
end;

procedure TfrmGNPtSel.dtVisitChange(Sender: TObject);
begin
  inherited;
  if dtVisit.FMDateTime > FMNow then
  begin
{$IFDEF ICD10DEBUG}
    ///
    /// TEST ONLY; allow Encounters with an ICD-10 date >= FMNow.
    ///
    if bICD10Debug then
      MessageDlg('Future date/time is being used.'+#13#10+
        '(DEBUG version only)', mtInformation, [mbOK], 0)
    else
      begin
        MessageDlg('Future date/time is not allowed', mtWarning,[mbOK],0);
        dtVisit.FMDateTime := FMNow;
      end;
{$ELSE}
    MessageDlg('Future date/time is not allowed', mtWarning, [mbOK], 0);
    dtVisit.FMDateTime := FMNow;
{$ENDIF}
  end;
end;

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

procedure TfrmGNPtSel.cboDateRangeMouseClick(Sender: TObject);
begin
  inherited;
  if (cboDateRange.ItemID = 'S') then
  begin
    with calApptRng do if Execute
      then cboDateRange.ItemIndex := cboDateRange.Items.Add(RelativeStart + ';' +
           RelativeStop + U + TextOfStart + ' to ' + TextOfStop)
      else cboDateRange.ItemIndex := -1;
  end;
  FLastDateIndex := cboDateRange.ItemIndex;
  if cboList.ItemIEN > 0 then SetPtListTop(cboList.ItemIEN);
end;

procedure TfrmGNPtSel.cboNewVisitExit(Sender: TObject);
begin
  inherited;
  if cboNewVisit.ItemIEN < 1 then
    Exit;
  {if not IsValidLocation(cboNewVisit.ItemIEN) then
  begin
    ShowMessage('Invalid location for Group Notes.');
    cboNewVisit.ItemIndex := -1;
    cboNewVisit.SetFocus;
  end;}
end;

end.
