SUBROUTINE MICOM_LOCATE(TERMINAL,TX_CIRCUIT,TX_LOCATION)
	IMPLICIT INTEGER (A-Z)
	INCLUDE '($IODEF)/NOLIST'
	INCLUDE '($SSDEF)/NOLIST'
	PARAMETER ( PRMFLG = 1 )
	PARAMETER ( MAX_VAX_PORTS = 12 )
	LOGICAL PASS_ONE/.TRUE./
	INTEGER*2 PID_MBX_IOSB(4)
	INTEGER*4 EXIT_STATUS,DESBLK(4),PORT_LINE_TABLE(MAX_VAX_PORTS)
	CHARACTER PID_MBX*14, PID_MBX_BUF*80, COMMAND*80
	CHARACTER*30 PORT_NAME(MAX_VAX_PORTS)
	CHARACTER*7 TERMINAL,TEMP
	CHARACTER*30 CIRCUIT,LOCATION
	CHARACTER*30 TX_CIRCUIT,TX_LOCATION
	CHARACTER*40 CHARACTERISTICS
	COMMON/PID_MBX/PID_MBX_CHAN,PID_MBX_IOSB,PID_MBX_BUF
	COMMON/CTRL_MASK/OLDMASK
	EXTERNAL EXIT_HANDLER

C Ask MICOM for port status to determine VAX 780 connections BUT..
C only on the first pass.  On the first pass build a table to
C match port names with terminal line number

	IF(.NOT.PASS_ONE) GOTO 1000
	PASS_ONE = .FALSE.
C
C Setup descriptor block for declaring exit handler
	DESBLK(2) = %LOC(EXIT_HANDLER)
	DESBLK(3) = 1
	DESBLK(4) = %LOC(EXIT_STATUS)

C Declare an exit handler
	ISTAT = SYS$DCLEXH(%REF(DESBLK))
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Create the return mailbox name from the PID
	WRITE(PID_MBX,'(6HMICOM_,Z8.8)') PID()

C Create the return mailbox
	ISTAT = SYS$CREMBX(%VAL(PRMFLG),PID_MBX_CHAN,,,,,PID_MBX)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Assign a channel to the detached process mailbox
	ISTAT = SYS$ASSIGN('MICOM_MBX',MICOM_MBX_CHAN,,)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Open input and output files
	OPEN(UNIT=1,FILE='SYS$INPUT',TYPE='OLD',READONLY)
	OPEN(UNIT=2,FILE='SYS$OUTPUT',TYPE='NEW')

C Set the old control mask
	CALL LIB$DISABLE_CTRL('02000000'X,OLDMASK)

C Send port status command to MICOM
	COMMAND = 'STA P1 P12'
	LEN = 10

C Send MICOM command to detached process mailbox
	ISTAT = SYS$QIOW(,%VAL(MICOM_MBX_CHAN),%VAL(IO$_WRITEVBLK),
	1 MICOM_MBX_IOSB,,,%REF(COMMAND),%VAL(LEN),,,,)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Read MICOM reply from PID mailbox
	DO WHILE (.TRUE.)
	   ISTAT = SYS$QIOW(,%VAL(PID_MBX_CHAN),%VAL(IO$_READVBLK),
	1 PID_MBX_IOSB,,,%REF(PID_MBX_BUF),%VAL(80),,,,)
	   IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Look for end of file (end of message)
	   IF (PID_MBX_IOSB(1) .EQ. SS$_ENDOFFILE) GOTO 100
C	   WRITE(2,'(19H PID_MBX_IOSB(2) = ,I2)')PID_MBX_IOSB(2)
D 	   WRITE(2,'(1H ,A)')PID_MBX_BUF(1:PID_MBX_IOSB(2))

C If the port is connected add the line number to the table
	   IF(PID_MBX_BUF(34:37).EQ.'CONN') THEN
		READ(PID_MBX_BUF(2:5),'(I)')INDEX
		READ(PID_MBX_BUF(39:42),'(I)')PORT_LINE_TABLE(INDEX)
	   ENDIF
	ENDDO

100	CONTINUE
D	DO I=1,MAX_VAX_PORTS
D	TYPE *,'PORT',I,' CONNECTED TO LINE',PORT_LINE_TABLE(I)
D	ENDDO

C Open the MICOMLIST file to match VAX ports to MICOM ports
	OPEN(UNIT=4,FILE='SYS$SYSROOT:[SYSMGR.MICOM]MICOMLIST.DAT',
	1 RECORDTYPE='FIXED',ACCESS='DIRECT',TYPE='OLD',READONLY)

C Read the VAX physical device name into table
	DO I=1,MAX_VAX_PORTS
	   READ(4'I)CHARACTERISTICS,PORT_NAME(I),LOCATION
	ENDDO

C OK, PORT_LINE_TABLE contains MICOM port numbers vs line numbers
C PORT_NAME contains port numbers vs names

1000	CONTINUE

C Match the PORT_NAME, use index(I) for PORT_LINE_TABLE for line number,
C and read the terminal record from MICOMLIST.DAT

	DO I=1,MAX_VAX_PORTS
	   IF(PORT_NAME(I)(1:5).EQ.TERMINAL(1:5)) THEN
		IF(PORT_LINE_TABLE(I) .GT. 120) THEN
		    WRITE(6,1010) PORT_LINE_TABLE(I)
1010	FORMAT(' Terminal record ',I3,' is out of range')
		ELSE
		   READ(4'PORT_LINE_TABLE(I))CHARACTERISTICS,
	1 TX_CIRCUIT,TX_LOCATION      
D		   WRITE(6,'(1H ,A6,3H   ,A,A)')PORT_NAME(I),
D	1 TX_CIRCUIT,TX_LOCATION
		   ENDIF
		GOTO 999
	   ENDIF
	ENDDO
C
C If we get here there's no match in the port_name table for this device
	TX_CIRCUIT = 'UNKNOWN'

999	CONTINUE	!SUCCESS

	END

	SUBROUTINE EXIT_HANDLER(ISTAT)
	IMPLICIT INTEGER (A-Z)
	INCLUDE '($SSDEF)/NOLIST'
	INTEGER*2 PID_MBX_IOSB(4)
	CHARACTER PID_MBX_BUF*80
	
	COMMON/PID_MBX/PID_MBX_CHAN,PID_MBX_IOSB,PID_MBX_BUF
	COMMON/CTRL_MASK/OLDMASK

C Delete the permanent mailbox 
	IF (PID_MBX_CHAN .NE. 0) THEN !a mailbox exists so delete it
	    STATUS = SYS$DELMBX(%VAL(PID_MBX_CHAN))
	    IF(STATUS.NE.SS$_NORMAL) CALL LIB$STOP(%VAL(STATUS))
	ENDIF
C Reset CTRL-Y
	CALL LIB$ENABLE_CTRL(OLDMASK)
	
C Call the condition handler for istat
	CALL EXIT(ISTAT)
	END