Changeset 542 for cprs/branches/GUI-config/BatchAddU.pas

Timestamp:

Aug 12, 2009, 7:34:51 PM (15 years ago)

Author:

Kevin Toppenberg

Message:

v1.1 Fixes Access/Verify code issues

File:

• cprs/branches/GUI-config/BatchAddU.pas (modified) (14 diffs)

cprs/branches/GUI-config/BatchAddU.pas

@@ -29 +29 @@
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, StdCtrls, Buttons, Grids, ExtCtrls, ComCtrls;
+  Dialogs, StdCtrls, Buttons, Grids, ExtCtrls, ComCtrls, DateUtils;
 
 type
@@ -46 +46 @@
     btnAbortRegistration: TBitBtn;
     SaveDialog: TSaveDialog;
+    EstTimeLabel: TLabel;
     procedure btnCreateTemplateClick(Sender: TObject);
     procedure btnClearGridClick(Sender: TObject);
@@ -66 +67 @@
     procedure ClearGrid;
     procedure LoadData(fileName : string);
-    procedure AddHeaderCol(oneEntry : string);  
+    procedure AddHeaderCol(oneEntry : string);
     procedure GetColFieldNums(List : TStringList);
     function GetOneRow(row : integer; ColFields : TStringList) : string;
+    function RowToStr(row : integer) : string;
+    procedure AddRowFromStr(Str : string);
     function RegisterOne(oneRow : string; Log : TStringList) : string;
-    procedure DelGridRow(BatchGrid : TStringGrid; row : integer);
+    //procedure DelGridRow(BatchGrid : TStringGrid; row : integer);
   public
     { Public declarations }
@@ -80 +83 @@
 implementation
 
-uses CreateTemplateU, StrUtils, ORNet, ORFn, Trpcb, FMErrorU;
+uses CreateTemplateU, StrUtils, ORNet, ORFn,
+     Trpcb,  //needed for .ptype types
+     FMErrorU;
 
 const NOT_ADDED='(Not Added)';
@@ -260 +265 @@
   end;
 
-  
+
   procedure TBatchAddForm.btnDoRegistrationClick(Sender: TObject);
-  var row : integer;
+  var i,row : integer;
+      FailedPatients : TStringList;
       ColFields : TStringList;
       onePostEntry : string;
-      newIEN : string;
+      RPCResult : string;
       Log : TStringList;
-      Success,Failure,PreExisting : integer;
+      Success,Failure,PreExisting,Errors : integer;
+      StartTime : TDateTime;
+
+      procedure ShowEstTime(Pct : single);
+      var  Delta : single;
+           EstTotalMin : Integer;
+           s : string;
+      begin
+        Delta := MinuteSpan(Now,StartTime);
+        if Pct=0 then begin
+          EstTimeLabel.caption := '';
+          exit;
+        end;
+        EstTotalMin := Round(Delta / Pct);
+        s := '';
+        if EstTotalMin > 1440 then begin  //extract number of days
+          s := s + IntToStr(EstTotalMin div 1440) + 'd:';
+          EstTotalMIn := EstTotalMin mod 1440;
+        end;
+        if EstTotalMin > 60 then begin  //extract number of hours
+          if s <> '' then s := s + IntToStr(EstTotalMin div 60) + 'h:'
+          else s := IntToStr(EstTotalMin div 60) + ':';
+          EstTotalMIn := EstTotalMin mod 60;
+        end;
+        s := s + IntToStr(EstTotalMin) + ':';
+        EstTimeLabel.Caption := s;
+      end;
+
   begin
     btnOpenDataFile.Enabled := false;
@@ -274 +307 @@
     btnClearGrid.Enabled := False;
     btnSaveGrid.Enabled := False;
-    
+
     Log := TStringList.Create;
     Success := 0;
     Failure := 0;
     PreExisting := 0;
+    Errors := 0;
     FMErrorForm.Memo.Lines.clear;
     ColFields := TStringList.Create;
+    FailedPatients := TStringList.Create;
     GetColFieldNums(ColFields);
     ProgressBar.Max := BatchGrid.RowCount-1;
     FAbortRegistration := false;  //abort button can change this.
