home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch15 / chapt15d.cob < prev    next >
Text File  |  1998-10-05  |  9KB  |  211 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt15d.
  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   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. 000116 01  Dealer-Status     Pic X(2) Value Spaces.
  45. 000240     88  Dealer-Success Value "00" Thru "09".
  46. 000279 01  Keyboard-Status.
  47. 000280     03  Accept-Status Pic 9.
  48. 000281     03  Function-Key  Pic X.
  49. 000282         88  F1-Pressed Value X"01".
  50. 000283         88  F2-Pressed Value X"02".
  51. 000284         88  F3-Pressed Value X"03".
  52. 000285         88  F4-Pressed Value X"04".
  53. 000286         88  F5-Pressed Value X"05".
  54. 000287         88  F6-Pressed Value X"06".
  55. 000289     03  System-Use    Pic X.
  56. 000290 01  Cursor-Position.
  57. 000291     03  Cursor-Row    Pic 9(2) Value 1.
  58. 000292     03  Cursor-Column Pic 9(2) Value 1.
  59. 000293 01  Error-Message Pic X(50) Value Spaces.
  60. 000294 Screen Section.
  61. 000442 01  Data-Entry-Screen
  62. 000443     Blank Screen, Auto
  63. 000444     Foreground-Color is 7,
  64. 000445     Background-Color is 1. 
  65. 000447     03  Screen-Literal-Group.
  66. 000448         05  Line 01 Column 30 Value "Darlene's Treasures"
  67. 000449             Highlight Foreground-Color 4 Background-Color 1.
  68. 000450         05  Line 03 Column 30 Value "Tenant Entry Program"
  69. 000451             Highlight. 
  70. 000452         05  Line 4  Column 01  Value "Number: ".            
  71. 000453         05  Line 5  Column 01  Value "Name, Last: ".
  72. 000454         05  Line 5  Column 39  Value "First: ".
  73. 000455         05  Line 5  Column 62  Value "Middle: ".
  74. 000456         05  Line 6  Column 01  Value "Address 1: ".
  75. 000457         05  Line 7  Column 01  Value "Address 2: ".
  76. 000458         05  Line 8  Column 01  Value "City: ".
  77. 000459         05  Line 9  Column 01  Value "Country/State: ".
  78. 000460         05  Line 9  Column 36  Value "Postal Code: ".
  79. 000461         05  Line 11 Column 01  Value "Phone/Home: ".
  80. 000462         05  Line 11 Column 34  Value "Work: ".
  81. 000463         05  Line 12 Column 06  Value "Other: ".
  82. 000464         05  Line 14 Column 01  Value "Start Date: ".
  83. 000465         05  Line 14 Column 24  Value "Last Paid Date: ".
  84. 000466         05  Line 14 Column 51  Value "Next Rent Due on: ".
  85. 000467         05  Line 15 Column 01  Value "Rent Amount: ".
  86. 000468         05  Line 16 Column 01  Value "Consignment Percent: ".
  87. 000469         05  Line 22 Column 01  Value "F1-Read Random Number".
  88. 000470         05  Line 22 Column 23  Value "F2-Read Random Name".
  89. 000471         05  Line 22 Column 56  Value "F3-Read Next Number".
  90. 000472         05  Line 23 Column 01  Value "F4-Read Next Name".
  91. 000473         05  Line 23 Column 23  Value "F5-Clear".
  92. 000474         05  Line 23 Column 56  Value "F6-Exit".
  93. 000475     03  Required-Reverse-Group Reverse-Video.
  94. 000476         05  Line 4 Column 13  Pic X(8)  Using Dealer-Number.
  95. 000477         05  Line 5 Column 13  Pic X(25) Using Last-Name.
  96. 000478         05  Line 5 Column 46  Pic X(15) Using First-Name.
  97. 000479         05  Line 5  Column 70 Pic X(10) Using Middle-Name.
  98. 000480         05  Line 6  Column 15 Pic X(50) From Address-Line-1.
  99. 000481         05  Line 7  Column 15 Pic X(50) From Address-Line-2.
  100. 000482         05  Line 8  Column 15 Pic X(40) From City.
  101. 000483         05  Line 9  Column 15 Pic X(20) From State-Or-Country.
  102. 000484         05  Line 9  Column 50 Pic X(15) From Postal-Code.
  103. 000485         05  Line 11 Column 13 Pic X(20) From Home-Phone.
  104. 000486         05  Line 11 Column 41 Pic X(20) From Work-Phone.
  105. 000487         05  Line 12 Column 13 Pic X(20) From Other-Phone.
  106. 000488         05  Line 14 Column 13 Pic 99/99/9999 From Start-Date.
  107. 000489         05  Line 14 Column 40 Pic 99/99/9999 From Last-Rent-Paid-Date.
  108. 000490         05  Line 14 Column 69 Pic 99/99/9999 From Next-Rent-Due-Date.
  109. 000491         05  Line 15 Column 14 Pic Z,ZZZ.99 From Rent-Amount.
  110. 000492         05  Line 16 Column 22 Pic ZZ9 From Consignment-Percent.
  111. 000493         05  Line 20 Column 01 Pic X(50) Using Error-Message.
  112. 000496 Procedure Division.
  113. 000497 Chapt15d-Start.
  114. 000498     Perform Open-File
  115. 000499     If Not Dealer-Success
  116. 000500        String "Error Opening Dealer File "
  117. 000501               Dealer-Status
  118. 000502               Delimited By Size
  119. 000503               Into Error-Message
  120. 000504        End-String
  121. 000505        Perform Display-And-Accept
  122. 000506     Else
  123. 000507        Initialize Dealer-Record
  124. 000508        Perform Process-File Until F6-Pressed
  125. 000509        Perform Close-File
  126. 000510     End-If
  127. 000511     Stop Run
  128. 000512     .
  129. 000513 Process-File.
  130. 000514     Perform Display-And-Accept
  131. 000515     Evaluate True
  132. 000516       When F1-Pressed
  133. 000517            Perform Read-Random-Number
  134. 000518       When F2-Pressed
  135. 000519            Perform Read-Random-Name
  136. 000520       When F3-Pressed
  137. 000521            Perform Read-Next-Number
  138. 000522       When F4-Pressed
  139. 000523            Perform Read-Next-Name
  140. 000524       When F5-Pressed
  141. 000525            Perform Clear-Screen
  142. 000526       When F6-Pressed
  143. 000527            Continue
  144. 000528       When Other
  145. 000529            Continue
  146. 000530     End-Evaluate
  147. 000531     .
  148. 000532 Read-Random-Number.
  149. 000533     Read Dealer-File
  150. 000534       Invalid Key
  151. 000535          String "Error on Random Read Number "
  152. 000536                 Dealer-Status
  153. 000537                 Delimited By Size
  154. 000538                 Into Error-Message
  155. 000539     End-Read
  156. 000540     .
  157. 000541 Read-Random-Name.
  158. 000542     Read Dealer-File Key Dealer-Name
  159. 000543       Invalid Key
  160. 000544          String "Error on Random Read Name "
  161. 000545                 Dealer-Status
  162. 000546                 Delimited By Size
  163. 000547                 Into Error-Message
  164. 000548     End-Read
  165. 000549     .
  166. 000550 Read-Next-Number.
  167. 000551     Start Dealer-File Key > Dealer-Number
  168. 000552      Invalid Key
  169. 000553         String "Start Error Number "
  170. 000554                Dealer-Status
  171. 000555                Delimited By Size
  172. 000556                Into Error-Message
  173. 000557     End-Start
  174. 000558     If Dealer-Success
  175. 000559       Read Dealer-File Next
  176. 000560          At End
  177. 000561             Move "End of File, Read by Number" To Error-Message
  178. 000562       End-Read
  179. 000563     End-If
  180. 000564     .
  181. 000565 Read-Next-Name.
  182. 000566     Start Dealer-File Key > Dealer-Name
  183. 000567      Invalid Key
  184. 000568         String "Start Error Name "
  185. 000569                Dealer-Status
  186. 000570                Delimited By Size
  187. 000571                Into Error-Message
  188. 000572     End-Start
  189. 000573     If Dealer-Success
  190. 000574       Read Dealer-File Next
  191. 000575          At End
  192. 000576             Move "End of File, Read by Name" To Error-Message
  193. 000577       End-Read
  194. 000578     End-If
  195. 000579     .
  196. 000580 Clear-Screen.
  197. 000581     Initialize Dealer-Record
  198. 000582     Move 01 To Cursor-Row Cursor-Column
  199. 000583     .
  200. 000584 Display-And-Accept.
  201. 000585     Display Data-Entry-Screen
  202. 000586     Accept Data-Entry-Screen
  203. 000587     Move Spaces To Error-Message
  204. 000588     .
  205. 000589 Open-File.
  206. 000590     Open Input Dealer-File
  207. 000591     .
  208. 000592 Close-File.
  209. 000593     Close Dealer-File
  210. 000594     .
  211.