Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation: frmSsd und frmsd
Erscheinungsbild
Diese Makros gehören zu Makros für Radiologen: Makro zur Auswahl der Patienten zur Röntgenkontrastmittel Applikation.
frmSsd
[Bearbeiten]'**********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]'****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