unit BatchAddU;
   (* 
   WorldVistA Configuration Utility
   (c) 8/2008 Kevin Toppenberg
   Programmed by Kevin Toppenberg, Eddie Hagood  
   
   Family Physicians of Greeneville, PC
   1410 Tusculum Blvd, Suite 2600
   Greeneville, TN 37745
   kdtop@yahoo.com
                                                 
   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.

   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  *)   

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, ExtCtrls, ComCtrls;

type
  TBatchAddForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    BatchGrid: TStringGrid;
    btnCreateTemplate: TBitBtn;
    btnOpenDataFile: TBitBtn;
    btnDoRegistration: TBitBtn;
    btnClearGrid: TBitBtn;
    OpenDialog: TOpenDialog;
    btnDone: TBitBtn;
    ProgressBar: TProgressBar;
    btnSaveGrid: TBitBtn;
    btnAbortRegistration: TBitBtn;
    SaveDialog: TSaveDialog;
    procedure btnCreateTemplateClick(Sender: TObject);
    procedure btnClearGridClick(Sender: TObject);
    procedure btnOpenDataFileClick(Sender: TObject);
    function LTrim(s,subStr : string): string;
    function RTrim(s,subStr : string): string;
    function Trim(s,subStr : string): string;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure btnDoRegistrationClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnAbortRegistrationClick(Sender: TObject);
    procedure btnSaveGridClick(Sender: TObject);
    procedure BatchGridSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
  private
    { Private declarations }
    FieldNumList : TStringList;
    FAbortRegistration : boolean;
    procedure ClearGrid;
    procedure LoadData(fileName : string);
    procedure AddHeaderCol(oneEntry : string);  
    procedure GetColFieldNums(List : TStringList);
    function GetOneRow(row : integer; ColFields : TStringList) : string;
    function RegisterOne(oneRow : string; Log : TStringList) : string;
    procedure DelGridRow(BatchGrid : TStringGrid; row : integer);
  public
    { Public declarations }
  end;

var
  BatchAddForm: TBatchAddForm;

implementation

uses CreateTemplateU, StrUtils, ORNet, ORFn, Trpcb, FMErrorU;

