Just a bunch of LibreOffice macros to ease my report reviews at the hospital.

SantaTrans.bas

' SantaTrans
' Transformations for a standardized Santa Casa PACS reports
' Really just a bunch of snippets put together
' -----------------------------------------------------------------------------
' "THE BEER-WARE LICENSE" (commit 34973274ccef6ab4dfaaf86599792fa9c3fe4689):
' <[email protected]> wrote this file. As long as you retain this notice you
' can do whatever you want with this stuff. If we meet some day, and you think
' this stuff is worth it, you can buy me a beer in return. Pablo Lorenzzoni
' -----------------------------------------------------------------------------

Option Explicit

' Get this macro going
Sub Main(optional doc)
  Dim SkipRemoveLastTwoLines as Boolean
  Dim c, iAns, oDoc
  SkipRemoveLastTwoLines = False

  iAns = MsgBox ("Skip RemoveLastTwoLines?", 3)

  If iAns = 2 then End

  If iAns = 6 then
    SkipRemoveLastTwoLines = True
  EndIf

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)

  CleanUp(oDoc)
  
  Italicize(oDoc)

  SetPageSizeA4(oDoc)

  ChangeFontArial12(oDoc)

  ChangeParagraphFormat(oDoc)

  ChangeParagraphSpacing(oDoc)

  JustifyEverything(oDoc)

  CreateTitleAndHeader(oDoc)

  ' Check if we'll skip RemoveLastTwoLines.
  If Not SkipRemoveLastTwoLines then
    RemoveLastTwoLines(oDoc)
  EndIf
End Sub

