home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch19 / CHAPT19B.COB < prev    next >
Encoding:
Text File  |  1998-09-15  |  7.3 KB  |  184 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt19b.
  4. 000031* Simple Report - Some Data Selection
  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
  17. 000071         File Status Dealer-Status.
  18. 000076 Data Division.
  19. 000077 File Section.
  20. 000078 Fd  Report-File.
  21. 000079 01  Report-Record Pic X(80).
  22. 000093 Fd  Dealer-File.
  23. 000094 01  Dealer-Record.
  24. 000095     03  Dealer-Number         Pic X(8).
  25. 000096     03  Dealer-Name.
  26. 000097         05  Last-Name   Pic X(25).
  27. 000098         05  First-Name  Pic X(15).
  28. 000099         05  Middle-Name Pic X(10).
  29. 000100     03  Address-Line-1      Pic X(50).
  30. 000101     03  Address-Line-2      Pic X(50).
  31. 000102     03  City                Pic X(40).
  32. 000103     03  State-Or-Country    Pic X(20).
  33. 000104     03  Postal-Code         Pic X(15).
  34. 000105     03  Home-Phone          Pic X(20).
  35. 000106     03  Work-Phone          Pic X(20).
  36. 000107     03  Other-Phone         Pic X(20).
  37. 000108     03  Start-Date          Pic 9(8).
  38. 000109     03  Last-Rent-Paid-Date Pic 9(8).
  39. 000110     03  Next-Rent-Due-Date  Pic 9(8).
  40. 000111     03  Rent-Amount         Pic 9(4)v99.
  41. 000112     03  Consignment-Percent Pic 9(3).
  42. 000113     03  Last-Sold-Amount    Pic S9(7)v99.
  43. 000114     03  Last-Sold-Date      Pic 9(8).
  44. 000115     03  Sold-To-Date        Pic S9(7)v99.
  45. 000116     03  Commission-To-Date  Pic S9(7)v99.
  46. 000117     03  Filler              Pic X(15).
  47. 000144 Working-Storage Section.
  48. 000206 01  Dealer-Status           Pic XX Value Zeros.
  49. 000207     88  Dealer-Success  Value "00" Thru "09".
  50. 000209 01  Heading-Line-1.
  51. 000210     03  Filler      Pic X(12) Value "Created by:".
  52. 000211     03  Filler      Pic X(8)  Value "CHAPT19B".
  53. 000212     03  Filler      Pic X(11) Value Spaces.
  54. 000213     03  Filler      Pic X(23) Value "Dealer File Rent Report".
  55. 000214     03  Filler      Pic X(10) Value Spaces.
  56. 000215     03  Filler      Pic X(5)  Value "Page".
  57. 000216     03  Page-No     Pic Z(4)9 Value Zeros.
  58. 000217 01  Heading-Line-2.
  59. 000218     03  Filler      Pic X(12) Value "Created on:".
  60. 000219     03  Date-MM     Pic 99.
  61. 000220     03  Filler      Pic X     Value "/".
  62. 000221     03  Date-DD     Pic 99.
  63. 000222     03  Filler      Pic X     Value "/".
  64. 000223     03  Date-YY     Pic 99.
  65. 000224 01  Heading-Line-3.
  66. 000225     03  Filler      Pic X(12) Value "At:".
  67. 000226     03  Time-HH     Pic 99.
  68. 000227     03  Filler      Pic X     Value ":".
  69. 000228     03  Time-MM     Pic 99.
  70. 000229     03  Filler      Pic X     Value ":".
  71. 000230     03  Time-SS     Pic 99.
  72. 000231 01  Heading-Line-4.
  73. 000232     03  Filler      Pic X(41) Value Spaces.
  74. 000233     03  Filler      Pic X(27) Value "Last Rent  Next Rent".
  75. 000234     03  Filler      Pic X(4)  Value "Rent".
  76. 000235 01  Heading-Line-5.
  77. 000236     03  Filler   Pic X(44) Value "Name".
  78. 000237     03  Filler   Pic X(29) Value "Paid       Due         Amount".
  79. 000238 01  Detail-Line.
  80. 000239     03  Detail-Name         Pic X(40)       Value Spaces.
  81. 000240     03  Filler              Pic X           Value Spaces.
  82. 000241     03  Last-Rent-Paid-Date Pic 99/99/9999.
  83. 000242     03  Filler              Pic X           Value Spaces.
  84. 000243     03  Next-Rent-Due-Date  Pic 99/99/9999.
  85. 000244     03  Filler              Pic X           Value Spaces.
  86. 000245     03  Rent-Amount         Pic $$$,$$$.99.
  87. 000246 01  Line-Count           Pic 99          Value 99.
  88. 000247 01  Page-Count           Pic 9(4)        Value Zeros.
  89. 000248 01  Max-Lines            Pic 99          Value 60.
  90. 000249 01  Date-And-Time-Area.
  91. 000250     03  Work-Date            Pic 9(6).
  92. 000251     03  Work-Date-X          Redefines Work-Date.
  93. 000252         05  Date-YY          Pic 99.
  94. 000253         05  Date-MM          Pic 99.
  95. 000254         05  Date-DD          Pic 99.
  96. 000255     03  Work-Time            Pic 9(8).
  97. 000256     03  Work-Time-X          Redefines Work-Time.
  98. 000257         05  Time-HH          Pic 99.
  99. 000258         05  Time-MM          Pic 99.
  100. 000259         05  Time-SS          Pic 99.
  101. 000260         05  Filler           Pic XX.
  102. 000261
  103. 000262 Procedure Division.
  104. 000263 Declaratives.
  105. 000264 Dealer-File-Error Section.
  106. 000265     Use After Standard Error Procedure On Dealer-File
  107. 000266     .
  108. 000267 Dealer-Error-Paragraph.
  109. 000268     Display "Error on Dealer File " Dealer-Status
  110. 000269     .
  111. 000270 End Declaratives.
  112. 000271 Chapt19a-Start.
  113. 000272     Display "Begin Process Chapt19b"
  114. 000273     Perform Open-Files
  115. 000274      If Dealer-Success
  116. 000275        Perform Fill-Initial-Headings
  117. 000276        Perform Start-Alternate-Key
  118. 000277        Perform Process-File Until Not Dealer-Success
  119. 000278        Perform Close-Files
  120. 000279     End-If
  121. 000280     Stop Run.
  122. 000281 Start-Alternate-Key.
  123. 000282     Move Low-Values To Dealer-Name
  124. 000283     Start Dealer-File Key Not < Dealer-Name
  125. 000284     .
  126. 000285 Process-File.
  127. 000286     Read Dealer-File
  128. 000287          At End Continue
  129. 000288          Not At End
  130. 000289            If Dealer-Number (1:1) = "C"
  131. 000290               Perform Print-This-Record
  132. 000291            End-If
  133. 000292     End-Read
  134. 000293     .
  135. 000294 Print-This-Record.
  136. 000295     Perform Format-Name
  137. 000296     Move Corresponding Dealer-Record To Detail-Line
  138. 000297     If Line-Count >= Max-Lines
  139. 000298        Perform Heading-Routine
  140. 000299     End-If
  141. 000300     Write Report-Record From Detail-Line After 1
  142. 000301     Add 1 To Line-Count
  143. 000302     .
  144. 000303 Heading-Routine.
  145. 000304     Add 1 To Page-Count
  146. 000305     Move Page-Count To Page-No
  147. 000306     If Page-Count = 1
  148. 000307        Write Report-Record From Heading-Line-1 After Zero
  149. 000308     Else
  150. 000309        Write Report-Record From Heading-Line-1 After Page
  151. 000310     End-If
  152. 000311     Write Report-Record From Heading-Line-2 After 1
  153. 000312     Write Report-Record From Heading-Line-3 After 1
  154. 000313     Write Report-Record From Heading-Line-4 After 2
  155. 000314     Write Report-Record From Heading-Line-5 After 1
  156. 000315     Write Report-Record From Heading-Line-5 Before 2
  157. 000316     Move 7 To Line-Count
  158. 000317     .
  159. 000318 Format-Name.
  160. 000319     Move Spaces To Detail-Name
  161. 000320     String First-Name  Delimited By Space
  162. 000321            " "         Delimited By Size
  163. 000322            Middle-Name Delimited By Space
  164. 000323            " "         Delimited By Size
  165. 000324            Last-Name   Delimited By Space
  166. 000325            Into Detail-Name
  167. 000326     End-String
  168. 000327     .
  169. 000328 Fill-Initial-Headings.
  170. 000329     Accept Work-Date From Date
  171. 000330     Accept Work-Time From Time
  172. 000331     Move Corresponding Work-Date-X To
  173. 000332                        Heading-Line-2
  174. 000333     Move Corresponding Work-Time-X To
  175. 000334                        Heading-Line-3
  176. 000335     .
  177. 000336 Open-Files.
  178. 000337     Open Output Report-File
  179. 000338           Input Dealer-File
  180. 000339     .
  181. 000340 Close-Files.
  182. 000341     Close Report-File
  183. 000342           Dealer-File
  184. 000343     .
  185.