home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch18 / CHAPT18A.COB next >
Encoding:
Text File  |  1998-09-15  |  5.3 KB  |  139 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt18a.
  4. 000031* Transaction Entry
  5. 000043 Environment Division.
  6. 000050 Configuration Section.
  7. 000055 Source-Computer.  IBM-PC.
  8. 000056 Object-Computer.  IBM-PC.
  9. 000057 Special-Names.
  10. 000058     Crt Status Is Keyboard-Status
  11. 000059     Cursor Is Cursor-Position.
  12. 000061 Input-Output  Section.
  13. 000062 File-Control.
  14. 000063     Select Optional Trans-File Assign To "TRANS.TXT"
  15. 000064         Organization Is Line Sequential
  16. 000065         File Status  Is Trans-File-Status.
  17. 000066 Data Division.
  18. 000067 File Section.
  19. 000068 Fd  Trans-File.
  20. 000069 01  Trans-Record.
  21. 000070     03  Transaction-Date   Pic  9(8).
  22. 000071     03  Transaction-Type   Pic  X(4).
  23. 000072     03  Transaction-Dealer Pic  X(8).
  24. 000073     03  Transaction-Price  Pic S9(7)v99.
  25. 000074     03  Transaction-Qty    Pic  9(3).
  26. 000075     03  Filler             Pic  X(40).
  27. 000076 Working-Storage Section.
  28. 000077 01  Keyboard-Status.
  29. 000078     03  Accept-Status      Pic 9.
  30. 000079     03  Function-Key       Pic X.
  31. 000080         88 F1-Pressed      Value X"01".
  32. 000081         88 F3-Pressed      Value X"03".
  33. 000082         88 F4-Pressed      Value X"04".
  34. 000083     03  System-Use         Pic X.
  35. 000084 01  Cursor-Position.
  36. 000085     03  Cursor-Row    Pic 9(2) Value 1.
  37. 000086     03  Cursor-Column Pic 9(2) Value 1.
  38. 000088 01  File-Error-Flag        Pic X Value Space.
  39. 000089     88  File-Error         Value "Y".
  40. 000090 01  Trans-File-Status      Pic XX Value Spaces.
  41. 000091     88  Trans-File-Success Value "00" Thru "09".
  42. 000092 01  Error-Message         Pic X(50) Value Spaces.
  43. 000093 01  Open-Error-Message.
  44. 000094     03  Filler        Pic X(31)
  45. 000095         Value "Error Opening Transaction File ".
  46. 000096     03  Open-Status   Pic XX    Value Spaces.
  47. 000097 01  Write-Error-Message.
  48. 000098     03  Filler        Pic X(31)
  49. 000099         Value "Error Writing Transaction File ".
  50. 000100     03  Write-Status  Pic XX    Value Spaces.
  51. 000101 Screen Section.
  52. 000102 01  Data-Entry-Screen
  53. 000103     Blank Screen, Auto
  54. 000104     Foreground-Color Is 7,
  55. 000105     Background-Color Is 1.
  56. 000106*
  57. 000107     03  Screen-Literal-Group.
  58. 000108         05  Line 01 Column 30 Value "Darlene's Treasures"
  59. 000109             Highlight Foreground-Color 4 Background-Color 1.
  60. 000110         05  Line 03 Column 28 Value "Transaction Entry Program"
  61. 000111             Highlight.
  62. 000112         05  Line 4  Column 01  Value "Date: ".
  63. 000113         05  Line 5  Column 01  Value "Category: ".
  64. 000114         05  Line 6  Column 01  Value "Dealer Number: ".
  65. 000115         05  Line 7  Column 01  Value "Price: ".
  66. 000116         05  Line 8  Column 01  Value "Quantity: ".
  67. 000122         05  Line 22 Column 01  Value "F1-Save Record".
  68. 000124         05  Line 22 Column 23  Value "F3-Exit".
  69. 000125         05  Line 22 Column 56  Value "F4-Clear".
  70. 000127     03  Required-Reverse-Group Reverse-Video Required.
  71. 000128         05  Line 4 Column 16  Pic 99/99/9999
  72. 000129             Using Transaction-Date.
  73. 000130         05  Line 5 Column 16  Pic X(4)
  74. 000131             Using Transaction-Type.
  75. 000132         05  Line 6 Column 16  Pic X(8)
  76. 000133             Using Transaction-Dealer.
  77. 000134         05  Line 7 Column 16  Pic ZZ,ZZZ.99-
  78. 000135             Using Transaction-Price
  79. 000136             Blank When Zero.
  80. 000137         05  Line 8 Column 16  Pic ZZ9
  81. 000138             Using Transaction-Qty
  82. 000139             Blank When Zero.
  83. 000143     03  Highlight-Display Highlight.
  84. 000163         05  Line 20 Column 01 Pic X(50) From Error-Message
  85. 000164             Foreground-Color 5 Background-Color 1.
  86. 000166 Procedure Division.
  87. 000167 Chapt18a-Start.
  88. 000168     Perform Open-File
  89. 000170     If Not File-Error
  90. 000171        Initialize Trans-Record
  91. 000172        Perform Process-Input Until F3-Pressed Or
  92. 000173                                    File-Error
  93. 000174        Perform Close-File
  94. 000175     End-If
  95. 000176     Stop Run
  96. 000177     .
  97. 000178 Open-File.
  98. 000187     Open Extend Trans-File
  99. 000197     If Not Trans-File-Success
  100. 000198        Move Trans-File-Status To Open-Status
  101. 000199        Move Open-Error-Message To Error-Message
  102. 000200        Perform Display-And-Accept-Error
  103. 000257     End-If
  104. 000267     .
  105. 000277 Process-Input.
  106. 000288     Display Data-Entry-Screen
  107. 000297     Accept Data-Entry-Screen
  108. 000298     Move Spaces To Error-Message
  109. 000299     Evaluate True
  110. 000300        When F1-Pressed
  111. 000301             Perform Write-Record
  112. 000302        When F4-Pressed
  113. 000303             Initialize Trans-Record
  114. 000304        When F3-Pressed
  115. 000305             Continue
  116. 000306        When Other
  117. 000307             Continue
  118. 000308     End-Evaluate
  119. 000317     .
  120. 000327 Write-Record.
  121. 000337     Write Trans-Record
  122. 000338     If Trans-File-Success
  123. 000339        Initialize Trans-Record
  124. 000340        Move "Record Written" To Error-Message
  125. 000341        Move "0101" To Cursor-Position
  126. 000342     Else
  127. 000351        Move Trans-File-Status To Write-Status
  128. 000352        Move Write-Error-Message To Error-Message
  129. 000357        Perform Display-And-Accept-Error
  130. 000397     End-If
  131. 000407     .
  132. 000417 Display-And-Accept-Error.
  133. 000427     Set File-Error To True
  134. 000437     Display Data-Entry-Screen
  135. 000447     Accept Data-Entry-Screen
  136. 000457     .
  137. 000467 Close-File.
  138. 000477     Close Trans-File
  139. 000487     .
  140.