Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation: frmSniere und frmniere

Links hinzufügen
Aus Wikibooks

Diese Makros gehören zu Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation.

frmSniere[Bearbeiten]

Datei:FrmSNiere.png 

'****Fragt alllgemein nach Nierenproblemen und Diabetes********

 Option Explicit
 Dim ALT As Byte
 Dim VOLUMEN As Single
 Dim KREA As Single
 Dim GFR As Single
 Dim NierenE As Byte
 Dim KREABEST As Byte
 Dim GESCHLECHT As Single
 Dim NOTF As Byte
----------------
 Private Sub UserForm_Initialize()
   Me.labid.Caption = ID
   Me.labmta.Caption = MTA
 End Sub
-------------------
 Private Sub cmdNProbleme_Click()
 
 Unload frmSniere
 
 frmniere.Show
 
 End Sub
------------------------
 Private Sub cmdnein_Click()
 
 PROTOKOLL = PROTOKOLL & " ," & "Niere & Diab. ok"
 
 ALT = MsgBox("Älter als 70 J.?", 4 + 32)
     If ALT = 7 Then
         Call Gewichtabfragen(GEWICHT)
         VOLUMEN = (2 * GEWICHT) - KMREDUKTION
         PROTOKOLL = PROTOKOLL & " ," & "<70J" & " ," & GEWICHT & "kg"
         REPORT = "KM bis max. " & VOLUMEN & " ml ok. " & vbCrLf & BEGLEITUNG & _
         CORTISON & ANTIALLERGIKA & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     End If
     If ALT = 6 Then
         NierenE = MsgBox("Kreatinin Wert herausfinden möglich", 4 + 32)
             If NierenE = 6 Then
                 Call Kreatininabfragen(KREA)
                 Call Alterabfragen(ALTER)
                 PROTOKOLL = PROTOKOLL & " ," & ALTER & "J" & " ," & KREA & "Krea."
                 Call Geschlechtabfragen(GESCHLECHT)
                 PROTOKOLL = PROTOKOLL & " ," & GESCHLECHT & "m/w "
                 GFR = GESCHLECHT * (186.3 * (KREA ^ -1.154) * (ALTER ^ -0.203))
                     MsgBox GFR
                     If GFR >= 59.5 Then
                         Call Gewichtabfragen(GEWICHT)
                         VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                         PROTOKOLL = PROTOKOLL & " ," & GEWICHT & "kg"
                         REPORT = "eGFR liegt über 60 und damit" & _
                         " KM bis max. " & VOLUMEN & " ml ok. " _
                         & vbCrLf & BEGLEITUNG & BLOCK & ANTIALLERGIKA & _
                         CORTISON & vbCrLf & "(" & PROTOKOLL & ")"
                         MsgBox REPORT
                         Call Ausdruck(REPORT)
                         End
                     Else
                         REPORT = mbLOWGFR & vbCrLf & "(" & PROTOKOLL & ")"
                         MsgBox REPORT, vbCritical
                         Call Ausdruck(REPORT)
                         End
                     End If
             Else
                 PROTOKOLL = PROTOKOLL & " ," & ">70J" & " ," & "KREA?"
                 NOTF = MsgBox("Nach Rücksprache mit Arzt dringliche " & _
                 "Untersuchung und KM ok ohne Kreatinin dann Ja. " & _
                 "Wenn neuer Termin, nativ oder keine Untersuchung, dann Nein", vbYesNo)
                 If NOTF = 6 Then
                     PROTOKOLL = PROTOKOLL & ", " & "Anweisung: dringlich KM ohne Krea."
                     Call Gewichtabfragen(GEWICHT)
                     PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
                     VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                     REPORT = "KM bis max. " & _
                     VOLUMEN & " ml ok. " & vbCrLf & CORTISON & BEGLEITUNG & ANTIALLERGIKA _
                     & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
                     MsgBox REPORT
                     Call Ausdruck(REPORT)
                     End
                 End If
         End If
             KREABEST = MsgBox(mbKREATININBEST, vbYesNoCancel + vbQuestion)
             If KREABEST = 6 Then
                 PROTOKOLL = PROTOKOLL & ", " & "Anweisung: Kreatinin bestimmen"
                 REPORT = "Anweisung: Blut abnehmen zur Kreatininbestimmung. " & _
                 vbCrLf & BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
                 vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT
                 Call Ausdruck(REPORT)
                 End
             End If
                 If KREABEST = 7 Then
                     PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
                     REPORT = "Nur NATIV nach Anweisung." & _
                     vbCrLf & "(" & PROTOKOLL & ")"
                     MsgBox REPORT
                     Call Ausdruck(REPORT)
                     End
                 End If
                 If KREABEST = 2 Then
                     PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
                     REPORT = "Nach Anweisung keine Untersuchung." & _
                     vbCrLf & "(" & PROTOKOLL & ")"
                     MsgBox REPORT
                     Call Ausdruck(REPORT)
                     End
                 End If
             End If
         
         End
 End Sub

