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 NAMEMC(K,J) C*****TAKES SIX CHARACTERS FROM THE INPUT STREAM AND RETURNS A MACRO C*****FILE NAME IN ANAME C*****RETURNS NAMEMC=-1 IF THE CHARACTER STRING IA AN ILLEGAL C*****NAME I.E.NOT ONLY COMPRISED OF SPACES,ALPHABETIC AND NUMERIC C*****K=2 THE CHAIN STREAM NAME IS USED AS THE INPUT STREAM C*****AND NO CHECKING IS DONE TO THE LETTERS IMPLICIT LOGICAL*1(A) IMPLICIT INTEGER*2(D-Z) COMMON/MAC/AMACRO,AFLAG,ICM,ICN,ANAME(16),IREDNM(4) DIMENSION AEX(6),ADEV(3) COMMON/IN/NA,A(76),LP,ASEMIC,ASPACE COMMON/CH/F,ACHAIN(6) DATA IREDNM(1),IREDNM(4)/3RSY ,3RMCC/ DATA AEX/'.','M','C','C',' ',' '/ DATA ADEV/'S','Y',':'/ IF(K.EQ.2)GOTO 30 C***** ADD DEV NAME DO 1 I=1,3 1 ANAME(I)=ADEV(I) J=4 C*****CHECK FOR VALID CHARACTERS DO 10 I=LP,NA IF(A(I).EQ.ASPACE)GOTO 10 IF(A(I).EQ.ASEMIC)GOTO 12 IF(J.GT.9)GOTO 12 IF(A(I).LT."60)GOTO 50 IF(A(I).LT."71)GOTO 5 IF(A(I).LT."100)GOTO 50 IF(A(I).GT."132)GOTO 50 5 ANAME(J)=A(I) C*****TRANSFER NAME TO ANAME J=J+1 10 CONTINUE IF(J.EQ.5)GOTO 50 DO 14 I=J,9 14 ANAME(I)=ASPACE I=IRAD50(6,ANAME(4),IREDNM(2)) 12 LP=I+1 DO 15 I=1,4 15 ANAME(J+I-1)=AEX(I) C*****ADD EXTENSION MCC 20 ANAME(J+4)=0 NAMEMC=0 RETURN 30 DO 35 I=1,6 35 ANAME(I)=ACHAIN(I) J=7 C*****CHAIN MACRO NAME GOTO 12 50 NAMEMC=-1 C*****INVALID CHARACTERS IN NAME RETURN END