home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch24 / CHAPT24A.CBL < prev    next >
Text File  |  1998-09-14  |  11KB  |  277 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000011 Identification Division.
  3. 000020 Program-Id. Chapt24a.
  4. 000030
  5. 000040* Title - Tenant Display Program
  6. 000050* Description - Tenant Display Program
  7. 000060
  8. 000070 Environment Division.
  9. 000080 Configuration Section.
  10. 000090 Source-Computer. IBM-PC.
  11. 000100 Object-Computer. IBM-PC.
  12. 000110 Input-Output Section.
  13. 000111 File-Control.
  14. 000112     Select Dealer-File Assign To "\Tycobol\Dealer.Dat"
  15. 000113            Organization Indexed
  16. 000114            Access Dynamic
  17. 000115            Record Key Dealer-Number
  18. 000116            Alternate Record Key Dealer-Name
  19. 000117            File Status Dealer-Status.
  20. 000120 Data Division.
  21. 000121 File Section.
  22. 000122 Fd  Dealer-File.
  23. 000123 01  Dealer-Record.
  24. 000124     03  Dealer-Number         Pic X(8).
  25. 000125     03  Dealer-Name.
  26. 000126         05  Last-Name   Pic X(25).
  27. 000127         05  First-Name  Pic X(15).
  28. 000128         05  Middle-Name Pic X(10).
  29. 000129     03  Address-Line-1      Pic X(50).
  30. 000130     03  Address-Line-2      Pic X(50).
  31. 000131     03  City                Pic X(40).
  32. 000132     03  State-Or-Country    Pic X(20).
  33. 000133     03  Postal-Code         Pic X(15).
  34. 000134     03  Home-Phone          Pic X(20).
  35. 000135     03  Work-Phone          Pic X(20).
  36. 000136     03  Other-Phone         Pic X(20).
  37. 000137     03  Start-Date          Pic 9(8).
  38. 000138     03  Last-Rent-Paid-Date Pic 9(8).
  39. 000139     03  Next-Rent-Due-Date  Pic 9(8).
  40. 000140     03  Rent-Amount         Pic 9(4)v99.
  41. 000141     03  Consignment-Percent Pic 9(3).
  42. 000142     03  Filler              Pic X(50).
  43. 000143 Working-Storage Section.
  44. 000144 01  Dealer-Status     Pic X(2) Value Spaces.
  45. 000145     88  Dealer-Success Value "00" Thru "09".
  46. 000150 01  Error-Message     Pic X(60) Value Spaces.
  47. 000151 Copy "sp2.cpy".
  48. 000160
  49. 000170 Copy "chapt24a.cpy".
  50. 000180 01  Date-Reverse-Area.
  51. 000181     03  Date-YYYYMMDD     Pic 9(8).
  52. 000182     03  Date-YYYYMMDD-X Redefines Date-YYYYMMDD.
  53. 000183         05  Date-YYYY     Pic 9(4).
  54. 000184         05  Date-MM       Pic 9(2).
  55. 000185         05  Date-DD       Pic 9(2).
  56. 000186     03  Date-MMddyyyy     Pic 9(8).
  57. 000187     03  Date-MMddyyyy-X Redefines Date-MMddyyyy.
  58. 000188         05  Date-MM       Pic 9(2).
  59. 000189         05  Date-DD       Pic 9(2).
  60. 000190         05  Date-YYYY     Pic 9(4).
  61. 000191 Procedure Division.
  62. 000200 Mainline.
  63. 000210******************
  64. 000220* Mainline Logic *
  65. 000230******************
  66. 000240     Perform Proc-Open-File
  67. 000250     Move Low-Values To Chapt24a-Data
  68. 000260     Move "chapt24a" To Chapt24a-Next-Panel
  69. 000270     Move "y" To Chapt24a-New-Window
  70. 000280     Move Low-Values To Chapt24a-Fields
  71. 000290     Move Low-Values To Chapt24a-Colrs
  72. 000300     Move Low-Values To Chapt24a-Types
  73. 000301     Perform Open-File
  74. 000302     If Not Dealer-Success
  75. 000303* Message Box Display!
  76. 000304        Move Low-Values To Sp2-Ms-Data
  77. 000305        Move "b" To Sp2-Ms-Icon
  78. 000306        Move "File Error"                  To Sp2-Ms-Title
  79. 000307        Move "o"                           To Sp2-Ms-Button
  80. 000309          Move 1                 To Sp2-Ms-Line-Cnt
  81. 000310          String "Error Opening Dealer File "
  82. 000311               Dealer-Status
  83. 000312               Delimited By Size
  84. 000313               Into Sp2-Ms-Text
  85. 000314        End-String
  86. 000316        Call "SP2" Using Sp2-Display-Message Sp2-Message-Data
  87. 000318     Else
  88. 000319* There Is No Reason To Perform These If The Open Fails
  89. 000320        Perform Proc-Con-Chapt24a
  90. 000321        Perform Proc-Close-Window
  91. 000322        Perform Close-File
  92. 000323     End-If
  93. 000330     Perform Proc-Close-File
  94. 000340     Perform Proc-End-Session
  95. 000350     Stop Run
  96. 000360     .
  97. 000370 Open-File.
  98. 000371     Open Input Dealer-File
  99. 000372     .
  100. 000373 Close-File.
  101. 000374     Close Dealer-File
  102. 000375     .
  103. 000380 Proc-Open-File.
  104. 000390*****************
  105. 000400* Open Sp2 File *
  106. 000410*****************
  107. 000420     Move Low-Values To Sp2-Fi-Data
  108. 000430     Move "C:\SPFJ3224\chapt24.pan" To Sp2-Fi-Name
  109. 000440     Call "SP2" Using Sp2-Open-File Sp2-File-Def
  110. 000450     .
  111. 000460
  112. 000470 Proc-Con-Chapt24a.
  113. 000480******************
  114. 000490* Converse Panel *
  115. 000500******************
  116. 000501     Perform With Test After Until
  117. 000502             Chapt24a-Key = Sp2-Key-Close Or
  118. 000503             Chapt24a-Exit-Hit
  119. 000510        Call "SP2" Using Sp2-Converse-Panel Chapt24a-Converse-Data
  120. 000520        Move Low-Value To Chapt24a-New-Window
  121. 000521        Perform Determine-Action
  122. 000522     End-Perform
  123. 000530     .
  124. 000540 Determine-Action.
  125. 000541     Evaluate True
  126. 000542        When Chapt24a-Exit-Hit
  127. 000543        When Chapt24a-Key = Sp2-Key-Close
  128. 000544           Continue
  129. 000545        When Chapt24a-Read-Hit
  130. 000546          Evaluate Chapt24a-Operation-Type
  131. 000547             When "Read Random Number"
  132. 000548                  Perform Read-Random-Number
  133. 000549             When "Read Random Name"
  134. 000550                  Perform Read-Random-Name
  135. 000551             When "Read Next Number"
  136. 000552                  Perform Read-Next-Number
  137. 000553             When "Read Next Name"
  138. 000554                  Perform Read-Next-Name
  139. 000555          End-Evaluate
  140. 000556        When Chapt24a-Clear-Hit
  141. 000557           Initialize Chapt24a-Fields
  142. 000558           Move "Read Random Number" To Chapt24a-Operation-Type
  143. 000559        When Other
  144. 000560           Continue
  145. 000561     End-Evaluate
  146. 000562     .
  147. 000563 Read-Random-Number.
  148. 000564     Move Chapt24a-Number To Dealer-Number
  149. 000565     Read Dealer-File
  150. 000566       Invalid Key
  151. 000570         String "Error on Random Read Number "
  152. 000571                 Dealer-Status
  153. 000572                 Delimited By Size
  154. 000573                 Into Error-Message
  155. 000574          End-String
  156. 000575          Perform Show-Error-Message
  157. 000576          Not Invalid Key
  158. 000577              Perform Fill-Panel-Data
  159. 000579     End-Read
  160. 000580     .
  161. 000581 Read-Random-Name.
  162. 000582     Move Chapt24a-Last To Last-Name
  163. 000583     Move Chapt24a-First To First-Name
  164. 000584     Move Chapt24a-Middle To Middle-Name
  165. 000586     Read Dealer-File Key Dealer-Name
  166. 000587        Invalid Key
  167. 000588          String "Error on Random Read Name "
  168. 000594                  Dealer-Status
  169. 000595                  Delimited By Size
  170. 000596                Into Sp2-Ms-Text
  171. 000597          End-String
  172. 000598          Perform Show-Error-Message
  173. 000599        Not Invalid Key
  174. 000600            Perform Fill-Panel-Data
  175. 000601     End-Read
  176. 000602     .
  177. 000603 Read-Next-Number.
  178. 000604     Move Chapt24a-Number To Dealer-Number
  179. 000605     Start Dealer-File Key > Dealer-Number
  180. 000606      Invalid Key
  181. 000607         String "Start Error Number "
  182. 000608                Dealer-Status
  183. 000609                Delimited By Size
  184. 000610                Into Error-Message
  185. 000611         End-String
  186. 000612         Perform Show-Error-Message
  187. 000613     End-Start
  188. 000614     If Dealer-Success
  189. 000615       Read Dealer-File Next
  190. 000616          At End
  191. 000617             Move "End of File, Read by Number" To Error-Message
  192. 000618             Perform Show-Error-Message
  193. 000619          Not At End
  194. 000620             Perform Fill-Panel-Data
  195. 000621       End-Read
  196. 000622     End-If
  197. 000623     .
  198. 000624 Read-Next-Name.
  199. 000625     Move Chapt24a-Last To Last-Name
  200. 000626     Move Chapt24a-First To First-Name
  201. 000627     Move Chapt24a-Middle To Middle-Name
  202. 000628     Start Dealer-File Key > Dealer-Name
  203. 000629      Invalid Key
  204. 000630         String "Start Error Name "
  205. 000631                Dealer-Status
  206. 000632                Delimited By Size
  207. 000633                Into Error-Message
  208. 000634         End-String
  209. 000635         Perform Show-Error-Message
  210. 000636     End-Start
  211. 000637     If Dealer-Success
  212. 000638       Read Dealer-File Next
  213. 000639          At End
  214. 000640             Move "End of File, Read by Name" To Error-Message
  215. 000641             Perform Show-Error-Message
  216. 000642          Not At End
  217. 000643             Perform Fill-Panel-Data
  218. 000644       End-Read
  219. 000645     End-If
  220. 000646     .
  221. 000647 Fill-Panel-Data.
  222. 000648     Move Dealer-Number       To Chapt24a-Number
  223. 000649     Move Last-Name           To Chapt24a-Last
  224. 000650     Move First-Name          To Chapt24a-First
  225. 000651     Move Middle-Name         To Chapt24a-Middle
  226. 000652     Move Address-Line-1      To Chapt24a-Address-Line-1
  227. 000653     Move Address-Line-2      To Chapt24a-Address-Line-2
  228. 000654     Move City                To Chapt24a-City
  229. 000655     Move State-Or-Country    To Chapt24a-State-Or-Country
  230. 000656     Move Postal-Code         To Chapt24a-Postal-Code
  231. 000657     Move Home-Phone          To Chapt24a-Home-Phone
  232. 000658     Move Work-Phone          To Chapt24a-Work-Phone
  233. 000659     Move Other-Phone         To Chapt24a-Other-Phone
  234. 000660     Move Start-Date          To Date-MMddyyyy
  235. 000661     Move Corresponding Date-MMddyyyy-X To Date-YYYYMMDD-X
  236. 000662     Move Date-YYYYMMDD       To Chapt24a-Start-Date
  237. 000663     Move Last-Rent-Paid-Date To Date-MMddyyyy
  238. 000664     Move Corresponding Date-MMddyyyy-X To Date-YYYYMMDD-X
  239. 000665     Move Date-YYYYMMDD       To Chapt24a-Last-Rent-Paid-Date
  240. 000666     Move Next-Rent-Due-Date To Date-MMddyyyy
  241. 000667     Move Corresponding Date-MMddyyyy-X To Date-YYYYMMDD-X
  242. 000668     Move Date-YYYYMMDD       To Chapt24a-Next-Rent-Due-Date
  243. 000670     Move Rent-Amount         To Chapt24a-Rent-Amount
  244. 000671     Move Consignment-Percent To Chapt24a-Consignment-Percent
  245. 000672     .
  246. 000673 Show-Error-Message.
  247. 000674     Move Low-Values To Sp2-Ms-Data
  248. 000675     Move "b" To Sp2-Ms-Icon
  249. 000676     Move "File Error"                  To Sp2-Ms-Title
  250. 000677     Move "o"                           To Sp2-Ms-Button
  251. 000678       Move 1                 To Sp2-Ms-Line-Cnt
  252. 000679     Move Error-Message To Sp2-Ms-Text
  253. 000680     Move Spaces To Error-Message
  254. 000681* Spaces Are Moved Into Error-Message Is Preparation Of The Next
  255. 000682* String Statement That Will Occur Using The Field.
  256. 000683     Call "SP2" Using Sp2-Display-Message Sp2-Message-Data
  257. 000684     .
  258. 000685 Proc-Close-Window.
  259. 000686************************
  260. 000687* Close Current Window *
  261. 000688************************
  262. 000689     Call "SP2" Using Sp2-Close-Window Sp2-Null-Parm
  263. 000690     .
  264. 000691
  265. 000692 Proc-Close-File.
  266. 000693**********************
  267. 000694* Close Current File *
  268. 000695**********************
  269. 000696     Call "SP2" Using Sp2-Close-File Sp2-Null-Parm
  270. 000697     .
  271. 000698
  272. 000699 Proc-End-Session.
  273. 000700*******************
  274. 000710* End Sp2 Session *
  275. 000720*******************
  276. 000730     Call "SP2" Using Sp2-End-Session Sp2-Null-Parm
  277. 000740     .