home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch10 / CHAPT10D.COB < prev    next >
Text File  |  1998-09-14  |  5KB  |  127 lines
  1. 000010 @OPTIONS MAIN
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt10d.
  4. 000031* Go To Vs Perform Logic
  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  Last-Name              Pic X(20) Value Spaces.
  20. 000069     03  First-Name             Pic X(20) Value Spaces.
  21. 000070     03  E-Mail                 Pic X(30) Value Spaces.
  22. 000085 Screen Section.
  23. 000255 01  Entry-Screen
  24. 000256     Blank Screen, Auto
  25. 000257     Foreground-Color Is 7,
  26. 000258     Background-Color Is 1.
  27. 000259*
  28. 000260     03  Screen-Literal-Group.
  29. 000261         05  Line 01 Column 30 Value "Name and E-mail Entry"
  30. 000262             Highlight Foreground-Color 4 Background-Color 1.
  31. 000273         05  Line 06 Column 05 Value "E-mail: ".
  32. 000283         05  Line 08 Column 05 Value "  Last: ".
  33. 000284         05  Line 09 Column 05 Value " First: ".
  34. 000285         05  Line 22 Column 05 Value "Press F1 to Exit".
  35. 000287     03  Reverse-Video-Group Reverse-Video.
  36. 000289         05  Line 06 Column 13 Pic X(30) Using E-Mail.
  37. 000290         05  Line 08 Column 13 Pic X(20) Using Last-Name.
  38. 000291         05  Line 09 Column 13 Pic X(20) Using First-Name.
  39. 000326 Procedure Division.
  40. 000327 Chapt10d-Start.
  41. 000328* First The Perform Code.
  42. 000330     Perform Display-And-Accept-Screen Until F1-Pressed
  43. 000331* Now The Go To Code
  44. 000332     Initialize Screen-Items
  45. 000333     Go To Process-Screen
  46. 000334     .
  47. 000335 Display-And-Accept-Screen.
  48. 000336     Display Entry-Screen
  49. 000337     Accept  Entry-Screen
  50. 000347     If F1-Pressed
  51. 000357        Continue
  52. 000358     Else
  53. 000359        Perform Process-Data-Fields
  54. 000360     End-If
  55. 000361     .
  56. 000362 Process-Data-Fields.
  57. 000363     If Last-Name > Spaces
  58. 000364        Perform Process-Last-Name
  59. 000365     Else
  60. 000366        Move "********************" To Last-Name
  61. 000367     End-If
  62. 000368     If First-Name > Spaces
  63. 000369        Perform Process-First-Name
  64. 000370     Else
  65. 000371        Move "********************" To First-Name
  66. 000372     End-If
  67. 000373     If E-Mail > Spaces
  68. 000374        Perform Process-E-Mail
  69. 000375     Else
  70. 000376        Move "******************************" To E-Mail
  71. 000377     End-If
  72. 000386     .
  73. 000396 Process-Last-Name.
  74. 000406     Inspect Last-Name Converting "abcdefghijklmnopqrstuvwxyz"
  75. 000416                       To         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  76. 000426     .
  77. 000436 Process-First-Name.
  78. 000446     Inspect First-Name Converting "abcdefghijklmnopqrstuvwxyz"
  79. 000456                        To         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  80. 000466     .
  81. 000476 Process-E-Mail.
  82. 000486     Inspect E-Mail Converting "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  83. 000496                    To         "abcdefghijklmnopqrstuvwzyz"
  84. 000506     .
  85. 000507* Go To Method
  86. 000516 Process-Screen.
  87. 000526     Display Entry-Screen
  88. 000536     Accept Entry-Screen
  89. 000546     If F1-Pressed
  90. 000556        Stop Run
  91. 000566     End-If
  92. 000576     If Last-Name > Spaces
  93. 000586        Go To Process-Last-Name-Goto
  94. 000596     Else
  95. 000606        Move "********************" To Last-Name
  96. 000616     End-If
  97. 000617     .
  98. 000626 Check-First-Name.
  99. 000636     If First-Name > Spaces
  100. 000646        Go To Process-First-Name-Goto
  101. 000656     Else
  102. 000666        Move "********************" To First-Name
  103. 000676     End-If
  104. 000686     .
  105. 000696 Check-E-Mail.
  106. 000706     If E-Mail > Spaces
  107. 000716        Go To Process-E-Mail-Goto
  108. 000726     Else
  109. 000736        Move "******************************" To E-Mail
  110. 000746     End-If
  111. 000756     Go To Process-Screen
  112. 000766     .
  113. 000776 Process-Last-Name-Goto.
  114. 000777     Inspect Last-Name Converting "abcdefghijklmnopqrstuvwxyz"
  115. 000778                       To         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  116. 000780     Go To Check-First-Name
  117. 000781     .
  118. 000786 Process-First-Name-Goto.
  119. 000787     Inspect First-Name Converting "abcdefghijklmnopqrstuvwxyz"
  120. 000788                        To         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  121. 000790     Go To Check-E-Mail
  122. 000791     .
  123. 000796 Process-E-Mail-Goto.
  124. 000797     Inspect E-Mail Converting "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  125. 000798                    To         "abcdefghijklmnopqrstuvwzyz"
  126. 000806     Go To Process-Screen
  127. 000816     .