adding new records to linked tables (1 Viewer)

MilaK · Jul 7, 2016

Hello,

I have two linked Tables 'tblPatients' and 'tblDSA' and two continues forms 'frmPatients' and 'frmDSA'. When I create a new patient via 'frmPatient', I would like to add a new record for that patient in 'frmDSA' without closing the form. The record source for the frmDSA is a query that includes fields from both tables.

On 'frmPatients' next to each record there is a button 'Enter_DSA_Record' that should do all of the following:

(1) saves a new record to 'tblPatients' if a new Patient has been entered. (2) opens 'frmDSA' to display related records for that Patients.

Here is what happens:

Please suggest how to fix the If statement that checks if this record already exists in 'tblPatients'.

Code:

If CurrentDb.OpenRecordset("Select count(*) from tblPatients where LABCODE=" & Forms!frmPatients!LABCODE & ";").Fields(0) < 0 Then

'If this patient is new'

Do I need to use DAO.Recordset and DAO.Recordset2 to add records to two tables in one sub routine?

Thanks,

Here is the code:

Code:

Private Sub Enter_DSA_Record_Click()

Dim db As DAO.Database

Dim PatientTable As DAO.Recordset
Dim DSAtable As DAO.Recordset2

Dim errMsg As String

Dim errData As Boolean

Dim i As Integer
Dim x As Integer

Dim errorArray(0 To 1) As String 'Array to hold the error messages so we can 'use them if needed.

'need to check if a record for Patient already exists before creating a new patient
If CurrentDb.OpenRecordset("Select count(*) from tblPatients where LABCODE=" & Forms!frmPatients!LABCODE & ";").Fields(0) < 0 Then

    MsgBox ("This Patient is new")

            If Me.LABCODE.Value = "" Then
                        errorArray(0) = "Must Enter Labcode."
                        errData = True
            End If
            If Me.LastName.Value = 0 Then
                        errorArray(1) = "Must Enter Patient Number"
                        errData = True
            End If


'MsgBox "errData = " & errData
            If errData = True Then
              i = 0
              x = 0
                For i = 0 To 1
                    If errorArray(i) <> "" Then
                        If x > 0 Then
                        errMsg = errMsg & vbNewLine & errorArray(i)
                        Else
                        errMsg = errorArray(i)
                        x = x + 1
                        End If
                    End If
                Next i

                MsgBox errMsg & vbNewLine & "Please try again."
                errMsg = ""
                Me.LABCODE.SetFocus
                Exit Sub
            End If

                Set db = CurrentDb()
                Set PatientTable = db.OpenRecordset("tblPatients")

                    With PatientTable
                        .AddNew
                        !LABCODE = Me.LABCODE.Value
                        !LastName = Me.LastName.Value
                        !FirstName = Me.FirstName.Value
                        !MRN = Me.MRN.Value
                        !MRNTwo = Me.MRN2.Value
                        Debug.Print Me.MRN.Value
                        '!CPI#2 = Me.MRN2.Value
                        !Kidney = Me.cbKidney.Value
                        !Heart = Me.cbHeart.Value
                        !Lung = Me.cbLung.Value
                        !Liver = Me.cbLiver.Value
                        !Pancreas = Me.cbPancreas.Value

                        !DateLogged = Format(Date, "MM/DD/YY")
                        .Update
                    End With
                'End If
                  Set DSAtable = db.OpenRecordset("tblDSA")
                        With DSAtable
                            .AddNew
                            !LABCODE = Me.LABCODE.Value
                            .Update
                        End With
'Let the user know it worked.
                MsgBox "This patient has been added successfully.", vbOKOnly
                DoCmd.OpenForm "DSAfrm", _
                        WhereCondition:="LABCODE=" & Me.LABCODE
Else
 'if record exists show correspondin records in 'tblDSA'
                DoCmd.OpenForm "DSAfrm", _
                    WhereCondition:="LABCODE=" & Me.LABCODE
End If


End sub

pbaldy · Jul 7, 2016

