Makros für Radiologen: Makro zum Report der Mammographie: Makro Mammographie
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