frmniere[Bearbeiten]

Datei:Frmniere.png 

'**************fragt nach Dialyse,Myelom,Kreatinin*************
 '**************Diabetes, Nierenerkrankung**************
 Option Explicit
 
 Dim KREA As Single
 
 Dim GFR As Single
 
 Dim NierenE As Byte
 
 Dim ALT As Byte
 
 Dim DIAB As Byte
 
 Dim DIALYSE As Byte
 
 Dim BIGUANIDE As Byte
 
 Dim DIA As Byte
 
 Dim MYE As Byte
 
 Dim KREABEST As Byte
 
 Dim GESCHLECHT As Single
 
 Dim NOTF As Byte
-------------------------
 Private Sub UserForm_Initialize()
 
 Me.labid.Caption = ID
 
 Me.labmta.Caption = MTA
 
 Me.cmdNn1.Visible = True
 
 Me.cmddialyse.Visible = True
 
 Me.cmdNn2.Visible = False
 
 Me.cmdmyelom.Visible = False
 
 Me.cmdNn3.Visible = False
 
 Me.cmdkreatinin.Visible = False
 
 Me.cmdNn4.Visible = False
 
 Me.cmdnierenE.Visible = False
 
 Me.cmdNn5.Visible = False
 
 Me.cmddiab.Visible = False
 
 End Sub
------------------------------
 Private Sub cmddialyse_Click()
 
 
 PROTOKOLL = PROTOKOLL & ", " & "Dialyse"
 DIALYSE = MsgBox("Nächste Dialyse in max. 12 h?", vbYesNo + vbQuestion)
     If DIALYSE = 6 Then
         PROTOKOLL = PROTOKOLL & ", " & "Dialyse in <12 h"
         Call Gewichtabfragen(GEWICHT)
         PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
         VOLUMEN = (2 * GEWICHT) - KMREDUKTION
         REPORT = "KM bis max. " & VOLUMEN & " ml ok. " & vbCrLf & _
         BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     Else
         PROTOKOLL = PROTOKOLL & ", " & "Dialyse in >12 h"
         NOTF = MsgBox("Nach Rücksprache mit Arzt: dringliche " & _
         "Untersuchung und KM ok trotz später Dialyse, dann Ja." & _
         "Wenn neuer Termin, nativ oder keine Untersuchung, dann Nein", vbYesNo)
         If NOTF = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: dringlich KM ohne Krea."
             Call Gewichtabfragen(GEWICHT)
             PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
             VOLUMEN = (2 * GEWICHT) - KMREDUKTION
             REPORT = "KM bis max. " & _
             VOLUMEN & " ml ok. " & vbCrLf & CORTISON & BEGLEITUNG & ANTIALLERGIKA _
             & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         DIA = MsgBox("Dialyse in >12 h. Mit Arzt Rücksprache nehmen. " & vbCrLf & "Bei Anweisung: neuer " & _
         "Termin max. 12 h vor Dialyse dann ja. " & vbCrLf & _
         "Bei Anweisung: nur NATIV dann nein. " & vbCrLf & _
         "Bei Anweisung: keine Untersuchung dann abbbrechen.", vbYesNoCancel + vbQuestion)
         If DIA = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "neuer Termin <12h"
             Call Gewichtabfragen(GEWICHT)
             PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
             REPORT = "KM wäre dann bis max. " & VOLUMEN & " ml ok. " & _
             vbCrLf & BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If DIA = 7 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
             REPORT = "Nur NATIV nach Anweisung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If DIA = 2 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
             REPORT = "Nach Anweisung keine Untersuchung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
     End If
 End Sub