const NOT_ADDED='(Not Added)';
      ADD_ROW='Add-->';
      ALREADY_ADDED='(Already Registered)';
{$R *.dfm}

  procedure TBatchAddForm.ClearGrid;
  begin
    BatchGrid.ColCount := 2;
    BatchGrid.RowCount := 3;
    BatchGrid.Cells[0,0] := 'Field NAME';
    BatchGrid.Cells[0,1] := 'Field NUM';
    BatchGrid.Cells[0,2] := '';
    BatchGrid.Cells[1,0] := '';
    BatchGrid.Cells[1,1] := '';
    BatchGrid.Cells[1,2] := '';
  end;


  procedure TBatchAddForm.btnCreateTemplateClick(Sender: TObject);
  begin
    CreateTemplateForm.PrepForm('2');
    CreateTemplateForm.ShowModal;
  end;

  procedure TBatchAddForm.btnClearGridClick(Sender: TObject);
  begin
    if MessageDlg('Clear All Patients?',mtConfirmation,mbOKCancel,0) = mrOK then begin
      ClearGrid;
      btnSaveGrid.Enabled := false;
      btnDoRegistration.Enabled := false;
      btnClearGrid.Enabled := false;
      btnCreateTemplate.Enabled := true;
      btnOpenDataFile.Enabled := true;
    end;
  end;

  procedure TBatchAddForm.btnOpenDataFileClick(Sender: TObject);
  begin
    if OpenDialog.Execute then begin
      LoadData(OpenDialog.FileName);
      btnClearGrid.Enabled := true;
      btnDoRegistration.Enabled := true;
      btnCreateTemplate.Enabled := false;
      btnOpenDataFile.Enabled := false;
    end;
  end;

  function TBatchAddForm.RTrim(s,subStr : string): string;
  var p,subLen : integer;       
  begin
    result := s;
    p := Pos(subStr,s);
    subLen := length(subStr);
    if p <> length(s)-subLen+1 then exit;
    result := MidStr(s,1, length(s)-subLen);
  end;

  
  function TBatchAddForm.LTrim(s,subStr : string): string;
  var p,subLen : integer;
  begin
    result := s;
    p := Pos(subStr,s);
    subLen := length(subStr);
    if p <> 1 then exit;
    result := MidStr(s,subLen+1,999);
  end;

  function TBatchAddForm.Trim(s,subStr : string): string;
  begin
    result := LTrim(s,subStr);
    result := RTrim(result,subStr);
  end;
  

  procedure TBatchAddForm.LoadData(fileName : string);
  var Data: TStringList;
      Line1List: TStringList;
      oneLine : string;
      value : string;
      row,i,j : integer;
      fldName,fldNum : string;
      dataFound : boolean;
      oneEntry : string;
  begin
    Data := TStringList.Create;
    Line1List := TStringList.Create;
    Data.LoadFromFile(fileName);
    if Data.Count < 3 then begin
      MessageDlg('Template file has less than 3 lines.'+#10+#13+
                 'Doesn''t appear to be valid template'+#10+#13+
                 'filled with patient data.  Please fill '+#10+#13+
                 'with patient demographics first.', mtError,[mbOK],0);
      exit;           
    end;
    ClearGrid;    
    //------- set up header rows  (name and number) ------------------
    oneLine := Data.Strings[0];
    PiecesToList(oneLine, #9, Line1List);
    oneLine := Data.Strings[1];
    PiecesToList(oneLine, #9, FieldNumList);
    for i := 1 to Line1List.Count-1 do begin
      fldName := Trim(Line1List.Strings[i],'"');
      if i < FieldNumList.Count then begin
        fldNum := LTrim(FieldNumList.Strings[i],'"<');
        fldNum := RTrim(fldNum,'>"');
      end else begin
        fldNum := '??';
      end;
      oneEntry := fldNum+'^'+fldName;
      AddHeaderCol(oneEntry);  
    end;    
    //--------- now load data ----------------------
    dataFound := true;
    for i := 2 to Data.Count-1 do begin
      if dataFound then begin
        if BatchGrid.RowCount = 3 then begin
          if BatchGrid.Cells[0,2] <> '' then BatchGrid.RowCount := BatchGrid.RowCount + 1;
        end else begin
          BatchGrid.RowCount := BatchGrid.RowCount + 1;
        end;  
      end;  
      row := BatchGrid.RowCount-1;
      oneLine := Data.Strings[i];    
      PiecesToList(oneLine, #9, Line1List);
      BatchGrid.Cells[0,row] := ADD_ROW;
      dataFound := false;  //don't advance line if data row is empty.
      for j := 1 to Line1List.Count-1 do begin  //don't use first column of data file
        value := Line1List.Strings[j];
        value := Trim(value,'"');
        if FieldNumList.Strings[j]='"<.09>"' then begin
          value := LTrim(value,'<');
          value := RTrim(value,'>');
        end;
        if value <> '' then dataFound := true;
        BatchGrid.Cells[j,row]:= value;
      end;
      if (dataFound = false) and (i = Data.Count-1) then begin
        BatchGrid.RowCount := BatchGrid.RowCount - 1;
      end;
    end;
    Data.Free;
    Line1List.Free;
  end;

  procedure TBatchAddForm.AddHeaderCol(oneEntry : string);  
  //oneEntry format: fldNum^fldName
  var i : integer;
      fldName,fldNum : string;
  begin
    CreateTemplateForm.GetNumName(oneEntry,fldName,fldNum);    
    i := BatchGrid.ColCount-1;
    if BatchGrid.Cells[i,0] <> '' then begin
      BatchGrid.ColCount := BatchGrid.ColCount + 1;
    end;
    i := BatchGrid.ColCount-1;

    BatchGrid.Cells[i,0] := fldName;      
    BatchGrid.Cells[i,1] := fldNum;      
  end;


  procedure TBatchAddForm.FormClose(Sender: TObject; var Action: TCloseAction);
  begin
    {
    if MessageDlg('Leave Batch Registration? (Later check to ensure data was saved)',mtConfirmation,mbOKCancel,0) = mrOK then begin
      Action := caHide;
    end else begin
      Action := caNone;
    end;
    }
  end;

  procedure TBatchAddForm.FormCreate(Sender: TObject);
  begin
    FieldNumList := TStringList.Create;
  end;

  
  procedure TBatchAddForm.btnDoRegistrationClick(Sender: TObject);
  var row : integer;
      ColFields : TStringList;
      onePostEntry : string;
      newIEN : string;
      Log : TStringList;
      Success,Failure,PreExisting : integer;
  begin
    btnOpenDataFile.Enabled := false;
    btnClearGrid.Enabled := true;
    btnAbortRegistration.Enabled := True;
    btnClearGrid.Enabled := False;
    btnSaveGrid.Enabled := False;
    
    Log := TStringList.Create;
    Success := 0;
    Failure := 0;
    PreExisting := 0;
    FMErrorForm.Memo.Lines.clear;
    ColFields := TStringList.Create;
    GetColFieldNums(ColFields);
    ProgressBar.Max := BatchGrid.RowCount-1;
    FAbortRegistration := false;  //abort button can change this.
    for row := 2 to BatchGrid.RowCount-1 do begin
      if FAbortRegistration = true then break;
      ProgressBar.Position := row;
      onePostEntry := GetOneRow(row,ColFields);
      newIEN := RegisterOne(onePostEntry,Log);
      BatchGrid.Cells[0,row] := newIEN;
      if newIEN = NOT_ADDED then inc(Failure) 
      else if newIEN = ALREADY_ADDED then inc(PreExisting) 
      else inc(Success);     
      Application.ProcessMessages;
    end;
    ProgressBar.Position := 0;
    ColFields.free;
    MessageDlg(IntToStr(Success)+' successful registrations,  '+#10+#13+
               IntToStr(PreExisting)+' Patients were already registered,'+#10+#13+
               IntToStr(Failure)+' failures.',
               mtInformation,[mbOK],0);
    for row := BatchGrid.RowCount-1 downto 2 do begin
      if (BatchGrid.Cells[0,row] <> NOT_ADDED)
      and (BatchGrid.Cells[0,row] <> ADD_ROW) then begin
        DelGridRow(BatchGrid,row);
      end;
    end;                        
    if Log.Count>0 then begin
      FMErrorForm.Memo.Lines.Assign(Log);
      FMErrorForm.PrepMessage;
      FMErrorForm.ShowModal;
    end;  
    Log.Free;
    if (BatchGrid.RowCount=3)and(BatchGrid.Cells[0,2]='') then begin
      btnSaveGrid.Enabled := false;
      btnDoRegistration.Enabled := false;
      btnClearGrid.Enabled := false;
      btnCreateTemplate.Enabled := true;
      btnOpenDataFile.Enabled := true;
      btnAbortRegistration.Enabled := true;
    end else begin
      btnClearGrid.Enabled := true;
      btnSaveGrid.Enabled := true; 
      btnAbortRegistration.Enabled := false;
    end;
  end;

  function TBatchAddForm.RegisterOne(oneRow : string; Log : TStringList) : string;
  var RPCResult : string;
      Msg : string;
      i : integer;
  begin
    RPCBrokerV.remoteprocedure := 'TMG CHANNEL';
    RPCBrokerV.param[0].ptype := list;
    RPCBrokerV.Param[0].Mult['"REQUEST"'] := 'REGISTER PATIENT^'+oneRow;
    RPCBrokerV.Call;
    RPCResult := RPCBrokerV.Results[0];    //returns:  error: -1;  success=1
    Msg := piece(RPCResult,'^',2);
    result := piece(RPCResult,'^',3);
    if result = '' then result := NOT_ADDED;
    if piece(RPCResult,'^',1)='-1' then begin
      if Msg='Patient already registered' then begin
        result := ALREADY_ADDED; 
        exit;
      end;  
      FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
      FMErrorForm.PrepMessage;  //Does some clean up of the message format
      //FMErrorForm.ShowModal;  //later just put these in log...
      Log.Add('-----------------------------------------------');
      Log.Add('There was a problem with registering a patient.');
      //Log.Add('This was the data sent to the server: ');
      //Log.Add('    '+oneRow);
      for i:= 0 to FMErrorForm.Memo.Lines.Count-1 do begin
        Log.Add(FMErrorForm.Memo.Lines.Strings[i]);
      end;    
      Log.Add(' ');      
      FMErrorForm.Memo.Lines.Clear;      
      if Msg='Success (but see message)' then exit;
      result := NOT_ADDED;
    end;     
  end;

  procedure TBatchAddForm.DelGridRow(BatchGrid : TStringGrid; row : integer);
  var col : integer;
  begin
    if row >= BatchGrid.RowCount then exit;
    repeat
      if row = BatchGrid.RowCount-1 then begin
        if BatchGrid.RowCount=3 then begin
          for col := 0 to BatchGrid.ColCount-1 do begin
            BatchGrid.Cells[col,row] := '';
          end;
        end else begin
          BatchGrid.RowCount := BatchGrid.RowCount-1;
        end;  
        exit;
      end;
      for col := 0 to BatchGrid.ColCount-1 do begin
        BatchGrid.Cells[col,row] := BatchGrid.Cells[col,row+1]
      end;
      inc(row);
    until (1=0);      
  end;  
  
  procedure TBatchAddForm.FormDestroy(Sender: TObject);
  begin
    FieldNumList.Free;
  end;

  procedure TBatchAddForm.GetColFieldNums(List : TStringList);
  var i : integer;
  begin
    List.Clear;
    List.Add(''); //fill 0'th column will null
    for i := 1 to BatchGrid.ColCount-1 do begin
      List.Add(BatchGrid.Cells[i,1]);      
    end;
  end;

  function TBatchAddForm.GetOneRow(row : integer; ColFields : TStringList) : string;
  //Output format: FldNum1^Value1^fldNum2^Value2^FldNum3^Value3...
  var i : integer;
      oneValue : string;
  begin    
    result := '';
    if row >= BatchGrid.RowCount then exit;
    for i := 1 to BatchGrid.ColCount-1 do begin
      result := result + ColFields.Strings[i]+'^'+BatchGrid.Cells[i,row]+'^';
    end;
  end;

  procedure TBatchAddForm.btnAbortRegistrationClick(Sender: TObject);
  begin
    FAbortRegistration := true;
  end;

  procedure TBatchAddForm.btnSaveGridClick(Sender: TObject);
  var DataLines : TStringList;
      Value : string;
      row,col : integer;
      Line : string;
  begin
    If SaveDialog.Execute then begin
      DataLines := TStringList.Create;
      for row := 0 to BatchGrid.RowCount-1 do begin
        Line := '';
        for col := 0 to BatchGrid.ColCount-1 do begin
          Value := BatchGrid.Cells[col,row];
          if Value = ADD_ROW then Value := ' ';          
          if (row=1)or((BatchGrid.Cells[col,1]='.09')and(row<>0)) then begin
            Value := '<'+Value+'>';  //protect field numbers as text
          end;  
          Line := Line + '"'+Value+'"' + #9
        end;  
        DataLines.Add(Line);
      end;
      DataLines.Add(' ');
      DataLines.Add('Add as many rows as needed)');
      DataLines.Add(' ');
      DataLines.Add('When done, save file and import with');
      DataLines.Add('  the WorldVista Config Utility.');
      DataLines.Add('Save in CSV format, using TAB as field');
      DataLines.Add(' delimiter, and " as text delimiter.');
      DataLines.SaveToFile(SaveDialog.FileName);
      DataLines.Free;
    end;
  end;

  procedure TBatchAddForm.BatchGridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
  begin
    btnSaveGrid.Enabled := true;
  end;

end.