Form Sql May Be Causing Corruption

B

Bob

Record corruption

Access Ver: XP
Windows Ver: XP
LAN Envoronment
Count of users in database an hour ago: 17.

This week we had a second record corrupted in a child table within our
XP application.
During the past 30 days, 3350 records are transfered into the database
from Excel flat files.
There are no errors in the source flat files. The parent table's
records are not corrupted.



Two corrupted records (there are only two at this point in time):



ICN System Case ID fk Line Number Allowed Amount Billed Amount
clm_dtl_count Claim Type Code Clinical Recommendation Notes Date Last
Service Paid Date Date Received Date of Service Diagnosis Principal
Code Explanation of Benefits 1 Code FYI Indicator Line Message Code
Live Claim Indicator Prevailing Allow Amount Prevailing Fee Amount
Pricing Region Code Procedure Claim Code Procedure Modifier Code 1
Procedure Modifier Code 2 Procedure Modifier Code 3 Procedure Modifier
Code 4 Provider Claim ID Provider Claim Name Provider Specialty Code
Claim Provider Type Code Units of Service
1969250 3170 $5,072,699,973,992.45 $12,884,901,888,000.00 0 㘴〰 1
12/30/1899 12/30/1899 12/30/1899 12/30/1899 2A 0000 〰 〰N ã
$108,863.53 $5,072,699,973,959.68 㘱 ~~ 㠹㜲 LT ~ ~~婚㥚 ㌳娲~Missi ng 2 0

ICN System Case ID fk Line Number Allowed Amount Billed Amount
clm_dtl_count Claim Type Code Clinical Recommendation Notes Date Last
Service Paid Date Date Received Date of Service Diagnosis Principal
Code Explanation of Benefits 1 Code FYI Indicator Line Message Code
Live Claim Indicator Prevailing Allow Amount Prevailing Fee Amount
Pricing Region Code Procedure Claim Code Procedure Modifier Code 1
Procedure Modifier Code 2 Procedure Modifier Code 3 Procedure Modifier
Code 4 Provider Claim ID Provider Claim Name Provider Specialty Code
Claim Provider Type Code Units of Service
蠀犱 9089 1 $999,346,170,428.65 $167,772,160,000.03 0 〸㔳 as per
previous 12/30/1899 12/30/1899 12/30/1899 01/01/1900 ㌲〴〸 U084 㛾 ㄱXヾ 〰
($691,752,902,763,682.94) $425.25 丰 ＀僾〰 ~~  ㉓ 㘰 ä°¸å€ç¸€ç¸€ç¸€ 〰ã¡ã„²ã€°äœ±åˆ€ä¤€ä˜€ä˜€ä¤€
一              0

The ICN value in the second value above (蠀犱) looks like asian
characters when viewed in the database or pasted into Word.

The dollar figures we deal with never are the size you see above -
more like $500.00 +-.

Currently, the foriegn key (System_Case_ID_fk) values in the parent
table range from 1 to 9907.
Referential integrity is set and enforced with all tables and forms.
Back end tables are access via form only.


I was asked several weeks ago to add a utility that will duplicate
reasons and codes in child records. A button was added on the
associated child form that does this.
The code opens a dialog form, which accepts user imputs. The code to
open the dialog box:
Private Sub btnDupeClinRec_Click()
Dim lngCaseId As Long
Dim strFrmName As String

If IsNull(Me.sys_case_id_fk) Then
MsgBox "No child records are present", vbInformation
Exit Sub
End If
lngCaseId = Me.sys_case_id_fk

strFrmName = "dlgDupeClinRecommendation"
DoCmd.OpenForm strFrmName, , , , , , lngCaseId

End Sub


NOTE: The utility appears to be causing the corruption of the child
records, but
we are unable to reporduce the error. This corruption has only
happened twice.


The dialog box offers several dupe/update options and uses a simple
sql statement to update. The code to update:


Private Sub btnReplace_Click()
'-------------------------------------------------------------
' Procedure : btnReplace_Click
' Purpose : Modifies field(s) in d_clm_general depending on
' option selected by user.
' Author : Bob
' Phone:
' E-Mail:
' DateTime : 2/21/2008 11:28
' Fields Modified : clin_recommendation and optionally eob_cd_1.
' Tables: d_clm_general
'-------------------------------------------------------------
' Revision History
'-------------------------------------------------------------
'
'=============================================================
Dim bytSelection As Byte
Dim dbe As DAO.DBEngine
Dim db As DAO.Database
Dim sql As String
Dim strRevisedClnRec As String
Dim lngCaseId As Long
Dim frm As Form_sfrmClaimGen
Dim strEob As String

