home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch17 / CHAPT17F.COB < prev    next >
Text File  |  1998-09-14  |  4KB  |  94 lines

  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt17f.
  4. 000031* Sort Example With Output Procedure
  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-Text Assign To "Dealer.TXT"
  12. 000060            Organization Line Sequential
  13. 000061            Access Sequential.
  14. 000062     Select Dealer-File Assign To "Dealer.Dat"
  15. 000063            Organization Is Indexed
  16. 000064            Record Key Dealer-Number Of Dealer-Record
  17. 000065            Alternate Key Dealer-Name Of Dealer-Record
  18. 000066            Access Is Sequential
  19. 000067            File Status Is Dealer-Status.
  20. 000068     Select Sort-Work Assign To Dealer-Sort-Work.
  21. 000069 Data Division.
  22. 000070 File Section.
  23. 000071 Fd  Dealer-File.
  24. 000077 01  Dealer-Record.
  25. 000078     03  Dealer-Number         Pic X(8).
  26. 000079     03  Dealer-Name.
  27. 000080         05  Last-Name   Pic X(25).
  28. 000081         05  First-Name  Pic X(15).
  29. 000082         05  Middle-Name Pic X(10).
  30. 000083     03  Address-Line-1      Pic X(50).
  31. 000084     03  Address-Line-2      Pic X(50).
  32. 000085     03  City                Pic X(40).
  33. 000086     03  State-Or-Country    Pic X(20).
  34. 000087     03  Postal-Code         Pic X(15).
  35. 000088     03  Home-Phone          Pic X(20).
  36. 000089     03  Work-Phone          Pic X(20).
  37. 000090     03  Other-Phone         Pic X(20).
  38. 000091     03  Start-Date          Pic 9(8).
  39. 000092     03  Last-Rent-Paid-Date Pic 9(8).
  40. 000093     03  Next-Rent-Due-Date  Pic 9(8).
  41. 000094     03  Rent-Amount         Pic 9(4)v99.
  42. 000095     03  Consignment-Percent Pic 9(3).
  43. 000096     03  Last-Sold-Amount    Pic S9(7)v99.
  44. 000097     03  Last-Sold-Date      Pic 9(8).
  45. 000098     03  Sold-To-Date        Pic S9(7)v99.
  46. 000099     03  Commission-To-Date  Pic S9(7)v99.
  47. 000100     03  Filler              Pic X(15).
  48. 000102 Fd  Dealer-Text.
  49. 000103 01  Text-Record         Pic X(376).
  50. 000121 Sd  Sort-Work.
  51. 000122 01  Sort-Record.
  52. 000123     03  Dealer-Number         Pic X(8).
  53. 000124     03  Dealer-Name.
  54. 000125         05  Last-Name   Pic X(25).
  55. 000126         05  First-Name  Pic X(15).
  56. 000127         05  Middle-Name Pic X(10).
  57. 000128     03  Filler          Pic X(318).
  58. 000147 Working-Storage Section.
  59. 000157 01  Record-Count        Pic 9(5) Value Zeros.
  60. 000167 01  Dealer-Status       Pic XX   Value "00".
  61. 000177 01  Done-Flag           Pic X    Value Spaces.
  62. 000187     88  All-Done                 Value "Y".
  63. 000390 Procedure Division.
  64. 000391 Declaratives.
  65. 000392 Dealer-File-Error Section.
  66. 000393     Use After Standard Error Procedure On Dealer-File.
  67. 000394 Dealer-Error.
  68. 000395     Display "Unhandled error on Dealer File " Dealer-Status
  69. 000396     Set All-Done To True
  70. 000397     .
  71. 000398 End Declaratives.
  72. 000399 Chapt17f-Start.
  73. 000401     Sort Sort-Work Ascending Key Dealer-Number Of Sort-Record
  74. 000431          Using Dealer-Text
  75. 000441          Output Procedure Sort-Out
  76. 000461     Display "Sort Complete with " Record-Count " Records."
  77. 000471     Stop Run
  78. 000481     .
  79. 000491 Sort-Out.
  80. 000501     Open Output Dealer-File
  81. 000511     Perform Until All-Done
  82. 000521        Return Sort-Work Into Dealer-Record
  83. 000531           At End Set All-Done To True
  84. 000541           Not At End
  85. 000551             Add 1 To Record-Count
  86. 000561             Move Zeros To Last-Sold-Amount
  87. 000571                           Last-Sold-Date
  88. 000581                           Sold-To-Date
  89. 000591                           Commission-To-Date
  90. 000592             Write Dealer-Record
  91. 000601        End-Return
  92. 000611     End-Perform
  93. 000621     Close Dealer-File
  94. 000631     .