Index: cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas
===================================================================
--- cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas	(revision 453)
+++ cprs/branches/tmg-cprs/CPRS-Chart/rHTMLTools.pas	(revision 541)
@@ -1,261 +1,780 @@
 unit rHTMLTools;
-(*
-  This entire unit was created by K. Toppenberg, starting on 5/27/05
+(*This entire unit was created by K. Toppenberg, starting on 5/27/05
   It will hold additional functions to support HTML display of notes
-  and printing of HTML notes.
-*)
+  and printing of HTML notes.                                           *)
 
 interface
 
-uses Windows, SysUtils, Classes, Printers, ComCtrls,
-     ShDocVw, {//kt added ShDocVw 5-2-05 for TWebBrowser access}
-     ORFn;    {//kt for RedrawActivate}
-
-procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string);  //kt added 5-2-05
-function IsHTMLDocument(Lines : TStrings): boolean;  //kt added 5-2-05
-procedure WaitForBrowserOK(MaxSecDelay: integer);
-procedure ActivateWebBrowser;
-procedure ActivateMemo;
-function CheckForImageLink(Lines: TStrings; ImageList : TStringList) : boolean;
-
+  uses Windows, SysUtils, Classes, Printers, ComCtrls,
+       ShDocVw, {//kt added ShDocVw 5-2-05 for TWebBrowser access}
+       Dialogs,
+       Forms,
+       Registry, {elh   6/19/09}
+       ORFn;    {//kt for RedrawActivate}
+
+  var
+    DesiredHTMLFontSize : byte;       
+     
+  procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string; PtName:string; 
+                            DOB:string; Location:string; Application : TApplication);  //kt added 5-2-05
+  function  IsHTML(Lines : TStrings): boolean; overload;
+  function  IsHTML(Line : String): boolean; overload;
+  function  HasHTMLTags(Text: string) : boolean;
+  procedure FixHTML(Lines : TStrings); 
+  function  FixHTMLCRLF(Text : String) : string;
+  procedure SplitToArray (HTMLText: string; Lines : TStrings);
+  procedure StripBeforeAfterHTML(Lines,OutBefore,OutAfter : TStrings);
+  function  UnwrapHTML(HTMLText : string) : string; 
+  function  WrapHTML(HTMLText : string) : string; 
+//  function  WaitForBrowserOK(MaxSecDelay: integer; Application : TApplication) : boolean;
+  function  CheckForImageLink(Lines: TStrings; ImageList : TStringList) : boolean;
+  function  ProtectHTMLSpaces(Text : String) : string;
+  function  Text2HTML(Lines : TStrings) : String; overload;
+  function  Text2HTML(text : string) : String;    overload;
+  procedure SetRegHTMLFontSize(Size: byte);
+  procedure RestoreRegHTMLFontSize;
+  procedure SetupHTMLPrinting(Name,DOB,Location,Institution : string);
+  procedure RestoreIEPrinting;
+   
 implementation
 
-uses fNotes,
-     fImages,
-     StrUtils; {//kt added 5-2-05 rTIU for frmNotes.WebBrowser access}
-
-
-procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string);
-//Note:
-//     I use two web browsers because sometimes the display web browser
-//     would be changed by other parts of CPRS during the printing
-//     process, causing the incorrect page to print out.  By having a
-//     browser just for printing, this will hopefully not happen.
-//
-//      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.
-
-var
-  Status: OLECMDF;
-  HTMLfilename : string;
-  //Pauses : integer;
-begin
-  try
+  uses fNotes,
+       fImages,
+       Messages,
+       Graphics, //For color constants
+       fTMGPrintingAnimation,
+       StrUtils; 
+
+  const CRLF = #$0D#$0A;
+
+  
+  function GetCurrentPrinterName : string;
+   //var ResStr: array[0..255] of Char;
+  begin
+  //GetProfileString('Windows', 'device', '', ResStr, 255);
+  //Result := StrPas(ResStr);
+    if (Printer.PrinterIndex > 0)then begin
+      Result := Printer.Printers[Printer.PrinterIndex];
+    end else begin
+      Result := '';
+    end;
+  end;
+
+  procedure SetDefaultPrinter(PrinterName: String) ;
+  var
+      j                    : Integer;
+      Device, Driver, Port : PChar;
+      HdeviceMode          : THandle;
+      aPrinter             : TPrinter;
+  begin    
+     Printer.PrinterIndex := -1;
+     getmem(Device, 255) ;
+     getmem(Driver, 255) ;
+     getmem(Port, 255) ;
+     aPrinter := TPrinter.create;
+     j := Printer.Printers.IndexOf(PrinterName);
+     if j >= 0 then begin
+       aprinter.printerindex := j;
+       aPrinter.getprinter(device, driver, port, HdeviceMode) ;
+       StrCat(Device, ',') ;
+       StrCat(Device, Driver ) ;
+       StrCat(Device, Port ) ;
+       WriteProfileString('windows', 'device', Device) ;
+       StrCopy( Device, 'windows' ) ;
+       //SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, Longint(@Device)) ;
+     end;
+     Freemem(Device, 255) ;
+     Freemem(Driver, 255) ;
+     Freemem(Port, 255) ;
+     aPrinter.Free;
+  end;    
+
+
+  procedure Wait(Sec : byte; Application : TApplication);
+  var   StartTime : TDateTime; 
+  const OneSec = 0.000012;  
+  begin
+    StartTime := GetTime; 
+    repeat
+      Application.ProcessMessages;
+    until (GetTime-StartTime) > (OneSec*Sec);
+  end;
+  
+  procedure PrintHTMLReport(Lines: TStringList; var ErrMsg: string; 
+                            PtName, DOB, 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.                                               }    
+  
+  var
+    UseUI : OleVariant;   
+    NewPrinterName,DefaultPrinter: string;    
+    dlgWinPrinter: TPrintDialog;
+  begin
+    DefaultPrinter := GetCurrentPrinterName;
+    dlgWinPrinter := TPrintDialog.Create(nil);
+    frmTMGPrinting.Show;
+    if dlgWinPrinter.Execute then begin  //only sets a local printer
+      NewPrinterName := GetCurrentPrinterName;  
+      SetDefaultPrinter(NewPrinterName); //Set global setting that IE will use.
+      try
+        //frmNotes.SetHTMLorTextViewer(True,Lines);  //ActivateHtmlViewer(Lines);
+        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;
+        SetupHTMLPrinting(PtName,DOB,Location,' ');  {elh 6/19/09} //kt
+        frmNotes.HtmlViewer.PrintFinished := false;               
+        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?
+        //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
+      finally   //any needed final code goes here.
+        SetDefaultPrinter(DefaultPrinter);
+        //beep;
+      end;
+    end;
+    dlgWinPrinter.Free;
+    frmTMGPrinting.Hide;        
+  end;
+
+  (*
+  function WaitForBrowserOK(MaxSecDelay: integer; Application : TApplication) : boolean;
+  //Returns TRUE if can print
+  var
+    StartTime : TDateTime; 
+    Status: OLECMDF;
+    MaxDelay,ElapsedTime : Double;
+    CanPrint : boolean;
+  const
+    OneMin = 0.0007;  //note: 0.0007 is about 1 minute
+  begin
+    StartTime := GetTime; 
+    MaxDelay := OneMin * MaxSecDelay;
+    repeat
+      Status := frmNotes.HtmlViewer.QueryStatusWB(OLECMDID_PRINT);  //"can you print?" -- get print command status
+      CanPrint := (Status and OLECMDF_ENABLED) > 0;
+      ElapsedTime := GetTime-StartTime;
+      Application.ProcessMessages;
+    until (ElapsedTime > MaxDelay) or CanPrint or frmNotes.HtmlViewer.PrintFinished;
+    Result := CanPrint;
+  end;
+  *)
+  
+  Procedure ScanForSubs(Lines : TStrings);
+  //Purpose: To scan note for constant $CPRS$ and replace with CPRS's actual directory
+  var i : integer;
+      CPRSDir : string;
+  begin
+    for i := 0 to Lines.Count-1 do begin
+      if Pos('$CPRSDIR$',Lines.Strings[i])>0 then begin
+        CPRSDir := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
+        Lines.Strings[i] := AnsiReplaceStr(Lines.Strings[i],'$CPRSDIR$',CPRSDir);
+        //Ensure images are downloaded before passing page to web browser        
+        frmImages.timLoadImagesTimer(nil);
+      end;
+    end;
+  end;
+
+
+  function IsHTML(Line : String): boolean;
+  {Purpose: To look at the Text and determine if it is an HTML document.
+   Test used: if document contains <!DOCTYPE HTML" or <HTML> or </BODY>
+        This is not a fool-proof test...                                   
+   NOTE: **This does NOT call ScanForSubs as the other IsHTML(TStrings) function does.     }
+        
+  begin
+    Result := false;  //default of false
+    Line := UpperCase(Line);
+    if (Pos('<!DOCTYPE HTML',Line) > 0) 
+      or (Pos('<HTML>',Line) > 0) 
+      or (Pos('</BODY>',Line) > 0)then begin
+      Result := true;
+    end;
+  end;
+
+  
+  function IsHTML(Lines : TStrings): boolean;
+  //Purpose: To look at the note loaded into Lines and determine if it is
+  //          an HTML document.  See other IsHTML(String) function for test used.
+  begin
+    Result := false;  
+    if Lines = nil then exit;
+    Result := IsHTML(Lines.Text);
+    if Result = true then ScanForSubs(Lines);  
+  end;
+
+  
+  function HasHTMLTags(Text: string) : boolean;
+    function GetTag(p1,p2 : integer; var Text : string) : string;
+    var i : integer;
     begin
-      HTMLfilename := ExtractFilePath(ParamStr(0)) + 'printing_html_note.html';
-      Lines.SaveToFile(HTMLfilename);  //write the note to a file,
-      frmNotes.WebBrowser1.Navigate(HTMLfilename);  //now navigate to file.
-      ActivateWebBrowser;
-      Status := frmNotes.WebBrowser1.QueryStatusWB(OLECMDID_PRINT);  //"can you print?" -- get print command status
-      //Note: If I print multiple documents, I think there may be a problem if
-      //      document #2 asks to print, and it is not yet done with doc #1
-      //      As it is now, it will simply report an error.  Solutions would
-      //      be to wait a certain period of time and then ask for status again.
-      //      OR, I could wait after printing until it is done....
-      WaitForBrowserOK(10); //wait up to 10 seconds
-      if (Status and OLECMDF_ENABLED)>0 then begin
-        frmNotes.WebBrowser1.ExecWB(OLECMDID_PRINT,OLECMDEXECOPT_PROMPTUSER);
-        //Here I want to wait until it is done printing.
-        //Note: this doesn't do what I want.  Status is immediately OK.
-        WaitForBrowserOK(10); //wait up to 10 seconds
+      Result := MidStr(Text,p1, p2-p1);
+      if Result[1] = '/' then Result := MidStr(Result,2,999);
+      i := Pos(' ',Result);
+      if i >0 then Result := MidStr(Result,1,i-1);
+    end;
+    
+  var p1,p2: integer;
+      Tag : string;
+  begin
+    Result := False; //default to ignore
+    Text := UpperCase(Text);
+    if (Pos('&NBSP;',Text)>0) then Result := true
+    else if (Pos('<P>',Text)>0) then Result := true
+    else if (Pos('<BR>',Text)>0) then Result := true
+    else if (Pos('<HTML>',Text)>0) then Result := true
+    else begin
+      p1 := Pos('<',Text); if p1 = 0 then exit;
+      p2 := Pos('>',Text); if p2 = 0 then exit;
+      Tag := GetTag(p1,p2,Text);
+      if Tag='' then exit;
+      if Pos('/'+Tag+'>',Text)>0 then result := true;      
+    end;
+    {
+    if (Pos('<BR>',Text)>0) or
+       (Pos('</P>',Text)>0) or
+       (Pos('<UL>',Text)>0) or
+       (Pos('</UL>',Text)>0) or
+       (Pos('<LI>',Text)>0) or
+       (Pos('</LI>',Text)>0) or
+       (Pos('<OL>',Text)>0) or
+       (Pos('</OL>',Text)>0) or
+       (Pos('&NBSP;',Text)>0) or
+       (Pos('<P>',Text)>0) then begin
+      Result := true;
+    end;            
+    }
+  end;
+    
+  
+  function LineAfterTag(Lines : TStrings; Tag : string) : integer;
+  //returns index of line directly after tag (-1 if not found)
+  //Note: only 1st tag is found (stops looking after that)
+  var p,i : integer;
+      s,s1,s2 : string;
+  begin
+    result := -1;  
+    Tag := UpperCase(Tag);
+    for i := 0 to Lines.Count-1 do begin
+      s := UpperCase(Lines.Strings[i]);
+      p := Pos(Tag,s);
+      if p=0 then continue;
+      if (p+length(Tag)-1) < length(s) then begin  //extra stuff after tag on line --> split line
+        s1 := MidStr(Lines.Strings[i],1,p+length(Tag)-1);
+        s2 := MidStr(Lines.Strings[i],p+length(Tag),9999);
+        Lines.Strings[i] := s1;
+        Lines.Insert(i+1,s2);            
+      end;
+      //Lines.Insert(i+1,'');    
+      result := i+1;
+      break;
+    end;
+  end;
+
+  function LineBeforeTag(Lines : TStrings; Tag : string) : integer;
+  //returns index of newly added blank line, directly before tag (-1 if not found)
+  //Note: only 1st tag is found (stops looking after that)
+  var p,i,idx : integer;
+      s,s1,s2 : string;
+  begin
+    result := -1;  
+    idx := -1;
+    Tag := UpperCase(Tag);
+    for i := 0 to Lines.Count-1 do begin
+      s := UpperCase(Lines.Strings[i]);
+      p := Pos(Tag,s);
+      if p>0 then begin
+        idx := i;
+        break;
+      end;  
+    end;  
+    if idx <> -1 then begin
+      p := Pos(Tag,UpperCase(Lines.Strings[idx]));
+      if p>1 then begin  //extra stuff after tag on line --> split line
+        s1 := MidStr(Lines.Strings[idx],1,p-1);
+        s2 := MidStr(Lines.Strings[idx],p,9999);
+        Lines.Strings[idx] := s1;
+        Lines.Insert(idx+1,s2);
+        inc(idx);
+      end;
+      //Lines.Insert(idx-1,'');    
+      result := idx;
+    end;
+  end;
+
+  procedure SplitLineAfterTag(Lines : TStrings; Tag : string);
+  //Purpose: To ensure that text that occurs after Tag is split and wrapped
+  //         to the next line.
+  //Note: It is assumed that tag is in form of <TAGName> or <SomeReallyLongText...
+  //      if a closing '>' is not provided in the tag name, then the part provided
+  //      is used for matching, and then a search for the closing '>' is made, and
+  //      the split will occur after that.
+  //Note: Only the first instance of Tag will be found, stops searching after that.
+  //Note: Tag beginning and ending MUST occur on same line (wrapping of a long tag NOT supported)
+  var i,p1,p2 : integer;
+      s,s1,s2 : string;
+  begin
+    Tag := UpperCase(Tag);
+    for i := 0 to Lines.Count-1 do begin
+      s := UpperCase(Lines.Strings[i]);
+      p1 := Pos(Tag,s);    
+      if p1=0 then continue;
+      p2 := PosEx('>',s,p1);
+      if p2=0 then continue;  //this is a problem, no closing '>' found... ignore for now.
+      if p2 = length(s) then break;
+      s1 := MidStr(Lines.Strings[i],1,p2);
+      S2 := MidStr(Lines.Strings[i],p2+1,999);
+      Lines.Strings[i] := s1;
+      Lines.Insert(i+1,s2);
+      break;    
+    end;
+  end;
+
+  procedure SplitLineBeforeTag(Lines : TStrings; Tag : string);
+  //Purpose: To ensure that text that occurs before Tag is split and Tag
+  //         is wrapped to the next line.
+  //Note: It is assumed that tag is in form of <TAGName> or <SomeReallyLongText...
+  //Note: Only the first instance of Tag will be found, stops searching after that.
+  var i,p1 : integer;
+      s1,s2 : string;
+  begin
+    Tag := UpperCase(Tag);
+    for i := 0 to Lines.Count-1 do begin
+      p1 := Pos(Tag,UpperCase(Lines.Strings[i]));    
+      if p1=0 then continue;
+      s1 := MidStr(Lines.Strings[i],1,p1-1);
+      S2 := MidStr(Lines.Strings[i],p1,999);
+      Lines.Strings[i] := s1;
+      Lines.Insert(i+1,s2);
+      break;    
+    end;
+  end;
+
+  function IndexOfHoldingLine(Lines : TStrings; Tag : string) : integer;
+  var i : integer;
+      s : string;
+  begin
+    result := -1;  
+    Tag := UpperCase(Tag);
+    for i := 0 to Lines.Count-1 do begin
+      s := UpperCase(Lines.Strings[i]);
+      if Pos (Tag,s)=0 then continue;
+      result := i;
+      break;
+    end;
+  end; 
+
+  procedure EnsureTrailingBR(Lines : TStrings);
+  var  p,i : integer;
+  begin
+    for i := 0 to Lines.Count-1 do begin   //Ensure each line ends with <BR>
+      p := Pos('<BR>',Lines.Strings[i]);
+      if p+3=length(Lines.Strings[i]) then continue;
+      Lines.Strings[i] := Lines.Strings[i] + '<BR>';          
+    end;
+  end;
+
+  procedure MergeLines(Lines,BeforeLines,AfterLines : TStrings);
+  var  i : integer;
+       Result : TStringList;
+  begin
+    Result := TStringList.Create;
+    SplitLineAfterTag(Lines,'<!DOCTYPE HTML');
+    SplitLineBeforeTag(Lines,'</BODY>');
+    Result.Add(Lines.Strings[0]);  //Should be line with <!DOCTYPE HTML...
+    for i := 0 to BeforeLines.Count-1 do begin  //Add Before-Lines text
+      Result.Add(BeforeLines.Strings[i]);
+    end;
+    for i := 1 to Lines.Count-2 do begin  //Add back regular lines text
+      Result.Add(Lines.Strings[i]);
+    end;
+    for i := 1 to AfterLines.Count-1 do begin //Add After-Lines text
+      Result.Add(AfterLines.Strings[i]);
+    end;
+    Result.Add(Lines.Strings[Lines.count-1]); //Should be '</BODY></HTML>' line
+
+    Lines.Assign(Result);  
+  end;
+
+  procedure StripBeforeAfterHTML(Lines,OutBefore,OutAfter : TStrings);
+  //Purpose: Strip all text that comes before <!DOCTYPE ... line and store in OutBefore;
+  //         Strip all text that comes after </HTML> ... line and store in OutAfter;           
+  var i : integer;
+      DocTypeLine,EndHTMLLine: integer;
+  begin
+    OutBefore.Clear;
+    OutAfter.Clear;
+    DocTypeLine := IndexOfHoldingLine(Lines,'<!DOCTYPE HTML');
+    if DocTypeLine>1 then begin
+      for i := 0 to DocTypeLine-1 do OutBefore.Add(Lines.Strings[i]);
+      for i := 0 to DocTypeLine-1 do Lines.Delete(0);
+    end;
+    EndHTMLLine := IndexOfHoldingLine(Lines,'</HTML>');
+    if (EndHTMLLine>0) and (EndHTMLLine < (Lines.Count-1)) then begin
+      for i := EndHTMLLine+1 to Lines.Count-1 do OutAfter.Add(Lines.Strings[i]);
+      for i := EndHTMLLine+1 to Lines.Count-1 do Lines.Delete(EndHTMLLine+1);
+    end;
+  end;  
+
+  Function FixHTMLCRLF(Text : String) : string;
+  begin
+    Result := AnsiReplaceText(Text,'<NO DATA>',#$1E); //protect sequences we want
+    Result := AnsiReplaceText(Result,'>'+CRLF,'>'#$1F); //protect sequences we want
+    Result := AnsiReplaceText(Result,CRLF,'<BR>'+CRLF); //Add <BR>'s to CrLf's
+    Result := AnsiReplaceText(Result,'>'#$1F,'>'+CRLF); //Restore sequences we wanted
+    Result := AnsiReplaceText(Result,#$1E,'<NO DATA>'); //Restore sequences we wanted
+  end;
+  
+
+  procedure FixHTML(Lines : TStrings); //kt 6/20/09
+  //Purpose: to put header info that VistA adds to note into proper formatting.  
+  var  BeforeLines,AfterLines : TStringList;
+  begin
+    BeforeLines := TStringList.Create;
+    AfterLines := TStringList.Create;
+    StripBeforeAfterHTML(Lines,BeforeLines,AfterLines);
+    EnsureTrailingBR(BeforeLines);
+    if BeforeLines.Count>0 then begin  //Wrap Before-Lines with formatting
+      BeforeLines.Insert(0,'<CODE>'); 
+      //<---Existing text remains in between --->
+      BeforeLines.Add('</CODE>');  
+      BeforeLines.Add('<HR><P>');  //horizontal line
+    end;
+    EnsureTrailingBR(AfterLines);  
+    if AfterLines.Count > 0 then begin  //Wrap After-Lines with formatting
+      AfterLines.Insert(0,'<P><CODE>'); 
+      //<---Existing text remains in between --->
+      AfterLines.Add('</CODE>');  
+    end;
+    MergeLines(Lines,BeforeLines,AfterLines);    
+    BeforeLines.Free;
+    AfterLines.Free;
+  end;
+  
+  procedure SplitToArray (HTMLText: string; Lines : TStrings);
+  var tempS                 : string;
+    InEscapeCode, InTagCode : boolean;
+    i, LastGoodBreakI       : integer;
+    TagStart,TagEnd         : integer;
+    TagText                 : string;
+    TextLen                 : integer;
+    MaxLineLen              : integer;
+  begin
+    Lines.Clear;
+    MaxLineLen := 80;
+    Repeat
+      InEscapeCode := False;
+      InTagCode := False;
+      LastGoodBreakI := 0;
+      TextLen := length(HTMLText);
+      TagText := '';
+      TagStart := 0; TagEnd := 0;
+      if TextLen > 80 then TextLen := MaxLineLen;
+      for i := 1 to TextLen do begin
+        if (HTMLText[i] = '<') then begin
+          InTagCode := True;
+          TagStart := i;
+          TagText := '';
+          LastGoodBreakI := i-1;
+        end;
+        if (HTMLText[i] = '&') then begin
+          InEscapeCode := True;
+          LastGoodBreakI := i-1;
+        end;
+        if InEscapeCode and (HTMLText[i] = ';') then begin   
+          InEscapeCode := False;
+          LastGoodBreakI := i;
+        end;
+        if InTagCode and (HTMLText[i] = '>') then begin   
+          InTagCode := False;
+          TagEnd := i;
+          TagText := UpperCase(MidStr(HTMLText,TagStart+1,(TagEnd-TagStart-1)));
+          LastGoodBreakI := i;
+        end;
+        if (HTMLText[i] = ',') and (MaxLineLen > 80) then begin   
+          LastGoodBreakI := i;        
+          break;
+        end;
+        if (TagText='BR') or (TagText='/P') then begin
+          LastGoodBreakI := TagEnd;
+          break;
+        end else TagText := '';;  
+        if (not InTagCode) and (not InEscapeCode) 
+        and (HTMLText[i] = ' ') then LastGoodBreakI  := i;
+      end;    
+      if LastGoodBreakI > 0 then begin
+        tempS := MidStr(HTMLText,1,LastGoodBreakI);   //get next 80 chars, or less if at the end.
+        HTMLText := Rightstr(HTMLText, length(HTMLText)- LastGoodBreakI);    //characters 81 ... the end
+        Lines.Add(tempS);      
       end else begin
-        ErrMsg := 'The web browser reports being unable to print.  Trying printing this document by itself.';
-      end;
-    end;
-  finally
+        if MaxLineLen < 250 then begin
+          MaxLineLen := 250; //emergency mode      
+        end else begin  //i.e. couldn't find any break within 250 chars. So just chop off.
+          tempS := MidStr(HTMLText,1,80);   
+          HTMLText := Rightstr(HTMLText, length(HTMLText)- 80);    //characters 81 ... the end
+          Lines.Add(tempS);      
+        end;  
+      end;  
+    until length(HTMLText)=0;
+   end;      
+  
+
+  function WrapHTML(HTMLText : string) : string; //kt 6/3/09
+  //Purpose: take HTML formatted text and sure it has proper headers and footers etc.
+  //         i.e. 'wrap' partial HTML into formal format.
+  begin
+    if Pos('<BODY>',HTMLText)=0 then HTMLText := '<BODY>' + HTMLText;    
+    if Pos('</BODY>',HTMLText)=0 then HTMLText :=  HTMLText + '</BODY>';      
+    if Pos('<HTML>',HTMLText)=0 then HTMLText := '<HTML>' + HTMLText;    
+    if Pos('</HTML>',HTMLText)=0 then HTMLText :=  HTMLText + '</HTML>';      
+    if Pos('<!DOCTYPE HTML',HTMLText)=0 then begin    
+      HTMLText := '<!DOCTYPE HTML PUBLIC "-//WC3//DTD HTML 3.2//EN">'+ #10#13 + HTMLText;
+    end;
+    result := HTMLText;
+  end;
+
+  function UnwrapHTML(HTMLText : string) : string; 
+  //Purpose: take HTML formatted text and remove proper headers and footers etc.
+  //         i.e. 'unwrap' formal HTML into partial HTML format.
+  begin
+    HTMLText := piece(HTMLText,'<HTML>',2);
+    HTMLText := piece(HTMLText,'</HTML>',1);
+    HTMLText := piece(HTMLText,'<BODY>',2);
+    HTMLText := piece(HTMLText,'</BODY>',1);
+    result := HTMLText;
+  end;
+
+  function CheckForImageLink(Lines: TStrings; ImageList : TStringList) : boolean;
+  {Purpose:  To scan memNote memo for a link to an image.  If found, return link(s)
+   input:  none:
+   output:  Will return a string list holding 1 or more links
+   Notes:  Here will be the <img ..  > format scanned for:
+
+        Here is some opening text...
+          <img src="http://www.geocities.com/kdtop3/OpenVistA.jpg" alt="Image Title 1">
+        And here is some more text
+          <img src="http://www.geocities.com/kdtop3/OpenVistA_small.jpg" alt="Image Title 2">
+        And the saga continues...
+          <img src="http://www.geocities.com/kdtop3/pics/Image100.gif" alt="Image Title 3">
+           As with html, end-of-lines and white space is not preserved or significant
+  }
+
+    function GetBetween (var Text : AnsiString; OpenTag,CloseTag : string;
+                         KeepTags : Boolean) : string;
+    {Purpose: Gets text between Open and Close tags.  Removes any CR's or LF's
+     Input: Text - the text to work on.  It IS changed as code is removed
+            KeepTags - true if want tag return in result
+                       false if tag not in result (still is removed from Text)
+     Output: Text is changed.
+             Result=the code between the opening and closing tags
+     Note: Both OpenTag and CloseTag MUST be present for anything to happen.
+    }
+
+      procedure CutInThree(var Text : AnsiString; p1, p2 : Integer; var s1,s2,s3 : AnsiString);
+      {Purpose: Cut input string Text into 3 parts, with cut points given by p1 & p2.
+                p1 points to first character to be in s2
+                p2 points to last character to be in s2        }
+      begin
+        s1 := ''; s2 := '';  s3 := '';
+        if p1 > 1 then s1 := MidStr(Text, 1, p1-1);
+        s2 := MidStr(Text, p1, p2-p1+1);
+        s3 := MidStr(Text, p2+1, Length(Text)-p2);
+      end;
+
+    var
+      p1,p2 : integer;
+      s1,s2,s3 : AnsiString;
+
     begin
-      //any needed final code goes here.
-    end;
-  end;
-end;
-
-
-procedure WaitForBrowserOK(MaxSecDelay: integer);
-var
-  CumulativeDelay : integer;
-  Status: OLECMDF;
-  MaxMSDelay: integer;
-
-const
-  DelayStep = 1000;
-begin
-  MaxMSDelay:=MaxSecDelay*1000;
-  CumulativeDelay := 0;
-  while ((Status and OLECMDF_ENABLED)<=0) and (CumulativeDelay < MaxMSDelay) do begin
-    sleep(DelayStep);
-    CumulativeDelay := CumulativeDelay + DelayStep;
-    Status := frmNotes.WebBrowser1.QueryStatusWB(OLECMDID_PRINT);  //"can you print?" -- get print command status
-    //Beep;
-  end;
-end;
-
-
-Procedure ScanForSubs(Lines : TStrings);
-//Purpose: To scan note for constant $CPRS$ and replace with CPRS's actual directory
-var i : integer;
-    CPRSDir : string;
-begin
-  for i := 0 to Lines.Count-1 do begin
-    if Pos('$CPRSDIR$',Lines.Strings[i])>0 then begin
-      CPRSDir := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
-      Lines.Strings[i] := AnsiReplaceStr(Lines.Strings[i],'$CPRSDIR$',CPRSDir);
-      //Ensure images are downloaded before passing page to web browser        
-      frmImages.timLoadImagesTimer(nil);  //only downloads 1 image each call
-    end;
-  end;
-end;
-
-
-//kt added following 5-2-05
-function IsHTMLDocument(Lines : TStrings): boolean;
-{purpose: To look at the note loaded into Lines and determine if it is
-          an HTML document.
- Test used: if document contains <!DOCTYPE HTML" or <HTML>
-      This is not a fool-proof test...                                   }
-var
-  i:integer;  s : string;
-begin
-  i := 0;
-  Result := false;  //default of false
-  while (i <= Lines.Count-1) do begin
-    s := UpperCase(Lines.Strings[i]);
-    if (Pos('<!DOCTYPE HTML',s) > 0) or (Pos('<HTML>',s) > 0) then begin
-      Result := true;
-      break;
-    end;
-    Inc(i);
-  end;
-  if Result = true then ScanForSubs(Lines);  
-end;
-//kt end of addition from 5-2-05
-
-
-procedure ActivateWebBrowser;
-begin
-  with frmNotes do begin
-    MemNote.Lines.SaveToFile(HTMLfilename);  //write the note to a file,
-    //kt I later delete the file on destruction of this form (on CPRS exiting)
-    WebBrowser1.Visible := true;
-    WebBrowser1.TabStop := true;
-    WebBrowser1.Navigate(HTMLfilename);  //now navigate to file.
-    WebBrowser1.BringToFront;
-    memNote.Visible := false;
-    memNote.TabStop := false;
-  end;
-end;
-
-procedure ActivateMemo;
-begin
-  with frmNotes do begin
-    WebBrowser1.Visible := false;
-    //WebBrowser1.Navigate('about:blank');  //if I leave this here, "Print Selected" doesn't work properly
-    //DeleteFile(HTMLfilename);  //no error if file doesn't exist.
-    WebBrowser1.TabStop := false;
-    memNote.Visible := true;
-    memNote.TabStop := true;
-    memNote.BringToFront;
-    RedrawActivate(frmNotes.memNote.Handle);
-  end;
-end;
-
-
-
-//kt added the following  1/1/05
-function CheckForImageLink(Lines: TStrings; ImageList : TStringList) : boolean;
-{Purpose:  To scan memNote memo for a link to an image.  If found, return link(s)
- input:  none:
- output:  Will return a string list holding 1 or more links
- Notes:  Here will be the <img ..  > format scanned for:
-
-      Here is some opening text...
-        <img src="http://www.geocities.com/kdtop3/OpenVistA.jpg" alt="Image Title 1">
-      And here is some more text
-        <img src="http://www.geocities.com/kdtop3/OpenVistA_small.jpg" alt="Image Title 2">
-      And the saga continues...
-        <img src="http://www.geocities.com/kdtop3/pics/Image100.gif" alt="Image Title 3">
-         As with html, end-of-lines and white space is not preserved or significant
-}
-
-  function GetBetween (var Text : AnsiString; OpenTag,CloseTag : string;
-                       KeepTags : Boolean) : string;
-  {Purpose: Gets text between Open and Close tags.  Removes any CR's or LF's
-   Input: Text - the text to work on.  It IS changed as code is removed
-          KeepTags - true if want tag return in result
-                     false if tag not in result (still is removed from Text)
-   Output: Text is changed.
-           Result=the code between the opening and closing tags
-   Note: Both OpenTag and CloseTag MUST be present for anything to happen.
-  }
-
-    procedure CutInThree(var Text : AnsiString; p1, p2 : Integer; var s1,s2,s3 : AnsiString);
-    {Purpose: Cut input string Text into 3 parts, with cut points given by p1 & p2.
-              p1 points to first character to be in s2
-              p2 points to last character to be in s2        }
-    begin
-      s1 := ''; s2 := '';  s3 := '';
-      if p1 > 1 then s1 := MidStr(Text, 1, p1-1);
-      s2 := MidStr(Text, p1, p2-p1+1);
-      s3 := MidStr(Text, p2+1, Length(Text)-p2);
+      Result := ''; //default of no result.
+
+      p1 := Pos(UpperCase(OpenTag), UpperCase(Text));
+      if (p1 > 0) then begin
+        p2 := Pos(UpperCase(CloseTag),UpperCase(Text)) + Length(CloseTag) -1;
+        if ((p2 > 0) and (p2 > p1)) then begin
+          CutInThree (Text, p1,p2, s1,Result,s3);
+          Text := s1+s3;
+          //Now, remove any CR's or LF's
+          repeat
+            p1 := Pos (Chr(13),Result);
+            if p1= 0 then p1 := Pos (Chr(10),Result);
+            if (p1 > 0) then begin
+              CutInThree (Result, p1,p1, s1,s2,s3);
+              Result := s1+s3;
+  //            Text := MidStr(Text,1,p1-1) + MidStr(Text,p1+1,Length(Text)-p1);
+            end;
+          until (p1=0);
+          //Now cut off boundry tags if requested.
+          if not KeepTags then begin
+            p1 := Length(OpenTag) + 1;
+            p2 := Length (Result) - Length (CloseTag);
+            CutInThree (Result, p1,p2, s1,s2,s3);
+            Result := s2;
+          end;
+        end;
+      end;
     end;
 
   var
-    p1,p2 : integer;
-    s1,s2,s3 : AnsiString;
-
-  begin
-    Result := ''; //default of no result.
-
-    p1 := Pos(UpperCase(OpenTag), UpperCase(Text));
-    if (p1 > 0) then begin
-      p2 := Pos(UpperCase(CloseTag),UpperCase(Text)) + Length(CloseTag) -1;
-      if ((p2 > 0) and (p2 > p1)) then begin
-        CutInThree (Text, p1,p2, s1,Result,s3);
-        Text := s1+s3;
-        //Now, remove any CR's or LF's
-        repeat
-          p1 := Pos (Chr(13),Result);
-          if p1= 0 then p1 := Pos (Chr(10),Result);
-          if (p1 > 0) then begin
-            CutInThree (Result, p1,p1, s1,s2,s3);
-            Result := s1+s3;
-//            Text := MidStr(Text,1,p1-1) + MidStr(Text,p1+1,Length(Text)-p1);
-          end;
-        until (p1=0);
-        //Now cut off boundry tags if requested.
-        if not KeepTags then begin
-          p1 := Length(OpenTag) + 1;
-          p2 := Length (Result) - Length (CloseTag);
-          CutInThree (Result, p1,p2, s1,s2,s3);
-          Result := s2;
-        end;
-      end;
-    end;
-  end;
-
-var
-  Text : AnsiString;
-  Line : string;
-
-begin
-  Result := false;  //set default
-  if (ImageList <> nil) then begin
+    Text : AnsiString;
+    LineStr : string;
+
+  begin
+    Result := false;  //set default
+    if (ImageList = nil) or (Lines = nil) then exit;
     ImageList.Clear;  //set default
     Text := Lines.Text;  //Get entire note into one long string
     repeat
-      Line := GetBetween (Text, '<img', '>', true);
-      if Line <> '' then begin
-        ImageList.Add(Line);
+      LineStr := GetBetween (Text, '<img', '>', true);
+      if LineStr <> '' then begin
+        ImageList.Add(LineStr);
         Result := true;
       end;
-    until Line = '';
+    until LineStr = '';
     //Note: The following works, but need to replace removed links
     // with "[Title]"   Work on later...
     //memNote.Lines.Text := Text;
   end;
-end;
-
-
-
+
+  function ProtectHTMLSpaces(Text : String) : string;
+  begin
+    Result := AnsiReplaceStr(Text, #9, '&nbsp;&nbsp;&nbsp;&nbsp; ');
+    while Pos('  ',Result)>0 do begin //preserve whitespace
+        Result := AnsiReplaceStr(Result, '  ', '&nbsp;&nbsp;');    
+    end;
+  end;
+
+  function  Text2HTML(Lines : TStrings) : String;
+  //Purpose: Take plain text, and prep for viewing in HTML viewer.
+  //i.e. convert TABs into &nbsp's and add <br> at end of line etc.  
+  var i : integer;
+      tempS : string;
+  begin
+    for i := 0 to Lines.Count-1 do begin
+      tempS := TrimRight(Lines.Strings[i]);
+      if i = Lines.Count-1 then tempS := tempS + '<P>'
+      else tempS := tempS + '<BR>';
+      Lines.Strings[i] := tempS;
+    end;        
+    Result := ProtectHTMLSpaces(Lines.Text)
+  end;
+
+  function Text2HTML(text : string) : String;    overload;
+  var Lines : TStringList;
+  begin
+    Lines := TStringList.create;
+    Lines.Text := text;
+    Result := Text2HTML(Lines);
+    Lines.Free;
+  end;
+
+  type
+    TFontSizeData = record
+      case byte of 1: (Data : array[0..3] of byte);
+                   2: (Size : byte; Filler : array[1..3] of byte);
+    end;    
+    
+  var
+    StoredFontSize : TFontSizeData;
+    FontSizeReg:     TRegistry;
+  
+  procedure SetRegHTMLFontSize(Size: byte);
+  //Purpose: To set the internet explorer Font Size value via the registry.
+  //Expected input: HTML_SMALLEST, HTML_SMALL, HTML_MEDIUM,HTML_LARGE, HTML_LARGEST
+  //         Value should be 0 (smallest) - 4 (largest)
+  const  HTML_BLANK : TFontSizeData =(Data: (0,0,0,0));
+  var  Value : TFontSizeData;
+
+  begin
+    if Size > 4 then Size := 4;
+    Value := HTML_BLANK; Value.Size := Size;
+    FontSizeReg := TRegistry.Create;  //To be freed in RestoreRegHTMLFontSize
+    try
+      FontSizeReg.Rootkey := HKEY_CURRENT_USER;
+      if FontSizeReg.OpenKey('\Software\Microsoft\Internet Explorer\International\Scripts\3', False) then begin
+        FontSizeReg.ReadBinaryData('IEFontSize',StoredFontSize,Sizeof(StoredFontSize));
+        FontSizeReg.WriteBinaryData('IEFontSize',Value,SizeOf(Value));
+      end;
+    finally
+    end;
+  end;
+
+  procedure RestoreRegHTMLFontSize;
+  //Purpose: To restore the Internet Explorer zoom value to a stored value..
+  //elh 6/19/09
+  begin
+    if not assigned(FontSizeReg) then FontSizeReg := TRegistry.Create;
+    try
+      FontSizeReg.WriteBinaryData('IEFontSize',StoredFontSize,SizeOf(StoredFontSize));
+    finally
+      FontSizeReg.Free;
+    end;
+  end;
+
+  var
+    StoredIEHeader, StoredIEFooters : string;
+    Reg : TRegistry;
+   
+  procedure SetupHTMLPrinting(Name,DOB,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
+  //NOTE: There does not seem to be any other way to do this programatically.
+  var NewHeader,NewFooter : string;
+  begin
+    if DesiredHTMLFontSize > 0 then begin
+      SetRegHTMLFontSize(DesiredHTMLFontSize-1);   //Downsize by 1 step
+    end;  
+    NewHeader := Location + ' &b ' + Institution + ' &b Printed: &d &t';
+    NewFooter := Name + ' &b DOB: ' + DOB + ' &b &p of &P';
+    Reg := TRegistry.Create;  //to be freed in RestoreIEPrinting
+    try
+      Reg.Rootkey := HKEY_CURRENT_USER;
+      if Reg.OpenKey('\Software\Microsoft\Internet Explorer\PageSetup', False) then begin
+        StoredIEFooters := Reg.ReadString('footer');
+        StoredIEHeader := Reg.ReadString('header');
+        Reg.WriteString('header',NewHeader);
+        Reg.WriteString('footer',NewFooter);
+      end;
+    finally 
+    end;
+  end;
+
+  procedure RestoreIEPrinting;
+  //Purpose: To restore the IE header and footer registry with the initial value
+  //elh 6/19/09
+  begin
+    if not assigned(Reg) then Reg := TRegistry.Create;
+    try
+      Reg.WriteString('footer',StoredIEFooters);
+      Reg.WriteString('header',StoredIEHeader);
+      RestoreRegHTMLFontSize; 
+    finally
+      Reg.Free;
+    end;
+  end;
+
+begin
+  DesiredHTMLFontSize := 2; //probably overwritten in fNotes initialization
 end.