-----------------------
 Private Sub cmdmyelom_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "Myelom"
 
 MYE = MsgBox(mbKEINKM, vbOKCancel + vbQuestion)
   If MYE = 1 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
             REPORT = "Nur NATIV nach Anweisung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If DIA = 2 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
             REPORT = "Nach Anweisung keine Untersuchung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
 Unload frmniere
 End
 End Sub
------------------------
 Private Sub cmdkreatinin_Click()
 
 Call Kreatininabfragen(KREA)
 
 PROTOKOLL = PROTOKOLL & ", " & KREA & "Krea."
 
 Call Alterabfragen(ALTER)
 
 PROTOKOLL = PROTOKOLL & ", " & ALTER & "J"
 
 Call Geschlechtabfragen(GESCHLECHT)
 PROTOKOLL = PROTOKOLL & ", " & GESCHLECHT & "m/w"
 
 GFR = GESCHLECHT * (186.3 * (KREA ^ -1.154) * (ALTER ^ -0.203))
 
 MsgBox GFR
     If GFR >= 60 Then
         Call Gewichtabfragen(GEWICHT)
         PROTOKOLL = PROTOKOLL & ", " & ", " & GEWICHT & "kg"
         VOLUMEN = (2 * GEWICHT) - KMREDUKTION
         REPORT = ("eGFR liegt über 60 und damit KM bis max. " & VOLUMEN & _
         " ml ok. ") & vbCrLf & BLOCK & CORTISON & BEGLEITUNG & _
         ANTIALLERGIKA & vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     Else
         REPORT = mbLOWGFR & vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT, 16
         Call Ausdruck(REPORT)
         End
     End If
 End Sub
--------------------
 Private Sub cmdnierenE_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "NierenErkrg."
 
 NierenE = MsgBox("Kann ein Kreatinin Wert beschafft werden, der " & _
 
 "nicht älter ist als 1 Woche? ", vbYesNo + vbQuestion)
     If NierenE = 6 Then
         Call Kreatininabfragen(KREA)
         PROTOKOLL = PROTOKOLL & ", " & KREA & "Krea."
         Call Alterabfragen(ALTER)
         PROTOKOLL = PROTOKOLL & ", " & ALTER & "J"
         Call Geschlechtabfragen(GESCHLECHT)
         PROTOKOLL = PROTOKOLL & ", " & GESCHLECHT & "m/w"
         GFR = GESCHLECHT * (186.3 * (KREA ^ -1.154) * (ALTER ^ -0.203))
             MsgBox GFR
             If GFR >= 59.5 Then
                 Call Gewichtabfragen(GEWICHT)
                 PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
                 VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                 REPORT = "GFR liegt über 60 und damit KM bis max. " & _
                 VOLUMEN & "ml ok. " & vbCrLf & CORTISON & BEGLEITUNG & ANTIALLERGIKA _
                 & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT
                 Call Ausdruck(REPORT)
                 End
             Else
                 REPORT = mbLOWGFR & vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT, vbCritical
                 Call Ausdruck(REPORT)
                 End
             End If
     Else
         PROTOKOLL = PROTOKOLL & ", " & "Krea?"
         NOTF = MsgBox("Nach Rücksprache mit Arzt: dringliche " & _
         "Untersuchung und KM ok ohne Kreatinin dann Ja." & _
         "Wenn neuer Termin, nativ oder keine Untersuchung, dann Nein", vbYesNo)
         If NOTF = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: dringlich KM ohne Krea."
             Call Gewichtabfragen(GEWICHT)
             PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
             VOLUMEN = (2 * GEWICHT) - KMREDUKTION
             REPORT = "KM bis max. " & _
             VOLUMEN & " ml ok. " & vbCrLf & CORTISON & BEGLEITUNG & ANTIALLERGIKA _
             & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
            End
         Else
         KREABEST = MsgBox(mbKREATININBEST, vbYesNoCancel + vbQuestion)
         If KREABEST = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: Kreatinin bestimmen"
             REPORT = "Anweisung: Blut abnehmen zur Kreatininbestimmung. " & VOLUMEN & " ml ok. " & _
             vbCrLf & BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If KREABEST = 7 Then
             PROTOKOLL = PROTOKOLL & ", " & "nur NATIV"
             REPORT = "Nur NATIV nach Anweisung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If KREABEST = 2 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung keine Untersuchung"
             REPORT = "Nach Anweisung keine Untersuchung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
     End If
 End If
 End Sub
