Modulus11 Check

[ianward]

Hi - I am trying to get to grips with validating an NHS number using the modulus11 algorithm on a form prior to saving the record. So far i have managed to find some code and adapt to what i want to do but cannot get this to work fully - ideally i need this to work on an on_click or on_dirty event.

Please help? I am going greyer by the hour trying to implement this.

Could someone please take a look at the code and advise how i would implement this to an on_click or dirty?

Many Thanks - Ian

Public Function NHS_Number_Check (ByVal DigitType As Byte, ByVal txtNHSNumber As String) As String
Dim tmpNumber, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Asum, Bsum, Csum
tmpNumber = Trim(txtNHSNumber) 

A1 = Mid(tmpNumber, 1, 1) * 10
A2 = Mid(tmpNumber, 2, 1) * 9
A3 = Mid(tmpNumber, 3, 1) * 8
A4 = Mid(tmpNumber, 4, 1) * 7
A5 = Mid(tmpNumber, 5, 1) * 6
A6 = Mid(tmpNumber, 6, 1) * 5
A7 = Mid(tmpNumber, 7, 1) * 4
A8 = Mid(tmpNumber, 8, 1) * 3
A9 = Mid(tmpNumber, 9, 1) * 2
A10 = Mid(tmpNumber, 10, 1) * 1

Asum = A1 + A2 + A3 + A4 + A5 + A6 + A7 + A8 + A9 + A10
Bsum = Asum Mod 11 'Reminder
Csum = 11 - Bsum
If Csum = 0 Then
MsgBox ("Valid NHS Number")
Else
MsgBox ("Invalid NHS Number")
End If
End Function

 

[RuralGuy]

Try something like:

Public Function NHSCheck(ByVal NHSNumber As String) As Boolean
'
'-- This would be called in the [b]BeforeUpdate[/b] event of a TextBox with:
'-- If Not NHSCheck(Me.TextBoxName) Then
'--    MsgBox "Invalid Number, try again"
'--    Cancel = True
'-- End If

   Dim A1 As Integer, A2 As Integer, A3 As Integer, A4 As Integer, A5 As Integer
   Dim A6 As Integer, A7 As Integer, A8 As Integer, A9 As Integer, A10 As Integer
   Dim Asum As Integer, Bsum As Integer, Csum As Integer

   NHSNumber = Trim(NHSNumber)
   If Len(NHSNumber) = 10 Then

      A1 = Mid(NHSNumber, 1, 1) * 10
      A2 = Mid(NHSNumber, 2, 1) * 9
      A3 = Mid(NHSNumber, 3, 1) * 8
      A4 = Mid(NHSNumber, 4, 1) * 7
      A5 = Mid(NHSNumber, 5, 1) * 6
      A6 = Mid(NHSNumber, 6, 1) * 5
      A7 = Mid(NHSNumber, 7, 1) * 4
      A8 = Mid(NHSNumber, 8, 1) * 3
      A9 = Mid(NHSNumber, 9, 1) * 2
      A10 = Mid(NHSNumber, 10, 1) * 1

      Asum = A1 + A2 + A3 + A4 + A5 + A6 + A7 + A8 + A9 + A10
      Bsum = Asum Mod 11   'Reminder
      Csum = 11 - Bsum
      If Csum = 0 Then
         '-- Valid NHS Number
         NHSCheck = True
      Else
         '-- Invalid NHS Number
         NHSCheck = False
      End If
   Else
      '-- Invalid NHS Number
      NHSCheck = False
   End If
End Function

 

[raskew]

Allan -

Just for fun I tightened-up the code a tad.

Having done that, I'm at an loss as to how this would be used and how one would select/create a valid NHS number.

Public Function NHSCheck(ByVal NHSNumber As String) As Boolean
'
'-- This would be called in the BeforeUpdate event of a TextBox with:
'-- If Not NHSCheck(Me.TextBoxName) Then
'--    MsgBox "Invalid Number, try again"
'--    Cancel = True
'-- End If

   Dim tmpNumber As String
   Dim Asum As Integer, Csum As Integer, n As Integer

   tmpNumber = Trim(NHSNumber)
   If Len(tmpNumber) = 10 Then
      For n = 1 To 10
         Asum = Asum + Mid(tmpNumber, n, 1) * (11 - n)
      Next n
   End If
    
    Csum = 11 - (Asum Mod 11)   
   NHSCheck = (Csum = 0)
   
End Function

Can you help relieve my ignorance.

Best Wishes - Bob

 

[RuralGuy]

Hi Bob,
Nice coding (as usual)! I tend to use incoming variables as long as they are not needed for something else. It eliminates creating the tmpNumber string variable. Is that not a good practice? It has never gotten me in trouble yet and that is quite a few years. As for creating an NHS number, the OP was just trying to validate an NHS number that was entered into a control. NHS numbers are assigned by the government I assume.

 

[raskew]

Allan -

Thanks! Hopefully I'll never run into an NHS number.

