Option Compare Database   'Use database order for string comparisons

'****************************************************************************
'Function:  Perform check digit validation on Ace order numbers
'
'Parameters:  Ace hardware number
'
'Returns:  True if validation passes, False if validation fails
'****************************************************************************
Function CheckAce (number)
On Error GoTo err_checkace
Select Case Len(number)
    Case 7
        chk1 = Val(Mid$(number, 1, 1)) + Val(Mid$(number, 3, 1)) + Val(Mid$(number, 5, 1))
        chk2 = Val(Mid$(number, 2, 1)) * 2
        chk3 = Val(Mid$(number, 4, 1)) * 2
        chk4 = Val(Mid$(number, 6, 1)) * 2
        chk = chk1 + ((chk2 Mod 10) - (chk2 > 9)) + ((chk3 Mod 10) - (chk3 > 9)) + ((chk4 Mod 10) - (chk4 > 9))
        chk = (100 - chk) Mod 10
        If chk = Val(Mid$(number, 7, 1)) Then CheckAce = True Else CheckAce = False
    Case 5
        CheckAce = True
    End Select
If Len(number) <> 5 And Len(number) <> 7 Then CheckAce = False
Exit Function
err_checkace:
MsgBox "Error: " & Error$ & " in function CheckAce"
Resume Next

End Function

'****************************************************************************
'Function:  Performs check digit validation on True Value order numbers
'
'Parameters:  Cotter order number
'
'Returns:  True if validation passes, False if validation fails
'****************************************************************************
'
Function CheckCotter (number)
On Error GoTo err_checkcotter

If Len(number) = 6 Then
    chk1 = Val(Mid$(number, 2, 1)) + Val(Mid$(number, 4, 1))
    chk2 = Val(Mid$(number, 1, 1)) * 2
    chk3 = Val(Mid$(number, 3, 1)) * 2
    chk4 = Val(Mid$(number, 5, 1)) * 2
    chk = chk1 + ((chk2 Mod 10) - (chk2 > 9)) + ((chk3 Mod 10) - (chk3 > 9)) + ((chk4 Mod 10) - (chk4 > 9))
    chk = (100 - chk) Mod 10
    If chk = Val(Mid$(number, 6, 1)) Then
        CheckCotter = True
    Else
        Select Case (chk)
            Case Is < 5
                extchk = chk + 3
            Case Is > 4
                extchk = chk - 3
        End Select
        CheckCotter = (extchk = Val(Mid$(number, 6, 1)))
    End If
Else
    CheckCotter = False
End If
Exit Function
err_checkcotter:
MsgBox "Error " & Error$ & " in function CheckCotter"
Resume Next

End Function

'****************************************************************************
'Function:  Calculate check digit for UPC-A or EAN-13 codes
'
'Parameters:  11 Digit UPC-A or 12 digit EAN-13 code as string
'
'Returns:  Single digit Check Digit as string
'****************************************************************************
'
Function CheckDigit (number) As String
On Error GoTo err_checkdigit
Select Case Len(number)
Case 11
    chk1 = 0: chk2 = 0
    For x = 2 To 10 Step 2
        chk1 = chk1 + Val(Mid$(number, x, 1))
    Next x
    For x = 1 To 11 Step 2
        chk2 = chk2 + Val(Mid$(number, x, 1))
    Next x
    CheckDigit$ = Chr$(((210 - (chk2 * 3 + chk1)) Mod 10) + 48)
Case 12
    chk1 = 0: chk2 = 0
    For x = 1 To 11 Step 2
        chk1 = chk1 + Val(Mid$(number, x, 1))
    Next x
    For x = 2 To 12 Step 2
        chk2 = chk2 + Val(Mid$(number, x, 1))
    Next x
    CheckDigit$ = Chr$(((220 - (chk2 * 3 + chk1)) Mod 10) + 48)
Case Else
    CheckDigit$ = "x"
End Select
Exit Function
err_checkdigit:
MsgBox "Error " & Error$ & " in function CheckDigit"
Resume Next

End Function

'****************************************************************************
'Function:  Performs check digit validation on HWI order numbers
'
'Parameters:  HWI order number
'
'Returns:  True if validation passes, False if validation fails
'****************************************************************************
'
Function CheckHWI (number)
On Error GoTo err_checkhwi

