home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch19 / chapt19x.cob < prev   
Encoding:
Text File  |  1998-09-28  |  8.2 KB  |  202 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt19x.
  4. 000031* Chapter 19 Exercise Answer
  5. 000043 Environment Division.
  6. 000050 Configuration Section.
  7. 000055 Source-Computer.  IBM-PC.
  8. 000056 Object-Computer.  IBM-PC.
  9. 000061 Input-Output  Section.
  10. 000062 File-Control.
  11. 000063     Select Report-File Assign To Printer.
  12. 000066     Select Dealer-File Assign To "Dealer.Dat"
  13. 000067         Organization Indexed
  14. 000068         Access Sequential
  15. 000069         Record Key Dealer-Number
  16. 000070         Alternate Record Key Dealer-Name Of Dealer-Record
  17. 000071         File Status Dealer-Status.
  18. 000072     Select Sort-File Assign To Sort-Work.
  19. 000076 Data Division.
  20. 000077 File Section.
  21. 000078 Fd  Report-File.
  22. 000079 01  Report-Record Pic X(80).
  23. 000093 Fd  Dealer-File.
  24. 000094 01  Dealer-Record.
  25. 000095     03  Dealer-Number         Pic X(8).
  26. 000096     03  Dealer-Name.
  27. 000097         05  Last-Name   Pic X(25).
  28. 000098         05  First-Name  Pic X(15).
  29. 000099         05  Middle-Name Pic X(10).
  30. 000100     03  Address-Line-1      Pic X(50).
  31. 000101     03  Address-Line-2      Pic X(50).
  32. 000102     03  City                Pic X(40).
  33. 000103     03  State-Or-Country    Pic X(20).
  34. 000104     03  Postal-Code         Pic X(15).
  35. 000105     03  Home-Phone          Pic X(20).
  36. 000106     03  Work-Phone          Pic X(20).
  37. 000107     03  Other-Phone         Pic X(20).
  38. 000108     03  Start-Date          Pic 9(8).
  39. 000109     03  Last-Rent-Paid-Date Pic 9(8).
  40. 000110     03  Next-Rent-Due-Date  Pic 9(8).
  41. 000111     03  Rent-Amount         Pic 9(4)v99.
  42. 000112     03  Consignment-Percent Pic 9(3).
  43. 000113     03  Last-Sold-Amount    Pic S9(7)v99.
  44. 000114     03  Last-Sold-Date      Pic 9(8).
  45. 000115     03  Sold-To-Date        Pic S9(7)v99.
  46. 000116     03  Commission-To-Date  Pic S9(7)v99.
  47. 000117     03  Filler              Pic X(15).
  48. 000127 Sd  Sort-File.
  49. 000137 01  Sort-Record.
  50. 000138* It Is Not Necessary To Duplicate The Entire Dealer File In The Sort,
  51. 000139* As We Are Going To Only Use A Few Fields.  This Will Make The Sort Faster.
  52. 000141     03  Dealer-Name.
  53. 000142         05  Last-Name       Pic X(25).
  54. 000143         05  First-Name      Pic X(15).
  55. 000144         05  Middle-Name     Pic X(10).
  56. 000145     03  Last-Rent-Paid-Date Pic 9(8).
  57. 000146     03  Next-Rent-Due-Date  Pic 9(8).
  58. 000147     03  Rent-Amount         Pic 9(4)v99.
  59. 000148 Working-Storage Section.
  60. 000206 01  Dealer-Status           Pic XX Value Zeros.
  61. 000207     88  Dealer-Success  Value "00" Thru "09".
  62. 000209 01  Heading-Line-1.
  63. 000210     03  Filler      Pic X(12) Value "Created by:".
  64. 000211     03  Filler      Pic X(8)  Value "CHAPT19X".
  65. 000212     03  Filler      Pic X(11) Value Spaces.
  66. 000213     03  Filler      Pic X(23) Value "Dealer File Rent Report".
  67. 000214     03  Filler      Pic X(10) Value Spaces.
  68. 000215     03  Filler      Pic X(5)  Value "Page".
  69. 000216     03  Page-No     Pic Z(4)9 Value Zeros.
  70. 000217 01  Heading-Line-2.
  71. 000218     03  Filler      Pic X(12) Value "Created on:".
  72. 000219     03  Date-MM     Pic 99.
  73. 000220     03  Filler      Pic X     Value "/".
  74. 000221     03  Date-DD     Pic 99.
  75. 000222     03  Filler      Pic X     Value "/".
  76. 000223     03  Date-YY     Pic 99.
  77. 000224 01  Heading-Line-3.
  78. 000225     03  Filler      Pic X(12) Value "At:".
  79. 000226     03  Time-HH     Pic 99.
  80. 000227     03  Filler      Pic X     Value ":".
  81. 000228     03  Time-MM     Pic 99.
  82. 000229     03  Filler      Pic X     Value ":".
  83. 000230     03  Time-SS     Pic 99.
  84. 000231 01  Heading-Line-4.
  85. 000232     03  Filler      Pic X(41) Value Spaces.
  86. 000233     03  Filler      Pic X(27) Value "Last Rent  Next Rent".
  87. 000234     03  Filler      Pic X(4)  Value "Rent".
  88. 000235 01  Heading-Line-5.
  89. 000236     03  Filler   Pic X(44) Value "Name".
  90. 000237     03  Filler   Pic X(29) Value "Paid       Due         Amount".
  91. 000238 01  Detail-Line.
  92. 000239     03  Detail-Name         Pic X(40)       Value Spaces.
  93. 000240     03  Filler              Pic X           Value Spaces.
  94. 000241     03  Last-Rent-Paid-Date Pic 99/99/9999.
  95. 000242     03  Filler              Pic X           Value Spaces.
  96. 000243     03  Next-Rent-Due-Date  Pic 99/99/9999.
  97. 000244     03  Filler              Pic X           Value Spaces.
  98. 000245     03  Rent-Amount         Pic $$$,$$$.99.
  99. 000246 01  Line-Count           Pic 99          Value 99.
  100. 000247 01  Page-Count           Pic 9(4)        Value Zeros.
  101. 000248 01  Max-Lines            Pic 99          Value 60.
  102. 000249 01  Date-And-Time-Area.
  103. 000250     03  Work-Date            Pic 9(6).
  104. 000251     03  Work-Date-X          Redefines Work-Date.
  105. 000252         05  Date-YY          Pic 99.
  106. 000253         05  Date-MM          Pic 99.
  107. 000254         05  Date-DD          Pic 99.
  108. 000255     03  Work-Time            Pic 9(8).
  109. 000256     03  Work-Time-X          Redefines Work-Time.
  110. 000257         05  Time-HH          Pic 99.
  111. 000258         05  Time-MM          Pic 99.
  112. 000259         05  Time-SS          Pic 99.
  113. 000260         05  Filler           Pic XX.
  114. 000261 01  Done-Flag            Pic X Value Spaces.
  115. 000262     88  All-Done               Value "Y".
  116. 000263 Procedure Division.
  117. 000264 Declaratives.
  118. 000265 Dealer-File-Error Section.
  119. 000266     Use After Standard Error Procedure On Dealer-File
  120. 000267     .
  121. 000268 Dealer-Error-Paragraph.
  122. 000269     Display "Error on Dealer File " Dealer-Status
  123. 000270     .
  124. 000271 End Declaratives.
  125. 000272 Chapt19x-Start.
  126. 000273     Display "Begin Process Chapt19x"
  127. 000274     Sort Sort-File Descending Key Rent-Amount Of Sort-Record
  128. 000275          Input Procedure Sort-In
  129. 000276          Output Procedure Print-Report
  130. 000277     Stop Run
  131. 000278     .
  132. 000279 Sort-In.
  133. 000280     Open Input Dealer-File
  134. 000281* No Need To Do A "Start", We Have A Sort!
  135. 000282     Perform Until Not Dealer-Success
  136. 000283        Read Dealer-File
  137. 000284          At End Continue
  138. 000285          Not At End
  139. 000286* No Need To Release It To The Sort If Its Not $40.00 Or More.
  140. 000287              If Rent-Amount Of Dealer-Record >= 40
  141. 000288                 Move Corresponding Dealer-Record To Sort-Record
  142. 000289                 Release Sort-Record
  143. 000290              End-If
  144. 000291        End-Read
  145. 000292     End-Perform
  146. 000293     Close Dealer-File
  147. 000294     .
  148. 000295 Print-Report.
  149. 000296     Open Output Report-File
  150. 000297     Perform Fill-Initial-Headings
  151. 000298     Perform Until All-Done
  152. 000299        Return Sort-File
  153. 000300            At End Set All-Done To True
  154. 000301            Not At End
  155. 000302                Perform Print-This-Record
  156. 000303        End-Return
  157. 000304     End-Perform
  158. 000305     Close Report-File
  159. 000306     .
  160. 000319 Print-This-Record.
  161. 000320     Perform Format-Name
  162. 000321     Move Corresponding Sort-Record To Detail-Line
  163. 000322     If Line-Count >= Max-Lines
  164. 000323        Perform Heading-Routine
  165. 000324     End-If
  166. 000325     Write Report-Record From Detail-Line After 1
  167. 000326     Add 1 To Line-Count
  168. 000327     .
  169. 000328 Heading-Routine.
  170. 000329     Add 1 To Page-Count
  171. 000330     Move Page-Count To Page-No
  172. 000331     If Page-Count = 1
  173. 000332        Write Report-Record From Heading-Line-1 After Zero
  174. 000333     Else
  175. 000334        Write Report-Record From Heading-Line-1 After Page
  176. 000335     End-If
  177. 000336     Write Report-Record From Heading-Line-2 After 1
  178. 000337     Write Report-Record From Heading-Line-3 After 1
  179. 000338     Write Report-Record From Heading-Line-4 After 2
  180. 000339     Write Report-Record From Heading-Line-5 After 1
  181. 000340     Write Report-Record From Heading-Line-5 Before 2
  182. 000341     Move 7 To Line-Count
  183. 000342     .
  184. 000343 Format-Name.
  185. 000344     Move Spaces To Detail-Name
  186. 000345     String First-Name  Of Sort-Record Delimited By Space
  187. 000346            " "         Delimited By Size
  188. 000347            Middle-Name Of Sort-Record Delimited By Space
  189. 000348            " "         Delimited By Size
  190. 000349            Last-Name   Of Sort-Record Delimited By Space
  191. 000350            Into Detail-Name
  192. 000351     End-String
  193. 000352     .
  194. 000353 Fill-Initial-Headings.
  195. 000354     Accept Work-Date From Date
  196. 000355     Accept Work-Time From Time
  197. 000356     Move Corresponding Work-Date-X To
  198. 000357                        Heading-Line-2
  199. 000358     Move Corresponding Work-Time-X To
  200. 000359                        Heading-Line-3
  201. 000360     .
  202.