
	Subroutine FTP$GETDVI( Device_Name )
c
	Character	Device_Name*(*)
c
	Include '($JPIDEF)'
	Include 'FTP$DEVINFO.FOR'
c
	Parameter	ITEM_CNT = 27
c
	Integer*4	DVI_ITEMS(ITEM_CNT)
c
	Integer*4	SYS$GETDVIW,	GETDVI_Status
	Integer*4	LIB$GETJPI,	GETJPI_Status
c
	Integer*4	GETDVI_IOSB( 2 )
c
c	*** Build the item list of needed information
c
	Call FTP$MAKE_ITEM_LIST( DVI_ITEMS, DVI_ITEMS )
c
c	*** Get the needed information
c
	GETDVI_Status = SYS$GETDVIW	(			! EFN
	1				,			! CHAN
	1				,	Device_Name	! DEVNAM
	1				,	DVI_ITEMS	! ITMLST
	1				,	GETDVI_IOSB	! ISOB
	1				,			! ASTADR
	1				,			! ASTPRM
	1				,			! NULLARG
	1				)
c
	GETJPI_Status = LIB$GETJPI	(	JPI$_MASTER_PID	! item-code
	1				,			! process-id
	1				,			! process-name
	1				,	FTP$MYPID	! out-value
	1				,			! out-string
	1				,			! out-len
	1				)
c
	If (GETDVI_Status .and. GETJPI_Status) Then
c
c	    *** Check the information to be sure everything is as it should be
c
	    Call FTP$INTERPRET
c
	Else If ( .not. GETDVI_Status ) Then
	    Call Lib$Signal( %Val(GETDVI_Status) )
	    Call Exit
	Else
	    Call Lib$Signal( %Val(GETJPI_Status) )
	    Call Exit
	End If
c
	Return
	End



	Subroutine FTP$INTERPRET
c
	Include 'FTP$FLAGS.FOR'
	Include 'FTP$DEVINFO.FOR'
	Include '($SSDEF)'
	Include '($DEVDEF)'
	Include '($DCDEF)'
	Include '($MTDEF)'
c
c	*** FTP error messages
c
	External	FTP$_NOTTAPE
	External	FTP$_NOTFOREIGN
c
c	*** Check returned information
c
	If ( FTP$DEVCLASS .ne. DC$_TAPE ) Then
	    Call Lib$Signal( FTP$_NOTTAPE )
	    Call Exit
	Else
	    FTP$TAPDEV_FLG = .TRUE.
	    If ( IAND(FTP$DEVCHAR, DEV$M_AVL) .eq. 0 ) Then
		Call Lib$Signal( %Val( SS$_DEVOFFLINE ) )
		Call Exit
	    Else
		FTP$DEVAVL_FLG = .TRUE.
		If ( (FTP$MYPID .ne. FTP$DEVPID) .and.
	1	     (FTP$DEVPID .ne. 0) ) Then
		    Call Lib$Signal( %Val( SS$_DEVALLOC ) )
		    Call Exit
		Else
		    FTP$IOWN_FLG = .True.		    
		    If ( IAND(FTP$DEVCHAR, DEV$M_MNT) .ne. 0 ) Then
			FTP$MOUNTED_FLG = .TRUE.
			If ( IAND(FTP$DEVCHAR, DEV$M_FOR) .eq. 0 ) Then
			    Call Lib$Signal( FTP$_NOTFOREIGN )
			    Call Exit
			Else
			    FTP$MNTFOR_FLG = .TRUE.
			End If	    
		    End If
c
		    FTP$LCK_FLG = (IAND(FTP$DEVDEPEND, MT$M_HWL) .ne. 0)
		    FTP$LST_FLG = (IAND(FTP$DEVDEPEND, MT$M_LOST) .ne. 0)
		    FTP$EOT_FLG = (IAND(FTP$DEVDEPEND, MT$M_EOT) .ne. 0)
		    FTP$EOF_FLG = (IAND(FTP$DEVDEPEND, MT$M_EOF) .ne. 0)
		    FTP$BOT_FLG = (IAND(FTP$DEVDEPEND, MT$M_BOT) .ne. 0)
