Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation: frmallergie
Dieses Makro gehört zu Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation.
'*******************fragt nach Allergien*******************
Option Explicit
Dim BEG As Byte
Dim ALL As Byte
Dim AST As Byte
-------------------
Private Sub UserForm_Initialize()
Me.labid = ID
Me.labmta = MTA
Me.cmdasthma.Visible = True
Me.cmdAn1.Visible = True
Me.cmdallergie.Visible = False
Me.cmdAn2.Visible = False
End Sub
-------------------------
'********Fragt nach Asthma und Allergien**********
Private Sub cmdasthma_Click()
PROTOKOLL = PROTOKOLL & ", " & "Asthma"
AST = MsgBox(mbCORTISON, vbYesNoCancel + vbCritical)
If AST = 6 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: KM"
CORTISON = " Prednisolon 30 m Tbl. 12 h und 2h vor KM iv " & _
"und damit neuer Termin und Anästhesist "
Unload frmkmunvertr
frmSsd.Show
End If
If AST = 7 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: NATIV"
REPORT = "Nur NATIV nach Anweisung." & vbCrLf & "(" & PROTOKOLL & ")"
MsgBox REPORT
Call Ausdruck(REPORT)
End
End If
If AST = 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 cmdAn1_Click()
PROTOKOLL = PROTOKOLL & ", " & "kein Asthma"
Me.cmdasthma.Visible = False
Me.cmdAn1.Visible = False
Me.cmdallergie.Visible = True
Me.cmdAn2.Visible = True
End Sub
-----------------------------
Private Sub cmdallergie_Click()
PROTOKOLL = PROTOKOLL & ", " & "Poliallergie"
BEG = MsgBox("Antiallergika iv vor KM erforderlich. " & _
"Ist Begleitung vorhanden oder kann organisiert werden?", vbYesNo + vbQuestion)
If BEG = 7 Then
PROTOKOLL = PROTOKOLL & ", " & "keine Begl."
ALL = MsgBox("Keine Begleitung und neuer Termin. " & _
mbANTIALLERGIKA, vbYesNoCancel + vbCritical)
If ALL = 6 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: KM, Antiallergika, neuer Termin mit Begl."
ANTIALLERGIKA = " 20 min vorher je 1 Amp Tavegil iv und Tagamed iv. "
BEGLEITUNG = " Neuer Termin mit Begleitung wegen " & _
"sedierender Wirkung der Antiallergika. "
MsgBox "Anweisung: KM, Antiallergika, neuer Termin mit Begl."
Unload frmkmunvertr
frmSsd.Show
End If
If ALL = 7 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
REPORT = "Nur NATIV nach Anweisung." & vbCrLf & "(" & PROTOKOLL & ")"
MsgBox REPORT
Call Ausdruck(REPORT)
End
End If
If ALL = 2 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
REPORT = "Keine Untersuchung nach Anweisung." & vbCrLf & _
"(" & PROTOKOLL & ")"
MsgBox REPORT
Call Ausdruck(REPORT)
End
End If
Else
PROTOKOLL = PROTOKOLL & ", " & "Begl. ok"
ALL = MsgBox("Begl. vorhanden. " & _
mbANTIALLERGIKA, vbYesNoCancel + vbCritical)
If ALL = 6 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: KM, Antiallergika"
ANTIALLERGIKA = " 20 min vorher je 1 Amp Tavegil iv und Tagamed iv. "
BEGLEITUNG = " Begleitung über die sedierende Wirkung der Antiallergika informieren. "
MsgBox "Anweisung: KM und Antiallergika. Begl. informieren."
Unload frmkmunvertr
frmSsd.Show
End If
If ALL = 7 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
REPORT = "Anweisung: Nur NATIV." & vbCrLf & "(" & PROTOKOLL & ")"
MsgBox REPORT
Call Ausdruck(REPORT)
End
End If
If ALL = 2 Then
PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
REPORT = "Keine Untersuchung nach Anweisung." & vbCrLf & _
"(" & PROTOKOLL & ")"
MsgBox REPORT
Call Ausdruck(REPORT)
End
End If
End If
End Sub
---------------------------------
Private Sub cmdAn2_Click()
PROTOKOLL = PROTOKOLL & ", " & "keine Allergie"
Unload frmallergie
frmSsd.Show
End Sub