IDENTIFICATION DIVISION.
PROGRAM-ID. ANSWERNQ.
*PROGRAM: P6 TO DEAL WITH THE ON-LINE ENQUIRY.
AUTHOR. PAT BURKE.
DATE-WRITTEN. NOVEMBER 1995.
*
*
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUSTOMER-MASTER
ASSIGN TO DISK-CUSMF
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS CUSMF-CUSNUM
FILE STATUS IS CUSMF-STAT.
SELECT SCREEN-FILE
ASSIGN TO WORKSTATION-P6SCR
ORGANIZATION IS TRANSACTION
FILE STATUS IS SCREEN-STAT, WA-RETURN-CODE
CONTROL-AREA IS WA-CONTROL-AREA.
*
*
DATA DIVISION.
FILE SECTION.
FD CUSTOMER-MASTER
LABEL RECORDS ARE STANDARD
DATA RECORD IS CUSMF-REC.
01 CUSMF-REC.
03 CUSMF-CUSNUM PIC X(8).
03 CUSMF-NAME PIC X(30).
03 CUSMF-ADDRESS PIC X(75).
03 CUSMF-CREDITLIM PIC 9(4)V99.
03 CUSMF-CURBAL PIC 9(4)V99.
03 CUSMF-PRVBAL PIC 9(4)V99.
FD SCREEN-FILE
LABEL RECORDS ARE OMITTED.
01 SCREEN-REC PIC X(500).
WORKING-STORAGE SECTION.
01 SCREEN-CONTROL.
03 SCREEN-STAT PIC X(2).
88 SUCCESSFUL-READ VALUE "00".
03 WA-RETURN-CODE PIC X(4).
03 WA-CONTROL-AREA.
05 AID-BYTE PIC 9(2) VALUE ZEROES.
88 SEARCH-NOT-ABANDONED VALUE 0.
88 SEARCH-ABANDONED VALUE 12.
88 AMOUNT-ABANDONED VALUE 12.
88 WISH-TO-END-ENQUIRY VALUE 3.
88 CUSNUM-FORMAT-VALID VALUE 0.
88 CUSNUM-FORMAT-INVALID VALUE 12.
05 SESSION-ID PIC X(2).
05 FILLER PIC X(8).
01 FILE-STATUS-AND-CONDITIONS.
03 CUSMF-STAT PIC X(2).
03 CUSMF-FLAG PIC X.
88 CUSTOMER-RECORD-FOUND VALUE "Y".
88 CUSTOMER-RECORD-NOT-FOUND VALUE "N".
01 SCREEN-BUFFERS.
03 CUSNUM-BUFFER PIC X(8).
03 PROPOSED-BUFFER.
05 PROPOSED-AMOUNT PIC 9(4).
03 CREDIT-STATUS PIC X(3).
88 ALLOW-CREDIT VALUE "YES".
88 NO-CREDIT VALUE "NO".
01 WORKSPACE.
03 AVAILABLE-CREDIT PIC S9(4)V99.
01 MSG-BUFFER PIC X(60).
01 MESSAGES-ETC.
03 PROCESSING-ABANDONED-MSG.
05 FILLER PIC X(39)
VALUE "PROCESSING ABANDONED - PRESS ENTER".
03 CUSTOMER-NOT-FOUND-MSG.
05 FILLER PIC X(39)
VALUE "ACCOUNT NUMBER IS NOT ON FILE - REENTER".
*
*
PROCEDURE DIVISION.
DECLARATIVES.
IN-FAIL SECTION.
USE AFTER STANDARD EXCEPTION PROCEDURE ON INPUT.
IN-FAIL-PARA.
DISPLAY "ATTENTION!!! ERROR IN READ", CUSMF-STAT.
SCREEN-ERROR SECTION.
USE AFTER STANDARD EXCEPTION PROCEDURE ON I-O.
SCREEN-FAIL-PARA.
DISPLAY "ATTENTION!!! ERROR IN I-O", SCREEN-CONTROL.
END DECLARATIVES.
MAIN-PROCESSING SECTION.
CONTROL-PARA.
PERFORM OPEN-FILES.
PERFORM PROMPT-USER.
PERFORM DO-ALL-ENQUIRIES.
PERFORM CLOSE-DOWN.
STOP RUN.
OPEN-FILES.
OPEN INPUT CUSTOMER-MASTER.
OPEN I-O SCREEN-FILE.
CLOSE-DOWN.
CLOSE CUSTOMER-MASTER, SCREEN-FILE.
PROMPT-USER.
PERFORM REFRESH-SCREEN.
WRITE SCREEN-REC FORMAT IS "GOONSCR".
READ SCREEN-FILE.
REFRESH-SCREEN.
WRITE SCREEN-REC FORMAT IS "FOOTER".
WRITE SCREEN-REC FORMAT IS "SYSID".
WRITE SCREEN-REC FORMAT IS "SCRHDG8".
DO-ALL-ENQUIRIES.
PERFORM DO-ONE-ENQUIRY
UNTIL WISH-TO-END-ENQUIRY.
DO-ONE-ENQUIRY.
PERFORM SEARCH-FOR-CUSTOMER.
PERFORM POSS-SUCCESSFUL-SEARCH.
PERFORM PROMPT-USER.
POSS-SUCCESSFUL-SEARCH.
IF CUSTOMER-RECORD-FOUND
PERFORM SUCCESSFUL-SEARCH
ELSE
PERFORM PUT-ABANDON-MSG.
SUCCESSFUL-SEARCH.
PERFORM GET-AMOUNT.
PERFORM POSS-VALID-AMOUNT.
GET-AMOUNT.
WRITE SCREEN-REC FORMAT IS "OLENQ".
READ SCREEN-FILE INTO PROPOSED-BUFFER.
POSS-VALID-AMOUNT.
IF AMOUNT-ABANDONED
PERFORM DO-ABANDON-AMOUNT
ELSE
PERFORM DO-VALID-AMOUNT.
DO-ABANDON-AMOUNT.
PERFORM REFRESH-SCREEN.
WRITE SCREEN-REC FROM SCREEN-BUFFERS
FORMAT IS "OLENQR".
* THIS DISPLAYS THE VALUES THAT HAVE BEEN KEYED IN SO FAR ***
WRITE SCREEN-REC FORMAT IS "BADAMOUNT".
READ SCREEN-FILE.
PERFORM PUT-ABANDON-MSG.
DO-VALID-AMOUNT.
PERFORM DETERMINE-CREDIT-STATUS.
PERFORM PUT-CREDIT-STATUS.
DETERMINE-CREDIT-STATUS.
SUBTRACT CUSMF-CURBAL FROM CUSMF-CREDITLIM
GIVING AVAILABLE-CREDIT.
IF AVAILABLE-CREDIT > ZERO
IF AVAILABLE-CREDIT > PROPOSED-AMOUNT
SET ALLOW-CREDIT TO TRUE
ELSE
SET NO-CREDIT TO TRUE
ELSE
SET NO-CREDIT TO TRUE.
PUT-CREDIT-STATUS.
PERFORM REFRESH-SCREEN.
WRITE SCREEN-REC FROM SCREEN-BUFFERS
FORMAT IS "OLENQR".
READ SCREEN-FILE.
PUT-ABANDON-MSG.
WRITE SCREEN-REC FROM PROCESSING-ABANDONED-MSG
FORMAT IS "MSGSCR".
READ SCREEN-FILE.
*......................................................
** SEARCH FOR CUSTOMER PARAGRAPHS
SEARCH-FOR-CUSTOMER.
PERFORM INITIALISE-CUSTOMER-SEARCH.
PERFORM DO-THE-SEARCH.
INITIALISE-CUSTOMER-SEARCH.
SET CUSTOMER-RECORD-NOT-FOUND TO TRUE.
SET SEARCH-NOT-ABANDONED TO TRUE.
DO-THE-SEARCH.
PERFORM TRY-FOR-A-CUSTOMER
UNTIL CUSTOMER-RECORD-FOUND
OR SEARCH-ABANDONED.
TRY-FOR-A-CUSTOMER.
PERFORM INPUT-CUSTOMER-NUMBER.
PERFORM POSS-VALID-CUSNUM.
INPUT-CUSTOMER-NUMBER.
PERFORM REFRESH-SCREEN.
WRITE SCREEN-REC FORMAT IS "CNSCR".
READ SCREEN-FILE INTO CUSNUM-BUFFER.
POSS-VALID-CUSNUM.
IF SEARCH-NOT-ABANDONED
PERFORM DO-VALID-CUSNUM
ELSE
PERFORM POSSIBLE-ABANDON.
DO-VALID-CUSNUM.
PERFORM GET-CUSTOMER-RECORD.
PERFORM POSS-FOUND-CUSTOMER.
GET-CUSTOMER-RECORD.
SET CUSTOMER-RECORD-FOUND TO TRUE.
MOVE CUSNUM-BUFFER TO CUSMF-CUSNUM.
READ CUSTOMER-MASTER
INVALID KEY SET CUSTOMER-RECORD-NOT-FOUND TO TRUE.
POSS-FOUND-CUSTOMER.
IF CUSTOMER-RECORD-NOT-FOUND
* NOTE: SUCCESSFUL READ CAUSES EXIT HERE ...........
PERFORM DO-CUSTOMER-NOT-FOUND.
DO-CUSTOMER-NOT-FOUND.
PERFORM PUT-NOT-FOUND-MESSAGE.
PERFORM POSSIBLE-ABANDON.
PUT-NOT-FOUND-MESSAGE.
MOVE CUSTOMER-NOT-FOUND-MSG TO MSG-BUFFER.
WRITE SCREEN-REC FROM MSG-BUFFER
FORMAT IS "MSGSCR".
READ SCREEN-FILE.
POSSIBLE-ABANDON.
EXIT.
* NOTE : CF12 CAUSES EXIT HERE
* ENTER KEY RESULTS IN REPEAT OF
* TRY-FOR-A-CUSTOMER
Link back to cobol page