home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch20 / chapt20x.cob < prev   
Text File  |  1998-10-16  |  19KB  |  447 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt20x.
  4. 000031* Chapter 20 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 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. 000153     03  Sort-Trans-Price        Pic S9(6)v99.
  75. 000154     03  Sort-Trans-Qty          Pic 9(3).
  76. 000155     03  Sort-Commission         Pic S9(6)v99.
  77. 000156     03  Sort-Dealer-Number      Pic X(8).
  78. 000157 Working-Storage Section.
  79. 000209 01  Heading-Line-1.
  80. 000210     03  Filler      Pic X(12) Value "Created by:".
  81. 000211     03  Filler      Pic X(8)  Value "CHAPT20X".
  82. 000212     03  Filler      Pic X(8) Value Spaces.
  83. 000213     03  Filler      Pic X(29)
  84. 000214         Value "Transaction Detail by Dealer".
  85. 000215     03  Filler      Pic X(7) Value Spaces.
  86. 000216     03  Filler      Pic X(5)  Value "Page".
  87. 000217     03  Page-No     Pic Z(4)9 Value Zeros.
  88. 000218 01  Heading-Line-2.
  89. 000219     03  Filler      Pic X(12) Value "Created on:".
  90. 000220     03  Date-MM     Pic 99.
  91. 000221     03  Filler      Pic X     Value "/".
  92. 000222     03  Date-DD     Pic 99.
  93. 000223     03  Filler      Pic X     Value "/".
  94. 000224     03  Date-YY     Pic 99.
  95. 000225 01  Heading-Line-3.
  96. 000226     03  Filler      Pic X(12) Value "At:".
  97. 000227     03  Time-HH     Pic 99.
  98. 000228     03  Filler      Pic X     Value ":".
  99. 000229     03  Time-MM     Pic 99.
  100. 000230     03  Filler      Pic X     Value ":".
  101. 000231     03  Time-SS     Pic 99.
  102. 000232* Heading Line Must Be Modified.
  103. 000235 01  Heading-Line-4.
  104. 000236     03  Filler      Pic X(10) Value "Dealer".
  105. 000237     03  Filler      Pic X(28) Value "Name".
  106. 000238     03  Filler      Pic X(8)  Value "Date   ".
  107. 000239     03  Filler      Pic X(7)  Value "Type ".
  108. 000240     03  Filler      Pic X(8)  Value "Qty".
  109. 000241     03  Filler      Pic X(8)  Value "Amount".
  110. 000242     03  Filler      Pic X(10) Value "Commission".
  111. 000243 01  Blank-Line      Pic X(80) Value Spaces.
  112. 000244* Detail Line Is New.
  113. 000253 01  Detail-Line.
  114. 000254     03  Detail-Dealer       Pic X(8)  Value Spaces.
  115. 000255     03  Filler              Pic X     Value Spaces.
  116. 000256     03  Detail-Dealer-Name  Pic X(25) Value Spaces.
  117. 000257     03  Filler              Pic X     Value Spaces.
  118. 000258     03  Detail-Date.
  119. 000259         05  Trans-Month     Pic 99.
  120. 000260         05  Filler          Pic X Value "/".
  121. 000261         05  Trans-Day       Pic 99.
  122. 000262         05  Filler          Pic X Value "/".
  123. 000263         05  Trans-Year      Pic 9(4).
  124. 000264     03  Filler              Pic X     Value Spaces.
  125. 000265     03  Detail-Type         Pic X(4)  Value Spaces.
  126. 000266     03  Filler              Pic X     Value Spaces.
  127. 000267     03  Detail-Qty          Pic Z(4)9.
  128. 000268     03  Filler              Pic X     Value Spaces.
  129. 000269     03  Detail-Amt          Pic $$$,$$$.99-.
  130. 000270     03  Filler              Pic X     Value Spaces.
  131. 000271     03  Detail-Commission   Pic $$$,$$$.99-.
  132. 000272 01  Total-Line.
  133. 000273     03  Total-Description   Pic X(51)       Value Spaces.
  134. 000274     03  Total-Qty           Pic Z(4)9.
  135. 000275     03  Filler              Pic X           Value Spaces.
  136. 000276     03  Total-Amt           Pic $$$,$$$.99-.
  137. 000277     03  Filler              Pic X           Value Spaces.
  138. 000278     03  Total-Commission    Pic $$$,$$$.99-.
  139. 000279 01  Desc-Type.
  140. 000280     03  Filler              Pic X(11) Value "*   Total".
  141. 000281     03  Desc-Type-Type      Pic X(4).
  142. 000282 01  Desc-Date.
  143. 000283     03  Filler              Pic X(11) Value "**  Total".
  144. 000284     03  Trans-Month         Pic 99.
  145. 000285     03  Filler              Pic X Value "/".
  146. 000286     03  Trans-Day           Pic 99.
  147. 000287     03  Filler              Pic X Value "/".
  148. 000288     03  Trans-Year          Pic 9(4).
  149. 000289 01  Desc-Dealer.
  150. 000290     03  Filler              Pic X(11) Value "*** Total".
  151. 000291     03  Desc-Dealer-Name    Pic X(30).
  152. 000292 01  Save-Fields.
  153. 000293     03  Save-Dealer-Name                Value High-Values.
  154. 000294         05  Last-Name      Pic X(25).
  155. 000295         05  First-Name     Pic X(15).
  156. 000296         05  Middle-Name    Pic X(10).
  157. 000297     03  Save-Date-X.
  158. 000298         05  Trans-Year     Pic 9(4).
  159. 000299         05  Trans-Month    Pic 9(2).
  160. 000300         05  Trans-Day      Pic 9(2).
  161. 000301     03 Save-Type           Pic X(4)     Value High-Values.
  162. 000302 01  Accumulators.
  163. 000303     03  Grand-Totals.
  164. 000304         05  Total-Qty        Pic 9(5)         Value Zeros.
  165. 000305         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  166. 000306         05  Total-Commission Pic S9(5)v99     Value Zeros.
  167. 000307     03  Dealer-Totals.
  168. 000308         05  Total-Qty        Pic 9(5)         Value Zeros.
  169. 000309         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  170. 000310         05  Total-Commission Pic S9(5)v99     Value Zeros.
  171. 000311     03  Date-Totals.
  172. 000312         05  Total-Qty        Pic 9(5)         Value Zeros.
  173. 000313         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  174. 000314         05  Total-Commission Pic S9(5)v99     Value Zeros.
  175. 000315     03  Type-Totals.
  176. 000316         05  Total-Qty        Pic 9(5)         Value Zeros.
  177. 000317         05  Total-Amt        Pic S9(6)v99     Value Zeros.
  178. 000318         05  Total-Commission Pic S9(5)v99     Value Zeros.
  179. 000319 01  Line-Count           Pic 99          Value 99.
  180. 000320 01  Page-Count           Pic 9(4)        Value Zeros.
  181. 000321 01  Max-Lines            Pic 99          Value 60.
  182. 000322 01  Date-And-Time-Area.
  183. 000323     03  Work-Date            Pic 9(6).
  184. 000324     03  Work-Date-X          Redefines Work-Date.
  185. 000325         05  Date-YY          Pic 99.
  186. 000326         05  Date-MM          Pic 99.
  187. 000327         05  Date-DD          Pic 99.
  188. 000328     03  Work-Time            Pic 9(8).
  189. 000329     03  Work-Time-X          Redefines Work-Time.
  190. 000330         05  Time-HH          Pic 99.
  191. 000331         05  Time-MM          Pic 99.
  192. 000332         05  Time-SS          Pic 99.
  193. 000333         05  Filler           Pic XX.
  194. 000334 01  String-Pointer       Pic 99 Value Zeros.
  195. 000335 01  Done-Flag            Pic X Value Spaces.
  196. 000336     88  All-Done               Value "Y".
  197. 000337 01  Dealer-Status           Pic XX Value Zeros.
  198. 000338     88  Dealer-Success  Value "00" Thru "09".
  199. 000339 Procedure Division.
  200. 000340 Declaratives.
  201. 000341 Dealer-File-Error Section.
  202. 000342     Use After Standard Error Procedure On Dealer-File
  203. 000343     .
  204. 000344 Dealer-Error-Paragraph.
  205. 000345     Display "Error on Dealer File " Dealer-Status
  206. 000346     .
  207. 000347 End Declaratives.
  208. 000348 Chapt20x-Start.
  209. 000349     Display "Begin Process Chapt20X"
  210. 000350     Sort Sort-File Ascending Key Sort-Key
  211. 000351          Input Procedure Sort-In
  212. 000352          Output Procedure Print-Report
  213. 000353     Stop Run
  214. 000354     .
  215. 000355 Sort-In.
  216. 000356     Open Input Trans-File
  217. 000357                Dealer-File
  218. 000358     Perform Process-Input-Records Until All-Done
  219. 000359     Close Trans-File
  220. 000360           Dealer-File
  221. 000361     .
  222. 000362 Process-Input-Records.
  223. 000363     Read Trans-File
  224. 000364        At End Set All-Done To True
  225. 000365        Not At End
  226. 000366            Perform Move-And-Release-Input
  227. 000367     End-Read
  228. 000368     .
  229. 000369 Move-And-Release-Input.
  230. 000370* Reverse The Date
  231. 000371     Move Corresponding Transaction-Date-X To
  232. 000372                        Sort-Trans-Date
  233. 000373* Move The Data
  234. 000374     Move Transaction-Price  To Sort-Trans-Price
  235. 000375     Move Transaction-Qty    To Sort-Trans-Qty
  236. 000376     Move Transaction-Type   To Sort-Trans-Type
  237. 000377     Move Transaction-Dealer To Sort-Dealer-Number
  238. 000378* Read Dealer File To Retrieve Name And Consignment Percent
  239. 000379     Perform Retrieve-Dealer-Record
  240. 000380* Move The Name And Compute Consignment
  241. 000381     Move Dealer-Name Of Dealer-Record To
  242. 000382          Dealer-Name Of Sort-Record
  243. 000383     Compute Sort-Commission Rounded =
  244. 000384             (Transaction-Qty * Transaction-Price) *
  245. 000385             (Consignment-Percent / 100)
  246. 000386* Release The Record
  247. 000387     Release Sort-Record
  248. 000388     .
  249. 000389 Retrieve-Dealer-Record.
  250. 000390     Move Transaction-Dealer To Dealer-Number Of Dealer-Record
  251. 000391     Read Dealer-File
  252. 000392          Invalid Key
  253. 000393             Move "**UNKNOWN**" To
  254. 000394                  Dealer-Name Of Dealer-Record
  255. 000395             Move 10 To Consignment-Percent
  256. 000396     End-Read
  257. 000397     .
  258. 000398 Print-Report.
  259. 000399     Open Output Report-File
  260. 000400     Move Space To Done-Flag
  261. 000401     Perform Fill-Initial-Headings
  262. 000402     Perform Return-Process-Records Until All-Done
  263. 000403     Close Report-File
  264. 000404     .
  265. 000405 Return-Process-Records.
  266. 000406     Return Sort-File
  267. 000407            At End
  268. 000408               Perform Type-Break
  269. 000409               Perform Date-Break
  270. 000410               Perform Dealer-Break
  271. 000411               Perform Print-Grand-Totals
  272. 000412               Set All-Done To True
  273. 000413            Not At End
  274. 000414               Perform Check-For-Break
  275. 000415     End-Return
  276. 000416     .
  277. 000417 Check-For-Break.
  278. 000418     Evaluate True
  279. 000419        When  Save-Dealer-Name = High-Values
  280. 000420              Move Sort-Key To Save-Fields
  281. 000421        When  Dealer-Name Of Sort-Record Not = Save-Dealer-Name
  282. 000422              Perform Type-Break
  283. 000423              Perform Date-Break
  284. 000424              Perform Dealer-Break
  285. 000425        When  Sort-Trans-Date Not = Save-Date-X
  286. 000426              Perform Type-Break
  287. 000427              Perform Date-Break
  288. 000428        When  Sort-Trans-Type Not = Save-Type
  289. 000429              Perform Type-Break
  290. 000430        When  Other
  291. 000431              Continue
  292. 000432     End-Evaluate
  293. 000433     Perform Accumulate-Details
  294. 000434     .
  295. 000435 Accumulate-Details.
  296. 000436* New Detail Record Logic
  297. 000437     Perform Fill-Write-Detail
  298. 000438     Add Sort-Trans-Qty To Total-Qty Of Type-Totals
  299. 000439     Add Sort-Commission To Total-Commission Of Type-Totals
  300. 000440     Compute Total-Amt Of Type-Totals =
  301. 000441             Total-Amt Of Type-Totals +
  302. 000442             (Sort-Trans-Qty * Sort-Trans-Price)
  303. 000443     .
  304. 000444 Fill-Write-Detail.
  305. 000445* Notice The Qualification Of First-Name, Middle-Name
  306. 000446* And Last-Name Is All The Way Up To The Record Level And
  307. 000447* Not The Group Name The Immediately Precedes Them In
  308. 000448* The Sort Record?  This Is Because That Group Is Also
  309. 000449* Duplicated.  When Qualifying Data Fields, You Should Try
  310. 000450* To Use The Lowest Level That Provides A Unique Qualification.
  311. 000451     Move Sort-Dealer-Number To Detail-Dealer
  312. 000452     Move Spaces To Detail-Dealer-Name
  313. 000453     Move 1 To String-Pointer
  314. 000454     String First-Name Of Sort-Record
  315. 000455                         Delimited By Space
  316. 000456            Into Detail-Dealer-Name
  317. 000457            With Pointer String-Pointer
  318. 000458     End-String
  319. 000459     If Middle-Name Of Sort-Record
  320. 000460        > Spaces
  321. 000461        String " " Delimited By Size
  322. 000462               Middle-Name Of Sort-Record
  323. 000463                   Delimited By Spaces
  324. 000464               Into Detail-Dealer-Name
  325. 000465               With Pointer String-Pointer
  326. 000466        End-String
  327. 000467     End-If
  328. 000468     String " " Delimited By Size
  329. 000469            Last-Name Of Sort-Record
  330. 000470                   Delimited By Spaces
  331. 000471               Into Detail-Dealer-Name
  332. 000472               With Pointer String-Pointer
  333. 000473     End-String
  334. 000474     Move Corresponding Sort-Trans-Date To Detail-Date
  335. 000475     Move Sort-Trans-Type To Detail-Type
  336. 000476     Move Sort-Trans-Qty  To Detail-Qty
  337. 000477     Compute Detail-Amt = Sort-Trans-Qty * Sort-Trans-Price
  338. 000478     Move Sort-Commission To Detail-Commission
  339. 000479     If Line-Count > Max-Lines
  340. 000480        Perform Heading-Routine
  341. 000481     End-If
  342. 000482     Write Report-Record From Detail-Line After 1
  343. 000483     .
  344. 000484 Type-Break.
  345. 000485     Perform Print-Type-Total
  346. 000486     Add Corresponding Type-Totals To Date-Totals
  347. 000487     Initialize Type-Totals
  348. 000488     Move Sort-Trans-Type To Save-Type
  349. 000517     .
  350. 000527 Date-Break.
  351. 000537     Perform Print-Date-Total
  352. 000538     Add Corresponding Date-Totals To Dealer-Totals
  353. 000539     Initialize Date-Totals
  354. 000540     Move Sort-Trans-Date To Save-Date-X
  355. 000541     .
  356. 000542 Dealer-Break.
  357. 000543     Perform Print-Dealer-Total
  358. 000544     Add Corresponding Dealer-Totals To Grand-Totals
  359. 000545     Initialize Dealer-Totals
  360. 000546     Move Dealer-Name Of Sort-Record To Save-Dealer-Name
  361. 000547     .
  362. 000548 Print-Type-Total.
  363. 000549* Changed This Paragraph To Double Space.
  364. 000558     Move Corresponding Type-Totals To Total-Line
  365. 000568     Move Save-Type To Desc-Type-Type
  366. 000578     Move Desc-Type To Total-Description
  367. 000579     If Line-Count > Max-Lines - 2
  368. 000580        Perform Heading-Routine
  369. 000581     End-If
  370. 000582     Write Report-Record From Total-Line After 2
  371. 000583     Write Report-Record From Blank-Line After 1
  372. 000592     Add 3 To Line-Count
  373. 000598     .
  374. 000608 Print-Date-Total.
  375. 000618     Move Corresponding Date-Totals To Total-Line
  376. 000628     Move Corresponding Save-Date-X To Desc-Date
  377. 000638     Move Desc-Date To Total-Description
  378. 000639     If Line-Count > Max-Lines - 1
  379. 000640        Perform Heading-Routine
  380. 000641     End-If
  381. 000648     Write Report-Record From Total-Line After 1
  382. 000649     Write Report-Record From Blank-Line After 1
  383. 000658     Add 2 To Line-Count
  384. 000659     .
  385. 000668 Print-Dealer-Total.
  386. 000678     Move Corresponding Dealer-Totals To Total-Line
  387. 000715     Move Spaces To Desc-Dealer-Name
  388. 000716     Move 1 To String-Pointer
  389. 000717     String First-Name Of Save-Dealer-Name
  390. 000718                         Delimited By Space
  391. 000719            Into Desc-Dealer-Name
  392. 000720            With Pointer String-Pointer
  393. 000721     End-String
  394. 000722     If Middle-Name Of Save-Dealer-Name
  395. 000723        > Spaces
  396. 000724        String " " Delimited By Size
  397. 000725               Middle-Name Of Save-Dealer-Name
  398. 000726                   Delimited By Spaces
  399. 000727               Into Desc-Dealer-Name
  400. 000728               With Pointer String-Pointer
  401. 000729        End-String
  402. 000730     End-If
  403. 000731     String " " Delimited By Size
  404. 000732            Last-Name Of Save-Dealer-Name
  405. 000733                   Delimited By Spaces
  406. 000734               Into Desc-Dealer-Name
  407. 000735               With Pointer String-Pointer
  408. 000736     End-String
  409. 000737     Move Desc-Dealer To Total-Description
  410. 000738     If Line-Count > Max-Lines - 1
  411. 000739        Perform Heading-Routine
  412. 000740     End-If
  413. 000741     Write Report-Record From Total-Line After 1
  414. 000742     Write Report-Record From Blank-Line After 1
  415. 000743     Add 2 To Line-Count
  416. 000748     .
  417. 000758 Print-Grand-Totals.
  418. 000768     Move Corresponding Grand-Totals To Total-Line
  419. 000778     Move "****Grand Totals" To Total-Description
  420. 000788     If Line-Count > Max-Lines - 1
  421. 000798        Perform Heading-Routine
  422. 000808     End-If
  423. 000818     Write Report-Record From Total-Line After 2
  424. 000828     .
  425. 000838 Heading-Routine.
  426. 000848     Add 1 To Page-Count
  427. 000849     Move Page-Count To Page-No
  428. 000858     If Page-Count = 1
  429. 000868        Write Report-Record From Heading-Line-1 After Zero
  430. 000878     Else
  431. 000888        Write Report-Record From Heading-Line-1 After Page
  432. 000898     End-If
  433. 000908     Write Report-Record From Heading-Line-2 After 1
  434. 000918     Write Report-Record From Heading-Line-3 After 1
  435. 000919     Write Report-Record From Heading-Line-4 After 2
  436. 000920     Write Report-Record From Blank-Line     After 1
  437. 000921     Move 6 To Line-Count
  438. 000922     .
  439. 000932 Fill-Initial-Headings.
  440. 000942     Accept Work-Date From Date
  441. 000952     Accept Work-Time From Time
  442. 000962     Move Corresponding Work-Date-X To
  443. 000972                        Heading-Line-2
  444. 000982     Move Corresponding Work-Time-X To
  445. 000992                        Heading-Line-3
  446. 001002     .
  447.