C/CS.FT 	MH,ICD 8/30/74	LAST MOD: 10/30/74
C
C COPY SHIFT WITH LABELING.
C
C .FORT
C *CS<CS
C .LOADER
C *UTILTY,IOH,CS$     UTILTY,IOH ON MH#1
C
	DIMENSION IN(65),ITL(4),NAM(5)
	EQUIVALENCE (IN,NAM)
502	READ(1,104) NAM
104	FORMAT('FILE? '3A2' EXT? 'A2' UNIT? 'O2)
	READ(1,105) IC
105	FORMAT('OK? 'R1)
	IF(IC-25)502,512,502
512	CALL I0PEN(NAM,NAM(4))
C
C BLANK NAME ITL FOR NO HEADER OPTION.
C
505	READ(3,100) IN
	DO 511 I=1,4
511	ITL(I)=-2016
S	CPAGE 4
S	CALL 0,EOF
S	JMP \502	/NEXT FILE
S	JMP \510	/PAGE EJECT IF EOR ON FIRST LINE
C
C TRANSFER NAME LINE TO ITL, PRINT IT WITH INITIAL PAGE EJECT.
C
508	DO 507 I=1,4
507	ITL(I)=IN(I)
C
C PAGE EJECT, TITLE, DATE ON FIRST LINE.
C
S	TAD \ITL
S	AND (77
S	TAD (4000	/BLANK FIRST CHR
S	DCA \ITL
	WRITE(3,102) ITL
102	FORMAT('1'4A2,9X'DATE: 'D'   '55('*')//)
	IC=1
	GOTO 506
C
C PAGE EJECT FOR EOR ON FIRST LINE OF FILE.
C
510	WRITE(3,103)
103	FORMAT('1')
	IC=0
C
500	READ(3,100) IN
100	FORMAT(65A2)
C
C INPUT LINE COUNT MOD 1000.
C
	IC=IC+1
	IF(IC-1000)504,509,504
509	IC=0
S	CPAGE 4
S\504,	CALL 0,EOF
S	JMP \502	/EOF-QUIT CS
S	JMP \505	/EOR-PAGE EJECT
C
C FIND LAST NONBLANK WORD - TRIM BLANKS.
C
506	KK=66
	DO 503 K=1,65
	KK=KK-1
	IF(IN(KK)+2016)501,503,501
503	CONTINUE
	WRITE(3,101) ITL,IC
	GOTO 500
501	WRITE(3,101) ITL,IC,(IN(K),K=1,KK)
101	FORMAT(X4A2,I4,5X65A2)
	GOTO 500
	END