unit fPtAdd;
//kt  This entire module and form was added.  Coded by Eddie Hagood 10/2007

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Trpcb, mfunstr, ORNet, uCore, ExtCtrls, StrUtils,
  Buttons;

type
  TPatientInfo = class(TObject)
  public
    LName: String;
    FName: String;
    MName: String;
    CombinedName: String;
    Suffix: String;
    DOB: String;
    Sex: String;
    SSNum: String;
    PtType: String;
    Veteran: String;
    procedure ClearArray;
  end;
  
  TfrmPtAdd = class(TForm)
    LNameLabel: TLabel;
    SexComboBox: TComboBox;
    SSNumEdit: TEdit;
    DOBEdit: TEdit;
    SuffixEdit: TEdit;
    MNameEdit: TEdit;
    FNameEdit: TEdit;
    LNameEdit: TEdit;
    FNameLabel: TLabel;
    MNameLabel: TLabel;
    SuffixLabel: TLabel;
    DOBLabel: TLabel;
    SSNumLabel: TLabel;
    SexLabel: TLabel;
    PrefixLabel: TLabel;
    PtTypeComboBox: TComboBox;
    VeteranCheckBox: TCheckBox;
    OkButton: TButton;
    CloseButton: TButton;
    Label1: TLabel;
    SSNHelpBtn: TSpeedButton;
    Label2: TLabel;
    procedure OnShow(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure OkButtonClick(Sender: TObject);
    procedure LNameEditChange(Sender: TObject);
    procedure FNameEditChange(Sender: TObject);
    procedure DOBEditChange(Sender: TObject);
    procedure SSNumEditChange(Sender: TObject);
    procedure SexComboBoxChange(Sender: TObject);
    procedure MNameEditChange(Sender: TObject);
    procedure SuffixEditChange(Sender: TObject);
    procedure PtTypeComboBoxChange(Sender: TObject);
    procedure VeteranCheckBoxClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SSNumEditExit(Sender: TObject);
    procedure SSNumEditKeyPress(Sender: TObject; var Key: Char);
    procedure DOBEditKeyPress(Sender: TObject; var Key: Char);
    procedure LNameEditKeyPress(Sender: TObject; var Key: Char);
    procedure FNameEditKeyPress(Sender: TObject; var Key: Char);
    procedure MNameEditKeyPress(Sender: TObject; var Key: Char);
    procedure SuffixEditKeyPress(Sender: TObject; var Key: Char);
    procedure SexComboBoxKeyPress(Sender: TObject; var Key: Char);
    procedure PtTypeComboBoxKeyPress(Sender: TObject; var Key: Char);
    procedure FormDestroy(Sender: TObject);
    procedure DOBEditExit(Sender: TObject);
    procedure SSNHelpBtnClick(Sender: TObject);
  private
    { Private declarations }
    ThisPatientInfo: TPatientInfo;
    ProgModSSNum : boolean;
    procedure ResetColors();
    procedure ResetFields();
    procedure TestUserInput();
    procedure DataToArray();
    procedure CreatePSSN();
    procedure PostInfo(ThisPatientInfo : TPatientInfo);
    function FrmtSSNum(SSNumStr : string) : string;
    function UnFrmtSSNum(SSNumStr : string) : string;
    function SSNumInvalid(SSNumStr: string) : boolean;
  public
    { Public declarations }
    DFN: Int64;
  end;

var
  frmPtAdd: TfrmPtAdd; 

implementation

uses fPtSel;

{$R *.dfm}

var
  boolErrorFound: boolean; 
  boolDirtyForm: boolean;

procedure TfrmPtAdd.OnShow(Sender: TObject);
begin
  LNameEdit.SetFocus;
  PtTypeComboBox.Text := 'NON-VETERAN (OTHER)';
  ResetColors;
  ResetFields;
  ThisPatientInfo.ClearArray;
  boolDirtyForm := False;
  DFN := -1;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.CancelButtonClick(Sender: TObject);
begin
  if (boolDirtyForm = True) then begin
    if MessageDlg('** Patient Not Yet Added **'+#10+#13+
                  'ADD this patient before exiting?', 
                   mtWarning, [mbYes, mbNo],0) = mrYes then begin
      OkButtonClick(self);
    end else begin
      modalresult:=1;
    end;       
  end else begin
    modalresult:=1;
  end;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.ResetColors();
begin
  LNameEdit.Color := clWindow;
  FNameEdit.Color := clWindow;
  DOBEdit.Color := clWindow;
  SSNumEdit.Color := clWindow;
  SexComboBox.Color := clWindow;        
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.ResetFields();
begin
  LNameEdit.text := '';
  FNameEdit.text := '';
  MNameEdit.text := '';
  SuffixEdit.Text := '';
  PtTypeComboBox.Text := 'NON-VETERAN (OTHER)';
  DOBEdit.text := '';
  SSNumEdit.text := '';
  SexComboBox.text := '<Sex>'; 
  Label1.Visible := False;
  Label1.Caption := '';
  VeteranCheckbox.Checked := False;       
end;
//------------------------------------------------------------------------

procedure TfrmPtAdd.OkButtonClick(Sender: TObject);

begin
  TestUserInput;
  if boolErrorFound = False then begin
    DataToArray;    
    PostInfo(ThisPatientInfo);
    boolDirtyForm := False;
    ThisPatientInfo.ClearArray;
    modalresult:=1;
  end else begin
    label1.Caption := 'Needs: ' + label1.caption;
    label1.Visible := True;
  end;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.LNameEditChange(Sender: TObject);
begin
  ResetColors;
  ThisPatientInfo.LName := LNameEdit.Text;
  boolDirtyForm := True;
  label1.Visible := False;
  if Pos('P',SSNumEdit.Text) > 0 then begin
    CreatePSSN();
  end;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.FNameEditChange(Sender: TObject);
begin
  ResetColors;
  ThisPatientInfo.FName := FNameEdit.Text;
  boolDirtyForm := True;
  label1.Visible := False;
  if Pos('P',SSNumEdit.Text) > 0 then begin
    CreatePSSN();
  end;
end;
//------------------------------------------------------------------------    
procedure TfrmPtAdd.MNameEditChange(Sender: TObject);
begin
  ThisPatientInfo.MName := MNameEdit.Text;
  boolDirtyForm := True;
  label1.Visible := False;
  if Pos('P',SSNumEdit.Text) > 0 then begin
    CreatePSSN();
  end;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.DOBEditChange(Sender: TObject);
begin
  ResetColors;
  label1.Visible := False;
  ThisPatientInfo.DOB := DOBEdit.Text;
  if Pos('P',SSNumEdit.Text) > 0 then begin
    CreatePSSN();
  end;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.SSNumEditChange(Sender: TObject);
begin
  if ProgModSSNum = false then begin
    ResetColors;
    ThisPatientInfo.SSNum := UnFrmtSSNum(SSNumEdit.Text);
    //ProgModSSNum := true;
    //SSNumEdit.Text := FrmtSSNum(ThisPatientInfo.SSNum);
    //ProgModSSNum := false;
    boolDirtyForm := True;
    label1.Visible := False;
  end;  
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.SexComboBoxChange(Sender: TObject);
begin
  ResetColors;
  ThisPatientInfo.Sex  := SexComboBox.Text;
  boolDirtyForm := True;
  label1.Visible := False;
end;
//------------------------------------------------------------------------

procedure TfrmPtAdd.TestUserInput();
begin
  boolErrorFound := False;
  label1.caption := '';
  label1.Visible := False;
  ResetColors;

  if SSNumInvalid(ThisPatientInfo.SSNum) then begin
    if MessageDlg('Invalid SSN. Would you like to use a pseudo-SSN?', mtConfirmation, [mbYes, mbNo],0) = mrYes then begin
       SSNumEdit.Text := 'p';
    end else begin   
       label1.Caption := label1.Caption + 'SSN,';
       boolErrorFound := True;
       SSNumEdit.Color := clYellow;
    end; 
  end;  
  
  if LNameEdit.Text = '' then begin
    label1.Caption := 'Last Name,';
    boolErrorFound := True;
    LNameEdit.Color := clYellow;
  end;
  if FNameEdit.Text = '' then begin
    label1.Caption := label1.Caption + 'First Name,';
    boolErrorFound := True;
    FNameEdit.Color := clYellow;
  end;  
  if DOBEdit.Text = '' then begin
    label1.Caption := label1.Caption + 'DOB,';
    boolErrorFound := True;
    DOBEdit.Color := clYellow;
  end;  
     
  if SexComboBox.Text = '<Sex>' then begin
    label1.Caption := label1.Caption + 'Gender';
    boolErrorFound := True;
    SexComboBox.Color := clYellow;
  end;
     
end; 
//------------------------------------------------------------------------
procedure TfrmPtAdd.DataToArray();
   
begin
  ThisPatientInfo.ClearArray; 
  ThisPatientInfo.LName := LNameEdit.Text;
  ThisPatientInfo.FName := FNameEdit.Text;
  ThisPatientInfo.MName := MNameEdit.Text;
  ThisPatientInfo.Suffix  := SuffixEdit.Text;
  ThisPatientInfo.DOB := DOBEdit.Text;
  ThisPatientInfo.Sex := SexComboBox.Text;

  if Uppercase(SSNumEdit.Text) = 'P' then begin
    CreatePSSN;
  end else begin  
    ThisPatientInfo.SSNum := UnFrmtSSNum(SSNumEdit.Text);
  end;

  ThisPatientInfo.PtType := PtTypeComboBox.Text;
  if VeteranCheckBox.Checked = True then ThisPatientInfo.Veteran := 'True' else ThisPatientInfo.Veteran := 'False';
      
end;            
//------------------------------------------------------------------------
procedure TPatientInfo.ClearArray;
begin
  LName := '';
  FName := '';
  MName := '';
  Suffix := '';
  DOB := '';
  Sex := '';
  SSNum := '';
  PtType := '';
  Veteran := '';
end; 
//------------------------------------------------------------------------
procedure TfrmPtAdd.SuffixEditChange(Sender: TObject);
begin
  ThisPatientInfo.Suffix := SuffixEdit.Text;
  boolDirtyForm := True;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.PtTypeComboBoxChange(Sender: TObject);
begin
  ThisPatientInfo.PtType := PtTypeComboBox.Text;
  boolDirtyForm := True;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.VeteranCheckBoxClick(Sender: TObject);
begin
  if VeteranCheckBox.Checked = True then ThisPatientInfo.Veteran := 'True' else ThisPatientInfo.Veteran := 'False';
  boolDirtyForm := True;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.FormCreate(Sender: TObject);
begin
  ThisPatientInfo := TPatientInfo.Create;
  DFN := -1;
  ProgModSSNum := false;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.SSNumEditExit(Sender: TObject);
begin
  ProgModSSNum := true;
  SSNumEdit.Text := FrmtSSNum(ThisPatientInfo.SSNum);
  ProgModSSNum := false;

  if (SSNumInvalid(ThisPatientInfo.SSNum)) and (SSNumEdit.Text <>'') then begin
    label1.Caption := 'SSN not correct length';
    label1.Visible := True;
    SSNumEdit.Color := clYellow;
  end;  
end;
//------------------------------------------------------------------------
function TfrmPtAdd.SSNumInvalid(SSNumStr: string) : boolean;
var targetLen : byte;
begin
  if Pos('P',SSNumStr)>0 then targetLen := 10 else targetLen := 9;
  Result := (length(SSNumStr) <> targetLen);
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.SSNumEditKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = 'p' then Key := 'P';
  if Key=#8 then begin
    if Pos('P',SSNumEdit.Text)>0 then begin
      SSNumEdit.Text := '';
      Key := #0;
    end;  
  end else if Key='P' then begin  
    CreatePSSN;
    Key := #0;
  end else if not (Key in ['0'..'9','-']) then Key := #0;
end;
//------------------------------------------------------------------------
function TfrmPtAdd.FrmtSSNum(SSNumStr : string) : string;
var partA,partB,partC : string;
begin
  partA := MidStr(SSNumStr,1,3);
  partB := MidStr(SSNumStr,4,2);
  partC := MidStr(SSNumStr,6,5);
  Result := partA;
  if length(partA)=3 then begin
    Result := Result + '-' + partB;  
    if partC<>'' then begin
      Result := Result + '-' + partC;
    end;  
  end else begin
    Result := SSNumStr;
  end;
end;
//------------------------------------------------------------------------
function TfrmPtAdd.UnFrmtSSNum(SSNumStr : string) : string;
begin
  Result := AnsiReplaceText(SSNumStr,'-','');  
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.DOBEditKeyPress(Sender: TObject; var Key: Char);
begin
  if Key in ['-', '\'] then Key := '/';
  if Key in ['0'..'9'] + ['/'] then Key := Key 
  else if Key <> #8 then Key := #0;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.LNameEditKeyPress(Sender: TObject; var Key: Char);
begin
  Key := Uppercase(Key)[1];
  if Key in ['0'..'9',','] then Key := #0
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.FNameEditKeyPress(Sender: TObject; var Key: Char);
begin
  Key := Uppercase(Key)[1];
  if Key in ['0'..'9'] then Key := #0
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.MNameEditKeyPress(Sender: TObject; var Key: Char);
begin
  Key := Uppercase(Key)[1];
  if Key in ['0'..'9'] then Key := #0
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.SuffixEditKeyPress(Sender: TObject; var Key: Char);
begin
  if Key in ['0'..'9'] then Key := #0
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.SexComboBoxKeyPress(Sender: TObject; var Key: Char);
begin
  Key := Uppercase(Key)[1];
  if Key = 'M' then begin
    SexComboBox.Text := 'MALE';
    Key := #0;
  end else if Key = 'F' then begin
    SexComboBox.Text := 'FEMALE';
    Key := #0;
  end else if Key = #8 then begin
    SexComboBox.Text := '';
    Key := #0;
  end else Key := #0;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.PtTypeComboBoxKeyPress(Sender: TObject; var Key: Char);
begin
  Key := #0;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.PostInfo(ThisPatientInfo : TPatientInfo);
var tempResult: integer;

  procedure CheckPost(Title, Value : string);
  begin 
    if Value <> '' then RPCBrokerV.Param[0].Mult['"'+Title+'"'] := Value;
  end;
  
begin
  if MessageDlg('Add New Patient?  (Can Not Be Undone)', 
                mtConfirmation, [mbYes, mbNo],0) = mrNo then exit;
  
  RPCBrokerV.remoteprocedure := 'TMG ADD PATIENT';
  
  RPCBrokerV.Param[0].PType := list;
  with ThisPatientInfo do begin
    CombinedName := LName + ',' + FName;
    If MName <> '' then CombinedName := CombinedName + ' ' + MName;
    If Suffix <> '' then CombinedName := CombinedName + ' ' + Suffix;
    CheckPost('COMBINED_NAME',CombinedName);
    CheckPost('DOB',DOB);
    CheckPost('SEX',Sex);
    CheckPost('SS_NUM',SSNum);
    //CheckPost('Veteran',Veteran);
    //CheckPost('PtType',PtType);

    //RPCBrokerV.Call;
    CallBroker;
    tempResult := strtoint(piece(RPCBrokerV.Results.Strings[0],'^',1));
    DFN := tempResult;
    if tempResult > 0 then begin
       //MessageDlg('Patient successfully added',mtInformation,[mbOK],0);
    end else if tempResult = 0 then begin   
      MessageDlg('Patient already exists.',mtError,[mbOK],0);
      DFN := strtoint(piece(RPCBrokerV.Results.Strings[0],'^',2));
    end else begin
       MessageDlg(RPCBrokerV.Results.Strings[0],mtError,[mbOK],0);   
    end;
  end;  
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.FormDestroy(Sender: TObject);
begin
  ThisPatientInfo.Destroy;
end;
//------------------------------------------------------------------------
procedure TfrmPtAdd.CreatePSSN();
var 
  i: integer; 
  tempPseudo: string; 
  Init : array [1..3] of char;
  code : char;
  Month,Day,Year: string;
  
begin
  for i := 1 to 3 do Init[i]:=' ';
  if ThisPatientInfo.FName<>'' then Init[1] := UpperCase(ThisPatientInfo.FName)[1];
  if ThisPatientInfo.MName<>'' then Init[2] := UpperCase(ThisPatientInfo.MName)[1];
  if ThisPatientInfo.LName<>'' then Init[3] := UpperCase(ThisPatientInfo.LName)[1];

  tempPseudo := '';
  for i := 1 to 3 do begin
    if      Init[i] in ['A','B','C'] then code := '1'
    else if Init[i] in ['D','E','F'] then code := '2'
    else if Init[i] in ['G','H','I'] then code := '3'
    else if Init[i] in ['J','K','L'] then code := '4'
    else if Init[i] in ['M','N','O'] then code := '5'
    else if Init[i] in ['P','Q','R'] then code := '6'
    else if Init[i] in ['S','T','U'] then code := '7'
    else if Init[i] in ['V','W','X'] then code := '8'
    else if Init[i] in ['Y','Z']     then code := '9'
    else if Init[i] in [' ']         then code := '0'
    else code := '0';
    tempPseudo := tempPseudo + code;
  end;  
  
  Month := piece(ThisPatientInfo.DOB,'/',1);
  Day := piece(ThisPatientInfo.DOB,'/',2);     
  Year := piece(ThisPatientInfo.DOB,'/',3);
  tempPseudo := tempPseudo + Month + Day + Year + 'P';
  ThisPatientInfo.SSNum := tempPseudo;
  SSNumEdit.Text := ThisPatientInfo.SSNum;
  SSNumEditExit(nil);
end;

procedure TfrmPtAdd.DOBEditExit(Sender: TObject);
var
  s,s2: string;
  i:integer; boolInvalid: boolean;
begin
  boolInvalid := False;
  s2 := '';
  For i:=1 to 3 do begin
   s := piece(DobEdit.Text,'/',i);
   if ((i = 3) and (length(s) = 4)) then s := rightstr(s,2);      
   if length(s) = 1 then s := '0' + s;
   if s2 <> '' then s2 := s2 + '/';
   s2 := s2 + s;
   if length(s) <> 2 then boolInvalid := True;
  end;               

  if (boolInvalid = True) and (DOBEdit.Text<>'') then begin
    messagedlg('DOB format is invalid. Please enter it in mm/dd/yy format.',mtError,[mbOK],0);
    DOBEdit.text := '';
  end else begin
    DOBEdit.text := s2;  
  end;
end;

procedure TfrmPtAdd.SSNHelpBtnClick(Sender: TObject);
begin
  if MessageDlg('If Soc. Sec. Number (SSN) is unknown, a "Pseudo" SSN may be used.'+#10+#13+
                 'Create a Pseudo-SSN For this Patient?', 
                  mtConfirmation, [mbYes, mbNo],0) = mrYes then begin
    CreatePSSN;
  end else begin
    SSNumEdit.Text := '';
  end;
end;

end.