home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch15 / CHAPT15X.COB < prev   
Text File  |  1998-09-14  |  13KB  |  271 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt15x.
  4. 000031* Chapter 15 Exercise Solution
  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 Sequential
  17. 000062            Record Key Dealer-Number Of Dealer-Record
  18. 000063            Alternate Record Key Dealer-Name Of Dealer-Record
  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. 000074         05  First-Name  Pic X(15).
  28. 000075         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. 000108 01  Match-Flag        Pic X Value Spaces.
  45. 000109     88  Match-Found   Value "M".
  46. 000110     88  End-Of-File   Value "E".
  47. 000111* The Initialization Of Match-Name To Spaces Is Important In Case They
  48. 000112* Press The Find Next, Without Ever Entering Any Match Criteria.
  49. 000113 01  Match-Name        Value Spaces.
  50. 000114     03  Match-Last    Pic X(25).
  51. 000115     03  Match-First   Pic X(15).
  52. 000116     03  Match-Middle  Pic X(10).
  53. 000118 01  Dealer-Status     Pic X(2) Value Spaces.
  54. 000240     88  Dealer-Success Value "00" Thru "09".
  55. 000279 01  Keyboard-Status.
  56. 000280     03  Accept-Status Pic 9.
  57. 000281     03  Function-Key  Pic X.
  58. 000282         88  F1-Pressed Value X"01".
  59. 000283         88  F2-Pressed Value X"02".
  60. 000284         88  F3-Pressed Value X"03".
  61. 000285         88  F4-Pressed Value X"04".
  62. 000286     03  System-Use    Pic X.
  63. 000290 01  Cursor-Position.
  64. 000291     03  Cursor-Row    Pic 9(2) Value 1.
  65. 000292     03  Cursor-Column Pic 9(2) Value 1.
  66. 000293 01  Eof-Message   Pic X(11) Value "End Of File".
  67. 000294 01  Error-Message Pic X(50) Value Spaces.
  68. 000295* A Working Storage Record Is Used, Because We Are Reading Multiple
  69. 000296* Records From The File, But Not Necessarying Displaying Them.
  70. 000297* If We Did Not Use A Separate Area, The Last Record Displayed Would Not
  71. 000298* Remain When We Fail To Find Another Match.
  72. 000299 01  Dealer-Work.
  73. 000300     03  Dealer-Number         Pic X(8)  Value Spaces.
  74. 000301     03  Dealer-Name                     Value Spaces.
  75. 000302         05  Last-Name   Pic X(25).
  76. 000303         05  First-Name  Pic X(15).
  77. 000304         05  Middle-Name Pic X(10).
  78. 000305     03  Address-Line-1      Pic X(50)   Value Spaces.
  79. 000306     03  Address-Line-2      Pic X(50)   Value Spaces.
  80. 000307     03  City                Pic X(40)   Value Spaces.
  81. 000308     03  State-Or-Country    Pic X(20)   Value Spaces.
  82. 000309     03  Postal-Code         Pic X(15)   Value Spaces.
  83. 000310     03  Home-Phone          Pic X(20)   Value Spaces.
  84. 000311     03  Work-Phone          Pic X(20)   Value Spaces.
  85. 000312     03  Other-Phone         Pic X(20)   Value Spaces.
  86. 000313     03  Start-Date          Pic 9(8)    Value Zeros.
  87. 000314     03  Last-Rent-Paid-Date Pic 9(8)    Value Zeros.
  88. 000315     03  Next-Rent-Due-Date  Pic 9(8)    Value Zeros.
  89. 000316     03  Rent-Amount         Pic 9(4)v99 Value Zeros.
  90. 000317     03  Consignment-Percent Pic 9(3)    Value Zeros.
  91. 000318     03  Filler              Pic X(50)   Value Spaces.
  92. 000319 Screen Section.
  93. 000321 01  Data-Entry-Screen
  94. 000322     Blank Screen, Auto
  95. 000323     Foreground-Color Is 7,
  96. 000324     Background-Color Is 1.
  97. 000325*
  98. 000326     03  Screen-Literal-Group.
  99. 000327         05  Line 01 Column 30 Value "Darlene's Treasures"
  100. 000328             Highlight Foreground-Color 4 Background-Color 1.
  101. 000329         05  Line 03 Column 30 Value "Tenant Entry Program"
  102. 000330             Highlight.
  103. 000331         05  Line 4  Column 01  Value "Number: ".
  104. 000332         05  Line 5  Column 01  Value "Name, Last: ".
  105. 000333         05  Line 5  Column 39  Value "First: ".
  106. 000334         05  Line 5  Column 62  Value "Middle: ".
  107. 000335         05  Line 6  Column 01  Value "Address 1: ".
  108. 000336         05  Line 7  Column 01  Value "Address 2: ".
  109. 000337         05  Line 8  Column 01  Value "City: ".
  110. 000338         05  Line 9  Column 01  Value "Country/State: ".
  111. 000339         05  Line 9  Column 36  Value "Postal Code: ".
  112. 000340         05  Line 11 Column 01  Value "Phone/Home: ".
  113. 000341         05  Line 11 Column 34  Value "Work: ".
  114. 000342         05  Line 12 Column 06  Value "Other: ".
  115. 000343         05  Line 14 Column 01  Value "Start Date: ".
  116. 000344         05  Line 14 Column 24  Value "Last Paid Date: ".
  117. 000345         05  Line 14 Column 51  Value "Next Rent Due on: ".
  118. 000346         05  Line 15 Column 01  Value "Rent Amount: ".
  119. 000347         05  Line 16 Column 01  Value "Consignment Percent: ".
  120. 000348         05  Line 22 Column 01  Value "F1-Find New Match".
  121. 000349         05  Line 22 Column 23  Value "F2-Find Next Match".
  122. 000350         05  Line 22 Column 56  Value "F3-Clear".
  123. 000351         05  Line 23 Column 01  Value "F4-Exit".
  124. 000354     03  Required-Reverse-Group Reverse-Video.
  125. 000355         05  Line 4 Column 13  Pic X(8)  From Dealer-Number
  126. 000356                    Of Dealer-Work.
  127. 000357         05  Line 5 Column 13  Pic X(25) Using Last-Name
  128. 000358                    Of Dealer-Work.
  129. 000360         05  Line 5 Column 46  Pic X(15) Using First-Name
  130. 000361                    Of Dealer-Work.
  131. 000362         05  Line 5  Column 70 Pic X(10) Using Middle-Name
  132. 000363                    Of Dealer-Work.
  133. 000364         05  Line 6  Column 15 Pic X(50) From Address-Line-1
  134. 000365                    Of Dealer-Work.
  135. 000366         05  Line 7  Column 15 Pic X(50) From Address-Line-2
  136. 000367                    Of Dealer-Work.
  137. 000368         05  Line 8  Column 15 Pic X(40) From City
  138. 000369                    Of Dealer-Work.
  139. 000370         05  Line 9  Column 15 Pic X(20) From State-Or-Country
  140. 000371                    Of Dealer-Work.
  141. 000372         05  Line 9  Column 50 Pic X(15) From Postal-Code
  142. 000373                    Of Dealer-Work.
  143. 000374         05  Line 11 Column 13 Pic X(20) From Home-Phone
  144. 000375                    Of Dealer-Work.
  145. 000376         05  Line 11 Column 41 Pic X(20) From Work-Phone
  146. 000377                    Of Dealer-Work.
  147. 000378         05  Line 12 Column 13 Pic X(20) From Other-Phone
  148. 000379                    Of Dealer-Work.
  149. 000380         05  Line 14 Column 13 Pic 99/99/9999 From Start-Date
  150. 000381                    Of Dealer-Work.
  151. 000382         05  Line 14 Column 40 Pic 99/99/9999
  152. 000383                    From Last-Rent-Paid-Date Of Dealer-Work.
  153. 000385         05  Line 14 Column 69 Pic 99/99/9999
  154. 000386                    From Next-Rent-Due-Date Of Dealer-Work.
  155. 000388         05  Line 15 Column 14 Pic Z,ZZZ.99 From Rent-Amount
  156. 000389                    Of Dealer-Work.
  157. 000390         05  Line 16 Column 22 Pic ZZ9 From Consignment-Percent
  158. 000391                    Of Dealer-Work.
  159. 000392         05  Line 20 Column 01 Pic X(50) Using Error-Message.
  160. 000393*
  161. 000394 Procedure Division.
  162. 000395 Chapt15x-Start.
  163. 000408     Perform Open-File
  164. 000418     If Not Dealer-Success
  165. 000438        String "Error Opening Dealer File "
  166. 000448               Dealer-Status
  167. 000449               Delimited By Size
  168. 000450               Into Error-Message
  169. 000451        End-String
  170. 000452        Perform Display-And-Accept
  171. 000454     Else
  172. 000455        Perform Process-File Until F4-Pressed
  173. 000457        Perform Close-File
  174. 000458     End-If
  175. 000459     Stop Run
  176. 000460     .
  177. 000461 Process-File.
  178. 000462     Perform Display-And-Accept
  179. 000463     Evaluate True
  180. 000464       When F1-Pressed
  181. 000465            Perform Find-First-Match
  182. 000466       When F2-Pressed
  183. 000467* If We Already Reached The End Of The File, We Don't Want
  184. 000468* To Attempt To Read Another Record.  Since The Error Message
  185. 000469* Gets Cleared After Every Accept, We Have To Put It Back If It
  186. 000470* Is End Of File
  187. 000471            If End-Of-File
  188. 000472               Move Eof-Message To Error-Message
  189. 000473            Else
  190. 000475               Move Spaces To Match-Flag
  191. 000476               Perform Find-Next-Match Until Match-Found Or
  192. 000477                                             End-Of-File
  193. 000478            End-If
  194. 000479       When F3-Pressed
  195. 000480            Perform Clear-Screen
  196. 000481* The F4-Pressed Condition Could Be Detected With Other, But This
  197. 000482* Method Is A Little Clearer
  198. 000483       When F4-Pressed
  199. 000484            Continue
  200. 000485       When Other
  201. 000486            Continue
  202. 000487     End-Evaluate
  203. 000488     .
  204. 000489 Find-First-Match.
  205. 000490     Move Corresponding
  206. 000491          Dealer-Name Of Dealer-Work To
  207. 000492          Dealer-Name Of Dealer-Record
  208. 000494     Move First-Name Of Dealer-Work To Match-First
  209. 000495     Move Middle-Name Of Dealer-Work To Match-Middle
  210. 000496     Move Last-Name Of Dealer-Work To Match-Last
  211. 000497* Start The File Based On The Name Key.  If They Entered A Last Name
  212. 000498* All The Better, Because It Will Save Processing.  If They Did Not Enter
  213. 000499* A Last Name We Will Be Processing From The Beginning Of The File
  214. 000500
  215. 000501* The "Not <" Is Used So That If All Three Names Are Entered, You Will
  216. 000502* Position The File On That Record And Not On A Later One, As Would Happen
  217. 000503* If You Used > In The Start.
  218. 000504     Start Dealer-File Key Not < Dealer-Name Of Dealer-Record
  219. 000505           Invalid Key
  220. 000506             String "Error Starting Dealer File " Dealer-Status
  221. 000507                    Delimited By Size Into Error-Message
  222. 000508           Not Invalid Key
  223. 000509             Move Spaces To Match-Flag
  224. 000510             Perform Find-Next-Match Until Match-Found Or
  225. 000511                                           End-Of-File
  226. 000512     End-Start
  227. 000513     .
  228. 000514 Find-Next-Match.
  229. 000515     Read Dealer-File Next Record
  230. 000523          At End Set End-Of-File To True
  231. 000524                 Move Eof-Message To Error-Message
  232. 000533          Not At End
  233. 000534* Determine If All Of The Search Names That Were Entered,
  234. 000535* Match The Search Names In The Record Retrieved
  235. 000540         Evaluate True
  236. 000541            When Match-First Not = Spaces And
  237. 000542                 Match-First Not = First-Name Of Dealer-Record
  238. 000543            When Match-Last Not = Spaces And
  239. 000544                 Match-Last Not = Last-Name Of Dealer-Record
  240. 000545            When Match-Middle Not = Spaces And
  241. 000546                 Match-Middle Not = Middle-Name Of Dealer-Record
  242. 000547                 Move Spaces To Match-Flag
  243. 000548            When Other
  244. 000549                 Set Match-Found To True
  245. 000550* Found A Match, Move In That Record!
  246. 000551                 Move Dealer-Record To Dealer-Work
  247. 000552         End-Evaluate
  248. 000553*
  249. 000554* This Evaluate Is A Very Efficient Way To Test And Determine If
  250. 000555* This Record Matches The Entered Criteria.  It Uses "negative logic"
  251. 000556* Which Confuses Some Programmer, But Consider What You Are Trying To Do.
  252. 000557* The Stacked When Statements Are All Of The Conditions When The Match Is
  253. 000558* Not Made, Anything Else Is A Match.
  254. 000559*
  255. 000561     End-Read
  256. 000562     .
  257. 000563 Clear-Screen.
  258. 000564     Initialize Dealer-Work
  259. 000565     Move 01 To Cursor-Row Cursor-Column
  260. 000566     .
  261. 000567 Display-And-Accept.
  262. 000568     Display Data-Entry-Screen
  263. 000569     Accept Data-Entry-Screen
  264. 000570     Move Spaces To Error-Message
  265. 000571     .
  266. 000572 Open-File.
  267. 000573     Open Input Dealer-File
  268. 000574     .
  269. 000575 Close-File.
  270. 000576     Close Dealer-File
  271. 000577     .