home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch18 / chapt18b.cob < prev    next >
Encoding:
Text File  |  1998-09-23  |  8.6 KB  |  220 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt18b.
  4. 000031* Transaction Entry - With Data Validation
  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     Select Dealer-File Assign To "Dealer.Dat"
  18. 000067         Organization Indexed
  19. 000068         Access Random
  20. 000069         Record Key Dealer-Number
  21. 000070         Alternate Record Key Dealer-Name
  22. 000071         File Status Dealer-Status.
  23. 000073 Data Division.
  24. 000074 File Section.
  25. 000075 Fd  Trans-File.
  26. 000076 01  Trans-Record.
  27. 000077     03  Transaction-Date   Pic  9(8).
  28. 000078     03  Transaction-Text.
  29. 000079         05  Transaction-Type   Pic  X(4).
  30. 000080         05  Transaction-Dealer Pic  X(8).
  31. 000081     03  Transaction-Price  Pic S9(7)v99.
  32. 000082     03  Transaction-Qty    Pic  9(3).
  33. 000083     03  Filler             Pic  X(40).
  34. 000084 Fd  Dealer-File.
  35. 000085 01  Dealer-Record.
  36. 000086     03  Dealer-Number         Pic X(8).
  37. 000087     03  Dealer-Name.
  38. 000088         05  Last-Name   Pic X(25).
  39. 000089         05  First-Name  Pic X(15).
  40. 000090         05  Middle-Name Pic X(10).
  41. 000091     03  Address-Line-1      Pic X(50).
  42. 000092     03  Address-Line-2      Pic X(50).
  43. 000093     03  City                Pic X(40).
  44. 000094     03  State-Or-Country    Pic X(20).
  45. 000095     03  Postal-Code         Pic X(15).
  46. 000096     03  Home-Phone          Pic X(20).
  47. 000097     03  Work-Phone          Pic X(20).
  48. 000098     03  Other-Phone         Pic X(20).
  49. 000099     03  Start-Date          Pic 9(8).
  50. 000100     03  Last-Rent-Paid-Date Pic 9(8).
  51. 000101     03  Next-Rent-Due-Date  Pic 9(8).
  52. 000102     03  Rent-Amount         Pic 9(4)v99.
  53. 000103     03  Consignment-Percent Pic 9(3).
  54. 000104     03  Last-Sold-Amount    Pic S9(7)v99.
  55. 000105     03  Last-Sold-Date      Pic 9(8).
  56. 000106     03  Sold-To-Date        Pic S9(7)v99.
  57. 000107     03  Commission-To-Date  Pic S9(7)v99.
  58. 000108     03  Filler              Pic X(15).
  59. 000109 Working-Storage Section.
  60. 000110 01  Keyboard-Status.
  61. 000111     03  Accept-Status      Pic 9.
  62. 000112     03  Function-Key       Pic X.
  63. 000113         88 F1-Pressed      Value X"01".
  64. 000114         88 F3-Pressed      Value X"03".
  65. 000115         88 F4-Pressed      Value X"04".
  66. 000116     03  System-Use         Pic X.
  67. 000117 01  Cursor-Position.
  68. 000118     03  Cursor-Row    Pic 9(2) Value 1.
  69. 000119     03  Cursor-Column Pic 9(2) Value 1.
  70. 000120 01  File-Error-Flag        Pic X Value Space.
  71. 000121     88  File-Error         Value "Y".
  72. 000122 01  Validate-Flag          Pic X Value "Y".
  73. 000123     88  Validation-Passed  Value "Y".
  74. 000124     88  Validation-Error   Value "N".
  75. 000125 01  Trans-File-Status      Pic XX Value Spaces.
  76. 000126     88  Trans-File-Success Value "00" Thru "09".
  77. 000127 01  Dealer-Status     Pic X(2) Value Spaces.
  78. 000128     88  Dealer-Success Value "00" Thru "09".
  79. 000130 01  Error-Message         Pic X(50) Value Spaces.
  80. 000131 01  Open-Error-Message.
  81. 000132     03  Filler        Pic X(31)
  82. 000133         Value "Error Opening Transaction File ".
  83. 000134     03  Open-Status   Pic XX    Value Spaces.
  84. 000135 01  Dealer-Open-Error-Message.
  85. 000136     03  Filler        Pic X(31)
  86. 000137         Value "Error Opening Dealer File ".
  87. 000138     03  Open-Dealer-Status   Pic XX    Value Spaces.
  88. 000139 01  Write-Error-Message.
  89. 000140     03  Filler        Pic X(31)
  90. 000141         Value "Error Writing Transaction File ".
  91. 000142     03  Write-Status  Pic XX    Value Spaces.
  92. 000143 Screen Section.
  93. 000144 01  Data-Entry-Screen
  94. 000145     Blank Screen, Auto
  95. 000146     Foreground-Color Is 7,
  96. 000147     Background-Color Is 1.
  97. 000148*
  98. 000149     03  Screen-Literal-Group.
  99. 000150         05  Line 01 Column 30 Value "Darlene's Treasures"
  100. 000151             Highlight Foreground-Color 4 Background-Color 1.
  101. 000152         05  Line 03 Column 28 Value "Transaction Entry Program"
  102. 000153             Highlight.
  103. 000154         05  Line 4  Column 01  Value "Date: ".
  104. 000155         05  Line 5  Column 01  Value "Category: ".
  105. 000156         05  Line 6  Column 01  Value "Dealer Number: ".
  106. 000157         05  Line 7  Column 01  Value "Price: ".
  107. 000158         05  Line 8  Column 01  Value "Quantity: ".
  108. 000159         05  Line 22 Column 01  Value "F1-Save Record".
  109. 000160         05  Line 22 Column 23  Value "F3-Exit".
  110. 000161         05  Line 22 Column 56  Value "F4-Clear".
  111. 000162     03  Required-Reverse-Group Reverse-Video Required.
  112. 000163         05  Line 4 Column 16  Pic 99/99/9999
  113. 000164             Using Transaction-Date.
  114. 000165         05  Line 5 Column 16  Pic X(4)
  115. 000166             Using Transaction-Type.
  116. 000167         05  Line 6 Column 16  Pic X(8)
  117. 000168             Using Transaction-Dealer.
  118. 000169         05  Line 7 Column 16  Pic ZZ,ZZZ.99-
  119. 000170             Using Transaction-Price
  120. 000171             Blank When Zero.
  121. 000172         05  Line 8 Column 16  Pic ZZ9
  122. 000173             Using Transaction-Qty
  123. 000174             Blank When Zero.
  124. 000175     03  Highlight-Display Highlight.
  125. 000176         05  Line 20 Column 01 Pic X(50) From Error-Message
  126. 000177             Foreground-Color 5 Background-Color 1.
  127. 000178 Procedure Division.
  128. 000179 Chapt18b-Start.
  129. 000180     Perform Open-File
  130. 000181     If Not File-Error
  131. 000182        Perform Open-Dealer-File
  132. 000183     End-If
  133. 000184     If Not File-Error
  134. 000185        Initialize Trans-Record
  135. 000186        Perform Process-Input Until F3-Pressed Or
  136. 000187                                    File-Error
  137. 000188        Perform Close-File
  138. 000189        Perform Close-Dealer-File
  139. 000190     End-If
  140. 000191     Stop Run
  141. 000192     .
  142. 000193 Open-File.
  143. 000194     Open Extend Trans-File
  144. 000197     If Not Trans-File-Success
  145. 000198        Move Trans-File-Status To Open-Status
  146. 000199        Move Open-Error-Message To Error-Message
  147. 000200        Perform Display-And-Accept-Error
  148. 000257     End-If
  149. 000267     .
  150. 000268 Open-Dealer-File.
  151. 000269     Open Input Dealer-File
  152. 000270     If Not Dealer-Success
  153. 000271        Move Dealer-Status To Open-Dealer-Status
  154. 000272        Move Dealer-Open-Error-Message To Error-Message
  155. 000273        Perform Display-And-Accept-Error
  156. 000274     End-If
  157. 000275     .
  158. 000277 Process-Input.
  159. 000288     Display Data-Entry-Screen
  160. 000297     Accept Data-Entry-Screen
  161. 000298     Move Spaces To Error-Message
  162. 000299     Evaluate True
  163. 000300        When F1-Pressed
  164. 000301             Perform Validate-Data
  165. 000302             If Validation-Passed
  166. 000303                Perform Write-Record
  167. 000304             End-If
  168. 000305        When F4-Pressed
  169. 000306             Initialize Trans-Record
  170. 000307        When F3-Pressed
  171. 000308             Continue
  172. 000309        When Other
  173. 000310             Continue
  174. 000311     End-Evaluate
  175. 000317     .
  176. 000318 Validate-Data.
  177. 000319     Inspect Transaction-Text Converting
  178. 000320             "abcdefghijklmnopqrstuvwxyz" To
  179. 000321             "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  180. 000322     Move "Y" To Validate-Flag
  181. 000323     If Not (Transaction-Type = "ANTI" Or "CRAF" Or "HOLI" Or "JEWL" Or
  182. 000324             "MISC" Or "XMAS")
  183. 000325        Set Validation-Error To True
  184. 000326        Move "0516" To Cursor-Position
  185. 000327        Move
  186. 000328        "Invalid Category, Must be ANTI, CRAF, HOLI, JEWL, MISC or XMAS"
  187. 000329        To Error-Message
  188. 000330     End-If
  189. 000331     Move Transaction-Dealer To Dealer-Number
  190. 000332     Read Dealer-File
  191. 000333          Invalid Key
  192. 000334            Set Validation-Error To True
  193. 000335            Move "0616" To Cursor-Position
  194. 000336            Move "Invalid Dealer Number Entered" To Error-Message
  195. 000339     End-Read
  196. 000340     .
  197. 000341 Write-Record.
  198. 000342     Write Trans-Record
  199. 000343     If Trans-File-Success
  200. 000344        Initialize Trans-Record
  201. 000345        Move "Record Written" To Error-Message
  202. 000346        Move "0101" To Cursor-Position
  203. 000347     Else
  204. 000351        Move Trans-File-Status To Write-Status
  205. 000352        Move Write-Error-Message To Error-Message
  206. 000357        Perform Display-And-Accept-Error
  207. 000397     End-If
  208. 000407     .
  209. 000417 Display-And-Accept-Error.
  210. 000427     Set File-Error To True
  211. 000437     Display Data-Entry-Screen
  212. 000447     Accept Data-Entry-Screen
  213. 000457     .
  214. 000467 Close-File.
  215. 000477     Close Trans-File
  216. 000487     .
  217. 000497 Close-Dealer-File.
  218. 000507     Close Dealer-File
  219. 000517     .
  220.