Trailing-Edge
-
PDP-10 Archives
-
BB-D867D-BM
-
uetp/lib/rancbl.cbl
There are 15 other files named rancbl.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. RANCBL.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT RAN1 ASSIGN TO DSK
FILE LIMITS 0 THRU 1500
ACCESS RANDOM
ACTUAL KEY KEY1
RECORDING MODE SIXBIT.
* FILE STATUS FS,EN,AC,VID,BN,RN,FN,FT.
SELECT FILE1 ASSIGN TO DSK
RECORDING MODE SIXBIT.
* FILE STATUS FS,EN,AC,VID,BN,RN,FN,FT.
SELECT FILE2 ASSIGN TO DSK
RECORDING MODE SIXBIT.
* FILE STATUS FS,EN,AC,VID,BN,RN,FN,FT.
DATA DIVISION.
FILE SECTION.
FD RAN1
BLOCK 4 RECORD
LABEL STANDARD
VALUE OF ID "RAN1 DAT".
01 REC1 PIC X(6)
USAGE IS DISPLAY-6.
01 REC3 PIC X(13).
01 REC5 PIC X(29).
FD FILE1
BLOCK 4 RECORD
LABEL STANDARD
VALUE OF ID "RAN1 DAT".
01 RECSS PIC X(29)
USAGE DISPLAY-6.
FD FILE2
BLOCK 4 RECORD
LABEL STANDARD
VALUE OF ID "RAN1 DAT".
01 RECS PIC X(29)
USAGE DISPLAY-6.
WORKING-STORAGE SECTION.
77 NEWCMD PIC X(2).
77 CMD PIC X(2).
77 RCNT PIC 9(10).
77 KEY1 PIC 9(4) COMP.
77 FS PIC 9(2) DISPLAY-7.
77 EN PIC 9(10) DISPLAY-6.
77 AC INDEX.
77 VID PIC X(9).
77 BN INDEX.
77 RN INDEX.
77 FN PIC X(30).
77 FT INDEX.
PROCEDURE DIVISION.
DECLARATIVES.
DECLA SECTION. USE AFTER ERROR PROCEDURE RAN1, FILE1, FILE2.
DECLARA. DISPLAY "***IOEUP***".
DISPLAY "FS = " FS.
DISPLAY "EN = " EN.
DISPLAY "VID = " VID.
DISPLAY "BN = " BN.
DISPLAY "RN = " RN.
DISPLAY "FN = " FN.
DISPLAY "FT = " FT.
DISPLAY "AK = "KEY1.
DISPLAY "AC = "WITH NO ADVANCING.
ACCEPT AC.
END DECLARATIVES.
START. DISPLAY " ".
DISPLAY "TYPE: O OI OO R W1 W3 W5 C CD RA RS SW SR ".
ST. DISPLAY "*" WITH NO ADVANCING.
ACCEPT NEWCMD.
IF NEWCMD NOT = " " MOVE NEWCMD TO CMD.
IF CMD = "O " PERFORM O GO TO ST.
IF CMD = "OI" PERFORM OI GO TO ST.
IF CMD = "OO" PERFORM OO GO TO ST.
IF CMD = "C " PERFORM C GO TO START.
IF CMD = "CD" PERFORM CDD GO TO START.
IF CMD = "R " PERFORM R GO TO ST.
IF CMD = "RA" PERFORM RA GO TO START.
IF CMD = "RS" PERFORM RS GO TO START.
IF CMD = "W1" PERFORM W1 GO TO ST.
IF CMD = "W3" PERFORM W3 GO TO ST.
IF CMD = "W5" PERFORM W5 GO TO ST.
IF CMD = "SR" PERFORM SR GO TO ST.
IF CMD = "SW" PERFORM SW GO TO ST.
DISPLAY "HUH ? "WITH NO ADVANCING GO TO START.
O. OPEN I-O RAN1.
OI. OPEN INPUT RAN1.
OO. OPEN OUTPUT RAN1.
C. CLOSE RAN1.
CDD. OPEN INPUT RAN1.
CLOSE RAN1 WITH DELETE.
W1. DISPLAY "KEY = "WITH NO ADVANCING ACCEPT KEY1.
MOVE ALL "1" TO REC1 WRITE REC1 INVALID KEY PERFORM REND.
W3. DISPLAY "KEY = " WITH NO ADVANCING ACCEPT KEY1.
MOVE ALL "3" TO REC3 WRITE REC3 INVALID KEY PERFORM REND.
W5. DISPLAY "KEY = " WITH NO ADVANCING ACCEPT KEY1.
MOVE ALL "5" TO REC5 WRITE REC5 INVALID KEY PERFORM REND.
SR SECTION.
S0. OPEN INPUT FILE2.
S1. READ FILE2 AT END GO TO S2.
DISPLAY RECS GO TO S1.
S2. CLOSE FILE2.
SRX. EXIT.
SW SECTION.
SW0. OPEN OUTPUT FILE2.
MOVE ZERO TO RCNT.
SW1. SET RCNT UP BY 1. MOVE RCNT TO RECS.
WRITE RECS.
IF RCNT = 50 GO TO SW2 ELSE GO TO SW1.
SW2. CLOSE FILE2.
SWX. EXIT.
R SECTION.
RR. DISPLAY "KEY = " WITH NO ADVANCING.
ACCEPT KEY1 READ RAN1 INVALID KEY GO TO REND.
DISPLAY "[" KEY1 "]" WITH NO ADVANCING.
DISPLAY REC5 GO TO REXIT.
REND. DISPLAY "INVALID KEY [" KEY1 "]".
REXIT. EXIT.
RA SECTION.
RA1. MOVE ZERO TO RCNT, KEY1.
OPEN INPUT RAN1.
RA1-LOOP. READ RAN1 INVALID KEY GO TO RA1-END.
SET RCNT UP BY 1.
DISPLAY "[" RCNT "]" WITH NO ADVANCING.
DISPLAY REC5.
GO TO RA1-LOOP.
RA1-END. DISPLAY RCNT " - RECORDS".
CLOSE RAN1.
RS SECTION.
RS-1. MOVE ZERO TO RCNT.
OPEN I-O FILE1.
RS-2. READ FILE1 AT END GO TO RS-END.
SET RCNT UP BY 1.
DISPLAY "[" RCNT "]" RECSS.
GO TO RS-2.
RS-END. DISPLAY RCNT " - RECORDS".
CLOSE FILE1.