Well, one answer to "Please suggest how to fix the If statement that checks if this record already exists in 'tblPatients'" is to use a DCount():

If DCount(...) = 0 Then

http://www.mvps.org/access/general/gen0018.htm

By the way, " < 0 " ?? How could the count ever be less than zero?

MilaK · Jul 7, 2016

pbaldy said:
Well, one answer to "Please suggest how to fix the If statement that checks if this record already exists in 'tblPatients'" is to use a DCount():

If DCount(...) = 0 Then

http://www.mvps.org/access/general/gen0018.htm

By the way, " < 0 " ?? How could the count ever be less than zero?

Thanks,! "= 0" lets me enter values into tblDSA, however, when I save and close 'DSAfrm' and go back to 'frmPatients" to search/enter new records I see an error message: Error 3022 Duplicate Values in Index, Primary Key or relationship.

I don't understand why this is happening? Please help!

MilaK · Jul 7, 2016

I'm posting the updated code in case someone here knows how to fix the error and give some insight to what is causing it.

Code:

 Private Sub Enter_New_DSA()
  
 Dim db As DAO.Database
 Dim PatientTable As DAO.Recordset
 Dim DSAtable As DAO.Recordset
 Dim errMsg As String
 Dim errData As Boolean
 Dim i As Integer
 Dim x As Integer
  
 Dim errorArray(0 To 1) As String 'Array to hold the error messages so we can 'use them if needed.
 
 'need to check if a record for Patient already exists before creating a new patient
'If CurrentDb.OpenRecordset("Select count(*) from tblPatients where LABCODE=" & Forms!frmPatients!LABCODE & ";").Fields(0) < 0 Then

If DCount("[LABCODE]", "tblPatients", "[LABCODE] = " & Me![LABCODE] & "  ") = 0 Then
   
    MsgBox ("This Patient is new")
             If Me.LABCODE.Value = "" Then
                        errorArray(0) = "Must Enter Labcode."
                        errData = True
            End If
            If Me.LastName.Value = 0 Then
                        errorArray(1) = "Must Enter Patient Number"
                        errData = True
            End If
            
 'MsgBox "errData = " & errData
            If errData = True Then
              i = 0
              x = 0
                For i = 0 To 1
                    If errorArray(i) <> "" Then
                        If x > 0 Then
                        errMsg = errMsg & vbNewLine & errorArray(i)
                        Else
                        errMsg = errorArray(i)
                        x = x + 1
                        End If
                    End If
                Next i
                    
                MsgBox errMsg & vbNewLine & "Please try again."
                errMsg = ""
                Me.LABCODE.SetFocus
                Exit Sub
            End If
                 Set db = CurrentDb()
                Set PatientTable = db.OpenRecordset("tblPatients")
                Set DSAtable = db.OpenRecordset("tblDSA")
                
                    With PatientTable
                        .AddNew
                        !LABCODE = Me.LABCODE.Value
                        !LastName = Me.LastName.Value
                        !FirstName = Me.FirstName.Value
                        !MRN = Me.MRN.Value
                        !MRNTwo = Me.MRN2.Value
                        Debug.Print Me.MRN.Value
                        '!CPI#2 = Me.MRN2.Value
                        !Kidney = Me.cbKidney.Value
                        !Heart = Me.cbHeart.Value
                        !Lung = Me.cbLung.Value
                        !Liver = Me.cbLiver.Value
                        !Pancreas = Me.cbPancreas.Value
                        
                        !DateLogged = Format(Date, "MM/DD/YY")
                        .Update
                    End With
                'End If
                  
                        With DSAtable
                            .AddNew
                            !LABCODE = Me.LABCODE.Value
                            .Update
                        End With
                        
                        PatientTable.Close
                        DSAtable.Close
                        Set PatientTable = Nothing
                        Set DSAtable = Nothing
                        Set db = Nothing
 
'Let the user know it worked.
                MsgBox "This patient has been added successfully.", vbOKOnly
                DoCmd.OpenForm "DSAfrm", _
                        WhereCondition:="LABCODE=" & Me.LABCODE
