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

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

frmSsd Bearbeiten

Datei:FrmSsd.png

'**********fragt allgemein nach Schildddrüsenproblemen*******

 Option Explicit
------------------
 Private Sub UserForm_Initialize()
 
 Me.labid.Caption = ID
 
 Me.labmta.Caption = MTA
 
 End Sub
-------------------
 Private Sub cmdsdprobleme_Click()
 
 Unload frmSsd
 
 frmsd.Show
 
 End Sub
--------------------
 Private Sub cmdnein_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "SD ok"
 
 Unload frmSsd
 
 frmSniere.Show
 
 End Sub

frmsd Bearbeiten

Datei:Frmsd.png

'****frmsd *******fragt ausführlich nach Schilddrüsenprobleme**********

 Option Explicit
 
 Dim KROPFUNTERS As Byte

 Dim AA As Byte
 
 Dim TSH As Byte
 
 Dim CA As Byte
 
 Dim DIFFCA As Byte
 
 Dim ÜFU As Byte
 
 Dim DIF As Byte
 
 Dim HISTO As Byte
 
 Dim RJT As Byte
 
 Dim SZINTI As Byte
--------------------------
 Private Sub UserForm_Initialize()
 
 Me.labid.Caption = ID
 
 Me.labmta.Caption = MTA
 
 Me.lablevo.Caption = mbLEVOTHYROXIN
 
 Me.cmdSn1.Visible = True
 
 Me.cmdüfunktion.Visible = True
 
 Me.cmdSn2.Visible = False
 
 Me.cmdlevot.Visible = False
 
 Me.cmdSn3.Visible = False
 
 Me.cmdtsh.Visible = False
 
 Me.cmdSn4.Visible = False
 
 Me.cmdaa.Visible = False
 
 Me.cmdSn5.Visible = False
 
 Me.cmdkropf.Visible = False
 
 Me.cmdSn6.Visible = False
 
 Me.cmdca.Visible = False
 
 End Sub
--------------------------
 Private Sub cmdüfunktion_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "Üfunktion"
 
 ÜFU = MsgBox("Bei Überfunktion kein KM. " & mbKEINKM, vbOKCancel + vbQuestion)
     If ÜFU = 1 Then
         PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
         REPORT = "Nur NATIV nach Anweisung." & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     End If
         If ÜFU = 2 Then
         PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
         REPORT = "Nach Anweisung keine Untersuchung." & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     End If
 Unload frmsd
 End
 End Sub
---------------------------
 Private Sub cmdca_Click()
 
 CA = MsgBox("Diagnose älter als 10 Jahre?", vbYesNo + 48)
     If CA = 6 Then
         PROTOKOLL = PROTOKOLL & ", " & "Ca>10J"
         MsgBox "OK, Ca hat keinen Einfluss auf Entscheidung. "
         frmsd.cmdSn2.Visible = True
         frmsd.cmdlevot.Visible = True
         frmsd.cmdSn6.Visible = False
         frmsd.cmdca.Visible = False
     Else
         CA = MsgBox("Histologische Diagnose bekannt " & _
         "oder kann in Erfahrung gebracht werden?", vbYesNo + vbQuestion)
             If CA = 6 Then
                 DIFFCA = MsgBox("War es ein differenziertes Ca?", vbYesNo + 48)
                     If DIFFCA = 6 Then
                         PROTOKOLL = PROTOKOLL & ", " & "diff. Ca"
                         DIF = MsgBox(mbKEINKM, vbOKCancel + vbQuestion)
                                 If DIF = 1 Then
                                     PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
                                     REPORT = "Nur NATIV nach Anweisung." & _
                                     vbCrLf & "(" & PROTOKOLL & ")"
                                     MsgBox REPORT
                                     Call Ausdruck(REPORT)
                                     End
                                 End If
                                 If DIF = 2 Then
                                     PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
                                     REPORT = "Nach Anweisung keine Untersuchung." & _
                                     vbCrLf & "(" & PROTOKOLL & ")"
                                     MsgBox REPORT
                                     Call Ausdruck(REPORT)
                                     End
                                 End If
                     Else
                         PROTOKOLL = PROTOKOLL & ", " & "Ca nicht diff."
                         MsgBox "Ok, Ca hat keinen Einfluss auf Entscheidung."
                         frmsd.cmdSn2.Visible = True
                         frmsd.cmdlevot.Visible = True
                         frmsd.cmdSn6.Visible = False
                         frmsd.cmdca.Visible = False
                     End If
             Else
                 PROTOKOLL = PROTOKOLL & ", " & "Ca Histo?"
                 HISTO = MsgBox(mbKEINKM, vbOKCancel + vbQuestion)
                    If HISTO = 1 Then
                         PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nur NATIV"
                         REPORT = "Nur NATIV nach Anweisung." & _
                         vbCrLf & "(" & PROTOKOLL & ")"
                         MsgBox REPORT
                         Call Ausdruck(REPORT)
                         End
                     End If
                     If HISTO = 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 cmdlevot_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "Levothyroxin"
 
 MsgBox "Wer Levothyroxin einnimmt, kann auch KM haben! "
 
 Unload frmsd
 
 frmSniere.Show
 
 End Sub
