' PasteToVision_Correspondence Macro Version 3.005
' Macro created 25/04/2002 by Simon Child
' amended 5/8/02
' © Simon Child 25/04/2002


' INTRODUCTION

' Latest version will be found at www.GPUK.net

' You may use this macro free of charge in your practice, and you may modify it to suit your needs, so long as you retain the copyright notice and you do not distribute it to other practices. 

' If you wish to pass on copies to colleagues please do not do so! Please refer them to www.GPUK.net where they can obtain the latest version and in return www.GPUK.net may gain a little heightened awareness of its services.  

' Please email any improvements and modifications to simon.child@gpuk.net


' BACKGROUND

' This macro is configured for Word 97 to paste scanned and tidied text to the correspondence and attachment section of InPractice Vision software version 3

' It will also work under Word 2000 if you enable the Microsoft Forms 2.0 Object library in Word 2000

' It can also be modified for pasting text to other parts of Vision such as History if that is where you prefer to paste letters.

' It should also work for other clinical systems if you appropriately amend the pasting part of the macro to suit the target in your system


' WORD 2000 additional configuration (not required for Word 97):

   ' Start Word 2000 and go to Tools/Macro/Visual Basic Editor.

   ' In VB Editor go to Project-Normal (which is Word normal.dot) Tools/References

   ' Select (enable) "Microsoft Forms 2.0 Object library"

   ' If you can't find it then browse to locate fm20.dll and add that - this is the Microsoft Forms 2.0 Object library - you may have to tick it after adding it.


' USAGE
   
  ' Actually there are 9 macros here (together with required functions), the only differences between them are the batch numbers, and you can make more batches simply by duplicating the 5 line sections at the beginning of the macro code.

  ' The idea is that for each macro you can place a button on the Word toolbar, labelled Batch_1, Batch_2, etc
	
  ' These are then used according to which batch you are processing, and correspondingly the macro puts almost all of the path to the saved image file in the file name box to create the link to the attachment - all you need to add manually is the number of the page being processed.

  ' When running the macro, Vision Consultation Manager should be setup in Vision 2 "Classic Framework". This is only necessary for _adding_ correspondence using the macro, pasted text and attachments will be visible under Vision 3 as well as under Vision 2 Classic Framework.

  ' Open the patient record which is to receive the correspondence, open "Add Correspondence" dialog (Alt-A O), then switch to Word, select the text to be pasted, and run the macro - e.g. click the button for Batch_1. When the macro stops simply type in the digit of the page of the letter in the batch, e.g. 5 if it is the fifth letter in the pile, and click OK.

  ' If you prefer then it can be amended to also paste the path to the original image at the bottom of the ocr'd and pasted letter, as it did under Vision 2. (see comments in code).

  ' The end result is that the ocr'd text has been pasted to vision correspondence, the image file has been imported to Vision as an attachment, and the ocr'd text has also been pasted to the note of the attachment record (to help identify the attachment).

  ' The directory structure to use to store image files which complements this macro is described in the accompanying report scanreport.rtf to be found at www.GPUK.net 

  ' Since attachments are actually imported into the Vision file structure there is no need to keep the original scanned images in the file structure outside of Vision, but you may prefer to do so for security. 

  ' In fact, if you do not want to keep the images outside of Vision then you could use a simplified version of this macro (contact simon.child@GPUK.net) which does not need to provide for multiple batches and a dated file structure. However I prefer to keep them since Vision files attachments all together in a single directory and I am concerned at the possibility of loss of images if the indexing of this ever becomes corrupted. Having the original images outside of Vision in a dated file structure means that they can be reliably retrieved if ever required (based on determining the date of scanning by the audit trail on the patient record).

 ' Multiple page letters are a bit of nuisance:
   ' Option 1: no need to paste ocr'd text to the attachment note for each page, just to create additional attachments (one per page) with a note PAGE 2, or PAGE 3 or whatever, is sufficient.
   ' OPtion 2 (untested): scan multipage letters as individual batches, and in Omnipage instad of saving each page image as a separate file, save all pages as one file, then you only have to create one attachment and so the macro will cope easily with this.


