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

  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt17e.
  4. 000031* Sort Example With An Input 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-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     Select Sort-Work Assign To Dealer-Sort-Work.
  21. 000070 Data Division.
  22. 000071 File Section.
  23. 000072 Fd  Dealer-File.
  24. 000073 01  Dealer-Record.
  25. 000074     03  Dealer-Number         Pic X(8).
  26. 000075     03  Dealer-Name.
  27. 000076         05  Last-Name   Pic X(25).
  28. 000077         05  First-Name  Pic X(15).
  29. 000078         05  Middle-Name Pic X(10).
  30. 000083     03  Address-Line-1      Pic X(50).
  31. 000085     03  Address-Line-2      Pic X(50).
  32. 000086     03  City                Pic X(40).
  33. 000087     03  State-Or-Country    Pic X(20).
  34. 000088     03  Postal-Code         Pic X(15).
  35. 000089     03  Home-Phone          Pic X(20).
  36. 000090     03  Work-Phone          Pic X(20).
  37. 000091     03  Other-Phone         Pic X(20).
  38. 000092     03  Start-Date          Pic 9(8).
  39. 000093     03  Last-Rent-Paid-Date Pic 9(8).
  40. 000094     03  Next-Rent-Due-Date  Pic 9(8).
  41. 000095     03  Rent-Amount         Pic 9(4)v99.
  42. 000096     03  Consignment-Percent Pic 9(3).
  43. 000097     03  Last-Sold-Amount    Pic S9(7)v99.
  44. 000098     03  Last-Sold-Date      Pic 9(8).
  45. 000099     03  Sold-To-Date        Pic S9(7)v99.
  46. 000100     03  Commission-To-Date  Pic S9(7)v99.
  47. 000101     03  Filler              Pic X(15).
  48. 000102 Sd  Sort-Work.
  49. 000103 01  Sort-Record.
  50. 000106     03  Dealer-Name.
  51. 000107         05  Last-Name   Pic X(25).
  52. 000108         05  First-Name  Pic X(15).
  53. 000109         05  Middle-Name Pic X(10).
  54. 000110     03  Address-Line-1      Pic X(50).
  55. 000111     03  Address-Line-2      Pic X(50).
  56. 000112     03  City                Pic X(40).
  57. 000113     03  State-Or-Country    Pic X(20).
  58. 000114     03  Postal-Code         Pic X(15).
  59. 000124 Fd  Address-File.
  60. 000125 01  Address-Record          Pic X(225).
  61. 000128 Working-Storage Section.
  62. 000138 01  Done-Flag   Pic X Value Spaces.
  63. 000148     88  All-Done      Value "Y".
  64. 000158 01  Dealer-Status Pic XX Value "00".
  65. 000390 Procedure Division.
  66. 000391 Declaratives.
  67. 000392 Dealer-File-Error Section.
  68. 000393     Use After Standard Error Procedure On Dealer-File.
  69. 000394 Dealer-Error.
  70. 000395     Display "Unhandled error on Dealer File " Dealer-Status
  71. 000396     Set All-Done To True
  72. 000397     .
  73. 000398 End Declaratives.
  74. 000399 Chapt17e-Start.
  75. 000401     Sort Sort-Work Ascending  Key Last-Name Of Sort-Record
  76. 000411                                   First-Name Of Sort-Record
  77. 000421                                   Middle-Name Of Sort-Record
  78. 000431          Input Procedure Sort-In
  79. 000441          Giving Address-File
  80. 000461     Display "Sort Complete"
  81. 000471     Stop Run
  82. 000481     .
  83. 000491 Sort-In.
  84. 000492     Open Input Dealer-File
  85. 000501     Perform Until All-Done
  86. 000502        Read Dealer-File
  87. 000503             At End Set All-Done To True
  88. 000504             Not At End
  89. 000505             If State-Or-Country Of Dealer-Record = "CA"
  90. 000506                Move Corresponding Dealer-Record To Sort-Record
  91. 000507                Release Sort-Record
  92. 000508             End-If
  93. 000510        End-Read
  94. 000511     End-Perform
  95. 000512     Close Dealer-File
  96. 000521     .