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 MACCRE() C*****CREATES A MACRO IN FILE ANAME BY COPYING LINES OF C*****INPUT TO THE FILE C*****RETURNS MACCRE =-1 IF THE COMMAND IS GIVEN IN A MACRO. C*****RETURNS MACCRE=0 FOR AN OPEN ERROR IMPLICIT LOGICAL*1(A) IMPLICIT INTEGER*2(D-Z) COMMON/IN/NA,A(76) COMMON/MAC/AMACRO,AFLAG,ICM,ICN,ANAME(16),IREDNM(4) MACCRE=1 IF(AMACRO)GOTO 100 IF(LOOKUP(ICM,IREDNM).LT.0)GOTO 10 CALL CLOSEC(ICM) CALL IFREEC(ICM) WRITE(7,200) READ(5,210)ANS IF(ANS.NE.'Y')GOTO 150 10 OPEN (UNIT=ICM,NAME=ANAME,TYPE='NEW',ERR=150) K=1 20 WRITE(7,205)K READ(5,220)NA,A IF(NA.EQ.0)GOTO 30 WRITE(ICM,230,ERR=140,END=140)NA,A K=K+1 GOTO 20 30 CLOSE(UNIT=ICM) RETURN 100 MACCRE=-1 RETURN C*****ICM WILL BE CLOSED IN MASTER 140 CLOSE(UNIT=ICM) WRITE(7,240) MACCRE=0 150 RETURN C*****DISK ERROR 200 FORMAT(1X,'FILE ALREADY EXISTS,OVERWRITE?(Y/N):',$) 205 FORMAT(1X,I6,':',$) 210 FORMAT(A1) 220 FORMAT(Q,76A1) 230 FORMAT(' ',I6,76A1) 240 FORMAT(1X,'EDIT FILE ERROR?NO ROOM') END