' CleanUp executes a lot of find and replace operations
' either to fix general formatting or to fix recurrent mistakes
' the typists usually commit.
Sub CleanUp(optional doc)
  Dim oDoc, SearchArray, ReplaceAray, FandR, c, iAns
  oDoc = IIf(IsMissing(doc), ThisComponent, doc) 'Get the current active document or the one passed

  SearchArray = Array("^ *", " *"," *$"," *\t","\t *", "^$", "\t", "evidencia ", "^Adrenais",   "adrenais tem", "^Rins",_
                      "rins tem", "^F.gado" , "^P.ncreas" , "usual a resson.ncia", "esta p.rvi",_
                      "^Art.rias"  , "^Art.ria" , "endoleak "   , "l.quido", "fina extra..o",_
                      "^Esta bem", "v.sico vaginal", "reto vaginal", "^Reto espa.o pr." , "^Baço tem",_
                      "^A aorta abdominal e veia", "evidênciad", "femura", "p.rvia e têm", "evidênciando",_
                      "^. .squerda" , "^. .ireita" , "p.rvias e tem", "esta p.rvia", ".adol.n.o",_
                      "([^ ])\( ", "signifcativ" , "fora de fase", "a.rtica em il.acas", "sitio",_
                      "t.bio fibular", "equ.ncia", "calcarias", "sigm.ide", "iluminado", "iluminada",_
                      "urinaria", "substancia", "mantem", "pervia", "cerebrais medias", "intra ou extra-", "intra e extra-",_
                      "encef.lico e hemisf.rio cerebelar ", "secal", "serie", "observad.s altera..es",_
                      "n.vel l.quido l.quido", "proteico", "pode se determinar", "seco", "f.gado",_
                      "diagn.stico", "c.lculo", "l.quido", "rins inativos", "amontante", "prim.ria",_
                      "prim.rio", "cuja a ", "cujo o", "ou di.ria", "est. pervi", "est. oclu.d", "heterog.nia",_
                      "p.rvios e tem", "p.rvias e tem", "p.rvio e t.m", "p.rvia e t.m", "flovoide",_
                      "pápila", "equitasic", "porem", "ulcera ", "úlceração", "est. bem demonstrad",_
                      "restri..o . difus.o", ". calcifica..es", "linha m.dia", "orbita", "porem", "by-pass",_
                      "distr.ficas", "ureter pielocalicinal", " , ", "n.mero ", "cl.nica ", "p.lipo ",_
                      "pr. operat.rio", "p.lipo\.", "pr. sacral", "flow voide", "flow-void", "^est. bem",_
                      "Por..o intracraniana das art.rias vertebrais e arteria basilar", "agr.ficos", "agrafos",_
                      "A art.rial femoral", " ate ", "braquio cef.lico", "algumaa", "as vezes", "As vezes",_
                      "causa pancre.tica", "retr.grada", "retr.grado")

  ReplaceAray = Array("", " " ,""   ,"\t"  ,"\t"  , ""  , ""  , "evidência ", "As adrenais", "adrenais têm", "Os rins",_
                      "rins têm", "O fígado", "O pâncreas", "usual à ressonância", "está pérvi",_
                      "As artérias", "A artéria", "endoleaking ", "líquido", "fenestração",_
                      "Está bem", "vesicovaginal"  , "retovaginal" , "Reto e espaço pré", "O baço tem",_
                      "Aorta abdominal e veia"   , "evidenciad", "femora", "pérvia e tem", "evidenciando",_
                      "\nÀ esquerda", "\nÀ direita", "pérvias e têm", "está pérvia", "gadolíneo",_
                      "$1 ("     , "significativ", "fora-de-fase", "aórtica-em-ilíacas", "sítio",_
                      "tíbio-fibular", "equência", "calcárias", "sigmoide", "inominado", "inominada",_
                      "urinária", "substância", "mantém", "pérvia", "cerebrais médias", "intra- ou extra-", "intra- e extra-",_
                      "encefálico e hemisférios cerebelares ", "cecal", "série", "observadas alterações",_
                      "nível líquido-líquido", "protéico", "pode ser determinada", "ceco", "fígado",_
                      "diagnóstico", "cálculo", "líquido", "rins nativos", "a montante", "primária",_
                      "primário", "cuja ", "cujo ", "ou de área", "está pérvi", "está ocluíd", "heterogênea",_
                      "pérvios e têm", "pérvias e têm", "pérvio e tem", "pérvia e tem", "flow void",_
                      "papila", "ectásic", "porém", "úlcera ", "ulceração", "está bem demonstrad",_
                      "restrição à difusão", "a calcificações", "linha média", "órbita", "porém", "bypass",_
                      "distróficas", "ureteropielocalicinal", ", ", "número ", "clínica ", "pólipo ",_
                      "pré-operatório", "pólipo.", "pré-sacral", "flow void", "flow void", "Está bem",_
                      "A porção intracraniana das artérias vertebrais e a artéria basilar", "agrafes", "agrafes",_
                      "A artéria femoral", " até ", "braquiocefálico", "algumas", "às vezes", "Às vezes",_
                      "causa pancreática", "retrógrada", "retrógrado")

  FandR = oDoc.createReplaceDescriptor
  FandR.searchRegularExpression = True

  For c = 0 to uBound(SearchArray)
    FandR.setSearchString(SearchArray(c))
    FandR.setReplaceString(ReplaceAray(c))
    oDoc.ReplaceAll(FandR)
  Next c
End Sub

' Italicize executes some find operations
' to apply italics to common foreign (non-pt_BR) expressions
Sub Italicize(optional doc)
  Dim oDoc, SearchArray, FandR, c, target, d, foundText, iAns
  oDoc = IIf(IsMissing(doc), ThisComponent, doc) 'Get the current active document or the one passed

  SearchArray = Array("stent ", "Stent ", "skin-to-stone distance", "washout", "Spin Echo", "spin echo",_
                      "bypass", "flow void", "Flow void")

  FandR = oDoc.createReplaceDescriptor
  FandR.searchRegularExpression = True

  For c = 0 to uBound(SearchArray)
    FandR.searchString = SearchArray(c)
    target = oDoc.findAll(FandR)
    For d = 0 to target.count - 1
      foundText = target.getByIndex(d)
      foundText.CharPosture = com.sun.star.awt.FontSlant.ITALIC
    Next d
  Next c
End Sub

' We just use A4 paper. Sometimes a word processor have US Letter as default
Sub SetPageSizeA4(optional doc)
  Dim oDoc, oStyle

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)
  oStyle = oDoc.StyleFamilies.getByName("PageStyles").getByName("Standard")

  ' units of 1/1000 cm
  oStyle.IsLandscape = False
  oStyle.Width = 21000
  oStyle.Height = 29700
End Sub

