home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch19 / CHAPT19C.COB < prev    next >
Encoding:
Text File  |  1998-09-15  |  7.2 KB  |  182 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt19c.
  4. 000031* Simple Report - Print To A File
  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 "Print.IMG".
  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 "CHAPT19C".
  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 Chapt19c"
  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               Perform Print-This-Record
  131. 000291     End-Read
  132. 000292     .
  133. 000293 Print-This-Record.
  134. 000294     Perform Format-Name
  135. 000295     Move Corresponding Dealer-Record To Detail-Line
  136. 000296     If Line-Count >= Max-Lines
  137. 000297        Perform Heading-Routine
  138. 000298     End-If
  139. 000299     Write Report-Record From Detail-Line After 1
  140. 000300     Add 1 To Line-Count
  141. 000301     .
  142. 000302 Heading-Routine.
  143. 000303     Add 1 To Page-Count
  144. 000304     Move Page-Count To Page-No
  145. 000305     If Page-Count = 1
  146. 000306        Write Report-Record From Heading-Line-1 After Zero
  147. 000307     Else
  148. 000308        Write Report-Record From Heading-Line-1 After Page
  149. 000309     End-If
  150. 000310     Write Report-Record From Heading-Line-2 After 1
  151. 000311     Write Report-Record From Heading-Line-3 After 1
  152. 000312     Write Report-Record From Heading-Line-4 After 2
  153. 000313     Write Report-Record From Heading-Line-5 After 1
  154. 000314     Write Report-Record From Heading-Line-5 Before 2
  155. 000315     Move 7 To Line-Count
  156. 000316     .
  157. 000317 Format-Name.
  158. 000318     Move Spaces To Detail-Name
  159. 000319     String First-Name  Delimited By Space
  160. 000320            " "         Delimited By Size
  161. 000321            Middle-Name Delimited By Space
  162. 000322            " "         Delimited By Size
  163. 000323            Last-Name   Delimited By Space
  164. 000324            Into Detail-Name
  165. 000325     End-String
  166. 000326     .
  167. 000327 Fill-Initial-Headings.
  168. 000328     Accept Work-Date From Date
  169. 000329     Accept Work-Time From Time
  170. 000330     Move Corresponding Work-Date-X To
  171. 000331                        Heading-Line-2
  172. 000332     Move Corresponding Work-Time-X To
  173. 000333                        Heading-Line-3
  174. 000334     .
  175. 000335 Open-Files.
  176. 000336     Open Output Report-File
  177. 000337           Input Dealer-File
  178. 000338     .
  179. 000339 Close-Files.
  180. 000340     Close Report-File
  181. 000341           Dealer-File
  182. 000342     .
  183.