If Len(number) = 6 Then
    chk1 = Val(Mid$(number, 1, 1)) * 6
    chk2 = Val(Mid$(number, 2, 1)) * 5
    chk3 = Val(Mid$(number, 3, 1)) * 4
    chk4 = Val(Mid$(number, 4, 1)) * 3
    chk5 = Val(Mid$(number, 5, 1)) * 2
    chk = chk1 + chk2 + chk3 + chk4 + chk5
    chk = 11 - (chk Mod 11)
    Select Case (chk)
        Case 10
            check = False
        Case 11
            If Val(Mid$(number, 6, 1)) = 0 Then check = True Else check = False
        Case 0 To 9
            If Val(Mid$(number, 6, 1)) = chk Then check = True Else check = False
    End Select
    If check = False Then
        chk1 = Val(Mid$(number, 2, 1)) * 2
        chk2 = Val(Mid$(number, 4, 1)) * 2
        chk3 = Val(Mid$(number, 3, 1)) + Val(Mid$(number, 1, 1)) + Val(Mid$(number, 5, 1))
        chk = chk3 + ((chk1 Mod 10) - (chk1 > 9)) + ((chk2 Mod 10) - (chk2 > 9))
        chk = (100 - chk) Mod 10
        If Val(Mid$(number, 6, 1)) = chk Then check = True Else check = False
    End If
End If
If check <> True Then CheckHWI = False Else CheckHWI = check
Exit Function

err_checkhwi:
MsgBox "Error " & Error$ & " in function CheckHWI"
Resume Next

End Function

'****************************************************************************
'Function:  Perform check digit validation of Paint Sundries order numbers
'
'Parameters:  Paint Sundries Supply order number as string
'
'Returns:  True if validation passes, False if validation fails
'****************************************************************************
'
Function CheckPS (number)
On Error GoTo err_checkps

If Len(number) = 6 Then
    chk1 = Val(Mid$(number, 2, 1)) + Val(Mid$(number, 4, 1))
    chk2 = Val(Mid$(number, 1, 1)) * 2
    chk3 = Val(Mid$(number, 3, 1)) * 2
    chk4 = Val(Mid$(number, 5, 1)) * 2
    chk = chk1 + ((chk2 Mod 10) - (chk2 > 9)) + ((chk3 Mod 10) - (chk3 > 9)) + ((chk4 Mod 10) - (chk4 > 9))
    chk = (100 - chk) Mod 10
    If chk = Val(Mid$(number, 6, 1)) Then CheckPS = True
Else
    CheckPS = False
End If
Exit Function
err_checkps:
MsgBox "Error " & Error$ & " in function CheckPS"
Resume Next

End Function

'****************************************************************************
'Function:  Performs check digit validation on UPC-A codes
'
'Parameters:  UPC-A code as string
'
'Returns:  True if validation passes, False if validation fails
'***************************************************************************'
Function CheckUPC (number)
On Error GoTo err_checkUPC
Dim x As Integer, check As Integer, chk1 As Integer, chk2 As Integer
Select Case Len(number)
Case 12
    chk1 = 0: chk2 = 0
    For x = 2 To 10 Step 2
        chk1 = chk1 + Val(Mid$(number, x, 1))
    Next x
    For x = 1 To 11 Step 2
        chk2 = chk2 + Val(Mid$(number, x, 1))
    Next x
    check = (210 - (chk2 * 3 + chk1)) Mod 10
    CheckUPC = (check = Val(Mid$(number, 12, 1)))
Case 13
    chk1 = 0: chk2 = 0
    For x = 1 To 11 Step 2
        chk1 = chk1 + Val(Mid$(number, x, 1))
    Next x
    For x = 2 To 12 Step 2
        chk2 = chk2 + Val(Mid$(number, x, 1))
    Next x
    check = (220 - (chk2 * 3 + chk1)) Mod 10
    CheckUPC = (check = Val(Mid$(number, 13, 1)))
Case Else
    CheckUPC = False
End Select
Exit Function
err_checkUPC:
MsgBox "Error " & Error$ & " in function CheckUPC"
Resume Next

End Function

'****************************************************************************
'Function:  Expands incomplete UPC codes to 12 digit UPC-A
'
'Parameters:  UPC code
'
'Returns:   12 digit UPC code if given 7 or 8 digit UPC-E
'           12 digit UPC code if given 11 digit UPC-A
'           passed value if given 12 or 13 digit UPC
'           "x" if passed value is un-expandable
'****************************************************************************
Function ExpandUPC (code) As String
On Error GoTo err_expandupc
Select Case Len(code)
    Case 7, 8
        Select Case Mid$(code, 7, 1)
        Case "0", "1", "2"
            retval = "0" + Mid$(code, 2, 2) + Mid$(code, 7, 1) + "0000" + Mid$(code, 4, 3)
        Case "3"
            retval = "0" + Mid$(code, 2, 3) + "00000" + Mid$(code, 5, 2)
        Case "4"
            retval = "0" + Mid$(code, 2, 4) + "00000" + Mid$(code, 6, 1)
        Case "5", "6", "7", "8", "9"
            retval = "0" + Mid$(code, 2, 5) + "0000" + Mid$(code, 7, 1)
        End Select
        ExpandUPC = retval & CheckDigit(retval)
    Case 11
        ExpandUPC = code & CheckDigit(code)
    Case 12, 13, 6
        ExpandUPC = code
    Case Else
        ExpandUPC = "x"
End Select
Exit Function
err_expandupc:
MsgBox "Error " & Error$ & " in function ExpandUPC"
Resume Next
End Function

