Trailing-Edge
-
PDP-10 Archives
-
k20v7c
-
mfg/src/massrt.cbl
There are no other files named massrt.cbl in the archive.
IDENTIFICATION DIVISION.
PROGRAM-ID. MASSRT.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LISTING ASSIGN TO DSK
FILE STATUS IS L-FILSTAT,L-ERRNUM,L-ACTCODE
L-VID,L-BLKNUM,L-RECNUM,L-FILNAM,L-FILPNTR
RECORDING MODE ASCII.
SELECT MASSOR ASSIGN TO DSK RECORDING MODE ASCII.
SELECT MASWRK ASSIGN TO DSK,DSK,DSK RECORDING MODE ASCII.
SELECT LOGFILE ASSIGN TO DSK RECORDING MODE ASCII.
SELECT MASHLP ASSIGN TO SYS,DSK
FILE STATUS IS L-FILSTAT,L-ERRNUM,L-ACTCODE
L-VID,L-BLKNUM,L-RECNUM,L-FILNAM,L-FILPNTR
RECORDING MODE ASCII.
SELECT DELFIL ASSIGN TO DSK RECORDING MODE ASCII.
DATA DIVISION.
FILE SECTION.
SD MASWRK
DATA RECORD IS SORT-REC.
01 SORT-REC.
*TIME (23)
05 LAST-TIME PIC X(22).
05 FILLER PIC X.
*SPOT (29)
05 SERIAL-NUMBER PIC X(5).
05 DEVICE PIC X(6) JUST RIGHT.
05 FILLER PIC X.
05 CYL-PGM PIC X(6) JUST RIGHT.
05 SUR-FIL PIC X(4) JUST RIGHT.
05 FILLER PIC X.
05 SEC-REC PIC X(5) JUST RIGHT.
05 FILLER PIC X.
*TALLY (4)
05 TAL PIC X(4).
*ERROR (24)
05 FILLER PIC X.
05 H-S PIC X(1).
05 FILLER PIC X.
05 CREG PIC X(6) JUST RIGHT.
05 FILLER PIC X.
05 EREG PIC X(6) JUST RIGHT.
05 ERROR-TYPE PIC X.
05 ENTRY-TYPE PIC X.
05 CONI-RH PIC X(6) JUST RIGHT.
FD LISTING
LABEL RECORDS STANDARD
VALUE OF ID FILNAM
RECORD CONTAINS 132 CHARACTERS.
01 INRECORD DISPLAY-7.
05 ENTRY-Q PIC X(10).
05 FILLER PIC X(122).
01 IN-LINE PIC X(80) DISPLAY-7.
FD MASSOR
LABEL RECORDS STANDARD
VALUE OF ID SORT-FILE
RECORD CONTAINS 80 CHARACTERS.
01 SORTRECORD PIC X(80).
FD LOGFILE
LABEL RECORDS STANDARD
VALUE OF ID "MASSRTLOG".
01 LOGFILE-REC DISPLAY-7.
*TIME (23)
05 TALOUT-TIME PIC X(23).
*SPOT (29)
05 TALOUT-SPOT.
10 TALOUT-SERIAL PIC X(5).
10 TALOUT-B-SPOT.
20 TALOUT-DEVICE PIC X(6).
20 FILLER PIC X(18).
10 TALOUT-BD1-SPOT REDEFINES TALOUT-B-SPOT.
20 FILLER PIC X.
20 TALOUT-BD1 PIC X(23).
10 TALOUT-DEL-SPOT REDEFINES TALOUT-B-SPOT.
20 FILLER PIC X(3).
20 DSK-CHAN PIC X(2).
20 FILLER PIC X(5).
20 DEL-CYL PIC X(3).
20 FILLER PIC X.
20 DEL-SUR PIC X(3).
20 FILLER PIC X(7).
*TALLY (4)
05 TALOUT-TALLY PIC X(4).
*ERROR (24)
05 TALOUT-ERROR.
10 FILLER PIC X.
10 DEL-MARK PIC X.
10 FILLER PIC X(15).
10 TALOUT-TYPE PIC X.
10 FILLER PIC X(6).
05 TALOUT-EXCESS.
10 FILLER PIC X(52).
01 LOGFILE-SIZE-REC DISPLAY-7.
05 FILLER PIC X(40).
05 EX-40.
10 FILLER PIC X(20).
10 EX-60.
15 FILLER PIC X(20).
15 EX-80.
20 FILLER PIC X(20).
20 EX-100.
25 FILLER PIC X(20).
25 EX-120 PIC X(12).
01 LOGFILE-SH40-REC PIC X(40) DISPLAY-7.
01 LOGFILE-SH60-REC PIC X(60) DISPLAY-7.
01 LOGFILE-SH80-REC PIC X(80) DISPLAY-7.
01 LOGFILE-SH100-REC PIC X(100) DISPLAY-7.
01 LOGFILE-SH120-REC PIC X(120) DISPLAY-7.
01 PAGE-REC PIC X DISPLAY-7.
FD MASHLP
LABEL RECORDS STANDARD
VALUE OF ID "MASSRTHLP"
RECORD CONTAINS 80 CHARACTERS.
01 MASHLP-REC PIC X(80) DISPLAY-7.
FD DELFIL
LABEL RECORDS STANDARD
VALUE OF ID DSK-DELFIL.
01 DELETE-2-REC PIC X(2).
01 DELETE-4-REC PIC X(4).
WORKING-STORAGE SECTION.
01 TALLY PIC S9(5) COMP.
77 L-FILSTAT PIC 9(2).
77 L-ERRNUM PIC 9(10).
77 L-ACTCODE INDEX.
77 L-VID PIC X(9).
77 L-BLKNUM INDEX.
77 L-RECNUM INDEX.
77 L-FILNAM PIC X(30).
77 L-FILPNTR INDEX.
01 DSK-DELFIL.
05 FFF PIC X(3) VALUE "DSK".
05 DEL-CHAN PIC X(2).
05 GGG PIC X(4) VALUE "XSPT".
01 SORT-FILE.
05 HHHH PIC X(4) VALUE "MASS".
05 SORT-CHAN PIC X(2) VALUE "YY".
05 SORT-TXT PIC X(3) VALUE "TXT".
01 LOGFILE-IN-RECORD.
*TIME (23)
05 TALIN-TIME PIC X(23).
*SPOT (29)
05 TALIN-SPOT.
10 TALIN-SERIAL PIC X(5).
10 TALIN-DEVICE PIC X(6).
10 FILLER PIC X(18).
*TALLY (4)
05 TALIN-TALLY PIC 9(4).
*ERROR (24)
05 TALIN-ERROR.
10 FILLER PIC X(17).
10 TALIN-TYPE PIC X.
10 FILLER PIC X(6).
01 LOGFILE-LF.
05 A-SPACE PIC X(1) VALUE ALL " ".
05 FILLER PIC X(131).
01 LOGFILE-H1.
05 EIGHTY-STARS PIC X(80) VALUE ALL "*".
05 FILLER PIC X(52).
01 LOGFILE-H2.
05 D-FILNAM PIC X(10).
05 H2-LEFT-STAR PIC X(5) VALUE "*SEQ:".
05 H2-BEG-SEQ PIC X(4) JUST RIGHT.
05 H2-SEP1 PIC X(2) VALUE "= ".
05 H2-BEG-TIME PIC X(22).
05 H2-TO PIC X(4) VALUE " TO ".
05 H2-END-STAR PIC X(4) VALUE "SEQ:".
05 H2-END-SEQ PIC X(4) JUST RIGHT.
05 H2-SEP2 PIC X(2) VALUE "= ".
05 H2-END-TIME PIC X(22).
05 H2-RIGHT-STAR PIC X VALUE "*".
01 LOGFILE-H3.
*TIME (23)
05 LOGFILE-TIME PIC X(23).
*SPOT (29)
05 LOGFILE-HSPOT.
10 HSERIAL PIC X(6) VALUE "SER# ".
10 HSPOT PIC X(23).
*TALLY (4)
05 LOGFILE-HTALLY PIC X(4).
*ERROR (24)
05 LOGFILE-HERROR PIC X(24) VALUE " T CREG EREG RH STAT".
05 FILLER PIC X(52).
01 LOGFILE-H3-TAL PIC X(23) VALUE "TIME OF LAST ERROR ".
01 LOGFILE-H3-NO-TAL PIC X(23) VALUE "TIME OF ERROR ".
01 LOGFILE-H3-DSK PIC X(22) VALUE "MEDIA CYL SUR SEC ".
01 LOGFILE-H3-MAS PIC X(22) VALUE "MEDIA PGM FIL REC ".
01 LOGFILE-H3-NTALLY PIC X(4) VALUE "SEQ#".
01 LOGFILE-H3-TALLY PIC X(4) VALUE "REPT".
01 LOGFILE-H4.
05 EIGHTY-DASHES PIC X(80) VALUE ALL "-".
05 FILLER PIC X(52).
01 REC-NUM PIC 9(6) USAGE COMP SYNC RIGHT.
01 REC-COUNT PIC 9(6).
01 SEQ-COUNT PIC 9(4).
01 BEGIN-INDEX PIC 9(4).
01 REC-TABLE OCCURS 1201 TIMES.
05 B-TIME PIC X(22).
05 B-SEQ-NUM PIC X(4).
05 FILLER PIC X.
05 B-REC-NUM PIC 9(6).
05 B-ERROR PIC X.
05 B-TYPE PIC X.
01 BUFF-COUNT PIC 9(4).
01 SORT-BUFFER OCCURS 1201 TIMES.
05 BUFFER-REC PIC X(80).
05 BUFFER-MARK PIC X.
05 BUFFER-MED-ID PIC X(6).
01 MED-ID PIC X(6) JUST RIGHT.
01 TIME-DETECT.
05 SPOT-TIME PIC X(11).
05 STIME PIC X(22).
05 FILLER PIC X(47).
01 TIME-Q PIC X(11) VALUE " LOGGED ON ".
01 TWENTY-TWO-STARS PIC X(22) VALUE "**********************".
01 SEQ-DETECT.
05 FILLER PIC X.
05 SPOT-SEQ PIC X(23).
05 FILLER PIC X.
05 SSEQ PIC X(4).
05 FILLER PIC X(52).
01 SEQ-Q PIC X(23) VALUE "RECORD SEQUENCE NUMBER:".
01 VOL-ID-DETECT.
05 FILLER PIC X.
05 SPOT-VOL-ID PIC X(10).
05 FILLER PIC X.
05 SVOL-ID.
10 FILLER PIC X(1).
10 SVOL-END.
11 FILLER PIC X(4).
11 SVOL-LAST PIC X.
05 FILLER PIC X(62).
01 MED-ID-DETECT REDEFINES VOL-ID-DETECT.
05 FILLER PIC X.
05 SPOT-MED-ID PIC X(9).
05 FILLER PIC X.
05 SMED-ID.
10 FILLER PIC X(1).
10 SMED-END.
11 FILLER PIC X(4).
11 SMED-LAST PIC X.
05 FILLER PIC X(63).
01 VOL-ID-Q PIC X(10) VALUE "VOLUME ID:".
01 MED-ID-Q PIC X(9) VALUE "MEDIA ID:".
01 UNAME-DETECT.
05 FILLER PIC X.
05 SPOT-UNAME PIC X(10).
05 FILLER PIC X.
05 SUNAME PIC X(7).
05 FILLER PIC X(61).
01 UNIT-DETECT REDEFINES UNAME-DETECT.
05 FILLER PIC X.
05 SPOT-UID PIC X(8).
05 FILLER PIC X.
05 SUNIT PIC X(7).
05 FILLER PIC X(63).
01 UNIT-Q PIC X(8) VALUE "UNIT ID:".
01 UNAME-Q PIC X(10) VALUE "UNIT NAME:".
01 SERIAL-DETECT.
05 FILLER PIC X.
05 SPOT-SERIAL PIC X(14).
05 FILLER PIC X.
05 SSERIAL PIC X(5).
05 FILLER PIC X(59).
01 SERIAL-Q PIC X(14) VALUE "UNIT SERIAL #:".
01 PROGRM-DETECT.
05 FILLER PIC X.
05 SPOT-PROGRM PIC X(11).
05 FILLER PIC X.
05 SPROGRM.
10 FILLER PIC X(2).
10 SPRO-END.
11 SPRO-MID PIC X(5).
11 SPRO-LAST PIC X.
05 FILLER PIC X(59).
01 PROGRM-Q PIC X(11) VALUE "USER'S PGM:".
01 ELEVEN-STARS PIC X(11) VALUE "***********".
01 D-SPOT-DETECT.
05 FILLER PIC X.
05 SPOT-D-SPOT PIC X(4).
05 SD-SPOT PIC X(30).
05 FILLER PIC X(45).
01 T-SPOT-DETECT REDEFINES D-SPOT-DETECT.
05 FILLER PIC X(14).
05 SPOT-T-SPOT PIC X(6).
05 ST-SPOT PIC X(30).
05 FILLER PIC X(30).
01 D-SPOT-Q PIC X(4) VALUE "CYL:".
01 T-SPOT-Q PIC X(8) VALUE "RECORD".
01 ERR-DETECT.
05 FILLER PIC X.
05 SPOT-ERR PIC X(6).
05 FILLER PIC X.
05 SH-S PIC X(4).
05 FILLER PIC X(68).
01 ERR-Q PIC X(6) VALUE "ERROR:".
01 SIX-STARS PIC X(6) VALUE "******".
01 CONI-DETECT.
* 05 FILLER PIC X.
05 SPOT-CONI PIC X(14).
05 FILLER PIC X.
05 SCONI PIC X(8).
* 05 FILLER PIC X(56).
05 FILLER PIC X(57).
01 KS-CONI-DETECT REDEFINES CONI-DETECT.
* 05 FILLER PIC X.
05 SPOT-KS-CONI PIC X(23).
* 05 SKSCONI PIC X(56).
05 SKSCONI PIC X(57).
01 DX20-DETECT REDEFINES CONI-DETECT.
05 FILLER PIC X.
05 SPOT-DX20 PIC X(4).
05 FILLER PIC X(75).
01 CONI-Q PIC X(14) VALUE "CONI AT ERROR:".
01 KS-CONI-Q PIC X(23) VALUE "RH11 STATUS 2 AT ERROR:".
01 DX20-Q PIC X(4) VALUE "DX20".
01 FOURTEEN-STARS PIC X(14) VALUE "**************".
01 CREG-DETECT.
* 05 FILLER PIC X.
05 SPOT-CREG PIC X(8).
05 SCREG PIC X(6).
* 05 FILLER PIC X(65).
05 FILLER PIC X(66).
01 CREG-Q PIC X(8) VALUE "CR(00): ".
01 CREG78-Q PIC X(8) VALUE "CMD 00: ".
01 RD-WR-TEST.
05 FILLER PIC X(4).
05 RD-WR PIC X(2).
01 EIGHT-STARS PIC X(8) VALUE "********".
*ER(02): 0 0 0
*ER(02): 100000 100000 0
01 EREG-DETECT.
* 05 FILLER PIC X.
05 SPOT-EREG PIC X(8).
05 SEREG PIC X(6).
* 05 FILLER PIC X(65).
05 FILLER PIC X(66).
01 EREG-Q PIC X(8) VALUE "ER(02): ".
01 EREG78-Q PIC X(8) VALUE "DST 01: ".
01 REG-TEST.
05 REG-A PIC X.
05 REG-B PIC X.
05 REG-C PIC X.
05 REG-D PIC X.
05 REG-E PIC X.
05 REG-F PIC X.
01 LINE-COUNT PIC 99.
01 DONE PIC 9.
01 FILNAM.
05 FILENAME PIC X(6).
05 FILEXT PIC X(3).
01 SEC-ALLIGNED.
05 SEC-ALIGN PIC X(3) JUST RIGHT.
05 SEC-SPACES PIC X(2) VALUE " ".
01 CMD-IN.
05 CMD PIC X.
05 CMD2 PIC X.
05 CMD3 PIC X.
05 FILLER PIC X(3).
01 SEQ-CMD REDEFINES CMD-IN.
05 FILLER PIC X.
05 SEQ-IN PIC X(4).
05 FILLER PIC X.
01 REPTS PIC 9(4).
01 S-CMD PIC X.
01 SYSFILE PIC X(10).
01 SECPASS PIC 9.
01 REG-BUF PIC X(7).
01 SYS-DISPLAY PIC X.
01 TALLY-OMIT PIC X.
01 FILE-SELECTED PIC 9.
01 O-ERR-FLAG PIC X.
01 SEQ PIC X(4) JUST RIGHT.
01 DSEQ PIC X(4).
01 JUNK PIC X(10).
01 SEQNUM PIC X(4).
01 DSK-DONE PIC X.
01 DX20-ENTRY PIC X.
01 CHAR-BUF PIC X.
01 LISTING-OPEN PIC X VALUE "N".
01 NEW-FILE PIC X VALUE "Y".
01 ENTRY-ENDING PIC X VALUE "N".
01 L-CMD PIC X VALUE "Y".
01 LOG-OPEN PIC X VALUE "N".
01 LAST-CMD PIC X VALUE "0".
01 LAST-SEQ-COUNT PIC 9(4).
01 DUMMY-COMP PIC S9(10) VALUE 24 COMP.
01 DUMMY-ACSII REDEFINES DUMMY-COMP USAGE DISPLAY-7.
02 FILLER PIC X(4).
02 PAGE-TXT PIC X.
01 BEGIN-SEQ PIC X(4).
01 SPARE-NUM PIC 9(4).
01 MAKDEL-RPTS PIC 999.
01 DEL-CMD PIC X VALUE "N".
01 DELFIL-OPEN PIC X VALUE "N".
01 DEL-FILL.
05 DEL-SPOT PIC X(3).
05 DEL-TEN PIC X VALUE ".".
01 SAVE-CMDS PIC X(8).
01 SORT-CMDS.
05 PGM-SORT PIC X VALUE "N".
05 ERRORS-IGNOR PIC X.
05 SECT-IGNOR PIC X.
05 MED-ID-SEL PIC X.
05 SERIAL-IGNOR PIC X.
05 UNIT-IGNOR PIC X.
05 D-SEL PIC X VALUE "A".
05 D-CMD PIC X VALUE "3".
01 UNIT-ALIGN PIC X(8).
01 ERR-TOTAL-LINE.
05 TOTAL-TXT PIC X(15) VALUE "TOTAL ERRORS = ".
05 ERR-TOTAL PIC 9(4).
05 FILLER PIC X.
05 ERR-DASHES PIC X(60) VALUE ALL ".".
PROCEDURE DIVISION.
DECLARATIVES.
OPEN-LISTING-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON LISTING OPEN.
O-LISTING-FIX.
MOVE "Y" TO O-ERR-FLAG.
MOVE 1 TO L-ACTCODE.
O-LISTING-END. EXIT.
OPEN-MASHLP-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON MASHLP OPEN.
O-MASHLP-FIX.
PERFORM O-LISTING-FIX.
END DECLARATIVES.
MASSRT-HEADING.
DISPLAY " ".
DISPLAY " ".
DISPLAY "MASSRT - DISK AND TAPE ERROR SORTING PROGRM".
DISPLAY " ".
GO TO INITIALIZER.
COMMAND-HELP.
DISPLAY " ".
DISPLAY " ".
DISPLAY "COMMANDS ARE:".
DISPLAY "G - GO SORT ERRORS".
DISPLAY "S - CHANGE SORT PARAMETERS".
DISPLAY "D - CHANGE DISPLAY SELECTION".
DISPLAY "L - SILENCE/REVIVE/DELETE LOG".
DISPLAY "F - SELECT NEW SYSERR LISTING".
DISPLAY "B - BEGIN AT SPECIFIED SEQUENCE".
DISPLAY "R - READ SYSERR LISTING ENTRY".
DISPLAY "Q - CLOSE LOG AND RETURN TO MONITOR".
DISPLAY "H - TYPE DETAILED HELP FILE".
INITIALIZER.
MOVE 0 TO DONE.
MOVE 0 TO REPTS.
MOVE 0 TO CMD.
MOVE "N" TO DSK-DONE.
MOVE 0 TO SEQ-COUNT.
MOVE 0 TO BUFF-COUNT.
GET-COMMAND.
DISPLAY " ".
DISPLAY "COMMAND (G,S,D,L,F,B,R,Q,H) ? " WITH NO ADVANCING.
ACCEPT CMD-IN.
IF CMD-IN = "MAKDEL"
GO TO MAKDEL-COMMAND.
IF CMD = "G"
GO TO GET-FILENAME.
IF CMD = "S"
GO TO CHANGE-SORT.
IF CMD = "D"
PERFORM DISPLAY-SELLECT THRU DISPLAY-EXIT
GO TO INITIALIZER.
IF CMD = "B"
GO TO BEGIN-COMMAND.
IF CMD = "R"
GO TO READ-COMMAND.
IF CMD = "F"
PERFORM GET-FILENAME
GO TO INITIALIZER.
IF CMD = "L"
GO TO LOG-COMMAND.
IF CMD = "Q"
GO TO QUIT-COMMAND.
IF CMD = "H"
GO TO GET-HELP.
GO TO COMMAND-HELP.
QUIT-COMMAND.
IF LOG-OPEN = "Y" CLOSE LOGFILE.
* IF DELFIL-OPEN = "Y" CLOSE DELFIL.
STOP RUN.
GET-HELP.
MOVE "N" TO O-ERR-FLAG.
OPEN INPUT MASHLP.
IF O-ERR-FLAG = "Y"
DISPLAY "CAN'T FIND HELP FILE"
MOVE "N" TO O-ERR-FLAG
GO TO COMMAND-HELP.
PERFORM READ-HELP UNTIL DONE = 1.
CLOSE MASHLP.
GO TO COMMAND-HELP.
READ-HELP.
READ MASHLP AT END MOVE 1 TO DONE.
DISPLAY MASHLP-REC.
LOG-COMMAND.
IF CMD2 = ( "Y" OR "N" )
MOVE CMD2 TO L-CMD
GO TO LOG-COMMAND-END.
IF CMD2 = "D" GO TO LOG-DELETE.
DISPLAY " ".
DISPLAY "Y - OUTPUT TO LOG".
DISPLAY "N - STOP OUTPUT".
DISPLAY "D - DELETE LOG".
DISPLAY " ".
DISPLAY "COMMAND (Y,N,D) " WITH NO ADVANCING.
ACCEPT CMD2.
GO TO LOG-COMMAND.
LOG-DELETE.
IF LOG-OPEN = "Y" CLOSE LOGFILE WITH DELETE
OPEN OUTPUT LOGFILE.
LOG-COMMAND-END.
DISPLAY "O.K."
GO TO INITIALIZER.
CHANGE-SORT.
DISPLAY "SORT BY CYL/PROGRAM........... (Y,N,E) ? " WITH NO ADVANCING.
ACCEPT S-CMD.
IF S-CMD = "E" MOVE S-CMD TO CMD
GO TO INITIALIZER.
IF S-CMD NOT = ("Y" AND "N") GO TO CHANGE-SORT
ELSE MOVE S-CMD TO PGM-SORT.
SPOTS-ONLY.
DISPLAY "EXAMINE SPOTS ONLY............ (Y,N,E) ? " WITH NO ADVANCING.
ACCEPT S-CMD.
IF S-CMD = "E" MOVE S-CMD TO CMD
GO TO INITIALIZER.
IF S-CMD NOT = ("Y" AND "N") GO TO SPOTS-ONLY
ELSE MOVE S-CMD TO ERRORS-IGNOR.
IGNOR-SECT.
DISPLAY "IGNORE SECTORS ON DISK ENTRIES (Y,N,E) ? " WITH NO ADVANCING.
ACCEPT S-CMD.
IF S-CMD = "E" MOVE S-CMD TO CMD
GO TO INITIALIZER.
IF S-CMD NOT = ("Y" AND "N") GO TO IGNOR-SECT
ELSE MOVE S-CMD TO SECT-IGNOR.
IDENT-MEDIUM.
DISPLAY "USE MEDIA ID (IF AVAILABLE)... (Y,N,E) ? " WITH NO ADVANCING.
ACCEPT S-CMD.
IF S-CMD = "E" MOVE S-CMD TO CMD
GO TO INITIALIZER.
IF S-CMD NOT = ("Y" AND "N") GO TO IDENT-MEDIUM
ELSE MOVE S-CMD TO MED-ID-SEL.
IGNOR-SERIAL.
DISPLAY "IGNORE SERIAL NUMBER.......... (Y,N,E) ? " WITH NO ADVANCING.
ACCEPT S-CMD.
IF S-CMD = "E" MOVE S-CMD TO CMD
GO TO INITIALIZER.
IF S-CMD NOT = ("Y" AND "N") GO TO IGNOR-SERIAL
ELSE MOVE S-CMD TO SERIAL-IGNOR.
IGNOR-UNIT.
DISPLAY "IGNORE LOGICAL DEVICE/MEDIA-ID (Y,N,E) ? " WITH NO ADVANCING.
ACCEPT S-CMD.
IF S-CMD = "E" MOVE S-CMD TO CMD
GO TO INITIALIZER.
IF S-CMD NOT = ("Y" AND "N") GO TO IGNOR-UNIT
ELSE MOVE S-CMD TO UNIT-IGNOR.
GO TO INITIALIZER.
MAKDEL-COMMAND.
DISPLAY " ".
DISPLAY "MAKE DELETE SEQUENCE FOR DDRPI ? (Y,N) " WITH NO ADVANCING.
ACCEPT DEL-CMD.
IF DEL-CMD NOT = ("Y" AND "N")
GO TO MAKDEL-COMMAND.
IF DEL-CMD = "N"
MOVE "YY" TO SORT-CHAN
MOVE SAVE-CMDS TO SORT-CMDS
GO TO INITIALIZER.
DISPLAY "WHERE A = RH #".
DISPLAY "AND B = DRIVE #".
DISPLAY "TYPE AB (OR XX FOR ALL) " WITH NO ADVANCING.
ACCEPT DEL-CHAN.
MOVE DEL-CHAN TO SORT-CHAN.
DISPLAY "FOR HOW MANY REPEATS ? " WITH NO ADVANCING.
ACCEPT MAKDEL-RPTS.
OPEN OUTPUT DELFIL.
MOVE "Y" TO DELFIL-OPEN.
MOVE SORT-CMDS TO SAVE-CMDS.
MOVE "N" TO PGM-SORT.
MOVE "Y" TO ERRORS-IGNOR.
MOVE "Y" TO SECT-IGNOR.
MOVE "N" TO MED-ID-SEL.
MOVE "N" TO UNIT-IGNOR.
MOVE "3" TO D-CMD.
MOVE "D" TO D-SEL.
GO TO INITIALIZER.
REPEAT-CHECK.
IF REPTS LESS THAN MAKDEL-RPTS
GO TO REPEAT-EXIT.
MOVE DSK-CHAN TO DELETE-2-REC.
INSPECT DELETE-2-REC REPLACING ALL "A" BY "0".
INSPECT DELETE-2-REC REPLACING ALL "B" BY "1".
INSPECT DELETE-2-REC REPLACING ALL "C" BY "2".
INSPECT DELETE-2-REC REPLACING ALL "D" BY "3".
INSPECT DELETE-2-REC REPLACING ALL "E" BY "4".
INSPECT DELETE-2-REC REPLACING ALL "F" BY "5".
IF DELETE-2-REC NOT = DEL-CHAN AND DEL-CHAN NOT = "XX"
GO TO REPEAT-EXIT.
MOVE "X" TO DEL-MARK.
WRITE DELETE-2-REC BEFORE ADVANCING 1 LINE .
MOVE DEL-CYL TO DEL-SPOT.
INSPECT DEL-FILL REPLACING ALL " " BY "0".
MOVE DEL-FILL TO DELETE-4-REC.
WRITE DELETE-4-REC BEFORE ADVANCING 1 LINE .
MOVE DEL-SUR TO DEL-SPOT.
INSPECT DEL-FILL REPLACING ALL " " BY "0".
MOVE DEL-FILL TO DELETE-4-REC.
WRITE DELETE-4-REC BEFORE ADVANCING 1 LINE .
REPEAT-EXIT.
MOVE 0 TO JUNK.
DISPLAY-SELLECT.
IF CMD2 = ("D" OR "T" OR "A") MOVE CMD2 TO D-SEL
MOVE "Z" TO CMD
GO TO DISPLAY-TYPE.
IF CMD2 NOT = " " DISPLAY "WHAT ?" GO TO COMMAND-HELP.
DISPLAY " ".
DISPLAY "PROCESS DISK OR TAPE ENTRIES OR ALL ?".
DISPLAY "(D OR T OR A) ? " WITH NO ADVANCING.
ACCEPT D-SEL.
IF D-SEL NOT = "D" AND "T" AND "A"
GO TO DISPLAY-SELLECT.
DISPLAY-TYPE.
IF CMD3 = ("1" OR "2" OR "3") MOVE CMD3 TO D-CMD
GO TO DISPLAY-EXIT.
IF CMD = "Z" AND CMD3 = " " GO TO DISPLAY-EXIT.
DISPLAY " ".
DISPLAY "DISPLAY ENTRIES...".
DISPLAY "1 - IN CHRONOLOGICAL ORDER".
DISPLAY "2 - SORTED BY SPOTS".
DISPLAY "3 - SORTED BY SPOTS AND TALLIED.".
DISPLAY "DISPLAY SELECTION 1, 2, OR 3 ? " WITH NO ADVANCING.
ACCEPT D-CMD.
IF D-CMD NOT = "1" AND D-CMD NOT = "2" AND D-CMD NOT = "3"
GO TO DISPLAY-TYPE.
DISPLAY-EXIT.
DISPLAY "O.K."
BEGIN-COMMAND.
IF NEW-FILE = "Y"
DISPLAY "CAN'T USE BEGIN UNTIL G COMMAND EXECUTED ON LISTING"
GO TO INITIALIZER.
IF CMD2 = "N "
MOVE SPACES TO BEGIN-SEQ
GO TO BEGIN-COMMAND-EXIT.
IF CMD2 NUMERIC GO TO BEGIN-CHECK.
GET-BEGIN-SEQ.
DISPLAY " ".
DISPLAY "BEGIN COMMAND (N,SEQ#) " WITH NO ADVANCING.
ACCEPT SEQ-IN.
GO TO BEGIN-COMMAND.
BEGIN-CHECK.
MOVE 1 TO SPARE-NUM.
PERFORM INC-SPARE-NUM UNTIL B-SEQ-NUM (SPARE-NUM) = SEQ-IN OR
B-SEQ-NUM (SPARE-NUM) = "NONE" OR
SEQ-COUNT GREATER THAN 1200.
IF B-SEQ-NUM (SPARE-NUM) = "NONE" OR
SEQ-COUNT GREATER THAN 1200
DISPLAY "CAN'T FIND SEQUENCE [" SEQ-IN "]"
GO TO INITIALIZER.
IF B-SEQ-NUM (SPARE-NUM) = SEQ-IN
MOVE SPARE-NUM TO BEGIN-INDEX
UNSTRING SEQ-IN DELIMITED BY ALL " " INTO SEQ JUNK
MOVE SEQ TO BEGIN-SEQ
MOVE SEQ TO H2-BEG-SEQ
MOVE B-TIME (SPARE-NUM) TO H2-BEG-TIME.
BEGIN-COMMAND-EXIT.
DISPLAY "O.K.".
GO TO INITIALIZER.
INC-SPARE-NUM.
ADD 1 TO SPARE-NUM.
LISTING-INI.
IF LISTING-OPEN = "Y" CLOSE LISTING MOVE "N" TO LISTING-OPEN.
MOVE "N" TO O-ERR-FLAG.
OPEN INPUT LISTING.
MOVE 0 TO REC-NUM.
IF O-ERR-FLAG NOT = "Y" MOVE "Y" TO LISTING-OPEN
ELSE DISPLAY "ERROR INITIALIZING " D-FILNAM.
LISTING-INI-EXIT. EXIT.
GET-FILENAME.
IF FILE-SELECTED = 1 AND CMD NOT = "F"
PERFORM LISTING-INI THRU LISTING-INI-EXIT
GO TO GO-COMMAND.
IF LISTING-OPEN = "Y" CLOSE LISTING.
DISPLAY " ".
DISPLAY "TYPE FILENAME OF SYSERR LISTING " WITH NO ADVANCING.
ACCEPT SYSFILE.
MOVE SYSFILE TO D-FILNAM.
UNSTRING SYSFILE DELIMITED BY "." INTO FILENAME FILEXT.
MOVE "N" TO O-ERR-FLAG.
OPEN INPUT LISTING.
IF O-ERR-FLAG = "Y"
DISPLAY "CAN'T FIND FILE [" SYSFILE "]"
GO TO GET-FILENAME.
MOVE "Y" TO LISTING-OPEN.
MOVE "Y" TO NEW-FILE.
MOVE SPACES TO BEGIN-SEQ.
MOVE 1 TO FILE-SELECTED.
PERFORM ZERO-BUFFER THRU ZERO-BUFFER-END.
MOVE 0 TO REC-NUM.
MOVE 0 TO SEQ-COUNT.
MOVE 0 TO BUFF-COUNT.
IF CMD = "G" GO TO GO-COMMAND.
ZERO-BUFFER.
MOVE 1 TO SEQ-COUNT.
MOVE 1 TO BUFF-COUNT.
ZERO-BUFFER-LOOP.
MOVE "NONE" TO B-SEQ-NUM (SEQ-COUNT).
MOVE "000000" TO B-REC-NUM (SEQ-COUNT).
MOVE " " TO B-ERROR (SEQ-COUNT).
MOVE " " TO B-TYPE (SEQ-COUNT).
MOVE "E" TO BUFFER-MARK (BUFF-COUNT).
ADD 1 TO SEQ-COUNT.
ADD 1 TO BUFF-COUNT.
IF SEQ-COUNT LESS THAN 1201 GO TO ZERO-BUFFER-LOOP.
ZERO-BUFFER-END.
MOVE 0 TO REC-COUNT.
GO-COMMAND.
IF D-CMD = "1" SORT MASWRK
ASCENDING KEY ENTRY-TYPE,
ASCENDING KEY DEVICE,
ASCENDING KEY SERIAL-NUMBER,
ASCENDING KEY TAL
INPUT PROCEDURE TECO-ROUTINE
GIVING MASSOR
GO TO GO-COMMAND-END.
IF PGM-SORT NOT = "Y"
SORT MASWRK
ASCENDING KEY ENTRY-TYPE,
ASCENDING KEY DEVICE,
ASCENDING KEY SERIAL-NUMBER,
ASCENDING KEY SUR-FIL,
ASCENDING KEY CYL-PGM,
ASCENDING KEY SEC-REC,
ASCENDING KEY CREG,
ASCENDING KEY H-S,
ASCENDING KEY EREG,
ASCENDING KEY CONI-RH,
ASCENDING KEY TAL
INPUT PROCEDURE TECO-ROUTINE
GIVING MASSOR.
IF PGM-SORT = "Y"
SORT MASWRK
ASCENDING KEY ENTRY-TYPE,
ASCENDING KEY DEVICE,
ASCENDING KEY SERIAL-NUMBER,
ASCENDING KEY CYL-PGM,
ASCENDING KEY SUR-FIL,
ASCENDING KEY SEC-REC,
ASCENDING KEY CREG,
ASCENDING KEY H-S,
ASCENDING KEY EREG,
ASCENDING KEY CONI-RH,
ASCENDING KEY TAL
INPUT PROCEDURE TECO-ROUTINE
GIVING MASSOR.
GO-COMMAND-END.
IF LOG-OPEN NOT = "Y" AND DEL-CMD NOT = "Y"
OPEN OUTPUT LOGFILE MOVE "Y" TO LOG-OPEN.
GO TO LOGFILE-INI.
LOGFILE-INI.
MOVE LOGFILE-LF TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
MOVE LOGFILE-H1 TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
IF BEGIN-SEQ = SPACES
MOVE 1 TO SPARE-NUM
MOVE B-SEQ-NUM (SPARE-NUM) TO UNIT-ALIGN
INSPECT UNIT-ALIGN REPLACING FIRST " " BY "."
UNSTRING UNIT-ALIGN DELIMITED BY ALL "."
INTO H2-BEG-SEQ
MOVE B-TIME (SPARE-NUM) TO H2-BEG-TIME.
MOVE LOGFILE-H2 TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
LOGFILE-INI-CONT.
MOVE LOGFILE-H1 TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
IF D-SEL = "D" OR D-SEL = "A" AND DSK-DONE NOT = "Y"
MOVE LOGFILE-H3-DSK TO HSPOT.
IF D-SEL = "T" OR D-SEL = "A" AND DSK-DONE = "Y"
MOVE LOGFILE-H3-MAS TO HSPOT.
IF D-CMD = "1" OR D-CMD = "2"
MOVE LOGFILE-H3-NO-TAL TO LOGFILE-TIME
MOVE LOGFILE-H3-NTALLY TO LOGFILE-HTALLY
ELSE MOVE LOGFILE-H3-TAL TO LOGFILE-TIME
MOVE LOGFILE-H3-TALLY TO LOGFILE-HTALLY.
MOVE LOGFILE-H3 TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
MOVE LOGFILE-H4 TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
LOGFILE-INI-DONE. EXIT.
TALLYER.
OPEN INPUT MASSOR.
MOVE 0 TO DONE.
MOVE 1 TO SECPASS.
MOVE 0 TO REPTS.
MOVE 0 TO ERR-TOTAL.
READ MASSOR AT END MOVE 1 TO DONE.
IF DONE = 1
PERFORM OUT-TOTAL
GO TO TALLY-END.
MOVE SORTRECORD TO LOGFILE-IN-RECORD.
IF D-SEL = "A" AND TALIN-TYPE = "T"
PERFORM OUT-TOTAL
MOVE "Y" TO DSK-DONE
PERFORM LOGFILE-INI THRU LOGFILE-INI-DONE
MOVE LOGFILE-IN-RECORD TO LOGFILE-REC
ELSE
MOVE SORTRECORD TO LOGFILE-REC.
MOVE 1 TO ERR-TOTAL.
PERFORM TALLY-LOOP THRU TALLY-LOOP-EXIT UNTIL DONE = 1.
TALLY-END.
CLOSE MASSOR WITH DELETE.
IF D-SEL = "A" AND DSK-DONE NOT = "Y"
MOVE LOGFILE-LF TO LOGFILE-REC
PERFORM OUT-LINE THRU OUT-LINE-EXIT
MOVE "Y" TO DSK-DONE
PERFORM LOGFILE-INI-CONT THRU LOGFILE-INI-DONE
MOVE 0 TO ERR-TOTAL
PERFORM OUT-TOTAL.
IF DELFIL-OPEN = "Y"
CLOSE DELFIL
MOVE "N" TO DELFIL-OPEN.
MOVE "N" TO DEL-CMD
MOVE "YY" TO SORT-CHAN.
GO TO INITIALIZER.
TALLY-LOOP.
READ MASSOR AT END MOVE 1 TO DONE.
IF DONE = 1 GO TO TALLY-OUT.
MOVE SORTRECORD TO LOGFILE-IN-RECORD.
IF TALIN-DEVICE = TALOUT-DEVICE
AND TALIN-SERIAL = TALOUT-SERIAL
ADD 1 TO ERR-TOTAL.
IF D-CMD NOT = "3"
GO TO TALLY-OUT.
IF TALIN-SPOT = TALOUT-SPOT AND TALIN-ERROR = TALOUT-ERROR
ADD 1 TO REPTS
MOVE TALIN-TIME TO TALOUT-TIME
GO TO TALLY-LOOP-EXIT.
TALLY-OUT.
IF DEL-CMD = "Y" PERFORM REPEAT-CHECK THRU REPEAT-EXIT.
PERFORM LOG-ENTRY THRU LOG-ENTRY-EXIT.
TALLY-LOOP-EXIT. EXIT.
LOG-ENTRY.
IF D-CMD NOT = "3" GO TO LOG-ENTRY-BEG.
MOVE REPTS TO TALOUT-TALLY.
INSPECT TALOUT-TALLY REPLACING LEADING "0" BY " ".
IF TALOUT-TALLY = SPACES MOVE "NONE" TO TALOUT-TALLY.
LOG-ENTRY-BEG.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
IF TALIN-DEVICE NOT = TALOUT-DEVICE
OR TALIN-SERIAL NOT = TALOUT-SERIAL
PERFORM OUT-TOTAL
MOVE SPACES TO LOGFILE-REC
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
IF TALIN-TYPE = "T" AND TALOUT-TYPE = "D"
MOVE LOGFILE-LF TO LOGFILE-REC
PERFORM OUT-LINE THRU OUT-LINE-EXIT
MOVE "Y" TO DSK-DONE
PERFORM LOGFILE-INI-CONT THRU LOGFILE-INI-DONE
GO TO LOG-ENTRY-CONT.
IF DONE = 1
PERFORM OUT-TOTAL.
LOG-ENTRY-CONT.
MOVE LOGFILE-IN-RECORD TO LOGFILE-REC.
MOVE 0 TO REPTS.
LOG-ENTRY-EXIT. EXIT.
OUT-TOTAL.
MOVE ERR-TOTAL-LINE TO LOGFILE-REC.
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
MOVE 1 TO ERR-TOTAL.
READ-IN.
READ LISTING AT END MOVE 1 TO DONE.
ADD 1 TO REC-NUM.
READ-COMMAND.
IF NEW-FILE NOT = "N"
DISPLAY "CAN'T READ UNTIL G COMMAND HAS BEEN ISSUED FOR LISTING."
GO TO INITIALIZER.
MOVE 1 TO SEQ-COUNT.
IF CMD2 = "?" GO TO READ-ERRORS.
IF CMD2 = "N" GO TO READ-NEXT.
IF CMD2 NUMERIC
MOVE SEQ-IN TO SEQNUM
GO TO SEARCH-SEQ.
GET-SEQNUM.
DISPLAY "READ COMMAND (?,N,SEQUENCE NUMBER) " WITH NO ADVANCING.
ACCEPT SEQ-IN.
GO TO READ-COMMAND.
READ-NEXT.
MOVE LAST-SEQ-COUNT TO SEQ-COUNT.
ADD 1 TO SEQ-COUNT.
IF SEQ-COUNT GREATER THAN 1200
DISPLAY "CAN'T FIND NEXT SEQUENCE"
GO TO INITIALIZER.
IF B-SEQ-NUM (SEQ-COUNT) = "NONE"
DISPLAY "CAN'T FIND NEXT SEQUENCE"
GO TO INITIALIZER.
PERFORM READ-ENTRY THRU SEARCH-SEQ-EXIT.
GO TO INITIALIZER.
READ-ERRORS.
IF BEGIN-SEQ NOT = SPACES MOVE BEGIN-INDEX TO SEQ-COUNT.
READ-ERRORS-LOOP.
PERFORM INC-SEQ-COUNT UNTIL
( B-ERROR (SEQ-COUNT) = "?" AND D-SEL = "A" ) OR
( B-ERROR (SEQ-COUNT) = "?" AND D-SEL = B-TYPE (SEQ-COUNT) ) OR
B-SEQ-NUM (SEQ-COUNT) = "NONE" OR
SEQ-COUNT GREATER THAN 1200.
IF SEQ-COUNT GREATER THAN 1200 OR
B-SEQ-NUM (SEQ-COUNT) = "NONE"
GO TO INITIALIZER
ELSE PERFORM READ-ENTRY
ADD 1 TO SEQ-COUNT
GO TO READ-ERRORS-LOOP.
SEARCH-SEQ.
PERFORM INC-SEQ-COUNT UNTIL
SEQ-COUNT GREATER THAN 1200 OR
B-SEQ-NUM (SEQ-COUNT) = SEQNUM.
IF B-SEQ-NUM (SEQ-COUNT) = SEQNUM PERFORM READ-ENTRY THRU SEARCH-SEQ-EXIT
ELSE DISPLAY "CAN'T FIND SEQUENCE NUMBER [" SEQNUM "]".
GO TO INITIALIZER.
READ-ENTRY.
MOVE PAGE-TXT TO PAGE-REC WRITE PAGE-REC BEFORE ADVANCING 1 LINE .
MOVE SEQ-COUNT TO LAST-SEQ-COUNT.
IF B-REC-NUM (SEQ-COUNT) NOT LESS THAN REC-NUM
SUBTRACT REC-NUM FROM B-REC-NUM (SEQ-COUNT) GIVING REC-COUNT
ELSE PERFORM LISTING-INI THRU LISTING-INI-EXIT
MOVE B-REC-NUM (SEQ-COUNT) TO REC-COUNT.
IF REC-COUNT LESS THAN 2 AND ENTRY-Q = ALL "*"
MOVE INRECORD TO LOGFILE-REC
PERFORM OUT-LINE THRU OUT-LINE-EXIT.
PERFORM SEARCH-ENTRY UNTIL DONE = 1 OR REC-COUNT LESS THAN 2.
IF REC-COUNT LESS THAN 2
MOVE "N" TO ENTRY-ENDING
PERFORM READ-LINE THRU READ-LINE-DONE 8 TIMES
MOVE "Y" TO ENTRY-ENDING.
PERFORM READ-LINE THRU READ-LINE-DONE UNTIL DONE = 1 OR ENTRY-Q = ALL "*".
SEARCH-SEQ-EXIT. EXIT.
INC-SEQ-COUNT.
ADD 1 TO SEQ-COUNT.
SEARCH-ENTRY.
PERFORM READ-IN.
SUBTRACT 1 FROM REC-COUNT.
READ-LINE.
PERFORM READ-IN.
MOVE INRECORD TO LOGFILE-REC.
IF ENTRY-ENDING = "Y" AND ENTRY-Q = ALL "*"
GO TO READ-LINE-DONE
ELSE PERFORM OUT-LINE THRU OUT-LINE-EXIT.
READ-LINE-DONE.
MOVE 0 TO JUNK.
OUT-LINE.
IF CMD NOT = "G" GO TO OUT-LINE-40.
IF TALOUT-TYPE = "D" OR TALOUT-TYPE = "T"
MOVE TALOUT-TYPE TO CHAR-BUF
MOVE " " TO TALOUT-TYPE.
IF DEL-CMD = "Y"
DISPLAY LOGFILE-SH80-REC
GO TO OUT-LINE-EXIT.
OUT-LINE-40.
IF EX-40 NOT = SPACES GO TO OUT-LINE-60.
IF L-CMD = "Y" WRITE LOGFILE-SH40-REC BEFORE ADVANCING 1 LINE .
DISPLAY LOGFILE-SH40-REC.
GO TO OUT-LINE-END.
OUT-LINE-60.
IF EX-60 NOT = SPACES GO TO OUT-LINE-80.
IF L-CMD = "Y" WRITE LOGFILE-SH60-REC BEFORE ADVANCING 1 LINE .
DISPLAY LOGFILE-SH60-REC.
GO TO OUT-LINE-END.
OUT-LINE-80.
IF EX-80 NOT = SPACES GO TO OUT-LINE-100.
IF L-CMD = "Y" WRITE LOGFILE-SH80-REC BEFORE ADVANCING 1 LINE .
DISPLAY LOGFILE-SH80-REC.
GO TO OUT-LINE-END.
OUT-LINE-100.
IF EX-100 NOT = SPACES GO TO OUT-LINE-120.
IF L-CMD = "Y" WRITE LOGFILE-SH100-REC BEFORE ADVANCING 1 LINE .
DISPLAY LOGFILE-SH100-REC.
GO TO OUT-LINE-END.
OUT-LINE-120.
IF EX-120 NOT = SPACES GO TO OUT-LINE-132.
IF L-CMD = "Y" WRITE LOGFILE-SH120-REC BEFORE ADVANCING 1 LINE .
DISPLAY LOGFILE-SH120-REC.
GO TO OUT-LINE-END.
OUT-LINE-132.
IF L-CMD = "Y" WRITE LOGFILE-REC BEFORE ADVANCING 1 LINE .
DISPLAY LOGFILE-REC.
OUT-LINE-END.
IF CMD = "G" MOVE CHAR-BUF TO TALOUT-TYPE.
OUT-LINE-EXIT. EXIT.
TECO-ROUTINE SECTION.
TECO-LOOP.
MOVE SPACES TO SORT-REC.
MOVE SPACES TO MED-ID.
MOVE 0 TO DONE.
IF NEW-FILE = "N" GO TO BUFFER-LOOP.
MOVE 0 TO DX20-ENTRY.
MOVE 0 TO LINE-COUNT.
T-TIME.
PERFORM FIND-TIME UNTIL DONE = 1 OR SPOT-TIME = TIME-Q.
IF SPOT-TIME = TIME-Q
MOVE STIME TO LAST-TIME
MOVE LAST-TIME TO H2-END-TIME.
MOVE ZEROS TO SPOT-TIME.
IF DONE = 1 GO TO S-FINAL.
GO TO T-SEQ.
FIND-TIME.
PERFORM READ-IN.
MOVE IN-LINE TO TIME-DETECT.
T-SEQ.
PERFORM FIND-SEQ VARYING LINE-COUNT FROM 0 BY 1 UNTIL
LINE-COUNT = 4 OR
SPOT-SEQ = "RECORD SEQUENCE NUMBER:" OR
DONE = 1.
IF SPOT-SEQ = "RECORD SEQUENCE NUMBER:"
MOVE SEQ TO TAL
MOVE TAL TO H2-END-SEQ
ADD 1 TO SEQ-COUNT
SUBTRACT 4 FROM REC-NUM GIVING B-REC-NUM (SEQ-COUNT)
MOVE LAST-TIME TO B-TIME (SEQ-COUNT)
MOVE DSEQ TO B-SEQ-NUM (SEQ-COUNT).
IF SEQ-COUNT GREATER THAN 1200
DISPLAY "BUFFER OVERFLOW AT SEQUENCE " TAL " - TOO MANY ENTRIES"
SUBTRACT 1 FROM SEQ-COUNT
GO TO S-FINAL.
MOVE SPACES TO SPOT-SEQ.
IF DONE = 1 GO TO S-FINAL.
IF LINE-COUNT = 4 DISPLAY "ERROR FINDING SEQUENCE NUMBER AT " LAST-TIME
GO TO TECO-LOOP.
GO TO T-UNIT.
FIND-SEQ.
PERFORM READ-IN.
MOVE IN-LINE TO SEQ-DETECT.
UNSTRING SSEQ DELIMITED BY ALL "." INTO SEQ JUNK.
UNSTRING SSEQ DELIMITED BY ALL "." INTO DSEQ JUNK.
T-UNIT.
PERFORM FIND-UNIT VARYING LINE-COUNT FROM 0 BY 1 UNTIL
LINE-COUNT = 3 OR
SPOT-UID = UNIT-Q OR
SPOT-UNAME = "VOLUME ID:" OR
SPOT-UNAME = UNAME-Q OR
DONE = 1.
IF SPOT-UID = UNIT-Q
MOVE SUNIT TO UNIT-ALIGN.
IF SPOT-UNAME = "VOLUME ID:"
MOVE SUNAME TO UNIT-ALIGN.
VOL.
IF SPOT-UNAME = UNAME-Q
MOVE SUNAME TO UNIT-ALIGN.
INSPECT UNIT-ALIGN REPLACING FIRST " " BY ".".
VOL1.
UNSTRING UNIT-ALIGN DELIMITED BY ALL "." INTO DEVICE JUNK.
VOL2.
* MOVE SUNAME TO DEVICE.
MOVE ZEROS TO SPOT-UID.
MOVE ZEROS TO SPOT-UNAME.
IF DONE = 1 GO TO S-FINAL.
IF LINE-COUNT = 3 GO TO TECO-LOOP.
*LINE COUNT = 3 ASSUME NOT A DISK OR TAPE ENTRY.
GO TO T-SERIAL.
FIND-UNIT.
PERFORM READ-IN.
MOVE IN-LINE TO UNAME-DETECT.
T-SERIAL.
PERFORM FIND-SERIAL VARYING LINE-COUNT FROM 0 BY 1 UNTIL
LINE-COUNT = 4 OR
SPOT-SERIAL = SERIAL-Q OR
DONE = 1.
IF SPOT-SERIAL = SERIAL-Q MOVE SSERIAL TO SERIAL-NUMBER
MOVE SPACES TO SERIAL-DETECT
GO TO T-MED-ID.
IF LINE-COUNT = 4
* MOVE "????" TO SERIAL-NUMBER
* MOVE IN-LINE TO D-SPOT-DETECT
* GO TO T-B-SPOT.
GO TO TECO-LOOP.
IF DONE = 1 GO TO S-FINAL.
GO TO T-MED-ID.
FIND-SERIAL.
PERFORM READ-IN.
MOVE IN-LINE TO SERIAL-DETECT.
T-MED-ID.
PERFORM FIND-MED-ID VARYING LINE-COUNT FROM 0 BY 1 UNTIL
LINE-COUNT = 3 OR
DONE = 1 OR
SPOT-VOL-ID = VOL-ID-Q OR
SPOT-MED-ID = MED-ID-Q.
IF DONE = 1 GO TO S-FINAL.
IF LINE-COUNT = 3
MOVE SPACES TO MED-ID
MOVE IN-LINE TO D-SPOT-DETECT
GO TO T-B-SPOT.
IF SPOT-VOL-ID = VOL-ID-Q
MOVE SVOL-ID TO UNIT-ALIGN
GO TO T-MED-ALIGN.
IF SPOT-MED-ID = MED-ID-Q
MOVE SMED-ID TO UNIT-ALIGN
GO TO T-MED-ALIGN.
IF SMED-ID = SPACES
GO TO T-MED-END.
T-MED-ALIGN.
INSPECT UNIT-ALIGN REPLACING FIRST " " BY ".".
UNSTRING UNIT-ALIGN DELIMITED BY ALL "." INTO MED-ID JUNK.
T-MED-END.
MOVE SPACES TO SPOT-MED-ID.
GO TO T-B-SPOT.
FIND-MED-ID.
PERFORM READ-IN.
MOVE IN-LINE TO MED-ID-DETECT.
T-B-SPOT.
PERFORM FIND-SPOT VARYING LINE-COUNT FROM 0 BY 1 UNTIL
LINE-COUNT = 8 OR
SPOT-T-SPOT = TWENTY-TWO-STARS OR
DONE = 1 OR
SPOT-D-SPOT = D-SPOT-Q OR
SPOT-T-SPOT = T-SPOT-Q.
IF SPOT-T-SPOT = T-SPOT-Q GO TO T-SPOT-T.
IF SPOT-D-SPOT = D-SPOT-Q GO TO T-SPOT-D.
IF DONE = 1 GO TO S-FINAL.
IF LINE-COUNT = 8 OR SPOT-T-SPOT = TWENTY-TWO-STARS
PERFORM SORT-RELEASE THRU SORT-RELEASE-END
MOVE SPACES TO SPOT-T-SPOT
GO TO TECO-LOOP.
T-SPOT-D.
MOVE "D" TO ENTRY-TYPE.
INSPECT SD-SPOT REPLACING ALL ":" BY " ".
UNSTRING SD-SPOT DELIMITED BY ALL "." INTO
CYL-PGM SUR-FIL SEC-ALIGN.
MOVE SEC-ALLIGNED TO SEC-REC.
MOVE SPACES TO SPOT-D-SPOT.
GO TO T-SPOT-END.
T-SPOT-T.
MOVE "T" TO ENTRY-TYPE.
INSPECT ST-SPOT REPLACING ALL "#" BY " ".
INSPECT ST-SPOT REPLACING ALL ":" BY " ".
UNSTRING ST-SPOT DELIMITED BY ALL "." INTO SEC-REC SUR-FIL.
MOVE SPACES TO SPOT-T-SPOT.
GO TO T-SPOT-END.
T-SPOT-END.
IF ENTRY-TYPE = "D" GO TO T-ERROR.
GO TO T-PROGRM.
FIND-SPOT.
PERFORM READ-IN.
MOVE IN-LINE TO D-SPOT-DETECT.
T-PROGRM.
PERFORM FIND-PROGRM VARYING LINE-COUNT FROM 0 BY 1 UNTIL LINE-COUNT = 4
OR SPOT-PROGRM = ELEVEN-STARS OR
DONE = 1 OR
SPOT-PROGRM = PROGRM-Q.
IF DONE = 1 GO TO S-FINAL.
IF SPOT-PROGRM NOT = PROGRM-Q GO TO T-PROGRM-DONE.
IF SPRO-LAST = " "
INSPECT SPRO-END REPLACING FIRST " " BY "."
UNSTRING SPROGRM DELIMITED BY ALL "." INTO CYL-PGM JUNK
ELSE MOVE SPRO-END TO CYL-PGM.
T-PROGRM-DONE.
IF SPOT-PROGRM = ELEVEN-STARS
PERFORM SORT-RELEASE THRU SORT-RELEASE-END
MOVE SPACES TO SPOT-PROGRM
GO TO TECO-LOOP.
MOVE SPACES TO SPOT-PROGRM.
GO TO T-ERROR.
FIND-PROGRM.
PERFORM READ-IN.
MOVE IN-LINE TO PROGRM-DETECT.
T-ERROR.
PERFORM FIND-ERROR UNTIL SPOT-ERR = SIX-STARS OR
DONE = 1 OR
SPOT-ERR = ERR-Q.
IF SPOT-ERR = ERR-Q MOVE "X" TO H-S.
*SH-S IS" REC" FOR TEN MAGTAPE.
IF SH-S = "RECO" OR SH-S = " REC" MOVE "S" TO H-S.
IF SH-S = "NON-" OR SH-S = " NON" MOVE "H" TO H-S.
MOVE ZEROS TO SPOT-ERR.
IF DONE = 1 GO TO S-FINAL.
IF SPOT-ERR = SIX-STARS
PERFORM SORT-RELEASE THRU SORT-RELEASE-END GO TO TECO-LOOP.
GO TO T-CONI.
FIND-ERROR.
PERFORM READ-IN.
MOVE IN-LINE TO ERR-DETECT.
T-CONI.
PERFORM FIND-CONI UNTIL SPOT-CONI = FOURTEEN-STARS OR
SPOT-CONI = CONI-Q OR
SPOT-KS-CONI = KS-CONI-Q OR
SPOT-DX20 = DX20-Q OR
DONE = 1.
IF DONE = 1 GO TO S-FINAL.
IF SPOT-CONI = FOURTEEN-STARS
MOVE ZEROS TO SPOT-CONI
MOVE "******" TO CONI-RH
PERFORM SORT-RELEASE THRU SORT-RELEASE-END
GO TO TECO-LOOP.
IF SPOT-DX20 = DX20-Q MOVE "Y" TO DX20-ENTRY
MOVE SPACES TO SPOT-DX20
GO TO T-CONI.
IF SPOT-CONI = CONI-Q
UNSTRING SCONI DELIMITED BY ALL "," INTO JUNK REG-BUF
UNSTRING REG-BUF DELIMITED BY ALL " " INTO CONI-RH.
IF SPOT-KS-CONI = KS-CONI-Q
UNSTRING SKSCONI DELIMITED BY ALL "," INTO JUNK REG-BUF
UNSTRING REG-BUF DELIMITED BY ALL " " INTO CONI-RH JUNK.
MOVE ZEROS TO SPOT-CONI.
GO TO T-CREG.
FIND-CONI.
PERFORM READ-IN.
MOVE IN-LINE TO CONI-DETECT.
T-CREG.
*CMD 00: 4060 4060 0
*DST 01: 10422 401 10023
PERFORM FIND-CREG UNTIL SPOT-CREG = EIGHT-STARS OR
SPOT-CREG = CREG-Q OR
SPOT-CREG = CREG78-Q OR
DONE = 1.
IF DONE = 1 PERFORM SORT-RELEASE THRU SORT-RELEASE-END GO TO S-FINAL.
IF SPOT-CREG = EIGHT-STARS
MOVE "******" TO CREG
MOVE ZEROS TO SPOT-CREG
PERFORM SORT-RELEASE THRU SORT-RELEASE-END
GO TO TECO-LOOP.
* IF SPOT-CREG = CREG-Q
UNSTRING SCREG DELIMITED BY ALL " " INTO CREG JUNK.
MOVE CREG TO RD-WR-TEST.
IF RD-WR = "60" MOVE " WRITE" TO CREG.
IF RD-WR = "70" MOVE " READ" TO CREG.
MOVE ZEROS TO SPOT-CREG.
GO TO T-EREG.
FIND-CREG.
PERFORM READ-IN.
MOVE IN-LINE TO CREG-DETECT.
T-EREG.
PERFORM FIND-EREG UNTIL SPOT-EREG = EIGHT-STARS OR
SPOT-EREG = EREG-Q OR
SPOT-EREG = EREG78-Q OR
DONE = 1.
IF SPOT-EREG = EIGHT-STARS OR DONE = 1
MOVE "******" TO EREG
PERFORM SORT-RELEASE THRU SORT-RELEASE-END
GO TO TECO-LOOP.
* IF SPOT-EREG = EREG-Q
UNSTRING SEREG DELIMITED BY ALL " " INTO EREG JUNK.
IF EREG = SPACES MOVE SEREG TO EREG.
IF ENTRY-TYPE = "D" GO TO T-EREG-D.
*HERE ASSUME ENTRY IS TAPE
T-EREG-T.
IF DX20-ENTRY = "Y" GO TO T-EREG-DX20.
IF EREG NOT = "100000" AND
EREG NOT = " 100" AND
EREG NOT = " 200" AND
EREG NOT = " 300" AND
EREG NOT = "100100" AND
EREG NOT = "100200" AND
EREG NOT = "100300"
MOVE "?" TO ERROR-TYPE GO TO T-EREG-END.
MOVE " " TO ERROR-TYPE GO TO T-EREG-END.
T-EREG-DX20.
IF EREG = " 600" MOVE " " TO ERROR-TYPE
ELSE MOVE "?" TO ERROR-TYPE.
GO TO T-EREG-END.
T-EREG-D.
IF SEREG = "100000" MOVE "DCK" TO EREG
MOVE " " TO ERROR-TYPE
ELSE MOVE "?" TO ERROR-TYPE.
GO TO T-EREG-END.
T-EREG-END.
PERFORM SORT-RELEASE THRU SORT-RELEASE-END.
MOVE ZEROS TO SPOT-EREG.
GO TO TECO-LOOP.
FIND-EREG.
PERFORM READ-IN.
MOVE IN-LINE TO EREG-DETECT.
BUFFER-LOOP.
MOVE 1 TO BUFF-COUNT.
PERFORM BUFFER-LOOP-GO THRU BUFFER-LOOP-EXIT VARYING BUFF-COUNT FROM
1 BY 1 UNTIL BUFF-COUNT GREATER THAN 1200 OR
BUFFER-MARK (BUFF-COUNT) = "E".
GO TO S-D-END.
BUFFER-LOOP-GO.
MOVE BUFFER-REC (BUFF-COUNT) TO SORT-REC.
IF BUFFER-MARK (BUFF-COUNT) = "E" GO TO BUFFER-LOOP-EXIT.
PERFORM SORT-RELEASE THRU SORT-RELEASE-END.
BUFFER-LOOP-EXIT.
MOVE 0 TO DONE.
SORT-RELEASE.
IF NEW-FILE = "Y"
ADD 1 TO BUFF-COUNT
MOVE SORT-REC TO BUFFER-REC (BUFF-COUNT)
MOVE MED-ID TO BUFFER-MED-ID (BUFF-COUNT)
MOVE ERROR-TYPE TO B-ERROR (SEQ-COUNT)
MOVE ENTRY-TYPE TO B-TYPE (SEQ-COUNT)
MOVE "G" TO BUFFER-MARK (BUFF-COUNT).
IF TAL LESS THAN BEGIN-SEQ GO TO SORT-RELEASE-END.
IF D-SEL = "D" AND ENTRY-TYPE NOT = "D" GO TO SORT-RELEASE-END.
IF D-SEL = "T" AND ENTRY-TYPE NOT = "T" GO TO SORT-RELEASE-END.
IF MED-ID-SEL = "Y"
AND BUFFER-MED-ID (BUFF-COUNT) NOT = SPACES
MOVE BUFFER-MED-ID (BUFF-COUNT) TO DEVICE.
IF SERIAL-IGNOR = "Y" AND D-CMD NOT = "1" MOVE "XXXX" TO SERIAL-NUMBER.
IF UNIT-IGNOR = "Y" AND D-CMD NOT = "1" MOVE "XXXXX" TO DEVICE.
IF SECT-IGNOR = "Y" AND ENTRY-TYPE = "D" AND D-CMD NOT = "1"
MOVE " XX" TO SEC-ALLIGNED
MOVE SEC-ALLIGNED TO SEC-REC.
IF ERRORS-IGNOR = "Y" AND D-CMD NOT = "1"
MOVE SPACES TO H-S
MOVE SPACES TO CONI-RH
MOVE SPACES TO CREG
MOVE SPACES TO EREG
MOVE SPACES TO ERROR-TYPE.
RELEASE SORT-REC.
SORT-RELEASE-END.
MOVE 0 TO JUNK.
S-FINAL.
CLOSE LISTING.
MOVE "N" TO NEW-FILE.
MOVE "N" TO LISTING-OPEN.
S-D-END.
EXIT.