+    StartTime := Now;
+    EstTimeLabel.Caption := '';
     for row := 2 to BatchGrid.RowCount-1 do begin
       if FAbortRegistration = true then break;
       ProgressBar.Position := row;
+      if (row mod 100) = 0 then ShowEstTime(row/(BatchGrid.RowCount-1));
       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);     
+      RPCResult := RegisterOne(onePostEntry,Log);  //Returns: NewIEN^PrevReg^Reg'dNow^ErrorOccured
+      BatchGrid.Cells[0,row] := Piece(RPCResult,'^',1);
+      if Piece(RPCResult,'^',1)=NOT_ADDED then inc(Failure);
+      if Piece(RPCResult,'^',2)='1' then inc(PreExisting);
+      if Piece(RPCResult,'^',3)='1' then inc(Success);
+      if Piece(RPCResult,'^',4)='1' then inc(Errors);
       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.',
+    MessageDlg(IntToStr(Success)+' successful registrations or data refresh,  '+#10+#13+
+               IntToStr(PreExisting)+' patients were already registered,'+#10+#13+
+               IntToStr(Errors)+' filing errors encountered (including minor errors),'+#10+#13+
+               IntToStr(Failure)+' patients NOT registered.',
                mtInformation,[mbOK],0);
+    EstTimeLabel.Caption := '';
+    StartTime := Now;
+    if BatchGrid.RowCount > 1000 then ShowMessage('Will now clear out patients that have been registered.');
+    for row := 2 to BatchGrid.RowCount-1 do begin
+      if (BatchGrid.Cells[0,row] = NOT_ADDED) or (BatchGrid.Cells[0,row] = ADD_ROW) then begin
+        FailedPatients.Add(RowToStr(row));
+      end;
+      ProgressBar.Position := row;
+      if (row mod 100) = 0 then ShowEstTime(row/(BatchGrid.RowCount-1));
+      Application.ProcessMessages;
+    end;
+    BatchGrid.RowCount := 2;
+    ProgressBar.Max := FailedPatients.Count;
+    StartTime := Now;
+    for i := 0 to FailedPatients.Count-1 do begin
+      AddRowFromStr(FailedPatients.Strings[i]);
+      ProgressBar.Position := i;
+      if (i mod 100) = 0 then ShowEstTime(i/(FailedPatients.Count-1));
+      Application.ProcessMessages;
+    end;
+    {
     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;                        
+        DelGridRow(BatchGrid,row);  // <------- this is VERY SLOW!!@#@!
+      end;
+      ProgressBar.Position := row;
+      if (row mod 100) = 0 then ShowEstTime((BatchGrid.RowCount-1-row)/(BatchGrid.RowCount-1));
+      Application.ProcessMessages;
+    end;
+    }
+    EstTimeLabel.Caption := '';
     if Log.Count>0 then begin
       FMErrorForm.Memo.Lines.Assign(Log);
       FMErrorForm.PrepMessage;
       FMErrorForm.ShowModal;
-    end;  
+    end;
     Log.Free;
     if (BatchGrid.RowCount=3)and(BatchGrid.Cells[0,2]='') then begin
@@ -322 +388 @@
     end else begin
       btnClearGrid.Enabled := true;
-      btnSaveGrid.Enabled := true; 
+      btnSaveGrid.Enabled := true;
       btnAbortRegistration.Enabled := false;
     end;
+    FailedPatients.Free;
+
   end;
 
   function TBatchAddForm.RegisterOne(oneRow : string; Log : TStringList) : string;
-  var RPCResult : string;
+  //Returns: NewIEN^Bool1^Bool2^Bool3
+    //    NewIEN can be a #, or NOT_ADDED
+    //    For each Bool, 0=false, 1=true
+    //    Bool1 : Patient previously registered
+    //    Bool2 : Patient registered this time (using identifier fields)
+    //    Bool3 : Some Problem occurred during filing
+  var tempResult,RPCResult : string;
       Msg : string;
       i : integer;
@@ -336 +410 @@
     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;  
