home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch15 / chapt15e.cob < prev    next >
Text File  |  1998-10-05  |  10KB  |  234 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt15e.
  4. 000031* Dynamic Access Example
  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. 000055 Source-Computer.  IBM-PC.
  11. 000056 Object-Computer.  IBM-PC.
  12. 000057 Input-Output Section.
  13. 000058 File-Control.
  14. 000059     Select Dealer-File Assign To "Dealer.Dat"
  15. 000060            Organization Indexed
  16. 000061            Access Dynamic
  17. 000062            Record Key Dealer-Number
  18. 000063            Alternate Record Key Dealer-Name
  19. 000064            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.
  27. 000072             10  Last-Name-First-Letter Pic X.
  28. 000073             10  Last-Name-Remainder    Pic X(24).
  29. 000074         05  First-Name  Pic X(15).
  30. 000075         05  Middle-Name Pic X(10).
  31. 000083     03  Address-Line-1      Pic X(50).
  32. 000085     03  Address-Line-2      Pic X(50).
  33. 000086     03  City                Pic X(40).
  34. 000087     03  State-Or-Country    Pic X(20).
  35. 000088     03  Postal-Code         Pic X(15).
  36. 000089     03  Home-Phone          Pic X(20).
  37. 000090     03  Work-Phone          Pic X(20).
  38. 000091     03  Other-Phone         Pic X(20).
  39. 000092     03  Start-Date          Pic 9(8).
  40. 000093     03  Last-Rent-Paid-Date Pic 9(8).
  41. 000094     03  Next-Rent-Due-Date  Pic 9(8).
  42. 000095     03  Rent-Amount         Pic 9(4)v99.
  43. 000096     03  Consignment-Percent Pic 9(3).
  44. 000097     03  Filler              Pic X(50).
  45. 000098 Working-Storage Section.
  46. 000116 01  Dealer-Status     Pic X(2) Value Spaces.
  47. 000240     88  Dealer-Success Value "00" Thru "09".
  48. 000279 01  Keyboard-Status.
  49. 000280     03  Accept-Status Pic 9.
  50. 000281     03  Function-Key  Pic X.
  51. 000282         88  F1-Pressed Value X"01".
  52. 000283         88  F2-Pressed Value X"02".
  53. 000284         88  F3-Pressed Value X"03".
  54. 000285         88  F4-Pressed Value X"04".
  55. 000286         88  F5-Pressed Value X"05".
  56. 000287         88  F6-Pressed Value X"06".
  57. 000288         88  F7-Pressed Value X"07".
  58. 000289     03  System-Use    Pic X.
  59. 000290 01  Cursor-Position.
  60. 000291     03  Cursor-Row    Pic 9(2) Value 1.
  61. 000292     03  Cursor-Column Pic 9(2) Value 1.
  62. 000293 01  Error-Message Pic X(50) Value Spaces.
  63. 000294 Screen Section.
  64. 000304 01  Data-Entry-Screen
  65. 000305     Blank Screen, Auto
  66. 000306     Foreground-Color is 7,
  67. 000307     Background-Color is 1. 
  68. 000308*
  69. 000309     03  Screen-Literal-Group.
  70. 000310         05  Line 01 Column 30 Value "Darlene's Treasures"
  71. 000311             Highlight Foreground-Color 4 Background-Color 1.
  72. 000312         05  Line 03 Column 30 Value "Tenant Entry Program"
  73. 000313             Highlight. 
  74. 000314         05  Line 4  Column 01  Value "Number: ".            
  75. 000315         05  Line 5  Column 01  Value "Name, Last: ".
  76. 000316         05  Line 5  Column 39  Value "First: ".
  77. 000317         05  Line 5  Column 62  Value "Middle: ".
  78. 000318         05  Line 6  Column 01  Value "Address 1: ".
  79. 000319         05  Line 7  Column 01  Value "Address 2: ".
  80. 000320         05  Line 8  Column 01  Value "City: ".
  81. 000321         05  Line 9  Column 01  Value "Country/State: ".
  82. 000322         05  Line 9  Column 36  Value "Postal Code: ".
  83. 000323         05  Line 11 Column 01  Value "Phone/Home: ".
  84. 000324         05  Line 11 Column 34  Value "Work: ".
  85. 000325         05  Line 12 Column 06  Value "Other: ".
  86. 000326         05  Line 14 Column 01  Value "Start Date: ".
  87. 000327         05  Line 14 Column 24  Value "Last Paid Date: ".
  88. 000328         05  Line 14 Column 51  Value "Next Rent Due on: ".
  89. 000329         05  Line 15 Column 01  Value "Rent Amount: ".
  90. 000330         05  Line 16 Column 01  Value "Consignment Percent: ".
  91. 000331         05  Line 22 Column 01  Value "F1-Read Random Number".
  92. 000332         05  Line 22 Column 23  Value "F2-Read Random Name".
  93. 000333         05  Line 22 Column 56  Value "F3-Read Next Number".
  94. 000334         05  Line 23 Column 01  Value "F4-Read Next Name".
  95. 000335         05  Line 23 Column 23  Value "F5-Clear".
  96. 000336         05  Line 23 Column 56  Value "F6-Read via First Letter".
  97. 000337         05  Line 24 Column 01  Value "F7-Exit".
  98. 000338     03  Required-Reverse-Group Reverse-Video.
  99. 000339         05  Line 4 Column 13  Pic X(8)  Using Dealer-Number.
  100. 000340         05  Line 5 Column 13  Pic X(25) Using Last-Name.
  101. 000341         05  Line 5 Column 46  Pic X(15) Using First-Name.
  102. 000342         05  Line 5  Column 70 Pic X(10) Using Middle-Name.
  103. 000343         05  Line 6  Column 15 Pic X(50) From Address-Line-1.
  104. 000344         05  Line 7  Column 15 Pic X(50) From Address-Line-2.
  105. 000345         05  Line 8  Column 15 Pic X(40) From City.
  106. 000346         05  Line 9  Column 15 Pic X(20) From State-Or-Country.
  107. 000347         05  Line 9  Column 50 Pic X(15) From Postal-Code.
  108. 000348         05  Line 11 Column 13 Pic X(20) From Home-Phone.
  109. 000349         05  Line 11 Column 41 Pic X(20) From Work-Phone.
  110. 000350         05  Line 12 Column 13 Pic X(20) From Other-phone.
  111. 000351         05  Line 14 Column 13 Pic 99/99/9999 From Start-Date.
  112. 000352         05  Line 14 Column 40 Pic 99/99/9999 From Last-Rent-Paid-Date.
  113. 000353         05  Line 14 Column 69 Pic 99/99/9999 From Next-Rent-Due-Date.
  114. 000354         05  Line 15 Column 14 Pic Z,ZZZ.99 From Rent-Amount.
  115. 000355         05  Line 16 Column 22 Pic ZZ9 From Consignment-Percent.
  116. 000356         05  Line 20 Column 01 Pic X(50) Using Error-Message.
  117. 000357*
  118. 000439 Procedure Division.
  119. 000440 Chapt15e-Start.
  120. 000441     Perform Open-File
  121. 000442     If Not Dealer-Success
  122. 000443        String "Error Opening Dealer File "
  123. 000448               Dealer-Status
  124. 000449               Delimited By Size
  125. 000450               Into Error-Message
  126. 000451        End-String
  127. 000452        Perform Display-And-Accept
  128. 000454     Else
  129. 000455        Initialize Dealer-Record
  130. 000456        Perform Process-File Until F7-Pressed
  131. 000457        Perform Close-File
  132. 000458     End-If
  133. 000459     Stop Run
  134. 000460     .
  135. 000461 Process-File.
  136. 000462     Perform Display-And-Accept
  137. 000463     Evaluate True
  138. 000464       When F1-Pressed
  139. 000465            Perform Read-Random-Number
  140. 000466       When F2-Pressed
  141. 000467            Perform Read-Random-Name
  142. 000468       When F3-Pressed
  143. 000469            Perform Read-Next-Number
  144. 000470       When F4-Pressed
  145. 000471            Perform Read-Next-Name
  146. 000472       When F5-Pressed
  147. 000473            Perform Clear-Screen
  148. 000474       When F6-Pressed
  149. 000475            Perform Read-Next-Letter
  150. 000476       When F7-Pressed
  151. 000477            Continue
  152. 000478       When Other
  153. 000479            Continue
  154. 000480     End-Evaluate
  155. 000481     .
  156. 000482 Read-Random-Number.
  157. 000483     Read Dealer-File
  158. 000484       Invalid Key
  159. 000485          String "Error on Random Read Number "
  160. 000486                 Dealer-Status
  161. 000487                 Delimited By Size
  162. 000488                 Into Error-Message
  163. 000489     End-Read
  164. 000490     .
  165. 000491 Read-Random-Name.
  166. 000492     Read Dealer-File Key Dealer-Name
  167. 000493       Invalid Key
  168. 000494          String "Error on Random Read Name "
  169. 000495                 Dealer-Status
  170. 000496                 Delimited By Size
  171. 000497                 Into Error-Message
  172. 000498     End-Read
  173. 000499     .
  174. 000500 Read-Next-Number.
  175. 000501     Start Dealer-File Key > Dealer-Number
  176. 000502      Invalid Key
  177. 000503         String "Start Error Number "
  178. 000504                Dealer-Status
  179. 000505                Delimited By Size
  180. 000506                Into Error-Message
  181. 000507     End-Start
  182. 000508     If Dealer-Success
  183. 000509       Read Dealer-File Next
  184. 000510          At End
  185. 000511             Move "End of File, Read by Number" To Error-Message
  186. 000514       End-Read
  187. 000515     End-If
  188. 000516     .
  189. 000517 Read-Next-Name.
  190. 000518     Start Dealer-File Key > Dealer-Name
  191. 000519      Invalid Key
  192. 000520         String "Start Error Name "
  193. 000521                Dealer-Status
  194. 000522                Delimited By Size
  195. 000523                Into Error-Message
  196. 000524     End-Start
  197. 000525     If Dealer-Success
  198. 000526       Read Dealer-File Next
  199. 000527          At End
  200. 000528             Move "End of File, Read by Name" To Error-Message
  201. 000529       End-Read
  202. 000534     End-If
  203. 000535     .
  204. 000536 Read-Next-Letter.
  205. 000537     Start Dealer-File Key > Last-Name-First-Letter
  206. 000538      Invalid Key
  207. 000539         String "Start Error First Letter "
  208. 000540                Dealer-Status
  209. 000541                Delimited By Size
  210. 000542                Into Error-Message
  211. 000543     End-Start
  212. 000544     If Dealer-Success
  213. 000545       Read Dealer-File Next
  214. 000546          At End
  215. 000547             Move "End of File, Read by Name" To Error-Message
  216. 000548       End-Read
  217. 000549     End-If
  218. 000550     .
  219. 000551 Clear-Screen.
  220. 000553     Initialize Dealer-Record
  221. 000554     Move 01 To Cursor-Row Cursor-Column
  222. 000555     .
  223. 000556 Display-And-Accept.
  224. 000557     Display Data-Entry-Screen
  225. 000558     Accept Data-Entry-Screen
  226. 000559     Move Spaces To Error-Message
  227. 000560     .
  228. 000561 Open-File.
  229. 000562     Open Input Dealer-File
  230. 000563     .
  231. 000564 Close-File.
  232. 000565     Close Dealer-File
  233. 000566     .
  234.