Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation: Start Makro und Userframe frmSkalkulator und frmknkalkulator

Dieses Makro gehört zu Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation.
frmSkalkulator Code

'**********Fragt nach Problemen mit KM, Allergie,Asthma*********

Option Explicit
------------------------
Private Sub UserForm_Initialize()

Me.labid.Caption = ID

Me.labmta.Caption = MTA

End Sub
----------------------
Private Sub cmdnein_Click()

PROTOKOLL = ID & ", " & MTA & ", " & Now & _

", " & "KM & Allergie ok"

Unload frmSkalkulator

frmSsd.Show

End Sub
----------------------
Private Sub cmdprobleme_Click()

PROTOKOLL = ID & ", " & MTA & ", " & Now

Unload frmSkalkulator

frmkmkalkulator.Show

End Sub

===frmkmkalkulator Code===

[[Image:Frmkmkalkulator.png]]

'***********Fragt nach Atemnot,vorheriger KM Gabe und KM Reaktion*************

Option Explicit

Dim DYS As Byte

Dim VORHER As Byte
---------
Private Sub UserForm_Initialize()

Me.labid.Caption = ID

Me.labmta.Caption = MTA

Me.cmdkmr.Visible = False

Me.cmdKn1.Visible = False

Me.cmddyspnoe.Visible = True

Me.cmdKn2.Visible = True

Me.cmd72.Visible = False

Me.cmdKn3.Visible = False

Me.cmdniekm.Visible = False

End Sub
-----------
Private Sub cmddyspnoe_Click()

PROTOKOLL = PROTOKOLL & ", " & "Dyspnoe"

DYS = MsgBox("Rücksprache mit dem Arzt wegen Atembeschwerden. " & vbCrLf & "Bei " & _

"Anweisung: Untersuchung mit KM, dann ja." & vbCrLf & _

"Bei Anweisung: nur NATIV, dann nein." & vbCrLf & _

"Keine Untersuchung, dann abbrechen.", vbYesNoCancel + vbCritical + vbApplicationModal)

    If DYS = 6 Then
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: KM"
        frmkmkalkulator.cmddyspnoe.Visible = False
        frmkmkalkulator.cmdKn2.Visible = False
        frmkmkalkulator.cmd72.Visible = True
        frmkmkalkulator.cmdKn3.Visible = True
    End If
    If DYS = 7 Then
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: NATIV"
        REPORT = "Nur NATIV nach Anweisung." & vbCrLf & "(" & PROTOKOLL & ")"
        MsgBox REPORT
        Call Ausdruck(REPORT)
        End
    End If
    If DYS = 2 Then
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
        REPORT = "Keine Untersuchung nach Anweisung." & vbCrLf & "(" & PROTOKOLL & ")"
        MsgBox REPORT
          Call Ausdruck(REPORT)
        End
    End If
End Sub
---------------------
Private Sub cmdKn2_Click()

PROTOKOLL = PROTOKOLL & ", " & "keine Dyspnoe"

frmkmkalkulator.cmddyspnoe.Visible = False

frmkmkalkulator.cmdKn2.Visible = False

frmkmkalkulator.cmd72.Visible = True

frmkmkalkulator.cmdKn3.Visible = True

End Sub
------------------
Private Sub cmd72_Click()

PROTOKOLL = PROTOKOLL & ", " & "vorher KM"

VORHER = MsgBox("Rücksprache mit dem Arzt. " & vbCrLf & "Wenn Anweisung: " & _

"mit KM, dann ja." & vbCrLf & "Wenn Anweisung: Untersuchung " & _

"nur NATIV, dann nein. " & vbCrLf & "Wenn Anweisung: keine " & _

"Untersuchung, dann abbrechen.", vbYesNoCancel + vbCritical + vbApplicationModal)

    If VORHER = 6 Then
        KMREDUKTION = InputBox("Um wieviel ml soll KM reduziert werden?")
            While KMREDUKTION = -0.001 Or KMREDUKTION > 100
                KMREDUKTION = InputBox("Bitte nochmal eingeben. Um " & _
                "wieviel ml soll KM reduziert werden? Wert war leer oder zu groß!")
            Wend
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: KMReduktion um " & KMREDUKTION & "ml"
        frmkmkalkulator.cmd72.Visible = False
        frmkmkalkulator.cmdKn3.Visible = False
        frmkmkalkulator.cmdkmr.Visible = True
        frmkmkalkulator.cmdKn1.Visible = True
        frmkmkalkulator.cmdniekm.Visible = False
    End If
    If VORHER = 7 Then
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: NATIV"
        REPORT = "Nur NATIV nach Anweisung." & vbCrLf & "(" & PROTOKOLL & ")"
        MsgBox REPORT
        Call Ausdruck(REPORT)
        End
    End If
    If VORHER = 2 Then
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
        REPORT = "Keine Untersuchung nach Anweisung." & vbCrLf & "(" & PROTOKOLL & ")"
        MsgBox REPORT
        Call Ausdruck(REPORT)
        End
    End If
End Sub
------------------
Private Sub cmdKn3_Click()

PROTOKOLL = PROTOKOLL & ", " & "kein KM direkt vorher"

frmkmkalkulator.cmd72.Visible = False

frmkmkalkulator.cmdKn3.Visible = False

frmkmkalkulator.cmdkmr.Visible = True

frmkmkalkulator.cmdKn1.Visible = True

frmkmkalkulator.cmdniekm.Visible = True

End Sub
-----------------
Private Sub cmdkmr_Click()

Unload frmkmkalkulator

frmkmunvertr.Show

End Sub
-----------------
Private Sub cmdKn1_Click()

PROTOKOLL = PROTOKOLL & ", " & "KM vertr."

Unload frmkmkalkulator

frmSsd.Show

End Sub
-----------------
Private Sub cmdniekm_Click()

PROTOKOLL = PROTOKOLL & ", " & "nie KM"

Unload frmkmkalkulator

frmallergie.Show

End Sub