------------------------
 Private Sub cmddiab_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "Diabetes"
 
 BIGUANIDE = MsgBox("Wird als orales Antidiabetikum Metformin " & _
 
 "eingenommen?: Biocos, Diabesin, espa-formin, glucobon, Glucophage, " & _
 
 "Juformin, Mediabet, Mescorit, Meglucon, Met, Metfogamma, Metform, " & _
 
 "Metformin, Siofor, Thiabet? Wenn nicht zu klären, dann abbrechen", vbYesNoCancel + vbQuestion)
 If BIGUANIDE = 6 Then
         REPORT = mbBIGUANIDE & CORTISON & _
         BEGLEITUNG & BLOCK & ANTIALLERGIKA & _
         " (" & PROTOKOLL & ")"
         MsgBox REPORT, vbCritical
         Call Ausdruck(REPORT)
         End
 End If
 If BIGUANIDE < 6 Then
         PROTOKOLL = PROTOKOLL & ", " & "Biguanide?"
         REPORT = mbCANCEL & vbCrLf & CORTISON & _
         BEGLEITUNG & BLOCK & ANTIALLERGIKA & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT, vbCritical
         Call Ausdruck(REPORT)
         End
 End If
 If BIGUANIDE = 7 Then
         PROTOKOLL = PROTOKOLL & ", " & "keine Biguanide"
 End If
 DIAB = MsgBox("Kreatinin Wert bis zu 1 Jahr alt herausfinden möglich", 4)
 If DIAB = 6 Then
         Call Kreatininabfragen(KREA)
         PROTOKOLL = PROTOKOLL & ", " & KREA & "Krea."
         Call Alterabfragen(ALTER)
         PROTOKOLL = PROTOKOLL & ", " & ALTER & "J"
         Call Geschlechtabfragen(GESCHLECHT)
         PROTOKOLL = PROTOKOLL & ", " & GESCHLECHT & "m/w"
         GFR = GESCHLECHT * (186.3 * (KREA ^ -1.154) * (ALTER ^ -0.203))
         MsgBox GFR
             If GFR >= 59.5 Then
                 Call Gewichtabfragen(GEWICHT)
                 PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
                 VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                 REPORT = "eGFR liegt über 60 und damit KM bis max. " & _
                 VOLUMEN & " ml ok. " & vbCrLf & BLOCK & CORTISON & BEGLEITUNG & _
                 ANTIALLERGIKA & vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT
                 Call Ausdruck(REPORT)
                 End
             Else
                 REPORT = mbLOWGFR & vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT, vbCritical
                 Call Ausdruck(REPORT)
                 End
             End If
 Else
         PROTOKOLL = PROTOKOLL & ", " & "Krea?"
         NOTF = MsgBox("Nach Rücksprache mit Arzt dringliche " & _
         "Untersuchung und KM ok ohne Kreatinin dann Ja." & _
         "Wenn neuer Termin, nativ oder keine Untersuchung, dann Nein", vbYesNo)
         If NOTF = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: dringlich KM ohne Krea."
                 Call Gewichtabfragen(GEWICHT)
                 PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
                 VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                 REPORT = "KM bis max. " & _
                 VOLUMEN & " ml ok. " & vbCrLf & CORTISON & BEGLEITUNG & ANTIALLERGIKA _
                 & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT
                 Call Ausdruck(REPORT)
                 End
         End If
         KREABEST = MsgBox(mbKREATININBEST, vbYesNoCancel + vbQuestion)
         If KREABEST = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: Kreatinin bestimmen"
             REPORT = "Anweisung: Blut abnehmen zur Kreatininbestimmung. " & _
             vbCrLf & BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If KREABEST = 7 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
             REPORT = "Nur NATIV nach Anweisung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If KREABEST = 2 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
             REPORT = "Nach Anweisung keine Untersuchung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
 End If
 End Sub
------------------
 Private Sub cmdNn1_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "keine Dialyse"
 
 frmniere.cmdNn1.Visible = False
 
 frmniere.cmddialyse.Visible = False
 
 frmniere.cmdNn2.Visible = True
 
 frmniere.cmdmyelom.Visible = True
 
 End Sub
------------------------
 Private Sub cmdNn2_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein Myelom"
 
 frmniere.cmdNn2.Visible = False
 
 frmniere.cmdmyelom.Visible = False
 
 frmniere.cmdNn3.Visible = True
 
 frmniere.cmdkreatinin.Visible = True
 
 End Sub
