rendered paste body//KC03I98 JOB 'xxxxx',MSGCLASS=H,MSGLEVEL=(1,1),REGION=8M,
// NOTIFY=&SYSUID
//*********************************************************************
//** Project : COMP 35 - Assignment 3
//** Purpose : Allow the user to add bids
//**
//*********************************************************************
//*
//* THIS IS THE JCL REQUIRED FOR SUBMITTING CICS COBOL PROGRAMS
//*
//CICSPROC JCLLIB ORDER=(SLC.CPA.PROCLIB.PDS)
//*
//*********************************************************************
//* TRANSLATE COMPILE
//* AND LINK A CICS COBOL PROGRAM
//*********************************************************************
//COMPLI EXEC DFHYITVL,PROGLIB='TSOECCC.CICSTS12.STUDENT.LOADLIB',
// REG='4M',DSCTLIB='KC03I98.COMP35.CNTL',
// PARM.TRN='NOCBLCARD,COBOL3',
// PARM.COB='RENT,APOST,OBJECT,NODYNAM,LIB,SIZE(1048376)'
//TRN.SYSIN DD *
IDENTIFICATION DIVISION.
*
PROGRAM-ID. ADDP98.
*
ENVIRONMENT DIVISION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
*
01 SWITCHES.
*
05 VALID-DATA-SW PIC X(01) VALUE 'Y'.
88 VALID-DATA VALUE 'Y'.
05 CUSTOMER-FOUND-SW PIC X(01).
88 CUSTOMER-FOUND VALUE 'Y'.
05 ITEM-FOUND-SW PIC X(01).
88 ITEM-FOUND VALUE 'Y'.
*
01 FLAGS.
*
05 SEND-FLAG PIC X(01).
88 SEND-ERASE VALUE '1'.
88 SEND-DATAONLY VALUE '2'.
88 SEND-DATAONLY-ALARM VALUE '3'.
*
01 WORK-FIELDS.
*
05 BID-SUB PIC S9(04) COMP.
05 ITEM-COUNT PIC S9(04) COMP VALUE ZERO.
*
01 COMMUNICATION-AREA PIC X(01).
*
01 RESPONSE-CODE PIC S9(08) COMP.
*
COPY BIDDER.
*
COPY ITEMMAST.
*
COPY ADDMAP.
*
COPY DFHAID.
*
LINKAGE SECTION.
*
01 DFHCOMMAREA PIC X(01).
*
PROCEDURE DIVISION.
*
0000-PROCESS-CUSTOMER-BIDS.
*
EVALUATE TRUE
WHEN EIBCALEN = ZERO
MOVE LOW-VALUE TO ADDMAP
SET SEND-ERASE TO TRUE
PERFORM 1300-SEND-ADDBIDS-MAP
WHEN EIBAID = DFHCLEAR
MOVE LOW-VALUE TO ADDMAP
SET SEND-ERASE TO TRUE
PERFORM 1300-SEND-ADDBIDS-MAP
WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
CONTINUE
WHEN EIBAID = DFHPF3 OR DFHPF12
EXEC CICS
XCTL PROGRAM('MENUP98')
END-EXEC
WHEN EIBAID = DFHENTER
PERFORM 1000-PROCESS-ADDBIDS-MAP
WHEN OTHER
MOVE LOW-VALUE TO ADDMAP
MOVE 'Invalid key pressed.' TO ADD-D-MESSAGE
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1300-SEND-ADDBIDS-MAP
END-EVALUATE.
EXEC CICS
RETURN TRANSID('AD98')
COMMAREA(COMMUNICATION-AREA)
END-EXEC.
*
1000-PROCESS-ADDBIDS-MAP.
*
PERFORM 1100-RECEIVE-BIDS-MAP.
PERFORM 1200-EDIT-BIDS-DATA.
IF VALID-DATA
PERFORM 2000-POST-BIDS
ELSE
MOVE 'Invalid data. Please reenter.'
TO ADD-D-INSTR
SET SEND-DATAONLY-ALARM TO TRUE
PERFORM 1300-SEND-ADDBIDS-MAP
END-IF.
*
1100-RECEIVE-BIDS-MAP.
*
EXEC CICS
RECEIVE MAP('ADDMAP')
MAPSET('ADDM98')
INTO(ADDMAP)
END-EXEC.
*
1200-EDIT-BIDS-DATA.
*
IF ADD-L-CUSTNO = ZERO OR ADD-D-CUSTNO = SPACES
MOVE 'N' TO VALID-DATA-SW
MOVE 'You must enter a valid customer number.'
TO ADD-D-MESSAGE
END-IF
IF VALID-DATA
PERFORM 1230-READ-CUSTOMER-RECORD
IF CUSTOMER-FOUND
MOVE BM-FIRST-NAME TO ADD-D-FIRSTNAME
MOVE BM-LAST-NAME TO ADD-D-LASTNAME
ELSE
MOVE 'N' TO VALID-DATA-SW
MOVE 'That customer does not exist.'
TO ADD-D-MESSAGE
END-IF
PERFORM 1210-EDIT-ITEM-DATA
VARYING BID-SUB FROM 1 BY 1
UNTIL BID-SUB > 6.
IF ITEM-COUNT < 1
MOVE 'N' TO VALID-DATA-SW
MOVE 'You must enter at least one item.'
TO ADD-D-MESSAGE
END-IF
END-IF.
*
1210-EDIT-ITEM-DATA.
*
IF ADD-D-ITEM(BID-SUB) NOT = SPACE AND
ADD-L-ITEM(BID-SUB) NOT = ZERO
ADD 1 TO ITEM-COUNT
PERFORM 1220-READ-ITEM-RECORD
IF ITEM-FOUND
MOVE IM-DESCRIPTION TO ADD-D-DESCRIPTION(BID-SUB)
IF ITEM-SOLD
MOVE 'Sold' TO ADD-D-STATUS(BID-SUB)
MOVE 'That item is already sold.'
TO ADD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
ELSE
MOVE 'Not sold' TO ADD-D-STATUS(BID-SUB)
END-IF
ELSE
MOVE 'Invalid number' TO ADD-D-STATUS(BID-SUB)
MOVE 'Invalid item.' TO ADD-D-MESSAGE
MOVE 'N' TO VALID-DATA-SW
END-IF
END-IF.
*
1220-READ-ITEM-RECORD.
*
MOVE ADD-D-ITEM(BID-SUB) TO IM-ITEM-CODE
EXEC CICS
READ FILE('ITMMST98')
INTO(ITEM-MASTER-RECORD)
RIDFLD(IM-ITEM-CODE)
RESP(RESPONSE-CODE)
END-EXEC.
EVALUATE RESPONSE-CODE
WHEN DFHRESP(NORMAL)
MOVE 'Y' TO ITEM-FOUND-SW
WHEN DFHRESP(NOTFND)
MOVE 'N' TO ITEM-FOUND-SW
WHEN OTHER
EXEC CICS
ABEND
END-EXEC
END-EVALUATE.
*
1230-READ-CUSTOMER-RECORD.
*
EXEC CICS
READ FILE('CSTMST98')
INTO(BIDDER-MASTER-RECORD)
RIDFLD(ADD-D-CUSTNO)
RESP(RESPONSE-CODE)
END-EXEC.
EVALUATE RESPONSE-CODE
WHEN DFHRESP(NORMAL)
MOVE 'Y' TO CUSTOMER-FOUND-SW
WHEN DFHRESP(NOTFND)
MOVE 'N' TO CUSTOMER-FOUND-SW
WHEN OTHER
EXEC CICS
ABEND
END-EXEC
END-EVALUATE.
*
1300-SEND-ADDBIDS-MAP.
*
EVALUATE TRUE
WHEN SEND-ERASE
EXEC CICS
SEND MAP('ADDMAP')
MAPSET('ADDM98')
FROM(ADDMAP)
ERASE
END-EXEC
WHEN SEND-DATAONLY
EXEC CICS
SEND MAP('ADDMAP')
MAPSET('ADDM98')
FROM(ADDMAP)
DATAONLY
END-EXEC
WHEN OTHER
EXEC CICS
SEND MAP('ADDMAP')
MAPSET('ADDM98')
FROM(ADDMAP)
DATAONLY
END-EXEC
END-EVALUATE.
*
2000-POST-BIDS.
*
PERFORM 2400-UPDATE-CUSTOMER-RECORD.
PERFORM 2100-UPDATE-ITEM-RECORD
VARYING BID-SUB FROM 1 BY 1
UNTIL BID-SUB > 6.
MOVE LOW-VALUE TO ADDMAP
IF VALID-DATA
MOVE 'Records updated' TO ADD-D-MESSAGE
ELSE
MOVE 'Unable to update records. Try again.'
TO ADD-D-MESSAGE
END-IF.
SET SEND-ERASE TO TRUE.
PERFORM 1300-SEND-ADDBIDS-MAP.
*
2100-UPDATE-ITEM-RECORD.
*
IF ADD-D-ITEM(BID-SUB) NOT = LOW-VALUE AND
ADD-L-ITEM(BID-SUB) NOT = ZERO
PERFORM 2200-READ-ITEM-FOR-UPDATE
IF ITEM-FOUND
PERFORM 2300-REWRITE-ITEM-RECORD
ELSE
MOVE 'N' TO VALID-DATA-SW
END-IF
END-IF.
*
2200-READ-ITEM-FOR-UPDATE.
*
MOVE ADD-D-ITEM(BID-SUB) TO IM-ITEM-CODE.
EXEC CICS
READ FILE('ITMMST98')
INTO(ITEM-MASTER-RECORD)
RIDFLD(IM-ITEM-CODE)
UPDATE
RESP(RESPONSE-CODE)
END-EXEC.
EVALUATE RESPONSE-CODE
WHEN DFHRESP(NORMAL)
MOVE 'Y' TO ITEM-FOUND-SW
WHEN DFHRESP(NOTFND)
MOVE 'N' TO ITEM-FOUND-SW
VALID-DATA-SW
WHEN OTHER
EXEC CICS ABEND END-EXEC
END-EVALUATE.
*
2300-REWRITE-ITEM-RECORD.
*
EXEC CICS
REWRITE FILE('ITMMST98')
FROM(ITEM-MASTER-RECORD)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
EXEC CICS ABEND END-EXEC
END-IF.
*
2400-UPDATE-CUSTOMER-RECORD.
*
PERFORM 2500-READ-CUST-FOR-UPDATE.
IF CUSTOMER-FOUND
PERFORM 2600-REWRITE-CUSTOMER-RECORD
END-IF.
*
2500-READ-CUST-FOR-UPDATE.
*
EXEC CICS
READ FILE('CSTMST98')
INTO(BIDDER-MASTER-RECORD)
RIDFLD(ADD-D-CUSTNO)
UPDATE
RESP(RESPONSE-CODE)
END-EXEC.
EVALUATE RESPONSE-CODE
WHEN DFHRESP(NORMAL)
MOVE 'Y' TO CUSTOMER-FOUND-SW
WHEN DFHRESP(NOTFND)
MOVE 'N' TO CUSTOMER-FOUND-SW
VALID-DATA-SW
WHEN OTHER
EXEC CICS
ABEND
END-EXEC
END-EVALUATE.
*
2600-REWRITE-CUSTOMER-RECORD.
*
EXEC CICS
REWRITE FILE('CSTMST98')
FROM(BIDDER-MASTER-RECORD)
RESP(RESPONSE-CODE)
END-EXEC.
IF RESPONSE-CODE NOT = DFHRESP(NORMAL)
EXEC CICS
ABEND
END-EXEC
END-IF.
/*
//LKED.SYSIN DD *
NAME ADDP98(R)
//