' I like my reports with same font and size
' This uses UNO since it was first recorded with "Record Macro" facility
' what a shame! :-)
Sub ChangeFontArial12(optional doc)
  Dim oDoc, oDispatcher, oFrame
  Dim oArgsFontFamily(4) as new com.sun.star.beans.PropertyValue
  Dim oArgsFontHeight(2) as new com.sun.star.beans.PropertyValue

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)
  oFrame = oDoc.CurrentController.Frame
  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

  ' Select All Text
  oDispatcher.executeDispatch(oFrame, ".uno:SelectAll", "", 0, Array())

  ' Change Font Family
  oArgsFontFamily(0).Name = "CharFontName.StyleName"
  oArgsFontFamily(0).Value = ""
  oArgsFontFamily(1).Name = "CharFontName.Pitch"
  oArgsFontFamily(1).Value = 2
  oArgsFontFamily(2).Name = "CharFontName.CharSet"
  oArgsFontFamily(2).Value = -1
  oArgsFontFamily(3).Name = "CharFontName.Family"
  oArgsFontFamily(3).Value = 5
  oArgsFontFamily(4).Name = "CharFontName.FamilyName"
  oArgsFontFamily(4).Value = "Calibri"

  oDispatcher.executeDispatch(oFrame, ".uno:CharFontName", "", 0, oArgsFontFamily())

  ' Change Font Size
  oArgsFontHeight(0).Name = "FontHeight.Height"
  oArgsFontHeight(0).Value = 12
  oArgsFontHeight(1).Name = "FontHeight.Prop"
  oArgsFontHeight(1).Value = 100
  oArgsFontHeight(2).Name = "FontHeight.Diff"
  oArgsFontHeight(2).Value = 0

  oDispatcher.executeDispatch(oFrame, ".uno:FontHeight", "", 0, oArgsFontHeight())
End Sub

' It's amazing how different typists have different standards wrt paragraphing
' This normalizes the paragraph into my standards
' Also uses UNO. I am getting lazy...
Sub ChangeParagraphFormat(optional doc)
  Dim oDoc, oDispatcher, oFrame
  Dim oArgsParagraphStyle(7) as new com.sun.star.beans.PropertyValue

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)
  oFrame = oDoc.CurrentController.Frame
  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

  ' Select All Text
  oDispatcher.executeDispatch(oFrame, ".uno:SelectAll", "", 0, Array())

  ' Change Paragraph Style
  oArgsParagraphStyle(0).Name = "LeftRightMargin.LeftMargin"
  oArgsParagraphStyle(0).Value = 0
  oArgsParagraphStyle(1).Name = "LeftRightMargin.TextLeftMargin"
  oArgsParagraphStyle(1).Value = 0
  oArgsParagraphStyle(2).Name = "LeftRightMargin.RightMargin"
  oArgsParagraphStyle(2).Value = 0
  oArgsParagraphStyle(3).Name = "LeftRightMargin.LeftRelMargin"
  oArgsParagraphStyle(3).Value = 100
  oArgsParagraphStyle(4).Name = "LeftRightMargin.RightRelMargin"
  oArgsParagraphStyle(4).Value = 100
  oArgsParagraphStyle(5).Name = "LeftRightMargin.FirstLineIndent"
  oArgsParagraphStyle(5).Value = 1250
  oArgsParagraphStyle(6).Name = "LeftRightMargin.FirstLineRelIdent"
  oArgsParagraphStyle(6).Value = 100
  oArgsParagraphStyle(7).Name = "LeftRightMargin.AutoFirst"
  oArgsParagraphStyle(7).Value = false

  oDispatcher.executeDispatch(oFrame, ".uno:LeftRightMargin", "", 0, oArgsParagraphStyle())
End Sub

' Rather than working every paragraph with a style I just justify everything
' and work from there to change what is different.
' Lazy UNO warning applies
Sub JustifyEverything(optional doc)
  Dim oDoc, oDispatcher, oFrame
  Dim oArgsParagraphStyle(0) as new com.sun.star.beans.PropertyValue

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)
  oFrame = oDoc.CurrentController.Frame
  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

  ' Select All Text
  oDispatcher.executeDispatch(oFrame, ".uno:SelectAll", "", 0, Array())

  ' Justify Everything
  oArgsParagraphStyle(0).Name = "JustifyPara"
  oArgsParagraphStyle(0).Value = true

  oDispatcher.executeDispatch(oFrame, ".uno:JustifyPara", "", 0, oArgsParagraphStyle())
End Sub

