Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - acp010.lib
There are 4 other files named acp010.lib in the archive. Click here to see a list.
C\G,@C\G,WC
Gv%C(vAC:G4CI6G4KCX9G4qY>>N)GY>>N8Gm[LHG4
[LIG4}2&:e0%yeI:IG)BeI:LRG,ZeI:MzG0>g$[s[3Tg&\D4Cg"~-	GH:g"~-GKj

	@INFORMATION (ABOUT) DISK-USAGE                                                   
	@@INFORMATION (ABOUT) LOGICAL-NAMES                                               
(	@@DEF SYS: DSK:,SYS:                                                              
2	@                                                                                 
<	@LIBARY                                                                           
F**=ACP020                                                                          
P**EXTRACT ACP1CM,ACP1.CTL                                                          
Z**EXTRACT ACP2CM,ACP2.CTL                                                          
d**EXTRACT ACPCHKCM,ACPCHK.CTL                                                      
n**EXTRACT ACPDELCM,ACPDEL.CTL                                                      
x**EXTRACT LOGTYPCB,LOGTYP.CBL                                                      
**EXTRACT NEWTSTCB,NEWTST.CBL                                                      

**EXTRACT SETEOFMA,SETEOF.MAC                                                      
**EXTRACT SHORTLCB,SHORTL.CBL                                                      
 *^C                                                                                
*	@@MACRO                                                                           
4**=SETEOF                                                                          
>NO ERRORS DETECTED                                                                 
HPROGRAM BREAK IS 000136                                                            
RCPU TIME USED 00:01.058                                                            
\68P CORE USED                                                                      
f*^C                                                                                
p	@@LOAD SETEOF                                                                     
zMACRO:  SETEOF                                                                     
LINK:   Loading                                                                    
EXIT                                                                               
	@@SAVE                                                                            
"	@                                                                                 
,	@DELETE ACP1.LOG                                                                  
6	@@SUB ACP1                                                                        
@	@@SUB ACP2                                                                        
J	@@SUB ACPCHK                                                                      
T	@@CBL74                                                                           
^**=LOGTYP                                                                          
hPHASE C                                                                            
rPHASE D                                                                            
|PHASE E                                                                            
PHASE F                                                                            
**=SHORTL                                                                          
PHASE C                                                                            
$PHASE D                                                                            
.PHASE E                                                                            
8PHASE F                                                                            
B*^C                                                                                
L	@@COBOL                                                                           
V**=NEWTST                                                                          
`PHASE C                                                                            
jPHASE D                                                                            
tPHASE E                                                                            
~PHASE F                                                                            
WARNINGS:                                                                          
0140  Right-most truncation on SINGLE-CHAR                                         
0148  Most significant digits truncated on PTR                                     
&0205  Right-most truncation on STARLINETEXT                                        
0No Fatal Errors, 3 Warnings                                                        
:*^C                                                                                
D	@@INFORMATION (ABOUT) DISK-USAGE                                                  
N	@                                                                                 

*	MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT1.
2* REDEFINES
<* VALUE CLAUSE
F* ONE DIMENSIONED TABLE
P* OPEN, CLOSE, READ, WRIT SEQUENTIAL FILES
Z*   WITH BLOCKING AND ASCII/SIXBIT/BINARY MODES.
d* SAME AREA
n* RERUN EVERY N RECORDS
x* MOVE ALL LITERAL
* PERFORM N TIMES

* PERFORM VARYING
* ADD X TO Y
 * GO TO
** DISPLAY
4* STRING
>ENVIRONMENT DIVISION.
HI-O SECTION.
RFILE-CONTROL.
\	SELECT WORK-1 ASSIGN TO DSK
f	RECORDING MODE IS SIXBIT.
p
z	SELECT WORK-2 ASSIGN TO DSK
	RECORDING MODE IS BINARY.

	SELECT WORK-3 ASSIGN TO LOGDEV
"	RECORDING MODE IS ASCII.
,
6I-O-CONTROL.
@	RERUN EVERY 300 RECORDS OF WORK-3
J	SAME AREA WORK-1 WORK-2 WORK-3.
T
^DATA DIVISION.
hFILE SECTION.
rFD	WORK-1
|	VALUE OF ID IS FILENAME
	BLOCK CONTAINS 3 RECORDS.
01	RECORD-1 PIC X(80).

$FD	WORK-2
.	VALUE OF ID 'WORK2    '.
801	RECORD-2 PIC X(120).
B
LFD	WORK-3
V	VALUE OF ID 'TSTDATSEQ'.
`01	RECORD-3 DISPLAY-7.
j	3 RECKEY	PIC XXXXXX.
t	3 RECKEYREDEF REDEFINES RECKEY.
~	  5 RECKEY1	PIC XXX.
	  5 RECNO	PIC 999.
	3 FILLER	PIC X(20).

&WORKING-STORAGE SECTION.
01	FILENAME	PIC X(9) VALUE "WORK1XXXX".
:77	COUNT-1 PIC 99 VALUE 0.
D77	COUNT-2 PIC 99 VALUE 0.
N77	COUNT-3 PIC 9999 VALUE 0.
X1	TABLEOFVALUES.
b	3 RECVALUE PIC XXX OCCURS 999 TIMES.
l1	I	PIC S9(10) COMP.
v1	MESSAGEOUT	PIC X(28).


PROCEDURE DIVISION.
MAIN SECTION.
P0.
(	MOVE ALL "AAABBBCCCDDDEEEFFFGGGHHHIIIJJJ" TO TABLEOFVALUES.
2	OPEN OUTPUT WORK-1.
<	MOVE 'TEST DATA ' TO RECORD-1.
F	PERFORM WRITE-1 10 TIMES.
P	CLOSE WORK-1.
Z	STRING "  " FILENAME DELIMITED BY "X"
d		"X.XXX WRITTEN           " DELIMITED BY SIZE
n		INTO MESSAGEOUT.
x	DISPLAY MESSAGEOUT.
	OPEN OUTPUT WORK-2.

	MOVE 'TEST DATA' TO RECORD-2.
	PERFORM WRITE-2 20 TIMES.
 	CLOSE WORK-2.
*	DISPLAY '  WORK2 CREATED'.
4	OPEN OUTPUT WORK-3.
>	MOVE 'XXXXXX TEST DATA' TO RECORD-3.
H	PERFORM WRITE-3 VARYING I FROM 1 BY 1 UNTIL I > 999.
R	CLOSE WORK-3.
\	DISPLAY '  TSTDAT.SEQ CREATED '.
f	OPEN INPUT WORK-1.
pLOOP1.
z	READ WORK-1 RECORD AT END GO TO B1.
	ADD 1 TO COUNT-1.
	GO TO LOOP1.
B1.
"	IF COUNT-1=10, DISPLAY '  WORK1 CHECKOUT O.K.', GO TO B2.
,	DISPLAY '? 10 RECORDS ARE EXPECTED FROM WORK1, ONLY ';
6	COUNT-1, ' RECORDS WERE READ.'.
@B2.
J
T	CLOSE WORK-1, WITH DELETE.
^	OPEN INPUT WORK-2.
hLOOP2.
r	READ WORK-2 AT END GO TO B3.
|	ADD 1 TO COUNT-2.
	GO TO LOOP2.
B3.
	IF COUNT-2=20, DISPLAY '  WORK2 CHECKOUT O.K.', GO TO B4.
$	DISPLAY '? 20 RECORDS ARE EXPECTED FROM WORK-2, ONLY ';
.	COUNT-2, ' RECORDS WERE READ.'.
8B4.
B	CLOSE WORK-2  WITH DELETE.
L	OPEN INPUT WORK-3.
VLOOP3.
`	READ WORK-3 AT END GO TO B5.
j	ADD 1 TO COUNT-3.
t	IF COUNT-3 NOT = RECNO
~	  DISPLAY "? EXPECTING RECORD #" COUNT-3 ", GOT RECORD #" RECNO.
		GO TO LOOP3.
	B5.
		IF COUNT-3=999, DISPLAY ' TSTDAT.SEQ CHECKOUT O.K.', GO TO B6.
	&	DISPLAY '? 999 RECORDS ARE EXPECTED FROM TSTDAT.SEQ, ONLY ';
	0	COUNT-3, ' RECORDS WERE READ.'.
	:B6.
	D	CLOSE WORK-3.
	N	DISPLAY "END ACCPT1".
	X	STOP RUN.
	bWRITE-1.
	l	WRITE RECORD-1.
	vWRITE-2.

	WRITE RECORD-2.


WRITE-3.

	MOVE RECVALUE (I) TO RECKEY1.

	MOVE I TO RECNO.

(	WRITE RECORD-3.

*	MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT2.
2* OPEN, CLOSE, READ, WRITE ON RANDOM FILE
<* SORT WITH INPUT AND OUTPUT PROCEDURES.
F* REPORT WRITING FEATURES.
P* LINKED WITH COBDDT.REL, CHECKS COBDDT AD HISTOGRAM
ZENVIRONMENT DIVISION.
dINPUT-OUTPUT SECTION.
nFILE-CONTROL.
x	SELECT SEQFILE ASSIGN TO DSK.
	SELECT RANFILE ASSIGN TO DSK

	  ORGANIZATION RELATIVE
	  ACCESS DYNAMIC
 	  RELATIVE KEY ACTKEY
*	  RECORDING MODE IS SIXBIT.
4	SELECT REPFILE ASSIGN TO DSK.
>	SELECT SRTFILE ASSIGN TO DSK DSK DSK.
HDATA DIVISION.
RFILE SECTION.
\FD	SEQFILE VALUE OF ID IS "TSTDATSEQ".
f1	SEQREC PIC X(26) DISPLAY-7.
pFD	RANFILE VALUE OF ID IS "TSTDATRAN"
z	  BLOCK CONTAINS 20 RECORDS.
1	RANREC PIC X(26).
FD	REPFILE  VALUE OF ID IS "TSTDATREP"
	  REPORT IS REPTRY.
"1	REPREC PIC X(45) DISPLAY-7.
,SD	SRTFILE.
61	SRTREC.
@	3 KEY1 PIC XXX.
J	3 KEY2 PIC 999.
T	3 KEY2REDEF REDEFINES KEY2.
^	  5 DIGIT1 PIC 9.
h	  5 DIGIT2 PIC 9.
r	  5 DIGIT3 PIC 9.
|	3 KEY3 PIC X(20).
WORKING-STORAGE SECTION.
1	ACTKEY		PIC 9(10) COMP.
1	I		PIC 9(10) COMP.
$1	ONETHOUSAND	PIC 9(10) COMP VALUE 1000.
.1	OLDKEY		PIC XXX VALUE SPACE.
8REPORT SECTION.
BRD	REPTRY
L	  PAGE 60 LINES
V	  CONTROLS ARE FINAL DIGIT1 DIGIT2.
`1	  TYPE CONTROL FOOTING FINAL LINE PLUS 5.
j	3 COLUMN 1 PIC X(20) VALUE "FINAL LINE".
t	3 COLUMN 30 PIC XXX SOURCE KEY1.
~	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
	3 COLUMN 40 PIC ZZZZ SOURCE I.
1	  TYPE CONTROL FOOTING DIGIT1 LINE PLUS 3.
	3 COLUMN 1 PIC X(20) VALUE "BREAK ON DIGIT 1 ".
&	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
01	  TYPE CONTROL FOOTING DIGIT2 LINE PLUS 2.
:	3 COLUMN 1 PIC X(20) VALUE "BREAK ON DIGIT 2".
D	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
N1	DETAILLINE TYPE DETAIL LINE PLUS 1.
X	3 COLUMN 1 PIC XXXXXX VALUE "DETAIL".
b	3 COLUMN 30 PIC XXX SOURCE KEY1.
l	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
v1	TYPE PAGE HEADING LINE 1 NEXT GROUP PLUS 3.
	3 COLUMN 1 PIC X(35) VALUE "ACCEPTANCE TEST REPORT".

	3 COLUMN 30 PIC X(5) VALUE "PAGE".
	3 COLUMN 35 PIC ZZZ SOURCE PAGE-COUNTER.
PROCEDURE DIVISION.
(MAINLINE SECTION.
2P0.
<	SORT SRTFILE ON ASCENDING KEY1
F	  INPUT PROCEDURE INPROCEDURE
P	  OUTPUT PROCEDURE OUTPROCEDURE.
Z	DISPLAY "END ACCPT2".
d	STOP RUN.
nINPROCEDURE SECTION.
xIP0.
	OPEN INPUT SEQFILE, OUTPUT REPFILE.

	INITIATE REPTRY.
IP5.
 	READ SEQFILE AT END GO TO IP10.
*	RELEASE SRTREC FROM SEQREC.
4	MOVE SEQREC TO SRTREC.
>	GENERATE DETAILLINE.
H	GO TO IP5.
RIP10.
\	DISPLAY "  PRESORT DONE".
f	TERMINATE REPTRY.
p	CLOSE REPFILE.
z	CLOSE SEQFILE.
	DISPLAY "  TSTDAT.REP WRITTEN".

OUTPROCEDURE SECTION.
"OP0.
,	OPEN OUTPUT RANFILE.
6	DISPLAY "  MERGE STARTED".
@OP5.
J	RETURN SRTFILE AT END GO TO OP10.
T	IF KEY1 NOT < OLDKEY
^	  NEXT SENTENCE
h	ELSE
r	  DISPLAY SPACE
|	  DISPLAY "? KEYS NOT IN ORDER, LAST = " OLDKEY
	  ", THIS = " KEY1.
	MOVE KEY1 TO OLDKEY.
	MOVE KEY2 TO ACTKEY.
$	WRITE RANREC FROM SRTREC INVALID KEY
.	  REWRITE RANREC FROM SRTREC INVALID KEY
8	  DISPLAY SPACE
B	  DISPLAY "? CAN'T WRITE RANDOM RECORD AT KEY VALUE " ACTKEY.
L	GO TO OP5.
VOP10.
`	CLOSE RANFILE.
j	DISPLAY "  MERGE ENDED".
t	DISPLAY "  TSTDAT.RAN WRITTEN".
~	MOVE 0 TO ACTKEY I.
		OPEN INPUT RANFILE.
	OP15.
		READ RANFILE NEXT RECORD INTO SRTREC AT END
	&	  GO TO OP25.
	0	ADD 1 TO I.
	:	IF I NOT = KEY2
	D	  DISPLAY SPACE
	N	  DISPLAY "? RANDOM FILE RECORD OUT OF ORDER"
	X	  DISPLAY "  OR MISSING AT RECORD POSITION " I
	b	  DISPLAY "  RECORD FOUND THERE IS"
	l	  DISPLAY SRTREC.
	v	GO TO OP15.

OP25.


	CLOSE RANFILE.

	DISPLAY "  TSTDAT.RAN CHECK COMPLETED".

*	MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT3.
2* CONDITION-NAMES
<* CALL
F* OPEN INPUT-OUTPUT, DELETE REWRITE ON INDEXED FILE.
P* COMPILED WITH /U SWITCH, LINKED AS ROOT FOR OVERLAY.
ZENVIRONMENT DIVISION.
dINPUT-OUTPUT SECTION.
nFILE-CONTROL.
x	SELECT SEQFILE ASSIGN TO DSK.
	SELECT RANFILE ASSIGN TO DSK

	  ORGANIZATION RELATIVE
	  ACCESS RANDOM
 	  RELATIVE KEY IS ACTKEY.
*	SELECT IDXFILE ASSIGN TO DSK
4	  ORGANIZATION INDEXED
>	  ACCESS RANDOM
H	  RECORD KEY IS IDXKEY2.
R	SELECT REPFILE ASSIGN TO DSK.
\DATA DIVISION.
fFILE SECTION.
pFD	SEQFILE VALUE OF ID IS "TSTDATSEQ".
z1	SEQREC	PIC X(26) DISPLAY-7.

FD	RANFILE VALUE OF ID IS "TSTDATRAN"
	  BLOCK CONTAINS 20 RECORDS.
"1	RANREC	PIC X(26).
,
6FD	IDXFILE VALUE OF ID IS "TSTDATIDX"
@	  BLOCK CONTAINS 29 RECORDS.
J1	IDXREC.
T	3 IDXKEY1 PIC XXX.
^	88 RECORDTOBEDELETED VALUE "AAA" THRU "EEE".
h	88 RECORDTOBEREWRITTEN VALUE "FFF" "GGG" "HHH" "III" THRU "JJJ".
r	3 IDXKEY2 PIC 999.
|	3 IDXFILLER PIC X(20).

FD	REPFILE VALUE OF ID IS "TSTDATREP".
1	REPREC PIC X(45) DISPLAY-7.
$
.WORKING-STORAGE SECTION.
81	ACTKEY		PIC 9(10) COMP.
B1	I		PIC 9(10) COMP.
L1	RANWSREC	PIC X(26).
V1	REPWSREC DISPLAY-7.
`	88 ABORTSIGNALON VALUE ALL "Z".
j	3 FILLER	PIC XXXXXX.
t	88 ADETAILRECORD VALUE "DETAIL".
~	3 FILLER	PIC X(39).
PROCEDURE DIVISION.
MAINLINE SECTION.
P0.
&	OPEN INPUT SEQFILE REPFILE.
0	OPEN INPUT-OUTPUT RANFILE IDXFILE.
:	DISPLAY "  ALL FILES OPENED".
DP5.
N	ADD 1 TO I.
X	READ IDXFILE NEXT RECORD AT END GO TO ENDCHECK.
b	IF I NOT = IDXKEY2
l	  DISPLAY "? ON READ NUMBER " I " WE GOT THIS RECORD:"
v	  DISPLAY "  " IDXREC.
	MOVE IDXKEY2 TO ACTKEY.

	READ RANFILE INTO RANWSREC INVALID KEY
	  DISPLAY "? CAN'T READ RECORD #" ACTKEY " ON RANDOM FILE.".
	READ SEQFILE AT END
(	  DISPLAY "? PREMATURE AT END ON SEQUENTIAL FILE.".
2P7.
<	READ REPFILE INTO REPWSREC AT END
F	  DISPLAY "? PREMATURE AT END ON REPORT FILE.".
P	IF NOT ADETAILRECORD GO TO P7.
Z
d	CALL ACCPT4 USING I SEQREC RANWSREC REPWSREC IDXREC.
n
x	IF ABORTSIGNALON
	  DISPLAY "? RECORDS DO NOT MATCH, ABORTING EXECUTION"

	  STOP RUN.
	IF RECORDTOBEDELETED
 	  DELETE IDXFILE INVALID KEY
*	    DISPLAY "? CAN'T DELETE RECORD ON INDEXED FILE.".
4	IF RECORDTOBEREWRITTEN
>	  MOVE SPACES TO IDXKEY1
H	  REWRITE IDXREC INVALID KEY
R	    DISPLAY "? CAN'T REWRITE RECORD ON INDEXED FILE.".
\	GO TO P5.
fENDCHECK.
p	READ SEQFILE AT END
z	  DISPLAY "  SEQUENTIAL FILE OK"
	  GO TO P35.
	DISPLAY "? TOO MANY RECORDS IN SEQUENTIAL FILE.".
P35.
"	CLOSE SEQFILE RANFILE.
,P36.
6	READ REPFILE INTO REPWSREC AT END GO TO P37.
@	IF NOT ADETAILRECORD GO TO P36.
J	DISPLAY "? TOO MANY DETAIL RECORDS IN REPORT FILE.".
TP37.
^	CLOSE REPFILE.
h	IF I = 1000 
r	  DISPLAY "  NORMAL END ACCPT3."
|	ELSE DISPLAY "? ABNORMAL END ACCPT3, ONLY " I " RECORDS COUNTED.".
	STOP RUN.

*	MODIFIED ON 24-OCT-77 BY MFTT FOR '74 LANGUAGE SPECS
* 8 SEP 75
ID DIVISION.
(PROGRAM-ID. ACCPT4.
2* LINKAGE SECTION.
<* COMPILED WITH /U SWITCH, LINKED AS OVERLAY.
FDATA DIVISION.
PWORKING-STORAGE SECTION.
ZLINKAGE SECTION.
d1	I	PIC S9(10) COMP.
n1	SEQREC DISPLAY-7.
x	3 SEQKEY1		PIC XXX.
	3 SEQKEY2		PIC 999.

	3 SEQKEY3		PIC X(20).

 1	RANREC.
*	3 RANKEY1		PIC XXX.
4	3 RANKEY2		PIC 999.
>	3 RANKEY3		PIC X(20).
H
R1	IDXREC.
\	3 IDXKEY1		PIC XXX.
f	3 IDXKEY2		PIC 999.
p	3 IDXKEY3		PIC X(20).
z
1	REPREC DISPLAY-7.
	3 REPKEY3		PIC X(29).
	3 REPKEY1		PIC XXX.
"	3 FILLER		PIC XX.
,	3 REPKEY2		PIC 999.
6	3 FILLER 		PIC X(8).
@PROCEDURE DIVISION USING I SEQREC RANREC REPREC IDXREC.
JMANLINE SECTION.
TP0.
^	IF REPKEY1 NOT = RANKEY1
h	OR RANKEY1 NOT = SEQKEY1
r	OR SEQKEY1 NOT = IDXKEY1
|	OR IDXKEY1 NOT = REPKEY1
	  DISPLAY "? KEY1 VALUES ARE NOT EQUAL, RECORD # " I
	  DISPLAY "  RANDOM  KEY = " RANKEY1
	  DISPLAY "  INDEXED KEY = " IDXKEY1
$	  DISPLAY "  SEQUENT KEY = " SEQKEY1
.	  DISPLAY "  REPORT  KEY = " REPKEY1
8	  GO TO BADEXIT.
B	IF RANKEY2 = REPKEY2
L	AND REPKEY2 = SEQKEY2
V	AND IDXKEY2 = SEQKEY2
`	  GO TO GOODEXIT.
j	DISPLAY "? KEY2 VALUES NOT EQUAL, RECORD # " I
t	DISPLAY "  RANDOM  KEY = " RANKEY2
~	DISPLAY "  INDEXED KEY = " IDXKEY2
	DISPLAY "  SEQUENT KEY = " SEQKEY2
	DISPLAY "  REPORT  KEY = " REPKEY2.
BADEXIT.
&	MOVE ALL "Z" TO REPREC.
0GOODEXIT.
:	EXIT PROGRAM.


;$JOB
.NOERROR
(.R SETSRC                                                       
2*SYS  
<.ASS DSK SYS
F.SET WATCH V
P.R LIBARY
Z*=ACP010
d*EXTRACT ACCPT1CB,ACCPT1.CBL
n*EXTRACT ACCPT2CB,ACCPT2.CBL
x*EXTRACT ACCPT3CB,ACCPT3.CBL
*EXTRACT ACCPT4CB,ACCPT4.CBL

.SET WATCH V
.R CBL74
 *=ACCPT1
*.R CBL74
4*=ACCPT2
>.R CBL74
H*=ACCPT3/P/U
R.R CBL74
\*=ACCPT4/P/U
f.R LINK
p*ACCPT1/G
z.SAVE ACCPT1
.ASSIGN DSK LOGDEV
.RU ACCPT1
.DEAS LOGDEV
".R RERUN
,*ACCPT1
6.ASSIGN DSK LOGDEV
@.CONT
J.R ISAM
T*TSTDAT
^*A
h*S
r*26
|*UN4.3
*0
*29
*3
$*14
.*1
8*10
B*10
L*2000
V.R LINK
`*/DEB:C ACCPT2/G
j*BREAK OP25
t*HISTORY BEGIN TTY: 'ACCEPTANCE TEST OF HISTOGRAM'
~! I SHOULD HAVE VALUE OF 999
*DISPLAY I
*CLEAR
*WHERE
&*P
0.R LINK
:*ACCPT3.OVR/OV=ACCPT3/LINK:ROOT/SPACE:10000
D*ACCPT4/LINK/G
N!NOTE - THIS HAS NOT WORKED FOR LO THESE MANY MONTHS
X! ON TOPS-20 BECAUSE OF A LONG-STANDING LINK BUG
b! WHICH DOES NOT RIGHTLY INITIALIZE THE MODULE.
l!   IF THE BUG SHOULD STILL EXIST AT THIS RUNNING,
v! SUBSTITUTE A GET/SAVE/RUN SEQUENCE AFTER LINK.
! THE ERROR MESSAGE IF YOU ENCOUNTER IT, WILL SAY:

!     - ?OVLOPP OVERLAY HANDLER IN PRIVATE PAGE
.RU ACCPT3
.K/F


;$JOB
.NOERROR
(.R SETSRC                                                       
2*SYS  
<.ASS DSK SYS
F.DELETE RAN*.DAT,ISMDAT.*,*.CKP
P.R LIBARY
Z*=ACP010
d*EXTRACT RR74DLCB,RR74DL.CBL
n*EXTRACT RR74RDCB,RR74RD.CBL
x*EXTRACT RR74WTCB,RR74WT.CBL
.SET WATCH V

.R CBL74
*=RR74WT
 *=RR74RD
**=RR74DL
4.R LINK
>*RR74WT/G
H.SAVE RR74WT
R.RU ISAM
\*ISMDAT=NUL:
f*S
p*A
z*15
*X11.5
*0
*2
"*1
,*4
6*1
@*10
J*10
T*1000
^.RU RR74WT
h.R LINK
r*RR74RD/G
|.SAVE RR74RD
.START
.R LINK
*RR74DL/G
$.START
..R RERUN
8*RR74WT
B.RUN RR74RD
L.DELETE RAN*.DAT,ISMDAT.*,*.CKP
V.DELETE RR74*.*
`.K/N


.NOERROR
.R SETSRC                                                       
(*SYS  
2.ASS DSK SYS
<.R LOGTYP
F*N
P*ACP1
Z.R LOGTYP
d*YES
n*ACP2
x.R SHORTL
*N

*ACPMAS
.R LIBARY
 *=ACP010
**EXTRACT ACCEPTCK,ACPMAS.CHK
4.R FILCOM
>*=ACPMAS.CHK,ACPMAS.SLG
H.GOTO RESUME
R*@MAILER
\*
f*  ACP SUBSYSTEM
p*  IS DONE !!!
z*
*
RESUME::
.K/F


.NOERROR
.DELE ACP???.BAK
(.DELE ACPMAS.*,ACPCHK.*,ACPDEL.CTL,ACP1.*
2.DELETE TSTDAT.RAN,TSTDAT.REP
<.DELETE TSTDAT.IDA,TSTDAT.IDX
F.DELETE TSTDAT.SEQ,WORK1X.XXX,WORK2
P.DELETE SHORTL.CBL,SHORTL.LST
Z.DELETE LOGTYP.CBL,LOGTYP.LST
d.DELETE NEWTST.CBL,NEWTST.LST
n.DELETE *.INP
x.DELETE ACCPT?.*
.K/F


;$JOB
.NOERROR
(.R SETSRC                                                       
2*SYS  
<.ASS DSK SYS
FDO10::
P.R LIBARY
Z*=ACP010
d*EXTRACT ACP1CM,ACP1.CTL
n*EXTRACT ACP2CM,ACP2.CTL
x*EXTRACT ACPCHKCM,ACPCHK.CTL
*EXTRACT ACPDELCM,ACPDEL.CTL

*EXTRACT LOGTYPCB,LOGTYP.CBL
*EXTRACT NEWTSTCB,NEWTST.CBL
 *EXTRACT SHORTLCB,SHORTL.CBL
*.GOTO RESUME::
4DO20::
>*=ACP020
H*EXTRACT ACP1CM,ACP1.CTL
R*EXTRACT ACP2CM,ACP2.CTL
\*EXTRACT ACPCHKCM,ACPCHK.CTL
f*EXTRACT ACPDELCM,ACPDEL.CTL
p*EXTRACT LOGTYPCB,LOGTYP.CBL
z*EXTRACT NEWTSTCB,NEWTST.CBL
*EXTRACT SETEOFMA,SETEOF.MAC
*EXTRACT SHORTLCB,SHORTL.CBL
*=SETEOF
"RESUME::
,.DELETE ACP1.LOG
6.SUB ACP1
@.SUB ACP2
J.SUB ACPCHK
T.R CBL74
^*=LOGTYP/R
h*=SHORTL/R
r.R COBOL
|*=NEWTST/R
.R LINK
*LOGTYP/G
.SAVE LOGTYP
$.R LINK
.*SHORTL/G
8.SAVE SHORTL
B.R LINK
L*NEWTST/G
V.SAVE NEWTST
`.K/F

*26 DEC 75
ID DIVISION.
PROGRAM-ID. LOGTYP.
(*	READS AND TYPES .LOG FILES IN SHORT FORM.
2ENVIRONMENT DIVISION.
<INPUT-OUTPUT SECTION.
FFILE-CONTROL.
P	SELECT INFILE ASSIGN TO DSK.
ZDATA DIVISION.
dFILE SECTION.
nFD	INFILE VALUE OF ID IS INFILENAME.
x01	INREC DISPLAY-7.
	03  TABS	PIC XX.

	88  TABTAB VALUE "		".
	03  JOBFIELD.
 	88  JOBLINE	VALUE ";$JOB".
*	    05 FILLER	PIC X.
4	    88 TABTABQUESTION VALUE "?".
>	    05 FILLER	PIC XXXX.
H	03  FILLER	PIC XX.
R	03  INCODE	PIC X.
\	88  MONTR	VALUE "M" "T" "B" "F".
f	88 BATCH	VALUE "B" "T" "F".
p	88  USER	VALUE "U".
z	03  FILLER	PIC X(4).
	03  USERLINE.
	    05  CHR1	PIC X.
	    05  MONTRLINE.
"		07  CHRS2TO7.
,			88 KJOB VALUE "@@LOGO".
6		    09  CHR2	PIC X.
@		    09  FILLER	PIC X(5).
J		07  FILLER	PIC X(61).
TWORKING-STORAGE SECTION.
^1	STARTMARK	PIC S9(10) COMP.
h1	ENDMARK		PIC S9(10) COMP.
r1	MONTRMARK	PIC S9(10) COMP.
|1	QUESTIONMARK	PIC S9(10) COMP.
1	CURRENTLINE	PIC S9(10) COMP.
1	RESPONSE	PIC X.
	88 NOPE VALUE "N".
$	88 LEGALRESPONSE VALUE "N" "Y".
.1	INFILENAME.
8	3  FILENAME	PIC X(6).
B	3  FILLER	PIC XXX VALUE "LOG".
L1	PTR	PIC S9(5) COMP VALUE 1.
V1	FILENAMESTRING PIC X(72) DISPLAY-7.
`PROCEDURE DIVISION.
jP1.
t	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
~	ACCEPT RESPONSE.
	IF NOT LEGALRESPONSE
	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
	  GO TO P1.
&	DISPLAY "NAMES OF .LOG FILES: ".
0	ACCEPT FILENAMESTRING.
:	MOVE 1 TO PTR.
DP2.
N	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
X	  INTO FILENAME WITH POINTER PTR.
b	IF FILENAME = SPACE GO TO P1.
l	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
v	MOVE 10000 TO ENDMARK.
	IF NOPE GO TO P4.


*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.

(	OPEN INPUT INFILE.
2P3.
<	READ INFILE AT END GO TO P3C.
F	ADD 1 TO CURRENTLINE.
P	IF MONTR AND CHR2 = "@"
Z	  NEXT SENTENCE ELSE GO TO P3A.
d	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
n	  GO TO P3.
x*	  IGNORE THE @ST LINE IN ORDER TO GET THE PRECEDING LINES
*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.

	IF BATCH OR CHRS2TO7 = "@@ST" OR "@ST" OR "@" GO TO P3.
	MOVE CURRENTLINE TO MONTRMARK.
 	GO TO P3.
*P3A.
4	IF USER AND CHR1 = "?"
>	  GO TO P3B.
H	IF MONTR AND CHR2 = "?"
R	  GO TO P3B.
\	IF TABTABQUESTION GO TO P3B.
f	GO TO P3.
pP3B.
z	IF STARTMARK = 0
	  MOVE MONTRMARK TO STARTMARK.
	MOVE CURRENTLINE TO QUESTIONMARK.
	GO TO P3.
"P3C.
,	MOVE MONTRMARK TO ENDMARK.
6	MOVE 0 TO CURRENTLINE.
@	CLOSE INFILE.
J	IF STARTMARK = 0
T	  DISPLAY "NO ?'S FOUND IN " FILENAME
^	  GO TO P2.
hP4.
r	OPEN INPUT INFILE.
|	DISPLAY "**** " FILENAME.
P5.
	READ INFILE AT END GO TO P95.
	ADD 1 TO CURRENTLINE.
$	IF NOT JOBLINE GO TO P5.
.	IF CURRENTLINE < STARTMARK GO TO P10.
8	IF CURRENTLINE > ENDMARK GO TO P99.
B	MOVE "\\" TO TABS.
L	DISPLAY INREC.
VP10.
`	READ INFILE AT END GO TO P99.
j	ADD 1 TO CURRENTLINE
t	IF CURRENTLINE < STARTMARK GO TO P10.
~	IF CURRENTLINE > ENDMARK GO TO P99.
		IF KJOB GO TO P99.
		IF TABTAB
		  MOVE "\\" TO TABS
	&	  DISPLAY INREC
	0	  GO TO P10.
	:	IF MONTR AND CHRS2TO7 NOT = SPACE
	D	  DISPLAY MONTRLINE GO TO P10.
	N	IF USER AND USERLINE NOT = SPACE
	X	  DISPLAY USERLINE GO TO P10.
	b	GO TO P10.
	lP95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.
	vP99.	CLOSE INFILE GO TO P2.

 ID DIVISION.
PROGRAM-ID. LOGTYP.
ENVIRONMENT DIVISION.
(INPUT-OUTPUT SECTION.
2FILE-CONTROL.
<	SELECT INFILE ASSIGN TO DSK.
FDATA DIVISION.
PFILE SECTION.
ZFD	INFILE VALUE OF ID IS INFILENAME.
d01	INREC1 DISPLAY-7.
n	2 LINE1 PIC X(22).
x	2 FILLER PIC X(61).
01	INREC2 DISPLAY-7.

	3 SLASHSLASH PIC XX.
	3 FILLER PIC X(12).
 	3 OUTLINE PIC X(69).
*1	INREC3 DISPLAY-7.
4	2 FILLER PIC X(14).
>	2 USER-LINE.
H		3 FILLER PIC X.
R		3 TOPS-20-MONTR-LINE.
\		   4 FILLER PIC X.
f		   4 TOPS-10-MONITR-LINE PIC X(67).
p
zWORKING-STORAGE SECTION.
1	STARTMARK	PIC S9(10) COMP.
1	ENDMARK		PIC S9(10) COMP.
1	MONTRMARK	PIC S9(10) COMP.
"1	QUESTIONMARK	PIC S9(10) COMP.
,1	CURRENTLINE	PIC S9(10) COMP.
61	RESPONSE	PIC X.
@	88 NOPE VALUE "N".
J	88 LEGALRESPONSE VALUE "N" "Y".
T1	INFILENAME.
^	3  FILENAME	PIC X(6).
h	3  FILLER	PIC XXX VALUE "LOG".
r1	PTR	PIC S9(5) COMP VALUE 1.
|1	FILENAMESTRING PIC X(72) DISPLAY-7.
1	TALLY1 PIC 9999999999.
1	TALLY2 PIC 9999999999.
1	LOGIN-LINE1.
$	2 INDEXED-LINE PIC X OCCURS 22 TIMES.
.1	POINTER1	PIC 99.
81	TOPS-TYPE PIC X VALUE " ".
B	88 FOUND-TOPS-TYPE VALUE "@" ".".
L	88 TOPS-20 VALUE "@".
V	88 TOPS-10 VALUE ".".
`1	MONLINE PIC X(7) USAGE IS DISPLAY-7.
jPROCEDURE DIVISION.
tP1.
~	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
	ACCEPT RESPONSE.
	IF NOT LEGALRESPONSE
	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
&	  GO TO P1.
0	DISPLAY "NAMES OF .LOG FILES: ".
:	ACCEPT FILENAMESTRING.
D	MOVE 1 TO PTR.
NP2.
X	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
b	  INTO FILENAME WITH POINTER PTR.
l	IF FILENAME = SPACE GO TO P1.
v	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
	MOVE " " TO TOPS-TYPE.

	MOVE 10000 TO ENDMARK.
	IF NOPE GO TO P4.
	MOVE "NOVALUE" TO MONLINE.
(
2*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
<
F	OPEN INPUT INFILE.
PP3.
Z	READ INFILE AT END GO TO P3C.
d	IF NOT FOUND-TOPS-TYPE
n		PERFORM FIND-TYPE.
x	ADD 1 TO CURRENTLINE.
	SET TALLY1 TO 0.

	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE.
	IF TALLY1 NOT = 1 GO TO P3A.
 	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
*	  GO TO P3.
4*	  IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
>*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
H	SET TALLY1 TO 0.
R	INSPECT LINE1 TALLYING TALLY1 FOR ALL "..ST",
\		TALLY1 FOR ALL ".ST",
f		TALLY1 FOR ALL "@ST",
p		TALLY1 FOR ALL "@@ST".
z	IF TALLY1 = 1 GO TO P3.
	MOVE CURRENTLINE TO MONTRMARK.
	GO TO P3.
P3A.
"	SET TALLY1 TO 0.
,	INSPECT LINE1 TALLYING TALLY1 FOR ALL "?".
6	IF TALLY1 NOT < 1 PERFORM P3B.
@	GO TO P3.
JP3B.
T	IF STARTMARK = 0
^	  MOVE MONTRMARK TO STARTMARK.
h	MOVE CURRENTLINE TO QUESTIONMARK.
r
|P3C.
	MOVE MONTRMARK TO ENDMARK.
	MOVE 0 TO CURRENTLINE.
	CLOSE INFILE.
$	IF STARTMARK = 0
.	  DISPLAY "NO ?'S FOUND IN " FILENAME
8	  GO TO P2.
BP4.
L	OPEN INPUT INFILE.
V	DISPLAY "**** " FILENAME.
`	PERFORM FIND-MONLINE.
jP5.
t	READ INFILE AT END GO TO P95.
~	ADD 1 TO CURRENTLINE.
		SET TALLY1 TO 0.
		INSPECT LINE1 TALLYING TALLY1 FOR ALL ";$JOB".
		IF TALLY1 NOT = 1 GO TO P5.
	&	IF CURRENTLINE > ENDMARK GO TO P99.
	0P10.
	:	READ INFILE AT END GO TO P99.
	D	ADD 1 TO CURRENTLINE
	N	IF CURRENTLINE < STARTMARK GO TO P10.
	X	IF CURRENTLINE > ENDMARK GO TO P99.
	b	SET TALLY1 TO 0.
	l	INSPECT LINE1 TALLYING TALLY1 FOR ALL "KJOB",
	v		TALLY1 FOR  ALL "LOGO".

	IF TALLY1 = 1 GO TO P99.


	SET TALLY1 TO 0.

	INSPECT LINE1 TALLYING TALLY1 FOR ALL "		".

	IF TALLY1 = 1

(		MOVE "\\" TO SLASHSLASH

2		DISPLAY  INREC2

<		GO TO P10.

F	SET TALLY1 TO 0.

P	SET TALLY2 TO 0.

Z	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE,

d		TALLY2 FOR ALL " USER	".

n	IF TALLY1 = 1 

x		IF TOPS-10
		    DISPLAY TOPS-10-MONITR-LINE

		ELSE IF TOPS-20
		    DISPLAY TOPS-20-MONTR-LINE.
 	IF TALLY2 = 1 AND USER-LINE NOT = SPACE
*		DISPLAY USER-LINE.
4	GO TO P10.
>P95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.
HP99.	CLOSE INFILE.
R	GO TO P2.
\FIND-TYPE.
f	MOVE 0 TO TALLY1.
p	INSPECT LINE1 TALLYING TALLY1 FOR ALL "LOGIN".
z	MOVE 1 TO POINTER1.

	IF TALLY1 =1

		UNSTRING LINE1 DELIMITED BY "LOGIN"

			 INTO LOGIN-LINE1 WITH POINTER POINTER1

"		MOVE INDEXED-LINE (POINTER1 - 6) TO TOPS-TYPE

,		IF TOPS-20 

6			MOVE " MONTR	" TO MONLINE

@		ELSE IF TOPS-10

J			MOVE "MONITR	" TO MONLINE

T			ELSE 

^		DISPLAY"? SHORTL ERROR COULD NOT FIND TOPS TYPE".

hFIND-MONLINE.

r	READ INFILE AT END

|		DISPLAY "? COULDN'T FIND LOGIN LINE"
TOP RUN.
1 TO CURRENTLINE.
FORM FIND-TYPE.
F NOT FOUND-TOPS-TYPE GO TO FIND-MONLINE.


$JOB
.NOERROR
(.RU LIBARY
2*ACCCOM.DCY/D=ACCCOM
<*ACPCOM.DCY/D=ACPCOM
F*ADDCOM.DCY/D=ADDCOM
P*COMCOM.DCY/D=COMCOM
Z*DATCOM.DCY/D=DATCOM
d*DBMCOM.DCY/D=DBMCOM
n*DDTCOM.DCY/D=DDTCOM
x*DIVCOM.DCY/D=DIVCOM
*FILCOM.DCY/D=FILCOM

*GOTCOM.DCY/D=GOTCOM
*IFTCOM.DCY/D=IFTCOM
 *IPCCOM.DCY/D=IPCCOM
**LIBCOM.DCY/D=LIBCOM
4*MOVCOM.DCY/D=MOVCOM
>*MULCOM.DCY/D=MULCOM
H*REPCOM.DCY/D=REPCOM
R*SASCOM.DCY/D=SASCOM
\*SMUCOM.DCY/D=SMUCOM
f*SRTCOM.DCY/D=SRTCOM
p*STRCOM.DCY/D=STRCOM
z*SUBCOM.DCY/D=SUBCOM
*TBLCOM.DCY/D=TBLCOM
*UNSCOM.DCY/D=UNSCOM
*UTLCOM.DCY/D=UTILTY
"*DTMCOM.DCY/D=DATMOD
,*=ACP010
6*EXTRACT SETUP,SETUP.CBL
@*END
J.RU COBOL
T*=SETUP
^.LOAD SETUP
h.SAVE SETUP
r.DELE CONVRT.CTL
|.RU SETUP
*20
*I
*CONVRT
$*ACC
.*ACP
8*ADD
B*COM
L*DAT
V*DBM
`*DDT
j*DIV
t*FIL
~*GOT
*IFT
*IPC
*LIB
&*MOV
0*MUL
:*REP
D*SAS
N*SMU
X*SRT
b*STR
l*SUB
v*TBL
*UNS

*QIT
.SUB CONVRT/TIME:0:10:00
.K/F


$JOB
*ACCCOM.DCY/D=ACCCOM
(*ACPCOM.DCY/D=ACPCOM
2*ADDCOM.DCY/D=ADDCOM
<*COMCOM.DCY/D=COMCOM
F*DATCOM.DCY/D=DATCOM
P*DBMCOM.DCY/D=DBMCOM
Z*DDTCOM.DCY/D=DDTCOM
d*DIVCOM.DCY/D=DIVCOM
n*FILCOM.DCY/D=FILCOM
x*GOTCOM.DCY/D=GOTCOM
*IFTCOM.DCY/D=IFTCOM

*IPCCOM.DCY/D=IPCCOM
*LIBCOM.DCY/D=LIBCOM
 *MOVCOM.DCY/D=MOVCOM
**MULCOM.DCY/D=MULCOM
4*REPCOM.DCY/D=REPCOM
>*SASCOM.DCY/D=SASCOM
H*SMUCOM.DCY/D=SMUCOM
R*SRTCOM.DCY/D=SRTCOM
\*STRCOM.DCY/D=STRCOM
f*SUBCOM.DCY/D=SUBCOM
p*TBLCOM.DCY/D=TBLCOM
z*UNSCOM.DCY/D=UNSCOM
*UTLCOM.DCY/D=UTILTY
*DTMCOM.DCY/D=DATMOD
*=ACP010
"*EXTRACT SETUPCB,SETUP.CBL
,*=SETUP
6*20
@*I
J*CONVRT
T*ACC
^*ACP
h*ADD
r*COM
|*DAT
*DBM
*DDT
*DIV
$*FIL
.*GOT
8*IFT
B*IPC
L*LIB
V*MOV
`*MUL
j*REP
t*SAS
~*SMU
*SRT
*STR
*SUB
&*TBL
0*UNS
:*QIT

* 27 JULY 75
ID DIVISION.
PROGRAM-ID. NEWTST.
(*	NEWTST IS A TEST UTILITY PROGRAM THAT IS USED TO GENERATE
2*	TEST PROGRAMS FROM TEST MODULES.  SEE THE FULL DESCRIPTION
<*	OF NEWTST IN THE DECSYSTEM-10 COBOL TEST SYSTEM DESCRIPTION.
F*+ NOTE THAT AL CHANGES DUE TO THE REMOVAL OF THE ":" FUNCTION
P*  HAVE BEEN PRECEDED AND FOLLOWED BY COMMENTS.  THE COMMENT LINES
Z*- BEGIN WITH A "+" AND END WITH A "-".
dENVIRONMENT DIVISION.
nINPUT-OUTPUT SECTION.
xFILE-CONTROL.
	SELECT INFILE ASSIGN TO DSK.

	SELECT OUTFILE ASSIGN TO DSK.
DATA DIVISION.
 FILE SECTION.
*FD	INFILE VALUE OF ID IS INFILENAME.
41	INLINE	PIC X(64) DISPLAY-7.
>
HFD	OUTFILE VALUE OF ID IS OUTFILENAME.
R1	OUTLINE	PIC X(64) DISPLAY-7.
\
fWORKING-STORAGE SECTION.
p1	ITERATION	PIC S9999 COMP.
z1	EDITED-ITERATION PIC XXXXX.
1	STEP		PIC S9999 COMP.
1	EDITED-STEP	PIC XXXXX.
1	RIGHT-EDIT	PIC ZZZZZ.
"1	RIGHT-EDITX REDEFINES RIGHT-EDIT PIC XXXXX.
,1	JUNK		PIC X.
61	SINGLE-CHAR	PIC X.
@1	TABCOMP		PIC S9999 COMP VALUE 18.
J1	TABR REDEFINES TABCOMP DISPLAY-7.
T	3 FILLER	PIC XXXX.
^	3 TAB		PIC X.
h1	REPLACESWITCH	PIC X.
r1	LINECOUNT	PIC S9999 COMP.
|1	LIST-NUMBER	PIC S9999 COMP.
1	LIST-ENTRY	PIC S9999 COMP.
1	L		PIC S9999 COMP.
1	K		PIC S9999.
$1	I		PIC S9999 COMP.
.1	SKLN		PIC S9999 COMP.
81	DIGIT		PIC 9.
B1	DIGIT2		PIC 9.
L1	N		PIC S9999 COMP.
V1	M		PIC S9999 COMP.
`1	T		PIC S9999 COMP.
j1	P		PIC S9999 COMP.
t1	PTR		PIC S9999 COMP.
~1	DEL	PIC X.
1	LNAME		PIC X(31).
1	TLINE		PIC X(64) DISPLAY-7.
1	INFILENAME DISPLAY-7.
&	3 IFNAME	PIC XXXXXX.
0	3 IFEXT		PIC XXX.
:1	OUTFILENAME DISPLAY-7.
D	3 OFNAME	PIC XXXXXX.
N	3 OFEXT 	PIC XXX VALUE "CBL".
X1	LIST-CONTROL-TABLE.
b	3 LT  OCCURS 9.
l	  5 LIST-START PIC S9999 COMP.
v	  5 LIST-LENGTH PIC S9999 COMP.
	  5 LIST-COUNT PIC S9999 COMP.

	  5 LIST-TYPE PIC X.
1	TABLES DISPLAY-7.
	3 TNAME	PIC X(31) OCCURS 125 TIMES.
(	3 SKL		PIC X(64) OCCURS 20 TIMES.
21	CHARS1 DISPLAY-7.
<	3  CHAR11	PIC X.
F	3  FILLER	PIC X(63).
P1	CHARS2 DISPLAY-7.
Z	3 CHAR21	PIC X.
d	3 FILLER	PIC X(63).
n1	SENDING-FIELDS DISPLAY-7.
x	3 SENDING-ITEM OCCURS 20.
	  5 SENDING-ITEM5CHARS PIC XXXXX.

	  5 FILLER PIC X(59).
1	D		PIC X DISPLAY-7.
 1	CHARX	PIC X DISPLAY-7.
*1	TEMPNAME	PIC X(31) DISPLAY-7.
41	PROGLINE DISPLAY-7 VALUE "PROGRAM-ID. XXXXXX.".
>	3 FILLER	PIC X(12).
H	3 PROGID	PIC X(6).
R	3 FILLER	PIC X.
\1	IDLINE DISPLAY-7 PIC X(12) VALUE "ID DIVISION.".
f1	DATLINE DISPLAY-7 PIC X(14) VALUE "DATA DIVISION.".
p1	WSLINE DISPLAY-7 PIC X(24) VALUE "WORKING-STORAGE SECTION.".
z1	PDLINE DISPLAY-7 PIC X(19) VALUE "PROCEDURE DIVISION.".
1	P0LINE DISPLAY-7 PIC X(3) VALUE "P0.".
1	ENDLINE DISPLAY-7 PIC X(28) VALUE "    DISPLAY 'END' STOP RUN.".
1	HLINE DISPLAY-7 VALUE "****XXXXXX.XXX****".
"	3 FILLER	PIC XXXX.
,	3 HLINENAME	PIC X(6).
6	3 FILLER	PIC X.
@	3 HLINEEXT	PIC XXX.
J	3 FILLER	PIC XXXX.
T1	STARLINE DISPLAY-7 VALUE "*".
^	3 FILLER	PIC X.
h	3 STARLINETEXT	PIC X(63).
r
|PROCEDURE DIVISION.
ND1 SECTION.
P0.
	MOVE ZERO TO REPLACESWITCH ITERATION STEP SKLN.
$	MOVE 1 TO LIST-ENTRY LIST-NUMBER.
.	DISPLAY "OUTPUT FILENAME? (6 CHARS) " WITH NO ADVANCING.
8	ACCEPT OFNAME.
B	IF OFNAME = SPACES STOP RUN.
L*+ NEXT LINE SKIPPED TO AVOID THE ":" FUNCTION.
V*	MOVE "TMP" TO OFEXT.
`*- END OF CHANGE.
j	OPEN OUTPUT OUTFILE.
t	MOVE 4 TO LINECOUNT.
~	WRITE OUTLINE FROM IDLINE.
		MOVE OFNAME TO PROGID.
		WRITE OUTLINE FROM PROGLINE.
		DISPLAY "COMMENTS:".
	&P5.
	0	ACCEPT OUTLINE.
	:	IF OUTLINE NOT = SPACES
	D	  WRITE OUTLINE
	N	  ADD 1 TO LINECOUNT
	X	  GO TO P5.
	b	WRITE OUTLINE FROM DATLINE.
	l	WRITE OUTLINE FROM WSLINE.
	vBL3.

	DISPLAY "INPUT FILENAME? (9 CHARS) " WITH NO ADVANCING.


	ACCEPT INFILENAME.

	OPEN INPUT INFILE.

	MOVE LIST-ENTRY TO LIST-START(LIST-NUMBER).

(	MOVE IFNAME TO HLINENAME.

2	MOVE IFEXT TO HLINEEXT.

<	IF IFEXT = "PM " GO TO BL20.

F	WRITE OUTLINE FROM HLINE.

P	ADD 1 TO LINECOUNT.

Z

dBL4.

n	READ INFILE AT END GO TO BL9.

x	MOVE INLINE TO SINGLE-CHAR.
BL5.

	EXAMINE INLINE TALLYING UNTIL FIRST "[".
	IF TALLY > 63
 	  WRITE OUTLINE FROM INLINE
*	  ADD 1 TO LINECOUNT
4	  GO TO BL4.
>	MOVE 0 TO K.
H	ADD 2 TALLY GIVING PTR.
R	UNSTRING INLINE DELIMITED BY "]"
\	  INTO LNAME COUNT IN K WITH POINTER PTR.
f	IF K > 30 MOVE 30 TO K
p	  DISPLAY "ITEM TRUNCATION = " LNAME.
z	ADD 1 TO K.

	STRING "\" DELIMITED BY SIZE INTO LNAME WITH POINTER K.

	EXAMINE INLINE REPLACING FIRST "[" BY SPACE

	EXAMINE INLINE REPLACING FIRST "]" BY SPACE.

"	IF LIST-ENTRY > 125

,	  DISPLAY "? TOO MANY BRACKETED ITEMS" LNAME

6	  STOP RUN.

@	MOVE LNAME TO TNAME(LIST-ENTRY).

J	ADD 1 TO LIST-ENTRY.

T	GO TO BL5.

^BL9.

h	CLOSE INFILE.

r	SUBTRACT LIST-START(LIST-NUMBER) FROM

|	  LIST-ENTRY GIVING LIST-LENGTH(LIST-NUMBER).
 1 TO LIST-COUNT(LIST-NUMBER).
ST-NUMBER = 9
 DISPLAY "? TOO MANY LISTS" STOP RUN.
DD 1 TO LIST-NUMBER.
TO BL3.

 OUTLINE FROM PDLINE.
TE OUTLINE FROM P0LINE.
TE OUTLINE FROM HLINE.
3 TO LINECOUNT.

INFILE AT END GO TO BL29.
 1 TO PTR.
BL22.
	UNSTRING INLINE DELIMITED BY "%" OR "!"
	  INTO  CHARS1 DELIMITER IN D
&	  WITH POINTER PTR.
0	IF PTR > 62 GO TO BL26.
:	UNSTRING INLINE INTO CHARX WITH POINTER PTR.
D	MOVE CHARX TO P.
N	IF P NOT < LIST-NUMBER
X	  DISPLAY "? BAD LIST DIGIT"
b	  DISPLAY INLINE STOP RUN.
l	IF D = "%"
v	  MOVE "I" TO LIST-TYPE(P) GO TO BL22.
	IF D = "!"

	  MOVE "D" TO LIST-TYPE(P) GO TO BL22.
	DISPLAY "?BL25" STOP RUN.
BL26.
(*+ THIS CODE IS TO BE SKIPPED TO AVOID ":" FUNCTION.
2*	EXAMINE INLINE TALLYING ALL ":".
<*	IF TALLY NOT = 0 MOVE "1" TO REPLACESWITCH.
F*- END OF CHANGE.
P	ADD 1 TO SKLN.
Z	IF SKLN > 20
d	  DISPLAY "TOO MANY LINES IN SKELETON"
n	  STOP RUN.
x	MOVE INLINE TO SKL(SKLN).
	MOVE INLINE TO STARLINETEXT.

	WRITE OUTLINE FROM STARLINE.
	ADD 1 TO LINECOUNT.
 	GO TO BL21.
*BL29.
4	CLOSE INFILE.
>	IF SKLN = 0
H	  DISPLAY "SKELETON EMPTY" STOP RUN.
R	IF LIST-NUMBER < 2
\	  DISPLAY "? NO LISTS" STOP RUN.
f	MOVE 0 TO N.
pVP0.
z	ADD 1 TO N.
	IF N = LIST-NUMBER GO TO XEXIT.
	IF LIST-TYPE(N) NOT = "I" GO TO VP0.
	GO TO VP2.
"VP1.
,	ADD 1 TO N.
6	IF N = LIST-NUMBER GO TO XEXIT.
@	IF LIST-TYPE(N) NOT = "I" GO TO VP1.
J	ADD 1 TO LIST-COUNT(N).
TVP2.
^	IF LIST-COUNT(N) > LIST-LENGTH(N)
h	  MOVE 1 TO LIST-COUNT(N) GO TO VP1.
r	MOVE 0 TO N.
|	PERFORM ITERATE.
X2.
	ADD 1 TO N.
	IF N NOT > SKLN GO TO X4.
$	MOVE 0 TO N.
.X3.
8	ADD 1 TO N.
B	IF LIST-TYPE(N) NOT = "I" GO TO X3.
L	ADD 1 TO LIST-COUNT(N).
V	GO TO VP2.
`X4.
j	MOVE SKL(N) TO TLINE.
t	PERFORM SENDING-ITEM-SET-UP VARYING I FROM 1 BY 1 UNTIL I > 20.
~	MOVE 0 TO I.
	MOVE 1 TO P.
X5.
	ADD 1 TO I.
&	UNSTRING TLINE DELIMITED BY "%" OR "!" OR "@" OR "#"
0 	  INTO SENDING-ITEM (I)
:	  DELIMITER IN DEL COUNT IN K WITH POINTER P.
D	IF P = 65 GO TO X25.
N	ADD 1 TO K.
X	STRING "\" DELIMITED BY SIZE
b	  INTO SENDING-ITEM (I) WITH POINTER K.
l	ADD 1 TO I.
v	IF DEL = "#" GO TO X20.
	IF DEL = "@" GO TO X15.

	IF DEL = "!" GO TO X10.
	IF DEL = "%" GO TO X8.
	DISPLAY "?X5" STOP RUN.
(X8.
2	UNSTRING TLINE INTO DIGIT WITH POINTER P.
<	MOVE LIST-COUNT(DIGIT) TO LIST-ENTRY.
F	SUBTRACT 1 FROM LIST-ENTRY.
P	ADD LIST-START(DIGIT) TO LIST-ENTRY.
Z	MOVE TNAME (LIST-ENTRY) TO SENDING-ITEM (I).
d	GO TO X5.
nX10.
x	UNSTRING TLINE INTO DIGIT DIGIT2
	  WITH  POINTER P.

	MOVE LIST-COUNT(DIGIT2) TO LIST-ENTRY.
	SUBTRACT 1 FROM LIST-ENTRY.
 	ADD LIST-START(DIGIT) TO LIST-ENTRY.
*	MOVE TNAME(LIST-ENTRY) TO SENDING-ITEM (I).
4	GO TO X5.
>X15.
H	MOVE EDITED-ITERATION TO SENDING-ITEM5CHARS (I).
R	GO TO X5.
\X20.
f	PERFORM STEPUP.
p	MOVE EDITED-STEP TO SENDING-ITEM5CHARS (I).
z	GO TO X5.
X25.
	STRING
	 SENDING-ITEM (1)
"	 SENDING-ITEM (2)
,	 SENDING-ITEM (3)
6	 SENDING-ITEM (4)
@	 SENDING-ITEM (5)
J	 SENDING-ITEM (6)
T	 SENDING-ITEM (7)
^	 SENDING-ITEM (8)
h	 SENDING-ITEM (9)
r	 SENDING-ITEM (10)
|	 SENDING-ITEM (11)
	 SENDING-ITEM (12)
	 SENDING-ITEM (13)
	 SENDING-ITEM (14)
$	 SENDING-ITEM (15)
.	 SENDING-ITEM (16)
8	 SENDING-ITEM (17)
B	 SENDING-ITEM (18)
L	 SENDING-ITEM (19)
V	 SENDING-ITEM (20)
`	  DELIMITED BY "\" INTO TLINE.
j	WRITE OUTLINE FROM TLINE.
t	ADD 1 TO LINECOUNT.
~	GO TO X2.
XEXIT.
	WRITE OUTLINE FROM ENDLINE.
	ADD 1 TO LINECOUNT.
&	CLOSE OUTFILE.
0	DISPLAY LINECOUNT " LINES GENERATED.".
:*+ THE FOLLOWING GO TO AND PARAGRAPH NAME ARE ADDED TO AVOID 
D*  THE ":" FUNCTION.
N	GO TO P0.
XRS0.
b*- END OF CHANGE.
l	MOVE OUTFILENAME TO INFILENAME.
v	MOVE "CBL" TO OFEXT.
	OPEN INPUT INFILE.

	OPEN OUTPUT OUTFILE.
RS1.
	READ INFILE INTO OUTLINE AT END GO TO X9.
(	MOVE 1 TO P.
2	IF REPLACESWITCH NOT = "1" GO TO TABOUT.
<	UNSTRING OUTLINE DELIMITED BY ":"
F	  INTO CHARS1 WITH POINTER P.
P	IF CHAR11 = "*" GO TO TABOUT.
Z	IF P = 65 GO TO TABOUT.
d	SUBTRACT 1 FROM P GIVING N.
n	STRING "\" DELIMITED BY SIZE
x	  INTO CHARS1 WITH POINTER N.
	UNSTRING OUTLINE INTO CHARS2 WITH POINTER P.

	DISPLAY OUTLINE.
	ACCEPT TEMPNAME.
 	STRING CHARS1 DELIMITED BY "\"
*	  TEMPNAME DELIMITED BY SPACE
4	  CHARS2 DELIMITED BY SIZE INTO OUTLINE.
>TABOUT.
H* IT SEEMS THAT THERE IS NO REAL NEED TO REMOVE TABS,
R* SO THE FOLLOWING STATEMENT SKIPS THE TABOUT CODE.
\	GO TO TB3.
fTB0.
p	MOVE SPACES TO TEMPNAME.
z	MOVE 1 TO P.
	UNSTRING OUTLINE DELIMITED BY TAB
	  INTO CHARS1 WITH POINTER P.
	IF P > 64 GO TO TB3.
"	SUBTRACT 1 FROM P GIVING N.
,	STRING "\" DELIMITED BY SIZE
6	  INTO CHARS1 WITH POINTER N.
@	MOVE P TO N.
J	UNSTRING OUTLINE INTO CHARS2 WITH POINTER N.
T	IF P < 5 SUBTRACT P FROM 7 GIVING P GO TO TB1.
^	IF P < 13 SUBTRACT P FROM 15 GIVING P GO TO TB1.
h	IF P < 21 SUBTRACT P FROM 23 GIVING P GO TO TB1.
r	IF P < 29 SUBTRACT P FROM 31 GIVING P GO TO TB1.
|	IF P < 37 SUBTRACT P FROM 39 GIVING P GO TO TB1.
	IF P < 45 SUBTRACT P FROM 47 GIVING P GO TO TB1.
	IF P < 53 SUBTRACT P FROM 55 GIVING P GO TO TB1.
	IF P < 61 SUBTRACT P FROM 63 GIVING P GO TO TB1.
$	IF P < 65 SUBTRACT P FROM 67 GIVING P GO TO TB1.
.TB1.
8	STRING "\" DELIMITED BY SIZE
B	  INTO TEMPNAME WITH POINTER P.
L	STRING CHARS1 TEMPNAME DELIMITED BY "\"
V	  CHARS2 DELIMITED BY SIZE INTO OUTLINE.
`	GO TO TABOUT.
jTB3.
t	WRITE OUTLINE.
~	GO TO RS1.
X9.
	CLOSE INFILE WITH DELETE.
	CLOSE OUTFILE.
&	GO TO P0.
0ITERATE.
:	ADD 1 TO ITERATION.
D	MOVE ITERATION TO RIGHT-EDIT.
N	UNSTRING RIGHT-EDITX DELIMITED BY ALL SPACE
X	  INTO JUNK EDITED-ITERATION.
b	EXAMINE EDITED-ITERATION REPLACING ALL SPACE BY "\".
lSTEPUP.
v	ADD 1 TO STEP.
	MOVE STEP TO RIGHT-EDIT.

	UNSTRING RIGHT-EDITX DELIMITED BY ALL SPACE
	  INTO JUNK EDITED-STEP.
	EXAMINE EDITED-STEP REPLACING ALL SPACE BY "\".
(SENDING-ITEM-SET-UP.
2	MOVE "\    " TO SENDING-ITEM5CHARS (I).

* 20 NOV 75
ID DIVISION.
PROGRAM-ID. SHORTL.
(*	SHORTENS .LOG FILES BY REMOVING ALL THE GARBAGE.
2ENVIRONMENT DIVISION.
<INPUT-OUTPUT SECTION.
FFILE-CONTROL.
P	SELECT INFILE ASSIGN TO DSK.
Z	SELECT OUTFILE ASSIGN TO DSK.
dDATA DIVISION.
nFILE SECTION.
xFD	INFILE VALUE OF ID IS INFILENAME.
01	INREC DISPLAY-7.

	03  TABS	PIC XX.
	88  TABTAB VALUE "		".
 	03  JOBFIELD.
*	88  JOBLINE	VALUE ";$JOB".
4	    05 FILLER	PIC X.
>	    88 TABTABQUESTION VALUE "?".
H	    05 FILLER	PIC XXXX.
R	03  FILLER	PIC XX.
\	03  INCODE	PIC X.
f	88  MONTR	VALUE "M" "T" "F" "B".
p	88  BATCH	VALUE "B" "T" "F".
z	88  USER	VALUE "U".
	03  FILLER	PIC X(4).
	03  USERLINE.
	    05  CHR1	PIC X.
"	    05  MONTRLINE.
,		07  CHRS2TO7.
6			88 KJOB VALUE "..K/F".
@		 08 CHR23.
J		    09  CHR2	PIC X.
T		    09  FILLER	PIC X.
^		 08  FILLER	PIC X(4).
h		07  FILLER	PIC X(61).
rFD	OUTFILE VALUE OF ID IS OUTFILENAME.
|1	OUTREC DISPLAY-7 PIC X(82).
WORKING-STORAGE SECTION.
1	STARTMARK	PIC S9(10) COMP.
1	ENDMARK		PIC S9(10) COMP.
$1	MONTRMARK	PIC S9(10) COMP.
.1	QUESTIONMARK	PIC S9(10) COMP.
81	CURRENTLINE	PIC S9(10) COMP.
B1	RESPONSE	PIC X.
L	88 NOPE VALUE "N".
V	88 LEGALRESPONSE VALUE "N" "Y".
`1	INFILENAME.
j	3  FILENAME	PIC X(6).
t	3  FILLER	PIC XXX VALUE "LOG".
~1	OUTFILENAME.
	3 OUTNAME	PIC XXXXXX.
	3 FILLER	PIC XXX VALUE "SLG".
1	PTR	PIC S9(5) COMP VALUE 1.
&1	FILENAMESTRING PIC X(72) DISPLAY-7.
0PROCEDURE DIVISION.
:P1.
D	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
N	ACCEPT RESPONSE.
X	IF NOT LEGALRESPONSE
b	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
l	  GO TO P1.
v	DISPLAY "NAMES OF .LOG FILES: ".
	ACCEPT FILENAMESTRING.

	MOVE 1 TO PTR.
P2.
	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
(	  INTO FILENAME WITH POINTER PTR.
2	IF FILENAME = SPACE GO TO P1.
<	MOVE FILENAME TO OUTNAME.
F	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
P	MOVE 10000 TO ENDMARK.
Z	IF NOPE GO TO P4.
d
n*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
x
	OPEN INPUT INFILE.

P3.
	READ INFILE AT END GO TO P3C.
 	IF MONTR PERFORM 20-TO-10.
*	ADD 1 TO CURRENTLINE.
4	IF MONTR AND CHR2 = "."
>	  NEXT SENTENCE ELSE GO TO P3A.
H	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
R	  GO TO P3.
\*	  IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
f*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
p	IF BATCH OR CHRS2TO7 = "..ST" OR ".ST" OR "." GO TO P3.
z	MOVE CURRENTLINE TO MONTRMARK.
	GO TO P3.
P3A.
	IF TABTABQUESTION GO TO P3B.
"	IF USER AND CHR1 = "?"
,	  GO TO P3B.
6	IF MONTR AND CHR2 = "?"
@	  GO TO P3B.
J	GO TO P3.
TP3B.
^	IF STARTMARK = 0
h	  MOVE MONTRMARK TO STARTMARK.
r	MOVE CURRENTLINE TO QUESTIONMARK.
|	GO TO P3.
P3C.
	MOVE MONTRMARK TO ENDMARK.
	MOVE 0 TO CURRENTLINE.
$	CLOSE INFILE.
.	IF STARTMARK = 0
8	  DISPLAY "NO ?'S FOUND IN " FILENAME
B	  GO TO P2.
LP4.
V	OPEN INPUT INFILE.
`	OPEN OUTPUT OUTFILE.
jP5.
t	READ INFILE AT END GO TO P95.
~	ADD 1 TO CURRENTLINE.
		IF NOT JOBLINE GO TO P5.
		IF CURRENTLINE < STARTMARK GO TO P10.
		IF CURRENTLINE > ENDMARK GO TO P99.
	&	MOVE "\\" TO TABS.
	0	WRITE OUTREC FROM INREC.
	:P10.
	D	READ INFILE AT END GO TO P99.
	N	ADD 1 TO CURRENTLINE
	X	IF CURRENTLINE < STARTMARK GO TO P10.
	b	IF CURRENTLINE > ENDMARK GO TO P99.
	l	IF KJOB GO TO P99.
	v	IF TABTAB

	  MOVE "\\" TO TABS


	  WRITE OUTREC FROM INREC

	  GO TO P10.

	IF MONTR AND CHRS2TO7 NOT = SPACE

(	  PERFORM 20-TO-10

2	  WRITE OUTREC FROM MONTRLINE GO TO P10.

<	IF USER AND USERLINE NOT = SPACE

F	  WRITE OUTREC FROM USERLINE GO TO P10.

P	GO TO P10.

ZP95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.

dP99.	CLOSE INFILE OUTFILE.

n	DISPLAY FILENAME ".SLG WRITTEN" GO TO P2.

x20-TO-10.
	IF CHR1 = "@" MOVE "." TO CHR1.

	IF CHR2 = "@" MOVE "." TO CHR2.
	IF CHR23 = ".@" MOVE ".." TO CHR23.

ID DIVISION.
PROGRAM-ID. RR74DL.
ENVIRONMENT DIVISION.
(CONFIGURATION SECTION.
2SOURCE-COMPUTER. DECSYSTEM-20.
<OBJECT-COMPUTER. DECSYSTEM-20.
FINPUT-OUTPUT SECTION.
PFILE-CONTROL .
Z	SELECT RANE ASSIGN TO DSK
d	ORGANIZATION IS RELATIVE
n	ACCESS IS RANDOM
x	RELATIVE KEY IS RANKEY
	RECORDING MODE IS ASCII.

	SELECT RAN1 ASSIGN TO DSK
 	ORGANIZATION IS RELATIVE
*	ACCESS IS RANDOM
4	RELATIVE KEY IS RNKEY1
>	RECORDING MODE IS ASCII.
H
R	SELECT RAN2 ASSIGN TO DSK
\	ORGANIZATION IS RELATIVE
f	ACCESS IS RANDOM
p	RELATIVE KEY IS RNKEY2
z	RECORDING MODE IS ASCII.

	SELECT ISM ASSIGN TO DSK
	ORGANIZATION IS INDEXED
"	ACCESS MODE IS RANDOM
,	RECORD KEY IS RKEY
6	RECORDING MODE IS ASCII.
@
J	SELECT RANSQ ASSIGN TO DSK
T	RECORDING MODE IS ASCII.
^
hDATA DIVISION.
rFILE SECTION.
|FD	RANE
	VALUE OF ID IS "RANFILDAT"
	LABEL RECORD IS STANDARD.
01	RANREC	PIC X(10).
$
.FD	RAN1
8	VALUE OF ID IS "RANFL1DAT"
B	LABEL RECORD IS STANDARD.
L01	RNREC1	PIC X(10).
V
`FD	RAN2
j	VALUE OF ID IS "RANFL2DAT"
t	LABEL RECORD IS STANDARD.
~01	RNREC2	PIC X(10).

FD	ISM
	VALUE OF ID IS "ISMDATIDX"
&	BLOCK 2 RECORDS
0	LABEL RECORD IS STANDARD.
:01	ISMREC	.
D	02	REC2	PIC X(10).
N	02	RKEY	PIC X(5).
X
bFD	RANSQ
l	VALUE OF ID IS "RANSQ DAT"
v	BLOCK CONTAINS 5 RECORDS
	LABEL RECORD  STANDARD.

01	RECC.
	02	RECC1	PIC X(10).
	02	RECC2	PIC X(90).
(
2WORKING-STORAGE SECTION.
<01	END-COUNT	PIC S9(10) VALUE 0000000041.
F01	CHK-COUNT	PIC S9(10) VALUE 0000000001.
P77	REC-CNT PIC S9(10) COMP VALUE IS 22.
Z77	REC-CN1 PIC S9(10) COMP VALUE IS 22.
d77	REC-CN2 PIC S9(10) COMP VALUE IS 22.
n77	REC-CN3 PIC S9(10) COMP VALUE IS 22.
x77	REC-SQ PIC S9(10) COMP VALUE IS 22.
77	RANKEY	PIC 9(10).

77	RNKEY1	PIC 9(10).
77	RNKEY2	PIC 9(10).
 PROCEDURE DIVISION.
*	OPEN I-O RANSQ.
4
>	PERFORM SEQINI THRU SEQINIX.
H	PERFORM WRTSEQ THRU WRTSEQX 19 TIMES.
R
\	OPEN I-O RANE.
f
p	PERFORM WRTFIL 19 TIMES.
z
	OPEN I-O RAN1.

	PERFORM WRTFL1 19 TIMES.
"
,	OPEN I-O RAN2.
6
@	PERFORM WRTFL2 19 TIMES.
J
T	OPEN I-O ISM.
^
h	PERFORM WRTISM 19 TIMES.
r
|



$
.	GO TO DONE.
8
B
LWRTFIL.
V	MOVE REC-CNT TO RANKEY.
`	DELETE RANE, INVALID KEY GO TO WRT-ER.
j	ADD 1 TO REC-CNT.
t
~WRTFL1.
		MOVE REC-CN1 TO RNKEY1.
		DELETE RAN1, INVALID KEY GO TO WRT-ER.
		ADD 1 TO REC-CN1.
	&
	0WRTFL2.
	:	MOVE REC-CN2 TO RNKEY2
	D	DELETE RAN2, INVALID KEY GO TO WRT-ER.
	N	ADD 1 TO REC-CN2.
	X
	bWRTISM.
	l	MOVE REC-CN3 TO RKEY.
	v	DELETE ISM, INVALID KEY GO TO WRT-ER.

	ADD 1 TO REC-CN3.




WRTSEQ.

	READ RANSQ, AT END GO TO WRTSEQX.

(	MOVE 0000000000 TO RECC1.

2	REWRITE RECC.

<	ADD 1 TO REC-SQ.

FWRTSEQX.

P

ZSEQINI.

d	MOVE 1 TO REC-SQ.

nINI-LP.

x	READ RANSQ, AT END 
		DISPLAY "??ERROR READ SEQ INIT AT END RECORD ",REC-SQ

		GO TO DONE.
	ADD 1 TO REC-SQ.
 	IF REC-SQ < 22 GO TO INI-LP.
*
4SEQINIX.
>
H
R
\
f
p
zRDER.

	DISPLAY "???READ ERROR, KEY = ",RANKEY,RNKEY1,RNKEY2,RKEY.

	GO TO DONE.



"

,WRT-ER.

6	DISPLAY "???WRT-LOOP ERROR  ",RANKEY,RNKEY1,RNKEY2,RKEY,REC-SQ.

@

JDONE.

T

^	CLOSE  RANE,RAN1,RAN2,ISM,RANSQ.

h

r	STOP RUN.

ID DIVISION.
PROGRAM-ID. RR74RD.
ENVIRONMENT DIVISION.
(CONFIGURATION SECTION.
2SOURCE-COMPUTER. DECSYSTEM-20.
<OBJECT-COMPUTER. DECSYSTEM-20.
FINPUT-OUTPUT SECTION.
PFILE-CONTROL .
Z	SELECT RANE ASSIGN TO DSK
d	ORGANIZATION IS RELATIVE
n	ACCESS IS RANDOM
x	RELATIVE KEY IS RANKEY
	RECORDING MODE IS ASCII.

	SELECT RAN1 ASSIGN TO DSK
 	ORGANIZATION IS RELATIVE
*	ACCESS IS RANDOM
4	RELATIVE KEY IS RNKEY1
>	RECORDING MODE IS ASCII.
H
R	SELECT RAN2 ASSIGN TO DSK
\	ORGANIZATION IS RELATIVE
f	ACCESS IS RANDOM
p	RELATIVE KEY IS RNKEY2
z	RECORDING MODE IS ASCII.

	SELECT ISM ASSIGN TO DSK
	ORGANIZATION IS INDEXED
"	ACCESS MODE IS RANDOM
,	RECORD KEY IS RKEY
6	RECORDING MODE IS ASCII.
@
J	SELECT RANSQ ASSIGN TO DSK
T	RECORDING MODE IS ASCII.
^
hDATA DIVISION.
rFILE SECTION.
|FD	RANE
	VALUE OF ID IS "RANFILDAT"
	LABEL RECORD IS STANDARD.
01	RANREC	PIC X(10).
$
.FD	RAN1
8	VALUE OF ID IS "RANFL1DAT"
B	LABEL RECORD IS STANDARD.
L01	RNREC1	PIC X(10).
V
`FD	RAN2
j	VALUE OF ID IS "RANFL2DAT"
t	LABEL RECORD IS STANDARD.
~01	RNREC2	PIC X(10).

FD	ISM
	VALUE OF ID IS "ISMDATIDX"
&	BLOCK 2 RECORDS
0	LABEL RECORD IS STANDARD.
:01	ISMREC	.
D	02	REC2	PIC X(10).
N	02	RKEY	PIC X(5).
X
bFD	RANSQ
l	VALUE OF ID IS "RANSQ DAT"
v	BLOCK CONTAINS 5 RECORDS
	LABEL RECORD  STANDARD.

01	RECC.
	02	RECC1	PIC X(10).
	02	RECC2	PIC X(90).
(
2WORKING-STORAGE SECTION.
<01	ERR	PIC S9(10) COMP VALUE 0.
F	88	ALL-OK VALUE 0.
P01	END-COUNT	PIC S9(10) VALUE 0000000041.
Z01	CHK-COUNT	PIC S9(10) VALUE 0000000001.
d77	REC-CNT PIC S9(10) COMP VALUE IS 1.
n77	REC-CN1 PIC S9(10) COMP VALUE IS 1.
x77	REC-CN2 PIC S9(10) COMP VALUE IS 1.
77	REC-CN3 PIC S9(10) COMP VALUE IS 1.

77	REC-SQ PIC S9(10) COMP VALUE IS 1.
77	RANKEY	PIC 9(10).
 77	RNKEY1	PIC 9(10).
*77	RNKEY2	PIC 9(10).
4PROCEDURE DIVISION.
>
H	OPEN INPUT RANE,RAN1,RAN2,ISM,RANSQ.
R	
\	MOVE 00001 TO RANKEY,RNKEY1,RNKEY2,CHK-COUNT,RKEY.
f	READ RANE, INVALID KEY GO TO RDER.
p	READ RAN1, INVALID KEY GO TO RDER.
z	READ RAN2, INVALID KEY GO TO RDER.
	READ ISM, INVALID KEY GO TO RDER.
	READ RANSQ, AT END GO TO RDER.

"	PERFORM READ-CHECK.
,
6*	DISPLAY RANKEY,"  KEY ",RANREC, "  REC AFTER READ".
@*	DISPLAY RNKEY1,"  KEY ",RNREC1, "  REC AFTER READ".
J*	DISPLAY RNKEY2,"  KEY ",RNREC2, "  REC AFTER READ".
T*	DISPLAY RKEY,"  KEY ",REC2, "  REC AFTER READ".
^*	DISPLAY RKEY,"  KEY ",RECC1, "  REC AFTER READ".
h
rRD-LPP.
|	ADD 1 TO CHK-COUNT.

	READ RAN1 NEXT, AT END
		PERFORM END-CHECK
$		 GO TO RD21.
.RD21.
8	READ RAN2 NEXT, AT END
B		PERFORM END-CHECK
L		 GO TO RD23.
VRD23.
`	READ RANE NEXT, AT END
j		PERFORM END-CHECK
t		 GO TO RD24.
~RD24.
		READ ISM NEXT, AT END
			PERFORM END-CHECK
			 GO TO RD25.
	&RD25.
	0	READ RANSQ, AT END GO TO RD22.
	:
	D*	DISPLAY "......".
	N*
	X*	DISPLAY "RD NEXT ",RANREC,"  KEY ",RANKEY.
	b*	DISPLAY "RD NEXT ",RNREC1,"  KEY ",RNKEY1.
	l*	DISPLAY "RD NEXT ",RNREC2,"  KEY ",RNKEY2.
	v*	DISPLAY "RD NEXT ",REC2,"  KEY ",RKEY.

*	DISPLAY "RD NEXT ",RECC1,"  KEY ",RKEY.




	PERFORM READ-CHECK.



(	GO TO RD-LPP.

2RD22.

<	

F	PERFORM END-CHECK.

P	IF ALL-OK

Z		DISPLAY "ALL CHECKED AND FOUND OK.".

d	GO TO DONE.

n

x



 READ-CHECK.
*
4	IF	CHK-COUNT NOT = RANREC OR
>		RANREC NOT = RNREC1 OR
H		RNREC1 NOT = RNREC2 OR
R		RNREC2 NOT = REC2 OR
\		REC2 NOT = RECC1 
f
p	 ADD 1 TO ERR
z	 DISPLAY

		"???ERROR READING FILES AT RECORD NUMBER ",CHK-COUNT.



END-CHECK.

"

,	IF CHK-COUNT NOT = END-COUNT

6		ADD 1 TO ERR

@		DISPLAY "???ERROR AT READ END RECORD NUMBER ",CHK-COUNT.

J

T

^

h

rRDER.

|	DISPLAY "???READ ERROR, KEY = ",RANKEY,RNKEY1,RNKEY2,RKEY.
O TO DONE.


.
PLAY "???WRT-LOOP ERROR  ",RANKEY,RNKEY1,RNKEY2,RKEY,REC-SQ.



  RANE,RAN1,RAN2,ISM,RANSQ.

RUN.

ID DIVISION.
PROGRAM-ID. RR74WT.
ENVIRONMENT DIVISION.
(CONFIGURATION SECTION.
2SOURCE-COMPUTER. DECSYSTEM-20.
<OBJECT-COMPUTER. DECSYSTEM-20.
FINPUT-OUTPUT SECTION.
PFILE-CONTROL .
Z	SELECT RANE ASSIGN TO DSK
d	ORGANIZATION IS RELATIVE
n	ACCESS IS RANDOM
x	RELATIVE KEY IS RANKEY
	RECORDING MODE IS ASCII.

	SELECT RAN1 ASSIGN TO DSK
 	ORGANIZATION IS RELATIVE
*	ACCESS IS RANDOM
4	RELATIVE KEY IS RNKEY1
>	RECORDING MODE IS ASCII.
H
R	SELECT RAN2 ASSIGN TO DSK
\	ORGANIZATION IS RELATIVE
f	ACCESS IS RANDOM
p	RELATIVE KEY IS RNKEY2
z	RECORDING MODE IS ASCII.

	SELECT ISM ASSIGN TO DSK
	ORGANIZATION IS INDEXED
"	ACCESS MODE IS RANDOM
,	RECORD KEY IS RKEY
6	RECORDING MODE IS ASCII.
@
J	SELECT RANSQ ASSIGN TO DSK
T	RECORDING MODE IS ASCII.
^
hI-O-CONTROL.
r	RERUN EVERY 21 RECORDS OF RANE.
|	RERUN EVERY 21 RECORDS OF RAN1.
	RERUN EVERY 21 RECORDS OF RANSQ.
	RERUN EVERY 21 RECORDS OF ISM.
DATA DIVISION.
$FILE SECTION.
.FD	RANE
8	VALUE OF ID IS "RANFILDAT"
B	LABEL RECORD IS STANDARD.
L01	RANREC	PIC X(10).
V
`FD	RAN1
j	VALUE OF ID IS "RANFL1DAT"
t	LABEL RECORD IS STANDARD.
~01	RNREC1	PIC X(10).

FD	RAN2
	VALUE OF ID IS "RANFL2DAT"
&	LABEL RECORD IS STANDARD.
001	RNREC2	PIC X(10).
:
DFD	ISM
N	VALUE OF ID IS "ISMDATIDX"
X	BLOCK 2 RECORDS
b	LABEL RECORD IS STANDARD.
l01	ISMREC	.
v	02	REC2	PIC X(10).
	02	RKEY	PIC X(5).


FD	RANSQ
	VALUE OF ID IS "RANSQ DAT"
(	BLOCK CONTAINS 5 RECORDS
2	LABEL RECORD  STANDARD.
<01	RECC.
F	02	RECC1	PIC X(10).
P	02	RECC2	PIC X(90).
Z
dWORKING-STORAGE SECTION.
n01	END-COUNT	PIC S9(10) VALUE 0000000041.
x01	CHK-COUNT	PIC S9(10) VALUE 0000000001.
77	REC-CNT PIC S9(10) COMP VALUE IS 1.

77	REC-CN1 PIC S9(10) COMP VALUE IS 1.
77	REC-CN2 PIC S9(10) COMP VALUE IS 1.
 77	REC-CN3 PIC S9(10) COMP VALUE IS 1.
*77	REC-SQ PIC S9(10) COMP VALUE IS 1.
477	RANKEY	PIC 9(10).
>77	RNKEY1	PIC 9(10).
H77	RNKEY2	PIC 9(10).
RPROCEDURE DIVISION.
\	OPEN OUTPUT RANE.
f
p	PERFORM WRTFIL 20 TIMES.
z
	OPEN OUTPUT RAN1.

	PERFORM WRTFL1 20 TIMES.
"
,	OPEN OUTPUT RAN2.
6
@	PERFORM WRTFL2 20 TIMES.
J
T	OPEN OUTPUT ISM.
^
h	PERFORM WRTISM 20 TIMES.
r
|	OPEN OUTPUT RANSQ.

	PERFORM WRTSEQ 20 TIMES.

$	DISPLAY " NOW RERUNING ,ALL OPEN".
.
8
B	PERFORM WRTFILS 20 TIMES.
L
V
`
j
t	GO TO DONE.
~
	
	WRTFILS.
		PERFORM WRTFIL.
	&	PERFORM WRTFL1.
	0	PERFORM WRTFL2.
	:	PERFORM WRTISM.
	D	PERFORM WRTSEQ.
	N
	X
	b
	lWRTFIL.
	v	MOVE REC-CNT TO RANKEY,RANREC.

	WRITE RANREC, INVALID KEY GO TO WRT-ER.


	ADD 1 TO REC-CNT.



WRTFL1.

(	MOVE REC-CN1 TO RNKEY1,RNREC1.

2	WRITE RNREC1, INVALID KEY GO TO WRT-ER.

<	ADD 1 TO REC-CN1.

F

PWRTFL2.

Z	MOVE REC-CN2 TO RNKEY2,RNREC2.

d	WRITE RNREC2, INVALID KEY GO TO WRT-ER.

n	ADD 1 TO REC-CN2.

x
WRTISM.

	MOVE REC-CN3 TO RKEY,REC2.
	WRITE ISMREC, INVALID KEY GO TO WRT-ER.
 	ADD 1 TO REC-CN3.
*
4WRTSEQ.
>	MOVE REC-SQ TO RECC1.
H	WRITE RECC.
R	ADD 1 TO REC-SQ.
\
f
p
zWRT-ER.

	DISPLAY "???WRT-LOOP ERROR  ",RANKEY,RNKEY1,RNKEY2,RKEY,REC-SQ.



DONE.

"

,	CLOSE  RANE,RAN1,RAN2,ISM,RANSQ.

6

@	STOP RUN.

	TITLE SETEOF

	SEARCH MACSYM,MONSYM
(	.REQUIRE SYS:MACREL
2	SALL
<
F	SUBTTL LARRY CAMPBELL
P
Z;AC DEFINITIONS
dT1=1
nT2=2
xT3=3
T4=4

P1=5
P2=6
 P3=7
*P4=10
4P=17
>
H
R;PARAMETERS
\PDLLEN==50
f
p;IMPURE STORAGE
zPDL:	BLOCK PDLLEN


;START HERE
"
,SETEOF:	RESET
6	MOVE P,[IOWD PDLLEN,PDL]
@	TMSG <Size to set file(s) to: >
J	MOVX T1,.PRIIN
T	MOVEI T3,^D10
^	NIN
h	 ERMSG
r	MOVEM T2,FILSIZ#
|	TMSG <File(s) to set: >
	MOVX T1,GJ%OLD!GJ%FNS!GJ%SHT!GJ%CFM!GJ%IFG
	SETO T2,
	GTJFN
$	 ERMSG
.	MOVEM T1,JFN#
8
BFILOOP:	HRLI T1,12
L	SETO T2,
V	MOVE T3,FILSIZ
`	CHFDB
j	 ERMSG
t	MOVE T1,JFN
~	GNJFN
	 JRST DONE
	JRST FILOOP

&DONE:	TMSG <
0All done!
:>
D	HALTF
N	JRST SETEOF
X
b
l
v	END SETEOF

* 26 JAN 77
ID DIVISION.
PROGRAM-ID. SETUP.
(* A PROGRAM TO CONVERT THE EXISTING .CTL FILES STORED ON .LIB FILES
2* IN THE COBOL TEST SYSTEM TO "COMMON CONTROL FILE" FORMAT.
<*  TO 10 OR 20 FORMAT, AS REQUESTED BY USER.
F*
P
Z
dENVIRONMENT DIVISION.
nI-O SECTION.
xFILE-CONTROL.
	SELECT INFILE

	  ASSIGN TO DSK RECORDING MODE ASCII.
	SELECT OUTFILE
 	  ASSIGN TO DSK RECORDING MODE ASCII.
*	SELECT CTLFILE
4	  ASSIGN TO DSK RECORDING MODE ASCII.
>	SELECT DCYFILE
H	  ASSIGN TO DSK RECORDING MODE ASCII.
RDATA DIVISION.
\FILE SECTION.
fFD	INFILE
p	VALUE OF ID INFILENAME.
z1	INREC DISPLAY-7.
  02  FIRSTNINE.
    88 DEFDSK VALUE  "@DEF SYS:".
    88 RSETSRC VALUE ".R SETSRC".
"	3 FIRSTFOURCHARS.
,	  88 STAR-SYS  VALUE  "*SYS".
6
@	  88 20-LOGOUT VALUE  "@LOG".
J	      9 FIRSTCHAR	PIC X.
T		88 FOR-BOTH   VALUE "B".
^		88 FOR-10     VALUE ".".
h		88 FOR-20     VALUE "@".
r	      9  COMMAND-CHARS PIC X(3).
|			88 DELETE-CMD VALUE 'DEL'.

	3 LASTFIVE PIC X(5).
  02  OTHERNINE REDEFINES FIRSTNINE.
$	3 FIRSTWOCHARS PIC X(2).
.	88 LIBID-LINE VALUE '*='.
8	3 LASTSEVEN PIC X(7).
B  02  RESTCHARS PIC X(55).
L
V
`FD	OUTFILE
j	VALUE OF ID OUTFILENAME.
t1	OUTREC DISPLAY-7.
~	3 OUTCHAR	PIC X.
	3 OUTSKIP	PIC X(63).
1	OUTREC01 PIC X(01) DISPLAY-7.
1	OUTREC02 PIC X(02) DISPLAY-7.
&1	OUTREC03 PIC X(03) DISPLAY-7.
01	OUTREC04 PIC X(04) DISPLAY-7.
:1	OUTREC05 PIC X(05) DISPLAY-7.
D1	OUTREC06 PIC X(06) DISPLAY-7.
N1	OUTREC07 PIC X(07) DISPLAY-7.
X1	OUTREC08 PIC X(08) DISPLAY-7.
b1	OUTREC09 PIC X(09) DISPLAY-7.
l1	OUTREC10 PIC X(10) DISPLAY-7.
v1	OUTREC11 PIC X(11) DISPLAY-7.
1	OUTREC12 PIC X(12) DISPLAY-7.

1	OUTREC13 PIC X(13) DISPLAY-7.
1	OUTREC14 PIC X(14) DISPLAY-7.
1	OUTREC15 PIC X(15) DISPLAY-7.
(1	OUTREC16 PIC X(16) DISPLAY-7.
21	OUTREC17 PIC X(17) DISPLAY-7.
<1	OUTREC18 PIC X(18) DISPLAY-7.
F1	OUTREC19 PIC X(19) DISPLAY-7.
P1	OUTREC20 PIC X(20) DISPLAY-7.
Z1	OUTREC21 PIC X(21) DISPLAY-7.
d1	OUTREC22 PIC X(22) DISPLAY-7.
n1	OUTREC23 PIC X(23) DISPLAY-7.
x1	OUTREC24 PIC X(24) DISPLAY-7.
1	OUTREC25 PIC X(25) DISPLAY-7.

1	OUTREC26 PIC X(26) DISPLAY-7.
1	OUTREC27 PIC X(27) DISPLAY-7.
 1	OUTREC28 PIC X(28) DISPLAY-7.
*1	OUTREC29 PIC X(29) DISPLAY-7.
41	OUTREC30 PIC X(30) DISPLAY-7.
>1	OUTREC31 PIC X(31) DISPLAY-7.
H1	OUTREC32 PIC X(32) DISPLAY-7.
R1	OUTREC33 PIC X(33) DISPLAY-7.
\1	OUTREC34 PIC X(34) DISPLAY-7.
f1	OUTREC35 PIC X(35) DISPLAY-7.
p1	OUTREC36 PIC X(36) DISPLAY-7.
z1	OUTREC37 PIC X(37) DISPLAY-7.
1	OUTREC38 PIC X(38) DISPLAY-7.
1	OUTREC39 PIC X(39) DISPLAY-7.
1	OUTREC40 PIC X(40) DISPLAY-7.
"1	OUTREC41 PIC X(41) DISPLAY-7.
,1	OUTREC42 PIC X(42) DISPLAY-7.
61	OUTREC43 PIC X(43) DISPLAY-7.
@1	OUTREC44 PIC X(44) DISPLAY-7.
J1	OUTREC45 PIC X(45) DISPLAY-7.
T1	OUTREC46 PIC X(46) DISPLAY-7.
^1	OUTREC47 PIC X(47) DISPLAY-7.
h1	OUTREC48 PIC X(48) DISPLAY-7.
r1	OUTREC49 PIC X(49) DISPLAY-7.
|1	OUTREC50 PIC X(50) DISPLAY-7.
1	OUTREC51 PIC X(51) DISPLAY-7.
1	OUTREC52 PIC X(52) DISPLAY-7.
1	OUTREC53 PIC X(53) DISPLAY-7.
$1	OUTREC54 PIC X(54) DISPLAY-7.
.1	OUTREC55 PIC X(55) DISPLAY-7.
81	OUTREC56 PIC X(56) DISPLAY-7.
B1	OUTREC57 PIC X(57) DISPLAY-7.
L1	OUTREC58 PIC X(58) DISPLAY-7.
V1	OUTREC59 PIC X(59) DISPLAY-7.
`1	OUTREC60 PIC X(60) DISPLAY-7.
j1	OUTREC61 PIC X(61) DISPLAY-7.
t1	OUTREC62 PIC X(62) DISPLAY-7.
~1	OUTREC63 PIC X(63) DISPLAY-7.
	1	OUTREC64 PIC X(64) DISPLAY-7.
	1	OUTRECTEST DISPLAY-7.
		3 TESTFOUR.
	&	   5 O4	PIC XXXX OCCURS 16.
	0	3 TESTONE REDEFINES TESTFOUR.
	:	   5 O1	PIC X OCCURS 64.
	DFD	CTLFILE
	N	VALUE OF ID CTLFILENAME.
	X1	CTLREC	PIC X(72) DISPLAY-7.
	b1	CTL01 PIC X(01) DISPLAY-7.
	l1	CTL02 PIC X(02) DISPLAY-7.
	v1	CTL03 PIC X(03) DISPLAY-7.

1	CTL04 PIC X(04) DISPLAY-7.


1	CTL05 PIC X(05) DISPLAY-7.

1	CTL06 PIC X(06) DISPLAY-7.

1	CTL07 PIC X(07) DISPLAY-7.

(1	CTL08 PIC X(08) DISPLAY-7.

21	CTL09 PIC X(09) DISPLAY-7.

<1	CTL10 PIC X(10) DISPLAY-7.

F1	CTL11 PIC X(11) DISPLAY-7.

P1	CTL12 PIC X(12) DISPLAY-7.

Z1	CTL13 PIC X(13) DISPLAY-7.

d1	CTL14 PIC X(14) DISPLAY-7.

n1	CTL15 PIC X(15) DISPLAY-7.

x1	CTL16 PIC X(16) DISPLAY-7.
1	CTL17 PIC X(17) DISPLAY-7.

1	CTL18 PIC X(18) DISPLAY-7.
1	CTL19 PIC X(19) DISPLAY-7.
 1	CTL20 PIC X(20) DISPLAY-7.
*1	CTL21 PIC X(21) DISPLAY-7.
41	CTL22 PIC X(22) DISPLAY-7.
>1	CTL23 PIC X(23) DISPLAY-7.
H1	CTL24 PIC X(24) DISPLAY-7.
R1	CTL25 PIC X(25) DISPLAY-7.
\1	CTL26 PIC X(26) DISPLAY-7.
f1	CTL28 PIC X(28) DISPLAY-7.
p1	CTL30 PIC X(30) DISPLAY-7.
z1	CTL32 PIC X(32) DISPLAY-7.

1	CTL34 PIC X(34) DISPLAY-7.

1	CTL44 PIC X(44) DISPLAY-7.

1	CTL50 PIC X(50) DISPLAY-7.

"

,

6

@

JFD	DCYFILE

T	VALUE OF ID DCYFILENAME.

^1	DCYREC  PIC X(10).

hWORKING-STORAGE SECTION.

r1	I	PIC S9(10) COMP.

|1	J	PIC S9(10) COMP.
C S9(10) COMP.
ILENAME DISPLAY-7.
 CTLFILENAMEONLY	PIC XXXXXX.
LER		PIC XXX VALUE "CTL".
ILENAME DISPLAY-7.
FILENAMEIN	PIC XXXXXX.
LER	PIC XXX VALUE "XTT".
ILENAME DISPLAY-7.
 FILENAMEOUT	PIC XXXXXX.
LLER	PIC XXX VALUE "CTL".
ILENAME DISPLAY-7.
 DCYFILENAMEONLY PIC X(6).
FILLER  PIC XXX  VALUE "DCY".
1	PTR		PIC S9(10) COMP.
1	STRINGPTR	PIC S9(10) COMP.
1	FILENAMESTRING DISPLAY-7 PIC X(65).
&1	JOBLINE		PIC XXXXX DISPLAY-7 VALUE ";$JOB".
0******************************************          /\
:* CHANGED $JOB TO ;$JOB ON APRIL 14 1980 *          ||
D* TO REFLECT NEW REQUIREMENTS OF BATCON  *----------++
N* 		PWK			 *
X******************************************
b1	NOERRORLINE	PIC X(8) DISPLAY-7 VALUE "@NOERROR".
l1	10-NOERRORLINE	PIC X(8) DISPLAY-7 VALUE ".NOERROR".
v1	DEFLINE		PIC X(20) DISPLAY-7 VALUE "@DEF SYS: DSK:,SYS:".
1	10-SETSRCLINE	PIC X(9) DISPLAY-7 VALUE ".R SETSRC".

1	10-SYSLINE	PIC XXXX DISPLAY-7 VALUE "*SYS".
1	10-ASSIGNLINE	PIC X(12) DISPLAY-7 VALUE ".ASS DSK SYS".
1	EXELINE		PIC X(9) DISPLAY-7 VALUE "@RU SETUP".
(1	10-EXELINE	PIC X(9) DISPLAY-7 VALUE ".RU SETUP".
21	SYSTEMLINE DISPLAY-7.
<	3 FILLER	PIC X VALUE "*".
F	3 SYSTEMCHARS	PIC XX VALUE "10".
P	88 TOPS-10 VALUE "10".
Z	88 LEGALSYSTEM VALUE "10" "20".
d1	RLINE  PIC XX DISPLAY-7  VALUE "*C".
n1	EXPUNGELINE  PIC X(5) DISPLAY-7 VALUE "@EXPU".
x1	IDLINE PIC X(32)  DISPLAY-7 VALUE '@INFORMATION (ABOUT) DISK-USAGE'.
1	ILLINE PIC X(34) DISPLAY-7 VALUE '@INFORMATION (ABOUT) LOGICAL-NAMES'.

1	LIBARYLINE	PIC X(7) DISPLAY-7 VALUE "@LIBARY".
1	10-LIBARYLINE	PIC X(9) DISPLAY-7 VALUE ".R LIBARY".
 1	LOGOUTLINE	PIC X(7) DISPLAY-7 VALUE "@LOGOUT".
*1	KFLINE		PIC XXXX DISPLAY-7 VALUE ".K/F".
41	MASTER-LINE DISPLAY-7.
>	02 FILLER PIC X(2) VALUE '*='.
H	02 MASTER-NAME.
R		03 MASTER-SUBSYS-ID PIC X(3).
\		03 MASTER-MACHINE-ID PIC X(3) VALUE 'MAS'.
f1	SUBSTITUTE-LINE DISPLAY-7.
p	02 FILLER PIC X(2) VALUE '*='.
z	02 SUBSTITUTE-NAME.
		04 SUBSYS-ID PIC X(3).
		04 HOST-MACHINE-ID PIC X(3).
1	SUBSYS-LINE  DISPLAY-7.
"	03 FILLER PIC X VALUE '*'.
,	03 PUT-SUBSYS PIC X(3).
61	IN-LIBARYNAMELINE DISPLAY-7.
@	3 FILLER	PIC XX VALUE "*=".
J	3 IN-LIBARYNAME.
T		5 IN-SUBSYS PIC X(3).
^			88 QUITTING VALUE 'QIT'.
h		5 FILLER PIC X(3) VALUE 'COM'.
r1	OUT-LIBARYNAMELINE DISPLAY-7.
|	3 FILLER	PIC XX VALUE "*=".
	3 OUT-LIBARYNAME.
		5 OUT-SUBSYS PIC X(3).
		5 OUT-HOSTID PIC X(3).
$1	ENDLINE		PIC XXXX DISPLAY-7 VALUE "*END".
.1	NAMEHOLD2	PIC X(10) DISPLAY-7.
81	NAMEHOLD DISPLAY-7.
B	3 FILLER	PIC X(6).
L	3 LASTFEWCHARS	PIC XXXX.
V1	OLDNAMEHOLD	PIC X(10) DISPLAY-7.
`1	ON-A-LINE-FLAG PIC S9 COMP VALUE ZERO.
j		88 LINE-LIMIT VALUE 7.
t		88 LINE-EMPTY VALUE ZERO.
~1	LIBARYOPERATION PIC X(9) DISPLAY-7.
1	NAMEEXTENSION	PIC XXXX DISPLAY-7.
1	ERROREXIT	PIC 9 VALUE 0.
1	HOLD-CTL-NAMES		PIC X(66) DISPLAY-7.
&1	IDENTIFY-LIB-FLAG  PIC S9 COMP VALUE ZERO.
0	88	IN-LIB  VALUE  1.
:1	DELOUTLIB-LINE  DISPLAY-7.
D	  3 DELOUT-HOST-CHAR  PIC X  VALUE '@'.
N	  3 SYS-CMD  PIC X(4).
X	  3 FILLER  PIC X  VALUE SPACE.
b	  3 NAME-SLOT-1  PIC X(6)  JUSTIFIED RIGHT.
l	  3 FILLER  PIC X(4)  VALUE '.LIB'.
v	  3 ARG-DELIMITER  PIC X  VALUE SPACE.
	  3 NAME-SLOT-2  PIC X(6)  JUSTIFIED RIGHT.

	  3 FILLER  PIC X(5)  VALUE '.LIB '.
1  HOST-LINE  DISPLAY-7.
	02 FILLER PIC X VALUE "*".
(	02 HOST-CHARACTER PIC X.
2	88  HOST-10  VALUE ".".
<	88  HOST-20  VALUE "@".
F1	COMMENT-CHARACTER PIC X VALUE "!".
P1	SYS-COMMENT  PIC X(6)  DISPLAY-7    VALUE "! *SYS".
Z1	CHARS-XFRD-COUNT PIC  S99  COMP  VALUE ZERO.
d1	NAME-SUB  PIC S99  COMP  VALUE ZERO.
n	88 NAME-LIMIT  VALUE 99.
x1	CONTROLFILE-NAMES-TABLE.
	03 NAME-HOLD  PIC X(9)  OCCURS 99 TIMES.

1	ALT-NAMES-TABLE.
	03 ALT-NAME-HOLD  PIC X(9)  OCCURS 99 TIMES.
 1	NAME-TEMP.
*	02 N-T-3 PIC X(3).
4		88 MASTR-CTL VALUE 'MAS'.
>	02 FILLER PIC X(6).
H1	TERM PIC X(5).
R1	CM-NAME-TEMP PIC X(9).
\1	DEL-CTL-LINE  DISPLAY-7.
f	  3 DEL-CTL-HOST-CHAR  PIC X  VALUE '@'.
p	  3 FILLER  PIC X(4) VALUE 'DELE'.
z	  3 FILLER  PIC X  VALUE SPACE.
	  3 DEL-CTL-RIGHT PIC X(66).
1	COMMENT-OPTION-FLAG PIC S9 COMP VALUE ZERO.
	88 WANT-EXTRA-COMMENTS VALUE 1.
"
,
6
@
J1	MAILERLINE  DISPLAY-7.
T	02 MAILSTAR	PIC X VALUE '*'.
^	02 MAILLINE	PIC X(5) VALUE '@MAIL'.
h	02 MAILEX	PIC X(2) VALUE 'ER'.
r1	MAILSUBJECT DISPLAY-7 PIC X(24) VALUE '* CONVERSION JOB IS DONE'.
|1	MAILTERM DISPLAY-7.
	02 FILLER	PIC XX VALUE "*".
PROCEDURE DIVISION.
MAIN SECTION.
$START1.
.	DISPLAY "CONVERT TO [10] OR [20]?  "  WITH NO ADVANCING
8	ACCEPT SYSTEMCHARS.
B	IF NOT LEGALSYSTEM
L	  DISPLAY "INPUT '10' OR '20'"
V	  GO TO START1.
`	IF TOPS-10
j		MOVE '010' TO OUT-HOSTID
t		MOVE '.' TO 	HOST-CHARACTER,
~				DELOUT-HOST-CHAR,
				DEL-CTL-HOST-CHAR
		ELSE MOVE '@' TO HOST-CHARACTER
			MOVE '020' TO OUT-HOSTID.
&
0
:GET-MODE.
D	DISPLAY "[I]NITIATE OR [C]ONVERT MODE?  "  WITH NO ADVANCING
N	ACCEPT FILENAMESTRING.
X	IF FILENAMESTRING = "I" GO TO CTL-INIT.
b	IF FILENAMESTRING = "C" GO TO PART2.
l	DISPLAY "REPLY WITH 'I' OR 'C'".
v	GO TO GET-MODE.


CTL-INIT.
	DISPLAY "NAME OUTPUT CONTROL FILE  " WITH NO ADVANCING
	ACCEPT CTLFILENAMEONLY.
(	OPEN OUTPUT CTLFILE.
2
<	WRITE CTL05 FROM JOBLINE.
F	IF TOPS-10
P	  WRITE CTL08 FROM 10-NOERRORLINE
Z	  WRITE CTL09 FROM 10-SETSRCLINE
d	  WRITE CTL04 FROM 10-SYSLINE
n	  WRITE CTL12 FROM 10-ASSIGNLINE
x	  GO TO NEXTLIBS.
	WRITE CTL08 FROM NOERRORLINE.

	WRITE CTL20 FROM DEFLINE.

 NEXTLIBS.
*	DISPLAY "NAME THE SUBSYSTEM  " WITH NO ADVANCING
4	ACCEPT IN-SUBSYS.
>	IF QUITTING GO TO WINDUP.
H	MOVE IN-SUBSYS TO OUT-SUBSYS, MASTER-SUBSYS-ID.
R
\
fOPEN-UP.
p	MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
z	OPEN  INPUT DCYFILE.

	MOVE SPACES TO NAME-SLOT-2.
	MOVE OUT-LIBARYNAME TO NAME-SLOT-1.
"	MOVE "DELE" TO SYS-CMD.
,	WRITE CTL16 FROM DELOUTLIB-LINE.
6
@	IF TOPS-10
J		MOVE '=' TO ARG-DELIMITER
T		MOVE OUT-LIBARYNAME TO NAME-SLOT-1
^		MOVE IN-LIBARYNAME TO NAME-SLOT-2
h	ELSE
r		MOVE IN-LIBARYNAME TO NAME-SLOT-1
|		MOVE OUT-LIBARYNAME TO NAME-SLOT-2.
	MOVE "COPY" TO SYS-CMD.
	WRITE CTL28 FROM DELOUTLIB-LINE.
	MOVE SPACE TO ARG-DELIMITER.
$	PERFORM STACK-CONTROLFILE-NAMES.
.
8LIB-EXTRACT.
B	MOVE "*EXTRACT" TO LIBARYOPERATION.
L	MOVE ".XTT" TO NAMEEXTENSION.
V	MOVE 0 TO ERROREXIT.
`	SET IDENTIFY-LIB-FLAG TO 1.
j	PERFORM LIBARYCOMMAND.
t	SET IDENTIFY-LIB-FLAG TO ZERO.
~	IF ERROREXIT = 1 
	  CLOSE CTLFILE
	  STOP RUN.

&
0MOD-EXE.
:	IF TOPS-10
D	  WRITE CTL09 FROM 10-EXELINE
N	ELSE
X	  WRITE CTL09 FROM EXELINE.
b	WRITE CTL03 FROM SYSTEMLINE.
l	WRITE CTL02 FROM RLINE.
v
	MOVE IN-SUBSYS TO PUT-SUBSYS.

	WRITE CTL04 FROM SUBSYS-LINE.
LIB-REPLACE.
	MOVE "*REPLACE" TO LIBARYOPERATION.
(	MOVE ".CTL" TO NAMEEXTENSION.
2	PERFORM LIBARYCOMMAND.
<	WRITE CTL04 FROM ENDLINE.
F
P
ZDELETE-AND-EXPUNGE.
d	PERFORM DELETE-CTLS.
n
x	IF NOT TOPS-10 WRITE CTL05 FROM EXPUNGELINE.


GO-BACK.
 
*	CLOSE DCYFILE
4	GO TO NEXTLIBS.
>
H
RWINDUP.
\	IF TOPS-10
f	  WRITE CTL04 FROM KFLINE
p		ELSE
z	WRITE CTL05 FROM MAILLINE
 	WRITE CTL08 FROM MAILERLINE
 	WRITE CTL01 FROM MAILSTAR
 	WRITE CTL24 FROM MAILSUBJECT
 "	WRITE CTL02 FROM MAILTERM
 ,	  WRITE CTL07 FROM LOGOUTLINE.
 6	CLOSE CTLFILE .
 @
 J	DISPLAY  "END OF SETUP INITIATE SESSION".
 T	STOP RUN.
 ^DELETE-CTLS SECTION.
 hDC-INIT.
 r	SET PTR TO 1.
 |	SET NAME-SUB TO 1.
!
!DC-LINE-START.
!	MOVE SPACES TO HOLD-CTL-NAMES, DEL-CTL-RIGHT.
!$	SET ON-A-LINE-FLAG TO ZERO.
!.
!8DC-LOOP.
!B	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
!L	IF NAME-TEMP EQUALS SPACES GO TO DC-EXIT.
!V	IF MASTR-CTL GO TO DC-L1.
!`	IF NAME-TEMP EQUALS MASTER-NAME
!j		MOVE '.XTT,' TO TERM
!t	ELSE
!~		MOVE '.*,' TO TERM.
"	
"	STRING NAME-TEMP TERM
"		DELIMITED BY SPACE
"&		INTO HOLD-CTL-NAMES
"0		WITH POINTER PTR.
":	SET ON-A-LINE-FLAG UP BY 1.
"D	IF NAME-LIMIT GO TO DC-EXIT.
"NDC-L1.
"X	SET NAME-SUB UP BY 1.
"b	IF LINE-LIMIT GO TO DC-PUT.
"l
"v	GO TO DC-LOOP.
#
#
DC-PUT.
#	PERFORM SPECIAL-PUT.
#	GO TO DC-LINE-START.
#(
#2DC-EXIT.
#<	IF NOT LINE-EMPTY
#F		PERFORM SPECIAL-PUT.
#P
#Z
#dSPECIAL-PUT SECTION.
#n	STRING HOLD-CTL-NAMES
#x		DELIMITED BY ', '
$		INTO DEL-CTL-RIGHT.
$
	SET PTR TO 1.
$	WRITE CTLREC FROM DEL-CTL-LINE.
$ STACK-CONTROLFILE-NAMES SECTION.
$*SCN-START.
$4	MOVE SPACES TO CONTROLFILE-NAMES-TABLE.
$>	MOVE SPACES TO ALT-NAMES-TABLE.
$H	SET NAME-SUB TO 1.
$R
$\
$fGET-NEXT-NAME.
$p	READ DCYFILE
$z		AT END
%		GO TO SCN-EXIT.
%
%	MOVE 1 TO PTR.
%"	UNSTRING DCYREC INTO NAME-TEMP WITH POINTER PTR.
%,	MOVE 1 TO PTR.
%6	UNSTRING NAME-TEMP DELIMITED BY 'CM '
%@		INTO CM-NAME-TEMP WITH POINTER PTR.
%J	IF NAME-TEMP EQUALS CM-NAME-TEMP
%T		GO TO GET-NEXT-NAME.
%^
%h
%r	MOVE NAME-TEMP TO NAME-HOLD (NAME-SUB).
%|	MOVE CM-NAME-TEMP TO ALT-NAME-HOLD (NAME-SUB).
&
&	IF NAME-LIMIT 
&		DISPLAY "NAME LIMIT EXCEEDED"
&$		GO TO SCN-EXIT.
&.	SET NAME-SUB UP BY 1.
&8	GO TO GET-NEXT-NAME.
&B
&L
&VSCN-EXIT.
&`	EXIT.
&j
&t
&~
'LIBARYCOMMAND SECTION.
'P0.
'	IF TOPS-10 WRITE CTL09 FROM 10-LIBARYLINE
'&	ELSE
'0	  WRITE CTL07 FROM LIBARYLINE.
':	IF IN-LIB
'D		WRITE CTL08 FROM IN-LIBARYNAMELINE
'N		ELSE
'X		WRITE CTL08 FROM OUT-LIBARYNAMELINE.
'b	MOVE SPACE TO OLDNAMEHOLD.
'l	SET NAME-SUB TO 1.
'v
(NEXT-CTL.
(
	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAMEHOLD.
(	IF NAMEHOLD = SPACE GO TO LIB-EXIT.
(	MOVE 1 TO STRINGPTR.
((	MOVE SPACES TO CTLREC.
(2	MOVE NAME-HOLD (NAME-SUB) TO NAMEHOLD2.
(<	MOVE SPACES TO LASTFEWCHARS OF NAMEHOLD.
(F	STRING LIBARYOPERATION
(P		" "
(Z		NAMEHOLD2
(d		","
(n		NAMEHOLD
(x		NAMEEXTENSION DELIMITED BY "  "
)	  INTO CTLREC WITH POINTER STRINGPTR.
)
	WRITE CTL30.
)	IF NAME-LIMIT
) 		GO TO LIB-EXIT.
)*	SET NAME-SUB UP BY 1.
)4	GO TO NEXT-CTL.
)>
)H
)RLIB-EXIT.
)\	EXIT.
)f
)pPART2 SECTION.
)zSTART-RUNMODE.
*	DISPLAY "NAME THE SUBSYSTEM  " WITH NO ADVANCING
*	ACCEPT IN-SUBSYS.
*	MOVE IN-SUBSYS TO MASTER-SUBSYS-ID, OUT-SUBSYS.
*"	MOVE 'COM' TO MASTER-MACHINE-ID.
*,
*6
*@	MOVE OUT-LIBARYNAME TO SUBSTITUTE-NAME.
*J	MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
*T	OPEN INPUT DCYFILE.
*^	PERFORM STACK-CONTROLFILE-NAMES.
*h	CLOSE DCYFILE.
*r	SET NAME-SUB TO 1.
*|
+
+INIT-FILES.
+	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
+$	UNSTRING NAME-TEMP DELIMITED BY SPACE 
+.		INTO FILENAMEIN.
+8	IF FILENAMEIN = SPACE GO TO LEAVE.
+B	MOVE FILENAMEIN TO FILENAMEOUT.
+L
+V	OPEN INPUT INFILE.
+`	OPEN OUTPUT OUTFILE.
+j
+tGET-NEXT.
+~	READ INFILE AT END GO TO CTT-EXHAUST.
,
,
,SUBSTITUTE-FIRST.
,&	IF LIBID-LINE AND INREC EQUALS MASTER-LINE
,0		WRITE OUTREC08 FROM SUBSTITUTE-LINE
,:		GO TO GET-NEXT.
,D
,N	IF HOST-20 AND DEFDSK 
,X			WRITE OUTREC32 FROM IDLINE
,b			WRITE OUTREC34 FROM ILLINE.
,l	IF HOST-20 AND 20-LOGOUT WRITE OUTREC32 FROM IDLINE.
,v	IF RSETSRC PERFORM HANDLE-SETSRC 
-		GO TO GET-NEXT.
-
	IF FOR-BOTH MOVE HOST-CHARACTER TO FIRSTCHAR
-		GO TO MOV-REC.
-	IF NOT FOR-10 AND NOT FOR-20 GO TO MOV-REC.
-(	IF FOR-10 AND HOST-10  GO TO MOV-REC.
-2	IF FOR-20 AND HOST-20  GO TO MOV-REC.
-<	
-F*
-P*  FUNCTIONALITY HERE TO INCLUDE COMMANDS SPECIFIC TO THE
-Z*  ALTERNATE SYSTEM AS COMMENT LINES.  THIS MAY BE ENABLED
-d*  BY SETTING THE DEFAULT VALUE OF COMMENT-OPTION-FLAG TO 1.
-n*
-x	IF WANT-EXTRA-COMMENTS
.		MOVE COMMENT-CHARACTER TO FIRSTCHAR
.
	ELSE
.		GO TO GET-NEXT.
. 
.*
.4
.>MOV-REC.
.H	MOVE INREC TO OUTREC.
.RWRITE-REC.
.\	IF O4 (8) = SPACE
.f	  IF O4 (4) = SPACE
.p	    IF O4 (2) = SPACE
.z		MOVE 1 TO I GO TO P70
/	    ELSE
/	      IF O4 (3) = SPACE
/		MOVE 5 TO I GO TO P70
/"	      ELSE
/,		MOVE 9 TO I GO TO P70
/6	  ELSE
/@	    IF O4 (6) = SPACE
/J	      IF O4 (5) = SPACE
/T		MOVE 13 TO I GO TO P70
/^	      ELSE
/h		MOVE 17 TO I GO TO P70
/r	    ELSE
/|	      IF O4 (7) = SPACE
0		MOVE 21 TO I GO TO P70
0	      ELSE
0		MOVE 25 TO I GO TO P70
0$	ELSE
0.	  IF O4 (12) = SPACE
08	    IF O4 (10) = SPACE
0B	      IF O4 (9) = SPACE
0L		MOVE 29 TO I GO TO P70
0V	      ELSE
0`		MOVE 33 TO I GO TO P70
0j	    ELSE
0t	      IF O4 (11) = SPACE
0~		MOVE 37 TO I GO TO P70
1	      ELSE
1		MOVE 41 TO I GO TO P70
1	  ELSE
1&	    IF O4 (14) = SPACE
10	      IF O4 (13) = SPACE
1:		MOVE 45 TO I GO TO P70
1D	      ELSE
1N		MOVE 49 TO I GO TO P70
1X	    ELSE
1b	      IF O4 (15) = SPACE
1l		MOVE 53 TO I GO TO P70
1v	      ELSE
2		MOVE 57 TO I GO TO P70.
2
	IF O4 (16) NOT = SPACES MOVE 61 TO I.
2
2P70.
2(	IF O1 (I + 3) = SPACE
22	  IF O1 (I + 2) = SPACE
2<	    IF O1 (I + 1) = SPACE
2F		NEXT SENTENCE
2P	    ELSE ADD 1 TO I
2Z	  ELSE ADD 2 TO I
2d	ELSE ADD 3 TO I.
2n	GO TO 
2x		P70-01
3		P70-02
3
		P70-03
3		P70-04
3 		P70-05
3*		P70-06
34		P70-07
3>		P70-08
3H		P70-09
3R		P70-10
3\		P70-11
3f		P70-12
3p		P70-13
3z		P70-14
4		P70-15
4		P70-16
4		P70-17
4"		P70-18
4,		P70-19
46		P70-20
4@		P70-21
4J		P70-22
4T		P70-23
4^		P70-24
4h		P70-25
4r		P70-26
4|		P70-27
5		P70-28
5		P70-29
5		P70-30
5$		P70-31
5.		P70-32
58		P70-33
5B		P70-34
5L		P70-35
5V		P70-36
5`		P70-37
5j		P70-38
5t		P70-39
5~		P70-40
6		P70-41
6		P70-42
6		P70-43
6&		P70-44
60		P70-45
6:		P70-46
6D		P70-47
6N		P70-48
6X		P70-49
6b		P70-50
6l		P70-51
6v		P70-52
7		P70-53
7
		P70-54
7		P70-55
7		P70-56
7(		P70-57
72		P70-58
7<		P70-59
7F		P70-60
7P		P70-61
7Z		P70-62
7d		P70-63
7n		P70-64
7x		DEPENDING ON I.
8	DISPLAY "? SOMETHING WRONG WITH THE BINARY TREE " I.
8
	STOP RUN.
8P70-01. WRITE OUTREC01. GO TO GET-NEXT.
8 P70-02. WRITE OUTREC02. GO TO GET-NEXT.
8*P70-03. WRITE OUTREC03. GO TO GET-NEXT.
84P70-04. WRITE OUTREC04. GO TO GET-NEXT.
8>P70-05. WRITE OUTREC05. GO TO GET-NEXT.
8HP70-06. WRITE OUTREC06. GO TO GET-NEXT.
8RP70-07. WRITE OUTREC07. GO TO GET-NEXT.
8\P70-08. WRITE OUTREC08. GO TO GET-NEXT.
8fP70-09. WRITE OUTREC09. GO TO GET-NEXT.
8pP70-10. WRITE OUTREC10. GO TO GET-NEXT.
8zP70-11. WRITE OUTREC11. GO TO GET-NEXT.
9P70-12. WRITE OUTREC12. GO TO GET-NEXT.
9P70-13. WRITE OUTREC13. GO TO GET-NEXT.
9P70-14. WRITE OUTREC14. GO TO GET-NEXT.
9"P70-15. WRITE OUTREC15. GO TO GET-NEXT.
9,P70-16. WRITE OUTREC16. GO TO GET-NEXT.
96P70-17. WRITE OUTREC17. GO TO GET-NEXT.
9@P70-18. WRITE OUTREC18. GO TO GET-NEXT.
9JP70-19. WRITE OUTREC19. GO TO GET-NEXT.
9TP70-20. WRITE OUTREC20. GO TO GET-NEXT.
9^P70-21. WRITE OUTREC21. GO TO GET-NEXT.
9hP70-22. WRITE OUTREC22. GO TO GET-NEXT.
9rP70-23. WRITE OUTREC23. GO TO GET-NEXT.
9|P70-24. WRITE OUTREC24. GO TO GET-NEXT.
:P70-25. WRITE OUTREC25. GO TO GET-NEXT.
:P70-26. WRITE OUTREC26. GO TO GET-NEXT.
:P70-27. WRITE OUTREC27. GO TO GET-NEXT.
:$P70-28. WRITE OUTREC28. GO TO GET-NEXT.
:.P70-29. WRITE OUTREC29. GO TO GET-NEXT.
:8P70-30. WRITE OUTREC30. GO TO GET-NEXT.
:BP70-31. WRITE OUTREC31. GO TO GET-NEXT.
:LP70-32. WRITE OUTREC32. GO TO GET-NEXT.
:VP70-33. WRITE OUTREC33. GO TO GET-NEXT.
:`P70-34. WRITE OUTREC34. GO TO GET-NEXT.
:jP70-35. WRITE OUTREC35. GO TO GET-NEXT.
:tP70-36. WRITE OUTREC36. GO TO GET-NEXT.
:~P70-37. WRITE OUTREC37. GO TO GET-NEXT.
;P70-38. WRITE OUTREC38. GO TO GET-NEXT.
;P70-39. WRITE OUTREC39. GO TO GET-NEXT.
;P70-40. WRITE OUTREC40. GO TO GET-NEXT.
;&P70-41. WRITE OUTREC41. GO TO GET-NEXT.
;0P70-42. WRITE OUTREC42. GO TO GET-NEXT.
;:P70-43. WRITE OUTREC43. GO TO GET-NEXT.
;DP70-44. WRITE OUTREC44. GO TO GET-NEXT.
;NP70-45. WRITE OUTREC45. GO TO GET-NEXT.
;XP70-46. WRITE OUTREC46. GO TO GET-NEXT.
;bP70-47. WRITE OUTREC47. GO TO GET-NEXT.
;lP70-48. WRITE OUTREC48. GO TO GET-NEXT.
;vP70-49. WRITE OUTREC49. GO TO GET-NEXT.
<P70-50. WRITE OUTREC50. GO TO GET-NEXT.
<
P70-51. WRITE OUTREC51. GO TO GET-NEXT.
<P70-52. WRITE OUTREC52. GO TO GET-NEXT.
<P70-53. WRITE OUTREC53. GO TO GET-NEXT.
<(P70-54. WRITE OUTREC54. GO TO GET-NEXT.
<2P70-55. WRITE OUTREC55. GO TO GET-NEXT.
<<P70-56. WRITE OUTREC56. GO TO GET-NEXT.
<FP70-57. WRITE OUTREC57. GO TO GET-NEXT.
<PP70-58. WRITE OUTREC58. GO TO GET-NEXT.
<ZP70-59. WRITE OUTREC59. GO TO GET-NEXT.
<dP70-60. WRITE OUTREC60. GO TO GET-NEXT.
<nP70-61. WRITE OUTREC61. GO TO GET-NEXT.
<xP70-62. WRITE OUTREC62. GO TO GET-NEXT.
=P70-63. WRITE OUTREC63. GO TO GET-NEXT.
=
P70-64. WRITE OUTREC64. GO TO GET-NEXT.
=
= 
=*CTT-EXHAUST.
=4	CLOSE INFILE OUTFILE
=>	IF NOT NAME-LIMIT SET NAME-SUB UP BY 1
=H	GO TO INIT-FILES.
=RLEAVE.
=\	DISPLAY "END SETUP CONVERT SESSION"
=f	STOP RUN.
=p
=z
>
>
>HANDLE-SETSRC SECTION.
>"	IF HOST-20
>,		MOVE COMMENT-CHARACTER TO FIRSTCHAR.
>6	WRITE OUTREC FROM INREC.
>@
>J
>TGET-STAR-SYS.
>^	READ INFILE AT END
>h		DISPLAY "UNEXPECTED END ON SETSRC LINE"
>r		STOP RUN.
>|	IF NOT STAR-SYS
?		DISPLAY "NO *SYS AFTER .R SETSRC"
?		STOP RUN.
?
?$
?.PUT-STAR-SYS.
?8	IF HOST-20
?B		WRITE OUTREC06 FROM SYS-COMMENT
?L	ELSE
?V		WRITE OUTREC06 FROM INREC.
?`
?j
?t

* 26 DEC 75
ID DIVISION.
PROGRAM-ID. SHORTL.
(*	SHORTENS .LOG FILES BY REMOVING ALL THE GARBAGE.
2ENVIRONMENT DIVISION.
<INPUT-OUTPUT SECTION.
FFILE-CONTROL.
P	SELECT INFILE ASSIGN TO DSK.
Z	SELECT OUTFILE ASSIGN TO DSK.
dDATA DIVISION.
nFILE SECTION.
xFD	INFILE VALUE OF ID IS INFILENAME.
01	INREC DISPLAY-7.

	03  TABS	PIC XX.
	88  TABTAB VALUE "		".
 	03  JOBFIELD.
*	88  JOBLINE	VALUE ";$JOB".
4	    05 FILLER	PIC X.
>	    88 TABTABQUESTION VALUE "?".
H	    05 FILLER	PIC XXXX.
R	03  FILLER	PIC XX.
\	03  INCODE	PIC X.
f	88  MONTR	VALUE "M" "T" "F" "B".
p	88  BATCH	VALUE "B" "T" "F".
z	88  USER	VALUE "U".
	03  FILLER	PIC X(4).
	03  USERLINE.
	    05  CHR1	PIC X.
"	    05  MONTRLINE.
,		07  CHRS2TO7.
6			88 KJOB VALUE "@@LOGO".
@		    09  CHR2	PIC X.
J		    09  FILLER	PIC X(5).
T		07  FILLER	PIC X(61).
^FD	OUTFILE VALUE OF ID IS OUTFILENAME.
h1	OUTREC DISPLAY-7 PIC X(82).
rWORKING-STORAGE SECTION.
|1	STARTMARK	PIC S9(10) COMP.
1	ENDMARK		PIC S9(10) COMP.
1	MONTRMARK	PIC S9(10) COMP.
1	QUESTIONMARK	PIC S9(10) COMP.
$1	CURRENTLINE	PIC S9(10) COMP.
.1	RESPONSE	PIC X.
8	88 NOPE VALUE "N".
B	88 LEGALRESPONSE VALUE "N" "Y".
L1	INFILENAME.
V	3  FILENAME	PIC X(6).
`	3  FILLER	PIC XXX VALUE "LOG".
j1	OUTFILENAME.
t	3 OUTNAME	PIC XXXXXX.
~	3 FILLER	PIC XXX VALUE "SLG".
1	PTR	PIC S9(5) COMP VALUE 1.
1	FILENAMESTRING PIC X(72) DISPLAY-7.
PROCEDURE DIVISION.
&P1.
0	DISPLAY "ONLY '?' LINES? " WITH NO ADVANCING.
:	ACCEPT RESPONSE.
D	IF NOT LEGALRESPONSE
N	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
X	  GO TO P1.
b	DISPLAY "NAMES OF .LOG FILES: ".
l	ACCEPT FILENAMESTRING.
v	MOVE 1 TO PTR.
P2.

	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
	  INTO FILENAME WITH POINTER PTR.
	IF FILENAME = SPACE GO TO P1.
(	MOVE FILENAME TO OUTNAME.
2	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
<	MOVE 10000 TO ENDMARK.
F	IF NOPE GO TO P4.
P
Z*	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
d
n	OPEN INPUT INFILE.
xP3.
	READ INFILE AT END GO TO P3C.

	ADD 1 TO CURRENTLINE.
	IF MONTR AND CHR2 = "@"
 	  NEXT SENTENCE ELSE GO TO P3A.
*	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
4	  GO TO P3.
>*	  IGNORE THE @ST LINE IN ORDER TO GET THE PRECEDING LINES
H*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
R	IF BATCH OR CHRS2TO7 = "@@ST" OR "@ST" OR "@" GO TO P3.
\	MOVE CURRENTLINE TO MONTRMARK.
f	GO TO P3.
pP3A.
z	IF USER AND CHR1 = "?"
	  GO TO P3B.
	IF MONTR AND CHR2 = "?"
	  GO TO P3B.
"	IF TABTABQUESTION GO TO P3B.
,	GO TO P3.
6P3B.
@	IF STARTMARK = 0
J	  MOVE MONTRMARK TO STARTMARK.
T	MOVE CURRENTLINE TO QUESTIONMARK.
^	GO TO P3.
hP3C.
r	MOVE MONTRMARK TO ENDMARK.
|	MOVE 0 TO CURRENTLINE.
	CLOSE INFILE.
	IF STARTMARK = 0
	  DISPLAY "NO ?'S FOUND IN " FILENAME
$	  GO TO P2.
.P4.
8	OPEN INPUT INFILE.
B	OPEN OUTPUT OUTFILE.
LP5.
V	READ INFILE AT END GO TO P95.
`	ADD 1 TO CURRENTLINE.
j	IF NOT JOBLINE GO TO P5.
t	IF CURRENTLINE < STARTMARK GO TO P10.
~	IF CURRENTLINE > ENDMARK GO TO P99.
		MOVE "\\" TO TABS.
		WRITE OUTREC FROM INREC.
	P10.
	&	READ INFILE AT END GO TO P99.
	0	ADD 1 TO CURRENTLINE
	:	IF CURRENTLINE < STARTMARK GO TO P10.
	D	IF CURRENTLINE > ENDMARK GO TO P99.
	N	IF KJOB GO TO P99.
	X	IF TABTAB
	b	  MOVE "\\" TO TABS
	l	  WRITE OUTREC FROM INREC
	v	  GO TO P10.

	IF MONTR AND CHRS2TO7 NOT = SPACE


	  WRITE OUTREC FROM MONTRLINE GO TO P10.

	IF USER AND USERLINE NOT = SPACE

	  WRITE OUTREC FROM USERLINE GO TO P10.

(	GO TO P10.

2P95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.

<P99.	CLOSE INFILE OUTFILE.

F	DISPLAY FILENAME ".SLG WRITTEN" GO TO P2.

 ID DIVISION.
PROGRAM-ID. SHORTL.
*	SHORTENS .LOG FILES BY REMOVING ALL THE GARBAGE.
(ENVIRONMENT DIVISION.
2INPUT-OUTPUT SECTION.
<FILE-CONTROL.
F	SELECT INFILE ASSIGN TO DSK.
P	SELECT OUTFILE ASSIGN TO DSK.
ZDATA DIVISION.
dFILE SECTION.
nFD	INFILE VALUE OF ID IS INFILENAME.
x01	INREC1 DISPLAY-7.
	2 LINE1.

	  3 TIME-USER	PIC X(14).
	  3 FIRST-CHAR  PIC X.
 	  3 FILLER	PIC X(7).
*	2 FILLER PIC X(61).
401	INREC2 DISPLAY-7.
>	3 SLASHSLASH PIC XX.
H	3 FILLER PIC X(12).
R	3 OUTLINE PIC X(69).
\
f1	INREC3 DISPLAY-7.
p	2 FILLER PIC X(14).
z	2 USER-LINE.
		3 FILLER PIC X.
		3 TOPS-20-MONTR-LINE.
		    4 FILLER PIC X.
"		    4 TOPS-10-MONITR-LINE PIC X(67).
,FD	OUTFILE VALUE OF ID IS OUTFILENAME.
61	OUTREC DISPLAY-7 PIC X(83).
@WORKING-STORAGE SECTION.
J1	STARTMARK	PIC S9(10) COMP.
T1	ENDMARK		PIC S9(10) COMP.
^1	MONTRMARK	PIC S9(10) COMP.
h1	QUESTIONMARK	PIC S9(10) COMP.
r1	CURRENTLINE	PIC S9(10) COMP.
|1	RESPONSE	PIC X.
	88 NOPE VALUE "N".
	88 LEGALRESPONSE VALUE "N" "Y".
1	INFILENAME.
$	3  FILENAME	PIC X(6).
.	3  FILLER	PIC XXX VALUE "LOG".
81	OUTFILENAME.
B	3 OUTNAME	PIC XXXXXX.
L	3 FILLER	PIC XXX VALUE "SLG".
V1	PTR	PIC S9(5) COMP VALUE 1.
`1	FILENAMESTRING PIC X(72) DISPLAY-7.
j1	TALLY1 PIC 9(10) COMP.
t1	TALLY2 PIC 9(10) COMP.
~1	TALLY3 PIC 9(10) COMP.
1	LOGIN-LINE1.
	2 INDEXED-LINE PIC X OCCURS 22 TIMES.
1	POINTER1	PIC 99.
&1	TOPS-TYPE PIC X VALUE " ".
0	88 FOUND-TOPS-TYPE VALUE "@" ".".
:	88 TOPS-20 VALUE "@".
D	88 TOPS-10 VALUE ".".
N1	MONLINE PIC X(7) USAGE IS DISPLAY-7.
XPROCEDURE DIVISION.
bP1.
l	DISPLAY "ONLY LINES WITH QUESTIONMARKS? " WITH NO ADVANCING.
v	ACCEPT RESPONSE.
	IF NOT LEGALRESPONSE

	  DISPLAY "TYPE ONLY 'Y' OR 'N'"
	  GO TO P1.
	DISPLAY "NAMES OF .LOG FILES: ".
(	ACCEPT FILENAMESTRING.
2	MOVE 1 TO PTR.
<P2.
F	UNSTRING FILENAMESTRING DELIMITED BY "," OR SPACE
P	  INTO FILENAME WITH POINTER PTR.
Z	IF FILENAME = SPACE GO TO P1.
d	MOVE FILENAME TO OUTNAME.
n	MOVE 0 TO STARTMARK CURRENTLINE QUESTIONMARK.
x	MOVE 10000 TO ENDMARK.
	MOVE " " TO TOPS-TYPE.

	IF NOPE GO TO P4.
	MOVE "NOVALUE" TO MONLINE.
 
**	DO SCAN OF FILE TO SEE IF ANY ERROR MESSAGES ARE PRESENT.
4
>	OPEN INPUT INFILE.
HP3.
R	READ INFILE AT END GO TO P3C.
\	IF NOT FOUND-TOPS-TYPE
f		PERFORM FIND-TYPE.
p	ADD 1 TO CURRENTLINE.
z	SET TALLY1 TO 0.
	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE.
	IF TALLY1 NOT = 1 GO TO P3A.
	IF STARTMARK NOT = 0 AND MONTRMARK > QUESTIONMARK
"	  GO TO P3.
,*	  IGNORE THE .ST LINE IN ORDER TO GET THE PRECEDING LINES
6*	  WHICH HAVE MORE USEFUL INFORMATION ABOUT WHERE U ARE.
@	SET TALLY1 TO 0.
J	INSPECT LINE1 TALLYING TALLY1 FOR ALL "..ST",
T		TALLY1 FOR ALL ".ST",
^		TALLY1 FOR ALL "@ST",
h		TALLY1 FOR ALL "@@ST".
r	IF TALLY1 = 1 GO TO P3.
|	MOVE CURRENTLINE TO MONTRMARK.
	GO TO P3.
P3A.
	IF FIRST-CHAR = "?"
$		PERFORM P3B.
.	GO TO P3.
8P3B.
B	IF STARTMARK = 0
L	  MOVE MONTRMARK TO STARTMARK.
V	MOVE CURRENTLINE TO QUESTIONMARK.
`
jP3C.
t	MOVE MONTRMARK TO ENDMARK.
~	MOVE 0 TO CURRENTLINE.
		CLOSE INFILE.
		IF STARTMARK = 0
		  DISPLAY "NO ?'S FOUND IN " FILENAME
	&	  GO TO P2.
	0P4.
	:	OPEN INPUT INFILE.
	D	OPEN OUTPUT OUTFILE.
	N	PERFORM FIND-MONLINE.
	XP5.
	b	READ INFILE AT END GO TO P95.
	l	ADD 1 TO CURRENTLINE.
	v	SET TALLY1 TO 0.

	INSPECT LINE1 TALLYING TALLY1 FOR ALL ";$JOB".


	IF TALLY1 NOT = 1 GO TO P5.

	IF CURRENTLINE > ENDMARK GO TO P99.

P10.

(	READ INFILE AT END GO TO P99.

2	ADD 1 TO CURRENTLINE

<	IF CURRENTLINE < STARTMARK GO TO P10.

F	IF CURRENTLINE > ENDMARK GO TO P99.

P	SET TALLY1 TO 0.

Z	INSPECT LINE1 TALLYING TALLY1 FOR ALL "KJOB",

d		TALLY1 FOR  ALL "LOGO".

n	IF TALLY1 = 1 GO TO P99.

x	SET TALLY1 TO 0.
	INSPECT LINE1 TALLYING TALLY1 FOR ALL "		".

	IF TALLY1 = 1
		MOVE "\\" TO SLASHSLASH
 		WRITE OUTREC FROM INREC2
*		GO TO P10.
4	SET TALLY1 TO 0.
>	SET TALLY2 TO 0.
H	SET TALLY3 TO 0.
R*	SHORTL IS SET TO IGNORE THE COMPILER VERSION NUMBER LINE
\	INSPECT LINE1 TALLYING TALLY1 FOR ALL MONLINE,
f		TALLY2 FOR ALL " USER	",
p		TALLY3 FOR ALL "C74OTS".
z	IF TALLY1 = 1  AND TALLY3 NOT = 1

		IF TOPS-10

		   WRITE OUTREC FROM TOPS-10-MONITR-LINE

		ELSE IF TOPS-20

"		   WRITE OUTREC FROM TOPS-20-MONTR-LINE.

,	IF TALLY2 = 1 AND USER-LINE NOT = SPACE AND TALLY3 NOT = 1

6		WRITE OUTREC FROM USER-LINE.

@	GO TO P10.

JP95.	DISPLAY "? LOGTYP: CAN'T FIND $JOB LINE" GO TO P99.

TP99.	CLOSE INFILE OUTFILE.

^	DISPLAY FILENAME ".SLG WRITTEN" GO TO P2.

hFIND-TYPE.

r	MOVE 0 TO TALLY1.

|	INSPECT LINE1 TALLYING TALLY1 FOR ALL "LOGIN".
E 1 TO POINTER1.
LLY1 =1
NSTRING LINE1 DELIMITED BY "LOGIN"
INTO LOGIN-LINE1 WITH POINTER POINTER1
VE INDEXED-LINE (POINTER1 - 6) TO TOPS-TYPE
 TOPS-20 
MOVE " MONTR	" TO MONLINE
LSE IF TOPS-10
OVE "MONITR	" TO MONLINE
ELSE 
ISPLAY"? SHORTL ERROR COULD NOT FIND TOPS TYPE".
MONLINE.
AD INFILE AT END
		DISPLAY "? COULDN'T FIND LOGIN LINE"
		STOP RUN.
	ADD 1 TO CURRENTLINE.
&	PERFORM FIND-TYPE.
0	IF NOT FOUND-TOPS-TYPE GO TO FIND-MONLINE.