IDENTIFICATION DIVISION.
PROGRAM-ID. CUSADD.
*PROGRAM: P8.1 ADD NEW CUSTOMER.
AUTHOR. MARTIN O SULLIVAN
DATE-WRITTEN. FEBRUARY 1999.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TAPE-TITEL-FILE
ASSIGN TO DISK-V2L05
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS TTCODE OF TAPEREC
FILE STATUS IS V2L05-STAT.
SELECT MEMBER-FILE
ASSIGN TO DISK-V2L05
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS MEMNUM OF MEMREC
FILE STATUS IS V1L01-STAT.
SELECT TAPE-COPIES-FILE
ASSIGN TO DISK-V3L01
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS TCCODE OF TPREC
FILE STATUS IS V3L01-STAT.
SELECT LONES-FILE
ASSIGN TO DISK-V4L01
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS MEMNUM OF LONREC
FILE STATUS IS V4L01-STAT.
SELECT SCREEN-FILE
ASSIGN TO WORKSTATION-V4SCR
ORGANIZATION IS TRANSACTION
FILE STATUS IS SCREEN-STAT, WA-RETURN-CODE
CONTROL-AREA IS WA-CONTROL-AREA.
DATA DIVISION.
FILE SECTION.
FD MEMBER-FILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS MEMREC.
01 MEMREC.
03 MEMNUM PIC X(8).
03 NAME PIC X(20).
03 ADDRS1 PIC X(20).
03 ADDRS2 PIC X(20).
03 ADDRS3 PIC X(20).
03 TYPEMB PIC X(1).
03 MEMBER-FLAG PIC X(1).
03 LONES PIC X(2).
03 LATE PIC X(2).
88 GOODMEMBER VALUE "G".
FD TAPE-TITEL-FILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS MEMREC.
FD TAPE-COPIES-FILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS MEMREC.
FD LONES-FILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS MEMREC.
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 ADD-ABANDONED VALUE 12.
88 WISH-TO-END-ADD-MEMBER VALUE 3.
88 MEMBER-DATA-OK VALUE 0.
88 MEMBER-DATA-NOT-OK VALUE 12.
05 SESSION-ID PIC X(2).
05 FILLER PIC X(8).
01 FILE-STATUS-AND-CONDITIONS.
03 V2L05-STAT PIC X(2).
03 V1L01-STAT PIC X(2).
03 V3L01-STAT PIC X(2).
03 V4L01-STAT PIC X(2).
01 ADD-BUFFER.
03 NAME PIC X(20).
03 ADDRS1 PIC X(20).
03 ADDRS2 PIC X(20).
03 ADDRS3 PIC X(20).
03 TYPEMB PIC X(1).
01 MSG-BUFFER PIC X(60).
01 MESSAGES-ETC.
03 ADD-ABANDONED-MSG PIC X(60)
VALUE "NEW RECORD NOT CREATED - PRESS ENTER".
01 DATE-AND-TIME-STUFF.
03 TODAYS-DATE.
05 YEAR-IN PIC 9(2).
05 MONTH-IN PIC 9(2).
05 DAY-IN PIC 9(2).
PROCEDURE DIVISION.
DECLARATIVES.
I-O-FAIL SECTION.
USE AFTER STANDARD EXCEPTION PROCEDURE ON I-O.
I-O-FAIL-PARA.
DISPLAY "ATTENTION!! ERROR IN I-O MEMBER", V1L01-STAT.
DISPLAY "ATTENTION!! ERROR IN I-O SCREEN ", SCREEN-CONTROL.
END DECLARATIVES.
MAIN-PROCESSING SECTION.
TOP-LEVEL-PARA.
DISPLAY "THIS PROGRAM LONE A TAPE IS NOT YET WORKING".
PERFORM START-UP.
PERFORM PROMPT-GO.
PERFORM DO-ALL-LONES.
*1
START-UP.
OPEN I-O MEMBER-FILE, TAPE-TITEL-FILE, TAPE-COPIES-FILE
LONES-FILE.
OPEN I-O SCREEN-FILE.
*2
PROMPT-GO.
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 "SCRHDG6".
WRITE SCREEN-REC FORMAT IS "CASCR1".
*4
DO-ALL-LONES.
PERFORM DO-ONE-ADD-ASK-MORE
UNTIL WISH-TO-END-ADD-MEMBER.
*7
DO-ONE-ADD-ASK-MORE.
PERFORM TAKE-IN-LONE-DATA.
PERFORM POSS-OK-LONE-DATA.
PERFORM PROMPT-GO.
*8
TAKE-IN-LONE-DATA.
MOVE SPACES TO ADD-BUFFER.
WRITE SCREEN-REC FROM ADD-BUFFER
FORMAT IS "CASCR2".
READ SCREEN-FILE INTO ADD-BUFFER.
*9
POSS-OK-LONE-DATA.
IF LONE-DATA-OK
PERFORM COMPLETE-LONE
ELSE
PERFORM DO-LONE-ABANDON-JOBS.
*11
COMPLETE-LONE.
PERFORM ASSEMBLE-LONE-RECORD.
PERFORM WRITE-NEW-RECORD.
*14A
ASSEMBLE-NEW-RECORD.
MOVE CORRESPONDING ADD-BUFFER TO MEMREC.
SET GOODMEMBER TO TRUE.
*14B
WRITE-NEW-RECORD.
WRITE MEMREC INVALID KEY PERFORM
PROBLEM-WRITE-CUSMF.
*12
DO-LONE-ABANDON-JOBS.
PERFORM REFRESH-SCREEN.
WRITE SCREEN-REC FROM ADD-BUFFER FORMAT IS "CASCR3".
READ SCREEN-FILE.
MOVE ADD-ABANDONED-MSG TO MSG-BUFFER.
WRITE SCREEN-REC FROM MSG-BUFFER
FORMAT IS "MSGSCR".
READ SCREEN-FILE.
Link back to cobol page