FTN4
      SUBROUTINE XEND(LU,IDVID),92067-1X539 REV.2040 800717 
C*****************************************************************
C*                                                               *
C*  (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS       *
C*  RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,        *
C*  REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE     *
C*  WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD     *
C*  COMPANY.                                                     *
C*                                                               *
C*****************************************************************
C 
C     NAME:  XEND 
C   SOURCE:  92067-18539
C    RELOC:  PART OF 92067-12002
C     PGMR:  J.S.W
C 
C 
      DIMENSION IBUF(6) 
C 
C SEND END COMMAND
C 
      ID=IAND(IDVID,7B) 
C 
      IF(IFDVR(LU).EQ.0) GO TO 500
      IBUF(1)=440B+ID 
      CALL XPRTY(IBUF(1)) 
      IBUF(2)=550B
      IBUF(3)=25B 
      IBUF(4)=1000B 
      IBUF(5)=100677B 
      CALL ZCTRL(LU,IBUF,5) 
      RETURN
C 
C 
C 13037 DISC
C 
500   IBUF(1)=0 
      IBUF(2)=-1
      IBUF(3)=112400B 
      REG=EXEC(1,LU+2200B,IBUF,5,1,0) 
      RETURN
      END 
      END$
                      