' Put everything in Single Paragraph Spacing with no space between lines.
' Lazy UNO warning applies
Sub ChangeParagraphSpacing(optional doc)
  Dim oDoc, oDispatcher, oFrame
  Dim oArgsLineSpacing(1) as new com.sun.star.beans.PropertyValue
  Dim oArgsTopBottomMargin(3) as new com.sun.star.beans.PropertyValue

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)
  oFrame = oDoc.CurrentController.Frame
  oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

  ' Select All Text
  oDispatcher.executeDispatch(oFrame, ".uno:SelectAll", "", 0, Array())

  ' Change LineSpacing
  oArgsLineSpacing(0).Name = "LineSpacing.Mode"
  oArgsLineSpacing(0).Value = 0
  oArgsLineSpacing(1).Name = "LineSpacing.Height"
  oArgsLineSpacing(1).Value = 100

  oDispatcher.executeDispatch(oFrame, ".uno:LineSpacing", "", 0, oArgsLineSpacing())

  ' Change TopBottomMargin
  oArgsTopBottomMargin(0).Name = "TopBottomMargin.TopMargin"
  oArgsTopBottomMargin(0).Value = 0
  oArgsTopBottomMargin(1).Name = "TopBottomMargin.BottomMargin"
  oArgsTopBottomMargin(1).Value = 0
  oArgsTopBottomMargin(2).Name = "TopBottomMargin.TopRelMargin"
  oArgsTopBottomMargin(2).Value = 100
  oArgsTopBottomMargin(3).Name = "TopBottomMargin.BottomRelMargin"
  oArgsTopBottomMargin(3).Value = 100

  oDispatcher.executeDispatch(oFrame, ".uno:TopBottomMargin", "", 0, oArgsTopBottomMargin())
End Sub

' My reports (and most other radiologists) have a title and a header.
' I like to separate them with blank lines. There's probably a better
' way of doing this rather than using CHR$(13)... but this works.
' Also, this assumes you've applied CleanUp first.
' FIXME
Sub CreateTitleAndHeader(optional doc)
  Dim oDoc, oEnum, oText
  Dim oTextElement as Object

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)
  oEnum = oDoc.Text.createEnumeration()
  oText = oDoc.getText()

  ' Get the first paragrah, this should be the title (if CleanUp was applied)
  oTextElement = oEnum.nextElement
  If oTextElement.supportsService("com.sun.star.text.Paragraph") Then
    ' Just confirms it is a Paragraph and apply formatting and the two blank lines
    oTextElement.ParaAdjust = com.sun.star.style.ParagraphAdjust.CENTER
    oTextElement.CharWeight = com.sun.star.awt.FontWeight.BOLD
    oText.insertString(oTextElement.getEnd(), CHR$(13), False)
    oText.insertString(oTextElement.getEnd(), CHR$(13), False)
  EndIf

  ' Go to the next line, this should be the header...
  oTextElement = oEnum.nextElement
  If oTextElement.supportsService("com.sun.star.text.Paragraph") Then
    ' Just confirms it is a Paragraph and apply the blank line
    oText.insertString(oTextElement.getEnd(), CHR$(13), False)
  EndIf
End Sub

' Typists always write two lines with a 'signature' of the radiologist
' that have dictated the report. If this is my report, I just remove
' them and replace with the automatic signature the PACS editor has.
' If this is not, however, this will not be applied by Main procedure
' since I have to preserve'em.
' Also, there's probably a better way of removing last two lines other
' than counting the enum objects in a iteration and then iterate again
' replacing last two element's String property with ""... This works...
' FIXME
Sub RemoveLastTwoLines(optional doc)
  Dim oDoc, oEnum, oText, c, t
  Dim oTextElement as Object

  oDoc = IIf(IsMissing(doc), ThisComponent, doc)

  ' count the number of elements
  c = 0
  oEnum = oDoc.Text.createEnumeration()
  While oEnum.hasMoreElements
    oEnum.nextElement
    c = c + 1
  Wend

  ' set target
  t = c - 2

  ' enumerate the elements again
  c = 0
  oEnum = oDoc.Text.createEnumeration()
  While oEnum.hasMoreElements
    oTextElement = oEnum.nextElement
    c = c + 1
    If c > t Then
      oTextElement.String=""
      EndIf
  Wend
End Sub