c
		    FTP$DENSITY = IAND( FTP$DEVDEPEND, MT$M_DENSITY )
		    FTP$DENSITY = ISHFT( FTP$DENSITY, -8 )
c
		    If ( FTP$DENSITY .eq. MT$K_GCR_6250 ) Then
			FTP$DENSITY = 6250
		    Else If ( FTP$DENSITY .eq. MT$K_PE_1600 ) Then
			FTP$DENSITY = 1600
		    Else If ( FTP$DENSITY .eq. MT$K_NRZI_800 ) Then
			FTP$DENSITY = 800
		    Else If ( FTP$DENSITY .eq. MT$K_BLK_833 ) Then
			FTP$DENSITY = 833
		    End If
		End If
	    End If
	End If
c
	Return
	End



	Subroutine FTP$DISPLAY
c
	Include '($DEVDEF)'
	Include '($DCDEF)'
	Include '($MTDEF)'
	Include 'FTP$DEVINFO.FOR'
	Include 'FTP$FLAGS.FOR'
c
	Character*64	Device_Name
	Character*31	Trans_Type
c
10	Format( '0Device name: ', A, '	Label: "', A, '"' )
20	Format( '0Device is owned by process ', Z8.8, /,
	1	'0Block size:  ', I5, '	Block pad char:  ', I5, ' (ASCII)',/,
	1	' Record size: ', I5, '	Record pad char: ', I5, ' (ASCII)',/,
	1	' Density:     ', I5, /,
	1	' Translation:      ', A, /,
	1	' Carriage Control: ', A )

