Zum Inhalt springen

Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie

Links hinzufügen
Aus Wikibooks

Dieses Makro gehört zu Makro zum Report der Mammographie.

Im Quelltext dieses Makros werden die folgenden Makros aufgerufen: 

Option Explicit

Dim MGDATUM As Byte, MGSONOWAHL As Byte

Dim MGVGLDATUM As Date

Public MGUDATUM As Date
Public MGREFIND As Variant, MGAUFN As Variant, MGKV As Variant
Public MGDICHTE As Variant, MGASYM As Variant, MGVORAUFN As Variant
Public MGHERDB As Variant, MGSONO As Variant, MGMKALK As Variant
Public MGSONOVORAUFN As Variant, MGSPSONO As Variant, MGZUSATZ As Variant
Public MGBESCHW As Variant
Public MGBEURT As String, MGREPORT As String
Public MGSONOVGLDATUM As Date

'----

Sub Mammogaphie()
' vom 26.5.04 Wfg
' Regionäre Parenchymasymetrie fehlt
' mammogr cutisverdickung und Trabekelverdickung fehlt
' echogener Randsaum
' quantifizieren malignität
' vertikal, echogenes halo, schallschatten malignitätkriterien

MGDATUM = 0: MGUDATUM = "1.1.1910": MGVGLDATUM = "1.1.1910"
MGSONOVGLDATUM = "1.1.1910"
MGREFIND = "": MGAUFN = "": MGKV = "":
MGDICHTE = "": MGASYM = "": MGVORAUFN = "":
MGHERDB = "": MGSONO = "": MGMKALK = "":
MGSONOVORAUFN = "": MGSPSONO = "": MGZUSATZ = ""
MGREPORT = "": MGBEURT = "":
----
'[[Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmBeschw]] 
' Indikation abfragen und speichern in MGREFIND

MGREFIND = MsgBox("Wenn Befundabklärung, dann Ja." & Chr$(13) & _
    Chr$(13) & "Wenn Befundkontrolle, dann Nein." & Chr$(13) & _
    Chr$(13) & "Wenn Vorsorge, dann " & _
    "Abbrechen", vbYesNoCancel + vbQuestion)

If MGREFIND = 7 Then
    MGREFIND = "Befundkontrolle."
    MGBESCHW = "Beschwerden und Befunde: "
    MGfrmBeschw.Show ' Eingaben in MGBESCHW
End If
If MGREFIND = 6 Then
    MGREFIND = "Befundabklärung."
    MGBESCHW = "Beschwerden und Befunde: "
    MGfrmBeschw.Show ' Eingaben in MGBESCHW
End If
If MGREFIND = 2 Then
    MGREFIND = "Vorsorge."
    MGBESCHW = MsgBox("Bei familiärem Risiko." & Chr$(13) & "Keine Beschwerden und kein klin. Befund?", vbYesNo + vbQuestion + vbDefaultButton2)
    If MGBESCHW = 6 Then
        MGBESCHW = "Beschwerden und Befunde: Familiäres Risiko, keine Beschwerden und kein klin. Befund. "
    Else
        MGBESCHW = "Beschwerden und Befunde: Familiäres Risiko. "
        MGfrmBeschw.Show ' Eingaben in MGBESCHW
    End If
End If
'Datum abfragen speichern in MGUDATUM
MGDATUM = MsgBox("Mg von heute?", vbYesNo + vbQuestion)
If MGDATUM = 6 Then
    MGUDATUM = Date
Else
    MGUDATUM = InputBox("Von welchem Datum?")
End If

'----

' Voraufnahmen abfragen und speichern in MGVORAUFN und MGVORAUFN

MGVORAUFN = MsgBox("Verglichen mit Mammographie- Voraufnahmen?", vbYesNo + vbQuestion)
If MGVORAUFN = 7 Then
    MGVORAUFN = "Kein Vergleich mit Voraufnahmen. "
