home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / Cobol32 / PowerFRM / frmRTS.z / sale.cob < prev    next >
Text File  |  1997-03-31  |  13KB  |  257 lines
  1. 000010 IDENTIFICATION    DIVISION.
  2. 000020 PROGRAM-ID.       SALES.
  3. 000030 ENVIRONMENT       DIVISION.
  4. 000040 CONFIGURATION     SECTION.
  5. 000050 SPECIAL-NAMES.
  6. 000060      SYMBOLIC CONSTANT
  7. 000070      NORMAL      IS "  "
  8. 000080      .
  9. 000090*
  10. 000100* Define sequential file for printing
  11. 000110*
  12. 000120 INPUT-OUTPUT      SECTION.
  13. 000130 FILE-CONTROL.
  14. 000140      SELECT  PRINT-FILE           ASSIGN TO PRTFILE
  15. 000150              ORGANIZATION         IS SEQUENTIAL
  16. 000160              ACCESS MODE          IS SEQUENTIAL
  17. 000170              FORMAT               IS PRT-FORMAT
  18. 000180              GROUP                IS PRT-GROUP
  19. 000190              .
  20. 000200 DATA                DIVISION.
  21. 000210 FILE                SECTION.
  22. 000220*
  23. 000230* Copy print record from format descriptor
  24. 000240*
  25. 000250 FD   PRINT-FILE.
  26. 000260      COPY  SALE OF XMDLIB.
  27. 000270*               ~~~~~name of the format descriptor
  28. 000280 WORKING-STORAGE SECTION.
  29. 000290*
  30. 000300* Control Area
  31. 000310*
  32. 000320 01   PRT-PARAM.
  33. 000330      03  PRT-FORMAT      PIC X(08)   VALUE " ".
  34. 000340      03  PRT-GROUP       PIC X(08)   VALUE " ".
  35. 000350*
  36. 000360* Print Data
  37. 000370*
  38. 000380 01   SAMPLE-DATA.
  39. 000390*  --- These data being loaded from DB in the actual program. ---
  40. 000400   02   DETAIL-LINE.
  41. 000410      03  REGION-NAME-DATA-TABLE.
  42. 000420        04                      PIC X(10)  VALUE "New York".
  43. 000430        04                      PIC X(10)  VALUE "Washington".
  44. 000440        04                      PIC X(10)  VALUE "Boston".
  45. 000450        04                      PIC X(10)  VALUE "San Jose".
  46. 000460        04                      PIC X(10)  VALUE "Chicago".
  47. 000470        04                      PIC X(10)  VALUE "Los angels".
  48. 000480        04                      PIC X(10)  VALUE "Sacramento".
  49. 000490        04                      PIC X(10)  VALUE "Honolulu".
  50. 000500        04                      PIC X(10)  VALUE "Tokyo".
  51. 000510        04                      PIC X(10)  VALUE "HongKong".
  52. 000520      03  REDEFINES REGION-NAME-DATA-TABLE.
  53. 000530        04  REGION-NAME-DATA    PIC X(10) OCCURS 10.
  54. 000540      03  GROUP-NAME-TABLE.
  55. 000550        04                      PIC X(10)  VALUE "GOLF".
  56. 000560        04                      PIC X(10)  VALUE "FOOTBALL".
  57. 000570        04                      PIC X(10)  VALUE "SKI".
  58. 000580        04                      PIC X(10)  VALUE "TENNIS".
  59. 000590      03  REDEFINES GROUP-NAME-TABLE.
  60. 000600        04  G-NAME      PIC X(10) OCCURS 4.
  61. 000610      03  GOODS-NAME-DATA-TABLE.
  62. 000620        04                      PIC X(12)  VALUE "Shoes".
  63. 000630        04                      PIC X(12)  VALUE "Bag".
  64. 000640        04                      PIC X(12)  VALUE "Wear".
  65. 000650        04                      PIC X(12)  VALUE "Ball".
  66. 000660        04                      PIC X(12)  VALUE "Shoes".
  67. 000670        04                      PIC X(12)  VALUE "Wear".
  68. 000680        04                      PIC X(12)  VALUE "Club Set".
  69. 000690        04                      PIC X(12)  VALUE "Bag".
  70. 000700        04                      PIC X(12)  VALUE "Ball".
  71. 000710        04                      PIC X(12)  VALUE "Wear".
  72. 000720        04                      PIC X(12)  VALUE "Shoes".
  73. 000730        04                      PIC X(12)  VALUE "Club Set".
  74. 000740        04                      PIC X(12)  VALUE "Shoes".
  75. 000750        04                      PIC X(12)  VALUE "Ball".
  76. 000760        04                      PIC X(12)  VALUE "Bag".
  77. 000770        04                      PIC X(12)  VALUE "Club Set".
  78. 000780      03  REDEFINES GOODS-NAME-DATA-TABLE.
  79. 000790        04  GOODS-NAME-DATA     PIC X(12)  OCCURS 16.
  80. 000800      03  DATE-DATA-TABLE.
  81. 000810        04                      PIC 9(6)  VALUE 200196.
  82. 000820        04                      PIC 9(6)  VALUE 200296.
  83. 000830        04                      PIC 9(6)  VALUE 200296.
  84. 000840        04                      PIC 9(6)  VALUE 200396.
  85. 000850        04                      PIC 9(6)  VALUE 200396.
  86. 000860        04                      PIC 9(6)  VALUE 200496.
  87. 000870        04                      PIC 9(6)  VALUE 200596.
  88. 000880        04                      PIC 9(6)  VALUE 200696.
  89. 000890        04                      PIC 9(6)  VALUE 200696.
  90. 000900        04                      PIC 9(6)  VALUE 200696.
  91. 000910        04                      PIC 9(6)  VALUE 200796.
  92. 000920        04                      PIC 9(6)  VALUE 200896.
  93. 000930        04                      PIC 9(6)  VALUE 200996.
  94. 000940        04                      PIC 9(6)  VALUE 201196.
  95. 000950        04                      PIC 9(6)  VALUE 201296.
  96. 000960        04                      PIC 9(6)  VALUE 201296.
  97. 000970      03  REDEFINES DATE-DATA-TABLE.
  98. 000980        04  DATE-DATA           PIC 9(6)  OCCURS 16.
  99. 000990      03  CUSTOMER-NAME-DATA-TABLE.
  100. 001000        04                      PIC X(16) VALUE "Green Inc.".
  101. 001010        04                      PIC X(16) VALUE "Blue Co.,Ltd.".
  102. 001020        04                      PIC X(16) VALUE "Cyan Trading".
  103. 001030        04                      PIC X(16) VALUE "White Inc.".
  104. 001040        04                      PIC X(16) VALUE "Yellow Inc.".
  105. 001050        04                      PIC X(16) VALUE "Black Trading".
  106. 001060        04                      PIC X(16) VALUE "Brown Co.,Ltd.".
  107. 001070        04                      PIC X(16) VALUE "Gray Trading".
  108. 001080        04                      PIC X(16) VALUE "Pink Inc.".
  109. 001090        04                      PIC X(16) VALUE "Light Blue Inc.".
  110. 001100        04                      PIC X(16) VALUE "Red Business".
  111. 001110        04                      PIC X(16) VALUE "Magenta Co.,Ltd".
  112. 001120        04                      PIC X(16) VALUE "Purple Inc.".
  113. 001130        04                      PIC X(16) VALUE "Silver Business".
  114. 001140        04                      PIC X(16) VALUE "Orange Trading".
  115. 001150        04                      PIC X(16) VALUE "Golden Inc.".
  116. 001160      03  REDEFINES CUSTOMER-NAME-DATA-TABLE.
  117. 001170        04  CUSTOMER-NAME-DATA  PIC X(16) OCCURS 16.
  118. 001180      03  SALES-DATA-TABLE.
  119. 001190        04                      PIC 9(13) VALUE   200000.
  120. 001200        04                      PIC 9(13) VALUE   600000.
  121. 001210        04                      PIC 9(13) VALUE   500000.
  122. 001220        04                      PIC 9(13) VALUE     5000.
  123. 001230        04                      PIC 9(13) VALUE   200000.
  124. 001240        04                      PIC 9(13) VALUE   500000.
  125. 001250        04                      PIC 9(13) VALUE  1800000.
  126. 001260        04                      PIC 9(13) VALUE   600000.
  127. 001270        04                      PIC 9(13) VALUE     5000.
  128. 001280        04                      PIC 9(13) VALUE   500000.
  129. 001290        04                      PIC 9(13) VALUE   200000.
  130. 001300        04                      PIC 9(13) VALUE  1800000.
  131. 001310        04                      PIC 9(13) VALUE   200000.
  132. 001320        04                      PIC 9(13) VALUE     5000.
  133. 001330        04                      PIC 9(13) VALUE   600000.
  134. 001340        04                      PIC 9(13) VALUE  1800000.
  135. 001350      03  REDEFINES SALES-DATA-TABLE.
  136. 001360        04  SALES-DATA          PIC 9(13) OCCURS 16.
  137. 001370   02   SUM-LINE.
  138. 001380      03  SALES-SUM             PIC 9(13) VALUE  0.
  139. 001390   02   TOTAL-SUM-LINE.
  140. 001400      03  SALES-TOTAL-SUM       PIC 9(13) VALUE  0.
  141. 001410   02   WORK-TABLE.
  142. 001420      03  GROUP-1-TABLE.
  143. 001430        04           PIC 9(2) VALUE  16.
  144. 001440        04           PIC 9(2) VALUE  12.
  145. 001450        04           PIC 9(2) VALUE   5.
  146. 001460        04           PIC 9(2) VALUE   9.
  147. 001470        04           PIC 9(2) VALUE  15.
  148. 001480        04           PIC 9(2) VALUE   8.
  149. 001490        04           PIC 9(2) VALUE   7.
  150. 001500        04           PIC 9(2) VALUE   5.
  151. 001510        04           PIC 9(2) VALUE  13.
  152. 001520        04           PIC 9(2) VALUE  10.
  153. 001530      03  GROUP-2-TABLE.
  154. 001540        04           PIC 9(2) VALUE   7.
  155. 001550        04           PIC 9(2) VALUE   8.
  156. 001560        04           PIC 9(2) VALUE   9.
  157. 001570        04           PIC 9(2) VALUE  14.
  158. 001580        04           PIC 9(2) VALUE   5.
  159. 001590        04           PIC 9(2) VALUE   9.
  160. 001600        04           PIC 9(2) VALUE  10.
  161. 001610        04           PIC 9(2) VALUE   7.
  162. 001620        04           PIC 9(2) VALUE   5.
  163. 001630        04           PIC 9(2) VALUE  13.
  164. 001640      03  GROUP-3-TABLE.
  165. 001650        04           PIC 9(2) VALUE   9.
  166. 001660        04           PIC 9(2) VALUE   6.
  167. 001670        04           PIC 9(2) VALUE   9.
  168. 001680        04           PIC 9(2) VALUE  12.
  169. 001690        04           PIC 9(2) VALUE   8.
  170. 001700        04           PIC 9(2) VALUE  13.
  171. 001710        04           PIC 9(2) VALUE   5.
  172. 001720        04           PIC 9(2) VALUE   8.
  173. 001730        04           PIC 9(2) VALUE  11.
  174. 001740        04           PIC 9(2) VALUE   8.
  175. 001750      03  GROUP-4-TABLE.
  176. 001760        04           PIC 9(2) VALUE  10.
  177. 001770        04           PIC 9(2) VALUE  11.
  178. 001780        04           PIC 9(2) VALUE   9.
  179. 001790        04           PIC 9(2) VALUE  13.
  180. 001800        04           PIC 9(2) VALUE   7.
  181. 001810        04           PIC 9(2) VALUE  10.
  182. 001820        04           PIC 9(2) VALUE  12.
  183. 001830        04           PIC 9(2) VALUE   6.
  184. 001840        04           PIC 9(2) VALUE   4.
  185. 001850        04           PIC 9(2) VALUE   7.
  186. 001860    02  REDEFINES WORK-TABLE.
  187. 001870      03             OCCURS 4.
  188. 001880        04  GROUP-N  PIC 9(2) OCCURS 10.
  189. 001890* Counters
  190. 001900 77 CNTI            PIC 9(2) BINARY.
  191. 001910 77 CNTJ            PIC 9(2) BINARY.
  192. 001920 77 PAGEN         PIC 9(3) BINARY.
  193. 001930*
  194. 001940******************************************************************
  195. 001950 PROCEDURE    DIVISION.
  196. 001960*
  197. 001970* Open Print File
  198. 001980      OPEN  OUTPUT  PRINT-FILE
  199. 001990      INITIALIZE  SALE
  200. 002000      .
  201. 002010* Header
  202. 002020*  (fixed positional partition : HEAD)
  203. 002030      PERFORM VARYING PAGEN FROM 1 BY 1 UNTIL PAGEN > 2
  204. 002040        MOVE  "SALE"    TO  PRT-FORMAT
  205. 002050        MOVE  "HEAD"     TO  PRT-GROUP
  206. 002060        MOVE  PAGEN      TO  PAGE-COUNT OF SALE
  207. 002070        WRITE SALE AFTER ADVANCING PAGE
  208. 002080*                             ~~~~~~~~~~~~~~~~~~~~ form feed
  209. 002090        PERFORM  VARYING CNTI FROM 1 BY 1 UNTIL CNTI > 4
  210. 002100* Detail line printing
  211. 002110*  (floating positional partition : DETAIL)
  212. 002120*   Set sample data
  213. 002130          MOVE  "DETAIL"   TO  PRT-GROUP
  214. 002140          PERFORM VARYING CNTJ FROM 1 BY 1 UNTIL CNTJ > GROUP-N(CNTI PAGEN)
  215. 002150            MOVE GOODS-NAME-DATA(CNTJ)    TO GOODS-NAME    OF SALE
  216. 002160            MOVE DATE-DATA(CNTJ)          TO SALES-DATE    OF SALE
  217. 002170            MOVE CUSTOMER-NAME-DATA(CNTJ) TO CUSTOMER-NAME OF SALE
  218. 002180            MOVE SALES-DATA(CNTJ)         TO SALES         OF SALE
  219. 002190            ADD  SALES-DATA(CNTJ)           TO SALES-SUM     OF SUM-LINE
  220. 002200            IF  CNTJ = 1     THEN
  221. 002210              MOVE REGION-NAME-DATA(PAGEN)  TO REGION-NAME   OF SALE
  222. 002220              MOVE G-NAME(CNTI)                 TO GROUP-NAME    OF SALE
  223. 002230               IF   CNTI = 1     THEN
  224. 002240                  WRITE SALE AFTER ADVANCING 1 LINE
  225. 002250*                                       ~~~~~~~~~~~~~~~~~~~~~ form feed
  226. 002260               ELSE
  227. 002270                   WRITE SALE AFTER ADVANCING 0 LINE
  228. 002280*                                        ~~~~~~~~~~~~~~~~~~~~ no form feed
  229. 002290              END-IF
  230. 002300              MOVE  SPACE                   TO REGION-NAME   OF SALE
  231. 002310              MOVE  SPACE                   TO GROUP-NAME    OF SALE
  232. 002320            ELSE
  233. 002330                WRITE SALE AFTER ADVANCING 0 LINE
  234. 002340*                                     ~~~~~~~~~~~~~~~~~~~~ no form feed
  235. 002350            END-IF
  236. 002360          END-PERFORM
  237. 002370* Sum printing
  238. 002380*   (floating positional partition : SUM)
  239. 002390          MOVE  "SUM"   TO  PRT-GROUP
  240. 002400          MOVE CORR SUM-LINE OF SAMPLE-DATA TO SALE
  241. 002410          WRITE SALE AFTER ADVANCING 0 LINE
  242. 002420          ADD  SALES-SUM OF SUM-LINE TO SALES-TOTAL-SUM OF TOTAL-SUM-LINE
  243. 002430          MOVE 0 TO SALES-SUM OF SUM-LINE
  244. 002440        END-PERFORM
  245. 002450* Total sum printing
  246. 002460*   (floating positional partition : TOTAL)
  247. 002470        MOVE  "TOTAL"    TO  PRT-GROUP
  248. 002480        MOVE  "LOGO.BMP" TO  LOGO-AREA  OF SALE
  249. 002490        MOVE  "B"        TO  EDIT-MODE OF LOGO-AREA  OF SALE
  250. 002500        MOVE CORR TOTAL-SUM-LINE OF SAMPLE-DATA TO SALE
  251. 002510        WRITE SALE  AFTER ADVANCING 0 LINE
  252. 002520      END-PERFORM
  253. 002530******************************************************************
  254. 002540      CLOSE PRINT-FILE
  255. 002550      STOP RUN
  256. 002560      .
  257. 002570 END PROGRAM SALES.