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.

Datei:Frmallergie.png

'*******************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