home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch12 / CHAPT12A.COB next >
Text File  |  1998-09-14  |  3KB  |  80 lines
  1. 000001 @OPTIONS MAIN,TEST
  2. 000002 Identification Division.
  3. 000003 Program-Id.  Chapt12a.
  4. 000004 Environment Division.
  5. 000005 Configuration Section.
  6. 000006 Special-Names.
  7. 000007       Crt Status Is Keyboard-Status.
  8. 000008 Source-Computer.  IBM-PC.
  9. 000009 Object-Computer.  IBM-PC.
  10. 000010 Data Division.
  11. 000011 Working-Storage Section.
  12. 000012 01  Keyboard-Status.
  13. 000013     03  Accept-Status     Pic 9.
  14. 000014     03  Function-Key      Pic X.
  15. 000015         88 F1-Pressed     Value X"01".
  16. 000016     03  System-Use        Pic X.
  17. 000017 01  Date-Field            Pic 9(8)  Value Zeros.
  18. 000018 01  Date-Field-Split      Redefines Date-Field.
  19. 000019     03  Month-Portion     Pic 99.
  20. 000020     03  Filler            Pic X(6).
  21. 000021 01  Edited-Date-Field     Pic X(20) Value Spaces.
  22. 000022 01  Error-Flag            Pic X     Value Spaces.
  23. 000023     88  Month-Error       Value "Y".
  24. 000024 01  Error-Message         Pic X(50) Value Spaces.
  25. 000025 01  Month-Table-Area.
  26. 000026     03  Month-Descriptions.
  27. 000027         05  Filler            Pic X(9) Value "January".
  28. 000028         05  Filler            Pic X(9) Value "February".
  29. 000029         05  Filler            Pic X(9) Value "March".
  30. 000030         05  Filler            Pic X(9) Value "April".
  31. 000031         05  Filler            Pic X(9) Value "May".
  32. 000032         05  Filler            Pic X(9) Value "June".
  33. 000033         05  Filler            Pic X(9) Value "July".
  34. 000034         05  Filler            Pic X(9) Value "August".
  35. 000035         05  Filler            Pic X(9) Value "September".
  36. 000036         05  Filler            Pic X(9) Value "October".
  37. 000037         05  Filler            Pic X(9) Value "November".
  38. 000038         05  Filler            Pic X(9) Value "December".
  39. 000039     03  Month-Table Redefines Month-Descriptions.
  40. 000040         05  Month-Name        Pic X(9) Occurs 12 Times.
  41. 000041 Screen Section.
  42. 000042 01  Date-Entry Blank Screen.
  43. 000043     03  Line 01 Column 01 Value " Enter Date: ".
  44. 000044     03  Line 01 Column 14 Pic 99/99/9999 Using Date-Field.
  45. 000045     03  Line 02 Column 01 Value "Edited Date: ".
  46. 000046     03  Line 02 Column 14 Pic X(20) From Edited-Date-Field.
  47. 000047     03  Line 05 Column 01 Pic X(50) From Error-Message.
  48. 000048     03  Line 20 Column 01 Value "Press F1 to Exit".
  49. 000049 Procedure Division.
  50. 000050 Chapt12a-Start.
  51. 000051     Perform Until F1-Pressed
  52. 000052        Display Date-Entry
  53. 000053        Accept Date-Entry
  54. 000054* Clear The Error Message For The Next Display
  55. 000055        Move Spaces To Error-Message
  56. 000056* If They Did Not Press F1 To Exit, It's Ok To Process The Input
  57. 000057        If Not F1-Pressed
  58. 000058           Perform Process-Input
  59. 000059        End-If
  60. 000060     End-Perform
  61. 000061     Stop Run
  62. 000062     .
  63. 000063 Process-Input.
  64. 000064* Reset The Error Flag.
  65. 000065     Move Spaces To Error-Flag
  66. 000066     If Month-Portion < 01 Or Month-Portion > 12
  67. 000067        Set Month-Error To True
  68. 000068        Move "Invalid Month" To Error-Message
  69. 000069     Else
  70. 000070        Move Spaces To Edited-Date-Field
  71. 000071        String Month-Name (Month-Portion) Delimited By Space
  72. 000072               Space
  73. 000073               Date-Field (3:2)
  74. 000074               ","
  75. 000075               Date-Field (5:4)
  76. 000076               Delimited By Size
  77. 000077               Into Edited-Date-Field
  78. 000078        End-String
  79. 000079     End-If
  80. 000080     .