Google
 

Trailing-Edge - PDP-10 Archives - BB-H137B-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.