	subroutine micom_show_ch(micom_calling,micom_called,micom_connections)
	IMPLICIT INTEGER (A-Z)
	character*(*) micom_calling(*), micom_called(*)
	integer micom_connections	! number of connections found
c  send show channels command to Micom and get response, building tables

c procedure:
C  build tables by asking Micom about all channels

	INCLUDE '($IODEF)/NOLIST'
	INCLUDE '($SSDEF)/NOLIST'

	PARAMETER ( PRMFLG = 1 )
	PARAMETER ( MAX_VAX_PORTS = 32 )  ! max chem switch ports

	LOGICAL PASS_ONE/.TRUE./  ! initial value makes act like DATA statement
				  ! so value lasts between calls
	LOGICAL QUESTION	! flag syntax error response from Micom
	INTEGER*4 EXIT_STATUS,DESBLK(4)
	CHARACTER*4 PORT_LINE_TABLE(0:31) /32*'NONE'/
			! each VAX resource class MICOM channel
			! is numbered from 1/73 to 1/104 (MAX_VAX_PORTS of them)
			! table contains chem switch access group
			! Micom shelf/channel indexed by
			! the VAX resource class Micom channel 
			! it is connected to (shelf always 1)
	CHARACTER PID_MBX*14, COMMAND*80
 	CHARACTER*30 PORT_NAME(MAX_VAX_PORTS)
	CHARACTER*7 TEMP
	CHARACTER*30 USER_CIRC, LOCATION
	CHARACTER*40 CHARACTERISTICS
	character*5 calling_chan, called_chan
	character*5 dummy
	character*4 flag

	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

	EXTERNAL EXIT_HANDLER


C Ask MICOM for channel status to determine connections
C build tables to match calling and called channels

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  (why permanent ???)
	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 debug output file ??? why
D	OPEN(UNIT=2,FILE='SYS$OUTPUT',TYPE='NEW',carriagecontrol='list')

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

C Send port status command to MICOM  asking about Chem switch Micom calling chan
	COMMAND = 'SHOW CH ALL'	! ???  maybe should ONLY ask about specific chan
				! but then have to ask several times
	LEN = 11

50	continue	! comes here to retry ?
	question = .false.
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 lines from PID mailbox
	I=0
	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 response message)  ??? should watch for overrun ?
	   IF (PID_MBX_IOSB(1) .EQ. SS$_ENDOFFILE) then
		if(retry.gt.3) goto 200	! give up and return whatever we got
		if(question) goto 50	! try again
                goto 200		! if no question, done
	   ENDIF

	   if(question) goto 100  ! read but ignore all lines after '?' line

	   MBXLEN = PID_MBX_IOSB(2)
C	   WRITE(2,'(10H mbxlen = ,I3)') MBXLEN
D 	   WRITE(2,'(1H ,A)')PID_MBX_BUF(1:PID_MBX_IOSB(2))

	   IF( MBXLEN.LT.5 ) GOTO 100 ! ignore blank lines
	   IF(  INDEX( PID_MBX_BUF(1:MBXLEN), '?' ) .NE. 0  ) then
		question = .true.
		retry = retry + 1
		print *,'trouble talking to Micom, retry=',retry
	        goto 100	! ignore line
	   ENDIF
c---------+---------+---------+---------+---------+---------+---------+---------+
c         1         2         3         4         5         6         7         8
c12345678901234567890123456789012345678901234567890123456789012345678901234567890
c---------+---------+---------+---------+---------+---------+---------+---------+
c  01/026  PG=17 AG=26   DG=NONE CONN  9600 TTJ1     CALLING   01/074  
C If the port is connected add the shelf/chan number to the table
	   IF( PID_MBX_BUF(33:36).NE.'CONN' ) GOTO 100 ! disconnected, ignore
c  ignore duplicate entries  (could verify identical ???)
	   IF( INDEX( PID_MBX_BUF(53:62), 'CALLED BY ' ) .GT. 0
	1						 ) GOTO 100
	   I = I+1
	   micom_calling(I) = PID_MBX_BUF(4:8)
	   micom_called(I) = PID_MBX_BUF(64:68)
d	   print *,'micom_calling,micom_called=',
d	1	micom_calling(i),micom_called(i)
100	   CONTINUE	! comes here to ignore non-connected
	ENDDO

200	CONTINUE
d	print *,' done talking to Micom'
c  clean up after talking to Micom
	STATUS= SYS$DELMBX(%VAL(PID_MBX_CHAN))
	if(.not.status) then
		write(6,*) 'ERR- cant delete Micom reply MBX'
	endif
C  Deassign channel to the detached process mailbox
	ISTAT = SYS$DASSGN(%VAL(MICOM_MBX_CHAN))
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

	CALL LIB$ENABLE_CTRL(OLDMASK)

	micom_connections = I
d	print *,' micom_connections=',micom_connections

	return
	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
