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

Aus Wikibooks
Zur Navigation springen Zur Suche springen

Dieses Makro gehört zu Makro Mammographie – Kurzbeschreibung siehe Makro zum Report der Mammographie.

Option Explicit

Dim FEHLER As Variant
----
Private Sub chkDetailR_Click()

If (Me.chkDetailR.Value = True) Then
    Me.fraLokalR.Enabled = True
End If
End Sub
----
Private Sub chkDetailL_Click()

If (Me.chkDetailL.Value = True) Then
    Me.fraLokalL.Enabled = True
End If
End Sub
----
Private Sub cmdok_Click()

'auf Vollständigkeit prüfen

FEHLER = "" 'variable um bei Fehlern steuern zu können
'Rechts links

If (Me.optRS.Value = True) Or (Me.optLS.Value = True) Or _
 (Me.optBds.Value = True) Then
    If Me.optmlocc.Value = False And _
     Me.optmlo.Value = False And _
      Me.optml.Value = False And _
       Me.optcc.Value = False Then
    FEHLER = "Art"
    End If
End If
If (Me.chkDetailR.Value = True) Then
    If (Me.optObenR.Value = False) And _
     (Me.optUntenR.Value = False) And _
      (Me.optInnenR.Value = False) And _
       (Me.optAussenR.Value = False) And _
        (Me.optZentralR.Value = False) Then
    FEHLER = FEHLER & "Lokalisationsangabe R "
    End If
End If

If (Me.chkDetailL.Value = True) Then
    If (Me.optObenL.Value = False) And _
     (Me.optUntenL.Value = False) And _
      (Me.optInnenL.Value = False) And _
       (Me.optAussenL.Value = False) And _
        (Me.optZentralL.Value = False) Then
    FEHLER = FEHLER & "Lokalisationsangabe L "
    End If
End If

'wenn fehler
If FEHLER <> "" Then
    MsgBox FEHLER, vbCritical
Else

'Standard

    If Me.optRS.Value = True Then MGAUFN = Chr$(13) & MGSONO & "Mammographie rechts "
    If Me.optLS.Value = True Then MGAUFN = Chr$(13) & MGSONO & "Mammographie links "
    If Me.optBds.Value = True Then MGAUFN = Chr$(13) & MGSONO & "Mammographie beidseits "

    If Me.optmlocc.Value = True Then MGAUFN = MGAUFN & "mlo und cc vom " & _
     MGUDATUM & ":" & vbCrLf
    If Me.optmlo.Value = True Then MGAUFN = MGAUFN & "mlo vom " & _
     MGUDATUM & ":" & vbCrLf
    If Me.optml.Value = True Then MGAUFN = MGAUFN & "ml vom " & _
     MGUDATUM & ":" & vbCrLf
    If Me.optcc.Value = True Then MGAUFN = MGAUFN & "cc vom " & _
     MGUDATUM & ":" & vbCrLf

'Zusatz

    If Me.chkmlR.Value = True Or Me.chkmlL.Value = True Then
        MGZUSATZ = " Zusatzaufnahme "
        If Me.chkmlR.Value = True Then MGZUSATZ = MGZUSATZ & "ml rechts"
        If Me.chkmlR.Value = True And Me.chkmlL.Value = True Then MGZUSATZ = MGZUSATZ & " und"
        If Me.chkmlL.Value = True Then MGZUSATZ = MGZUSATZ & "ml links "
        MGZUSATZ = MGZUSATZ & ". "
    End If
    If Me.chkDetailR.Value = True Or Me.chkDetailL.Value = True Then
        MGZUSATZ = MGZUSATZ & " Detailvergrößerungsaufnahme  "
        If Me.optObenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts oben"
        If Me.optUntenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts unten"
        If Me.optInnenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts innen"
        If Me.optAussenR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts aussen"
        If Me.optZentralR.Value = True Then MGZUSATZ = MGZUSATZ & "rechts zentral"
        
        If Me.chkDetailR.Value = True And Me.chkDetailL.Value = True Then MGZUSATZ = MGZUSATZ & " und "
        
        If Me.optObenL.Value = True Then MGZUSATZ = MGZUSATZ & "links oben"
        If Me.optUntenL.Value = True Then MGZUSATZ = MGZUSATZ & "links unten"
        If Me.optInnenL.Value = True Then MGZUSATZ = MGZUSATZ & "links innen"
        If Me.optAussenL.Value = True Then MGZUSATZ = MGZUSATZ & "links aussen"
        If Me.optZentralL.Value = True Then MGZUSATZ = MGZUSATZ & "links zentral"

        MGZUSATZ = MGZUSATZ & ". "
    End If

    Unload MGfrmZusatzA
End If 'wenn Fehler

End Sub
----
Private Sub UserForm_Initialize()

Me.fraLokalR.Enabled = False
Me.fraLokalL.Enabled = False
End Sub