home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch10 / CHAPT10C.COB < prev    next >
Text File  |  1998-09-14  |  4KB  |  83 lines
  1. 000010 @OPTIONS MAIN
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt10c.
  4. 000031* Name And E-Mail Edit - Processing Loop.
  5. 000040 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. 000061 Working-Storage Section.
  13. 000062 01  Keyboard-Status.
  14. 000063     03  Accept-Status Pic 9.
  15. 000064     03  Function-Key  Pic X.
  16. 000065         88 F1-Pressed Value X"01".
  17. 000066     03  System-Use    Pic X.
  18. 000067 01  Screen-Items.
  19. 000068     03  Name-Entry             Pic X(40) Value Spaces.
  20. 000069     03  E-Mail                 Pic X(30) Value Spaces.
  21. 000070     03  Output-Fields.
  22. 000071         05  Last-Name          Pic X(30) Value Spaces.
  23. 000072         05  First-Name         Pic X(30) Value Spaces.
  24. 000073         05  Error-Message      Pic X(60) Value Spaces.
  25. 000074 01  Work-Numbers.
  26. 000075     03  Work-Number            Pic 99 Value Zeros.
  27. 000076     03  Work-Number-1          Pic 99 Value Zeros.
  28. 000077     03  Work-Number-2          Pic 99 Value Zeros.
  29. 000085 Screen Section.
  30. 000255 01  Name-Entry-Screen
  31. 000256     Blank Screen, Auto
  32. 000257     Foreground-Color Is 7,
  33. 000258     Background-Color Is 1.
  34. 000259*
  35. 000260     03  Screen-Literal-Group.
  36. 000261         05  Line 01 Column 30 Value "Name and E-mail Entry"
  37. 000262             Highlight Foreground-Color 4 Background-Color 1.
  38. 000263         05  Line 05 Column 05 Value "  Name: ".
  39. 000273         05  Line 06 Column 05 Value "E-mail: ".
  40. 000283         05  Line 08 Column 05 Value "  Last: ".
  41. 000284         05  Line 09 Column 05 Value " First: ".
  42. 000285         05  Line 22 Column 05 Value "Press F1 to Exit".
  43. 000287     03  Reverse-Video-Group Reverse-Video.
  44. 000288         05  Line 05 Column 13 Pic X(40) Using Name-Entry.
  45. 000289         05  Line 06 Column 13 Pic X(30) Using E-Mail.
  46. 000290         05  Line 08 Column 13 Pic X(30) From  Last-Name.
  47. 000291         05  Line 09 Column 13 Pic X(30) From  First-Name.
  48. 000301         05  Line 20 Column 01 Pic X(60)
  49. 000311                  Highlight From Error-Message.
  50. 000326 Procedure Division.
  51. 000327 Chapt10c-Start.
  52. 000328     Perform Display-And-Accept-Screen Until F1-Pressed
  53. 000329     Stop Run
  54. 000330     .
  55. 000331 Display-And-Accept-Screen.
  56. 000332     Display Name-Entry-Screen
  57. 000333     Accept  Name-Entry-Screen
  58. 000334* Reset The Working Fields
  59. 000335     Initialize Output-Fields
  60. 000336                Work-Numbers
  61. 000337* Make Sure There Is A Comma In The Name
  62. 000342     Inspect Name-Entry Tallying Work-Number-2 For All ","
  63. 000343* Only Try To Split If There Is One
  64. 000344     If Work-Number-2 > Zeros
  65. 000345        Perform Process-The-Data
  66. 000346     Else
  67. 000347        Move "Name must contain a comma" To Error-Message
  68. 000348     End-If
  69. 000349     .
  70. 000350 Process-The-Data.
  71. 000351* Split The First And Last Name Out Into Separate Fields
  72. 000352     Inspect Name-Entry Tallying Work-Number
  73. 000353             For Characters Before ","
  74. 000354     Move Name-Entry (1:work-Number) To Last-Name
  75. 000355     Add 2 To Work-Number
  76. 000356* We Need To Exclude The Leading Spaces, After The Comma
  77. 000357     Inspect Name-Entry (Work-Number:)
  78. 000358             Tallying Work-Number-1 For Leading Spaces
  79. 000359     Move Name-Entry (Work-Number + Work-Number-1:) To First-Name
  80. 000360* Change The E-Mail Address To All Lower Case Letters.
  81. 000361     Inspect E-Mail Converting "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  82. 000362                    To         "abcdefghijklmnopqrstuvwxyz"
  83. 000363     .