Changeset 671 for cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas

Timestamp:

Jan 19, 2010, 1:26:10 PM (15 years ago)

Author:

Kevin Toppenberg

Message:

Fixed HTML Note Printing Error

File:

• cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas (modified) (11 diffs)

cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas

@@ -16 +16 @@
     DesiredHTMLFontSize : byte;       
      
-  procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string; PtName:string; 
-                            DOB:string; Location:string; Application : TApplication);  //kt added 5-2-05
+  procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string; 
+                            PtName, DOB, VisitDate, Location:string; Application : TApplication);  //kt added 5-2-05
   function  IsHTML(Lines : TStrings): boolean; overload;
   function  IsHTML(Line : String): boolean; overload;
@@ -34 +34 @@
   procedure SetRegHTMLFontSize(Size: byte);
   procedure RestoreRegHTMLFontSize;
-  procedure SetupHTMLPrinting(Name,DOB,Location,Institution : string);
+  procedure SetupHTMLPrinting(Name,DOB,VisitDate,Location,Institution : string);
   procedure RestoreIEPrinting;
-   
+  function ExtractDateOfNote(Lines : TStringList) : string;
+
 implementation
 
@@ -44 +45 @@
        Graphics, //For color constants
        fTMGPrintingAnimation,
+       ExtCtrls,
        StrUtils; 
+
+  type
+    TPrinterEvents = class
+    public
+      SavedDefaultPrinter : string;
+      LastChosenPrinterName : string;
+      RestorePrinterTimer : TTimer;       
+      PrintingNow : boolean;
+      procedure HandleRestorePrinting (Sender: TObject);
+      Constructor Create;
+      Destructor Destroy; override;
+    end;  
+   
+  var
+    PrinterEvents : TPrinterEvents;
 
   const CRLF = #$0D#$0A;
@@ -100 +117 @@
     until (GetTime-StartTime) > (OneSec*Sec);
   end;
-  
+
+  
+  procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string; 
+                            PtName, DOB, VisitDate, Location:string;
+                            Application : TApplication);
+  //      Web browser printing options:
+  //        OLECMDEXECOPT_DODEFAULT       Use the default behavior, whether prompting the user for input or not.
+  //        OLECMDEXECOPT_PROMPTUSER      Execute the command after obtaining user input.
+  //        OLECMDEXECOPT_DONTPROMPTUSER  Execute the command without prompting the user.
+
+  {Notice:  When IE is asked to print, it immediately returns from the function,
+           but the printing has not yet occured.  If UI is requested, then the
+          printing will not start until after the user selects a printer and
+         presses [OK].  I could not find any reliable way to determine when the
+        print job had been created.  I had to know this event because I need to
+       restore some IE settings AFTER the printing has finished.  I even tried to
+      get the active windows and see if it was a print dialog.  But IE print dlg
+     apparently is owned by another thread than CPRS, because GetActiveWindow would
+     not bring back a handle to the printer dialog window.  I therefore told IE
+     to print WITHOUT asking which printer via UI.  In that case it prints to the
+     system wide default printer.  So I have to set the default printer to the 
+     user's choice, and then change it back again.  This is bit of a kludge,
+     but I couldn't figure out any other way after hours of trial and error.
+     NOTE: I tried to query IE to see if it was able to print, thinking that it
+     would return NO if in the process of currently printing.  It didn't work, 
+     and would return OK immediately.      
+     
+     ADDENDUM:  I was getting errors and inconsistent behavior with this, so I
+       have decided to try to let the user click a button when the printer has
+       been selected.                                         }    
+  
+  var
+    UseUI          : OleVariant;   
+    //NewPrinterName : string;    
+    //dlgWinPrinter  : TPrintDialog;
+  begin
+    //if PrinterEvents.RestorePrinterTimer.Enabled = false then begin
+    //  PrinterEvents.SavedDefaultPrinter := GetCurrentPrinterName;
+    //end;  
+    if PrinterEvents.PrintingNow then exit; // prevent double printing (it has happened)
+
+    try
+      frmNotes.SetDisplayToHTMLvsText([vmView,vmHTML],Lines);  //ActivateHtmlViewer(Lines);
+      if frmNotes.HtmlViewer.WaitForDocComplete = false then begin
+        ErrMsg := 'The web browser timed out trying to set up document.';
+        exit;
+      end;
+      PrinterEvents.PrintingNow := true;
+      SetupHTMLPrinting(PtName,DOB,VisitDate,Location,' ');  {elh 6/19/09} //kt
+      frmNotes.HtmlViewer.PrintFinished := false;               
+      UseUI := true;
+      frmNotes.HtmlViewer.PrintDocument(UseUI);   //Returns immediately, not after printing done.
+      frmTMGPrinting.ShowModal;    // Let user show when print job has been launched.
+      PrinterEvents.RestorePrinterTimer.Enabled := true; //launch a restore event in 30 seconds
+      //RestoreIEPrinting;  //elh - This was omitted from below. Not sure why.  11/10/09
+    finally  
+      PrinterEvents.PrintingNow := false;
+    end;
+  end;
+
+(*
+  Safe copy of above.  Delete later...
+    
   procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string; 
                             PtName, DOB, Location:string;
@@ -126 +205 @@
      and would return OK immediately.                                               }    
   
+
+
   var