Re the coding: I just saw a way to get rid of the A1 - A10 lines (personal quirk--when I see multiple lines like that the first thought is '...there's got to be a shorter way')

Best Wishes - Bob

 

[RuralGuy]

Glad to help Bob. I think it is a UK thing. I was too lazy to do the coding neatly. It is one of the many reasons I enjoy reading your posts. I have a little computer book of your code for reference.

Best wishes right back at you.

 

[doco]

Hey RuralGuy - maybe its the 7,000' difference in elevation from the Rockies to the Ozarks?

 

[DCrake]

Simple Software Solutions

Hi all thread men, I have just run the NHSCheck function on almost 20,000 known nhs numbers and each one came back false.

if you change the following to

Csum = (Asum Mod 11) [COLOR="SeaGreen"]'11 - (Asum Mod 11)[/COLOR]   
NHSCheck = IIf(Csum <> 0, False, True) [COLOR="seagreen"]'(Csum = 0)

[/COLOR]
Then the function returns the correct response.

CodeMaster:

 

[Dennisk]

there is a bit missed off as you need to check for all 1s, 2s etc. Here is the function I use

Public Function ValidateNHSNumber(NHSNumber As Variant) As Boolean
    '
    ' Modulus 11  Check Digit Algorithm
    ' Validates NHS Number
    ' Dennis Keeling 2002
    '
    Dim fValid As Boolean, intResult As Integer, intCheckDigit As Integer
On Error GoTo Err_Handler
    
    fValid = True

    If Not IsNull(NHSNumber) Then
        Select Case NHSNumber
            Case "1111111111", "2222222222", "3333333333", "4444444444", "5555555555", "6666666666", "7777777777", "8888888888", "9999999999", "0000000000"
                fValid = False
            Case Else
            
                intResult = 0
                'Perform Check Digit Calculation
                intResult = Left(NHSNumber, 1) * 10
                intResult = intResult + Mid(NHSNumber, 2, 1) * 9
                intResult = intResult + Mid(NHSNumber, 3, 1) * 8
                intResult = intResult + Mid(NHSNumber, 4, 1) * 7
                intResult = intResult + Mid(NHSNumber, 5, 1) * 6
                intResult = intResult + Mid(NHSNumber, 6, 1) * 5
                intResult = intResult + Mid(NHSNumber, 7, 1) * 4
                intResult = intResult + Mid(NHSNumber, 8, 1) * 3
                intResult = intResult + Mid(NHSNumber, 9, 1) * 2
                intCheckDigit = Right(NHSNumber, 1)
                intResult = intResult Mod 11
                intResult = 11 - intResult
                
                If intResult = 11 Then
                    intResult = 0
                End If
                
                If intResult = 10 Or (intResult <> intCheckDigit) Then
                    fValid = False
                End If
            End Select
            
            ValidateNHSNumber = fValid
            
    End If
    
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox Err & " " & Err.Description
    Resume Exit_Handler:
End Function

 

[ianward]

Many thanks to all who have responded to this thread, i cant begin to tell you how appreciative i am - was almost at the end of line with this.

RG - yes NHS Numbers are created by the Department of Health as far as i am aware. & as suggested i just need to run a validity check when users enter these unique numbers to avoid any typo's.

Thanks again to all helped out with this.

Regards

Ian

 

[RuralGuy]

Thanks for the update Ian.

 

[ianward]

Hi Guys,

After thinking the hard work was finally over and being given the solution, I thought i had struck gold, unfortunatley i am still unable to resolve this and am asking for your help once again.

I have attached a sample form with a valid NHS Number on the form as data to check, I would like to be able to check on an event such as on_click or after_update where if the number is invalid then i get a pop-up warning me - in the attached sample I have tried to call a pop-up on the on_click event of the Validate button to say either Valid or Invalid NHS Number, but cannot get this to work.

could one of you kind gents - or ladies possibly take a look and point me in the right direction?

Many Thanks

Ian

 

[doco]

Why not just use:
MsgBox "Valid or Invalid", vbInformation + vbOkOnly, "NHS NUMBER"

You need to remove the parens in your message boxes - you are not returning a response so you do not need them.

 

[ianward]

Hi doco,

I am trying to evaluate whether the number entered is a valid NHS number using the Modulus11 algorithm, so if the number entered into the field has been incorrectly entered (eg typo) a warning is triggered that prompts the user the number is invalid.

I can get the message box to pop up and say what i want without any criteria but cannot understand how to link the result of the validateNHSNumber function to the msgbox.

Ian

 

[Dennisk]

Ian,

This is how I do it.

Private Sub NHSNumber_BeforeUpdate(Cancel As Integer)
    ' Validate
    ' Check for Duplicates 1) New Record  2) Existing Record
    If Not IsNull(Me!NHSNumber) Then
        If Not ValidateNHSNumber(Me!NHSNumber) Then
            MsgBox "Invalid NHS Number ", vbCritical
            Cancel = True
        Else
            If Me.NewRecord Then
                If DCount("[Patient ID]", "tblpatientDirectory", "[NHSNumber]='" & Me!NHSNumber & "'") > 0 Then
                    MsgBox "This NHS Number has already been allocated", vbCritical
                    Cancel = True
                End If
            Else
                If DCount("[Patient ID]", "tblPatientDirectory", "[NHSNumber]='" & Me!NHSNumber & "' AND [Patient ID] <>" & Me![Patient ID]) > 0 Then
                    MsgBox "This NHS Number has already been allocated", vbCritical
                    Cancel = True
                End If
            End If
        End If
    End If
End Sub

 

[doco]

You have in your code

Private Sub btnValidate_Click()

    If ValidateNHSNumber = False Then
        MsgBox ("Invalid NHS Number")
    Else
        MsgBox ("Valid NHS Number")
    End If
    
End Sub

Shouldn't it be like

Private Sub btnValidate_Click()

    If ValidateNHSNumber( NHS_NUMBER ) = False Then
        MsgBox  NHS_NUMBER & " Is An Invalid NHS Number"
    Else
        MsgBox NHS_NUMBER & "Valid NHS Number"
    End If
    
End Sub

Seeing your boolean function requires an arg list?

 

[ianward]

Thanks Dennis,

I will have a go at putting this into action after lunch.

Thanks again

Ian

 

[ianward]

Thanks Dennis & Doco,

I did not understand fully how the function worked and how to tell the function what field to use as below

ValidateNHSNumber(Me!NHSNumber)

After seeing your posts the obvious hit me and i understand what to do, I have just tried this on my database and it works perfectly, once again thank you!

Kind Regards

Ian