home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch11 / CHAPT11X.COB < prev   
Encoding:
Text File  |  1998-09-15  |  4.0 KB  |  108 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt11x.
  4. 000031* Your Answer To This Exercise May Be Different.
  5. 000044 Environment Division.
  6. 000050 Configuration Section.
  7. 000051 Special-Names.
  8. 000052       Crt Status Is Keyboard-Status.
  9. 000054 Source-Computer.  IBM-PC.
  10. 000055 Object-Computer.  IBM-PC.
  11. 000056 Data Division.
  12. 000057 Working-Storage Section.
  13. 000067 01  Keyboard-Status.
  14. 000068     03  Accept-Status     Pic 9.
  15. 000069     03  Function-Key      Pic X.
  16. 000070         88 F1-Pressed     Value X"01".
  17. 000071     03  System-Use        Pic X.
  18. 000072 01  Date-Field            Pic 9(8)  Value Zeros.
  19. 000073 01  Edited-Date-Field     Pic X(20) Value Spaces.
  20. 000074 01  Month-Field           Pic X(9)  Value Spaces.
  21. 000075 01  Month-Length          Pic 99    Value Zeros.
  22. 000076 01  Error-Flag            Pic X     Value Spaces.
  23. 000077     88  Month-Error       Value "Y".
  24. 000083 01  Error-Message         Pic X(50) Value Spaces.
  25. 000085 Screen Section.
  26. 000086 01  Date-Entry Blank Screen.
  27. 000087     03  Line 01 Column 01 Value " Enter Date: ".
  28. 000088     03  Line 01 Column 14 Pic 99/99/9999 Using Date-Field.
  29. 000089     03  Line 02 Column 01 Value "Edited Date: ".
  30. 000090     03  Line 02 Column 14 Pic X(20) From Edited-Date-Field.
  31. 000091     03  Line 05 Column 01 Pic X(50) From Error-Message.
  32. 000092     03  Line 20 Column 01 Value "Press F1 to Exit".
  33. 000100 Procedure Division.
  34. 000159 Chapt11x-Start.
  35. 000160     Perform Until F1-Pressed
  36. 000161        Display Date-Entry
  37. 000162        Accept Date-Entry
  38. 000163* Clear The Error Message For The Next Display
  39. 000164        Move Spaces To Error-Message
  40. 000165* If They Did Not Press F1 To Exit, It's Ok To Process The Input
  41. 000166        If Not F1-Pressed
  42. 000167           Perform Process-Input
  43. 000168        End-If
  44. 000169     End-Perform
  45. 000170     Stop Run
  46. 000171     .
  47. 000172 Process-Input.
  48. 000173* Reset The Error Flag.
  49. 000174     Move Spaces To Error-Flag
  50. 000175* Figure Out Which Month It Is.
  51. 000176* Month-Length Contains The Number Of Characters In The
  52. 000177* Month Name
  53. 000178     Evaluate Date-Field (1:2)
  54. 000179        When "01"
  55. 000180          Move "January" To Month-Field
  56. 000181          Move 7 To Month-Length
  57. 000182        When "02"
  58. 000183          Move "February" To Month-Field
  59. 000184          Move 8 To Month-Length
  60. 000185        When "03"
  61. 000186          Move "March" To Month-Field
  62. 000187          Move 5 To Month-Length
  63. 000188        When "04"
  64. 000189          Move "April" To Month-Field
  65. 000190          Move 5 To Month-Length
  66. 000191        When "05"
  67. 000192          Move "May" To Month-Field
  68. 000193          Move 3 To Month-Length
  69. 000194        When "06"
  70. 000195          Move "June" To Month-Field
  71. 000196          Move 4 To Month-Length
  72. 000197        When "07"
  73. 000198          Move "July" To Month-Field
  74. 000199          Move 4 To Month-Length
  75. 000200        When "08"
  76. 000201          Move "August" To Month-Field
  77. 000202          Move 6 To Month-Length
  78. 000203        When "09"
  79. 000204          Move "September" To Month-Field
  80. 000205          Move 9 To Month-Length
  81. 000206        When "10"
  82. 000207          Move "October" To Month-Field
  83. 000208          Move 7 To Month-Length
  84. 000209        When "11"
  85. 000210          Move "November" To Month-Field
  86. 000211          Move 8 To Month-Length
  87. 000212        When "12"
  88. 000213          Move "December" To Month-Field
  89. 000214          Move 8 To Month-Length
  90. 000215        When Other
  91. 000216          Set Month-Error To True
  92. 000217          Move "Invalid Month" To Error-Message
  93. 000218     End-Evaluate
  94. 000219     If Month-Error
  95. 000220        Continue
  96. 000221     Else
  97. 000222* Initialize The Output Since We Are Going To Use String.
  98. 000223        Move Spaces To Edited-Date-Field
  99. 000224        String Month-Field (1:month-Length)
  100. 000225               Space
  101. 000226               Date-Field (3:2)
  102. 000227               ","
  103. 000228               Date-Field (5:4)
  104. 000229               Delimited By Size
  105. 000230               Into Edited-Date-Field
  106. 000231        End-String
  107. 000232     End-If
  108. 000233     .
  109.