jgt
unread,Sep 3, 2023, 2:38:03 PM9/3/23You do not have permission to delete messages in this group
Either email addresses are anonymous for this group or you need the view member email addresses permission to view the original message
to
I was cleaning up an old computer, before sending it for recycling and found this:
IDENTIFICATION DIVISION.
PROGRAM-ID. ISAM-TIP.
AUTHOR. J TEARLE.
DATE-WRITTEN. DEC 1983.
*REMARKS. COPY ISAM FROM SDF TO TIP AND RECREATE TIP INDEX.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. UNIVAC-1100-60.
OBJECT-COMPUTER. UNIVAC-1100-60.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SDF-FILE ASSIGN TO DISC CUSTFIL
ACCESS IS SEQUENTIAL
ORGANIZATION IS INDEXED
RECORD KEY IS SDF-KEY.
SELECT DATA-SORT ASSIGN TO DISC.
DATA DIVISION.
FILE SECTION.
SD DATA-SORT
DATA RECORD IS SORT-REC.
01 SORT-REC.
03 SORT-NAME-NUMB.
05 SORT-NAME PIC X(19).
05 SORT-NUMB PIC 9(12) COMP.
03 SORT-RRN PIC 9(10) COMP.
FD SDF-FILE LABEL RECORDS ARE STANDARD.
01 SDF-RECORD2.
03 SDF-KEY PIC X(12).
03 FILLER PIC X(548).
WORKING-STORAGE SECTION.
COPY CUSTFIL-DEF.
COPY FCSS-BUFFER.
COPY INDEX-DEF.
COPY TIPFILE-DEF.
01 SDF-RECORD.
02 SDF-DATA.
03 SDF-WORD PIC X(4) OCCURS 140 TIMES.
01 CUSTFIL-DATA REDEFINES SDF-RECORD.
COPY TMW140.
01 X0 PIC S9(10) COMP.
01 X1 PIC S9(10) COMP.
01 X2 PIC S9(10) COMP.
01 PC PIC 9(10) COMP.
01 XX PIC 9.
01 EOF PIC X VALUE 'N'.
01 EOF2 PIC X VALUE 'N'.
01 TODAY-DATE PIC 9(6).
01 DAY-OF-CENTURY PIC 9(10).
COPY ASYSDF IN TIPLIB.
01 CUSTOMER-KEY.
03 CUSTOMER-KEY-R PIC 9(12).
03 CUST-N REDEFINES CUSTOMER-KEY-R.
05 FILLER PIC X(6).
05 CUSTOMER-NUMBER PIC 9(6).
PROCEDURE DIVISION.
SOJ.
SORT DATA-SORT ON ASCENDING KEY SORT-NAME-NUMB
INPUT PROCEDURE IS PRE-SORT
OUTPUT PROCEDURE IS POST-SORT.
EOJ.
STOP RUN.
PRE-SORT SECTION.
BEGIN.
OPEN INPUT SDF-FILE.
CALL 'CCONET' USING 0 0 1.
MOVE CUSTFIL TO TIPFILE.
MOVE CUSTFIL-INDEX TO TIPFILE-INDEX.
PERFORM TIPFILE-LOCK.
PERFORM OPEN-TIPFILE.
MOVE ZERO TO X1 X2.
MOVE TIPFILE-INDEX TO INDEX-FILE-NUMBER.
* DISPLAY 'ENTER PERCENT FILL'. ACCEPT PC FROM CARD-READER.
MOVE ZERO TO TIPFILE-RRN WORK-RRN.
MOVE 1 TO INDEX-RRN.
CALL 'CFCSS' USING RR FCDONE INDEX-RECORD INDEX-FILE-NUMBER
INDEX-RECORD-LENGTH, INDEX-RRN, INDEX-BUFFER-LENGTH.
MOVE LEVEL-2-INDEX TO LEVEL-1-INDEX.
COMPUTE PC = PERCENT-FILL * 256 / 100
PERFORM INIT-INDEX-1 255 TIMES.
MOVE ZERO TO X1.
PERFORM LOAD-INDEX-1 THRU INDEX-1-EXIT UNTIL EOF2 EQUAL 'Y'.
MOVE 1 TO INDEX-RRN.
ACCEPT TODAY-DATE FROM DATE.
CALL 'DYCENT' USING TODAY-DATE DAY-OF-CENTURY.
MOVE DAY-OF-CENTURY TO DATE-LAST-REORGANIZATION.
MOVE X1 TO CURRENT-LEVEL2-RECORDS.
MOVE LEVEL-1-INDEX TO LEVEL-2-INDEX.
PERFORM WRITE-LEVEL-2.
PERFORM FCSS-CHECK.
* CALL 'CDISCN'.
CLOSE SDF-FILE.
GO TO PRE-SORT-EXIT.
LOAD-INDEX-1.
ADD 1 TO X1.
ADD 1 TO INDEX-RRN.
MOVE ZERO TO X2.
PERFORM LOAD-INDEX-2 THRU LOAD-INDEX-2-EXIT 256 TIMES.
MOVE LEVEL-2-KEY (1) TO LEVEL-1-KEY (X1).
MOVE LEVEL-2-RRN (1) TO LEVEL-1-RRN (X1).
IF LEVEL-1-KEY (X1) EQUAL HIGH-VALUES
CALL 'CFCSS' USING CK FCDONE TIPFILE-RECORD
MOVE 'Y' TO EOF2.
PERFORM WRITE-LEVEL-2.
INDEX-1-EXIT.
EXIT.
LOAD-INDEX-2.
ADD 1 TO X2 WORK-RRN.
MOVE HIGH-VALUES TO LEVEL-2-KEY (X2).
MOVE WORK-RRN TO LEVEL-2-RRN (X2).
IF X2 LESS THAN PC
PERFORM READ-SDF THRU READ-SDF-EXIT.
PERFORM WRITE-TIPFILE.
LOAD-INDEX-2-EXIT.
EXIT.
READ-SDF.
IF EOF NOT EQUAL 'Y'
READ SDF-FILE AT END MOVE 'Y' TO EOF.
IF EOF NOT EQUAL 'Y'
MOVE SDF-KEY TO LEVEL-2-KEY (X2)
MOVE SDF-RECORD2 TO SDF-RECORD
MOVE W140-NAME TO SORT-NAME W140-NAME-KEY
MOVE W140-CUSTOMER-KEY TO CUSTOMER-KEY
MOVE CUSTOMER-KEY-R TO SORT-NUMB W140-NUMB-KEY
MOVE WORK-RRN TO SORT-RRN
RELEASE SORT-REC
ELSE MOVE LOW-VALUES TO SDF-RECORD.
READ-SDF-EXIT.
EXIT.
R010-EXIT. EXIT.
COPY FCSS-CHECK-BATCH.
WRITE-LEVEL-2.
CALL 'CFCSS' USING WW FCDONE INDEX-RECORD INDEX-FILE-NUMBER
INDEX-RECORD-LENGTH, INDEX-RRN, INDEX-BUFFER-LENGTH.
MOVE INDEX-BUFFER TO FCSS-BUFFER.
PERFORM FCSS-CHECK.
INIT-INDEX-1.
ADD 1 TO X1.
MOVE HIGH-VALUES TO LEVEL-1-KEY (X1).
MOVE 9999999999 TO LEVEL-1-RRN (X1).
COPY OPEN-TIPFILE.
COPY TIPFILE-LOCK.
COPY WRITE-TIPFILE.
PRE-SORT-EXIT. EXIT.
POST-SORT SECTION.
BEGIN.
MOVE 'N' TO EOF2 EOF.
MOVE ZERO TO X1 X2.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
MOVE 1 TO INDEX-RRN.
CALL 'CFCSS' USING RR FCDONE INDEX-RECORD INDEX-FILE-NUMBER
INDEX-RECORD-LENGTH, INDEX-RRN, INDEX-BUFFER-LENGTH.
MOVE LEVEL-2-INDEX TO LEVEL-1-INDEX.
PERFORM INIT-INDEX-1 255 TIMES.
MOVE ZERO TO X1.
PERFORM LOAD-INDEX-1 THRU INDEX-1-EXIT UNTIL EOF2 EQUAL 'Y'.
MOVE 1 TO INDEX-RRN.
CALL 'DYCENT' USING TODAY-DATE DAY-OF-CENTURY.
MOVE DAY-OF-CENTURY TO DATE-LAST-REORGANIZATION.
MOVE X1 TO CURRENT-LEVEL2-RECORDS.
MOVE LEVEL-1-INDEX TO LEVEL-2-INDEX.
PERFORM WRITE-LEVEL-2.
PERFORM FCSS-CHECK.
CALL 'CDISCN'.
GO TO POST-SORT-EXIT.
LOAD-INDEX-1.
ADD 1 TO X1.
ADD 1 TO INDEX-RRN.
MOVE ZERO TO X2.
PERFORM LOAD-INDEX-2 THRU LOAD-INDEX-2-EXIT 256 TIMES.
MOVE LEVEL-2-KEY (1) TO LEVEL-1-KEY (X1).
MOVE LEVEL-2-RRN (1) TO LEVEL-1-RRN (X1).
IF LEVEL-1-KEY (X1) EQUAL HIGH-VALUES
MOVE 'Y' TO EOF2.
PERFORM WRITE-LEVEL-2.
INDEX-1-EXIT.
EXIT.
LOAD-INDEX-2.
ADD 1 TO X2 .
MOVE HIGH-VALUES TO LEVEL-2-KEY (X2).
MOVE 9999999999 TO LEVEL-2-RRN (X2).
IF X2 LESS THAN PC
PERFORM RETURN-SORT THRU RETURN-SORT-EXIT.
LOAD-INDEX-2-EXIT.
EXIT.
RETURN-SORT.
IF EOF NOT EQUAL 'Y'
RETURN DATA-SORT AT END MOVE 'Y' TO EOF.
IF EOF NOT EQUAL 'Y'
MOVE SORT-NUMB TO CUSTOMER-KEY-R
IF CUSTOMER-NUMBER EQUAL 999999 GO TO RETURN-SORT.
IF EOF NOT EQUAL 'Y'
MOVE SORT-RRN TO LEVEL-2-RRN (X2)
MOVE SORT-NAME-NUMB TO LEVEL-2-KEY (X2).
RETURN-SORT-EXIT.
EXIT.
COPY FCSS-CHECK-BATCH.
WRITE-LEVEL-2.
PERFORM LOCK-INDEX-RECORD.
CALL 'CFCSS' USING WR FCDONE INDEX-RECORD INDEX-FILE-NUMBER
INDEX-RECORD-LENGTH, INDEX-RRN, INDEX-BUFFER-LENGTH.
MOVE INDEX-BUFFER TO FCSS-BUFFER.
PERFORM FCSS-CHECK.
LOCK-INDEX-RECORD.
CALL 'CFCSS' USING LK FCDONE INDEX-RECORD INDEX-FILE-NUMBER
INDEX-RECORD-LENGTH INDEX-RRN INDEX-BUFFER-LENGTH.
MOVE INDEX-BUFFER TO FCSS-BUFFER.
PERFORM FCSS-CHECK.
INIT-INDEX-1.
ADD 1 TO X1.
MOVE HIGH-VALUES TO LEVEL-1-KEY (X1).
MOVE 9999999999 TO LEVEL-1-RRN (X1).
POST-SORT-EXIT. EXIT.
IDENTIFICATION DIVISION.
PROGRAM-ID. TIP-ISAM.
AUTHOR. J TEARLE.
DATE-WRITTEN. DEC 1983.
*REMARKS. COPY ISAM FROM TIP TO SDF.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. UNIVAC-1100-60.
OBJECT-COMPUTER. UNIVAC-1100-60.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SDF-FILE ASSIGN TO DISC CUSTFIL
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS SDF-KEY.
DATA DIVISION.
FILE SECTION.
FD SDF-FILE LABEL RECORDS ARE STANDARD.
01 SDF-RECORD.
03 SDF-KEY PIC X(12).
03 FILLER PIC X(2).
03 SDF-NAME PIC X(30).
03 FILLER PIC X(380).
03 SDF-NAME-NUMB-KEY PIC X(42).
03 FILLER PIC X(94).
WORKING-STORAGE SECTION.
COPY ASYSDF IN TIPLIB.
COPY CUSTFIL-DEF.
COPY FCSS-BUFFER.
COPY INDEX-DEF.
COPY TIPFILE-DEF.
01 X0 PIC S9(10) COMP.
01 WK-NAME-KEY.
03 WK-NAME PIC X(30).
03 WK-NUMB PIC 9(12).
01 RECORD-COUNT PIC 9(5) VALUE ZERO.
01 REC-COUNT-R REDEFINES RECORD-COUNT.
03 FILLER PIC XX.
03 RECORD-THOU PIC 999.
PROCEDURE DIVISION.
BEGIN.
OPEN OUTPUT SDF-FILE.
CALL 'CCONET' USING 0 0 1.
MOVE CUSTFIL-INDEX TO TIPFILE-INDEX.
MOVE CUSTFIL TO TIPFILE.
PERFORM TIPFILE-LOCK.
PERFORM OPEN-TIPFILE.
READ-LOOP.
IF TIPFILE-STATUS EQUAL -2 GO TO EOJ.
PERFORM READ-TIPFILE-FAST THRU READ-TIPFILE-FAST-EXIT.
ADD 1 TO RECORD-COUNT.
IF RECORD-THOU EQUAL ZERO DISPLAY RECORD-COUNT.
MOVE WORK-DATA TO SDF-RECORD.
WRITE SDF-RECORD INVALID DISPLAY ' INVALID'
DISPLAY SDF-KEY '*' SDF-NAME-NUMB-KEY
'*' TIPFILE-STATUS '*' TIPFILE-RRN '*' GOT-RECORD.
GO TO READ-LOOP.
EOJ.
CLOSE SDF-FILE.
CALL 'CDISCN'.
STOP RUN.
COPY FCSS-CHECK-BATCH.
COPY TIPFILE-LOCK.
COPY OPEN-TIPFILE.
COPY READ-TIPFILE-FAST.
READ-CUSTFIL* PROC
READ-CUSTFIL.
CALL 'CFCSS' USING RR, FCDONE, CUSTFIL-RECORD, CUSTFIL,
CUSTFIL-REC-LEN, CUSTFIL-RRN, CUSTFIL-BUF-LEN.
MOVE CUSTFIL-BUFFER TO FCSS-BUFFER.
MOVE CUSTFIL TO FCSS-FILE-NUMBER.
MOVE CUSTFIL-RRN TO FCSS-RECORD-NUMBER.
PERFORM FCSS-CHECK.
END
READ-CUSTFIL-NO-CHECK* PROC
READ-CUSTFIL-NO-CHECK.
CALL 'CFCSS' USING RR, FCDONE, CUSTFIL-RECORD, CUSTFIL,
CUSTFIL-REC-LEN, CUSTFIL-RRN, CUSTFIL-BUF-LEN.
MOVE CUSTFIL-BUFFER TO FCSS-BUFFER.
MOVE CUSTFIL-RRN TO FCSS-RECORD-NUMBER.
MOVE CUSTFIL TO FCSS-FILE-NUMBER.
IF FCSSCD NOT = FCSS-NO-RECORD-STATUS
PERFORM FCSS-CHECK.
END
READLOCK-CUSTFIL* PROC
READLOCK-CUSTFIL.
CALL 'CFCSS' USING RL, FCDONE, CUSTFIL-RECORD, CUSTFIL,
CUSTFIL-REC-LEN, CUSTFIL-RRN, CUSTFIL-BUF-LEN.
MOVE CUSTFIL-BUFFER TO FCSS-BUFFER.
MOVE CUSTFIL TO FCSS-FILE-NUMBER.
MOVE CUSTFIL-RRN TO FCSS-RECORD-NUMBER.
PERFORM FCSS-CHECK.
END
READ-CUSTFIL-FAST* PROC
READ-CUSTFIL-FAST.
MOVE ZERO TO CUSTFIL-STATUS.
ADD 1 TO CUSTFIL-RECORD-COUNT.
DIVIDE CUSTFIL-RECORD-COUNT BY 256 GIVING INDEX-RRN
REMAINDER X0.
IF X0 EQUAL ZERO MOVE 256 TO X0.
IF X0 EQUAL 1 PERFORM READ-CUSTFIL-INDEX.
IF CUSTFIL-STATUS EQUAL ZERO
IF LEVEL-2-KEY (X0) EQUAL HIGH-VALUES
IF X0 EQUAL 1 MOVE -2 TO CUSTFIL-STATUS
ELSE
GO TO READ-CUSTFIL-FAST
ELSE
MOVE LEVEL-2-RRN (X0) TO CUSTFIL-RRN
PERFORM READ-CUSTFIL-NO-CHECK
IF FCSS-STATUS LESS THAN ZERO
MOVE -2 TO CUSTFIL-STATUS.
READ-CUSTFIL-FAST-EXIT. EXIT.
READ-CUSTFIL-INDEX.
ADD 2 TO INDEX-RRN.
CALL 'CFCSS' USING RR FCDONE INDEX-RECORD CUSTFIL-INDEX
INDEX-RECORD-LENGTH INDEX-RRN INDEX-BUFFER-LENGTH.
MOVE INDEX-BUFFER TO FCSS-BUFFER.
IF FCSS-STATUS LESS THAN ZERO MOVE -2 TO CUSTFIL-STATUS.
END
WRITE-CUSTFIL* PROC
WRITE-CUSTFIL.
CALL 'CFCSS' USING WR, FCDONE, CUSTFIL-RECORD, CUSTFIL,
CUSTFIL-REC-LEN, CUSTFIL-RRN, CUSTFIL-BUF-LEN.
MOVE CUSTFIL-BUFFER TO FCSS-BUFFER.
MOVE CUSTFIL-RRN TO FCSS-RECORD-NUMBER.
MOVE CUSTFIL TO FCSS-FILE-NUMBER.
PERFORM FCSS-CHECK.
END
READ-CUSTFIL-INVALID* PROC
READ-CUSTFIL-INVALID.
MOVE CUSTFIL-INDEX TO INDEX-FILE-NUMBER.
MOVE W140-CUSTOMER-KEY TO SEARCH-KEY.
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO MOVE -1 TO RETURN-STATUS.
IF RETURN-STATUS EQUAL ZERO
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READ-CUSTFIL
IF W140-CUSTOMER-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
END
READLOCK-CUSTFIL-INVALID* PROC
READLOCK-CUSTFIL-INVALID.
MOVE CUSTFIL-INDEX TO INDEX-FILE-NUMBER.
MOVE W140-CUSTOMER-KEY TO SEARCH-KEY.
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO MOVE -1 TO RETURN-STATUS.
IF RETURN-STATUS EQUAL ZERO
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READLOCK-CUSTFIL
IF W140-CUSTOMER-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
END
READ-CUSTFIL-NEXT* PROC
READ-CUSTFIL-NEXT.
MOVE CUSTFIL-INDEX TO INDEX-FILE-NUMBER.
MOVE CUSTFIL-KEY TO SEARCH-KEY.
IF SEARCH-KEY EQUAL HIGH-VALUES
MOVE 9999999999 TO SEARCH-RRN
MOVE -2 TO RETURN-STATUS
ELSE
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO OR RETURN-STATUS EQUAL -1
IF NEXT-KEY NOT EQUAL HIGH-VALUES
MOVE NEXT-KEY TO SEARCH-KEY
PERFORM FIND-KEY THRU FIND-KEY-EXIT
ELSE
MOVE NEXT-KEY TO SEARCH-KEY
MOVE 9999999999 TO SEARCH-RRN.
IF SEARCH-RRN GREATER THAN 999999
MOVE -2 TO RETURN-STATUS
ELSE
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READ-CUSTFIL
IF W140-CUSTOMER-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
MOVE NEXT-KEY TO CUSTFIL-KEY.
END
READLOCK-CUSTFIL-NEXT* PROC
READLOCK-CUSTFIL-NEXT.
MOVE CUSTFIL-INDEX TO INDEX-FILE-NUMBER.
MOVE CUSTFIL-KEY TO SEARCH-KEY.
IF SEARCH-KEY EQUAL HIGH-VALUES
MOVE 9999999999 TO SEARCH-RRN
MOVE -2 TO RETURN-STATUS
ELSE
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO OR RETURN-STATUS EQUAL -1
IF NEXT-KEY NOT EQUAL HIGH-VALUES
MOVE NEXT-KEY TO SEARCH-KEY
PERFORM FIND-KEY THRU FIND-KEY-EXIT
ELSE
MOVE NEXT-KEY TO SEARCH-KEY
MOVE 9999999999 TO SEARCH-RRN.
IF SEARCH-RRN GREATER THAN 999999
MOVE -2 TO RETURN-STATUS
ELSE
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READLOCK-CUSTFIL
IF W140-CUSTOMER-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
MOVE NEXT-KEY TO CUSTFIL-KEY.
END
INSERT-CUSTFIL* PROC
INSERT-CUSTFIL.
MOVE W140-CUSTOMER-KEY TO SEARCH-KEY.
MOVE CUSTFIL-INDEX TO INDEX-FILE-NUMBER.
PERFORM INSERT-KEY THRU INSERT-KEY-EXIT.
IF RETURN-STATUS EQUAL ZERO
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM LOCK-CUSTFIL
PERFORM WRITE-CUSTFIL.
END
DELETE-CUSTFIL* PROC
DELETE-CUSTFIL.
MOVE W140-CUSTOMER-KEY TO SEARCH-KEY.
MOVE CUSTFIL-INDEX TO INDEX-FILE-NUMBER.
PERFORM DELETE-KEY THRU DELETE-KEY-EXIT.
IF RETURN-STATUS EQUAL ZERO
MOVE LOW-VALUES TO CUSTFIL-DATA
PERFORM WRITE-CUSTFIL.
END
READ-ALPHA-INVALID* PROC
READ-ALPHA-INVALID.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
MOVE W140-NAME-NUMB-KEY TO SEARCH-KEY.
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO MOVE -1 TO RETURN-STATUS.
IF RETURN-STATUS EQUAL ZERO
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READ-CUSTFIL
IF W140-NAME-NUMB-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
END
READLOCK-ALPHA-INVALID* PROC
READLOCK-ALPHA-INVALID.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
MOVE W140-NAME-NUMB-KEY TO SEARCH-KEY.
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO MOVE -1 TO RETURN-STATUS.
IF RETURN-STATUS EQUAL ZERO
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READLOCK-CUSTFIL
IF W140-NAME-NUMB-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
END
READ-ALPHA-NEXT* PROC
READ-ALPHA-NEXT.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
MOVE ALPHA-KEY TO SEARCH-KEY.
IF SEARCH-KEY EQUAL HIGH-VALUES
MOVE 9999999999 TO SEARCH-RRN
MOVE -2 TO RETURN-STATUS
ELSE
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO OR RETURN-STATUS EQUAL -1
IF NEXT-KEY NOT EQUAL HIGH-VALUES
MOVE NEXT-KEY TO SEARCH-KEY
PERFORM FIND-KEY THRU FIND-KEY-EXIT
ELSE
MOVE NEXT-KEY TO SEARCH-KEY
MOVE 9999999999 TO SEARCH-RRN.
IF SEARCH-RRN GREATER THAN 999999
MOVE -2 TO RETURN-STATUS
ELSE
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READ-CUSTFIL
IF W140-NAME-NUMB-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
MOVE NEXT-KEY TO ALPHA-KEY.
END
READLOCK-ALPHA-NEXT* PROC
READLOCK-ALPHA-NEXT.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
MOVE ALPHA-KEY TO SEARCH-KEY.
IF SEARCH-KEY EQUAL HIGH-VALUES
MOVE 9999999999 TO SEARCH-RRN
MOVE -2 TO RETURN-STATUS
ELSE
PERFORM FIND-KEY THRU FIND-KEY-EXIT.
IF SEARCH-RRN EQUAL ZERO OR RETURN-STATUS EQUAL -1
IF NEXT-KEY NOT EQUAL HIGH-VALUES
MOVE NEXT-KEY TO SEARCH-KEY
PERFORM FIND-KEY THRU FIND-KEY-EXIT
ELSE
MOVE NEXT-KEY TO SEARCH-KEY
MOVE 9999999999 TO SEARCH-RRN.
IF SEARCH-RRN GREATER THAN 999999
MOVE -2 TO RETURN-STATUS
ELSE
MOVE SEARCH-RRN TO CUSTFIL-RRN
PERFORM READLOCK-CUSTFIL
IF W140-NAME-NUMB-KEY NOT EQUAL SEARCH-KEY
PERFORM SEARCH-ERROR.
MOVE NEXT-KEY TO ALPHA-KEY.
END
INSERT-ALPHA* PROC
INSERT-ALPHA.
MOVE W140-NAME-NUMB-KEY TO SEARCH-KEY.
MOVE CUSTFIL-RRN TO SEARCH-RRN.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
PERFORM ALTERNATE-INSERT-KEY THRU ALTERNATE-INSERT-KEY-EXIT.
END
DELETE-ALPHA* PROC
DELETE-ALPHA.
MOVE W140-NAME-NUMB-KEY TO SEARCH-KEY.
MOVE ALPHA-INDEX TO INDEX-FILE-NUMBER.
PERFORM DELETE-KEY THRU DELETE-KEY-EXIT.
END
UNLOCK-CUSTFIL* PROC
UNLOCK-CUSTFIL.
CALL 'CFCSS' USING UN FCDONE CUSTFIL-RECORD.
MOVE CUSTFIL-BUFFER TO FCSS-BUFFER.
MOVE CUSTFIL-RRN TO FCSS-RECORD-NUMBER.
MOVE CUSTFIL TO FCSS-FILE-NUMBER.
PERFORM FCSS-CHECK.
END
LOCK-CUSTFIL* PROC
LOCK-CUSTFIL.
CALL 'CFCSS' USING LK FCDONE CUSTFIL-RECORD CUSTFIL
CUSTFIL-REC-LEN CUSTFIL-RRN CUSTFIL-BUF-LEN.
MOVE CUSTFIL-BUFFER TO FCSS-BUFFER.
MOVE CUSTFIL TO FCSS-FILE-NUMBER.
MOVE CUSTFIL-RRN TO FCSS-RECORD-NUMBER.
PERFORM FCSS-CHECK.
END
CUSTFIL-DEF* PROC
01 CUSTFIL-INDEX PIC 9(10) COMP VALUE 34.
01 ALPHA-INDEX PIC 9(10) COMP VALUE 30.
01 CUSTFIL PIC 9(10) COMP VALUE 33.
01 CUSTFIL-REC-LEN PIC 9(10) COMP VALUE 140.
01 CUSTFIL-BUF-LEN PIC 9(10) COMP VALUE 143.
01 CUSTFIL-RRN PIC 9(10) COMP.
01 CUSTFIL-RECORD-COUNT PIC 9(5) COMP.
01 CUSTFIL-STATUS PIC S99.
01 CUSTFIL-KEY PIC X(12).
01 ALPHA-KEY PIC X(24).
END