home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / o22516d1.zip / DSDEMO.@IP / BMSFRONT.CCP < prev    next >
Text File  |  1992-07-29  |  9KB  |  231 lines
  1. 000100 IDENTIFICATION DIVISION.
  2. 001100 ENVIRONMENT DIVISION.
  3. 001300 DATA DIVISION.
  4. 001500 WORKING-STORAGE SECTION.
  5. 001700 77  WORK-RESP-CODE  PIC 9(08) COMP.
  6.        77  WORK-LENGTH     PIC S9(4) COMP.
  7.        77  ARRAY-IND       PIC S9(4) COMP.
  8.        77  END-MESSAGE     PIC X(17) VALUE 'TRANSACTION ENDED'.
  9.  
  10. 002700 COPY CUST.
  11.        01  REDEF-SCRN002 REDEFINES SCRN002O.
  12.            05  FILLER PIC X(12).
  13.            05  WS-OCCURS OCCURS 10 TIMES.
  14.                10  FILLER      PIC X(7).
  15.                10  ORD-NO      PIC 9(6).
  16.                10  FILLER      PIC X(7).
  17.                10  ORD-MM      PIC 9(2).
  18.                10  FILLER      PIC X(7).
  19.                10  ORD-DD      PIC 9(2).
  20.                10  FILLER      PIC X(7).
  21.                10  ORD-YY      PIC 9(2).
  22.                10  FILLER      PIC X(7).
  23.                10  ORD-VALI    PIC 9(4).
  24.                10  FILLER      PIC X(7).
  25.                10  PAY-VALI    PIC 9(4).
  26.                10  FILLER      PIC X(7).
  27.                10  ORD-BALI    PIC 9(4).
  28.            05  FILLER          PIC X(61).
  29.        01  REDEF-SCRN003 REDEFINES REDEF-SCRN002.
  30.            05  FILLER PIC X(12).
  31.            05  WS-OCCURS OCCURS 10 TIMES.
  32.                10  FILLER      PIC X(47).
  33.                10  ORD-VALO    PIC Z(4).
  34.                10  FILLER      PIC X(7).
  35.                10  PAY-VALO    PIC Z(4).
  36.                10  FILLER      PIC X(7).
  37.                10  ORD-BALO    PIC Z(4).
  38.            05  FILLER          PIC X(61).
  39.  
  40.        COPY COMMAREA.
  41.  
  42.        LINKAGE SECTION.
  43.        01  DFHCOMMAREA  PIC X.
  44.  
  45. 002900 PROCEDURE DIVISION.
  46. 003000
  47. 003100 INITIAL-PARAGRAPH SECTION.
  48.            MOVE LENGTH OF COMM-AREA TO WORK-LENGTH
  49. 004500     IF EIBCALEN EQUAL ZERO
  50.                MOVE LOW-VALUES TO SCRN001I
  51. 006300         PERFORM SEND-MAP
  52.            ELSE
  53.                MOVE DFHCOMMAREA(1:EIBCALEN) TO COMM-AREA(1:EIBCALEN)
  54.                IF COMM-RETURN EQUAL 2
  55. 016000             EXEC CICS RECEIVE MAP ('SCRN002')
  56.                                      MAPSET ('CUST')
  57.                    END-EXEC
  58.                    EVALUATE EIBAID
  59. 004700                 WHEN '3'
  60.                            PERFORM FILL-RECORD-FROM-SCREEN2
  61.                            PERFORM FILL-SCREEN1-FROM-RECORD
  62.                            PERFORM SEND-MAP
  63. 004700                 WHEN '9 '
  64.                            PERFORM FILL-RECORD-FROM-SCREEN2
  65.                            PERFORM DERIVATIONS
  66.                            PERFORM SEND-ORDER
  67. 004700                 WHEN OTHER
  68. 009200                     MOVE 'INVALID KEY PRESSED'  TO ORDERRO
  69. 005900                     PERFORM SEND-ORDER
  70.                ELSE
  71. 016000             EXEC CICS RECEIVE MAP ('SCRN001')
  72.                                      MAPSET ('CUST')
  73.                    END-EXEC
  74.                    EVALUATE EIBAID
  75. 004700                 WHEN '3'
  76.                            EXEC CICS SEND TEXT
  77.                                           FROM (END-MESSAGE)
  78. 003900                                    LENGTH (17)
  79. 004000                                    ERASE
  80.                            END-EXEC
  81.                            EXEC CICS RETURN
  82.                            END-EXEC
  83. 004700                 WHEN '4'
  84.                            INITIALIZE COMM-AREA
  85.                            MOVE 1 TO COMM-LOAD-FLAG
  86.                            MOVE CODEI TO FILE-C-CODE
  87.                            PERFORM LINK-TO-IO
  88.                            PERFORM FILL-SCREEN1-FROM-RECORD
  89.                            PERFORM SEND-MAP
  90. 004700                 WHEN '5'
  91.                            PERFORM EDIT-SCREEN1
  92.                            IF ERRORO EQUAL SPACES
  93.                                MOVE 1 TO COMM-SAVE-FLAG
  94.                                PERFORM FILL-RECORD-FROM-SCREEN1
  95.                                PERFORM LINK-TO-IO
  96.                            END-IF
  97.                            PERFORM SEND-MAP
  98. 004700                 WHEN '6'
  99.                            INITIALIZE COMM-AREA
  100.                            MOVE 1 TO COMM-DELETE-FLAG
  101.                            MOVE CODEI TO FILE-C-CODE
  102.                            PERFORM LINK-TO-IO
  103.                            PERFORM SEND-MAP
  104. 004700                 WHEN '7'
  105.                            MOVE LOW-VALUES TO SCRN001O
  106.                            PERFORM SEND-MAP
  107. 004700                 WHEN '8'
  108.                            PERFORM FILL-RECORD-FROM-SCREEN1
  109.                            PERFORM FILL-SCREEN2-FROM-RECORD
  110.                            PERFORM DERIVATIONS
  111.                            PERFORM SEND-ORDER
  112. 004700                 WHEN OTHER
  113. 009200                     MOVE 'INVALID KEY PRESSED'  TO ERRORO
  114. 005900                     PERFORM SEND-MAP
  115. 006000             END-EVALUATE
  116.                END-IF
  117.            END-IF
  118.            .
  119.  
  120.        SEND-MAP SECTION.
  121.            INITIALIZE COMM-FLAGS
  122.            MOVE 1 TO COMM-RETURN
  123. 009400     EXEC CICS SEND MAP    ('SCRN001')
  124. 009500                    MAPSET ('CUST')
  125. 009600                    FROM   (SCRN001O)
  126.                           ERASE
  127. 009800                    FREEKB
  128. 010000     END-EXEC
  129.  
  130. 006500     EXEC CICS RETURN TRANSID  ('CUST')
  131. 006600                      COMMAREA (COMM-AREA)
  132. 006700                      LENGTH   (WORK-LENGTH)
  133. 006800     END-EXEC
  134. 006900     .
  135.  
  136.        SEND-ORDER SECTION.
  137.            INITIALIZE COMM-FLAGS
  138.            MOVE 2 TO COMM-RETURN
  139. 009400     EXEC CICS SEND MAP    ('SCRN002')
  140. 009500                    MAPSET ('CUST')
  141. 009600                    FROM   (SCRN002O)
  142.                           ERASE
  143. 009800                    FREEKB
  144. 010000     END-EXEC
  145.  
  146. 006500     EXEC CICS RETURN TRANSID  ('CUST')
  147. 006600                      COMMAREA (COMM-AREA)
  148. 006700                      LENGTH   (WORK-LENGTH)
  149. 006800     END-EXEC
  150. 006900     .
  151.  
  152.        LINK-TO-IO SECTION.
  153.            EXEC CICS LINK PROGRAM ('CUSTIO')
  154.                           COMMAREA (COMM-AREA)
  155.                           LENGTH (WORK-LENGTH)
  156.            END-EXEC
  157.            .
  158.  
  159.        EDIT-SCREEN1 SECTION.
  160.            MOVE SPACES TO ERRORO
  161.            IF LIMITI LESS THAN 1000 OR GREATER THAN 5000
  162.                MOVE 'CREDIT LIMIT MUST BE FROM 1000 TO 5000' TO ERRORO
  163.            ELSE
  164.                IF AREAI NOT EQUAL 'N' AND 'S' AND 'E' AND 'W'
  165.                    MOVE 'AREA MUST BE N,S,E,W' TO ERRORO
  166.                END-IF
  167.            END-IF
  168.            .
  169.  
  170.        FILL-RECORD-FROM-SCREEN1 SECTION.
  171.            MOVE CODEI  TO FILE-C-CODE
  172.            MOVE NAMEI  TO FILE-C-NAME
  173.            MOVE ADDR1I TO FILE-C-ADDR1
  174.            MOVE ADDR2I TO FILE-C-ADDR2
  175.            MOVE ADDR3I TO FILE-C-ADDR3
  176.            MOVE ADDR4I TO FILE-C-ADDR4
  177.            MOVE LIMITI TO FILE-C-LIMIT
  178.            MOVE AREAI  TO FILE-C-AREA
  179.            .
  180.  
  181.        FILL-RECORD-FROM-SCREEN2 SECTION.
  182.            PERFORM VARYING ARRAY-IND FROM 1 BY 1
  183.                                           UNTIL ARRAY-IND > 10
  184.                MOVE ORD-NO(ARRAY-IND)   TO FILE-ORD-NO(ARRAY-IND)
  185.                MOVE ORD-MM(ARRAY-IND)   TO FILE-ORD-MM(ARRAY-IND)
  186.                MOVE ORD-DD(ARRAY-IND)   TO FILE-ORD-DD(ARRAY-IND)
  187.                MOVE ORD-YY(ARRAY-IND)   TO FILE-ORD-YY(ARRAY-IND)
  188.                TRANSFORM ORD-VALI(ARRAY-IND) FROM SPACE TO ZERO
  189.                TRANSFORM PAY-VALI(ARRAY-IND) FROM SPACE TO ZERO
  190.                MOVE ORD-VALI(ARRAY-IND) TO FILE-ORD-VAL(ARRAY-IND)
  191.                MOVE PAY-VALI(ARRAY-IND) TO FILE-PAY-VAL(ARRAY-IND)
  192.            END-PERFORM
  193.            .
  194.  
  195.        FILL-SCREEN1-FROM-RECORD SECTION.
  196.            MOVE FILE-C-CODE            TO CODEO
  197.            MOVE FILE-C-NAME            TO NAMEO
  198.            MOVE FILE-C-ADDR1           TO ADDR1O
  199.            MOVE FILE-C-ADDR2           TO ADDR2O
  200.            MOVE FILE-C-ADDR3           TO ADDR3O
  201.            MOVE FILE-C-ADDR4           TO ADDR4O
  202.            MOVE FILE-C-LIMIT           TO LIMITO
  203.            MOVE FILE-C-AREA            TO AREAO
  204.            MOVE COMM-MESSAGE TO ERRORI
  205.            .
  206.  
  207.        FILL-SCREEN2-FROM-RECORD SECTION.
  208.            PERFORM VARYING ARRAY-IND
  209.                               FROM 1 BY 1 UNTIL ARRAY-IND > 10
  210.                MOVE FILE-ORD-NO(ARRAY-IND)  TO ORD-NO(ARRAY-IND)
  211.                MOVE FILE-ORD-MM(ARRAY-IND)  TO ORD-MM(ARRAY-IND)
  212.                MOVE FILE-ORD-DD(ARRAY-IND)  TO ORD-DD(ARRAY-IND)
  213.                MOVE FILE-ORD-YY(ARRAY-IND)  TO ORD-YY(ARRAY-IND)
  214.                MOVE FILE-ORD-VAL(ARRAY-IND) TO ORD-VALI(ARRAY-IND)
  215.                MOVE FILE-PAY-VAL(ARRAY-IND) TO PAY-VALI(ARRAY-IND)
  216.            .
  217.  
  218.        DERIVATIONS SECTION.
  219.            MOVE 0 TO BALANCEI
  220.            PERFORM VARYING ARRAY-IND
  221.                               FROM 1 BY 1 UNTIL ARRAY-IND > 10
  222.                COMPUTE ORD-BALI(ARRAY-IND) =
  223.                      ORD-VALI(ARRAY-IND) - PAY-VALI(ARRAY-IND)
  224.                ADD ORD-BALI(ARRAY-IND) TO BALANCEI
  225.                MOVE ORD-VALI(ARRAY-IND) TO ORD-VALO(ARRAY-IND)
  226.                MOVE PAY-VALI(ARRAY-IND) TO PAY-VALO(ARRAY-IND)
  227.                MOVE ORD-BALI(ARRAY-IND) TO ORD-BALO(ARRAY-IND)
  228.            END-PERFORM
  229.            MOVE BALANCEI TO BALANCEO
  230.            .
  231.