IDENTIFICATION DIVISION.
PROGRAM-ID. WBPRSB49.
DATE-WRITTEN. 2011-09-22.
DATE-COMPILED. 2011-09-22.
ENVIRONMENT DIVISION.
*
DATA DIVISION.
*
WORKING-STORAGE SECTION.
COPY DFHAID.
COPY DFHBMSCA.
*
* COPY MAPS
*
01 MAPS PIC X(1000).
COPY WBMENUB.
COPY WBCUSTB.
COPY WBORDRB.
*
01 WORK-VARS.
05 K PIC S9(4) COMP.
05 MSG-OUT PIC X(80).
01 INITIAL-COMMAREA.
05 MAP-NAME PIC X(7).
05 SEARCH-RESULTS-LINE-CNT PIC 9.
*
* MAP HEADER LINE FOR DISPLAYING BOOK SEARCH RESULTS
*
01 BOOK-HEADING-LINE.
05 LINE-NO PIC X(7) VALUE 'LINE NO'.
05 FILLER PIC X(10) VALUE SPACES.
05 BTITLE PIC X(5) VALUE 'TITLE'.
05 FILLER PIC X(21) VALUE SPACES.
05 BUTHOR PIC X(6) VALUE 'AUTHOR'.
05 FILLER PIC X(14) VALUE SPACES.
05 PRICE PIC X(5) VALUE 'PRICE'.
05 FILLER PIC X(4) VALUE SPACES.
05 QYT PIC X(7) VALUE 'ON HAND'.
*
* PF KEY DEFINITIONS FOR WBCUSTB AND WORDRB
*
01 PFKEYS.
05 PFKEYS-WBCUSTB.
10 CREATE-CUSTOMER PIC X(18) VALUE SPACES.
10 FILLER PIC X(02) VALUE SPACES.
10 EXIT-KEY PIC X(07) VALUE 'F3=EXIT'.
10 FILLER PIC X(21) VALUE SPACES.
10 REFRESH-KEY PIC X(10) VALUE SPACES.
10 FILLER PIC X(02) VALUE SPACES.
10 RETURN-KEY PIC X(18)
VALUE 'F12=RETURN TO MENU'.
10 FILLER PIC X VALUE SPACE.
05 PFKEYS-WBORDRB.
10 FILLER PIC X(07) VALUE SPACES.
10 EXIT-KEY PIC X(07) VALUE 'F3=EXIT'.
10 FILLER PIC X(06) VALUE SPACES.
10 PLACE-ORDER PIC X(17) VALUE SPACES.
10 FILLER PIC X(06) VALUE SPACES.
10 REFRESH-KEY PIC X(10)
VALUE 'F9=REFRESH'.
10 FILLER PIC X(06) VALUE SPACES.
10 RETURN-KEY PIC X(18)
VALUE 'F12=RETURN TO MENU'.
10 FILLER PIC X(2) VALUE SPACES.
*
* COMMAREAS PASSED TO SBCUSB99 AND SBORDB99
*
01 PASSED-COMMAREAS.
05 COMMAREA-PASSED-TO-WBCUSB99.
10 FUNCTION-REQUEST PIC X(5).
10 CUSTNO PIC X(5).
10 LNAME PIC X(20).
10 FNAME PIC X(15).
10 ADDRESS-LINE PIC X(40).
10 CITY PIC X(20).
10 STATE PIC X(8).
10 PCODE PIC X(10).
10 CTRY PIC X(15).
10 EMAIL PIC X(50).
10 ERROR-MSG PIC X(50) VALUE SPACES.
05 COMMAREA-PASSED-TO-WBORDB99.
10 FNCTN-REQUEST PIC X(5).
10 ORDER-LINE-NO PIC 9.
10 CUSTNUM PIC X(5).
10 ORDERNO PIC X(5) VALUE SPACES.
10 ERR-MSG PIC X(50) VALUE SPACES.
10 SEARCH-TITILE PIC X(50).
10 SEARCH-AUTHOR PIC X(20).
10 LINE-CNT-BACK PIC 9.
10 BOOK-LINE PIC X(79) OCCURS 6 TIMES.
LINKAGE SECTION.
01 DFHCOMMAREA.
05 PASSED-MAP-NAME PIC X(7).
05 PASSED-SEARCH-RESULTS-CNT PIC 9.
PROCEDURE DIVISION.
*
* SEND MAP FIRST TIME IN.
*
IF EIBCALEN = 0
MOVE 'WBMENUB' TO MAP-NAME
PERFORM SEND-MAP-MAPONLY
PERFORM RETURN-TRANSID
END-IF
*
* NOT FIRST TIME IN! MOVE NAME OF MAP TO WORKING-STORAGE.
MOVE PASSED-MAP-NAME TO MAP-NAME
MOVE PASSED-SEARCH-RESULTS-CNT TO SEARCH-RESULTS-LINE-CNT
*
* CHECK FOR CLAR KEY PRESS
*
IF EIBAID = DFHCLEAR
MOVE LOW-VALUES TO MAPS
*
* DETERMIN WHICH MAP WAS BEING PROCESSED WHEN CLAR PRESEED
*
EVALUATE MAP-NAME
WHEN 'WBMENUB'
MOVE 'DO NOT PRESS CLEAR. KEY AN OPTION AND PRESS ENTE
- 'R' TO MLINEO OF WBMENUBO
WHEN 'WBCUSTB'
MOVE 'TO ADD CUSTOMER,FILL IN THE BLANK AND PRESS ENTE
- 'R' TO MESSGEO
MOVE 'DO NOT PRESS CLEAR.TO RETURN TO MENU, PRESS F12'
TO MLINEO OF WBCUSTBO
MOVE PFKEYS-WBCUSTB TO PFKEYSO OF WBCUSTBO
WHEN 'WBORDB'
MOVE 'DO NOT PRESS CLEAR. KEY DATA AND PRESS AN APPROP
- 'RIATE KEY' TO MLINEO OF WBORDRBO
MOVE PFKEYS-WBORDRB TO PFKEYSO OF WBORDRBO
END-EVALUATE
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
END-IF
*
* CHECK FOR F3=EXIT KEY PRESSED ON MAPS OTHER THAN THE FIRST
*
IF MAP-NAME NOT = 'WBMENUB' AND EIBAID=DFHPF3
MOVE 'THANKS FOR USING WORLDWIDE BOOKS ONLINE' TO MSG-OUT
EXEC CICS SEND FROM(MSG-OUT)
LENGTH(39)
ERASE
END-EXEC
EXEC CICS
RETURN
END-EXEC
END-IF
*
* CHECK FOR F12=RETURN TO MENU KEY PRESSED ON MAPS OTHER THAN THE
* FIRST
*
IF MAP-NAME NOT = 'WBMENUB' AND EIBAID=DFHPF12
MOVE 'WBMENUB' TO MAP-NAME
PERFORM SEND-MAP-MAPONLY
PERFORM RETURN-TRANSID
END-IF
* RECEIVE MAP
*
EXEC CICS
RECEIVE MAP(MAP-NAME)
INTO (MAPS)
NOHANDLE
END-EXEC
EVALUATE EIBRESP
WHEN DFHRESP(NORMAL)
CONTINUE
WHEN DFHRESP(MAPFAIL)
IF MAP-NAME = 'WBMENUB'
MOVE 'KEY DATA AND THEN PRESS ENTHER' TO MLINEO
OF WBMENUBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
WHEN OTHER
PERFORM ERROR-ROUTINE
END-EVALUATE
*
* DETEMINE WHICH MAP WAS RECEIVED
*
EVALUATE MAP-NAME
WHEN 'WBMENUB'
PERFORM PROCESS-MAP-INPUT-WBMENUB
WHEN 'WBCUSTB'
PERFORM PROCESS-MAP-INPUT-WBCUSTB
WHEN 'WBORDRB'
MOVE PASSED-SEARCH-RESULTS-CNT TO
SEARCH-RESULTS-LINE-CNT
PERFORM PROCESS-MAP-INPUT-WBORDRB
END-EVALUATE.
*
* FIRST MAJOR PROGRAM: PROCESS WBMENUB
*
PROCESS-MAP-INPUT-WBMENUB.
IF OPTIONL NOT GREATER THAN 0
MOVE LOW-VALUES TO WBMENUBO
MOVE 'KEY AN OPTION AND THEN PRESS ENTHER' TO
MLINEO OF WBMENUBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
*
* DETERMINE WHICH OF THE SIX OPTIONS WAS SELECTED FORM THE MENU
*
EVALUATE OPTIONI
WHEN '1'
MOVE LOW-VALUES TO WBCUSTBO
MOVE 'F9=REFRESH' TO REFRESH-KEY OF PFKEYS-WBCUSTB
MOVE 'ADD CUSTOMER: FILL IN THE BLANKS AND PRESS ENTER'
TO MESSGEO
MOVE 'WBCUSTB' TO MAP-NAME
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
WHEN '2'
IF CUSTNUML NOT GREATER THAN 0
MOVE LOW-VALUES TO WBMENUBO
MOVE 'KEY A CUSTOMER NUMBER AND THEN PRESS ENTER'
TO MLINEO OF WBMENUBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
ELSE
MOVE 'QCUST' TO FUNCTION-REQUEST
MOVE CUSTNUMI TO CUSTNO
*
* THIS IS WHERE SHOULD LINK TO THE BUSINESS LOGIC INT THE
* CUSTOMER PROGRAM. INSTEAD WE WILL SIMULATE A SUCESSFUL
* LINK BY PLACEING "DUMMY" INFORMATION INTO COMMAREA FILEDS
*
MOVE '1111' TO CUSTNO
MOVE 'YOURLASTNAME' TO LNAME
MOVE 'YOURFIRSTNAME' TO FNAME
MOVE 'YOUR ADDRESS' TO ADDRESS-LINE
MOVE 'YOUR CITY' TO CITY
MOVE 'STATE' TO STATE
MOVE 'PCODE' TO PCODE
MOVE 'YOUR CTRY' TO CTRY
MOVE 'JOHN.DOEIBM.NET' TO EMAIL
*
* FORMAT DATA FROM CUSTOMER PGORGAM INTO MAP AND SEND
*
MOVE LOW-VALUES TO WBCUSTBO
IF ERROR-MSG IS EQUAL TO SPACES
MOVE 'CUSTOMER INFORMATION DISPLAY:' TO MESSGEO
MOVE LNAME TO LNAMEO
MOVE FNAME TO FNAMEO
MOVE ADDRESS-LINE TO ADDRESSO
MOVE CITY TO CITYO
MOVE STATE TO STATEO
MOVE PCODE TO PCODEO
MOVE CTRY TO CTRYO
MOVE EMAIL TO EMAILO
STRING 'CUSTOMER NUMBER IS: ' CUSTNO DELIMITED BY
SIZE INTO MLINEO OF WBCUSTBO
MOVE PFKEYS-WBCUSTB TO PFKEYSO OF WBCUSTBO
MOVE 'WBCUSTB' TO MAP-NAME
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
ELSE
MOVE LOW-VALUES TO WBCUSTBO
MOVE 'F9=REFRESH' TO REFRESH-KEY OF PFKEYS-WBCUSTB
MOVE
'NOTE ERROR MESSAGE BELOW: RETURN TO MAIN MENU AND TRY AGAIN'
TO MESSGEO
MOVE ERROR-MSG TO MLINEO OF WBCUSTBO
MOVE 'WBCUSTB' TO MAP-NAME
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
END-IF
END-IF
WHEN '3'
MOVE LOW-VALUES TO WBORDRBO
* SET UP PFKEY LINE BEFORE SENDING MAP
MOVE PFKEYS-WBORDRB TO PFKEYSO OF WBORDRBO
MOVE 'WBORDRB' TO MAP-NAME
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
WHEN '4'
MOVE LOW-VALUES TO WBORDRBO
* SET UP PFKEY LINE BEFORE SENDING MAP
MOVE PFKEYS-WBORDRB TO PFKEYSO OF WBORDRBO
MOVE 'TO ORDER A BOOK,FIRST SERACH BY COMPLETEING THE REQU
- 'ESTED INFO' TO MLINEO OF WBORDRBO
MOVE 'WBORDRB' TO MAP-NAME
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
WHEN '5'
MOVE 'THANKS FOR USING WORLDWIDE BOOKS ONLINE' TO MSG-OUT
EXEC CICS SEND FROM(MSG-OUT)
LENGTH(39)
ERASE
END-EXEC
EXEC CICS
RETURN
END-EXEC
WHEN OTHER
MOVE LOW-VALUE TO WBMENUBO
MOVE 'INAVLID OPTION: CHOOSE 1-5 AND PRESS ENTER'
TO MLINEO OF WBMENUBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-EVALUATE.
*
* SECOND MAJOY PERFORM: PROCESS WBCUSTB INPUT
* EVALUATE WHICH KEY OTHER KEY WAS PRESSED
*
* ENTER = ADD CUSTOMER
* F9 = REFRESH
* OTHER = INVALID KEY
PROCESS-MAP-INPUT-WBCUSTB.
EVALUATE TRUE
* ADD CUSTOMER
WHEN EIBAID = DFHENTER
MOVE 'ACUST' TO FUNCTION-REQUEST
MOVE LNAMEI TO LNAME
MOVE FNAMEI TO FNAME
MOVE ADDRESSI TO ADDRESS-LINE
MOVE CITYI TO CITY
MOVE STATEI TO STATE
MOVE PCODEI TO PCODE
MOVE CTRYI TO CTRY
MOVE EMAILI TO EMAIL
*
* THIS IS WHERE WE SHOULD LINK TO THE BUSINESS LOGIC
* IN THE CUSTMER PROGRAM. INSTEAD WE WILL SIMULATE A
* SUCCESSFUL LINK BY REPLACING ANY REQUIRED RESPONSE
* INTO THE COMMAREA
*
MOVE '1111' TO CUSTNO
* FORMAT MAP OUTPUT AND SEND MAP
MOVE LOW-VALUES TO WBCUSTBO
IF ERROR-MSG IS EQUAL TO SPACES
MOVE 'CUSTOMER INFORMATION DISPLAY:' TO MESSGEO
MOVE LNAME TO LNAMEO
MOVE FNAME TO FNAMEO
MOVE ADDRESS-LINE TO ADDRESSO
MOVE CITY TO CITYO
MOVE STATE TO STATEO
MOVE PCODE TO PCODEO
MOVE CTRY TO CTRYO
MOVE EMAIL TO EMAILO
STRING 'NEW CUSTOMER NUMBER IS:' CUSTNO
DELIMITED BY SIZE INTO MLINEO OF WBCUSTBO
MOVE PFKEYS-WBCUSTB TO PFKEYSO OF WBCUSTBO
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
ELSE
MOVE 'NOTE ERROR MESSAGE BELOW. TYR AGAIN.'
TO MESSGEO
MOVE ERROR-MSG TO MLINEO OF WBCUSTBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
* F9 = REFRESH
WHEN EIBAID = DFHPF9
MOVE LOW-VALUES TO WBCUSTBO
MOVE 'F9=REFRESH' TO REFRESH-KEY OF PFKEYS-WBCUSTB
MOVE PFKEYS-WBCUSTB TO PFKEYSO OF WBCUSTBO
MOVE 'ADD CUSTOMER: FILL IN THE BLANKS AND PRESS ENTER'
TO MESSGEO
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
WHEN OTHER
MOVE LOW-VALUES TO WBCUSTBO
MOVE 'INVALID KEY PRESSED. PLEASE TRY AGAIN'
TO MLINEO OF WBCUSTBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-EVALUATE.
* THE THIRD MAJOR PROGRAM: PROCESS WBORDRB INPUT
*
* EVALUATE WHICH KEY OTHER KEY WAS PRESEED
*
* ENTER = SEARCH KEY
* F5 = PLACE ORDER
* F9 = REFRESH
* OTHER = INVALID KEY
*
PROCESS-MAP-INPUT-WBORDRB.
EVALUATE TRUE
*
* WHEN ENTER PRESSED, DO A BOOK SEARCH
*
WHEN EIBAID=DFHENTER
IF AUTHORL NOT = 0 OR TITLEL NOT = 0
MOVE 'SRCHB' TO FNCTN-REQUEST
MOVE AUTHORI TO SEARCH-AUTHOR
MOVE TITLEI TO SEARCH-TITILE
*
* THIS IS WHERE WE SHOULD LINK TO THE BUSINESS LOGIC
* IN THE ORDER PROGRAM. INSTED WE SIMULATE A SUCCESSFUL
* LIKE BY PLACING THE REQUIRED RESPONSE INTO THE COMMAREA
*
MOVE '2' TO LINE-CNT-BACK
MOVE '1 CICS APPLICATION PROGRAMING REFERENCE CICSDEVE
- 'LOPER $55.55 0333' TO BOOK-LINE(1)
MOVE '2 CICS APPLICATION PROGRAMING REFERENCE CICSDEVE
- 'LOPER $55.55 0444' TO BOOK-LINE(2)
*
* FORMAT MAP OUTPUT AND SEND MAP
MOVE LOW-VALUES TO WBORDRBO
MOVE SPACES TO MLINEO OF WBORDRBO
IF ERR-MSG = SPACES
MOVE DFHBMASK TO ORDINFOA
MOVE DFHBMASK TO LNUMTTLA
MOVE DFHBMASK TO CUSTTTLA
MOVE 'F5=PLACE ORDER' TO PLACE-ORDER
MOVE PFKEYS-WBORDRB TO PFKEYSO OF WBORDRBO
MOVE BOOK-HEADING-LINE TO TTLNO
MOVE SPACES TO MLINEO OF WBORDRBO
PERFORM VARYING K FROM 1 BY 1 UNTIL K > LINE-CNT-BACK
MOVE BOOK-LINE(K) TO BOOKLNO(K)
END-PERFORM
MOVE LINE-CNT-BACK TO SEARCH-RESULTS-LINE-CNT
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
ELSE
STRING 'ERROR MSG FROM ORDER PGM:',ERR-MSG
DELIMITED BY SIZE INTO MLINEO OF WBORDRBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
ELSE
MOVE LOW-VALUES TO WBORDRBO
MOVE SPACES TO MLINEO OF WBORDRBO
MOVE 'ENTER EITHER AN AUTHOR OR SEARCH TITLE,THEN PRESS
- 'ENTER' TO MLINEO OF WBORDRBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
*
* WHEN F5 IS PRESSED, PLACE ORDER
*
WHEN EIBAID = DFHPF5
IF SEARCH-RESULTS-LINE-CNT >= LNUMI AND LNUMI >0
MOVE 'ORDRB' TO FNCTN-REQUEST
MOVE LNUMI TO ORDER-LINE-NO
MOVE CUSTNOI TO CUSTNUM
*
* THIS IS WHERE WE SHOULD LIKE TO THE BUSINESS LOGIC
* IN THE ORDER PROGRAM. INSTEAD WE SIMULATE A SUCCESSFUL
* LINK BY PLACING THE REQUIRED RESPONSED INTO THE COMMAREA
*
MOVE 'I1111' TO ORDERNO
*
* FORMAT MAP OUTPUT AND SEND MAP
*
MOVE LOW-VALUES TO WBORDRBO
MOVE SPACES TO MLINEO OF WBORDRBO
IF ERR-MSG IS EQUAL TO SPACES
STRING 'ORDER COMPLETE. ORDER NO.IS ' ORDERNO
DELIMITED BY SIZE INTO MLINEO OF WBORDRBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
ELSE
STRING 'ORDER ERROR: ' ERR-MSG
DELIMITED BY SIZE INTO MLINEO OF WBORDRBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
ELSE
MOVE LOW-VALUES TO WBORDRBO
MOVE 'ENTER BOTH A VALID LINIENO & CUSTOMER NUMBER, THEN P
- 'RESS F5' TO MLINEO OF WBORDRBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-IF
*
* WHEN F9 PRESSED, REFRESH
*
WHEN EIBAID = DFHPF9
MOVE LOW-VALUES TO WBORDRBO
MOVE PFKEYS-WBORDRB TO PFKEYSO OF WBORDRBO
PERFORM SEND-MAP-MERGE
PERFORM RETURN-TRANSID
* WHEN OTHER
WHEN OTHER
MOVE LOW-VALUES TO WBORDRBO
MOVE 'INVALID KEY PRESSED; PLEASE TRY AGAIN'
TO MLINEO OF WBORDRBO
PERFORM SEND-MAP-DATAONLY
PERFORM RETURN-TRANSID
END-EVALUATE.
*-----------------------------------------------
* PSEUDOCONVERSATIONAL RETURN PASSING MAPNAME
*-----------------------------------------------
RETURN-TRANSID.
EXEC CICS
RETURN TRANSID(EIBTRNID)
COMMAREA(INITIAL-COMMAREA)
LENGTH(8)
END-EXEC.
*
* THREE VARIETIES OF SEND MAP
*
SEND-MAP-MAPONLY.
EXEC CICS
SEND MAP(MAP-NAME)
MAPONLY
ERASE
NOHANDLE
END-EXEC.
SEND-MAP-DATAONLY.
EXEC CICS
SEND MAP(MAP-NAME)
DATAONLY
FROM(MAPS)
NOHANDLE
END-EXEC.
EVALUATE EIBRESP
WHEN DFHRESP(NORMAL)
CONTINUE
WHEN OTHER
PERFORM ERROR-ROUTINE
END-EVALUATE.
SEND-MAP-MERGE.
EXEC CICS
SEND MAP(MAP-NAME)
FROM(MAPS)
ERASE
NOHANDLE
END-EXEC
EVALUATE EIBRESP
WHEN DFHRESP(NORMAL)
CONTINUE
WHEN OTHER
PERFORM ERROR-ROUTINE
END-EVALUATE.
*
* GENERAL ERROR ROUTINE
*
ERROR-ROUTINE.
MOVE 'ERROR ENCOUNTERED. USED CEDF TO DEBUG.' TO MSG-OUT.
EXEC CICS
SEND FROM(MSG-OUT)
LENGTH(39)
ERASE
END-EXEC
EXEC CICS
RETURN
END-EXEC.
联系客服
