home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
o22516d1.zip
/
DSDEMO.@IP
/
BMSFRONT.CCP
< prev
next >
Wrap
Text File
|
1992-07-29
|
9KB
|
231 lines
000100 IDENTIFICATION DIVISION.
001100 ENVIRONMENT DIVISION.
001300 DATA DIVISION.
001500 WORKING-STORAGE SECTION.
001700 77 WORK-RESP-CODE PIC 9(08) COMP.
77 WORK-LENGTH PIC S9(4) COMP.
77 ARRAY-IND PIC S9(4) COMP.
77 END-MESSAGE PIC X(17) VALUE 'TRANSACTION ENDED'.
002700 COPY CUST.
01 REDEF-SCRN002 REDEFINES SCRN002O.
05 FILLER PIC X(12).
05 WS-OCCURS OCCURS 10 TIMES.
10 FILLER PIC X(7).
10 ORD-NO PIC 9(6).
10 FILLER PIC X(7).
10 ORD-MM PIC 9(2).
10 FILLER PIC X(7).
10 ORD-DD PIC 9(2).
10 FILLER PIC X(7).
10 ORD-YY PIC 9(2).
10 FILLER PIC X(7).
10 ORD-VALI PIC 9(4).
10 FILLER PIC X(7).
10 PAY-VALI PIC 9(4).
10 FILLER PIC X(7).
10 ORD-BALI PIC 9(4).
05 FILLER PIC X(61).
01 REDEF-SCRN003 REDEFINES REDEF-SCRN002.
05 FILLER PIC X(12).
05 WS-OCCURS OCCURS 10 TIMES.
10 FILLER PIC X(47).
10 ORD-VALO PIC Z(4).
10 FILLER PIC X(7).
10 PAY-VALO PIC Z(4).
10 FILLER PIC X(7).
10 ORD-BALO PIC Z(4).
05 FILLER PIC X(61).
COPY COMMAREA.
LINKAGE SECTION.
01 DFHCOMMAREA PIC X.
002900 PROCEDURE DIVISION.
003000
003100 INITIAL-PARAGRAPH SECTION.
MOVE LENGTH OF COMM-AREA TO WORK-LENGTH
004500 IF EIBCALEN EQUAL ZERO
MOVE LOW-VALUES TO SCRN001I
006300 PERFORM SEND-MAP
ELSE
MOVE DFHCOMMAREA(1:EIBCALEN) TO COMM-AREA(1:EIBCALEN)
IF COMM-RETURN EQUAL 2
016000 EXEC CICS RECEIVE MAP ('SCRN002')
MAPSET ('CUST')
END-EXEC
EVALUATE EIBAID
004700 WHEN '3'
PERFORM FILL-RECORD-FROM-SCREEN2
PERFORM FILL-SCREEN1-FROM-RECORD
PERFORM SEND-MAP
004700 WHEN '9 '
PERFORM FILL-RECORD-FROM-SCREEN2
PERFORM DERIVATIONS
PERFORM SEND-ORDER
004700 WHEN OTHER
009200 MOVE 'INVALID KEY PRESSED' TO ORDERRO
005900 PERFORM SEND-ORDER
ELSE
016000 EXEC CICS RECEIVE MAP ('SCRN001')
MAPSET ('CUST')
END-EXEC
EVALUATE EIBAID
004700 WHEN '3'
EXEC CICS SEND TEXT
FROM (END-MESSAGE)
003900 LENGTH (17)
004000 ERASE
END-EXEC
EXEC CICS RETURN
END-EXEC
004700 WHEN '4'
INITIALIZE COMM-AREA
MOVE 1 TO COMM-LOAD-FLAG
MOVE CODEI TO FILE-C-CODE
PERFORM LINK-TO-IO
PERFORM FILL-SCREEN1-FROM-RECORD
PERFORM SEND-MAP
004700 WHEN '5'
PERFORM EDIT-SCREEN1
IF ERRORO EQUAL SPACES
MOVE 1 TO COMM-SAVE-FLAG
PERFORM FILL-RECORD-FROM-SCREEN1
PERFORM LINK-TO-IO
END-IF
PERFORM SEND-MAP
004700 WHEN '6'
INITIALIZE COMM-AREA
MOVE 1 TO COMM-DELETE-FLAG
MOVE CODEI TO FILE-C-CODE
PERFORM LINK-TO-IO
PERFORM SEND-MAP
004700 WHEN '7'
MOVE LOW-VALUES TO SCRN001O
PERFORM SEND-MAP
004700 WHEN '8'
PERFORM FILL-RECORD-FROM-SCREEN1
PERFORM FILL-SCREEN2-FROM-RECORD
PERFORM DERIVATIONS
PERFORM SEND-ORDER
004700 WHEN OTHER
009200 MOVE 'INVALID KEY PRESSED' TO ERRORO
005900 PERFORM SEND-MAP
006000 END-EVALUATE
END-IF
END-IF
.
SEND-MAP SECTION.
INITIALIZE COMM-FLAGS
MOVE 1 TO COMM-RETURN
009400 EXEC CICS SEND MAP ('SCRN001')
009500 MAPSET ('CUST')
009600 FROM (SCRN001O)
ERASE
009800 FREEKB
010000 END-EXEC
006500 EXEC CICS RETURN TRANSID ('CUST')
006600 COMMAREA (COMM-AREA)
006700 LENGTH (WORK-LENGTH)
006800 END-EXEC
006900 .
SEND-ORDER SECTION.
INITIALIZE COMM-FLAGS
MOVE 2 TO COMM-RETURN
009400 EXEC CICS SEND MAP ('SCRN002')
009500 MAPSET ('CUST')
009600 FROM (SCRN002O)
ERASE
009800 FREEKB
010000 END-EXEC
006500 EXEC CICS RETURN TRANSID ('CUST')
006600 COMMAREA (COMM-AREA)
006700 LENGTH (WORK-LENGTH)
006800 END-EXEC
006900 .
LINK-TO-IO SECTION.
EXEC CICS LINK PROGRAM ('CUSTIO')
COMMAREA (COMM-AREA)
LENGTH (WORK-LENGTH)
END-EXEC
.
EDIT-SCREEN1 SECTION.
MOVE SPACES TO ERRORO
IF LIMITI LESS THAN 1000 OR GREATER THAN 5000
MOVE 'CREDIT LIMIT MUST BE FROM 1000 TO 5000' TO ERRORO
ELSE
IF AREAI NOT EQUAL 'N' AND 'S' AND 'E' AND 'W'
MOVE 'AREA MUST BE N,S,E,W' TO ERRORO
END-IF
END-IF
.
FILL-RECORD-FROM-SCREEN1 SECTION.
MOVE CODEI TO FILE-C-CODE
MOVE NAMEI TO FILE-C-NAME
MOVE ADDR1I TO FILE-C-ADDR1
MOVE ADDR2I TO FILE-C-ADDR2
MOVE ADDR3I TO FILE-C-ADDR3
MOVE ADDR4I TO FILE-C-ADDR4
MOVE LIMITI TO FILE-C-LIMIT
MOVE AREAI TO FILE-C-AREA
.
FILL-RECORD-FROM-SCREEN2 SECTION.
PERFORM VARYING ARRAY-IND FROM 1 BY 1
UNTIL ARRAY-IND > 10
MOVE ORD-NO(ARRAY-IND) TO FILE-ORD-NO(ARRAY-IND)
MOVE ORD-MM(ARRAY-IND) TO FILE-ORD-MM(ARRAY-IND)
MOVE ORD-DD(ARRAY-IND) TO FILE-ORD-DD(ARRAY-IND)
MOVE ORD-YY(ARRAY-IND) TO FILE-ORD-YY(ARRAY-IND)
TRANSFORM ORD-VALI(ARRAY-IND) FROM SPACE TO ZERO
TRANSFORM PAY-VALI(ARRAY-IND) FROM SPACE TO ZERO
MOVE ORD-VALI(ARRAY-IND) TO FILE-ORD-VAL(ARRAY-IND)
MOVE PAY-VALI(ARRAY-IND) TO FILE-PAY-VAL(ARRAY-IND)
END-PERFORM
.
FILL-SCREEN1-FROM-RECORD SECTION.
MOVE FILE-C-CODE TO CODEO
MOVE FILE-C-NAME TO NAMEO
MOVE FILE-C-ADDR1 TO ADDR1O
MOVE FILE-C-ADDR2 TO ADDR2O
MOVE FILE-C-ADDR3 TO ADDR3O
MOVE FILE-C-ADDR4 TO ADDR4O
MOVE FILE-C-LIMIT TO LIMITO
MOVE FILE-C-AREA TO AREAO
MOVE COMM-MESSAGE TO ERRORI
.
FILL-SCREEN2-FROM-RECORD SECTION.
PERFORM VARYING ARRAY-IND
FROM 1 BY 1 UNTIL ARRAY-IND > 10
MOVE FILE-ORD-NO(ARRAY-IND) TO ORD-NO(ARRAY-IND)
MOVE FILE-ORD-MM(ARRAY-IND) TO ORD-MM(ARRAY-IND)
MOVE FILE-ORD-DD(ARRAY-IND) TO ORD-DD(ARRAY-IND)
MOVE FILE-ORD-YY(ARRAY-IND) TO ORD-YY(ARRAY-IND)
MOVE FILE-ORD-VAL(ARRAY-IND) TO ORD-VALI(ARRAY-IND)
MOVE FILE-PAY-VAL(ARRAY-IND) TO PAY-VALI(ARRAY-IND)
.
DERIVATIONS SECTION.
MOVE 0 TO BALANCEI
PERFORM VARYING ARRAY-IND
FROM 1 BY 1 UNTIL ARRAY-IND > 10
COMPUTE ORD-BALI(ARRAY-IND) =
ORD-VALI(ARRAY-IND) - PAY-VALI(ARRAY-IND)
ADD ORD-BALI(ARRAY-IND) TO BALANCEI
MOVE ORD-VALI(ARRAY-IND) TO ORD-VALO(ARRAY-IND)
MOVE PAY-VALI(ARRAY-IND) TO PAY-VALO(ARRAY-IND)
MOVE ORD-BALI(ARRAY-IND) TO ORD-BALO(ARRAY-IND)
END-PERFORM
MOVE BALANCEI TO BALANCEO
.