---------------------
 Private Sub cmdNn3_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein Krea"
 
 frmniere.cmdNn3.Visible = False
 
 frmniere.cmdkreatinin.Visible = False
 
 frmniere.cmdNn4.Visible = True
 
 frmniere.cmdnierenE.Visible = True
 
 End Sub
-------------------
 Private Sub cmdNn4_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "keine NierenErkng"
 
 frmniere.cmdNn4.Visible = False
 
 frmniere.cmdnierenE.Visible = False
 
 frmniere.cmdNn5.Visible = True
 
 frmniere.cmddiab.Visible = True
 
 End Sub
---------------------
 Private Sub cmdNn5_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein Diabetes"
 
 ALT = MsgBox("Älter als 70?", 4 + 32)
     If ALT = 7 Then
         PROTOKOLL = PROTOKOLL & ", " & "<70J"
         Call Gewichtabfragen(GEWICHT)
         PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
         VOLUMEN = (2 * GEWICHT) - KMREDUKTION
         REPORT = "KM bis max. " & VOLUMEN & " ml ok. " & _
         vbCrLf & BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     End If
 If ALT = 6 Then
     NierenE = MsgBox("Kreatinin Wert bis max. 1 Jahr alt herausfinden möglich", 4 + 32)
     If NierenE = 6 Then
         Call Kreatininabfragen(KREA)
         PROTOKOLL = PROTOKOLL & ", " & KREA & "Krea."
         Call Alterabfragen(ALTER)
         PROTOKOLL = PROTOKOLL & ", " & ALTER & "J"
         Call Geschlechtabfragen(GESCHLECHT)
         PROTOKOLL = PROTOKOLL & ", " & GESCHLECHT & "m/w"
         GFR = GESCHLECHT * (186.3 * (KREA ^ -1.154) * (ALTER ^ -0.203))
             MsgBox GFR
             If GFR >= 59.5 Then
                 Call Gewichtabfragen(GEWICHT)
                 PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
                 VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                 REPORT = "eGFR liegt über 60 und damit" & _
                 " KM bis max. " & VOLUMEN & " ml ok. " & _
                 vbCrLf & BLOCK & CORTISON & BEGLEITUNG & _
                 ANTIALLERGIKA & vbCrLf & " (" & PROTOKOLL & ")"
                 MsgBox REPORT
                 Call Ausdruck(REPORT)
                 End
             Else
                 REPORT = mbLOWGFR & vbCrLf & " (" & PROTOKOLL & ")"
                 MsgBox REPORT, vbCritical
                 Call Ausdruck(REPORT)
                 End
             End If
     Else
         PROTOKOLL = PROTOKOLL & ", " & "Krea?"
         NOTF = MsgBox("Nach Rücksprache mit Arzt dringliche " & _
         "Untersuchung und KM ok ohne Kreatinin dann Ja." & _
         "Wenn neuer Termin, nativ oder keine Untersuchung, dann Nein", vbYesNo)
         If NOTF = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: dringlich KM ohne Krea."
                 Call Gewichtabfragen(GEWICHT)
                 PROTOKOLL = PROTOKOLL & ", " & GEWICHT & "kg"
                 VOLUMEN = (2 * GEWICHT) - KMREDUKTION
                 REPORT = "KM bis max. " & _
                 VOLUMEN & " ml ok. " & vbCrLf & CORTISON & BEGLEITUNG & ANTIALLERGIKA _
                 & BLOCK & vbCrLf & "(" & PROTOKOLL & ")"
                 MsgBox REPORT
                 Call Ausdruck(REPORT)
                 End
             End If
         End If
         KREABEST = MsgBox(mbKREATININBEST, vbYesNoCancel + vbQuestion)
         If KREABEST = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: Kreatinin bestimmen"
             REPORT = "Anweisung: Blut abnehmen zur Kreatininbestimmung. " & _
             vbCrLf & BLOCK & CORTISON & BEGLEITUNG & ANTIALLERGIKA & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If KREABEST = 7 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
             REPORT = "Nur NATIV nach Anweisung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
         If KREABEST = 2 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
             REPORT = "Nach Anweisung keine Untersuchung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
     End If
 End If
 End
 End Sub
Abgerufen von „https://de.wikibooks.org/w/index.php?title=Makros_für_Radiologen:_Makro_zur_Auswahl_der_Patienten_zur_Röntgenkontrastmittel_Applikation:_frmSniere_und_frmniere&oldid=731221“