Need a COBOL routine for Luhn Formula Modulus 10 chk digit

jacheter · Posted: Wed May 24, 2006 7:49 pm

I can probably figure it out but with all the credit card bank programmers out there, can anyone share their Luhn formula modulus 10 "double-add-double" routine for computing the Mod 10 check digit? My number will be 10 numeric characters including the check digit. The routine must be in COBOL. Any help is appreciated. Jacheter.

jacheter · Posted: Thu May 25, 2006 7:33 pm

Well I did it myself - next I will modify this sample program to be a called routine. J,

****** ***************************** Top of Data ******************************
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. LUHNRTN.
000030 AUTHOR. Jacheter.
000040 DATE-COMPILED.
000050 *
000060 ****************************************************************
000070 *
000080 *@ PROGRAM-ID: LUHNTRN.
000090 *@ TITLE: SAMPLE ROUTINE FOR LUHNRTN MOD 10 SELF CHECK TO
000091 *@ DETERMINE A CHECK DIGIT
000092 *
000093 ****************************************************************
000094 *
000095 /
000096 ENVIRONMENT DIVISION.
000097 CONFIGURATION SECTION.
000098 SOURCE-COMPUTER. IBM-370.
000099 OBJECT-COMPUTER. IBM-370.
000100 INPUT-OUTPUT SECTION.
000101 FILE-CONTROL.
000102 *
000104 /
000105 DATA DIVISION.
000106 FILE SECTION.
000107 /
000108 WORKING-STORAGE SECTION.
000109 *
000110 01 WS-PROGRAM-ID PIC X(8) VALUE 'LUHNRTN'.
000111
000120 01 LUHN-AREA.
000200 03 LUHN-NUMBER.
000300 05 EACH-DIGIT OCCURS 9 TIMES INDEXED BY DIG PIC 9(1).
000400 05 CHECK-DIGIT PIC 9(1).
000500 03 LUHN-NUMBER-WORK-AREA.
000600 05 DOUBLED-DIGIT OCCURS 9 TIMES INDEXED BY DBL PIC 9(2).
000610 03 LUHN-NUMBER-REWORK-AREA REDEFINES LUHN-NUMBER-WORK-AREA.
000620 05 SINGLED-DIGIT OCCURS 18 TIMES INDEXED BY SGL PIC 9.
000630
000700 01 NEXT-ZERO-TABLE.
000800 03 FILLER PIC X(3) VALUE '020'.
000900 03 FILLER PIC X(3) VALUE '030'.
001000 03 FILLER PIC X(3) VALUE '040'.
001100 03 FILLER PIC X(3) VALUE '050'.
001200 03 FILLER PIC X(3) VALUE '060'.
001300 03 FILLER PIC X(3) VALUE '070'.
001400 03 FILLER PIC X(3) VALUE '080'.
001500 03 FILLER PIC X(3) VALUE '090'.
001600 03 FILLER PIC X(3) VALUE '100'.
001700 03 FILLER PIC X(3) VALUE '110'.
001800 03 FILLER PIC X(3) VALUE '120'.
001900 03 FILLER PIC X(3) VALUE '130'.
002000 01 NEXT-ZERO-OCCURRENCES REDEFINES NEXT-ZERO-TABLE.
002100 03 EACH-STEP-NUM OCCURS 12 TIMES INDEXED BY STP PIC 9(3).
002200
002300 01 INTERIM-CALC-AREA.
002400 03 INTERIM-NUMBER PIC 9(3) VALUE ZERO.
002500
002510 01 FLAG-AREA PIC X(01) VALUE SPACE.
002520 88 CHECK-DIGIT-DETERMINED VALUE 'Y'.
002530 88 NO-CHECK-DIGIT-DETERMINED VALUE 'N'.
002540
002550
002560 PROCEDURE DIVISION.
002570 P0000-MAIN.
002571 DISPLAY WS-PROGRAM-ID.
002580
002600 MOVE '1234567890' TO LUHN-NUMBER. <=== SAMPLE NUMBER
002610 DISPLAY '1.) ' LUHN-NUMBER.
002700 **
002800 ** FIRST MOVE EACH SINGLE DIGIT TO DIGITS ALLOWING ROOM FOR THEM
002900 ** TO BE DOUBLED
003000 **
003100 PERFORM VARYING DIG FROM 1 BY 1 UNTIL DIG > 9
003200 SET DBL TO DIG
003300 MOVE EACH-DIGIT(DIG) TO DOUBLED-DIGIT(DBL)
003400 END-PERFORM
003410 DISPLAY '2.) ' LUHN-NUMBER-WORK-AREA.
003500 **
003600 ** DOUBLE THE VALUE OF ALTERNATE DIGITS BEGINNING WITH THE RIGHT
003700 ** MOST DIGIT AND MOVE TO THE LEFT
003800 **
003900
004000 PERFORM VARYING DIG FROM 9 BY -2 UNTIL DIG < 1
004100 SET DBL TO DIG
004200 MULTIPLY EACH-DIGIT(DIG) BY 2 GIVING DOUBLED-DIGIT(DBL)
004300 END-PERFORM
004310 DISPLAY '3.) ' LUHN-NUMBER-WORK-AREA.
004400 **
004500 ** ADD CONSTANT 24 TO ACCOUNT FOR 80840 PREFIX PLUS THE INDIVIDUAL
004600 ** DIGITS OF PRODUCTS OF DOUBLING PLUS THE UNAFFECTED DIGITS
004700 **
004800 MOVE 024 TO INTERIM-NUMBER.
004900 PERFORM VARYING SGL FROM 1 BY 1 UNTIL SGL > 18
005000 ADD SINGLED-DIGIT(SGL) TO INTERIM-NUMBER
005100 END-PERFORM
005110 DISPLAY '4.) ' INTERIM-NUMBER
005200 **
005300 ** SUBTRACT THE PRODUCT OF DOUBLE-ADD-DOUBLE PROCESS FROM THE NEXT
005400 ** HIGHER NUMBER ENDING IN ZERO
005500 **
005510 SET NO-CHECK-DIGIT-DETERMINED TO TRUE
005600 PERFORM VARYING STP FROM 1 BY 1 UNTIL STP > 12
005700 OR CHECK-DIGIT-DETERMINED
005800 IF INTERIM-NUMBER = EACH-STEP-NUM(STP)
005900 SET CHECK-DIGIT-DETERMINED TO TRUE
006000 MOVE ZERO TO CHECK-DIGIT
006100 ELSE
006200 IF INTERIM-NUMBER > EACH-STEP-NUM(STP) AND
006300 INTERIM-NUMBER < EACH-STEP-NUM(STP + 1)
006400 SET CHECK-DIGIT-DETERMINED TO TRUE
006500 SUBTRACT INTERIM-NUMBER FROM EACH-STEP-NUM(STP + 1)
006600 GIVING CHECK-DIGIT
006610 DISPLAY '5A.) ' INTERIM-NUMBER
006611 DISPLAY '5B.) ' EACH-STEP-NUM(STP)
006620 DISPLAY '5C.) ' EACH-STEP-NUM(STP + 1)
006630 DISPLAY '5D.) ' CHECK-DIGIT
006700 END-IF
006800 END-IF
006900 END-PERFORM
007000 **
007100 ** IF THIS ROUTINE DID NOT WORK DISPLAY A MESSAGE ELSE DISPLAY THE
007200 ** RESULTANT NUMBER WITH A CHECK DIGIT
007300 **
007400 IF NO-CHECK-DIGIT-DETERMINED
007500 DISPLAY 'COULD NOT DETERMINE CHECK DIGIT '
007600 DISPLAY 'GO BACK TO THE DRAWING BOARD '
007700 ELSE
007710 DISPLAY '6.) ' LUHN-NUMBER
007800 DISPLAY 'NUMBER WITH CHECK DIGIT '
007900 END-IF.
008000 GOBACK.
****** **************************** Bottom of Data ****************************

********************************* TOP OF DATA **********************************
LUHNRTN
1.) 1234567890
2.) 010203040506070809
3.) 020206041006140818
4.) 067
5A.) 067
5B.) 060
5C.) 070
5D.) 3 <== check digit
6.) 1234567893 <==== SAMPLE NUMBER WITH CHECK DIGIT
******************************** BOTTOM OF DATA ********************************