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

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)