home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch21 / CHAPT21X.COB < prev   
Text File  |  1998-09-14  |  4KB  |  81 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt21x.
  4. 000031* Chapter 21 Exercise Answer
  5. 000040 Environment Division.
  6. 000050 Configuration Section.
  7. 000051 Source-Computer.  IBM-PC.
  8. 000055 Object-Computer.  IBM-PC.
  9. 000056 Data Division.
  10. 000057 Working-Storage Section.
  11. 000098 01  Date-Work-Fields.
  12. 000099     03  Birthday      Pic 9(8) Value Zeros.
  13. 000100     03  Birthday-X Redefines Birthday.
  14. 000101         05  The-Month Pic 99.
  15. 000102         05  The-Day   Pic 99.
  16. 000103         05  The-Year  Pic 9(4).
  17. 000104     03  Julian-Birthday   Pic 9(7) Value Zeros.
  18. 000105     03  Julian-Birthday-X Redefines Julian-Birthday.
  19. 000106         05  Julian-Day    Pic 9(3).
  20. 000107         05  Julian-Year   Pic 9(4).
  21. 000108     03  Julian-Date       Pic 9(7) Value Zeros.
  22. 000109     03  Julian-Date-X Redefines Julian-Date.
  23. 000110         05  Julian-Year   Pic 9(4).
  24. 000111         05  Julian-Day    Pic 9(3).
  25. 000112     03  Work-Date         Pic 9(8) Value Zeros.
  26. 000113     03  Work-Date-X       Redefines Work-Date.
  27. 000114         05  The-Year      Pic 9(4).
  28. 000115         05  The-Month     Pic 99.
  29. 000116         05  The-Day       Pic 99.
  30. 000118 01  Birth-Day-Of-Week Pic X(9) Value Spaces.
  31. 000119 01  Days-Old          Pic 9(5) Value Zeros.
  32. 000120 01  Days-Old-2000     Pic 9(5) Value Zeros.
  33. 000121 01  Today-Date        Pic 9(8).
  34. 000122 01  Integer-Today     Pic 9(12).
  35. 000123 01  Integer-Birthday  Pic 9(12).
  36. 000124 01  Weekday-Number    Pic 9.
  37. 000125 01  Day-Of-Week-Table-Area.
  38. 000126     03  Day-Of-Week-Table-Values.
  39. 000127         05  Filler        Pic X(9) Value "Sunday".
  40. 000128         05  Filler        Pic X(9) Value "Monday".
  41. 000129         05  Filler        Pic X(9) Value "Tuesday".
  42. 000130         05  Filler        Pic X(9) Value "Wednesday".
  43. 000131         05  Filler        Pic X(9) Value "Thursday".
  44. 000132         05  Filler        Pic X(9) Value "Friday".
  45. 000133         05  Filler        Pic X(9) Value "Saturday".
  46. 000134     03  Day-Of-Week-Table Redefines Day-Of-Week-Table-Values.
  47. 000135         05  Week-Day-Entry Pic X(9) Occurs 7 Times.
  48. 000136 Screen Section.
  49. 000137 01  Date-Entry Blank Screen Auto.
  50. 000138     03  Line 01 Column 01 Value "Enter Birthday: ".
  51. 000139     03  Line 01 Column 17 Pic 99/99/9999 Using Birthday.
  52. 000140     03  Line 03 Column 1  Value "Born on ".
  53. 000141     03  Line 03 Column 9  Pic X(9) From Birth-Day-Of-Week.
  54. 000142     03  Line 04 Column 1  Value "Days Old Today: ".
  55. 000143     03  Line 04 Column 17 Pic Z(5)9 From Days-Old.
  56. 000144     03  Line 05 Column 1  Value "Days old 01/01/2000: ".
  57. 000145     03  Line 05 Column 24 Pic Z(5)9 From Days-Old-2000.
  58. 000146     03  Line 06 Column 1  Value "Julian Birthday:".
  59. 000147     03  Line 06 Column 18 Pic 999/9999 From Julian-Birthday.
  60. 000148 Procedure Division.
  61. 000159 Chapt21x-Start.
  62. 000169     Display Date-Entry
  63. 000179     Accept Date-Entry
  64. 000189     Move Function Current-Date (1:8) To Today-Date
  65. 000190     Compute Integer-Today =
  66. 000191             Function Integer-Of-Date (Today-Date)
  67. 000192     Move Corresponding Birthday-X To Work-Date-X
  68. 000193     Compute Integer-Birthday =
  69. 000194             Function Integer-Of-Date (Work-Date)
  70. 000199     Compute Weekday-Number =
  71. 000209             (Function Rem (Integer-Birthday 7) + 1)
  72. 000219     Move Week-Day-Entry (Weekday-Number) To Birth-Day-Of-Week
  73. 000229     Compute Days-Old = Integer-Today - Integer-Birthday
  74. 000239     Compute Days-Old-2000 = Function Integer-Of-Date (20000101)
  75. 000249                           - Integer-Birthday
  76. 000259     Compute Julian-Date =
  77. 000269             Function Day-Of-Integer (Integer-Birthday)
  78. 000279     Move Corresponding Julian-Date-X To Julian-Birthday-X
  79. 000289     Display Date-Entry
  80. 000299     Stop Run
  81. 000309     .