Else
    MGVGLDATUM = InputBox("Von welchem Datum?")
    MGVORAUFN = "Verglichen mit Voraufnahmen vom " & MGVGLDATUM & ". "
End If

'----

' Sonographie?

MGSONO = MsgBox("Sonographie?", vbYesNo + vbQuestion + vbDefaultButton2)
If MGSONO = 7 Then  'wenn kein Sono
    MGSONO = ""
Else       'wenn sonographiert wurde
    MGSONO = "Mamma- Sonographie und "
    MGSONOVORAUFN = MsgBox("Verglichen mit Sonographie- Voraufnahmen?", vbYesNo + vbQuestion + vbDefaultButton2)
    If MGSONOVORAUFN = 6 Then    'wenn  Vorsonos
        MGSONOVGLDATUM = InputBox("Von welchem Datum?")
    End If
End If 'Sonographie
----
'[[Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmZusatzA]] 
' Standard bds/re-links Zusatzaufnahmen speichern in MGZUSATZ

MGAUFN = MsgBox("Nicht-Standardaufnahmen oder Zusatzaufnahmen, dann JA?" & Chr$(13) & _
Chr$(13) & "Nur Standardaufnahmen beidseits, dann NEIN", vbYesNo + vbQuestion + vbDefaultButton1)

If MGAUFN = 7 Then
    MGAUFN = Chr$(13) & MGSONO & "Mammographie bds. cc und mlo vom " & _
    MGUDATUM & ":" & vbCrLf
End If
If MGAUFN = 6 Then
    MGAUFN = ""
    MGZUSATZ = ""
    MGfrmZusatzA.Show 'Eingaben stecken in MGZUSATZ und MGAUFN
End If

'----

' kV abfragen und speichern in MGKV

MGKV = MsgBox("wenn kV =28, dann JA." & Chr$(13) & _
    "Wenn kV= 27, dann NEIN. " & Chr$(13) & _
    "Wenn kV =26, dann ABBRECHEN", vbYesNoCancel + vbQuestion)
If MGKV = 6 Then MGKV = "28 kV, MinR 2190 Film, MinR 2000 Folie." & MGZUSATZ
If MGKV = 7 Then MGKV = "27 kV, MinR 2190 Film, MinR 2000 Folie." & MGZUSATZ
If MGKV = 2 Then MGKV = "26 kV, MinR 2190 Film, MinR 2000 Folie." & MGZUSATZ

'----

' Nach der Parenchymdichte fragen und speichern in MGDICHTE

MGDICHTE = MsgBox("Wenn fettreich, dann JA. " & Chr$(13) & _
"Wenn mässig dicht, dann NEIN. " & Chr$(13) & _
"Wenn sehr dicht, dann ABBRECHEN", vbYesNoCancel + vbQuestion + vbDefaultButton2)
If MGDICHTE = 6 Then MGDICHTE = "Fettreiches Drüsenparenchym. "
If MGDICHTE = 7 Then MGDICHTE = "Fibroglanduläres Drüsenparenchym. "
If MGDICHTE = 2 Then MGDICHTE = "Dichtes bis sehr dichtes Drüsenparenchym. "
----
'[[Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmAsym]] 
'Nach Asymmetrie fragen und speichern in MGASYM

MGASYM = MsgBox("Asymmetrie? " & Chr$(13) & _
"(inkl. Narben, Architekturstörung, Parenchyminsel, Defekt, Radiatio)", vbYesNo + vbQuestion + vbDefaultButton2)
If MGASYM = 7 Then
    MGASYM = "Keine wesentliche Seitendifferenz. "
Else
    MGASYM = "" 'initialisiern***
    MGfrmAsym.Show 'Eingaben kommen zurück in MGASYM
End If    'Nach Asymmmetrie
----
'[[Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmHerd]] 
'Nach Herd- Befunden fragen und speichern in MGHERDB

MGHERDB = MsgBox("Mammographischer Herdbefund?", vbYesNo + vbQuestion + vbDefaultButton2)
If MGHERDB = 7 Then
    MGHERDB = "Keine Herdbefunde. "
