daily pastebin goal
26%
SHARE
TWEET

luhn algorithm in cobol

manyone Oct 17th, 2018 98 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 100001 IDENTIFICATION DIVISION.
  2. 100002 PROGRAM-ID.  LUHNTEST.
  3. 100003 ENVIRONMENT DIVISION.
  4. 100004 INPUT-OUTPUT SECTION.
  5. 100005 data division.
  6. 100006 WORKING-STORAGE SECTION.
  7. 100007 01  inp-card.
  8. 100008   03  inp-card-ch      pic x(01) occurs 20 times.
  9. 100009 01  ws-result          pic 9(01).
  10. 100010   88  pass-luhn-test             value 0.
  11. 100011
  12. 100012 PROCEDURE DIVISION.
  13. 100013     move "49927398716"       to inp-card
  14. 100014     perform test-card
  15. 100015     move "49927398717"       to inp-card
  16. 100016     perform test-card
  17. 100017     move "1234567812345678"  to inp-card
  18. 100018     perform test-card
  19. 100019     move "1234567812345670"  to inp-card
  20. 100020     perform test-card
  21. 100021     stop run
  22. 100022     .
  23. 100023 test-card.
  24. 100024     call "LUHN" using inp-card, ws-result
  25. 100025     if pass-luhn-test
  26. 100026       display "input=" inp-card "pass"
  27. 100027     else
  28. 100028       display "input=" inp-card "fail"
  29. 100029     .
  30. 100030
  31. 100031 END PROGRAM LUHNTEST.
  32. 100032 IDENTIFICATION DIVISION.
  33. 100033 PROGRAM-ID.  LUHN.
  34. 100034 ENVIRONMENT DIVISION.
  35. 100035 INPUT-OUTPUT SECTION.
  36. 100036 DATA DIVISION.
  37. 100037 WORKING-STORAGE SECTION.
  38. 100038 01  maxlen           pic 9(02) comp value 16.
  39. 100039 01  inplen           pic 9(02) comp value 0.
  40. 100040 01  i                pic 9(02) comp value 0.
  41. 100041 01  j                pic 9(02) comp value 0.
  42. 100042 01  l                pic 9(02) comp value 0.
  43. 100043 01  dw               pic 9(02) comp value 0.
  44. 100044 01  ws-total         pic 9(03) comp value 0.
  45. 100045 01  ws-prod          pic 99.
  46. 100046 01  filler redefines ws-prod.
  47. 100047   03  ws-prod-tens   pic 9.
  48. 100048   03  ws-prod-units  pic 9.
  49. 100049 01  ws-card.
  50. 100050   03  filler           occurs 16 times depending on maxlen.
  51. 100051     05  ws-card-ch     pic x(01).
  52. 100052     05  ws-card-digit redefines ws-card-ch  pic 9(01).
  53. 100053 LINKAGE SECTION.
  54. 100054 01  inp-card.
  55. 100055   03  inp-card-ch      pic x(01) occurs 20 times.
  56. 100056 01  ws-result          pic 9(01).
  57. 100057   88  pass-luhn-test             value 0.
  58. 100058
  59. 100059 PROCEDURE DIVISION using inp-card, ws-result.
  60. 100060     perform varying i from 1 by +1
  61. 100061     until i > maxlen
  62. 100062     or    inp-card-ch (i) = space
  63. 100063     end-perform
  64. 100064     compute l = i - 1
  65. 100065     compute inplen = l
  66. 100066     perform varying j from 1 by +1
  67. 100067     until j > inplen
  68. 100068       if l < 1
  69. 100069         move "0"             to ws-card-ch (j)
  70. 100070       else
  71. 100071         move inp-card-ch (l) to ws-card-ch (j)
  72. 100072         compute l = l - 1
  73. 100073       end-if
  74. 100074     end-perform
  75. 100075     move 0 to ws-total
  76. 100076     perform varying i from 1 by +1
  77. 100077     until i > inplen
  78. 100078       compute dw = 2 - (i - 2 * function integer (i / 2))
  79. 100079       compute ws-prod = ws-card-digit (i) * dw
  80. 100080       compute ws-total = ws-total
  81. 100081                       + ws-prod-tens
  82. 100082                       + ws-prod-units
  83. 100083     end-perform
  84. 100084     compute ws-result = ws-total - 10 * function integer (ws-total / 10)
  85. 100085     goback
  86. 100086     .
  87. 100087 END PROGRAM LUHN.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top