C****************************************************************
C* 								*
C*								*
C*	DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY *
C*	EITHER FOR THE CREATION OR FOR THE CLINICAL EFFICACY	*
C*	OF THIS PROGRAM. USERS MUST ASSUME FULL RESPONSIBILITY	*
C*	FOR ANY RESULTS OR DIAGNOSES OBTAINED FROM THE USE	*
C*	OF THIS PROGRAM. QUESTIONS ON THE EXECUTION OF THIS	*
C*	PROGRAM MUST BE REFERRED BACK TO THE ORIGINAL AUTHOR.	*
C*								*
C* AUTHOR:	SALLY FORSTER					*
C*		C/O DEPARTMENT OF NUCLEAR MEDICINE		*
C*		GUY'S HOSPITAL				*
C*		LONDON, ENGLAND					*
C*								*
C*		TEL: 01-407-7600 EXT 2583/4			*
C*								*
C****************************************************************
	FUNCTION MACED
	IMPLICIT LOGICAL*1(A)
	IMPLICIT INTEGER*2(D-Z)
	INTEGER*2 ITEMP(8)
	LOGICAL*1 IBYT(12)
	COMMON/IN/NA,A(76)
	COMMON/MAC/AMACRO,AFLAG,ICM,ICN,ANAME(16),IREDNM(4)
	DATA IBAK/3RBAK/
D	PAUSE ' IN CMACED'
	IF(AMACRO)GOTO 100
	MACED=1
D	PAUSE ' CMACED'
	IF(LOOKUP(ICM,IREDNM).LT.0)GOTO 160
	CALL CLOSEC(ICM)
	CALL IFREEC(ICM)
1	OPEN(UNIT=ICN,NAME=ANAME,TYPE='NEW',ERR=155)
	OPEN(UNIT=ICM,NAME=ANAME,TYPE='OLD',ERR=154)
C
C	SET UP BACKUP NAME
C
	DO 2 I = 1,3
	ITEMP(I) = IREDNM(I)
2	ITEMP(I+4) = IREDNM(I)
	ITEMP(4) = IREDNM(4)
	ITEMP(8) = IBAK
D	CALL R50ASC(12,ITEMP(5),IBYT)
D	WRITE(7,405)(IBYT(I),I=1,12)
D405	FORMAT(' ',12A1)
D	CALL R50ASC(12,IREDNM,IBYT)
D	WRITE(7,405)(IBYT(I),I=1,12)
	ICF = IGETC()
	IF (ICF.LT.0) STOP ' NO CH ICF'
	IJ = IRENAM(ICF,ITEMP)
	OLNE=1
5	WRITE(7,200)
	READ(5,210)NLNE
	IF(NLNE.GE.OLNE)GOTO 9
C*****COPY REST OF FILE ACROSS
7	READ(ICM,220,END=8,ERR=152)NA,A
	WRITE(7,400)NA,(A(I),I=1,76)
400	FORMAT(' LINE ',I6,'     ',76A1)
	WRITE(ICN,225,ERR=140,END=140)NA,A
	GOTO 7
8	CLOSE(UNIT=ICM)
	CLOSE(UNIT=ICN)
	IF(NLNE.EQ.0)	GOTO 500		!RETURN
C*****START AGAIN
	WRITE(7,270)
	GOTO 1
C*****PRINT FILE TO REQUESTED LINE AND COPY TO ICN
9	DO 10 I=OLNE,NLNE
	READ(ICM,220,END=20,ERR=152)NA,A
	IF(I.NE.NLNE)WRITE(ICN,225,END=140,ERR=140)NA,A
10	WRITE(7,230)I,(A(K),K=1,NA)
	WRITE(7,240)
	GOTO 25
20	WRITE(7,280)
25	READ(5,250)NA,A
	IF(NA.GT.0)WRITE(ICN,225,END=140,ERR=140)NA,A
	OLNE=NLNE+1
	GOTO 5
100	MACED=-1
	GOTO 500
C	RETURN
C*****ICM CLOSED IN MASTER
140	WRITE(7,260)
152	ITEMP(4) = IBAK
	ITEMP(8) = IRENAM(4)
	IJ=IRENAM(ICF,ITEMP)
	WRITE(7,300)IJ
300	FORMAT(' RENAME',I6)
	CLOSE(UNIT=ICM)
154	CLOSE(UNIT=ICN)
155	MACED=0
	GOTO 500
C	RETURN
160	WRITE(7,205)
	GOTO 500
500	CALL CLOSEC(ICF)
	CALL IFREEC(ICF)
	RETURN
200	FORMAT(1X,'LINE NO(0 TO END):',$)
205	FORMAT(1X,'FILE NOT FOUND')
210	FORMAT(I6)
220	FORMAT(I6,76A1)
225	FORMAT(' ',I6,76A1)!	WAS' ',I6  ETC
230	FORMAT(1X,'LINE:',I6,'-',76A1)
240	FORMAT(1X,'REPLACEMENT:')
250	FORMAT(Q,76A1)
260	FORMAT(1X,'NO ROOM FOR FILE')
270	FORMAT(1X,'REWOUND')
280	FORMAT(1X,'ADD:')
	END