IDENTIFICATION DIVISION.
*AUTHOR : CAROL LAYCOCK
*Program to create an indexed file of the sequential file called
*"USER.DAT" with record key of user-id. The indexed file is
*called "USERI.DAT".
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT USER-FILE ASSIGN TO DISK "A:\USER.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT USERI-FILE ASSIGN TO DISK "A:\USERI.DAT"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS I-ID.
DATA DIVISION.
FILE SECTION.
FD USER-FILE
LABEL RECORDS ARE STANDARD.
01 USER-RECORD.
05 H-ID PIC X(04).
05 H-DATE.
10 H-DAY PIC 9(02).
10 H-MONTH PIC 9(02).
10 H-YEAR PIC 9(02).
05 H-TIME.
10 H-HOUR PIC 9(02).
10 H-MIN PIC 9(02).
05 R-DATE.
10 R-DAY PIC 9(02).
10 R-MONTH PIC 9(02).
10 R-YEAR PIC 9(02).
05 R-TIME.
10 R-HOUR PIC 9(02).
10 R-MIN PIC 9(02).
FD USERI-FILE
LABEL RECORDS ARE STANDARD.
01 USERI-RECORD.
05 I-ID PIC X(04).
05 I-DATE-HIRE PIC 9(06).
05 I-TIME-HIRE PIC 9(04).
05 I-DATE-RETURN PIC 9(06).
05 I-TIME-RETURN PIC 9(04).
WORKING-STORAGE SECTION.
01 W1-EOC-FILE PIC X(01).
88 EOC-FILE VALUE "T".
01 W-HOLDING PIC X(56).
01 Y-LEAP PIC 9(02).
01 N-LEAP PIC 9(02).
01 INVALID-RECORD PIC 9(02) VALUE ZEROS.
PROCEDURE DIVISION.
MAIN SECTION.
MAIN-A.
DISPLAY ERASE
PERFORM AA-INITIALISE
PERFORM AB-READ-AND-PROCESS UNTIL EOC-FILE.
AA-INITIALISE SECTION.
*Opens files, initialises variables, perform initial read.
AA-ENTRY.
OPEN INPUT
USER-FILE
OUTPUT
USERI-FILE
MOVE "F" TO W1-EOC-FILE
READ USER-FILE
AT END
DISPLAY "ERROR - USER FILE EMPTY"
MOVE "T" TO W1-EOC-FILE
END-READ.
AB-READ-AND-PROCESS SECTION.
* Creates indexed file from sequential file.
AB-ENTRY.
IF H-DATE IS NOT NUMERIC OR
H-DATE = ZEROS OR H-TIME IS NOT NUMERIC OR
H-TIME = ZERO OR R-DATE IS NOT NUMERIC OR
R-DATE = ZERO OR R-TIME IS NOT NUMERIC OR
R-TIME = ZERO
DISPLAY "ERROR"
DISPLAY USER-RECORD
ELSE
PERFORM CHECK-DATE
IF INVALID-RECORD = ZERO
WRITE USERI-RECORD FROM USER-RECORD
INVALID KEY
DISPLAY "ERROR - DUPLICATE RECORD"
END-WRITE
END-IF
END-IF
READ USER-FILE
AT END
MOVE "T" TO W1-EOC-FILE
NOT AT END
MOVE ZERO TO INVALID-RECORD
PERFORM AB-ENTRY
END-READ.
CLOSE USER-FILE USERI-FILE
STOP RUN.
*CHECK HIRE TIME
CHECK-DATE.
IF H-DATE > R-DATE OR H-MIN > 60 OR
H-HOUR > 24 OR H-TIME > 2400 OR H-MONTH > 12 OR
R-MIN > 60 OR R-HOUR > 24 OR R-TIME > 2400 OR
R-MONTH > 12
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
ELSE
PERFORM VALID-DATE-TIME
END-IF.
VALID-DATE-TIME.
IF H-MONTH = (1 OR 3 OR 5 OR 7 OR 10 OR 12) AND
H-DAY > 31 OR H-MONTH = (4 OR 6 OR 9 OR 11) AND
H-DAY > 30
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
END-IF
IF H-MONTH = 2
PERFORM LEAP-YEAR-1
END-IF
IF (R-MONTH = (1 OR 3 OR 5 OR 7 OR 10 OR 12) AND
R-DAY > 31) OR (R-MONTH = (4 OR 6 OR 9 OR 11) AND
R-DAY > 30)
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
END-IF
IF R-MONTH = 2
PERFORM LEAP-YEAR-2
END-IF.
LEAP-YEAR-1.
DIVIDE H-YEAR BY 4 GIVING Y-LEAP REMAINDER N-LEAP
IF N-LEAP = 0 AND H-DAY > 29
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
ELSE
IF N-LEAP NOT = 0
AND H-DAY > 28
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
END-IF
END-IF.
LEAP-YEAR-2.
DIVIDE R-YEAR BY 4 GIVING Y-LEAP REMAINDER N-LEAP
IF N-LEAP NOT = 0
AND R-DAY > 28
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
ELSE
IF N-LEAP NOT = 0
AND R-DAY > 28
DISPLAY "ERROR"
MOVE 1 TO INVALID-RECORD
END-IF
END-IF.
This is the indexed file and now I will add the sub program. I haven't used the linkage section in the sub program yet as I wanted to get it to work first.
IDENTIFICATION DIVISION.
PROGRAM-ID. UPDATE-RECORD.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUST-FILE ASSIGN TO DISK "A:\CUSTI.DAT"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS CUSTOMER-ID
ALTERNATE KEY IS CUSTOMER-NAME WITH DUPLICATES.
SELECT USER-FILE ASSIGN TO DISK "A:\USERI.DAT"
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS USER-ID.
DATA DIVISION.
FILE SECTION.
FD CUST-FILE.
01 CUST-RECORD.
05 CUSTOMER-ID PIC X(04).
05 CUSTOMER-NAME PIC X(15).
05 DISCOUNT-RATE PIC V99.
FD USER-FILE.
01 USER-RECORD.
05 USER-ID PIC X(04).
05 DATE-HIRE.
10 H-DAY PIC 9(02).
10 H-MONTH PIC 9(02).
10 H-YEAR PIC 9(02).
05 TIME-HIRE.
10 H-MIN PIC 9(02).
10 H-HOUR PIC 9(02).
05 DATE-RETURN PIC 9(06).
05 TIME-RETURN PIC 9(04).
*FIELDS TO HOLD TODAYS DATE
01 RUN-DATE.
05 RUN-YEAR PIC 9(02).
05 RUN-MONTH PIC 9(02).
05 RUN-DAY PIC 9(02).
*FIELDS TO HOLD CURRENT TIME
01 RUN-TIME.
05 RUN-HOUR PIC 9(02).
05 RUN-MIN PIC 9(02).
01 D-NAME PIC X(15).
01 D-ID PIC X(04).
01 D-DATE PIC 9(06).
01 D-TIME PIC 9(04).
01 CUST-OPTION PIC X(01).
LINKAGE SECTION.
01 H-DATE-HIRE PIC 9(06).
01 H-TIME-HIRE PIC 9(04).
01 H-DATE-RETURN PIC 9(06).
01 H-TIME-RETURN PIC 9(04).
01 H-CUSTOMER-NAME PIC X(15).
01 H-CUST-ID PIC X(04).
PROCEDURE DIVISION USING H-DATE-HIRE, H-TIME-HIRE,
H-DATE-RETURN, H-TIME-RETURN, H-CUSTOMER-NAME, H-CUST-ID.
MAIN.
INITIALISE.
*OPEN ALL FILES
OPEN INPUT CUST-FILE
OPEN I-O USER-FILE.
AA-NEW-CUSTOMER.
DISPLAY "Would you like to add a new customer Y/N"
ACCEPT CUST-OPTION
IF CUST-OPTION = "Y"
DISPLAY "Enter Customer First Name then Last Name and enter"
ACCEPT D-NAME
MOVE D-NAME TO CUSTOMER-NAME
ACCEPT RUN-DATE FROM DATE
MOVE RUN-YEAR TO H-YEAR
MOVE RUN-MONTH TO H-MONTH
MOVE RUN-DAY TO H-DAY
ACCEPT RUN-TIME FROM TIME
MOVE RUN-HOUR TO H-HOUR
MOVE RUN-MIN TO H-MIN
MOVE ZEROS TO DATE-RETURN
MOVE ZEROS TO TIME-RETURN
ELSE
IF CUST-OPTION = "N"
PERFORM BB-NAME
END-IF
END-IF.
BB-NAME.
DISPLAY "Enter Customer First Name then Last Name and enter"
ACCEPT D-NAME
DISPLAY "Do you wish to delete this customer Y/N"
ACCEPT CUST-OPTION
IF CUST-OPTION = "Y"
PERFORM DELETE-CUSTOMER
ELSE
IF CUST-OPTION = "N"
MOVE D-NAME TO CUSTOMER-NAME
IF D-NAME = SPACES
PERFORM CHECK-ID
ELSE
MOVE D-NAME TO CUSTOMER-NAME
READ CUST-FILE KEY IS CUSTOMER-NAME
INVALID KEY
PERFORM ERROR-RTN-1
NOT INVALID KEY
MOVE CUSTOMER-NAME TO H-CUSTOMER-NAME
END-READ
END-IF.
*CLOSE FILES
CLOSE CUST-FILE
CLOSE USER-FILE
EXIT PROGRAM.
STOP RUN.
ACCEPT-DATE.
ACCEPT RUN-DATE FROM DATE
MOVE RUN-YEAR TO H-YEAR
MOVE RUN-MONTH TO H-MONTH
MOVE RUN-DAY TO H-DAY.
ACCEPT-TIME.
ACCEPT RUN-TIME FROM TIME
MOVE RUN-HOUR TO H-HOUR
MOVE RUN-MIN TO H-MIN.
ERROR-RTN-1.
DISPLAY "File not found"
PERFORM BB-NAME.
CHECK-ID.
DISPLAY "Enter customer ID"
ACCEPT D-ID
MOVE D-ID TO CUSTOMER-ID
READ CUST-FILE KEY IS CUSTOMER-ID
INVALID KEY
PERFORM ERROR-RTN-1
NOT INVALID KEY
MOVE CUSTOMER-ID TO H-CUST-ID
END-READ.
DELETE-CUSTOMER.
MOVE CUSTOMER-ID TO USER-ID
START USER-FILE
KEY = USER-ID
INVALID KEY
DISPLAY "ERROR"
END-START
READ USER-FILE
INVALID KEY
DISPLAY "No Such Record"
NOT INVALID KEY
DELETE USER-FILE RECORD
INVALID KEY
DISPLAY "Delete Error"
END-DELETE
END-READ.
Sorry if this seems a lot to post here but is that what you wanted me to do? Can I set up the compound key with the index file?