On Error GoTo btnReplace_Click_Error
If MsgBox("Are you sure you want to do this?", vbYesNo, "Clinical
Recommendation") = vbNo Then
Exit Sub
End If

Set frm = Form_sfrmClaimGen

Set dbe = CreateObject("DAO.DBEngine.36")
Set db = CurrentDb()
bytSelection = Me.fraReplaceOptions

' **** Error checking before execution ******
If Len(Me.txtCaseId) < 1 Or IsNull(Me.txtCaseId) Then
MsgBox "Dialog box used out of context.", vbInformation
Exit Sub
End If

Select Case bytSelection
Case Is = 1
If Len(Me.txtDupeThis) < 2 Or IsNull(Me.txtDupeThis) Then
MsgBox "You must enter replacement text.", vbCritical
Exit Sub
ElseIf Len(Me.txtDupeThis) > 40 Then
MsgBox "Your text is " & Len(Me.txtDupeThis) & "
characters in length. The field cannot accept >40 characters. Try
again.", vbInformation
Exit Sub
ElseIf Len(Me.cboEob) < 2 Or IsNull(Me.cboEob) Then
MsgBox "You must select an EOB value.", vbCritical
End If
Case Is = 2
If Len(Me.txtDupeThis) < 2 Or IsNull(Me.txtDupeThis) Then
MsgBox "You must enter replacement text.", vbCritical
Exit Sub
ElseIf Len(Me.txtDupeThis) > 40 Then
MsgBox "Your text is " & Len(Me.txtDupeThis) & "
characters in length. The field cannot accept >40 characters. Try
again.", vbInformation
Exit Sub
ElseIf Len(Me.cboEob) < 2 Or IsNull(Me.cboEob) Then
MsgBox "You must select an EOB value.", vbCritical
End If
Case Is = 3, 6
' No check necessary
Case Is = 4, 5
If Len(Me.txtDupeThis) < 2 Or IsNull(Me.txtDupeThis) Then
MsgBox "You must enter replacement text.", vbCritical
Exit Sub
ElseIf Len(Me.txtDupeThis) > 40 Then
MsgBox "Your text is " & Len(Me.txtDupeThis) & "
characters in length. The field cannot accept >40 characters. Try
again.", vbInformation
Exit Sub
End If
End Select
' ***** End of error checks ****


' ***** prep for and execute sql statements ******
lngCaseId = Me.txtCaseId
strRevisedClnRec = DQ & Me.txtDupeThis & DQ
strEob = DQ & Me.cboEob & DQ

' Update clin_recommendation/EOB and requery the respective
controls
' if records were changed.
Select Case bytSelection
Case Is = 1 ' Replace all clin_recommendation value & EOB
with text
sql = "UPDATE d_clm_general SET clin_recommendation = " &
strRevisedClnRec & ", " _
& "eob_cd_1 = " & strEob & " " _
& "WHERE sys_case_id_fk=" & lngCaseId & ";"
db.Execute sql
If db.RecordsAffected > 0 Then
frm.clin_recommendation.Requery
frm.eob_cd_1.Requery
End If
Case Is = 2 ' Replace only null clin_recommendation & EOBs
with text
sql = "UPDATE d_clm_general SET clin_recommendation = " &
strRevisedClnRec & ", " _
& "eob_cd_1 = " & strEob & " " _
& "WHERE (((clin_recommendation) Is Null) AND
((sys_case_id_fk)=" & lngCaseId & ")) " _
& "OR (((clin_recommendation)='~Missing') AND
((sys_case_id_fk)=" & lngCaseId & "));"
db.Execute sql
If db.RecordsAffected > 0 Then
frm.clin_recommendation.Requery
frm.eob_cd_1.Requery
End If
Case Is = 3 ' Reset all clin_recommendation and EOBs to null
sql = "UPDATE d_clm_general SET clin_recommendation =
'~Missing', " _
& "eob_cd_1 ='~' " _
& "WHERE sys_case_id_fk=" & lngCaseId & ";"
db.Execute sql
If db.RecordsAffected > 0 Then
frm.clin_recommendation.Requery
frm.eob_cd_1.Requery
End If
Case Is = 4 ' Replace all clin_recommendation values
sql = "UPDATE d_clm_general SET clin_recommendation = " &
strRevisedClnRec & " " _
& "WHERE sys_case_id_fk=" & lngCaseId & ";"
db.Execute sql
If db.RecordsAffected > 0 Then
frm.clin_recommendation.Requery
End If
Case Is = 5 ' Replace only null clin_recommendation
sql = "UPDATE d_clm_general SET clin_recommendation = " &
strRevisedClnRec & " " _
& "WHERE (((clin_recommendation) Is Null) AND
((sys_case_id_fk)=" & lngCaseId & ")) " _
& "OR (((clin_recommendation)='~Missing') AND
((sys_case_id_fk)=" & lngCaseId & "));"
db.Execute sql
If db.RecordsAffected > 0 Then
frm.clin_recommendation.Requery
End If
Case Is = 6 ' Reset all clin_recommendation to null
sql = "UPDATE d_clm_general SET clin_recommendation =
'~Missing' " _
& "WHERE sys_case_id_fk=" & lngCaseId & ";"
db.Execute sql
If db.RecordsAffected > 0 Then
frm.clin_recommendation.Requery
End If
End Select

DoCmd.Close acForm, "dlgDupeClinRecommendation"

ExitHere:
Set dbe = Nothing
Set db = Nothing
Exit Sub

btnReplace_Click_Error:

Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ")
" _
& vbCrLf & "in procedure btnReplace_Click of VBA Document
Form_dlgDupeClinRecommendation"
End Select
Resume ExitHere
End Sub

Thank you for looking at this strange problem.

Bob
 
T

Tony Toews [MVP]

Bob said:
Record corruption

For more information on corruption including possible causes,
determining the offending PC, retrieving your data, links, official MS
KB articles and a list of vendors who state they can fix corruption
see the Microsoft Access Corruption FAQ at
http://www.granite.ab.ca/access/corruptmdbs.htm

Tony
--
Tony Toews, Microsoft Access MVP
Please respond only in the newsgroups so that others can
read the entire thread of messages.
Microsoft Access Links, Hints, Tips & Accounting Systems at
http://www.granite.ab.ca/accsmstr.htm
Tony's Microsoft Access Blog - http://msmvps.com/blogs/access/
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top