25	Format(	'0Device status is:',//, A )
30	Format( A )
c
	Device_Name = FTP$FULLDEVNAM( :FTP$FULLDEVNAM_LEN )
	Call FTP$GETDVI ( Device_Name( :FTP$FULLDEVNAM_LEN ) )
c
	If ( FTP$TRANSLATE_FLG ) Then
	    If ( FTP$ASCEBC_FLG ) Then
		Trans_Type = 'ASCII to EBCDIC                '
	    Else If ( FTP$EBCASC_FLG ) Then
		Trans_Type = 'EBCDIC to ASCII                '
	    Else
	        Trans_Type = 'USER SUPPLIED TRANSLATION TABLE'
	    End If
	Else
	    Trans_Type = 'NONE                           '
	End If
c
	Type 10, FTP$FULLDEVNAM( :FTP$FULLDEVNAM_LEN ),
	1	 FTP$LABEL( :FTP$LABEL_LEN )
	Type 20, FTP$DEVPID, FTP$BUFSIZ, FTP$BLK_PADCHAR,
	1	 FTP$RECSIZ, FTP$REC_PADCHAR, FTP$DENSITY, Trans_Type,
	1	 FTP$CARRIAGE_CONTROL
c
	If ( FTP$DEVAVL_FLG ) Then
	    Type 25, '$	AVAILABLE'
	Else
	    Type 25, '$	UNAVAILABLE'
	End If
c
	If ( FTP$MOUNTED_FLG ) Then
	    If ( FTP$MNTFOR_FLG ) Then
		Type 30, '+		MOUNTED FOREIGN'
	    Else
		Type 30, '+		MOUNTED FILES-11'
	    End If
	Else
	    Type 30, '+		NOT MOUNTED'
	End If
c
	If ( FTP$LCK_FLG ) Then
	    Type 30, '$	WRITE LOCKED'
	Else
	    Type 30, '$	WRITE ENABLED'
	End If
c
	If ( FTP$LST_FLG ) Then
	    Type 30, '+		POSITION UNKNOWN'
	Else
	    Type 30, '+		POSITION KNOWN'
	End If
c
	If ( FTP$EOT_FLG ) Then
	    Type 30, '$	AT END OF TAPE'
	Else
	    Type 30, '$	NOT AT END OF TAPE'
	End If
c
	If ( FTP$EOF_FLG ) Then
	    Type 30, '+	AT END OF FILE MARKER'
	Else
	    Type 30, '+	NOT AT END OF FILE'
	End If
c
	If ( FTP$BOT_FLG ) Then
	    Type 30, ' 	AT BEGINNING OF TAPE'
	Else
	    Type 30, ' 	NOT AT BEGINNING OF TAPE'
	End If
c
	Type 30, ' '
c
	Return
	End
	    


	Subroutine FTP$Make_Item_List( DVI_ITEMS, DVI_LISTS )
c
	Implicit NONE
c
	Parameter	ITEM_CNT = 27
c
	Integer*4	DVI_ITEMS( ITEM_CNT )
c
	Integer*2	DVI_LISTS(2, ITEM_CNT )
c
	Include '($DVIDEF)'
	Include 'FTP$DEVINFO.FOR'
c
c	*** Build the item list
c
c	    *** Bit vector of device independent characteristics
c
	    DVI_LISTS( 1, 1) = 4
	    DVI_LISTS( 2, 1) = DVI$_DEVCHAR
	    DVI_ITEMS( 2) = %Loc(FTP$DEVCHAR)
	    DVI_ITEMS( 3) = %Loc(FTP$DUMMY)	! Always 4 bytes returned
c
c	    *** Second bit vector of device independent characteristics 
c	
	    DVI_LISTS( 1, 4) = 4
	    DVI_LISTS( 2, 4) = DVI$_DEVCHAR2
	    DVI_ITEMS( 5) = %Loc(FTP$DEVCHAR2)
	    DVI_ITEMS( 6) = %Loc(FTP$DUMMY)	! Always 4 bytes returned
c
c	    *** Device Class
c
	    DVI_LISTS( 1, 7) = 4
	    DVI_LISTS( 2, 7) = DVI$_DEVCLASS
	    DVI_ITEMS( 8) = %Loc(FTP$DEVCLASS)
	    DVI_ITEMS( 9) = %Loc(FTP$DUMMY)	! Always 4 bytes returned
c
c	    *** Owner PID
c
	    DVI_LISTS( 1,10) = 4
	    DVI_LISTS( 2,10) = DVI$_PID
	    DVI_ITEMS(11) = %Loc(FTP$DEVPID)
	    DVI_ITEMS(12) = %Loc(FTP$DUMMY)
c
c	    *** Bit vector of device dependent characteristics
c
	    DVI_LISTS( 1,13) = 4
	    DVI_LISTS( 2,13) = DVI$_DEVDEPEND
	    DVI_ITEMS(14) = %Loc(FTP$DEVDEPEND)
	    DVI_ITEMS(15) = %Loc(FTP$DUMMY)	! Always 4 bytes returned
c
c	    *** Second bit vector of device dependent characteristics 
c	
	    DVI_LISTS( 1,16) = 4
	    DVI_LISTS( 2,16) = DVI$_DEVDEPEND2
	    DVI_ITEMS(17) = %Loc(FTP$DEVDEPEND2)
	    DVI_ITEMS(18) = %Loc(FTP$DUMMY)	! Always 4 bytes returned
c
c	    *** Full device name - includes node specification
c
	    DVI_LISTS( 1,19) = 64
	    DVI_LISTS( 2,19) = DVI$_FULLDEVNAM
	    DVI_ITEMS(20) = %Loc(FTP$FULLDEVNAM)
	    DVI_ITEMS(21) = %Loc(FTP$FULLDEVNAM_LEN)
c
c	    *** Device volume name
c
	    DVI_LISTS( 1,22) = 12
	    DVI_LISTS( 2,22) = DVI$_VOLNAM
	    DVI_ITEMS(23) = %Loc(FTP$LABEL)
	    DVI_ITEMS(24) = %Loc(FTP$LABEL_LEN)
c
c	    *** Mark end of options
c
	    DVI_LISTS( 1,25) = 0
	    DVI_LISTS( 2,25) = 0
	    DVI_ITEMS(26) = 0
	    DVI_ITEMS(27) = 0
c
	Return
	End