-------------------------------
 Private Sub cmdtsh_Click()
 
 TSH = MsgBox("Wird Levothyroxin eingenommen? Ja / Nein. Wenn nicht zu " & _
 
 "klären, dann Abbrechen." & mbLEVOTHYROXIN, vbYesNoCancel + vbQuestion)
     If TSH = 7 Then
         PROTOKOLL = PROTOKOLL & ", " & "TSH niedrig"
         BLOCK = mbIRENAT
         MsgBox "Rücksprache mit Arzt, damit verordnet werden " & _
         "können: " & mbIRENAT, vbCritical
         Unload frmsd
         frmSniere.Show
     End If
     If TSH = 6 Then
         PROTOKOLL = PROTOKOLL & ", " & "TSH niedrig unter Levothy."
         MsgBox "Wer ein niedriges TSH hat und Levothyroxin " & _
         "einnimmt, kann KM erhalten."
         Unload frmsd
         frmSniere.Show
     End If
     If TSH = 2 Then
        PROTOKOLL = PROTOKOLL & ", " & "TSH niedrig & Levothyroxin?"
         BLOCK = mbIRENAT
         MsgBox "Macht nichts! " & "Rücksprache mit Arzt, damit verordnet werden " & _
         "können: " & mbIRENAT, vbCritical
         Unload frmsd
         frmSniere.Show
     End If
 End Sub
----------------------------
 Private Sub cmdaa_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "AA"
 
 RJT = MsgBox("Behandelt mit Radiojodtherapie vor mehr als 3 Monaten?", vbYesNo + vbQuestion + 
 
 vbApplicationModal)
 If RJT = 7 Then
     PROTOKOLL = PROTOKOLL & ", " & "keine RJT"
     BLOCK = mbIRENAT
     MsgBox "Rücksprache mit Arzt, damit verordnet werden " & _
         "können: " & mbIRENAT, vbCritical
     Unload frmsd
     frmSniere.Show
 Else
     PROTOKOLL = PROTOKOLL & ", " & "RJT"
     MsgBox "Kann KM erhalten."
     Unload frmsd
     frmSniere.Show
 End If
 End Sub
--------------------------
 Private Sub cmdkropf_Click()
 
 KROPFUNTERS = MsgBox("SD in den letzten Jahren untersucht und " & _
 
 "Ergebnis bekannnt?", vbYesNo + 32)
 If KROPFUNTERS = 6 Then
     AA = MsgBox("Autonomes Adenom festgestellt oder unklar?", vbYesNo + 48)
         If AA = 6 Then
             PROTOKOLL = PROTOKOLL & ", " & "Kropf mit AA"
             BLOCK = mbIRENAT
             MsgBox "Rücksprache mit Arzt, damit verordnet werden " & _
             "können: " & mbIRENAT, vbCritical
         Else
             PROTOKOLL = PROTOKOLL & ", " & "Kropf ohne AA"
             MsgBox "Kropf ok. "
         End If
 Else
     PROTOKOLL = PROTOKOLL & ", " & "unbekannnter Kropf"
     SZINTI = MsgBox("Rücksprache mit Arzt. Bei Anweisung: " & _
     "Sonographie der SD und bei Knoten auch Szintigraphie " & _
     "dann Ja. Bei Anweisung nur nativ Nein. " & _
     "Bei Anweisung: keine Untersuchung Abbrechen.", vbYesNoCancel)
         If SZINTI = 7 Then
             PROTOKOLL = PROTOKOLL & ", " & "Anweisung: nativ"
             REPORT = "Nur NATIV nach Anweisung." & _
             vbCrLf & "(" & PROTOKOLL & ")"
             MsgBox REPORT
             Call Ausdruck(REPORT)
             End
         End If
     If SZINTI = 6 Then
         PROTOKOLL = PROTOKOLL & ", " & "Anweisung: Sonographie"
         REPORT = "Nach Anweisung: Sonographie organisieren" & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     End If
     If SZINTI = 2 Then
        PROTOKOLL = PROTOKOLL & ", " & "Anweisung: keine Untersuchung"
         REPORT = "Nach Anweisung: keine Untersuchung." & _
         vbCrLf & "(" & PROTOKOLL & ")"
         MsgBox REPORT
         Call Ausdruck(REPORT)
         End
     End If
 End If
 Unload frmsd
 frmSniere.Show
 End Sub
------------------------
 Private Sub cmdSn1_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "keine Üfunktion"
 
 frmsd.cmdSn1.Visible = False
 
 frmsd.cmdüfunktion.Visible = False
 
 frmsd.cmdSn6.Visible = True
 
 frmsd.cmdca.Visible = True
 
 End Sub
--------------------------
 Private Sub cmdSn6_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein Ca"
 
 frmsd.cmdSn6.Visible = False
 
 frmsd.cmdca.Visible = False
 
 frmsd.cmdSn2.Visible = True
 
 frmsd.cmdlevot.Visible = True
 
 End Sub
------------------------------
 Private Sub cmdSn2_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein Levothyroxin"
 
 frmsd.cmdSn2.Visible = False
 
 frmsd.cmdlevot.Visible = False
 
 frmsd.cmdSn3.Visible = True
 
 frmsd.cmdtsh.Visible = True
 
 End Sub
-------------------
 Private Sub cmdSn3_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "TSH unbekannt"
 
 frmsd.cmdSn3.Visible = False
 
 frmsd.cmdtsh.Visible = False
 
 frmsd.cmdSn4.Visible = True
 
 frmsd.cmdaa.Visible = True
 
 End Sub
---------------------------
 Private Sub cmdSn4_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein AA"
 
 frmsd.cmdSn4.Visible = False
 
 frmsd.cmdaa.Visible = False
 
 frmsd.cmdSn5.Visible = True
 
 frmsd.cmdkropf.Visible = True
 
 End Sub
-------------------------
 Private Sub cmdSn5_Click()
 
 PROTOKOLL = PROTOKOLL & ", " & "kein Kropf"
 
 Unload frmsd
 
 frmSniere.Show
 
 End Sub