home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch17 / CHAPT17X.COB < prev   
Text File  |  1998-09-14  |  9KB  |  205 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt17x.
  4. 000031* Chapter 17 Exercise Solution.
  5. 000041 Environment Division.
  6. 000050 Configuration Section.
  7. 000051 Source-Computer.  IBM-PC.
  8. 000056 Object-Computer.  IBM-PC.
  9. 000057 Input-Output Section.
  10. 000058 File-Control.
  11. 000059     Select Dealer-File Assign To "Dealer.Dat"
  12. 000060            Organization Indexed
  13. 000061            Record Key Dealer-Number Of Dealer-Record
  14. 000062            Alternate Record Key Dealer-Name Of Dealer-Record
  15. 000064            Access Sequential
  16. 000065            File Status Dealer-Status.
  17. 000066     Select Address-File Assign To "Address.Txt"
  18. 000067            Organization Line Sequential
  19. 000068            Access Sequential
  20. 000069            File Status Address-Status.
  21. 000070     Select Sort-Work Assign To Dealer-Sort-Work.
  22. 000071 Data Division.
  23. 000072 File Section.
  24. 000073 Fd  Dealer-File.
  25. 000074 01  Dealer-Record.
  26. 000075     03  Dealer-Number         Pic X(8).
  27. 000076     03  Dealer-Name.
  28. 000077         05  Last-Name   Pic X(25).
  29. 000078         05  First-Name  Pic X(15).
  30. 000079         05  Middle-Name Pic X(10).
  31. 000083     03  Address-Line-1      Pic X(50).
  32. 000085     03  Address-Line-2      Pic X(50).
  33. 000086     03  City                Pic X(40).
  34. 000087     03  State-Or-Country    Pic X(20).
  35. 000088     03  Postal-Code         Pic X(15).
  36. 000089     03  Home-Phone          Pic X(20).
  37. 000090     03  Work-Phone          Pic X(20).
  38. 000091     03  Other-Phone         Pic X(20).
  39. 000092     03  Start-Date          Pic 9(8).
  40. 000093     03  Last-Rent-Paid-Date Pic 9(8).
  41. 000094     03  Next-Rent-Due-Date  Pic 9(8).
  42. 000095     03  Rent-Amount         Pic 9(4)v99.
  43. 000096     03  Consignment-Percent Pic 9(3).
  44. 000097     03  Last-Sold-Amount    Pic S9(7)v99.
  45. 000098     03  Last-Sold-Date      Pic 9(8).
  46. 000099     03  Sold-To-Date        Pic S9(7)v99.
  47. 000100     03  Commission-To-Date  Pic S9(7)v99.
  48. 000101     03  Filler              Pic X(15).
  49. 000102* Note That The Field Being Sorted On, Sort-State-Name May Appear
  50. 000103* Anywhere In The Record.
  51. 000104 Sd  Sort-Work.
  52. 000105 01  Sort-Record.
  53. 000106     03  Dealer-Number       Pic X(8).
  54. 000107     03  Sort-State-Name     Pic X(20).
  55. 000108     03  Dealer-Name.
  56. 000109         05  Last-Name       Pic X(25).
  57. 000110         05  First-Name      Pic X(15).
  58. 000111         05  Middle-Name     Pic X(10).
  59. 000112     03  Address-Line-1      Pic X(50).
  60. 000113     03  Address-Line-2      Pic X(50).
  61. 000114     03  City                Pic X(40).
  62. 000115     03  State-Or-Country    Pic X(20).
  63. 000116     03  Postal-Code         Pic X(15).
  64. 000124 Fd  Address-File.
  65. 000125 01  Address-Record.
  66. 000126     03  Dealer-Number       Pic X(8).
  67. 000127     03  Dealer-Name.
  68. 000128         05  Last-Name       Pic X(25).
  69. 000129         05  First-Name      Pic X(15).
  70. 000130         05  Middle-Name     Pic X(10).
  71. 000131     03  Address-Line-1      Pic X(50).
  72. 000132     03  Address-Line-2      Pic X(50).
  73. 000133     03  City                Pic X(40).
  74. 000134     03  State-Or-Country    Pic X(20).
  75. 000135     03  Postal-Code         Pic X(15).
  76. 000136 Working-Storage Section.
  77. 000138 01  Done-Flag      Pic X Value Spaces.
  78. 000148     88  All-Done         Value "Y".
  79. 000158 01  Dealer-Status  Pic XX Value "00".
  80. 000168 01  Address-Status Pic XX Value "00".
  81. 000178 01  Sorted-Records Pic 9(5) Value Zeros.
  82. 000188 01  State-Table-Area.
  83. 000189     03  State-Table-Data.
  84. 000190         05  Filler Pic X(22) Value "ALAlabama".
  85. 000191         05  Filler Pic X(22) Value "AKAlaska".
  86. 000192         05  Filler Pic X(22) Value "AZArizona".
  87. 000193         05  Filler Pic X(22) Value "ARArkansas".
  88. 000194         05  Filler Pic X(22) Value "CACalifornia".
  89. 000195         05  Filler Pic X(22) Value "COColorado".
  90. 000196         05  Filler Pic X(22) Value "CTConnecticut".
  91. 000197         05  Filler Pic X(22) Value "DCDistrict of Columbia".
  92. 000198         05  Filler Pic X(22) Value "DEDelaware".
  93. 000199         05  Filler Pic X(22) Value "FLFlorida".
  94. 000200         05  Filler Pic X(22) Value "GAGeorgia".
  95. 000201         05  Filler Pic X(22) Value "HIHawaii".
  96. 000202         05  Filler Pic X(22) Value "IDIdaho".
  97. 000203         05  Filler Pic X(22) Value "ILIllinois".
  98. 000204         05  Filler Pic X(22) Value "INIndiana".
  99. 000205         05  Filler Pic X(22) Value "IAIowa".
  100. 000206         05  Filler Pic X(22) Value "KSKansas".
  101. 000207         05  Filler Pic X(22) Value "KYKentucky".
  102. 000208         05  Filler Pic X(22) Value "LALouisiana".
  103. 000209         05  Filler Pic X(22) Value "MEMaine".
  104. 000210         05  Filler Pic X(22) Value "MDMaryland".
  105. 000211         05  Filler Pic X(22) Value "MAMassachusetts".
  106. 000212         05  Filler Pic X(22) Value "MIMichigan".
  107. 000213         05  Filler Pic X(22) Value "MNMinnesota".
  108. 000214         05  Filler Pic X(22) Value "MSMississipi".
  109. 000215         05  Filler Pic X(22) Value "MOMissouri".
  110. 000216         05  Filler Pic X(22) Value "MTMontana".
  111. 000217         05  Filler Pic X(22) Value "NENebraska".
  112. 000218         05  Filler Pic X(22) Value "NVNevada".
  113. 000219         05  Filler Pic X(22) Value "NHNew Hampshire".
  114. 000220         05  Filler Pic X(22) Value "NJNew Jersey".
  115. 000221         05  Filler Pic X(22) Value "NMNew Mexico".
  116. 000222         05  Filler Pic X(22) Value "NYNew York".
  117. 000223         05  Filler Pic X(22) Value "NCNorth Carolina".
  118. 000224         05  Filler Pic X(22) Value "NDNorth Dakota".
  119. 000225         05  Filler Pic X(22) Value "OHOhio".
  120. 000226         05  Filler Pic X(22) Value "OKOklahoma".
  121. 000227         05  Filler Pic X(22) Value "OROregon".
  122. 000228         05  Filler Pic X(22) Value "PAPennsylvania".
  123. 000229         05  Filler Pic X(22) Value "RIRhode Island".
  124. 000230         05  Filler Pic X(22) Value "SCSouth Carolina".
  125. 000231         05  Filler Pic X(22) Value "SDSouth Dakota".
  126. 000232         05  Filler Pic X(22) Value "TNTennessee".
  127. 000233         05  Filler Pic X(22) Value "TXTexas".
  128. 000234         05  Filler Pic X(22) Value "UTUtah".
  129. 000235         05  Filler Pic X(22) Value "VTVermont".
  130. 000236         05  Filler Pic X(22) Value "VAVirginia".
  131. 000237         05  Filler Pic X(22) Value "WAWashington".
  132. 000238         05  Filler Pic X(22) Value "WVWest Virginia".
  133. 000239         05  Filler Pic X(22) Value "WIWisconsin".
  134. 000240         05  Filler Pic X(22) Value "WYWyoming".
  135. 000241     03  State-Table Redefines State-Table-Data.
  136. 000242         05  State-Table-Occurrences  Occurs 51 Times
  137. 000243                                     Indexed By Table-Index.
  138. 000244             10  State-Abbrev        Pic XX.
  139. 000245             10  State-Name          Pic X(20).
  140. 000390 Procedure Division.
  141. 000391 Declaratives.
  142. 000392 Dealer-File-Error Section.
  143. 000393     Use After Standard Error Procedure On Dealer-File.
  144. 000394 Dealer-Error.
  145. 000395     Display "Unhandled error on Dealer File " Dealer-Status
  146. 000396     Set All-Done To True
  147. 000397     .
  148. 000398 Address-File-Error Section.
  149. 000399     Use After Standard Error Procedure On Address-File.
  150. 000400 Address-Error.
  151. 000401     Display "Unhandled error on Address File " Address-Status
  152. 000402     Set All-Done To True
  153. 000403     .
  154. 000404 End Declaratives.
  155. 000405 Chapt17x-Start.
  156. 000406     Display "Begin Sort Chapt17x"
  157. 000407* Duplicates Is Used Here To Great Advantage.  Since The Indexed File
  158. 000408* Is Input, It Is Already In Dealer Number Sequence.  By Specifying
  159. 000409* Duplicates, We End Up With The Output Being In Dealer Number Sequence
  160. 000410* Within Postal Code In The Output File.
  161. 000411     Sort Sort-Work Ascending  Key Sort-State-Name
  162. 000412                                   Postal-Code Of Sort-Record
  163. 000413          Duplicates
  164. 000431          Input Procedure Sort-In
  165. 000441          Output Procedure Sort-Out
  166. 000461     Display "Sort Complete with " Sorted-Records " Records."
  167. 000471     Stop Run
  168. 000481     .
  169. 000491 Sort-In.
  170. 000492     Open Input Dealer-File
  171. 000501     Perform Until All-Done
  172. 000502        Read Dealer-File
  173. 000503             At End Set All-Done To True
  174. 000504             Not At End
  175. 000505             Move Corresponding Dealer-Record To Sort-Record
  176. 000507             Perform Find-State-Name
  177. 000508             Release Sort-Record
  178. 000510        End-Read
  179. 000511     End-Perform
  180. 000512     Close Dealer-File
  181. 000521     .
  182. 000522 Sort-Out.
  183. 000523* The Flag Is Set From The Sort In Procedure, Reset It.
  184. 000525     Move Spaces To Done-Flag
  185. 000526     Open Output Address-File
  186. 000527     Perform Until All-Done
  187. 000528        Return Sort-Work
  188. 000529          At End Set All-Done To True
  189. 000530          Not At End
  190. 000531             Move Corresponding Sort-Record To Address-Record
  191. 000532             Write Address-Record
  192. 000533             Add 1 To Sorted-Records
  193. 000534        End-Return
  194. 000535     End-Perform
  195. 000536     .
  196. 000537 Find-State-Name.
  197. 000541     Set Table-Index To 1
  198. 000551     Search State-Table-Occurrences
  199. 000561            At End Move "UNKNOWN" To Sort-State-Name
  200. 000571            When State-Abbrev (Table-Index) =
  201. 000572                 State-Or-Country Of Sort-Record
  202. 000573                 Move State-Name (Table-Index) To
  203. 000574                      Sort-State-Name
  204. 000581     End-Search
  205. 000611     .