home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch14 / CHAPT14X.COB < prev   
Encoding:
Text File  |  1998-09-15  |  8.9 KB  |  217 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt14x.
  4. 000031* Dealer Data Entry Exercise
  5. 000041 Environment Division.
  6. 000050 Configuration Section.
  7. 000051 Special-Names.
  8. 000052       Crt Status Is Keyboard-Status
  9. 000053       Cursor Is Cursor-Position.
  10. 000054 Source-Computer.  IBM-PC.
  11. 000055 Object-Computer.  IBM-PC.
  12. 000056 Input-Output Section.
  13. 000057 File-Control.
  14. 000058     Select Dealer-File Assign To "Dealer.Dat"
  15. 000059            Organization Indexed
  16. 000060            Access Random
  17. 000061            Record Key Dealer-Number Of Dealer-Record
  18. 000062            Alternate Record Key Dealer-Name Of Dealer-Record
  19. 000063            File Status Dealer-Status.
  20. 000065 Data Division.
  21. 000066 File Section.
  22. 000067 Fd  Dealer-File.
  23. 000068 01  Dealer-Record.
  24. 000069     03  Dealer-Number         Pic X(8).
  25. 000070     03  Dealer-Name.
  26. 000071         05  Last-Name   Pic X(25).
  27. 000072         05  First-Name  Pic X(15).
  28. 000073         05  Middle-Name Pic X(10).
  29. 000083     03  Address-Line-1      Pic X(50).
  30. 000085     03  Address-Line-2      Pic X(50).
  31. 000086     03  City                Pic X(40).
  32. 000087     03  State-Or-Country    Pic X(20).
  33. 000088     03  Postal-Code         Pic X(15).
  34. 000089     03  Home-Phone          Pic X(20).
  35. 000090     03  Work-Phone          Pic X(20).
  36. 000091     03  Other-Phone         Pic X(20).
  37. 000092     03  Start-Date          Pic 9(8).
  38. 000093     03  Last-Rent-Paid-Date Pic 9(8).
  39. 000094     03  Next-Rent-Due-Date  Pic 9(8).
  40. 000095     03  Rent-Amount         Pic 9(4)v99.
  41. 000096     03  Consignment-Percent Pic 9(3).
  42. 000097     03  Filler              Pic X(50).
  43. 000098 Working-Storage Section.
  44. 000099 01  Keyboard-Status.
  45. 000100     03  Accept-Status Pic 9.
  46. 000101     03  Function-Key  Pic X.
  47. 000102         88  F1-Pressed Value X"01".
  48. 000103         88  F2-Pressed Value X"02".
  49. 000104     03  System-Use    Pic X.
  50. 000105 01  Cursor-Position.
  51. 000106     03  Cursor-Row    Pic 9(2) Value 1.
  52. 000107     03  Cursor-Column Pic 9(2) Value 1.
  53. 000116 01  Dealer-Status     Pic X(2) Value Spaces.
  54. 000240     88  Dealer-Success Value "00".
  55. 000250 01  Error-Message     Pic X(60) Value Spaces.
  56. 000251 01  Open-Error.
  57. 000252     03  Filler        Pic X(26)
  58. 000253         Value "Error Opening Dealer File ".
  59. 000254     03  Open-Error-Status  Pic X(2).
  60. 000255 01  Write-Error.
  61. 000256     03  Filler        Pic X(26)
  62. 000257         Value "Error Writing Dealer File ".
  63. 000258     03  Write-Error-Status Pic X(2).
  64. 000259 01  Work-Record.
  65. 000260     03  Dealer-Number         Pic X(8).
  66. 000261     03  Dealer-Name.
  67. 000262         05  Last-Name   Pic X(25).
  68. 000263         05  First-Name  Pic X(15).
  69. 000264         05  Middle-Name Pic X(10).
  70. 000265     03  Address-Line-1      Pic X(50).
  71. 000266     03  Address-Line-2      Pic X(50).
  72. 000267     03  City                Pic X(40).
  73. 000268     03  State-Or-Country    Pic X(20).
  74. 000269     03  Postal-Code         Pic X(15).
  75. 000270     03  Home-Phone          Pic X(20).
  76. 000271     03  Work-Phone          Pic X(20).
  77. 000272     03  Other-Phone         Pic X(20).
  78. 000273     03  Start-Date          Pic 9(8).
  79. 000274     03  Last-Rent-Paid-Date Pic 9(8).
  80. 000275     03  Next-Rent-Due-Date  Pic 9(8).
  81. 000276     03  Rent-Amount         Pic 9(4)v99.
  82. 000277     03  Consignment-Percent Pic 9(3).
  83. 000278 01  End-Of-Process-Flag     Pic X Value Spaces.
  84. 000279     88  End-Process         Value "Y".
  85. 000280 Screen Section.
  86. 000388 01  Data-Entry-Screen
  87. 000389     Blank Screen, Auto
  88. 000390     Foreground-Color Is 7,
  89. 000391     Background-Color Is 1.
  90. 000392*
  91. 000393     03  Screen-Literal-Group.
  92. 000394         05  Line 01 Column 30 Value "Darlene's Treasures"
  93. 000395             Highlight Foreground-Color 4 Background-Color 1.
  94. 000396         05  Line 03 Column 30 Value "Tenant Entry Program"
  95. 000397             Highlight.
  96. 000398         05  Line 4  Column 01  Value "Number: ".
  97. 000399         05  Line 5  Column 01  Value "Name, Last: ".
  98. 000400         05  Line 5  Column 39  Value "First: ".
  99. 000401         05  Line 5  Column 62  Value "Middle: ".
  100. 000402         05  Line 6  Column 01  Value "Address 1: ".
  101. 000403         05  Line 7  Column 01  Value "Address 2: ".
  102. 000404         05  Line 8  Column 01  Value "City: ".
  103. 000405         05  Line 9  Column 01  Value "Country/State: ".
  104. 000406         05  Line 9  Column 36  Value "Postal Code: ".
  105. 000407         05  Line 11 Column 01  Value "Phone/Home: ".
  106. 000408         05  Line 11 Column 34  Value "Work: ".
  107. 000409         05  Line 12 Column 06  Value "Other: ".
  108. 000410         05  Line 14 Column 01  Value "Start Date: ".
  109. 000411         05  Line 14 Column 24  Value "Last Paid Date: ".
  110. 000412         05  Line 14 Column 51  Value "Next Rent Due on: ".
  111. 000413         05  Line 15 Column 01  Value "Rent Amount: ".
  112. 000414         05  Line 16 Column 01  Value "Consignment Percent: ".
  113. 000415         05  Line 22 Column 01  Value "F1-Exit    F2-Save".
  114. 000416*
  115. 000417     03  Required-Reverse-Group Reverse-Video Required.
  116. 000418         05  Line 4 Column 13  Pic X(8)  Using Dealer-Number
  117. 000419             Of Work-Record.
  118. 000420         05  Line 5 Column 13  Pic X(25) Using Last-Name
  119. 000421             Of Work-Record.
  120. 000422         05  Line 5 Column 46  Pic X(15) Using First-Name
  121. 000423             Of Work-Record.
  122. 000424*
  123. 000425     03  Reverse-Video-Group Reverse-Video.
  124. 000426         05  Line 5  Column 70 Pic X(10) Using Middle-Name
  125. 000427             Of Work-Record.
  126. 000428         05  Line 6  Column 15 Pic X(50) Using Address-Line-1
  127. 000429             Of Work-Record.
  128. 000430         05  Line 7  Column 15 Pic X(50) Using Address-Line-2
  129. 000431             Of Work-Record.
  130. 000432         05  Line 8  Column 15 Pic X(40) Using City
  131. 000433             Of Work-Record.
  132. 000434         05  Line 9  Column 15 Pic X(20) Using State-Or-Country
  133. 000435             Of Work-Record.
  134. 000436         05  Line 9  Column 50 Pic X(15) Using Postal-Code
  135. 000437             Of Work-Record.
  136. 000438         05  Line 11 Column 13 Pic X(20) Using Home-Phone
  137. 000439             Of Work-Record.
  138. 000440         05  Line 11 Column 41 Pic X(20) Using Work-Phone
  139. 000441             Of Work-Record.
  140. 000442         05  Line 12 Column 13 Pic X(20) Using Other-Phone
  141. 000443             Of Work-Record.
  142. 000444         05  Line 14 Column 13 Pic 99/99/9999 Using Start-Date
  143. 000445             Of Work-Record.
  144. 000446         05  Line 14 Column 40 Pic 99/99/9999
  145. 000447             Using Last-Rent-Paid-Date Of Work-Record.
  146. 000448         05  Line 14 Column 69 Pic 99/99/9999
  147. 000449             Using Next-Rent-Due-Date Of Work-Record.
  148. 000450         05  Line 15 Column 14 Pic Z,ZZZ.99 Using Rent-Amount
  149. 000451             Of Work-Record.
  150. 000452         05  Line 16 Column 22 Pic ZZ9 Using Consignment-Percent
  151. 000453             Of Work-Record.
  152. 000454     03  Blink-Group Highlight Blink.
  153. 000455         05  Line 20 Column 01 Pic X(60) From Error-Message.
  154. 000456*
  155. 000458 Procedure Division.
  156. 000459 Declaratives.
  157. 000460 Input-File-Error Section.
  158. 000461     Use After Standard Error Procedure On Dealer-File.
  159. 000462 Dealer-File-Error.
  160. 000463     String "Error On Dealer-File " Dealer-Status
  161. 000464       Delimited By Size Into Error-Message
  162. 000465     End-String
  163. 000466     Display Data-Entry-Screen
  164. 000467     Accept Data-Entry-Screen
  165. 000468     Set End-Process To True
  166. 000469     .
  167. 000470 End Declaratives.
  168. 000471 Chapt14x-Start Section.
  169. 000472     Perform Open-File
  170. 000473     If Dealer-Success
  171. 000474        Initialize Work-Record
  172. 000475        Perform Process-Screen Until F1-Pressed Or
  173. 000476                                     End-Process
  174. 000477        Perform Close-File
  175. 000478     End-If
  176. 000479     Stop Run
  177. 000480     .
  178. 000481  Process-Screen.
  179. 000482     Perform Display-And-Accept
  180. 000483     If F2-Pressed
  181. 000484        Perform Save-Record
  182. 000485     End-If
  183. 000486     .
  184. 000487 Save-Record.
  185. 000488     Move Corresponding Work-Record To Dealer-Record
  186. 000489     Write Dealer-Record
  187. 000490      Invalid Key
  188. 000491        Perform Generate-Proper-Error
  189. 000492      Not Invalid Key
  190. 000493        Initialize Work-Record
  191. 000494        Move 1 To Cursor-Row
  192. 000495                  Cursor-Column
  193. 000496     End-Write
  194. 000497     .
  195. 000498 Generate-Proper-Error.
  196. 000499     If Dealer-Status = "22"
  197. 000500        Move "Duplicate Information, record not written"
  198. 000501        To   Error-Message
  199. 000502     Else
  200. 000503        Move Dealer-Status To Write-Error-Status
  201. 000504        Move Write-Error To Error-Message
  202. 000505        Perform Display-And-Accept
  203. 000506        Set End-Process To True
  204. 000507     End-If
  205. 000508     .
  206. 000509 Display-And-Accept.
  207. 000510     Display Data-Entry-Screen
  208. 000511     Accept Data-Entry-Screen
  209. 000512* Clear So Next Display Does Not Show The Old Error Message
  210. 000513     Move Spaces To Error-Message
  211. 000514     .
  212. 000515 Open-File.
  213. 000516     Open Output Dealer-File
  214. 000517     .
  215. 000518 Close-File.
  216. 000519     Close Dealer-File
  217. 000520     .
  218.