Else
 'if record exists show correspondin records in 'tblDSA'
                DoCmd.OpenForm "DSAfrm", _
                    WhereCondition:="LABCODE=" & Me.LABCODE
End If
 
End Sub

pbaldy · Jul 7, 2016

I don't know. It sounds like it's a problem in the first form. Do you get the error if you don't add the new record? Does the record in the first form need to be saved before doing the test? Can you attach the db here?

pbaldy · Jul 7, 2016

Oh, and is the first form bound?

MilaK · Jul 7, 2016

pbaldy said:
I don't know. It sounds like it's a problem in the first form. Do you get the error if you don't add the new record? Does the record in the first form need to be saved before doing the test? Can you attach the db here?

If I create a new patient and don't click on "Enter_DSA_Record" it works fine without errors. When I create a new patient and run "Enter_DSA_Record" I get an error when I do anything to the "tblPatient" form.

"Labcode" is a primary key in 'tblPatient', is that the problem? But why?

It should save the new Patient record automatically, no?

I will need to delete almost all records (patient information) to attach the db on this forum. Is someone willing to take a look? Thanks

pbaldy · Jul 7, 2016

If the patient form is bound to the patient table, you don't want to run the code that adds that record. The bound form is already creating the record.

MilaK · Jul 7, 2016

pbaldy said:
If the patient form is bound to the patient table, you don't want to run the code that adds that record. The bound form is already creating the record.

Ok, so I only have to created a new record for 'DSAfrm' so it can link the two tables and it will automatically save the new patient?

It's still not clear please take a look at the attached...

I really appreciate your help.

Thanks

pbaldy · Jul 8, 2016

As suspected, frmPatients is bound to tblPatients, so any data entered/edited/deleted via that form will be reflected in the table. You don't need or want the code that adds a record to that table behind your button. The cause of your duplicate error is adding the same data twice.

MilaK · Jul 8, 2016

pbaldy said:
As suspected, frmPatients is bound to tblPatients, so any data entered/edited/deleted via that form will be reflected in the table. You don't need or want the code that adds a record to that table behind your button. The cause of your duplicate error is adding the same data twice.

Thank you, I've tried removing all of the code that creates the new patient from the button, (see below) however, Access is unable to join this new record.
Nothing I've tried seem to work. Could you please suggest how to edit my code or what to do to make this work. I'm open to anything. This has been really frustrating and discouraging.

Code:

 With PatientTable
                        .AddNew
                        !LABCODE = Me.LABCODE.Value
                        !LastName = Me.LastName.Value
                        !FirstName = Me.FirstName.Value
                        !MRN = Me.MRN.Value
                        !MRNTwo = Me.MRN2.Value
                        Debug.Print Me.MRN.Value
                        '!CPI#2 = Me.MRN2.Value
                        !Kidney = Me.cbKidney.Value
                        !Heart = Me.cbHeart.Value
                        !Lung = Me.cbLung.Value
                        !Liver = Me.cbLiver.Value
                        !Pancreas = Me.cbPancreas.Value
                        
                        !DateLogged = Format(Date, "MM/DD/YY")
                        .Update
                    End With

pbaldy · Jul 8, 2016

I'm not sure what you mean by "unable to join this new record".

MilaK · Jul 8, 2016

pbaldy said:
I'm not sure what you mean by "unable to join this new record".

It' saves the records if the patient is new but when I close 'frmDSA' and go back to 'frmPatients' I get an error message '3022' can't add duplicate values because of key constrains.

adding new records to linked tables (1 Viewer)

MilaK

Registered User.

pbaldy

Wino Moderator

MilaK

Registered User.

MilaK

Registered User.

pbaldy

Wino Moderator

pbaldy

Wino Moderator

MilaK

Registered User.

pbaldy

Wino Moderator

MilaK

Registered User.

Attachments

pbaldy

Wino Moderator

MilaK

Registered User.

pbaldy

Wino Moderator

MilaK

Registered User.

Similar threads

Users who are viewing this thread