Imports DPM2016.MyCombobox Public Class PatientDetailsFirma #Region "Properties" Dim m_patientnr As Integer Property PatientNr As Integer Get Return m_patientnr End Get Set(value As Integer) Try Me.SuspendLayout() m_patientnr = value Fill_Stammdaten() log.Writelog("Partnerdetails: Get_Data Start", clsLog.Logtype.Information) Get_Data() log.Writelog("Partnerdetails: Get_Data Ende", clsLog.Logtype.Information) AddChanges(Me) Me.cbboxNrAnrede.Select() Me.HasChanges = False Globals.EVH.Fire_PatName_Changed(Me.Patientname, Me.PatientNr) Catch ex As Exception log.Writelog("Partnerdetails: Property PatientNr: " + ex.Message, clsLog.Logtype.ApplError) End Try Me.Label13.Visible = False Me.chklbAdresstyp.Visible = False Me.ResumeLayout() End Set End Property Dim m_patname As String Property Patientname As String Get Return Me.txtnrprivat.Text + " " + Me.txtName.Text + " " + Me.txtVorname.Text + " " + Me.txtOrt.Text End Get Set(value As String) End Set End Property Dim m_haschanges As Boolean Property HasChanges As Boolean Get Return m_haschanges End Get Set(value As Boolean) m_haschanges = value End Set End Property #End Region #Region "Deklarationen" Dim DB As New clsDB Dim FormReadonly As Boolean = False Dim log As New clsLog Dim WithEvents evh As Generic_Event_Handler = Globals.EVH #End Region #Region "Closing / Check_Changes" ''' ''' Prüfung, ob Datenänderungen vorgenommen wurden. ''' ''' Private Function Check_Changes() As Boolean If Me.FormReadonly Then Return True Exit Function End If Dim msgres As MsgBoxResult If Me.HasChanges Then msgres = MsgBox("Daten wurden verändert. Wollen Sie die Änderungen speichern", vbYesNo + vbQuestion) Select Case msgres Case MsgBoxResult.Yes Save_Data() Return True Case MsgBoxResult.Cancel Return False Case MsgBoxResult.No Me.HasChanges = False Return True End Select Else Return True End If End Function #End Region #Region "Eventhandler ChangeEreignisse" ''' ''' Allg Eventhandler für Chanage-Ereignise festlegen ''' ''' ''' Private Sub AddChanges(ByVal Container As Control) Dim l As New List(Of Control) Me.GetControl(Me, "*", l) Dim evh As EventHandler = AddressOf ChangesMade For Each c As Control In l If TypeOf c Is TextBox Then Dim ctl As TextBox = c AddHandler ctl.TextChanged, evh End If If TypeOf c Is MaskedTextBox Then Dim ctl As MaskedTextBox = c AddHandler ctl.TextChanged, evh End If If TypeOf c Is ComboBox Then Dim ctl As ComboBox = c AddHandler ctl.SelectedValueChanged, evh End If If TypeOf c Is RichTextBox Then Dim ctl As RichTextBox = c AddHandler ctl.TextChanged, evh End If If TypeOf c Is CheckBox Then If c.Name <> "cboxNurAktive" Then Dim ctl As CheckBox = c AddHandler ctl.CheckedChanged, evh End If End If If TypeOf c Is DateTimePicker Then Dim ctl As DateTimePicker = c AddHandler ctl.ValueChanged, evh End If If TypeOf c Is CheckedListBox Then Dim ctl As CheckedListBox = c AddHandler ctl.ItemCheck, AddressOf ChecketListBoxChange End If Next End Sub ''' ''' Envent-Handler für Change-Ereignisse ''' ''' ''' ''' Private Sub ChangesMade(ByVal sender As Object, ByVal e As System.EventArgs) Me.HasChanges = True Dim objtype As System.Type = sender.GetType If objtype.Name = "MaskedTextBox" Then Dim o As MaskedTextBox = sender If o.Text = "01.01.1900" Then o.Text = " . . " End If End Sub Private Sub ChecketListBoxChange(ByVal sender As Object, ByVal e As System.Windows.Forms.ItemCheckEventArgs) Me.HasChanges = True End Sub ''' ''' Sucht in den Base-Controls sämtliche Controls mit dem Namen in "Key" (Wildcards * möglich) und listet ''' die gefundnen Controls in der Liste L zur weiteren Bearbeitung ''' ''' Base-Contrlo (z.B. aktuelles Formular ''' Schlüssel welcher gesucht werden soll ''' Liste der gefundenen Objekte ''' True wenn eines oder mehr Controls gefunden wurden, false wenn kein Control gefunden wurde. ''' ''' Private Function GetControl(ByVal BaseControl As Control, ByVal Key As String, ByRef L As List(Of Control), Optional ByVal ReturnAtFirstElement As Boolean = False) As Boolean If L Is Nothing Then L = New List(Of Control) Dim Gut As Boolean Dim ReturnFlag As Boolean = False If Key IsNot Nothing Then Key = Key.ToLower If BaseControl.HasChildren = True Then For Each ctl As Control In BaseControl.Controls Gut = False If Key Is Nothing Then Gut = True Else If ctl.Name.Length >= Key.Length Then Key = Key.ToLower If Key.StartsWith("*") Then If Key.Substring(1) = ctl.Name.ToLower.Substring(ctl.Name.Length - (Key.Length - 1), Key.Length - 1) Then Gut = True ElseIf Key.EndsWith("*") Then If Key.Substring(0, Key.Length - 1) = ctl.Name.ToLower.Substring(0, Key.Length - 1) Then Gut = True Else If Key = ctl.Name.ToLower Then Gut = True End If End If End If If Gut = True Then L.Add(ctl) If ReturnAtFirstElement = True Then ReturnFlag = True End If If ReturnFlag = False Then Call GetControl(ctl, Key, L) End If Next End If If L.Count - 1 > -1 Then Return True Else Return False End If End Function #End Region #Region "Daten_Laden" Public Sub Fill_Stammdaten() ' If Globals.Stammdaten_Geladen = True Then Exit Sub If Globals.Applicationtype = ApplicationTypes.Projektabrechnung Then chklbAdresstyp.Items.Clear() chklbAdresstyp.Items.Add("Leistungserbringer") End If log.Writelog("PartnerDetails: Fill_Stammdaten", clsLog.Logtype.Information) Me.cbboxNrAnrede.Table = "Anrede" Me.cbboxNrAnrede.Displaymember = "Anrede_D" Me.cbboxNrAnrede.Valuemember = "NRANREDE" Me.cbboxNRTitel.Table = "Titel" Me.cbboxNRTitel.Displaymember = "Titel_D" Me.cbboxNRTitel.Valuemember = "NRTITEL" Me.cbboxSprache.Table = "Sprache" Me.cbboxSprache.Displaymember = "Sprachbezeichnung" Me.cbboxSprache.Valuemember = "Sprachcode" Me.cbboxStatus.Table = "Status" Me.cbboxStatus.Displaymember = "Status" Me.cbboxStatus.Valuemember = "nrstatus" Me.cbboxGeschlecht.Table = "Geschlecht" Me.cbboxGeschlecht.Displaymember = "Geschlecht" Me.cbboxGeschlecht.Valuemember = "NrGeschlecht" Me.cbboxNRArbeitgeber.Dataselection = DB.Get_SQL(1) Me.cbboxNRArbeitgeber.Table = "Arbeitgeber" Me.cbboxNRArbeitgeber.Displaymember = "Firmenname" Me.cbboxNRArbeitgeber.Valuemember = "nrfirma" Try Me.ClsStammdaten_flat1.Tablename = "PADM_Ansprechpartner" Me.ClsStammdaten_flat1.SQL = "Select * from padm_ansprechpartner where aktiv=1 and nrprivat=" + Me.PatientNr.ToString Me.ClsStammdaten_flat1.get_data() Me.ClsStammdaten_flat1.ToolStripButton5.Visible = False Catch End Try log.Writelog("PartnerDetails: Fill_Stammdaten Ende", clsLog.Logtype.Information) Globals.Stammdaten_Geladen = True End Sub Sub Get_Data() Dim ctlname As String Dim colname As String Try If Globals.Hide_Gueltig_bis Then Me.Label15.Visible = False Me.dtgueltigbis.Visible = False End If DB.Get_Tabledata("privat", " where nrprivat=" + Me.PatientNr.ToString) Dim r As DataRow = DB.dsDaten.Tables(0).Rows(0) For Each c As DataColumn In DB.dsDaten.Tables(0).Columns colname = c.ColumnName Debug.Print(colname) For Each Ctl As Control In Me.Controls 'Dim objtype As System.Type = Ctl.GetType 'If objtype.Name = "Label" Then ' Exit For 'End If ctlname = Ctl.Name log.Writelog("Partnerdtails: Get_Data: " + Ctl.Name, clsLog.Logtype.Information) If UCase(Ctl.Name) = "TXT" + UCase(c.ColumnName) Then log.Writelog("--Partnerdtails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Ctl.Text = r(c.ColumnName).ToString Exit For End If If UCase(Ctl.Name) = "CBBOX" + UCase(c.ColumnName) Then log.Writelog("--Partnerdtails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) If (c.ColumnName) = "sprache" Then Dim a As Integer = 1 End If Dim ct As MyCombobox Dim o As Object = Ctl Try o.SelectedValue = r(c.ColumnName) Catch o.SelectedValue = -1 End Try Exit For End If If UCase(Ctl.Name) = "CBTXTBOX" + UCase(c.ColumnName) Then log.Writelog("--Partnerdtails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Dim ct As ComboBox Dim o As Object = Ctl Try o.text = r(c.ColumnName) Catch o.Text = "" End Try Exit For End If If UCase(Ctl.Name) = "DT" + UCase(c.ColumnName) Then log.Writelog("--Partnerdtails: Get_Data: " + Ctl.Name + " " + c.ColumnName, clsLog.Logtype.Information) Dim dt As DateTimePicker dt = Ctl 'Try ' dt.Value = r(c.ColumnName) 'Catch ' dt.Value = " . . " 'End Try Try dt.Value = r(c.ColumnName) dt.Format = DateTimePickerFormat.Short Catch dt.CustomFormat = " " 'An empty SPACE dt.Format = DateTimePickerFormat.Custom End Try Exit For End If 'If UCase(Ctl.Name) = "CHKMAIL_KOMMUNIKATION" Then ' MsgBox("Hallo") 'End If 'If UCase(r(c.ColumnName)) = "MAIL_KOMMUNIKATION" Then ' MsgBox("Bello") 'End If If UCase(Ctl.Name) = "CHK" + UCase(c.ColumnName) Then Dim cb As CheckBox cb = Ctl Try cb.Checked = r(c.ColumnName) Catch ex As Exception End Try Exit For End If Next If Globals.Applicationtype = ApplicationTypes.Projektabrechnung Then If LCase(c.ColumnName) = "behandler" Then Set_Adresstype(c.ColumnName, r(c.ColumnName).ToString) End If Else Select Case LCase(c.ColumnName) Case "patient" Set_Adresstype(c.ColumnName, r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "garant" Set_Adresstype(c.ColumnName, r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "gesvertreter" Set_Adresstype("Ges. Vertreter", r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "hausarzt" Set_Adresstype(c.ColumnName, r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "zahnarzt" Set_Adresstype(c.ColumnName, r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "behandler" Set_Adresstype(c.ColumnName, r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "dhpat" Set_Adresstype("DH-Patient", r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "nichtaufbieten" Set_Adresstype("Nicht Aufbieten", r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "nichtannehmen" Set_Adresstype("Nicht annehmen", r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) Case "betreibung" Set_Adresstype("Betreibung vorhanden", r(c.ColumnName).ToString) log.Writelog("--Partnerdtails: Get_Data Set_Adresstyp: " + c.ColumnName, clsLog.Logtype.Information) End Select End If Next Me.ClsStammdaten_flat1.SQL = "Select * from privat_ansprechpartner where nrprivat=" + Me.PatientNr.ToString Me.ClsStammdaten_flat1.AllowAddNew = False Me.ClsStammdaten_flat1.Tablename = "Privat_Ansprechpartner" Me.ClsStammdaten_flat1.get_data() Catch ex As Exception log.Writelog("Privatdetails: Get_Data: " + ctlname + " / " + colname + " " + ex.Message, clsLog.Logtype.ApplError) End Try End Sub Private Sub Set_Adresstype(ByVal feldname, value) If Globals.Applicationtype = ApplicationTypes.Projektabrechnung Then If value <> False Then chklbAdresstyp.SetItemCheckState(0, CheckState.Checked) Else chklbAdresstyp.SetItemCheckState(0, CheckState.Unchecked) End If Dim i As Integer For i = 0 To Me.chklbAdresstyp.Items.Count - 1 If UCase(chklbAdresstyp.Items(i).ToString) = UCase(feldname) Then Try If value <> False Then chklbAdresstyp.SetItemCheckState(i, CheckState.Checked) Else chklbAdresstyp.SetItemCheckState(i, CheckState.Unchecked) Catch ex As Exception chklbAdresstyp.SetItemCheckState(i, CheckState.Unchecked) End Try End If Next End Sub #End Region #Region "Daten speichern" Public Sub Save_Data() If Me.HasChanges = False Then Exit Sub DB.Get_Tabledata("privat", " where nrprivat=" + Me.PatientNr.ToString) Dim r As DataRow = DB.dsDaten.Tables(0).Rows(0) For Each c As DataColumn In DB.dsDaten.Tables(0).Columns For Each Ctl As Control In Me.Controls If UCase(Ctl.Name) = "TXT" + UCase(c.ColumnName) Then If UCase(Ctl.Name) <> "TXTMUTIERT_AM" And UCase(Ctl.Name) <> "TXTERSTLLT_AM" Then r(c.ColumnName) = Ctl.Text Exit For End If End If If UCase(Ctl.Name) = "CBBOX" + UCase(c.ColumnName) Then Dim ct As MyCombobox Dim o As Object = Ctl Try r(c.ColumnName) = o.selectedvalue Catch ex As Exception r(c.ColumnName) = 0 End Try Exit For End If If UCase(Ctl.Name) = "CBTXTBOX" + UCase(c.ColumnName) Then Dim ct As MyCombobox Dim o As Object = Ctl Try r(c.ColumnName) = o.text Catch ex As Exception r(c.ColumnName) = "" End Try Exit For End If If UCase(Ctl.Name) = "DT" + UCase(c.ColumnName) Then Dim dt As DateTimePicker dt = Ctl r(c.ColumnName) = dt.Value Exit For End If If UCase(Ctl.Name) = "CHK" + UCase(c.ColumnName) Then Dim cb As CheckBox cb = Ctl r(c.ColumnName) = cb.Checked Exit For End If Next If Globals.Applicationtype = ApplicationTypes.Projektabrechnung Then Select Case LCase(c.ColumnName) Case "behandler" r(c.ColumnName) = Get_Adresstype(c.ColumnName, r(c.ColumnName)) End Select Else Select Case LCase(c.ColumnName) Case "patient" r(c.ColumnName) = Get_Adresstype(c.ColumnName, r(c.ColumnName)) Case "garant" r(c.ColumnName) = Get_Adresstype(c.ColumnName, r(c.ColumnName)) Case "gesvertreter" r(c.ColumnName) = Get_Adresstype("Ges. Vertreter", r(c.ColumnName)) Case "hausarzt" r(c.ColumnName) = Get_Adresstype(c.ColumnName, r(c.ColumnName)) Case "zahnarzt" r(c.ColumnName) = Get_Adresstype(c.ColumnName, r(c.ColumnName)) Case "behandler" r(c.ColumnName) = Get_Adresstype(c.ColumnName, r(c.ColumnName)) Case "dhpat" r(c.ColumnName) = Get_Adresstype("DH-Patient", r(c.ColumnName)) Case "nichtaufbieten" r(c.ColumnName) = Get_Adresstype("nicht aufbieten", r(c.ColumnName)) Case "nichtannehmen" r(c.ColumnName) = Get_Adresstype("nicht annehmen", r(c.ColumnName)) Case "betreibung" r(c.ColumnName) = Get_Adresstype("Betreibung vorhanden", r(c.ColumnName)) End Select End If Next r("Mutiert_am") = Now r("mutierer") = Globals.ActUser DB.Update_Data() Me.HasChanges = False End Sub Private Function Get_Adresstype(ByVal feldname, value) As Integer Try If Globals.Applicationtype = ApplicationTypes.Projektabrechnung Then If UCase(feldname) = "BEHANDLER" Then Return chklbAdresstyp.GetItemChecked(0) Else Dim i As Integer For i = 0 To Me.chklbAdresstyp.Items.Count - 1 If UCase(chklbAdresstyp.Items(i).ToString) = UCase(feldname) Then Return chklbAdresstyp.GetItemChecked(i) End If Next End If Catch Return -1 End Try End Function #End Region Public Function Create_new() End Function Private Sub evh_PatSaved(Nr As Integer) Handles evh.PatSaved If Nr = Me.PatientNr Then Me.Save_Data() End If End Sub Private Sub cbboxNrAnrede_Leave(sender As Object, e As EventArgs) Handles txtVorname.Leave, txtName.Leave, cbboxNrAnrede.Leave, cbboxNRTitel.Leave Dim alt As String = Me.txtBriefanrede.Text Dim neu As String If Me.cbboxNrAnrede.Text = "Frau" Then neu = "Sehr geehrte Frau " If Me.cbboxNRTitel.Text <> "" Then neu = neu + Me.cbboxNRTitel.Text + " " neu = neu + Me.txtName.Text Else neu = "Sehr geehrter Herr " If Me.cbboxNRTitel.Text <> "" Then neu = neu + Me.cbboxNRTitel.Text + " " neu = neu + Me.txtName.Text End If If alt <> neu Then Me.txtBriefanrede.Text = neu End Sub Private Sub txtPLZ_Leave(sender As Object, e As EventArgs) Handles txtPLZ.Leave If Me.txtOrt.Text = "" Then IntTables.Get_Ort_Kantton(Me.txtPLZ.Text, Me.txtOrt, Me.cbtxtboxKanton) End Sub Private Sub PatientDetails_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.ClsStammdaten_flat1.ToolStripButton5.Visible = False End Sub Private Sub cbboxNrAnrede_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cbboxNrAnrede.SelectedIndexChanged If Me.cbboxNrAnrede.Text = "Herr" Then Me.cbboxGeschlecht.SelectedValue = 2 Else Me.cbboxGeschlecht.SelectedValue = 1 End Sub Private Sub lblName_Click(sender As Object, e As EventArgs) Handles lblName.Click End Sub Private Sub txtName_TextChanged(sender As Object, e As EventArgs) Handles txtName.TextChanged End Sub Private Sub ClsStammdaten_flat1_Load(sender As Object, e As EventArgs) Handles ClsStammdaten_flat1.Load End Sub Private Sub NeuerAnsprechpartnerToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles NeuerAnsprechpartnerToolStripMenuItem.Click Dim f As New frmPrivatAnsprechpartner f.is_new = True f.id = 0 f.nrprivat = txtnrprivat.Text f.ShowDialog() If f.DialogResult = DialogResult.OK Then Me.ClsStammdaten_flat1.get_data() End Sub Private Sub BearbeitenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BearbeitenToolStripMenuItem.Click Try Dim f As New frmPrivatAnsprechpartner f.is_new = False f.id = Me.ClsStammdaten_flat1.c1daten.Columns(0).Value f.nrprivat = txtnrprivat.Text f.ShowDialog() Catch End Try End Sub Private Sub LöschenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles LöschenToolStripMenuItem.Click Try Me.ClsStammdaten_flat1.c1daten.Columns("Aktiv").Value = False Catch End Try End Sub End Class