SUBROUTINE FILESCAN(filename,
     +	  filespec,len_filespec,dev,len_dev,dir,len_dir)
C 
C FUNCTIONAL DESCRIPTION:	
C
C   FILESCAN uses the system service SYS$FILESCAN to parse an input filename
C   string. It returns the NAME+TYPE+VERSION, the DEVICE  and the DIRECTORY
C   as separate entities. 
C
C DUMMY ARGUMENTS:
C
C	FILENAME	Character   Read    Input file name to be parsed
C	FILESPEC	Character   Write   NAME+TYPE+VERSION from FILENAME
C	LEN_FILESPEC	Integer*4   Write   Length of FILESPEC in characters
C	DEV		Character   Write   DEVICE portion of FILENAME
C	LEN_DEV		Integer*4   Write   Length of DEV in characters
C	DIR		Character   Write   DIRECTORY protion (with [])
C	LEN_DIR		Integer*4   Write   Length of DIR in characters	   
C 
C IMPLICIT INPUTS:
C 
C    none
C 
C IMPLICIT OUTPUTS:
C 
C    none
C 
C SIDE EFFECTS:
C 
C  1.) If the input FILENAME contains a node specification (NODE::), the 
C      routine will signal NONET and abort.
C  2.) If the length of the NAME protion of the input FILENAME is less than
C      1, the routine will signal BADFILENM and abort.
C  3.) If SYS$FILESCAN completes with an error status, it will be signalled
C      and the program will abort.
C
C            C H A N G E   L O G
C
C       Date     | Name  | Description
C----------------+-------+-----------------------------------------------------
C  17-Mar-1989   |  ATS  | Initial coding
C----------------+-------+-----------------------------------------------------
C   [change_entry]

        IMPLICIT NONE

        INCLUDE '($FSCNDEF)'

        CHARACTER*(*) filename,filespec,dev,dir
	INTEGER*4 len_filespec,len_dev,len_dir

	STRUCTURE/ITMLST/
          UNION
            MAP
              INTEGER*2 buflen,icode
              INTEGER*4 adr
            END MAP
            MAP
              INTEGER*4 END_LIST/0/
            END MAP
          END UNION
	END STRUCTURE
	RECORD/ITMLST/fscn(7)

	INTEGER*4 first,ist,b,e,i,ll, SYS$FILESCAN
	INTEGER*4 DISKCHG_BADFILENM, DISKCHG_NONET, DISKCHG_ERRSRC
	EXTERNAL  DISKCHG_BADFILENM, DISKCHG_NONET, DISKCHG_ERRSRC

	IF(first.EQ.0) THEN
	  first=1
          fscn(1).icode = FSCN$_NODE
	  fscn(2).icode = FSCN$_DEVICE
	  fscn(3).icode = FSCN$_DIRECTORY
          fscn(4).icode = FSCN$_NAME
          fscn(5).icode = FSCN$_TYPE
	  fscn(6).icode = FSCN$_VERSION
	ENDIF

        ist = sys$filescan (%DESCR(filename), fscn,)
	IF(.NOT.ist) CALL LIB$STOP(DISKCHG_ERRSRC,
     +      %VAL(2),'FILESCAN',
     +      'Error scanning input filename',
     +      %VAL(ist))
C 
C Make sure we don't try this across the net. This may work, but QIO won't.
C
	IF(fscn(1).buflen.NE.0) CALL LIB$STOP(DISKCHG_NONET)
C 
C If the file NAME portion has 0 length, signal a problem.
C
	IF(fscn(1).buflen.NE.0) CALL LIB$STOP(DISKCHG_BADFILENM)
C
C Piece together the NAME, TYPE and VERSION. This is messy since
C SYS$FILESCAN returns the address within the original string where the
C pieces are found.
C
	DO i=2,6
	  b=fscn(i).adr - %LOC(filename) + 1	!beginning offset into filename
	  e=b+fscn(i).buflen-1			!ending offset of this piece
	  IF(fscn(i).buflen.GT.0) THEN
  	    IF(i.EQ.2) THEN			!Return DEVICE info
	      dev=filename(b:e)
	      len_dev=fscn(i).buflen
            ELSE IF(i.EQ.3) THEN                !Return DIRECTORY
              dir=filename(b:e)
              len_dir=fscn(i).buflen
	    ELSE IF(i.EQ.4) THEN		!Initialize "trimmed" filespec
              filespec=filename(b:e)
	      len_filespec=fscn(i).buflen	!Initialize total length
	    ELSE
	      filespec=filespec(:ll)//filename(b:e)
	      len_filespec=len_filespec+fscn(i).buflen
	    ENDIF
	  ENDIF
	ENDDO
	RETURN
	END