' INSTALLATION INTO WORD 97 (similar in Word 2000):

 ' Open Word, Select Tools/Macro/Macros

 ' Type any name, e.g. a single letter, and click Create Macro

 ' This will open an editing box for you with a new macro of the name that you just typed

 ' Delete all the text (about four lines) between (and including) Sub yourmacroname () and End sub

 ' Leave the cursor at the very bottom and go to Insert/File and insert this file. Save and exit


' ADDING BUTTONS TO THE WORD 97 TOOLBAR  (Word 2000 probably similar)

 ' On a blank area of the toolbar right click, select Customize/Commands/Macros

 ' Find the first macro and drag it to the toolbar. Confusingly you should not drag it to a blank area but use an active area amongst or just next to some other buttons.

 ' Shorten the name to e.g Batch_1 - Rt click/Name and edit it.

 ' Repeat for other batch buttons


' DIRECTORY STRUCTURE WHICH WORKS WITH THIS MACRO

 ' Create an empty directory structure in the form:

  '  Year-Month-Day number-Batch number

   '  i.e. 2001 contains twelve months, each of which contains 31 days, each of which contains 6 batch folders numbered one to 6.

   ' So the path to June 9th batch 1 would be F:\scans\2001\June\9\Batch 01\

   ' If your scans are saved on a different drive letter/directory you will have to edit the macros accordingly

  ' After scanning a batch of letters in Omnipage 10 do File/Save Images and save them all as individual files to the appropriate Year/Month/Day/Batch directory, giving a filename of today's date and batch e.g. 09-06-01-01. These are automatically suffixed by Omnipage as Page 1.tif, Page 2.tif, etc
  
  ' More details in the report available at www.GPUK.net


' MACRO CODE STARTS HERE

Sub Batch_1()
Dim batchnum
batchnum = "01"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_2()
Dim batchnum
batchnum = "02"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_3()
Dim batchnum
batchnum = "03"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_4()
Dim batchnum
batchnum = "04"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_5()
Dim batchnum
batchnum = "05"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_6()
Dim batchnum
batchnum = "06"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_7()
Dim batchnum
batchnum = "07"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_8()
Dim batchnum
batchnum = "08"
VisionCorrespondence (batchnum)
End Sub

Sub Batch_9()
Dim batchnum
batchnum = "09"
VisionCorrespondence (batchnum)
End Sub