+    RPCResult := RPCBrokerV.Results[0];
+    //returns:  error: -1^Message;  success=1^Success^IEN; or Equivical=0^Message^IEN
+    //If 0 then Message is in this format
+    //    [Bool1;Bool2;Bool3;Bool4;Bool5*MessageText]
+    //    For each Bool, 0=false, 1=true
+    //    Bool1 : Patient previously registered
+    //    Bool2 : Patient registered this time (using identifier fields)
+    //    Bool3 : Problem filing non-identifier fields
+    //    Bool4 : Problem filing data info sub-file fields
+    //    Bool5 : Problem filing HRN
+    tempResult := piece(RPCResult,'^',1);
+    if tempResult='1' then begin  //1=Success
+      result := piece(RPCResult,'^',3)+'^0^1^0';
+    end else if tempResult='0' then begin  //0=Mixed results
+      Msg := piece(RPCResult,'^',2);
+      result := piece(RPCResult,'^',3);
+      if result = '' then result := NOT_ADDED;
+      result := result + '^' + Piece(Msg,';',1) + '^' + Piece(Msg,';',2);
+      if Pos('1',Pieces(Msg,';',3,5))>0 then begin
+        result := result + '^1';
+        if RPCBrokerV.Results.Count > 1 then begin
+          Log.Add('-----------------------------------------------');
+          Log.Add('There was a problem with registering a patient.');
+          for i := 1 to RPCBrokerV.Results.Count-1 do begin
+            Log.Add(RPCBrokerV.Results.Strings[i]);
+          end;
+        end;
+      end else begin
+        result := result + '^0';
+      end;
+    end else begin  //should be tempResult='-1'   //-1=Error
       FMErrorForm.Memo.Lines.Assign(RPCBrokerV.Results);
       FMErrorForm.PrepMessage;  //Does some clean up of the message format
@@ -350 +446 @@
       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;
-
+      end;
+      Log.Add(' ');
+      FMErrorForm.Memo.Lines.Clear;
+      result := NOT_ADDED+'^0^0^1';  //Not-prev-reg^Not-reg-this-time^Problem-occured
+    end;
+  end;
+
+  {
   procedure TBatchAddForm.DelGridRow(BatchGrid : TStringGrid; row : integer);
   var col : integer;
@@ -374 +468 @@
         end else begin
           BatchGrid.RowCount := BatchGrid.RowCount-1;
-        end;  
+        end;
         exit;
       end;
@@ -381 +475 @@
       end;
       inc(row);
-    until (1=0);      
-  end;  
+    until (1=0);
+  end;
+  }
   
   procedure TBatchAddForm.FormDestroy(Sender: TObject);
@@ -395 +490 @@
     List.Add(''); //fill 0'th column will null
     for i := 1 to BatchGrid.ColCount-1 do begin
-      List.Add(BatchGrid.Cells[i,1]);      
+      List.Add(BatchGrid.Cells[i,1]);
     end;
   end;
@@ -402 +497 @@
   //Output format: FldNum1^Value1^fldNum2^Value2^FldNum3^Value3...
   var i : integer;
-      oneValue : string;
-  begin    
+  begin
     result := '';
     if row >= BatchGrid.RowCount then exit;
@@ -410 +504 @@
     end;
   end;
+
+  function TBatchAddForm.RowToStr(row : integer) : string;
+  //Output format: Cell0^Cell1^Cell2^Cell3^Cell4....
+  var i : integer;
+  begin
+    result := '';
+    if row >= BatchGrid.RowCount then exit;
+    for i := 0 to BatchGrid.ColCount-1 do begin
+      result := result + BatchGrid.Cells[i,row]+'^';
+    end;
+  end;
+
+  procedure TBatchAddForm.AddRowFromStr(Str : string);
+  var   row : integer;
+        i : integer;
+  begin
+    BatchGrid.RowCount := BatchGrid.RowCount + 1;
+    row := BatchGrid.RowCount-1;
+    for i := 0 to BatchGrid.ColCount-1 do begin
+      BatchGrid.Cells[i,row] := Piece(Str,'^',i+1);
+    end;
+  end;
+
 
   procedure TBatchAddForm.btnAbortRegistrationClick(Sender: TObject);