home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch23 / CHAPT23E.COB < prev    next >
Text File  |  1998-09-14  |  3KB  |  60 lines
  1. 000020 Identification Division.
  2. 000030 Program-Id.  Chapt23e Is Initial.
  3. 000031* Validate A Date
  4. 000040 Environment Division.
  5. 000050 Configuration Section.
  6. 000051 Source-Computer.  IBM-PC.
  7. 000055 Object-Computer.  IBM-PC.
  8. 000056 Data Division.
  9. 000057 Working-Storage Section.
  10. 000099 01  Work-Number           Pic 9(5) Value Zeros.
  11. 000100 01  Work-Remainder        Pic 9(5) Value Zeros.
  12. 000101 01  Work-Remainder-100    Pic 9(5) Value Zeros.
  13. 000102 01  Work-Remainder-400    Pic 9(5) Value Zeros.
  14. 000103 01  Today-Date            Pic 9(8) Value Zeros.
  15. 000104 01  Today-Integer         Pic 9(7) Value Zeros.
  16. 000105 01  Test-Integer          Pic 9(7) Value Zeros.
  17. 000106 01  Test-Range            Pic 9(7) Value Zeros.
  18. 000107 01  Day-Table-Area.
  19. 000108     03  Day-Table-Values      Pic X(24) Value
  20. 000109         "312831303130313130313031".
  21. 000110     03  Day-Table Redefines Day-Table-Values.
  22. 000111         05  Days-In-Month     Pic 99   Occurs 12 Times.
  23. 000113 Linkage Section.
  24. 000114 01  Passed-Date.
  25. 000115     03  Date-To-Validate      Pic 9(8).
  26. 000116     03  Date-To-Validate-X Redefines Date-To-Validate.
  27. 000117         05  Date-MM           Pic 99.
  28. 000118         05  Date-DD           Pic 99.
  29. 000119         05  Date-YYYY         Pic 9(4).
  30. 000120 01  Valid-Status              Pic X(40).
  31. 000121 Procedure Division Using Passed-Date Valid-Status.
  32. 000159 Chapt23e-Start.
  33. 000199     Divide Date-YYYY Of Date-To-Validate-X By 4
  34. 000200            Giving Work-Number Remainder
  35. 000201                   Work-Remainder
  36. 000202     Divide Date-YYYY Of Date-To-Validate-X By 100
  37. 000203            Giving Work-Number Remainder
  38. 000204                   Work-Remainder-100
  39. 000205     Divide Date-YYYY Of Date-To-Validate-X By 400
  40. 000206            Giving Work-Number Remainder
  41. 000207                   Work-Remainder-400
  42. 000209     If Work-Remainder = Zeros And
  43. 000210        (Work-Remainder-100 Not = Zeros Or
  44. 000211         Work-Remainder-400 = Zeros)
  45. 000212           Move 29 To Days-In-Month (2)
  46. 000213     Else
  47. 000214           Move 28 To Days-In-Month (2)
  48. 000215     End-If
  49. 000217     If Date-MM Of Date-To-Validate-X  > 12 Or
  50. 000218        Date-MM Of Date-To-Validate-X  < 01 Or
  51. 000219        Date-YYYY Of Date-To-Validate-X < 1601 Or
  52. 000220        Date-DD Of Date-To-Validate-X Not > Zero Or
  53. 000221        Date-DD Of Date-To-Validate-X >
  54. 000222        Days-In-Month (Date-MM Of Date-To-Validate-X)
  55. 000223        Move "Invalid Date" To Valid-Status
  56. 000224     Else
  57. 000225        Move "Valid Date" To Valid-Status
  58. 000226     End-If
  59. 000253     Exit Program
  60. 000255     .