Updated 2008-07-11 18:03:55 by jmn

BPay is a broadly used Australian bill payment system. http://www.bpay.com.au

The system uses check digits with a sort of 'mix and match' 'Check Digit Rule Name' to select the checkdigit algorithm.

This is of the format "WxxMyyyFza" where Wxx indicates the key of an entry in a weights table

Myyy indicates the key of an entry in a modulus table

Fz indicates the key of an entry in a flags table

a, which must only be specified for Modulus 11 check digits, indicates the translations required for check digit values 10 and 11.

BPay recommends the check digit rule: W01M101F3 (MOD10V01) for billers who don't already have a preferred method. This happens to be the same algorithm used for many credit cards and other systems - the Luhn Algorithm or 'mod 10 algorithm'.

--- Below is a *minimally tested* tcl8.5 package to return and test BPay checkdigits.

Save it as bpaycheckdigit-0.2.tm and place it on your module path (see output of [tcl::tm::list])
    synopsis:
    %package require bpaycheckdigit
    0.2
    %bpaycheckdigit::get  2007050100001
    1
    %bpaycheckdigit::test 20070501000012
    0
    %bpaycheckdigit::test 20070501000011
    1
    %bpaycheckdigit::get  2007050100001   W17M971F1
    49
    %bpaycheckdigit::test 200705010000149 W17M971F1
    1
    %bpaycheckdigit::test 200705010500149 W17M971F1
    0

    WARNING: This has not been properly tested, reviewed or used in a production environment.
    You should review the code, and USE AT YOUR OWN RISK.
    In particular - weights array member 19 may need to be extended to contain further powers of 2
    to support larger inputs (or better; the code adjusted to extrapolate values)
    Also - this work was done by working from an old bpay document.
    Things may have changed, comments/updates welcome.
    According to this wikipedia article: http://en.wikipedia.org/wiki/Luhn_algorithm
    the Luhn Algorithm itself is public domain.
    The package supplied here is also released as public domain.

 #jmn 2007-05
 package require Tcl 8.5  ;#require 8.5 features such as lreverse, in

 package provide bpaycheckdigit [namespace eval bpaycheckdigit {
	variable version 0.2

	set version
 }]

 proc bpaycheckdigit::init {} {
	variable weights
	variable modulii
	variable flags
	variable translations

	set weights(01,array) {1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2}
	set weights(01,maxdigits) ""

	set weights(02,array) {2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1}
	set weights(02,maxdigits) ""

	set weights(03,array) {2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 0 0 0}
	set weights(03,maxdigits) ""

	set weights(04,array) {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
	set weights(04,maxdigits) ""

	set weights(05,array) {20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1}
	set weights(05,maxdigits) ""

	set weights(06,array) {2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21}
	set weights(06,maxdigits) ""

	set weights(07,array) {21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2}
	set weights(07,maxdigits) ""

	set weights(08,array) {2 1 7 4 5 3 2 1 7 4 5 3 2 1 7 4 5 3 2 1}
	set weights(08,maxdigits) ""

	set weights(09,array) {3 2 7 6 5 4 3 2 7 6 5 4 3 2 7 6 5 4 3 2}
	set weights(09,maxdigits) ""

	set weights(10,array) {3 2 9 8 7 4 3 2 9 8 7 4 3 2 9 8 7 4 3 2}
	set weights(10,maxdigits) ""

	set weights(11,array) {3 5 2 4 6 1 3 5 2 4 6 1 3 5 2 4 6 1 3 5}
	set weights(11,maxdigits) ""

	set weights(12,array) {3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7}
	set weights(12,maxdigits) ""

	set weights(13,array) {6 2 7 5 3 2 8 6 2 7 5 3 2 8 6 2 7 5 3 2}
	set weights(13,maxdigits) ""

	set weights(14,array) {7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1}
	set weights(14,maxdigits) ""

	set weights(15,array) {9 7 3 1 9 7 3 1 9 7 3 1 9 7 3 1 9 7 3 1}
	set weights(15,maxdigits) ""

	set weights(16,array) {9 7 5 3 1 9 7 5 3 1 9 7 5 3 1 9 7 5 3 1}
	set weights(16,maxdigits) ""

	set weights(17,array) {20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 2 1 4 3}
	set weights(17,maxdigits) ""

	set weights(18,array) {39 37 35 33 31 29 27 25 23 21 19 17 15 13 11 9 7 5 3 1}
	set weights(18,maxdigits) ""

	set weights(19,array) {1024 512 256 128 64 32 16 8 4 2}
	set weights(19,maxdigits) ""

	set weights(20,array) {0 0 5 2 7 4 3}
	set weights(20,maxdigits) "7"

	set weights(21,array) {0 0 7 6 9 2 3}
	set weights(21,maxdigits) "7"

	set weights(22,array) {0 0 11 3 7 19 13}
	set weights(22,maxdigits) "7"

	set weights(23,array) {5 8 4 2 1 6 3 7}
	set weights(23,maxdigits) "8"

	set weights(24,array) {6 9 7 5 3 8 4 2}
	set weights(24,maxdigits) "8"

	set weights(25,array) {0 0 15 17 12 13 07 18 14 3}
	set weights(25,maxdigits) "10"

	set weights(26,array) {0 0 7 1 3 9 1 7 9 1 3 7 9 1}
	set weights(26,maxdigits) "14"

	set weights(27,array) {1 6 7 2 9 4}
	set weights(27,maxdigits) "6"

	set weights(28,array) {7 9 10 5 8 4 2}
	set weights(28,maxdigits) "7"

	set weights(29,array) {3 9 7 3 1 7 5 3 1}
	set weights(29,maxdigits) "9"

	set weights(30,array) {13 11 7 5 3 2 1 13 11 7 5 3 2 1 13 11 7 5 3 2}
	set weights(30,maxdigits) ""

	set weights(31,array) {10 7 8 4 6 3 5 2}
	set weights(31,maxdigits) "8"

	set weights(32,array) {17 13 3 5 7}
	set weights(32,maxdigits) "5"

	set mlist {
	090 9 	0	1
	091 9 	9	1
	100 10	0	1
	101	10	10	1
	102	10	9	1
	103	10	17	1
	110	11	0	1
	111	11	11	1
	112	11	0	1
	113	11	0	1
	130	13	0	2
	131	13	13	2
	132	13	61	2
	970	97	00	2
	971	97	97	2
	}
	foreach {num divideby subtractfrom cdlength} $mlist {
		set modulii($num,divideby) $divideby
		set modulii($num,subtractfrom) $subtractfrom
		set modulii($num,cdlength) $cdlength
	}

	set flist {
	0	N	N	N
	1	N	N	Y
	2	N	Y	N
	3	N	Y	Y
	4	N	T	N
	5	N	T	Y
	6	Y	N	N
	7	Y	N	Y
	8	Y	Y	N
	9	Y	Y	Y
	}
	foreach {num start_left add_digits keep_zero} $flist {
		set flags($num,start_left)	$start_left
		set flags($num,add_digits)	$add_digits
		set flags($num,keep_zero)	$keep_zero
	}

	set tlist {
	a	""	""
	b	""	0
	c	""	1
	d	0	""
	e	0	1
	f	0	10
	g	1	""
	h	1	0
	i	1	10
	j	11	0
	k	11	1
	l	11	10
	}
	foreach {name cd10 cd11} $tlist {
		set translations($name,cd10) $cd10
		set translations($name,cd11) $cd11
	}

 }

 # cdrule format WxxMyyyFza
 # (a optional)
 #e.g cdrule -> W17M971F1
 #return a dict containing rule values required by algorithm
 proc bpaycheckdigit::getrule {cdrule} {
	variable weights
	variable modulii
	variable flags
	variable translations

	set cdrule [string trim $cdrule]
	if {![string length $cdrule]} {
		error "empty rule string supplied"
	}
	if {[string length $cdrule] ni {9 10}} {
		error "expected rule string of format WxxMyyyFz or WxxMyyyFza"
	}

	set w [string tolower [string index $cdrule 0]]
	if {$w ne "w"} {
		error "bad rule string: expected firstchar 'w'"
	}
	set weight [string range $cdrule 1 2]

	set m [string tolower [string index $cdrule 3]]
	if {$m ne "m"} {
		error "bad rule string: expected 'm' at char index 3"
	}
	set modulus [string range $cdrule 4 6]

	set f [string tolower [string index $cdrule 7]]
	if {$f ne "f"} {
		error "bad rule string: expected 'f' at char index 7"
	}
	set flag [string index $cdrule 8]

	set translation ""
	if {[string length $cdrule] == 10} {
		set translation [string index $cdrule 9]
	}

	set result [list weight $weight modulus $modulus flag $flag translation $translation]

	dict set result weightarray $weights($weight,array)
	if {![string length $weights($weight,maxdigits)]} {
		dict set result maxdigits [llength $weights($weight,array)]
	} else {
		dict set result maxdigits $weights($weight,maxdigits)
	}

	dict set result divideby 		$modulii($modulus,divideby)
	dict set result subtractfrom	$modulii($modulus,subtractfrom)
	dict set result cdlength		$modulii($modulus,cdlength)

	dict set result startleft		$flags($flag,start_left)
	dict set result adddigits		$flags($flag,add_digits)
	dict set result keepzero		$flags($flag,keep_zero)

	if {[string length $translation]} {
		dict set result cd10 			$translations($translation,cd10)
		dict set result cd11			$translations($translation,cd11)
	} else {
		dict set result cd10 ""
		dict set result cd11 ""
	}

	return $result
 }

 proc bpaycheckdigit::test {completenumber {cdrule W01M101F3}} {
	set rule [getrule $cdrule]
	set cdlength [dict get $rule cdlength]
	set refnumber [string range $completenumber 0 end-$cdlength]
	if {[string length $refnumber] > [dict get $rule maxdigits]} {
		error "number is longer than maxdigits specified by the supplied rule"
	}

	set cd [string range $completenumber end-[expr {$cdlength - 1}] end]

	if {$cd eq [bpaycheckdigit::get $refnumber $cdrule]} {
		return 1
	} else {
		return 0
	}
 }

 proc bpaycheckdigit::get {refnumber {cdrule W01M101F3}} {
	#rule recommended by bpay for billers that haven't currently got a check digit routine.
	#W01M101F3 = MOD10V01 (STANDARD LUHNS MODULUS 10)
	#(also works for visa/mastercard)

	set rule [getrule $cdrule]
	if {[string length $refnumber] > [dict get $rule maxdigits]} {
		error "number is longer than maxdigits specified by the supplied rule"
	}

	set refdigits [split $refnumber {}]
	if {[string tolower [dict get $rule startleft]] eq "n"} {
		set refdigits [lreverse $refdigits]
		set weights [lreverse [dict get $rule weightarray]]
	} else {
		set weights [dict get $rule weightarray]
	}
	set adddigits [string tolower [dict get $rule adddigits]]
	set keepzero [string tolower [dict get $rule keepzero]]

	set cd 0
	set i 0
	foreach ref $refdigits wt $weights {
		set weighted [expr {$wt * $ref}]
		if {$weighted > 9} {
			if {$adddigits eq "y"} {
				set weighted [expr [join [split $weighted {}] +]]  ;#not fastest way to sum a list.. but should be fine here.
			} elseif {$adddigits eq "t"} {
				set weighted [string index $weighted end] ;#(efficiency warning: will shimmer)
			}
		}
		incr cd $weighted
		incr i
		if {$i >= [llength $refdigits]} {
			break
		}
	}

	set divideby [dict get $rule divideby]
	set subtractfrom [dict get $rule subtractfrom]
	set cd10 [dict get $rule cd10]
	set cd11 [dict get $rule cd11]
	set cdlength [dict get $rule cdlength]

	set cd [expr {$cd % $divideby}]

	if {($cd != 0) && ($subtractfrom != 0)} {
		set cd [expr {$subtractfrom - $cd}]
	} elseif {($cd == 0) && !$keepzero} {
		set cd $subtractfrom
	}

	set cd [expr {abs($cd)}]

	if {($cd == 10) && [string length $cd10]} {
		set cd $cd10
	} elseif {($cd == 11) && [string length $cd11]} {
		set cd $cd11
	}

	if {($cdlength == 2) && ([string length $cd] == 1)} {
		set cd "0$cd"
	}

	return $cd
 }

 bpaycheckdigit::init

Category Currency and Finance