Else
    MGHERDB = "" 'initialisiern***
    MGfrmHerd.Show 'Eingaben kommen zurück in MGHERDB
End If  'Nach Herd- Befunden
----
'[[Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmKalk]]     
' Mikrokalk?

MGMKALK = MsgBox("Mikrokalk Cluster, dann JA. " & Chr$(13) & _
    Chr$(13) & "Makrokalk, dann NEIN. " & Chr$(13) & Chr$(13) & _
    "Kein Kalk, dann ABBRECHEN", vbYesNoCancel + vbQuestion + vbDefaultButton2)
If MGMKALK = 2 Then MGMKALK = "Keine gruppierten Mikroverkalkungen. "
If MGMKALK = 7 Then MGMKALK = "Benigne Makroverkalkungen. "
If MGMKALK = 6 Then
    MGMKALK = "" 'initialisieren***
    MGfrmKalk.Show 'Eingaben kommen zurück in MGMKALK
End If 'Mikrokalk
----
'[[Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie: MGfrmSono]]   
'weitere Sonographiebefunde, ausser den in Mammaherdbefunden beschriebenen?

If MGSONO = "Mamma- Sonographie und " Then   'nur wenn Sonographie
    MGSONOWAHL = MsgBox("Reine Sonographie- Herdbefunde, dann JA." & Chr$(13) & _
    Chr$(13) & "Andere reine Sonographie- Befunde, dann NEIN." & Chr$(13) & _
        Chr$(13) & "Keine weiteren Sonographie- Befunde, dann ABBRECHEN.", vbYesNoCancel + vbQuestion + vbDefaultButton3)
    If MGSONOWAHL = 2 Then
        MGSONO = "Sonographisch kein weiterer Befund. "
        MGSPSONO = ""
    End If
    If MGSONOWAHL = 6 Then
        MGSONO = "" 'initialisieren***
        MGfrmSono.Show ' Eingaben stecken in MGSONO
    End If
    If MGSONOWAHL = 7 Then
        MGSONO = "" 'initialisieren***
    End If
  'nur wenn weitere Sonobefunde
    If MGSONO <> "Sonographisch kein weiterer Befund. " Then
        MGSPSONO = MsgBox("Andere Sonographie- Befunde, dann JA." _
        , vbYesNo + vbQuestion + vbDefaultButton2)
        If MGSPSONO = 6 Then
            MGSPSONO = "" 'initialisieren***
            MGfrmSonoSP.Show ' Eingaben stecken in MGSONOSP
        End If
        If MGSPSONO = 7 Then
            MGSPSONO = "Sonographisch kein weiterer Befund. "
        End If
    End If
End If ' wenn sonographiert wurde
----
'Beurteilung

MGREPORT = MGBESCHW & vbCrLf & "Rechtfertigende Indikation: " & MGREFIND & _
 MGAUFN & vbCrLf & "Technik:" & MGKV & vbCrLf & MGVORAUFN & _
  vbCrLf & "Befunde:" & vbCrLf & MGDICHTE & vbCrLf & MGASYM & vbCrLf & _
    MGHERDB & vbCrLf & MGMKALK & vbCrLf & MGSONO & MGSPSONO & Chr$(13) & "Beurteilung: "
MGBEURT = ""
MGfrmReport.Show ' Eingaben kommen zurück als MGREPORT
'MGREPORT = MGREPORT & Chr$(13) & "Sonst unauffällig."
MsgBox MGREPORT

'----

' einfügen Text steht in der Zwischenablage zum einfügen

    ActiveDocument.Activate
    Selection.GoTo What:=wdGoToBookmark, Name:="Text"
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.TypeText MGREPORT
    Selection.GoTo What:=wdGoToBookmark, Name:="Text"
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend
    Selection.Cut
End Sub
Abgerufen von „https://de.wikibooks.org/w/index.php?title=Makros_für_Radiologen:_Makro_zum_Report_der_Mammographie:_Makro_Mammographie&oldid=731238“