Sub VisionCorrespondence(batchnum)
    
    On Error GoTo NoSelectError

    ' Remove illegal characters from selected text

    TidyText

    On Error GoTo Error1

    ' Copy the letter to clipboard, then to DataObject LetterText, then make
    ' a string "Contents" containing the letter preceded by \\ (to mark data for 
    ' exclusion from GPRD data collection) and ended by one linefeed

    Dim LetterText As New DataObject
    Dim Contents
    Selection.Copy
    LetterText.GetFromClipboard
    Contents = "\\ " + LetterText.GetText(1) + Chr(13) + Chr(10)
    
    On Error GoTo Error2

    ' Get the date, format it and store it with batch and filename info

    Dim Date1, Date2, Message, Path, PathString, FileName, sYear, sMonth, sDay As String
    Date1 = Format(Date, "mmm d yyyy")
    Date2 = Format(Date, "dd-mm-yy")
    sYear = Format(Date, "yyyy")
    sMonth = Format(Date, "mmmm")
    sDay = Format(Date, "dd")
    
    On Error GoTo Error3

    ' Construct filepath
    Path = Chr(34) + "F:\Scans\" + sYear + "\" + sMonth + "\Day " + sDay + "\Batch " + batchnum + "\"
    PathString = "Image file in " + Path + Chr(34) + Chr(13) + Chr(10)
    FileName = Path + Date2 + "-" + batchnum + " Page" + ".tif" + Chr(34) + Chr(13) + Chr(10)

    ' Put the letter text into a DataObject and put it on the clipboard

    Dim PasteString As New DataObject

    'uncomment next line (and comment out the subsequent line) if you want to include filepath in pasted text

    ' PasteString.SetText (Contents) + Chr(13) + Chr(10) + (PathString)

    ' we decided no need to include filepath in pasted text since the orginal image 
    ' is accessible from the attachment dialog

    PasteString.SetText (Contents)


    PasteString.PutInClipboard
     
    On Error GoTo AppNotOpenError

    ' change to Correspondence Add - dialog box should be already open and cursor 
    ' at default position

    AppActivate "Clinical Correspondence - Add"
    Sleep (1)
    
    ' Paste clipboard contents to correspondence

    SendKeys "%yc%p%s^V"
    Sleep (1)

    On Error GoTo Error4

    ' Paste clipboard contents to attachment dialog

    SendKeys "^k%am%s^V"
    Sleep (1)

    On Error GoTo Error5

    ' Get filepath and paste to attachment file link

    Dim FileString As New DataObject
    FileString.SetText (FileName)
        
    On Error GoTo Error6

    FileString.PutInClipboard
    
    On Error GoTo Error7

    ' set document type to Document Image, Out of Practice and paste filepath, then 
    ' stop awaiting manual input of page number

    SendKeys "%yddd%p%a^V{LEFT 5}"

   Exit Sub

   Error1:
   MsgBox "Error1"
   Exit Sub
    
   Error2:
   MsgBox "Error2"
   Exit Sub
    
   Error3:
   MsgBox "Error3"
   Exit Sub
    
   Error4:
   MsgBox "Error4"
   Exit Sub
    
   Error5:
   MsgBox "Error5"
   Exit Sub
    
   Error6:
   MsgBox "Error6"
   Exit Sub
    
   Error7:
   MsgBox "Error7"
   Exit Sub
    
   NoSelectError:
   MsgBox "You have not selected any text to copy to Vision."
   Exit Sub
  
   AppNotOpenError:
   MsgBox "You have not opened the correct correspondence box in the patient's Vision record ready to receive the text of this letter." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Make sure that Vision is running in Classic Framework, that the correct patient is selected, and that the Clinical Correspondence - Add box has been opened - Alt-A O."
   Exit Sub
    
End Sub


Public Function Sleep(interval)

    ' Sleep to allow paste etc to complete
     
    Dim PauseTime As Single, Start As Single, Finish As Single, TotalTime As Single

    PauseTime = interval    ' Set duration.
    Start = Timer    ' Set start time.
    Do While Timer < Start + PauseTime
    DoEvents    ' Yield to other processes.
    Loop

End Function


Public Function TidyText()

     ' Remove illegal characters from selected text
        
     'Replace tabs by spaces
    Call ReplaceChars("^t", " ")
     
     ' Replace invalid apostrophes with ascii apostrophes
    Call ReplaceChars(Chr(180), "'")
    Call ReplaceChars(Chr(145), "'")
    Call ReplaceChars(Chr(146), "'")
    
     'Replace curly "
    Call ReplaceChars(Chr(147), "'")
    Call ReplaceChars(Chr(148), "'")
    
     'Replace half, degrees etc
    Call ReplaceChars(Chr(188), ".25")
    Call ReplaceChars(Chr(189), ".5")
    Call ReplaceChars(Chr(190), ".75")
    Call ReplaceChars(Chr(186), "degrees")
       
     ' Replace hyphens
    Call ReplaceChars(Chr(173), Chr(45))
    Call ReplaceChars(Chr(150), Chr(45))
    Call ReplaceChars(Chr(151), Chr(45))
    
    Sleep (1)
     
End Function


Public Function ReplaceChars(illegal, legal)

  Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = illegal
        .Replacement.Text = legal
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
  Selection.Find.Execute replace:=wdReplaceAll

End Function