home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch20 / CHAPT20A.COB next >
Text File  |  1998-09-14  |  16KB  |  376 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt20a.
  4. 000031* Control Breaks
  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 Dealer-File Assign To "Dealer.Dat"
  12. 000064         Organization Indexed
  13. 000065         Access Random
  14. 000066         Record Key Dealer-Number
  15. 000067         Alternate Record Key Dealer-Name Of Dealer-Record
  16. 000068         File Status Dealer-Status.
  17. 000070     Select Report-File Assign To Printer.
  18. 000071     Select Optional Trans-File Assign To "Trans1.TXT"
  19. 000072            Organization Is Line Sequential.
  20. 000073     Select Sort-File Assign To Sort-Work.
  21. 000076 Data Division.
  22. 000077 File Section.
  23. 000085 Fd  Dealer-File.
  24. 000086 01  Dealer-Record.
  25. 000087     03  Dealer-Number         Pic X(8).
  26. 000088     03  Dealer-Name.
  27. 000089         05  Last-Name   Pic X(25).
  28. 000090         05  First-Name  Pic X(15).
  29. 000091         05  Middle-Name Pic X(10).
  30. 000092     03  Address-Line-1      Pic X(50).
  31. 000093     03  Address-Line-2      Pic X(50).
  32. 000094     03  City                Pic X(40).
  33. 000095     03  State-Or-Country    Pic X(20).
  34. 000096     03  Postal-Code         Pic X(15).
  35. 000097     03  Home-Phone          Pic X(20).
  36. 000098     03  Work-Phone          Pic X(20).
  37. 000099     03  Other-Phone         Pic X(20).
  38. 000100     03  Start-Date          Pic 9(8).
  39. 000101     03  Last-Rent-Paid-Date Pic 9(8).
  40. 000102     03  Next-Rent-Due-Date  Pic 9(8).
  41. 000103     03  Rent-Amount         Pic 9(4)v99.
  42. 000104     03  Consignment-Percent Pic 9(3).
  43. 000105     03  Last-Sold-Amount    Pic S9(7)v99.
  44. 000106     03  Last-Sold-Date      Pic 9(8).
  45. 000107     03  Sold-To-Date        Pic S9(7)v99.
  46. 000108     03  Commission-To-Date  Pic S9(7)v99.
  47. 000109     03  Filler              Pic X(15).
  48. 000110 Fd  Report-File.
  49. 000111 01  Report-Record Pic X(80).
  50. 000112 Fd  Trans-File.
  51. 000113 01  Trans-Record.
  52. 000114     03  Transaction-Date   Pic  9(8).
  53. 000115     03  Transaction-Date-X Redefines Transaction-Date.
  54. 000116         05  Trans-Month    Pic 99.
  55. 000117         05  Trans-Day      Pic 99.
  56. 000118         05  Trans-Year     Pic 9(4).
  57. 000119     03  Transaction-Type   Pic  X(4).
  58. 000120     03  Transaction-Dealer Pic  X(8).
  59. 000121     03  Transaction-Price  Pic S9(7)v99.
  60. 000122     03  Transaction-Qty    Pic  9(3).
  61. 000123     03  Filler             Pic  X(40).
  62. 000124 Sd  Sort-File.
  63. 000137 01  Sort-Record.
  64. 000138     03  Sort-Key.
  65. 000141         05  Dealer-Name.
  66. 000142             10  Last-Name               Pic X(25).
  67. 000143             10  First-Name              Pic X(15).
  68. 000144             10  Middle-Name             Pic X(10).
  69. 000145         05  Sort-Trans-Date.
  70. 000147             10  Trans-Year              Pic 9(4).
  71. 000149             10  Trans-Month             Pic 9(2).
  72. 000150             10  Trans-Day               Pic 9(2).
  73. 000151         05  Sort-Trans-Type             Pic X(4).
  74. 000152     03  Sort-Trans-Price        Pic S9(6)v99.
  75. 000153     03  Sort-Trans-Qty          Pic 9(3).
  76. 000154     03  Sort-Commission         Pic S9(6)v99.
  77. 000156 Working-Storage Section.
  78. 000209 01  Heading-Line-1.
  79. 000210     03  Filler      Pic X(12) Value "Created by:".
  80. 000211     03  Filler      Pic X(8)  Value "CHAPT20A".
  81. 000212     03  Filler      Pic X(8) Value Spaces.
  82. 000213     03  Filler      Pic X(29)
  83. 000214         Value "Transaction Summary by Dealer".
  84. 000215     03  Filler      Pic X(7) Value Spaces.
  85. 000216     03  Filler      Pic X(5)  Value "Page".
  86. 000217     03  Page-No     Pic Z(4)9 Value Zeros.
  87. 000218 01  Heading-Line-2.
  88. 000219     03  Filler      Pic X(12) Value "Created on:".
  89. 000220     03  Date-MM     Pic 99.
  90. 000221     03  Filler      Pic X     Value "/".
  91. 000222     03  Date-DD     Pic 99.
  92. 000223     03  Filler      Pic X     Value "/".
  93. 000224     03  Date-YY     Pic 99.
  94. 000225 01  Heading-Line-3.
  95. 000226     03  Filler      Pic X(12) Value "At:".
  96. 000227     03  Time-HH     Pic 99.
  97. 000228     03  Filler      Pic X     Value ":".
  98. 000229     03  Time-MM     Pic 99.
  99. 000230     03  Filler      Pic X     Value ":".
  100. 000231     03  Time-SS     Pic 99.
  101. 000235 01  Heading-Line-4.
  102. 000236     03  Filler      Pic X(51) Value Spaces.
  103. 000239     03  Filler      Pic X(6)  Value "  Qty".
  104. 000240     03  Filler      Pic X(12) Value "    Amount".
  105. 000241     03  Filler      Pic X(10) Value "Commission".
  106. 000242 01  Blank-Line      Pic X(80) Value Spaces.
  107. 000261 01  Total-Line.
  108. 000262     03  Total-Description   Pic X(51)       Value Spaces.
  109. 000263     03  Total-Qty           Pic Z(4)9.
  110. 000264     03  Filler              Pic X           Value Spaces.
  111. 000265     03  Total-Amt           Pic $$$,$$$.99-.
  112. 000266     03  Filler              Pic X           Value Spaces.
  113. 000267     03  Total-Commission    Pic $$$,$$$.99-.
  114. 000268 01  Desc-Type.
  115. 000269     03  Filler              Pic X(11) Value "*   Total".
  116. 000270     03  Desc-Type-Type      Pic X(4).
  117. 000271 01  Desc-Date.
  118. 000272     03  Filler              Pic X(11) Value "**  Total".
  119. 000273     03  Trans-Month         Pic 99.
  120. 000274     03  Filler              Pic X Value "/".
  121. 000275     03  Trans-Day           Pic 99.
  122. 000276     03  Filler              Pic X Value "/".
  123. 000277     03  Trans-Year          Pic 9(4).
  124. 000278 01  Desc-Dealer.
  125. 000279     03  Filler              Pic X(11) Value "*** Total".
  126. 000280     03  Desc-Dealer-Name    Pic X(30).
  127. 000281 01  Save-Fields.
  128. 000282     03  Save-Dealer-Name                Value High-Values.
  129. 000283         05  Last-Name      Pic X(25).
  130. 000284         05  First-Name     Pic X(15).
  131. 000285         05  Middle-Name    Pic X(10).
  132. 000286     03  Save-Date-X.
  133. 000287         05  Trans-Year     Pic 9(4).
  134. 000288         05  Trans-Month    Pic 9(2).
  135. 000289         05  Trans-Day      Pic 9(2).
  136. 000290     03 Save-Type           Pic X(4)     Value High-Values.
  137. 000291 01  Accumulators.
  138. 000292     03  Grand-Totals.
  139. 000293         05  Total-Qty        Pic 9(5)         Value Zeros.
  140. 000294         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  141. 000295         05  Total-Commission Pic S9(5)v99     Value Zeros.
  142. 000298     03  Dealer-Totals.
  143. 000299         05  Total-Qty        Pic 9(5)         Value Zeros.
  144. 000300         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  145. 000301         05  Total-Commission Pic S9(5)v99     Value Zeros.
  146. 000302     03  Date-Totals.
  147. 000303         05  Total-Qty        Pic 9(5)         Value Zeros.
  148. 000304         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  149. 000305         05  Total-Commission Pic S9(5)v99     Value Zeros.
  150. 000306     03  Type-Totals.
  151. 000307         05  Total-Qty        Pic 9(5)         Value Zeros.
  152. 000308         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  153. 000309         05  Total-Commission Pic S9(5)v99     Value Zeros.
  154. 000310 01  Line-Count           Pic 99          Value 99.
  155. 000311 01  Page-Count           Pic 9(4)        Value Zeros.
  156. 000312 01  Max-Lines            Pic 99          Value 60.
  157. 000318 01  Date-And-Time-Area.
  158. 000319     03  Work-Date            Pic 9(6).
  159. 000320     03  Work-Date-X          Redefines Work-Date.
  160. 000321         05  Date-YY          Pic 99.
  161. 000322         05  Date-MM          Pic 99.
  162. 000323         05  Date-DD          Pic 99.
  163. 000324     03  Work-Time            Pic 9(8).
  164. 000325     03  Work-Time-X          Redefines Work-Time.
  165. 000326         05  Time-HH          Pic 99.
  166. 000327         05  Time-MM          Pic 99.
  167. 000328         05  Time-SS          Pic 99.
  168. 000329         05  Filler           Pic XX.
  169. 000330 01  String-Pointer       Pic 99 Value Zeros.
  170. 000331 01  Done-Flag            Pic X Value Spaces.
  171. 000332     88  All-Done               Value "Y".
  172. 000333 01  Dealer-Status           Pic XX Value Zeros.
  173. 000334     88  Dealer-Success  Value "00" Thru "09".
  174. 000335 Procedure Division.
  175. 000336 Declaratives.
  176. 000337 Dealer-File-Error Section.
  177. 000338     Use After Standard Error Procedure On Dealer-File
  178. 000339     .
  179. 000340 Dealer-Error-Paragraph.
  180. 000341     Display "Error on Dealer File " Dealer-Status
  181. 000342     .
  182. 000343 End Declaratives.
  183. 000344 Chapt20a-Start.
  184. 000345     Display "Begin Process Chapt20A"
  185. 000346     Sort Sort-File Ascending Key Sort-Key
  186. 000347          Input Procedure Sort-In
  187. 000348          Output Procedure Print-Report
  188. 000349     Stop Run
  189. 000350     .
  190. 000351 Sort-In.
  191. 000352     Open Input Trans-File
  192. 000353                Dealer-File
  193. 000354     Perform Process-Input-Records Until All-Done
  194. 000355     Close Trans-File
  195. 000356           Dealer-File
  196. 000357     .
  197. 000358 Process-Input-Records.
  198. 000359     Read Trans-File
  199. 000360        At End Set All-Done To True
  200. 000361        Not At End
  201. 000362            Perform Move-And-Release-Input
  202. 000363     End-Read
  203. 000364     .
  204. 000365 Move-And-Release-Input.
  205. 000366* Reverse The Date
  206. 000367     Move Corresponding Transaction-Date-X To
  207. 000368                        Sort-Trans-Date
  208. 000369* Move The Data
  209. 000370     Move Transaction-Price  To Sort-Trans-Price
  210. 000371     Move Transaction-Qty    To Sort-Trans-Qty
  211. 000372     Move Transaction-Type   To Sort-Trans-Type
  212. 000373* Read Dealer File To Retrieve Name And Consignment Percent
  213. 000374     Perform Retrieve-Dealer-Record
  214. 000375* Move The Name And Compute Consignment
  215. 000376     Move Dealer-Name Of Dealer-Record To
  216. 000377          Dealer-Name Of Sort-Record
  217. 000378     Compute Sort-Commission Rounded =
  218. 000379             (Transaction-Qty * Transaction-Price) *
  219. 000380             (Consignment-Percent / 100)
  220. 000381* Release The Record
  221. 000382     Release Sort-Record
  222. 000383     .
  223. 000384 Retrieve-Dealer-Record.
  224. 000385     Move Transaction-Dealer To Dealer-Number Of Dealer-Record
  225. 000386     Read Dealer-File
  226. 000387          Invalid Key
  227. 000388             Move "**UNKNOWN**" To
  228. 000389                  Dealer-Name Of Dealer-Record
  229. 000390             Move 10 To Consignment-Percent
  230. 000391     End-Read
  231. 000392     .
  232. 000393 Print-Report.
  233. 000394     Open Output Report-File
  234. 000395     Move Space To Done-Flag
  235. 000396     Perform Fill-Initial-Headings
  236. 000397     Perform Return-Process-Records Until All-Done
  237. 000398     Close Report-File
  238. 000399     .
  239. 000400 Return-Process-Records.
  240. 000401     Return Sort-File
  241. 000402            At End
  242. 000403               Perform Type-Break
  243. 000404               Perform Date-Break
  244. 000405               Perform Dealer-Break
  245. 000406               Perform Print-Grand-Totals
  246. 000407               Set All-Done To True
  247. 000408            Not At End
  248. 000409               Perform Check-For-Break
  249. 000410     End-Return
  250. 000411     .
  251. 000412 Check-For-Break.
  252. 000413     Evaluate True
  253. 000414        When  Save-Dealer-Name = High-Values
  254. 000415              Move Sort-Key To Save-Fields
  255. 000416        When  Dealer-Name Of Sort-Record Not = Save-Dealer-Name
  256. 000417              Perform Type-Break
  257. 000418              Perform Date-Break
  258. 000419              Perform Dealer-Break
  259. 000420        When  Sort-Trans-Date Not = Save-Date-X
  260. 000421              Perform Type-Break
  261. 000422              Perform Date-Break
  262. 000423        When  Sort-Trans-Type Not = Save-Type
  263. 000424              Perform Type-Break
  264. 000425        When  Other
  265. 000426              Continue
  266. 000427     End-Evaluate
  267. 000428     Perform Accumulate-Details
  268. 000429     .
  269. 000430 Accumulate-Details.
  270. 000431     Add Sort-Trans-Qty To Total-Qty Of Type-Totals
  271. 000432     Add Sort-Commission To Total-Commission Of Type-Totals
  272. 000433     Compute Total-Amt Of Type-Totals =
  273. 000434             Total-Amt Of Type-Totals +
  274. 000435             (Sort-Trans-Qty * Sort-Trans-Price)
  275. 000436     .
  276. 000437 Type-Break.
  277. 000457     Perform Print-Type-Total
  278. 000458     Add Corresponding Type-Totals To Date-Totals
  279. 000467     Initialize Type-Totals
  280. 000468     Move Sort-Trans-Type To Save-Type
  281. 000517     .
  282. 000527 Date-Break.
  283. 000537     Perform Print-Date-Total
  284. 000538     Add Corresponding Date-Totals To Dealer-Totals
  285. 000539     Initialize Date-Totals
  286. 000540     Move Sort-Trans-Date To Save-Date-X
  287. 000541     .
  288. 000542 Dealer-Break.
  289. 000543     Perform Print-Dealer-Total
  290. 000544     Add Corresponding Dealer-Totals To Grand-Totals
  291. 000545     Initialize Dealer-Totals
  292. 000546     Move Dealer-Name Of Sort-Record To Save-Dealer-Name
  293. 000547     .
  294. 000548 Print-Type-Total.
  295. 000558     Move Corresponding Type-Totals To Total-Line
  296. 000568     Move Save-Type To Desc-Type-Type
  297. 000578     Move Desc-Type To Total-Description
  298. 000579     If Line-Count > Max-Lines
  299. 000580        Perform Heading-Routine
  300. 000581     End-If
  301. 000582     Write Report-Record From Total-Line After 1
  302. 000592     Add 1 To Line-Count
  303. 000598     .
  304. 000608 Print-Date-Total.
  305. 000618     Move Corresponding Date-Totals To Total-Line
  306. 000628     Move Corresponding Save-Date-X To Desc-Date
  307. 000638     Move Desc-Date To Total-Description
  308. 000639     If Line-Count > Max-Lines - 2
  309. 000640        Perform Heading-Routine
  310. 000641     End-If
  311. 000648     Write Report-Record From Total-Line After 2
  312. 000649     Write Report-Record From Blank-Line After 1
  313. 000658     Add 3 To Line-Count
  314. 000659     .
  315. 000668 Print-Dealer-Total.
  316. 000678     Move Corresponding Dealer-Totals To Total-Line
  317. 000679     Move Spaces To Desc-Dealer-Name
  318. 000680     Move 1 To String-Pointer
  319. 000686     String First-Name Of Save-Dealer-Name
  320. 000688                         Delimited By Space
  321. 000689            Into Desc-Dealer-Name
  322. 000690            With Pointer String-Pointer
  323. 000691     End-String
  324. 000692     If Middle-Name Of Save-Dealer-Name
  325. 000693        > Spaces
  326. 000694        String " " Delimited By Size
  327. 000695               Middle-Name Of Save-Dealer-Name
  328. 000696                   Delimited By Spaces
  329. 000697               Into Desc-Dealer-Name
  330. 000698               With Pointer String-Pointer
  331. 000699        End-String
  332. 000700     End-If
  333. 000701     String " " Delimited By Size
  334. 000702            Last-Name Of Save-Dealer-Name
  335. 000703                   Delimited By Spaces
  336. 000704               Into Desc-Dealer-Name
  337. 000705               With Pointer String-Pointer
  338. 000706     End-String
  339. 000715     Move Desc-Dealer To Total-Description
  340. 000716     If Line-Count > Max-Lines - 1
  341. 000717        Perform Heading-Routine
  342. 000718     End-If
  343. 000728     Write Report-Record From Total-Line After 1
  344. 000729     Write Report-Record From Blank-Line After 1
  345. 000738     Add 2 To Line-Count
  346. 000748     .
  347. 000758 Print-Grand-Totals.
  348. 000768     Move Corresponding Grand-Totals To Total-Line
  349. 000778     Move "****Grand Totals" To Total-Description
  350. 000788     If Line-Count > Max-Lines - 1
  351. 000798        Perform Heading-Routine
  352. 000808     End-If
  353. 000818     Write Report-Record From Total-Line After 2
  354. 000828     .
  355. 000838 Heading-Routine.
  356. 000848     Add 1 To Page-Count
  357. 000849     Move Page-Count To Page-No
  358. 000858     If Page-Count = 1
  359. 000868        Write Report-Record From Heading-Line-1 After Zero
  360. 000878     Else
  361. 000888        Write Report-Record From Heading-Line-1 After Page
  362. 000898     End-If
  363. 000908     Write Report-Record From Heading-Line-2 After 1
  364. 000918     Write Report-Record From Heading-Line-3 After 1
  365. 000919     Write Report-Record From Heading-Line-4 After 2
  366. 000920     Write Report-Record From Blank-Line     After 1
  367. 000921     Move 6 To Line-Count
  368. 000922     .
  369. 000932 Fill-Initial-Headings.
  370. 000942     Accept Work-Date From Date
  371. 000952     Accept Work-Time From Time
  372. 000962     Move Corresponding Work-Date-X To
  373. 000972                        Heading-Line-2
  374. 000982     Move Corresponding Work-Time-X To
  375. 000992                        Heading-Line-3
  376. 001002     .