Google
 
Trailing-Edge - PDP-10 Archives - ap-c800d-sb - acp010.ctl
There are no other files named acp010.ctl in the archive.
C\G,@C\G,RC
GrCvI6G4]CX9G4Y>>N)GSY>>N8Gb[LHG4p[LIG4p]>LzG^g$[s[![g&\D"Ig"~-	G7?g"~-G:p
$JOB                                                                            
.NOERROR                                                                          
.R LIBARY                                                                         
(**=ACCEPT                                                                         
2**EXTRACT ACP1,ACP1.CTL                                                           
<**EXTRACT CHKACP,CHKACP.CTL                                                       
F**EXTRACT LOGTYP,LOGTYP.CBL                                                       
P**EXTRACT NEWTST,NEWTST.CBL                                                       
Z**EXTRACT SHORTL,SHORTL.CBL                                                       
d*                                                                                 
n..DELETE ACP1.LOG,CHKACP.LOG                                                      
xFiles deleted:                                                                    
% No file named DSK:ACP1.LOG                                                      


% No file named DSK:CHKACP.LOG                                                    
..SUB ACP1                                                                        
 Job ACP1 submitted                                                                
*..COMPILE LOGTYP                                                                  
4COBOL:	LOGTYP  [LOGTYP.CBL]                                                       
>EXIT                                                                              
H..COMPILE NEWTST                                                                  
RCOBOL:	NEWTST  [NEWTST.CBL]                                                       
\WARNINGS:                                                                         
f    0135  RIGHT-MOST TRUNCATION ON SINGLE-CHAR                                    
p    0143  MOST SIGNIFICANT DIGITS TRUNCATED ON PTR                                
z    0200  RIGHT-MOST TRUNCATION ON STARLINETEXT                                   
NO FATAL ERRORS, 3 WARNINGS                                                       
EXIT                                                                              
..COMPILE SHORTL                                                                  
"COBOL:	SHORTL  [SHORTL.CBL]                                                       
,EXIT                                                                              

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT1.
(* REDEFINES
2* VALUE CLAUSE
<* ONE DIMENSIONED TABLE
F* OPEN, CLOSE, READ, WRIT SEQUENTIAL FILES
P*   WITH BLOCKING AND ASCII/SIXBIT/BINARY MODES.
Z* SAME AREA
d* RERUN EVERY N RECORDS
n* MOVE ALL LITERAL
x* PERFORM N TIMES
* PERFORM VARYING


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

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

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

WORKING-STORAGE SECTION.
&1	FILENAME	PIC X(9) VALUE "WORK1XXXX".
077	COUNT-1 PIC 99 VALUE 0.
:77	COUNT-2 PIC 99 VALUE 0.
D77	COUNT-3 PIC 9999 VALUE 0.
N1	TABLEOFVALUES.
X	3 RECVALUE PIC XXX OCCURS 999 TIMES.
b1	I	PIC S9(10) COMP.
l1	MESSAGEOUT	PIC X(28).
v
PROCEDURE DIVISION.

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


	PERFORM WRITE-2 20 TIMES.
	CLOSE WORK-2.
 	DISPLAY '  WORK2 CREATED'.
*	OPEN OUTPUT WORK-3.
4	MOVE 'XXXXXX TEST DATA' TO RECORD-3.
>	PERFORM WRITE-3 VARYING I FROM 1 BY 1 UNTIL I > 999.
H	CLOSE WORK-3.
R	DISPLAY '  TSTDAT.SEQ CREATED '.
\	OPEN INPUT WORK-1.
fLOOP1.
p	READ WORK-1 RECORD AT END GO TO B1.
z	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 ';
,	COUNT-1, ' RECORDS WERE READ.'.
6B2.
@
J	CLOSE WORK-1, WITH DELETE.
T	OPEN INPUT WORK-2.
^LOOP2.
h	READ WORK-2 AT END GO TO B3.
r	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.'.
.B4.
8	CLOSE WORK-2  WITH DELETE.
B	OPEN INPUT WORK-3.
LLOOP3.
V	READ WORK-3 AT END GO TO B5.
`	ADD 1 TO COUNT-3.
j	IF COUNT-3 NOT = RECNO
t	  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 ';
	&	COUNT-3, ' RECORDS WERE READ.'.
	0B6.
	:	CLOSE WORK-3.
	D	STOP RUN.
	N	DISPLAY "END ACCPT1".
	XWRITE-1.
	b	WRITE RECORD-1.
	lWRITE-2.
	v	WRITE RECORD-2.

WRITE-3.


	MOVE RECVALUE (I) TO RECKEY1.

	MOVE I TO RECNO.

	WRITE RECORD-3.

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT2.
(* OPEN, CLOSE, READ, WRITE ON RANDOM FILE
2* SORT WITH INPUT AND OUTPUT PROCEDURES.
<* REPORT WRITING FEATURES.
F* LINKED WITH COBDDT.REL, CHECKS COBDDT AD HISTOGRAM
PENVIRONMENT DIVISION.
ZINPUT-OUTPUT SECTION.
dFILE-CONTROL.
n	SELECT SEQFILE ASSIGN TO DSK.
x	SELECT RANFILE ASSIGN TO DSK
	  FILE-LIMIT IS ONETHOUSAND


	  ACCESS RANDOM
	  ACTUAL KEY ACTKEY
 	  RECORDING MODE IS SIXBIT.
*	SELECT REPFILE ASSIGN TO DSK.
4	SELECT SRTFILE ASSIGN TO DSK DSK DSK.
>DATA DIVISION.
HFILE SECTION.
RFD	SEQFILE VALUE OF ID IS "TSTDATSEQ".
\1	SEQREC PIC X(26) DISPLAY-7.
fFD	RANFILE VALUE OF ID IS "TSTDATRAN"
p	  BLOCK CONTAINS 20 RECORDS.
z1	RANREC PIC X(26).
FD	REPFILE  VALUE OF ID IS "TSTDATREP"
	  REPORT IS REPTRY.
1	REPREC PIC X(45) DISPLAY-7.
"SD	SRTFILE.
,1	SRTREC.
6	3 KEY1 PIC XXX.
@	3 KEY2 PIC 999.
J	3 KEY2REDEF REDEFINES KEY2.
T	  5 DIGIT1 PIC 9.
^	  5 DIGIT2 PIC 9.
h	  5 DIGIT3 PIC 9.
r	3 KEY3 PIC X(20).
|WORKING-STORAGE SECTION.
1	ACTKEY	PIC S9(10) COMP.
1	I		PIC S9(10) COMP.
1	ONETHOUSAND	PIC S9(10) COMP VALUE 1000.
$1	OLDKEY		PIC XXX VALUE SPACE.
.REPORT SECTION.
8RD	REPTRY
B	  PAGE 60 LINES
L	  CONTROLS ARE FINAL DIGIT1 DIGIT2.
V1	  TYPE CONTROL FOOTING FINAL LINE PLUS 5.
`	3 COLUMN 1 PIC X(20) VALUE "FINAL LINE".
j	3 COLUMN 30 PIC XXX SOURCE KEY1.
t	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.
&1	  TYPE CONTROL FOOTING DIGIT2 LINE PLUS 2.
0	3 COLUMN 1 PIC X(20) VALUE "BREAK ON DIGIT 2".
:	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
D1	DETAILLINE TYPE DETAIL LINE PLUS 1.
N	3 COLUMN 1 PIC XXXXXX VALUE "DETAIL".
X	3 COLUMN 30 PIC XXX SOURCE KEY1.
b	3 COLUMN 35 PIC ZZZ SOURCE KEY2.
l1	TYPE PAGE HEADING LINE 1 NEXT GROUP PLUS 3.
v	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.
(P0.
2	SORT SRTFILE ON ASCENDING KEY1
<	  INPUT PROCEDURE INPROCEDURE
F	  OUTPUT PROCEDURE OUTPROCEDURE.
P	DISPLAY "END ACCPT2".
Z	STOP RUN.
dINPROCEDURE SECTION.
nIP0.
x	OPEN INPUT SEQFILE, OUTPUT REPFILE.
	INITIATE REPTRY.


IP5.
	READ SEQFILE AT END GO TO IP10.
 	RELEASE SRTREC FROM SEQREC.
*	GENERATE DETAILLINE.
4	GO TO IP5.
>IP10.
H	DISPLAY "  PRESORT DONE".
R	TERMINATE REPTRY.
\	CLOSE REPFILE.
f	CLOSE SEQFILE.
p	DISPLAY "  TSTDAT.REP WRITTEN".
z
OUTPROCEDURE SECTION.
OP0.
	OPEN OUTPUT RANFILE.
"	DISPLAY "  MERGE STARTED".
,OP5.
6	RETURN SRTFILE AT END GO TO OP10.
@	IF KEY1 NOT < OLDKEY
J	  NEXT SENTENCE
T	ELSE
^	  DISPLAY SPACE
h	  DISPLAY "? KEYS NOT IN ORDER, LAST = " OLDKEY
r	  ", THIS = " KEY1.
|	MOVE KEY1 TO OLDKEY.
	MOVE KEY2 TO ACTKEY.
	WRITE RANREC FROM SRTREC INVALID KEY
	  DISPLAY SPACE
$	  DISPLAY "? CAN'T WRITE RANDOM RECORD AT KEY VALUE " ACTKEY.
.	GO TO OP5.
8OP10.
B	CLOSE RANFILE.
L	DISPLAY "  MERGE ENDED".
V	DISPLAY "  TSTDAT.RAN WRITTEN".
`	MOVE 0 TO ACTKEY I.
j	OPEN INPUT RANFILE.
tOP15.
~	READ RANFILE INTO SRTREC INVALID KEY
		  GO TO OP25.
		ADD 1 TO I.
		IF I NOT = KEY2
	&	  DISPLAY SPACE
	0	  DISPLAY "? RANDOM FILE RECORD OUT OF ORDER"
	:	  DISPLAY "  OR MISSING AT RECORD POSITION " I
	D	  DISPLAY "  RECORD FOUND THERE IS"
	N	  DISPLAY SRTREC.
	X	GO TO OP15.
	bOP25.
	l	CLOSE RANFILE.
	v	DISPLAY "  TSTDAT.RAN CHECK COMPLETED".

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT3.
(* CONDITION-NAMES
2* CALL
<* OPEN INPUT-OUTPUT, DELETE REWRITE ON INDEXED FILE.
F* COMPILED WITH /P SWITCH, LINKED AS ROOT FOR OVERLAY.
PENVIRONMENT DIVISION.
ZINPUT-OUTPUT SECTION.
dFILE-CONTROL.
n	SELECT SEQFILE ASSIGN TO DSK.
x	SELECT RANFILE ASSIGN TO DSK
	  ACCESS RANDOM


	  FILE LIMIT IS 1000
	  ACTUAL KEY IS ACTKEY.
 	SELECT IDXFILE ASSIGN TO DSK
*	  ACCESS INDEXED
4	  SYMBOLIC KEY IS SYMKEY
>	  RECORD KEY IS IDXKEY2.
H	SELECT REPFILE ASSIGN TO DSK.
RDATA DIVISION.
\FILE SECTION.
fFD	SEQFILE VALUE OF ID IS "TSTDATSEQ".
p1	SEQREC	PIC X(26) DISPLAY-7.
z
FD	RANFILE VALUE OF ID IS "TSTDATRAN"
	  BLOCK CONTAINS 20 RECORDS.
1	RANREC	PIC X(26).
"
,FD	IDXFILE VALUE OF ID IS "TSTDATIDX"
6	  BLOCK CONTAINS 29 RECORDS.
@1	IDXREC.
J	3 IDXKEY1 PIC XXX.
T	88 RECORDTOBEDELETED VALUE "AAA" THRU "EEE".
^	88 RECORDTOBEREWRITTEN VALUE "FFF" "GGG" "HHH" "III" THRU "JJJ".
h	3 IDXKEY2 PIC 999.
r	3 IDXFILLER PIC X(20).
|
FD	REPFILE VALUE OF ID IS "TSTDATREP".
1	REPREC PIC X(45) DISPLAY-7.

$WORKING-STORAGE SECTION.
.1	ACTKEY		PIC S9(10) COMP.
81	SYMKEY	PIC 999 VALUE LOW-VALUE.
B1	OLDIDXKEY2	PIC 999 VALUE LOW-VALUE.
L1	I		PIC S9(10) COMP.
V1	RANWSREC	PIC X(26).
`1	REPWSREC DISPLAY-7.
j	88 ABORTSIGNALON VALUE ALL "Z".
t	3 FILLER	PIC XXXXXX.
~	88 ADETAILRECORD VALUE "DETAIL".
	3 FILLER	PIC X(39).
PROCEDURE DIVISION.
MAINLINE SECTION.
&P0.
0	OPEN INPUT SEQFILE REPFILE.
:	OPEN INPUT-OUTPUT RANFILE IDXFILE.
D	DISPLAY "  ALL FILES OPENED".
NP5.
X	ADD 1 TO I.
b	READ IDXFILE INVALID KEY GO TO ENDCHECK.
l	IF IDXKEY2 NOT > OLDIDXKEY2
v	  DISPLAY "? INDEXFILE RECORDS OUTOF ORDER.".
	MOVE IDXKEY2 TO OLDIDXKEY2.

	IF I NOT = IDXKEY2
	  DISPLAY "? ON READ NUMBER " I " WE GOT THIS RECORD:"
	  DISPLAY "  " IDXREC.
(	MOVE IDXKEY2 TO ACTKEY.
2	READ RANFILE INTO RANWSREC INVALID KEY
<	  DISPLAY "? CAN'T READ RECORD #" ACTKEY " ON RANDOM FILE.".
F	READ SEQFILE AT END
P	  DISPLAY "? PREMATURE AT END ON SEQUENTIAL FILE.".
ZP7.
d	READ REPFILE INTO REPWSREC AT END
n	  DISPLAY "? PREMATURE AT END ON REPORT FILE.".
x	IF NOT ADETAILRECORD GO TO P7.



	CALL ACCPT4 USING I SEQREC RANWSREC REPWSREC IDXREC.

 	IF ABORTSIGNALON
*	  DISPLAY "? RECORDS DO NOT MATCH, ABORTING EXECUTION"
4	  STOP RUN.
>	MOVE IDXKEY2 TO SYMKEY.
H	IF RECORDTOBEDELETED
R	  DELETE IDXREC INVALID KEY
\	    DISPLAY "? CAN'T DELETE RECORD ON INDEXED FILE.".
f	IF RECORDTOBEREWRITTEN
p	  MOVE SPACES TO IDXKEY1
z	  REWRITE IDXREC INVALID KEY
	    DISPLAY "? CAN'T REWRITE RECORD ON INDEXED FILE.".
	MOVE LOW-VALUE TO SYMKEY.
	GO TO P5.
"ENDCHECK.
,	READ SEQFILE AT END
6	  DISPLAY "  SEQUENTIAL FILE OK"
@	  GO TO P35.
J	DISPLAY "? TOO MANY RECORDS IN SEQUENTIAL FILE.".
TP35.
^	CLOSE SEQFILE RANFILE.
hP36.
r	READ REPFILE INTO REPWSREC AT END GO TO P37.
|	IF NOT ADETAILRECORD GO TO P36.
	DISPLAY "? TOO MANY DETAIL RECORDS IN REPORT FILE.".
P37.
	CLOSE REPFILE.
$	IF I = 1000 
.	  DISPLAY "  NORMAL END ACCPT3."
8	ELSE DISPLAY "? ABNORMAL END ACCPT3, ONLY " I " RECORDS COUNTED.".
B	STOP RUN.

* 8 SEP 75
ID DIVISION.
PROGRAM-ID. ACCPT4.
(* LINKAGE SECTION.
2* COMPILED WITH /P SWITCH, LINKED AS OVERLAY.
<DATA DIVISION.
FWORKING-STORAGE SECTION.
PLINKAGE SECTION.
Z1	I	PIC S9(10) COMP.
d1	SEQREC DISPLAY-7.
n	3 SEQKEY1		PIC XXX.
x	3 SEQKEY2		PIC 999.
	3 SEQKEY3		PIC X(20).


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

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


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

.K/F

$JOB
.NOERROR
.EX LOGTYP
(*N
2*ACP1
<.EX SHORTL
F*N
P*ACPMAS
Z.R LIBARY
d*=ACP010
n*EXTRACT ACCEPTCK,ACPMAS.CHK
x.R FILCOM
*=ACPMAS.CHK,ACPMAS.SLG


.GOTO RESUME
*@MAILER
 *
**  ACP SUBSYSTEM
4*  IS DONE !!!
>*
H*
RRESUME::
\.K/F

$JOB
.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
DO10::
(.R LIBARY
2*=ACP010
<*EXTRACT ACP1CM,ACP1.CTL
F*EXTRACT ACPCHKCM,ACPCHK.CTL
P*EXTRACT ACPDELCM,ACPDEL.CTL
Z*EXTRACT LOGTYPCB,LOGTYP.CBL
d*EXTRACT NEWTSTCB,NEWTST.CBL
n*EXTRACT SHORTLCB,SHORTL.CBL
x.GOTO RESUME::
DO20::


*=ACP020
*EXTRACT ACP1CM,ACP1.CTL
 *EXTRACT ACPCHKCM,ACPCHK.CTL
**EXTRACT ACPDELCM,ACPDEL.CTL
4*EXTRACT LOGTY2CB,LOGTYP.CBL
>*EXTRACT NEWTSTCB,NEWTST.CBL
H*EXTRACT SETEOFMA,SETEOF.MAC
R*EXTRACT SHORT2CB,SHORTL.CBL
\=SETEOF
fRESUME::
p.DELETE ACP1.LOG,ACPCHK.LOG
z.SUB ACP1
.SUB ACPCHK
! BUG IN COMPILE STATEMENT, 1/4/77, <COBOL> SUBSTITUTED.
.R COBOL
"*=LOGTYP
,*=NEWTST
6*=SHORTL
@.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 XXX.
H	03  FILLER	PIC XXX.
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.

*20 NOV 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 XXX.
H	03  FILLER	PIC XXX.
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 "..K/F".
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 TABTABQUESTION GO TO P3B.
>	IF USER AND CHR1 = "?"
H	  GO TO P3B.
R	IF MONTR AND CHR2 = "?"
\	  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.

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


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

.K/F

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


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

	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 XXXX DISPLAY-7 VALUE "$JOB".
01	NOERRORLINE	PIC X(8) DISPLAY-7 VALUE "@NOERROR".
:1	10-NOERRORLINE	PIC X(8) DISPLAY-7 VALUE ".NOERROR".
D1	DEFLINE		PIC X(20) DISPLAY-7 VALUE "@DEF DSK: DSK: ,SYS:".
N1	10-SETSRCLINE	PIC X(9) DISPLAY-7 VALUE ".R SETSRC".
X1	10-SYSLINE	PIC XXXX DISPLAY-7 VALUE "*SYS".
b1	10-ASSIGNLINE	PIC X(12) DISPLAY-7 VALUE ".ASS DSK SYS".
l1	EXELINE		PIC X(9) DISPLAY-7 VALUE "@RU SETUP".
v1	10-EXELINE	PIC X(9) DISPLAY-7 VALUE ".RU SETUP".
1	SYSTEMLINE DISPLAY-7.

	3 FILLER	PIC X VALUE "*".
	3 SYSTEMCHARS	PIC XX VALUE "10".
	88 TOPS-10 VALUE "10".
(	88 LEGALSYSTEM VALUE "10" "20".
21	RLINE  PIC XX DISPLAY-7  VALUE "*C".
<1	EXPUNGELINE  PIC X(5) DISPLAY-7 VALUE "@EXPU".
F1	IDLINE PIC X(32)  DISPLAY-7 VALUE '@INFORMATION (ABOUT) DISK-USAGE'.
P1	ILLINE PIC X(34) DISPLAY-7 VALUE '@INFORMATION (ABOUT) LOGICAL-NAMES'.
Z1	LIBARYLINE	PIC X(7) DISPLAY-7 VALUE "@LIBARY".
d1	10-LIBARYLINE	PIC X(9) DISPLAY-7 VALUE ".R LIBARY".
n1	LOGOUTLINE	PIC X(7) DISPLAY-7 VALUE "@LOGOUT".
x1	KFLINE		PIC XXXX DISPLAY-7 VALUE ".K/F".
1	MASTER-LINE DISPLAY-7.


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

	88  HOST-20  VALUE "@".
1	COMMENT-CHARACTER PIC X VALUE "!".
1	SYS-COMMENT  PIC X(6)  DISPLAY-7    VALUE "! *SYS".
(1	CHARS-XFRD-COUNT PIC  S99  COMP  VALUE ZERO.
21	NAME-SUB  PIC S99  COMP  VALUE ZERO.
<	88 NAME-LIMIT  VALUE 99.
F1	CONTROLFILE-NAMES-TABLE.
P	03 NAME-HOLD  PIC X(9)  OCCURS 99 TIMES.
Z1	ALT-NAMES-TABLE.
d	03 ALT-NAME-HOLD  PIC X(9)  OCCURS 99 TIMES.
n1	NAME-TEMP.
x	02 N-T-3 PIC X(3).
		88 MASTR-CTL VALUE 'MAS'.


	02 FILLER PIC X(6).
1	TERM PIC X(5).
 1	CM-NAME-TEMP PIC X(9).
*1	DEL-CTL-LINE  DISPLAY-7.
4	  3 DEL-CTL-HOST-CHAR  PIC X  VALUE '@'.
>	  3 FILLER  PIC X(4) VALUE 'DELE'.
H	  3 FILLER  PIC X  VALUE SPACE.
R	  3 DEL-CTL-RIGHT PIC X(66).
\1	COMMENT-OPTION-FLAG PIC S9 COMP VALUE ZERO.
f	88 WANT-EXTRA-COMMENTS VALUE 1.
p
z


1	MAILERLINE  DISPLAY-7.
"	02 MAILSTAR	PIC X VALUE '*'.
,	02 MAILLINE	PIC X(5) VALUE '@MAIL'.
6	02 MAILEX	PIC X(2) VALUE 'ER'.
@1	MAILSUBJECT DISPLAY-7 PIC X(24) VALUE '* CONVERSION JOB IS DONE'.
J1	MAILMESSAGES DISPLAY-7.
T  02 MSG1 PIC X(44) VALUE '* YOUR DIRECTORY NOW CONTAINS THE FOLLOWING:'.
^  02 MSG2 PIC X(32) VALUE '* (1) UTILTY.LIB AND DATMOD.LIB '.
h  02 MSG3 PIC X(44) VALUE '* (2) 23 COMMON LIBS, ENTITLED NNNCOM.LIB   '.
r  02 MSG4 PIC X(44) VALUE '* (3) 25 DIRECTORIES, ENTITLED NNNCOM.DCY   '.
|  02 MSG5 PIC X(50) VALUE '* (4) 23 CONVERTED LIBRARIES, ENTITLED NNN020.LIB '.
  02 MSG6 PIC X(50) VALUE '* (5) 23 MASTER CONTROL FILES, ENTITLED NNNMAS.CTL'.
  02 MSG7 PIC X(50) VALUE '* (6) THE SETUP PGM, FOR SUBSEQUENT CONVERSIONS   '.
  02 MSG8 PIC X(34) VALUE '* WHERE "NNN" IS A SUBSYSTEM ID:  '.
$  02 MSG9 PIC X(34) VALUE '* ACC ACP ADD COM DAT DBM DDT DIV '.
.  02 MSGA PIC X(34) VALUE '* FIL GOT IFT IPC LIB MOV MUL REP '.
8  02 MSGB PIC X(34) VALUE '* SAS SMU SRT STR SUB TBL UNS     '.
B  02 MSGC PIC X(34) VALUE "* MOCK SUBSYS ID'S 'UTL' AND 'DTM'".
L  02 MSGD PIC X(34) VALUE "* ARE USED FOR UTILTY,DATMOD DCY'S".
V1	MAILTERM DISPLAY-7.
`	02 FILLER	PIC XX VALUE "*".
jPROCEDURE DIVISION.
tMAIN SECTION.
~START.
	DISPLAY "CONVERT TO [10] OR [20]?  "  WITH NO ADVANCING
	ACCEPT SYSTEMCHARS.
	IF NOT LEGALSYSTEM
&	  DISPLAY "INPUT '10' OR '20'"
0	  GO TO START.
:	IF TOPS-10
D		MOVE '010' TO OUT-HOSTID
N		MOVE '.' TO 	HOST-CHARACTER,
X				DELOUT-HOST-CHAR,
b				DEL-CTL-HOST-CHAR
l		ELSE MOVE '@' TO HOST-CHARACTER
v			MOVE '020' TO OUT-HOSTID.



GET-MODE.
	DISPLAY "[I]NITIATE OR [C]ONVERT MODE?  "  WITH NO ADVANCING
(	ACCEPT FILENAMESTRING.
2	IF FILENAMESTRING = "I" GO TO CTL-INIT.
<	IF FILENAMESTRING = "C" GO TO PART2.
F	DISPLAY "REPLY WITH 'I' OR 'C'".
P	GO TO GET-MODE.
Z
dCTL-INIT.
n	DISPLAY "NAME OUTPUT CONTROL FILE  " WITH NO ADVANCING
x	ACCEPT CTLFILENAMEONLY.
	OPEN OUTPUT CTLFILE.


	WRITE CTL04 FROM JOBLINE.
 	IF TOPS-10
*	  WRITE CTL08 FROM 10-NOERRORLINE
4	  WRITE CTL09 FROM 10-SETSRCLINE
>	  WRITE CTL04 FROM 10-SYSLINE
H	  WRITE CTL12 FROM 10-ASSIGNLINE
R	  GO TO NEXTLIBS.
\	WRITE CTL08 FROM NOERRORLINE.
f	WRITE CTL20 FROM DEFLINE.
p
zNEXTLIBS.
	DISPLAY "NAME THE SUBSYSTEM  " WITH NO ADVANCING
	ACCEPT IN-SUBSYS.
	IF QUITTING GO TO WINDUP.
"	MOVE IN-SUBSYS TO OUT-SUBSYS, MASTER-SUBSYS-ID.
,
6
@OPEN-UP.
J	MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
T	OPEN  INPUT DCYFILE.
^
h	MOVE SPACES TO NAME-SLOT-2.
r	MOVE OUT-LIBARYNAME TO NAME-SLOT-1.
|	MOVE "DELE" TO SYS-CMD.
	WRITE CTL16 FROM DELOUTLIB-LINE.

	IF TOPS-10
$		MOVE '=' TO ARG-DELIMITER
.		MOVE OUT-LIBARYNAME TO NAME-SLOT-1
8		MOVE IN-LIBARYNAME TO NAME-SLOT-2
B	ELSE
L		MOVE IN-LIBARYNAME TO NAME-SLOT-1
V		MOVE OUT-LIBARYNAME TO NAME-SLOT-2.
`	MOVE "COPY" TO SYS-CMD.
j	WRITE CTL28 FROM DELOUTLIB-LINE.
t	MOVE SPACE TO ARG-DELIMITER.
~	PERFORM STACK-CONTROLFILE-NAMES.

LIB-EXTRACT.
	MOVE "*EXTRACT" TO LIBARYOPERATION.
&	MOVE ".XTT" TO NAMEEXTENSION.
0	MOVE 0 TO ERROREXIT.
:	SET IDENTIFY-LIB-FLAG TO 1.
D	PERFORM LIBARYCOMMAND.
N	SET IDENTIFY-LIB-FLAG TO ZERO.
X	IF ERROREXIT = 1 
b	  CLOSE CTLFILE
l	  STOP RUN.
v


MOD-EXE.
	IF TOPS-10
	  WRITE CTL09 FROM 10-EXELINE
(	ELSE
2	  WRITE CTL09 FROM EXELINE.
<	WRITE CTL03 FROM SYSTEMLINE.
F	WRITE CTL02 FROM RLINE.
P
Z	MOVE IN-SUBSYS TO PUT-SUBSYS.
d	WRITE CTL04 FROM SUBSYS-LINE.
nLIB-REPLACE.
x	MOVE "*REPLACE" TO LIBARYOPERATION.
	MOVE ".CTL" TO NAMEEXTENSION.


	PERFORM LIBARYCOMMAND.
	WRITE CTL04 FROM ENDLINE.
 
*
4DELETE-AND-EXPUNGE.
>	PERFORM DELETE-CTLS.
H
R	IF NOT TOPS-10 WRITE CTL05 FROM EXPUNGELINE.
\
f
pGO-BACK.
z
 	CLOSE DCYFILE
 	GO TO NEXTLIBS.
 
 "
 ,WINDUP.
 6	IF TOPS-10
 @	  WRITE CTL04 FROM KFLINE
 J		ELSE
 T	WRITE CTL05 FROM MAILLINE
 ^	WRITE CTL08 FROM MAILERLINE
 h	WRITE CTL01 FROM MAILSTAR
 r	WRITE CTL24 FROM MAILSUBJECT
 |	WRITE CTL44 FROM MSG1
!	WRITE CTL32 FROM MSG2
!	WRITE CTL44 FROM MSG3
!	WRITE CTL44 FROM MSG4
!$	WRITE CTL01 FROM MAILSTAR
!.	WRITE CTL50 FROM MSG5
!8	WRITE CTL50 FROM MSG6
!B	WRITE CTL50 FROM MSG7
!L	WRITE CTL01 FROM MAILSTAR
!V	WRITE CTL34 FROM MSG8
!`	WRITE CTL34 FROM MSG9
!j	WRITE CTL34 FROM MSGA
!t	WRITE CTL34 FROM MSGB
!~	WRITE CTL01 FROM MAILSTAR
"	WRITE CTL34 FROM MSGC
"	WRITE CTL34 FROM MSGD
"	WRITE CTL02 FROM MAILTERM
"&	  WRITE CTL07 FROM LOGOUTLINE.
"0	CLOSE CTLFILE .
":
"D	DISPLAY  "END OF SETUP INITIATE SESSION".
"N	STOP RUN.
"XDELETE-CTLS SECTION.
"bDC-INIT.
"l	SET PTR TO 1.
"v	SET NAME-SUB TO 1.
#
#
DC-LINE-START.
#	MOVE SPACES TO HOLD-CTL-NAMES, DEL-CTL-RIGHT.
#	SET ON-A-LINE-FLAG TO ZERO.
#(
#2DC-LOOP.
#<	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
#F	IF NAME-TEMP EQUALS SPACES GO TO DC-EXIT.
#P	IF MASTR-CTL GO TO DC-L1.
#Z	IF NAME-TEMP EQUALS MASTER-NAME
#d		MOVE '.XTT,' TO TERM
#n	ELSE
#x		MOVE '.*,' TO TERM.
$	
$

	STRING NAME-TEMP TERM
$		DELIMITED BY SPACE
$ 		INTO HOLD-CTL-NAMES
$*		WITH POINTER PTR.
$4	SET ON-A-LINE-FLAG UP BY 1.
$>	IF NAME-LIMIT GO TO DC-EXIT.
$HDC-L1.
$R	SET NAME-SUB UP BY 1.
$\	IF LINE-LIMIT GO TO DC-PUT.
$f
$p	GO TO DC-LOOP.
$z
%DC-PUT.
%	PERFORM SPECIAL-PUT.
%	GO TO DC-LINE-START.
%"
%,DC-EXIT.
%6	IF NOT LINE-EMPTY
%@		PERFORM SPECIAL-PUT.
%J
%T
%^SPECIAL-PUT SECTION.
%h	STRING HOLD-CTL-NAMES
%r		DELIMITED BY ', '
%|		INTO DEL-CTL-RIGHT.
&	SET PTR TO 1.
&	WRITE CTLREC FROM DEL-CTL-LINE.
&STACK-CONTROLFILE-NAMES SECTION.
&$SCN-START.
&.	MOVE SPACES TO CONTROLFILE-NAMES-TABLE.
&8	MOVE SPACES TO ALT-NAMES-TABLE.
&B	SET NAME-SUB TO 1.
&L
&V
&`GET-NEXT-NAME.
&j	READ DCYFILE
&t		AT END
&~		GO TO SCN-EXIT.
'
'	MOVE 1 TO PTR.
'	UNSTRING DCYREC INTO NAME-TEMP WITH POINTER PTR.
'&	MOVE 1 TO PTR.
'0	UNSTRING NAME-TEMP DELIMITED BY 'CM '
':		INTO CM-NAME-TEMP WITH POINTER PTR.
'D	IF NAME-TEMP EQUALS CM-NAME-TEMP
'N		GO TO GET-NEXT-NAME.
'X
'b
'l	MOVE NAME-TEMP TO NAME-HOLD (NAME-SUB).
'v	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.
(2	GO TO GET-NEXT-NAME.
(<
(F
(PSCN-EXIT.
(Z	EXIT.
(d
(n
(x
)LIBARYCOMMAND SECTION.
)

P0.
)	IF TOPS-10 WRITE CTL09 FROM 10-LIBARYLINE
) 	ELSE
)*	  WRITE CTL07 FROM LIBARYLINE.
)4	IF IN-LIB
)>		WRITE CTL08 FROM IN-LIBARYNAMELINE
)H		ELSE
)R		WRITE CTL08 FROM OUT-LIBARYNAMELINE.
)\	MOVE SPACE TO OLDNAMEHOLD.
)f	SET NAME-SUB TO 1.
)p
)zNEXT-CTL.
*	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAMEHOLD.
*	IF NAMEHOLD = SPACE GO TO LIB-EXIT.
*	MOVE 1 TO STRINGPTR.
*"	MOVE SPACES TO CTLREC.
*,	MOVE NAME-HOLD (NAME-SUB) TO NAMEHOLD2.
*6	MOVE SPACES TO LASTFEWCHARS OF NAMEHOLD.
*@	STRING LIBARYOPERATION
*J		" "
*T		NAMEHOLD2
*^		","
*h		NAMEHOLD
*r		NAMEEXTENSION DELIMITED BY "  "
*|	  INTO CTLREC WITH POINTER STRINGPTR.
+	WRITE CTL30.
+	IF NAME-LIMIT
+		GO TO LIB-EXIT.
+$	SET NAME-SUB UP BY 1.
+.	GO TO NEXT-CTL.
+8
+B
+LLIB-EXIT.
+V	EXIT.
+`
+jPART2 SECTION.
+tSTART-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.
,&
,0
,:	MOVE OUT-LIBARYNAME TO SUBSTITUTE-NAME.
,D	MOVE IN-LIBARYNAME TO DCYFILENAMEONLY.
,N	OPEN INPUT DCYFILE.
,X	PERFORM STACK-CONTROLFILE-NAMES.
,b	CLOSE DCYFILE.
,l	SET NAME-SUB TO 1.
,v
-
-
INIT-FILES.
-	MOVE ALT-NAME-HOLD (NAME-SUB) TO NAME-TEMP.
-	UNSTRING NAME-TEMP DELIMITED BY SPACE 
-(		INTO FILENAMEIN.
-2	IF FILENAMEIN = SPACE GO TO LEAVE.
-<	MOVE FILENAMEIN TO FILENAMEOUT.
-F
-P	OPEN INPUT INFILE.
-Z	OPEN OUTPUT OUTFILE.
-d
-nGET-NEXT.
-x	READ INFILE AT END GO TO CTT-EXHAUST.
.
.

.SUBSTITUTE-FIRST.
. 	IF LIBID-LINE AND INREC EQUALS MASTER-LINE
.*		WRITE OUTREC08 FROM SUBSTITUTE-LINE
.4		GO TO GET-NEXT.
.>
.H	IF HOST-20 AND DEFDSK 
.R			WRITE OUTREC32 FROM IDLINE
.\			WRITE OUTREC34 FROM ILLINE.
.f	IF HOST-20 AND 20-LOGOUT WRITE OUTREC32 FROM IDLINE.
.p	IF RSETSRC PERFORM HANDLE-SETSRC 
.z		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.
/,	IF FOR-20 AND HOST-20  GO TO MOV-REC.
/6	
/@*
/J*  FUNCTIONALITY HERE TO INCLUDE COMMANDS SPECIFIC TO THE
/T*  ALTERNATE SYSTEM AS COMMENT LINES.  THIS MAY BE ENABLED
/^*  BY SETTING THE DEFAULT VALUE OF COMMENT-OPTION-FLAG TO 1.
/h*
/r	IF WANT-EXTRA-COMMENTS
/|		MOVE COMMENT-CHARACTER TO FIRSTCHAR
0	ELSE
0		GO TO GET-NEXT.
0
0$
0.
08MOV-REC.
0B	MOVE INREC TO OUTREC.
0LWRITE-REC.
0V	IF O4 (8) = SPACE
0`	  IF O4 (4) = SPACE
0j	    IF O4 (2) = SPACE
0t		MOVE 1 TO I GO TO P70
0~	    ELSE
1	      IF O4 (3) = SPACE
1		MOVE 5 TO I GO TO P70
1	      ELSE
1&		MOVE 9 TO I GO TO P70
10	  ELSE
1:	    IF O4 (6) = SPACE
1D	      IF O4 (5) = SPACE
1N		MOVE 13 TO I GO TO P70
1X	      ELSE
1b		MOVE 17 TO I GO TO P70
1l	    ELSE
1v	      IF O4 (7) = SPACE
2		MOVE 21 TO I GO TO P70
2
	      ELSE
2		MOVE 25 TO I GO TO P70
2	ELSE
2(	  IF O4 (12) = SPACE
22	    IF O4 (10) = SPACE
2<	      IF O4 (9) = SPACE
2F		MOVE 29 TO I GO TO P70
2P	      ELSE
2Z		MOVE 33 TO I GO TO P70
2d	    ELSE
2n	      IF O4 (11) = SPACE
2x		MOVE 37 TO I GO TO P70
3	      ELSE
3

		MOVE 41 TO I GO TO P70
3	  ELSE
3 	    IF O4 (14) = SPACE
3*	      IF O4 (13) = SPACE
34		MOVE 45 TO I GO TO P70
3>	      ELSE
3H		MOVE 49 TO I GO TO P70
3R	    ELSE
3\	      IF O4 (15) = SPACE
3f		MOVE 53 TO I GO TO P70
3p	      ELSE
3z		MOVE 57 TO I GO TO P70.
4	IF O4 (16) NOT = SPACES MOVE 61 TO I.
4
4P70.
4"	IF O1 (I + 3) = SPACE
4,	  IF O1 (I + 2) = SPACE
46	    IF O1 (I + 1) = SPACE
4@		NEXT SENTENCE
4J	    ELSE ADD 1 TO I
4T	  ELSE ADD 2 TO I
4^	ELSE ADD 3 TO I.
4h	GO TO 
4r		P70-01
4|		P70-02
5		P70-03
5		P70-04
5		P70-05
5$		P70-06
5.		P70-07
58		P70-08
5B		P70-09
5L		P70-10
5V		P70-11
5`		P70-12
5j		P70-13
5t		P70-14
5~		P70-15
6		P70-16
6		P70-17
6		P70-18
6&		P70-19
60		P70-20
6:		P70-21
6D		P70-22
6N		P70-23
6X		P70-24
6b		P70-25
6l		P70-26
6v		P70-27
7		P70-28
7
		P70-29
7		P70-30
7		P70-31
7(		P70-32
72		P70-33
7<		P70-34
7F		P70-35
7P		P70-36
7Z		P70-37
7d		P70-38
7n		P70-39
7x		P70-40
8		P70-41
8

		P70-42
8		P70-43
8 		P70-44
8*		P70-45
84		P70-46
8>		P70-47
8H		P70-48
8R		P70-49
8\		P70-50
8f		P70-51
8p		P70-52
8z		P70-53
9		P70-54
9		P70-55
9		P70-56
9"		P70-57
9,		P70-58
96		P70-59
9@		P70-60
9J		P70-61
9T		P70-62
9^		P70-63
9h		P70-64
9r		DEPENDING ON I.
9|	DISPLAY "? SOMETHING WRONG WITH THE BINARY TREE " I.
:	STOP RUN.
:P70-01. WRITE OUTREC01. GO TO GET-NEXT.
:P70-02. WRITE OUTREC02. GO TO GET-NEXT.
:$P70-03. WRITE OUTREC03. GO TO GET-NEXT.
:.P70-04. WRITE OUTREC04. GO TO GET-NEXT.
:8P70-05. WRITE OUTREC05. GO TO GET-NEXT.
:BP70-06. WRITE OUTREC06. GO TO GET-NEXT.
:LP70-07. WRITE OUTREC07. GO TO GET-NEXT.
:VP70-08. WRITE OUTREC08. GO TO GET-NEXT.
:`P70-09. WRITE OUTREC09. GO TO GET-NEXT.
:jP70-10. WRITE OUTREC10. GO TO GET-NEXT.
:tP70-11. WRITE OUTREC11. GO TO GET-NEXT.
:~P70-12. WRITE OUTREC12. GO TO GET-NEXT.
;P70-13. WRITE OUTREC13. GO TO GET-NEXT.
;P70-14. WRITE OUTREC14. GO TO GET-NEXT.
;P70-15. WRITE OUTREC15. GO TO GET-NEXT.
;&P70-16. WRITE OUTREC16. GO TO GET-NEXT.
;0P70-17. WRITE OUTREC17. GO TO GET-NEXT.
;:P70-18. WRITE OUTREC18. GO TO GET-NEXT.
;DP70-19. WRITE OUTREC19. GO TO GET-NEXT.
;NP70-20. WRITE OUTREC20. GO TO GET-NEXT.
;XP70-21. WRITE OUTREC21. GO TO GET-NEXT.
;bP70-22. WRITE OUTREC22. GO TO GET-NEXT.
;lP70-23. WRITE OUTREC23. GO TO GET-NEXT.
;vP70-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.
<2P70-30. WRITE OUTREC30. GO TO GET-NEXT.
<<P70-31. WRITE OUTREC31. GO TO GET-NEXT.
<FP70-32. WRITE OUTREC32. GO TO GET-NEXT.
<PP70-33. WRITE OUTREC33. GO TO GET-NEXT.
<ZP70-34. WRITE OUTREC34. GO TO GET-NEXT.
<dP70-35. WRITE OUTREC35. GO TO GET-NEXT.
<nP70-36. WRITE OUTREC36. GO TO GET-NEXT.
<xP70-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.
=*P70-42. WRITE OUTREC42. GO TO GET-NEXT.
=4P70-43. WRITE OUTREC43. GO TO GET-NEXT.
=>P70-44. WRITE OUTREC44. GO TO GET-NEXT.
=HP70-45. WRITE OUTREC45. GO TO GET-NEXT.
=RP70-46. WRITE OUTREC46. GO TO GET-NEXT.
=\P70-47. WRITE OUTREC47. GO TO GET-NEXT.
=fP70-48. WRITE OUTREC48. GO TO GET-NEXT.
=pP70-49. WRITE OUTREC49. GO TO GET-NEXT.
=zP70-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.
>,P70-55. WRITE OUTREC55. GO TO GET-NEXT.
>6P70-56. WRITE OUTREC56. GO TO GET-NEXT.
>@P70-57. WRITE OUTREC57. GO TO GET-NEXT.
>JP70-58. WRITE OUTREC58. GO TO GET-NEXT.
>TP70-59. WRITE OUTREC59. GO TO GET-NEXT.
>^P70-60. WRITE OUTREC60. GO TO GET-NEXT.
>hP70-61. WRITE OUTREC61. GO TO GET-NEXT.
>rP70-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.
?.	CLOSE INFILE OUTFILE
?8	IF NOT NAME-LIMIT SET NAME-SUB UP BY 1
?B	GO TO INIT-FILES.
?LLEAVE.
?V	DISPLAY "END SETUP CONVERT SESSION"
?`	STOP RUN.
?j
?t
?~
@
@HANDLE-SETSRC SECTION.
@	IF HOST-20
@&		MOVE COMMENT-CHARACTER TO FIRSTCHAR.
@0	WRITE OUTREC FROM INREC.
@:
@D
@NGET-STAR-SYS.
@X	READ INFILE AT END
@b		DISPLAY "UNEXPECTED END ON SETSRC LINE"
@l		STOP RUN.
@v	IF NOT STAR-SYS
A		DISPLAY "NO *SYS AFTER .R SETSRC"
A
		STOP RUN.
A
A
A(PUT-STAR-SYS.
A2	IF HOST-20
A<		WRITE OUTREC06 FROM SYS-COMMENT
AF	ELSE
AP		WRITE OUTREC06 FROM INREC.
AZ
Ad
An

* 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 XXX.
R	03  FILLER	PIC XXX.
\	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.

* 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 XXX.
R	03  FILLER	PIC XXX.
\	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".
@		    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 TABTABQUESTION GO TO P3B.
	IF USER AND CHR1 = "?"
	  GO TO P3B.
	IF MONTR AND CHR2 = "?"
"	  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.