SPL,L,O,M 
!     NAME:   FID.
!     SOURCE: 92070-18058 
!     RELOC:  92070-16058 
!     PGMR:   G.A.A.
!     MOD:    G.L.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
! 
      NAME FID.(7) " 92070-1X058  REV.1941  790712" 
! 
! EXTERNAL SUBROUTINES
      LET DR.RD     BE SUBROUTINE,EXTERNAL
      LET NAM..     BE SUBROUTINE,EXTERNAL
! EXTERNAL INTEGERS 
      LET D.LT      BE INTEGER,EXTERNAL          !DISC LAST TRACK 
      LET PK.DR     BE INTEGER,EXTERNAL          !DISC BUF FOR DR.RD
! CONSTANTS 
      LET READI     BE CONSTANT (1) 
! 
! 
FID.: FUNCTION (DS)GLOBAL 
!     THIS ROUTINE RETURNS FALSE IF A FILE SYSTEM EXISTS ON DS
! 
      DR.RD(READI,DS,0)?[GO TO RETF]             !READ THE DIRECTORY
! 
      PDIR8_[PDIR7_[PDIR6_[PDIR5_[PDIR3_[PDIR_@PK.DR]\
         +3]+2]+1]+1]+1 
      TX_$PDIR
      $PDIR_ TX AND 77777K
      NAM..(PK.DR)                               !CHECK ASCII LABEL 
      AREG_ $0
      $PDIR_ TX 
      IF AREG THEN GOTO RETF                     !IF ILLEGAL OR FLAG
      IF TX>0 THEN GOTO RETF                     !NOT SET THEN NO FILE
      IF $(PDIR3 )<0 THEN GOTO RETF              !IF LABEL < 0
      IF $(PDIR7 )-$(PDIR8 )-1 #$D.LT THEN GOTO RETF !LTR MAKE
      IF $(PDIR6 )<$(PDIR5 ) THEN GO TO RETF
      FID.V_ 0
      RETURN
RETF: FID.V_ 1
      RETURN
      END 
! 
      END 
      END$
                                  