Medizinische Informatik: RoeLeistungen
Zurück zur Übersicht
Dokumentation der Leistungen im Konventionellen Röntgen Bearbeiten
Im Folgenden wird eine Datenbankanwendung beschrieben, die folgende Funktionen erfüllt:
- Dokumentation
- Erfassung und Dokumentation der Art der Leistung
- Stammdatenerfassung der Patienten
- Dokumentation des anfordernden Doktors und der durchführenden MTA
- Dokumentation der Strahlenschutzmeßwerte
- Ausdruck der Beschriftung des Röntgenbildes (Scriborersatz)
- Ausdruck der Leistung für Station
- Leistungstattistik am Monatsende
Sie wurde in Vb3.0 und Access 2.0 verwirklicht und läuft seit einigen Jahren in den Wertachkliniken Bobingen.
Sie ist copyrightfrei.
3 Prinzipen sind verwirklicht:
- 1.Datenbank mit einem Datensatz pro Patient + Leistung
- 2.Schnelle anklickbare Kürzel für die Standarddokumentation
- 3.Schneller Ausdruck für die Bildbeschriftung und Dokumentation
Die Basisform des Programmes wurde ROE.FRM genannt. Von dort aus kann:
- in der Datenbank geblättert und gesucht werden
- ausgedruckt werden
- alle anderen Formen mit den anklickbaren Kürzeln erreicht werden.
Diese Basisdatenbank greift auf eine access 2.0 Tabelle zu die roe.mdb üblicherweise auf c:\mdb zu finden ist und eine eindimensionale Access 2.0 Tabelle ist.
ROE.FRM Bearbeiten
Im Folgenden ist der VB 3.0 Code des Basisfensters ROE.FRM beschrieben
VERSION 2.00
Begin Form us0
BackColor = &H00C00000&
BorderStyle = 1 'Nicht änderbar, einfach
Caption = "DOKU"
ClientHeight = 10695
ClientLeft = -375
ClientTop = 270
ClientWidth = 14505
ClipControls = 0 'False
ForeColor = &H00FFFFFF&
Height = 11100
Icon = ROE.FRX:0000
Left = -435
LinkTopic = "Form1"
ScaleHeight = 10695
ScaleWidth = 14505
Top = -75
Width = 14625
WindowState = 2 'Auf Vollbild
Begin TextBox ALT
Alignment = 2 'Mitte
DataField = "alt/neu"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 6240
TabIndex = 108
Top = 6120
Width = 615
End
Begin TextBox Tüte
Alignment = 2 'Mitte
DataField = "mitgegeben"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 6240
TabIndex = 107
Top = 5520
Width = 615
End
Begin TextBox Bemerkungen
DataField = "Bemerkungen"
DataSource = "Daten1"
Height = 495
Left = 4440
TabIndex = 106
Top = 6720
Width = 3135
End
Begin CommandButton Befehl20
Caption = "neu"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 5400
TabIndex = 104
Top = 6120
Width = 615
End
Begin CommandButton Befehl18
Caption = "vorh."
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4560
TabIndex = 103
Top = 6120
Width = 615
End
Begin CommandButton Befehl17
Caption = "Nein"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 5400
TabIndex = 101
Top = 5520
Width = 615
End
Begin CommandButton Befehl15
Caption = "Ja"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4560
TabIndex = 100
Top = 5520
Width = 615
End
Begin CommandButton Befehl11
Caption = "NeueNR"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 3240
TabIndex = 98
Top = 4320
Width = 1215
End
Begin CommandButton Befehl8
Caption = "SCRIBOR"
Height = 495
Left = 11520
TabIndex = 97
Top = 10080
Width = 1575
End
Begin TextBox t5250
DataField = "5250"
DataSource = "Daten1"
Height = 285
Left = 6600
TabIndex = 96
Top = 10320
Visible = 0 'False
Width = 615
End
Begin TextBox t5201
DataField = "5201"
DataSource = "Daten1"
Height = 285
Left = 6600
TabIndex = 95
Top = 9960
Visible = 0 'False
Width = 615
End
Begin TextBox t5166
DataField = "5166"
DataSource = "Daten1"
Height = 285
Left = 6600
TabIndex = 94
Top = 9240
Visible = 0 'False
Width = 615
End
Begin TextBox t5165
DataField = "5165"
DataSource = "Daten1"
Height = 285
Left = 6600
TabIndex = 93
Top = 8880
Visible = 0 'False
Width = 615
End
Begin TextBox t5158
DataField = "5158"
DataSource = "Daten1"
Height = 285
Left = 5880
TabIndex = 92
Top = 9960
Visible = 0 'False
Width = 615
End
Begin TextBox t5157
DataField = "5157"
DataSource = "Daten1"
Height = 285
Left = 5880
TabIndex = 91
Top = 9600
Visible = 0 'False
Width = 615
End
Begin TextBox t5191
DataField = "5191"
DataSource = "Daten1"
Height = 285
Left = 5880
TabIndex = 90
Top = 8880
Visible = 0 'False
Width = 615
End
Begin TextBox t5190
DataField = "5190"
DataSource = "Daten1"
Height = 285
Left = 5160
TabIndex = 89
Top = 10320
Visible = 0 'False
Width = 615
End
Begin TextBox t5135
DataField = "5135"
DataSource = "Daten1"
Height = 285
Left = 5160
TabIndex = 88
Top = 9600
Visible = 0 'False
Width = 615
End
Begin TextBox t5130
DataField = "5130"
DataSource = "Daten1"
Height = 285
Left = 5160
TabIndex = 87
Top = 9240
Visible = 0 'False
Width = 615
End
Begin TextBox t5200
DataField = "5200"
DataSource = "Daten1"
Height = 285
Left = 6600
TabIndex = 86
Top = 9600
Visible = 0 'False
Width = 615
End
Begin TextBox t5163
DataField = "5163"
DataSource = "Daten1"
Height = 285
Left = 5880
TabIndex = 85
Top = 10320
Visible = 0 'False
Width = 615
End
Begin TextBox t5150
DataField = "5150"
DataSource = "Daten1"
Height = 285
Left = 5880
TabIndex = 84
Top = 9240
Visible = 0 'False
Width = 615
End
Begin TextBox t5137
DataField = "5137"
DataSource = "Daten1"
Height = 285
Left = 5160
TabIndex = 83
Top = 9960
Visible = 0 'False
Width = 615
End
Begin TextBox t5121
DataField = "5121"
DataSource = "Daten1"
Height = 285
Left = 5160
TabIndex = 82
Top = 8880
Visible = 0 'False
Width = 615
End
Begin TextBox t5120
DataField = "5120"
DataSource = "Daten1"
Height = 285
Left = 4440
TabIndex = 81
Top = 10320
Visible = 0 'False
Width = 615
End
Begin TextBox t5030x2
DataField = "5030x2"
DataSource = "Daten1"
Height = 285
Left = 4440
TabIndex = 80
Top = 9960
Visible = 0 'False
Width = 615
End
Begin TextBox t5106
DataField = "5106"
DataSource = "Daten1"
Height = 285
Left = 4440
TabIndex = 79
Top = 9600
Visible = 0 'False
Width = 615
End
Begin TextBox t5105
DataField = "5105"
DataSource = "Daten1"
Height = 285
Left = 4440
TabIndex = 78
Top = 9240
Visible = 0 'False
Width = 615
End
Begin TextBox t5101
DataField = "5101"
DataSource = "Daten1"
Height = 285
Left = 4440
TabIndex = 77
Top = 8880
Visible = 0 'False
Width = 615
End
Begin TextBox t5100
DataField = "5100"
DataSource = "Daten1"
Height = 285
Left = 3720
TabIndex = 76
Top = 10320
Visible = 0 'False
Width = 615
End
Begin TextBox t5098
DataField = "5098"
DataSource = "Daten1"
Height = 285
Left = 3720
TabIndex = 75
Top = 9960
Visible = 0 'False
Width = 615
End
Begin TextBox t5095
DataField = "5095"
DataSource = "Daten1"
Height = 285
Left = 3720
TabIndex = 74
Top = 9600
Visible = 0 'False
Width = 615
End
Begin TextBox t5020
DataField = "5020"
DataSource = "Daten1"
Height = 285
Left = 3000
TabIndex = 73
Top = 9240
Visible = 0 'False
Width = 615
End
Begin TextBox t5040
DataField = "5040"
DataSource = "Daten1"
Height = 285
Left = 3720
TabIndex = 72
Top = 8880
Visible = 0 'False
Width = 615
End
Begin TextBox t5031
DataField = "5031"
DataSource = "Daten1"
Height = 285
Left = 3000
TabIndex = 71
Top = 10320
Visible = 0 'False
Width = 615
End
Begin TextBox t5030
DataField = "5030"
DataSource = "Daten1"
Height = 285
Left = 3000
TabIndex = 70
Top = 9960
Visible = 0 'False
Width = 615
End
Begin TextBox t5021
DataField = "5021"
DataSource = "Daten1"
Height = 285
Left = 3000
TabIndex = 69
Top = 9600
Visible = 0 'False
Width = 615
End
Begin TextBox t5010
DataField = "5010"
DataSource = "Daten1"
Height = 285
Left = 3000
TabIndex = 68
Top = 8880
Visible = 0 'False
Width = 615
End
Begin TextBox t5090
DataField = "5090"
DataSource = "Daten1"
Height = 285
Left = 3720
TabIndex = 67
Top = 9240
Visible = 0 'False
Width = 615
End
Begin CommandButton Befehl6
Caption = "Zeige Ziffern"
Height = 495
Left = 7560
TabIndex = 66
Top = 10080
Width = 1575
End
Begin TextBox tsuchvorname
Height = 495
Left = 2040
TabIndex = 65
Text = "Text1"
Top = 5640
Visible = 0 'False
Width = 180
End
Begin TextBox tsuch
Height = 495
Left = 1920
TabIndex = 64
Text = "Text1"
Top = 5640
Visible = 0 'False
Width = 180
End
Begin TextBox nr
DataField = "NR"
DataSource = "Daten1"
Height = 495
Left = 3840
TabIndex = 63
Top = 3720
Width = 615
End
Begin TextBox MTA
DataField = "Dr1"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 9360
MaxLength = 10
TabIndex = 5
Top = 1560
Width = 615
End
Begin TextBox Frage
DataField = "Info"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 9360
MaxLength = 63
TabIndex = 13
Top = 960
Width = 5535
End
Begin TextBox dr
DataField = "Dr2"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 9360
MaxLength = 30
TabIndex = 11
Top = 2160
Width = 2415
End
Begin TextBox Text12
DataField = "Aufn"
DataSource = "Daten1"
Height = 615
Left = 9360
MaxLength = 200
MultiLine = -1 'True
TabIndex = 61
Top = 240
Width = 4575
End
Begin TextBox Text11
DataField = "dlzeit"
DataSource = "Daten1"
Height = 495
Left = 9360
MaxLength = 5
TabIndex = 59
Top = 5760
Width = 1095
End
Begin TextBox Text10
DataField = "km"
DataSource = "Daten1"
Height = 495
Left = 9360
MaxLength = 20
TabIndex = 57
Top = 5160
Width = 3375
End
Begin CommandButton Befehl31
Caption = "Nein"
Height = 495
Left = 10320
TabIndex = 55
Top = 8760
Width = 615
End
Begin TextBox Text8
Alignment = 2 'Mitte
DataField = "grav"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 13.5
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 480
Left = 11880
MaxLength = 2
TabIndex = 54
Top = 8160
Width = 495
End
Begin CommandButton Befehl24
Caption = "JA"
Height = 495
Left = 10320
TabIndex = 53
Top = 8160
Width = 615
End
Begin TextBox Text7
DataField = "cu"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 13.5
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 11880
MaxLength = 10
TabIndex = 51
Top = 7560
Width = 975
End
Begin CommandButton Befehl12
Caption = "0,1 Cu"
Height = 495
Left = 10320
TabIndex = 50
Top = 7560
Width = 735
End
Begin CommandButton Befehl10
Caption = "Nicht möglich"
Height = 495
Left = 10320
TabIndex = 49
Top = 6960
Width = 1335
End
Begin CommandButton Befehl9
Caption = "JA"
Height = 495
Left = 10320
TabIndex = 48
Top = 6360
Width = 615
End
Begin TextBox Text5
Alignment = 2 'Mitte
DataField = "strschutz"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 13.5
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 12000
MaxLength = 2
TabIndex = 47
Top = 6360
Width = 495
End
Begin TextBox formate
DataField = "format"
DataSource = "Daten1"
Height = 495
Left = 9360
MaxLength = 200
TabIndex = 45
Top = 2760
Width = 5535
End
Begin TextBox Text3
DataField = "fd"
DataSource = "Daten1"
Height = 495
Left = 10440
MaxLength = 10
TabIndex = 43
Top = 4560
Width = 1215
End
Begin TextBox Dosismas
DataField = "mas"
DataSource = "Daten1"
Height = 495
Left = 9960
MaxLength = 50
TabIndex = 42
Top = 3960
Width = 4575
End
Begin TextBox dosiskv
DataField = "kv"
DataSource = "Daten1"
Height = 495
Left = 9960
MaxLength = 50
TabIndex = 37
Top = 3360
Width = 4575
End
Begin CommandButton Befehl30
Caption = "untere Extremitäten"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 36
Top = 3840
Width = 2175
End
Begin CommandButton Befehl29
Caption = "obere Extremitäten"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 35
Top = 1440
Width = 2175
End
Begin CommandButton Befehl26
Caption = "Thorax"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 34
Top = 2040
Width = 1335
End
Begin CommandButton Befehl25
Caption = "Schädel"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 33
Top = 240
Width = 1335
End
Begin CommandButton Befehl22
Caption = "Wirbelsäule"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 32
Top = 840
Width = 1455
End
Begin CommandButton Befehl23
Caption = "Datum suchen"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 31
Top = 6840
Width = 1575
End
Begin CommandButton Befehl2
Caption = "Info"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 30
Top = 9360
Width = 1575
End
Begin CommandButton Befehl19
Caption = "Abdomen"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 29
Top = 2640
Width = 1335
End
Begin CommandButton Befehl16
Caption = "Becken"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4920
TabIndex = 28
Top = 3240
Width = 1335
End
Begin CommandButton Befehl14
Caption = "Stammdaten 2*"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 27
Top = 4320
Width = 1695
End
Begin CommandButton Befehl13
Caption = "Weitersuchen"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 26
Top = 6240
Width = 1575
End
Begin TextBox st2
DataField = "st2"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1680
MaxLength = 3
TabIndex = 25
Top = 2880
Width = 495
End
Begin TextBox st1
DataField = "st1"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1200
MaxLength = 3
TabIndex = 24
Top = 2880
Width = 495
End
Begin CommandButton Befehl7
Caption = "&Beenden"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 13200
TabIndex = 21
Top = 10080
Width = 1575
End
Begin CommandButton Befehl5
Caption = "&Drucken"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 13200
TabIndex = 20
Top = 9360
Width = 1575
End
Begin CommandButton Befehl4
Caption = "&Löschen"
Enabled = 0 'False
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 19
Top = 10080
Width = 1575
End
Begin CommandButton Befehl3
Caption = "&Suchen"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 18
Top = 5640
Width = 1575
End
Begin CommandButton Befehl1
Caption = "&Neuer Patient"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 17
Top = 3720
Width = 1695
End
Begin TextBox tbefund
DataField = "Befund"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 855
Left = 1440
MaxLength = 2000
MultiLine = -1 'True
ScrollBars = 2 'Vertikal
TabIndex = 14
Top = 7680
Width = 4815
End
Begin TextBox tgeb
DataField = "geb"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1680
MaxLength = 10
TabIndex = 4
Top = 2160
Width = 1575
End
Begin TextBox tVorname
DataField = "Vorname"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1680
MaxLength = 25
TabIndex = 3
Top = 1680
Width = 1575
End
Begin TextBox TName
DataField = "Name"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1680
MaxLength = 25
TabIndex = 2
Top = 1200
Width = 1575
End
Begin TextBox tdatum
DataField = "Datum"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1680
MaxLength = 10
TabIndex = 1
Top = 720
Width = 1575
End
Begin TextBox stat
DataField = "Station"
DataSource = "Daten1"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 1680
MaxLength = 4
TabIndex = 0
Top = 240
Width = 975
End
Begin Data Daten1
Caption = "Blättern"
Connect = ""
DatabaseName = "C:\MDB\ROE.MDB"
Exclusive = -1 'True
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Left = 360
Options = 0
ReadOnly = 0 'False
RecordSource = "roe"
Top = 5040
Width = 2055
End
Begin Label Bezeichnung24
BackColor = &H0080FF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Bemerkungen"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 3000
TabIndex = 105
Top = 6720
Width = 1455
End
Begin Label Bezeichnung23
Alignment = 2 'Mitte
BackColor = &H0080FF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Rö-tüte "
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 3000
TabIndex = 102
Top = 6120
Width = 1335
End
Begin Label Bezeichnung22
Alignment = 2 'Mitte
BackColor = &H0080FF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Tüte mitgegeben"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 615
Left = 3000
TabIndex = 99
Top = 5400
Width = 1335
End
Begin Label Bezeichnung10
Alignment = 2 'Mitte
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Datensatznr.:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 2280
TabIndex = 62
Top = 3720
Width = 1575
End
Begin Label Bezeichnung7
Alignment = 2 'Mitte
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "DR"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 22
Top = 2160
Width = 975
End
Begin Label Bezeichnung6
Alignment = 2 'Mitte
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "MTRA"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 10
Top = 1560
Width = 975
End
Begin Label Bezeichnung1
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "STATION:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 12
Top = 240
Width = 1215
End
Begin Label Bezeichnung21
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Aufnahmen"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 60
Top = 240
Width = 1575
End
Begin Label Bezeichnung20
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "DL-Zeit"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 58
Top = 5760
Width = 975
End
Begin Label Bezeichnung19
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "KM"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 56
Top = 5160
Width = 975
End
Begin Label Bezeichnung18
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Schwangerschaft"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 52
Top = 8160
Width = 2175
End
Begin Label Bezeichnung17
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Strahlenschutz"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 46
Top = 6360
Width = 1935
End
Begin Label Bezeichnung16
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Format"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 44
Top = 2760
Width = 975
End
Begin Label Bezeichnung15
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "µGy cm²"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 9360
TabIndex = 41
Top = 4560
Width = 1095
End
Begin Label Bezeichnung14
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "mAs"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 9360
TabIndex = 40
Top = 3960
Width = 615
End
Begin Label Bezeichnung13
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "KV"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 9360
TabIndex = 39
Top = 3360
Width = 615
End
Begin Label Bezeichnung12
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "Dosis :"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 38
Top = 3360
Width = 975
End
Begin Label Bezeichnung11
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "ORGAN"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 23
Top = 2880
Width = 855
End
Begin Label Bezeichnung9
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "BEFUND:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 360
TabIndex = 16
Top = 7680
Width = 1095
End
Begin Label Bezeichnung8
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "FRAGE:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 7800
TabIndex = 15
Top = 960
Width = 1215
End
Begin Label Bezeichnung5
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "GEB:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 495
Left = 360
TabIndex = 9
Top = 2160
Width = 1215
End
Begin Label Bezeichnung4
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "VORNAME"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 495
Left = 360
TabIndex = 8
Top = 1680
Width = 1215
End
Begin Label Bezeichnung3
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "NAME:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 495
Left = 360
TabIndex = 7
Top = 1200
Width = 1215
End
Begin Label Bezeichnung2
Alignment = 1 'Rechts
BackColor = &H00FFFF80&
BorderStyle = 1 'nicht änderbar, einfach
Caption = "DATUM:"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H00000000&
Height = 495
Left = 360
TabIndex = 6
Top = 720
Width = 1215
End
End
Sub Befehl1_Click ()
'uart.Text = ""
Daten1.Caption = "Neuer Patient"
Daten1.Recordset.MoveLast
'Rem letzte Nummer holen und eins dazuzählen
n = Format$(Val(nr.Text) + 1)
Daten1.Recordset.AddNew
'Rem neues Nummerfeld wieder auffüllen
nr.Text = n
tbefund.Text = ""
stat.SetFocus
tdatum.Text = Format$(Now, "d/m/yyyy")
'Rem tdatum.Text = Format$(Now, "d/m/yy")
End Sub
Sub Befehl10_Click ()
text5.Text = "N"
End Sub
Sub Befehl11_Click ()
title = "Info Neue Nummern"
msg = "Wollen Sie wirklich neu Durchnummerieren ??"
msg = msg + Chr(13) + Chr(10) + "Dieser Vorgang dauert unter Umständen mehrere Minuten!"
If MsgBox(msg, 1, title) = 2 Then Exit Sub
mousepointer = 11
Daten1.Recordset.MoveLast
nn = Val(nr.Text)
Daten1.Recordset.MoveFirst
For a = 1 To nn
If Val(nr.Text) > a Then nr.Text = Format$(a)
If Val(nr.Text) < a Then nr.Text = Format$(a)
Daten1.Recordset.MoveNext
If Daten1.Recordset.EOF = True Then a = nn + 1
Next a
mousepointer = 0
End Sub
Sub Befehl12_Click ()
text7.Text = "0,1 Cu "
End Sub
Sub Befehl13_Click ()
mousepointer = 11
us0.Daten1.Recordset.FindPrevious "Name Like '" + tsuch.Text + "*' and Vorname Like '" + tsuchvorname.Text + "*'"
' Hier noch eine Message einfügen , daß weitersuchen nur funktioniert
' wenn vorher Suchen betätigt wurde
mousepointer = 0
End Sub
Sub Befehl14_Click () ' Hier werden die Stammdaten des angezeigten Datensatzes ' in einen neuen Datensatz kopiert ' tst = tstation.Text tn = tname.Text tv = tvorname.Text tg = tgeb.Text 'uart.Text = "" Daten1.Caption = "Neuer Patient" Daten1.Recordset.MoveLast n = Format$(Val(nr.Text) + 1) Rem n = Right$(n, 5) Daten1.Recordset.AddNew ' tstation.Text = tst tname.Text = tn tvorname.Text = tv tgeb.Text = tg tbefund.Text = "" mta.SetFocus Rem tdatum.Text = Format$(Now, "d/m/yy") : rem ohne 2000 Patch tdatum.Text = Format$(Now, "d/m/yyyy") nr.Text = n End Sub
Sub Befehl15_Click () Tüte.Text = "J" End Sub
Sub Befehl16_Click () Becken.Show 'us0.Hide End Sub
Sub Befehl17_Click () Tüte.Text = "N" End Sub
Sub Befehl18_Click () ALT.Text = "alt" End Sub
Sub Befehl19_Click () Abdomen.Show 'us0.Hide End Sub
Sub Befehl2_Click () msg = "Dieses Programm stammt von" msg = msg + Chr(13) + Chr(10) + "S.Glienke u R.Hoffmann " msg = msg + Chr(13) + Chr(10) + "Wertachstr 55" msg = msg + Chr(13) + Chr(10) + "86399 Bobingen " msg = msg + Chr(13) + Chr(10) + "Tel " msg = msg + Chr(13) + Chr(10) msg = msg + Chr(13) + Chr(10) + "DSatzZwSp = Der gesamte Datensatz wird in den Windows Zwischenspeicher kopiert" msg = msg + Chr(13) + Chr(10) + "BefundZwSp = Der Befundtext wird in den Windows Zwischenspeicher kopiert " title = "Programminfo" MsgBox msg, 0, title End Sub
Sub Befehl20_Click () ALT.Text = "neu" End Sub
Sub Befehl21_Click () 'nrsuch.Show 1 End Sub
Sub Befehl22_Click () wirbel.Show 'us0.Hide End Sub
Sub Befehl23_Click () 'datum.Show 1 End Sub
Sub Befehl24_Click () text8.Text = "J" End Sub
Sub Befehl25_Click () schaedel.Show 'us0.Hide End Sub
Sub Befehl26_Click () thorax.Show 'us0.Hide End Sub
Sub Befehl27_Click () Rem BefundZwSp = Der Befundtext wird in den Windows Zwischenspeicher kopiert Clipboard.Clear Clipboard.SetText tbefund.Text End Sub
Sub Befehl28_Click () Rem DSatzZwSp = Der gesamte Datensatz wird in den Windows Zwischenspeicher kopiert z$ = z$ + tname.Text + " " + tvorname.Text + " " + tgeb.Text + Chr$(13) + Chr$(10) z$ = z$ + "Untersuchung vom: " + tdatum.Text + " UNr:" + nr.Text + " Station: " + stat.Text + Chr$(13) + Chr$(10) z$ = z$ + "Doktor: " + mta.Text + " " + dr.Text + Chr$(13) + Chr$(10) z$ = z$ + "Klin.Diagnose:" + Chr$(13) + Chr$(10) z$ = z$ + "==> " + frage.Text + Chr$(13) + Chr$(10) z$ = z$ + "BEFUND: " + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) z$ = z$ + tbefund.Text Clipboard.SetText z$ End Sub
Sub Befehl29_Click () obere.Show 'us0.Hide End Sub
Sub Befehl3_Click () Suchen.Show 1 befehl13.SetFocus End Sub
Sub Befehl30_Click () untere.Show 'us0.Hide End Sub
Sub Befehl31_Click () text8.Text = "N" End Sub
Sub Befehl4_Click ()
Antwort = MsgBox("Datensatz wirklich löschen ?", 20)
If Antwort = 6 Then
Daten1.Recordset.Delete
Daten1.Recordset.MovePrevious
If Daten1.Recordset.BOF = True Then
Daten1.Recordset.MoveNext
End If
End If
End Sub
Sub Befehl5_Click ()
Rem Statistik felder = Untersuchungsart
mousepointer = 11
Printer.FontBold = False ' Fettdruck einschalten
Printer.ScaleMode = 7 ' Windows Grafikauflösung auf CM einstellen
Printer.ScaleLeft = -2 ' linken Rand auf 2 cm einstellen
Printer.FontName = "Times New Roman"
Printer.FontSize = 12
Printer.Print " "
Printer.Print " "
Printer.Print "-------------------------------------------------------------------------------------------------------------"
Printer.Print "RÖNTGEN WERTACHKLINIKEN KH BOBINGEN"
Printer.Print "-------------------------------------------------------------------------------------------------------------"
Printer.Print
Printer.Print
Printer.Print tname.Text + " " + tvorname.Text + " " + tgeb.Text
Printer.Print
Printer.Print "Untersuchung vom: " + tdatum.Text + " Station: " + stat.Text
Printer.Print
Printer.Print "MTRA: " + mta.Text + " " + "DR:" + dr.Text
Printer.Print
Printer.Print
Printer.Print "Aufnahmen: " + text12.Text
Printer.Print
Printer.Print "--------------------"
Printer.Print "FRAGESTELLUNG:"
Printer.Print "--------------------"
Printer.Print "==> " + frage.Text
Printer.Print
Printer.Print
Printer.Print "Formate : " + formate.Text
Printer.Print
Printer.Print "KV: " + dosiskv.Text
Printer.Print
Printer.Print "MAS: " + dosismas.Text
Printer.Print
Printer.Print "Flächendosis :"; " " + text3.Text
Printer.Print
Printer.Print "Kontrastmittel :" + text10.Text
Printer.Print
Printer.Print "Durchleuchtungszeit: " + text11.Text
Printer.Print
Printer.Print "Strahlenschutz: " + text5.Text + " " + text7.Text
Printer.Print
Printer.Print "Schwangerschaft: " + text8.Text
Printer.Print
'printer.Print "-------------"
'printer.Print "BEFUND: ": Rem:+ uart.Text
'printer.Print "-------------"
'printer.Print
Rem printer.Print tbefund.Text
Rem beginn druckroutine
Rem programmiert von martin passing, zdl 2000/2001
Dim a, b, i, n
a = 1: Rem markierungsvariable für zuletzt gedrucktes zeichen
b = 1: Rem markierungsvariable für zuletzt gefundenes leerzeichen
n = 90: Rem maximale zeilenlänge
prttxt$ = tbefund.Text
For i = 1 To Len(prttxt$)
Rem prüfe ob zeilenvorschub vorhanden
If Mid$(prttxt$, i, 1) = Chr(13) Then
Printer.Print Mid$(prttxt$, a, i - a)
a = i + 2
b = i + 2
Else
Rem prüfe ob leerzeichen vorhanden
If Mid$(prttxt$, i, 1) = " " Then
b = i
End If
Rem prüfe ob zeile zu lang wird
If i - a > n Then
Rem prüfe ob bei zu langer zeile kein leerzeichen vorhanden ist
If b <= a Then
b = i
End If
Printer.Print Mid$(prttxt$, a, b - a)
If Mid$(prttxt$, b, 1) = " " Then
b = b + 1
End If
a = b
End If
End If
Next i
Printer.Print Mid$(prttxt$, a, Len(prttxt$) - a + 1)
Rem ende druckroutine
Printer.Print
Printer.Print
Printer.Print
Rem printer.Print "Ausgedruckt am " + Format(Now, "ddd" + " " + "c")
Printer.Print "Ausgedruckt am " + Format$(Now, "d/m/yyyy") + " Uhrzeit " & Format(Now, "ttttt")
Printer.EndDoc
' Exit Sub
' errorhandler:
' MsgBox "Drucker überprüfen !"
' Exit Sub
mousepointer = 0
End Sub
Sub Befehl6_Click () If t5010.Visible = True Then t5010.Visible = False Else t5010.Visible = True End If If t5020.Visible = True Then t5020.Visible = False Else t5020.Visible = True End If If t5021.Visible = True Then t5021.Visible = False Else t5021.Visible = True End If If t5030.Visible = True Then t5030.Visible = False Else t5030.Visible = True End If If t5031.Visible = True Then t5031.Visible = False Else t5031.Visible = True End If If t5040.Visible = True Then t5040.Visible = False Else t5040.Visible = True End If If t5090.Visible = True Then t5090.Visible = False Else t5090.Visible = True End If If t5095.Visible = True Then t5095.Visible = False Else t5095.Visible = True End If If t5098.Visible = True Then t5098.Visible = False Else t5098.Visible = True End If If t5100.Visible = True Then t5100.Visible = False Else t5100.Visible = True End If If t5101.Visible = True Then t5101.Visible = False Else t5101.Visible = True End If If t5105.Visible = True Then t5105.Visible = False Else t5105.Visible = True End If If t5106.Visible = True Then t5106.Visible = False Else t5106.Visible = True End If If t5166.Visible = True Then t5166.Visible = False Else t5166.Visible = True End If If t5030x2.Visible = True Then t5030x2.Visible = False Else t5030x2.Visible = True End If If t5120.Visible = True Then t5120.Visible = False Else t5120.Visible = True End If If t5121.Visible = True Then t5121.Visible = False Else t5121.Visible = True End If If t5130.Visible = True Then t5130.Visible = False Else t5130.Visible = True End If If t5135.Visible = True Then t5135.Visible = False Else t5135.Visible = True End If If t5137.Visible = True Then t5137.Visible = False Else t5137.Visible = True End If If t5190.Visible = True Then t5190.Visible = False Else t5190.Visible = True End If If t5191.Visible = True Then t5191.Visible = False Else t5191.Visible = True End If If t5150.Visible = True Then t5150.Visible = False Else t5150.Visible = True End If If t5157.Visible = True Then t5157.Visible = False Else t5157.Visible = True End If If t5158.Visible = True Then t5158.Visible = False Else t5158.Visible = True End If If t5163.Visible = True Then t5163.Visible = False Else t5163.Visible = True End If If t5165.Visible = True Then t5165.Visible = False Else t5165.Visible = True End If If t5200.Visible = True Then t5200.Visible = False Else t5200.Visible = True End If If t5201.Visible = True Then t5201.Visible = False Else t5201.Visible = True End If If t5250.Visible = True Then t5250.Visible = False Else t5250.Visible = True End If End Sub
Sub Befehl6_MouseUp (button As Integer, Shift As Integer, X As Single, Y As Single) If button = 2 Then st1 = "Abd" End Sub
Sub Befehl7_Click () Daten1.Recordset.MovePrevious If Daten1.Recordset.BOF = True Then Daten1.Recordset.MoveNext End If End End Sub
Sub Befehl8_Click () mousepointer = 11 Printer.FontBold = False ' Fettdruck einschalten Printer.ScaleMode = 7 ' Windows Grafikauflösung auf CM einstellen Printer.ScaleLeft = -2 ' linken Rand auf 2 cm einstellen Printer.FontName = "Times New Roman" Printer.FontSize = 11 Printer.FontBold = True 'Fettdruck Printer.ScaleLeft = -1 ' linken Rand auf 2 cm einstellen Printer.FontName = "Times New Roman" Printer.FontSize = 13 Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print " " Printer.Print "-------------------------------------------------------------------------------------------------------------" Printer.Print "KH Bobingen " + " " + tname.Text + " " + tvorname.Text + " " + tgeb.Text + " " + stat.Text + " " + tdatum.Text + " A" Printer.Print "-------------------------------------------------------------------------------------------------------------" Printer.EndDoc mousepointer = 0 End Sub Sub Befehl9_Click () text5.Text = "J" End Sub
Sub Bezeichnung1_Click ()
Station.Show
'us0.Hide
End Sub
Sub Bezeichnung13_Click ()
KV.Show
'us0.Hide
End Sub
Sub Bezeichnung14_Click ()
mAs.Show
'us0.Hide
End Sub
Sub Bezeichnung16_Click ()
Kassetten.Show
'us0.Hide
End Sub
Sub Bezeichnung19_Click ()
KM.Show
'us0.Hide
End Sub
Sub Bezeichnung6_Click ()
mtr.Show
'us0.Hide
End Sub
Sub Bezeichnung7_Click ()
dokt.Show
'us0.Hide
End Sub
Sub Bezeichnung8_Click ()
frage1.Show
'us0.Hide
End Sub
Sub Daten1_MouseDown (button As Integer, Shift As Integer, X As Single, Y As Single)
Daten1.Caption = "Bearbeiten"
End Sub
Sub dr1_Change ()
'kombi1.Text = dr1.Text
End Sub
Sub dr1_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then dr.SetFocus
If keycode = Nach_oben_Taste Then tgeb.SetFocus
End Sub
Sub dr1_KeyPress (keyansi As Integer)
If keyansi = 13 Then
dr.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Sub dr2_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then frage.SetFocus
If keycode = Nach_oben_Taste Then mta.SetFocus
End Sub
Sub dr2_KeyPress (keyansi As Integer)
If keyansi = 13 Then
frage.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Sub Form_Load ()
Width = Screen.Width
Height = Screen.Height
us0.AutoRedraw = True
us0.DrawStyle = 6
us0.DrawMode = 13
us0.DrawWidth = 2
us0.ScaleMode = 3
us0.ScaleHeight = (256 * 2)
For i = 0 To 255
us0.Line (0, Y)-(us0.Width, Y + 2), RGB(0, 0, i), BF
Y = Y + 2
Next i
Rem Füllen der Kombiliste 1
'kombi1.AddItem "ho": Rem Hoffmann
'kombi1.AddItem "he": Rem Herrmann
'kombi1.AddItem "fr": Rem Frieß
'kombi1.AddItem "za": Rem Zapf
'kombi1.AddItem "zei": Rem Zeier
'kombi1.AddItem "fi": Rem Fischer
'kombi1.AddItem "sav": Rem Frau Savova
'kombi1.AddItem "cs": Rem Csernai
'kombi1.AddItem "st": Rem Steinbach
End Sub
Sub info_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then tbefund.SetFocus
If keycode = Nach_oben_Taste Then dr.SetFocus
End Sub
Sub info_KeyPress (keyansi As Integer)
If keyansi = 13 Then
tbefund.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Sub Kombi1_Change ()
End Sub
Sub Kombi1_Click ()
frage.SetFocus
End Sub
Sub Kombi2_Change ()
End Sub
Sub Kombi2_Click ()
tname.SetFocus
End Sub
Sub tdatum_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then tname.SetFocus
If keycode = Nach_oben_Taste Then Station.SetFocus
End Sub
Sub tgeb_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then mta.SetFocus
If keycode = Nach_oben_Taste Then tvorname.SetFocus
End Sub
Sub tgeb_KeyPress (keyansi As Integer)
If keyansi = 13 Then
mta.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Sub TName_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then tvorname.SetFocus
If keycode = Nach_oben_Taste Then tdatum.SetFocus
End Sub
Sub TName_KeyPress (keyansi As Integer)
If keyansi = 13 Then
tvorname.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Sub tstation_Change ()
End Sub
Sub tstation_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then tdatum.SetFocus
End Sub
Sub tstation_KeyPress (keyansi As Integer)
If keyansi = 13 Then
tname.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Sub tVorname_KeyDown (keycode As Integer, Shift As Integer)
If keycode = Nach_unten_Taste Then tgeb.SetFocus
If keycode = Nach_oben_Taste Then tname.SetFocus
End Sub
Sub tVorname_KeyPress (keyansi As Integer)
If keyansi = 13 Then
tgeb.SetFocus
'if keyansi = "Pfeil runter "
'then tdatum.setfocus
End If
End Sub
Voraussetzungen für die korrekte Funktion des Programmes Bearbeiten
Vb 3.0 und Access 2.0 sind sehr schlank und laufen auf allen Windowo Version seit 1993 ( Windows 95/98, XP). Vista unterstützt VB3 nicht mehr korrekt. VB3 und Access2 können einfach installiert werden, wenn man lauffähige lizenzierte Versionen dieser Programme besitzt.
Access 2.0 ist nicht unbedingt notwendig für die Funktion des Programmes. Allerdings ist es hilfreich für die Erstellung der Tabelle roe.mdb und für die spätere statistische Auswertung der Tabelle.
Für die korrekte Funktion von Vb 3.0 zusammen mit Accesse 2.0 sind einige DLLs notwendig:
Siehe Waybackmaschine und dann unter www.madeasy.de/4/prgmeddb.htm suchen. Dort ist auch ein Download der DLLs möglich.
Folgende Systemdateien müssen für den Betrieb der Datenbank Programme vorhanden sein: Datei Download Größe Datum MSAJT112.DLL MSAJT112.DLL 17.440 Bytes 24.03.1994 00:00 MSAJT200.DLL MSAJT200.DLL 994.496 Bytes 06.04.1994 00:00 VBDB300.DLL VBDB300.DLL 95.200 Bytes 24.03.1994 00:00 VBRUN300.DLL VBRUN300.DLL 398416 Bytes 12.05.1993 01:00:00
Stellen Sie sicher, daß diese Dateien in Ihrem Windows Systemverzeichnis (C:\WINDOWS\SYSTEM\) nicht in einer älteren Version als der o.g. (Datum / Uhrzeit) vorhanden sind.
Stellen Sie weiterhin sicher, daß keine der genannten Dateien im Verzeichnis C:\WINDOWS\ vorhanden ist. Löschen Sie ggf. die vorhandenen Dateien.
Die Datenbanken stehen immer in einem separaten Verzeichnis auf der Festplatte mit der Bezeichnung C:\MDB Zur Programmierung unter Visual Basic sollte der COMLAYER 2.0 installiert sein.