-    UseUI : OleVariant;   
-    NewPrinterName,DefaultPrinter: string;    
-    dlgWinPrinter: TPrintDialog;
-  begin
-    DefaultPrinter := GetCurrentPrinterName;
+    UseUI          : OleVariant;   
+    NewPrinterName : string;    
+    dlgWinPrinter  : TPrintDialog;
+  begin
+    if PrinterEvents.RestorePrinterTimer.Enabled = false then begin
+      PrinterEvents.SavedDefaultPrinter := GetCurrentPrinterName;
+    end;  
     dlgWinPrinter := TPrintDialog.Create(nil);
     frmTMGPrinting.Show;
+    //FIX: get printer name for the one used last time somehow...
     if dlgWinPrinter.Execute then begin  //only sets a local printer
       NewPrinterName := GetCurrentPrinterName;  
       SetDefaultPrinter(NewPrinterName); //Set global setting that IE will use.
+      PrinterEvents.LastChosenPrinterName := NewPrinterName;
       try
-        //frmNotes.SetHTMLorTextViewer(True,Lines);  //ActivateHtmlViewer(Lines);
         frmNotes.SetDisplayToHTMLvsText([vmView,vmHTML],Lines);  //ActivateHtmlViewer(Lines);
         if frmNotes.HtmlViewer.WaitForDocComplete = false then begin
@@ -148 +232 @@
         UseUI := false;  //UseUI := true;
         frmNotes.HtmlViewer.PrintDocument(UseUI);   //Returns immediately, not after printing done.
-        Wait(4,Application); //give IE x sec to complete print document.  Is this always enough?
+        PrinterEvents.RestorePrinterTimer.Enabled := true; //launch a restore event in 30 seconds
+        Wait(4,Application); 
         //WaitForBrowserOK(10, Application); //wait up to 10 seconds  //Note: this doesn't do what I want.  Status is immediately OK.
-        RestoreIEPrinting;   {elh 6/19/09}  //kt
+        //RestoreIEPrinting;   {elh 6/19/09}  //kt
       finally   //any needed final code goes here.
-        SetDefaultPrinter(DefaultPrinter);
+        //SetDefaultPrinter(DefaultPrinter);
         //beep;
       end;
@@ -159 +244 @@
     frmTMGPrinting.Hide;        
   end;
-
+*)  
   (*
   function WaitForBrowserOK(MaxSecDelay: integer; Application : TApplication) : boolean;
@@ -738 +823 @@
     Reg : TRegistry;
    
-  procedure SetupHTMLPrinting(Name,DOB,Location,Institution : string);
+  procedure SetupHTMLPrinting(Name,DOB,VisitDate,Location,Institution : string);
   //Purpose: To open the IE header and footer registry keys, save the
   //current value and then replace with passed patient data.   elh 6/19/09
@@ -748 +833 @@
     end;  
     NewHeader := Location + ' &b ' + Institution + ' &b Printed: &d &t';
-    NewFooter := Name + ' &b DOB: ' + DOB + ' &b &p of &P';
+    NewFooter := Name + ' (' + DOB + ') &b Note: ' + VisitDate + ' &b &p of &P';
     Reg := TRegistry.Create;  //to be freed in RestoreIEPrinting
     try
@@ -764 +849 @@
   procedure RestoreIEPrinting;
   //Purpose: To restore the IE header and footer registry with the initial value
+  //NOTE: The below function was used to restore the previous value to the registry
+  //       but got commented above, so the registry retained the patient's data
+  //       to resolve this, we are now setting this to a default value.
   //elh 6/19/09
   begin
     if not assigned(Reg) then Reg := TRegistry.Create;
     try
+      StoredIEFooters := '&u&b&d';          //Comment this line to restore previous value
+      StoredIEHeader := '&d&b&t&bPage &p of &P';  //Comment this line to restore previous value
       Reg.WriteString('footer',StoredIEFooters);
       Reg.WriteString('header',StoredIEHeader);
@@ -776 +866 @@
   end;
 
-begin
+  function ExtractDateOfNote(Lines : TStringList) : string;
+  //Scan note and return date found after 'DATE OF NOTE:', if present.
+  var i,p : integer;
+      s : string;
+  begin
+    Result := '';
+    if Lines = nil then exit;
+    for i := 0 to Lines.Count-1 do begin
+      p := Pos('DATE OF NOTE:',Lines.Strings[i]);
+      if p<1 then continue;
+      s := Piece(Lines.Strings[i],'DATE OF NOTE:',2);
+      s := Piece(s,'@',1);
+      Result := Trim(s);      
+    end;
+  end;
+
+  //===============================================================
+
+  Constructor TPrinterEvents.Create;
+  begin
+    RestorePrinterTimer := TTimer.Create(frmNotes);
+    RestorePrinterTimer.Enabled := false;
+    RestorePrinterTimer.Interval := 30000; //30 seconds to complete print job.
+    RestorePrinterTimer.OnTimer := HandleRestorePrinting;
+    PrintingNow := false;
+  end;
+  
+  Destructor TPrinterEvents.Destroy;
+  begin
+    RestorePrinterTimer.Free;    
+    inherited Destroy;
+  end;
+
+
+  procedure TPrinterEvents.HandleRestorePrinting (Sender: TObject);
+  begin
+    if PrinterEvents.PrintingNow then begin
+      RestorePrinterTimer.Enabled := true; // reset timer for later.
+      exit;
+    end;
+    RestorePrinterTimer.Enabled := false;
+    RestoreIEPrinting;   {elh 6/19/09}  //kt
+    //kt SetDefaultPrinter(SavedDefaultPrinter);   
+    //beep;    
+  end;  
+
+  //===============================================================
+  
+
+initialization
   DesiredHTMLFontSize := 2; //probably overwritten in fNotes initialization
+  PrinterEvents := TPrinterEvents.Create;  
+
+finalization
+  PrinterEvents.Free;   
 end.