FTN4,Q,C SUBROUTINE XVRFY(LU,IDVID,ISC, IS1,IS2, IER),92067-1X530 REV.2040 X800717 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: XVRFY C SOURCE: 92067-18530 C RELOC: PART OF 92067-12002 C PGMR: J.S.W C DIMENSION IBUF(20) C C C C VERIFY C C IUNIT=IAND(IDVID,177400B)/256 ID=IAND(IDVID,7B) IF(IFDVR(LU).EQ.0) GO TO 500 C C C 1 CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.2.OR.IER.EQ.4) RETURN IBUF(1)=440B+ID CALL XPRTY(IBUF(1)) IBUF(2)=550B C OP CODE C IBUF(3)=7 IBUF(4)=IUNIT IBUF(5)=IAND(ISC,177400B)/256 IBUF(6)=IAND(ISC,377B)+1000B IBUF(7)=100677B C C CALL ZCTRL(LU,IBUF) CALL XDSJ(LU,IDVID,IER) IF(IER.EQ.4) GO TO 900 CALL XSTAT(LU,IDVID,IS1,IS2,IXX) RETURN C 900 IER=4 RETURN C 500 IBUF(1)=ID IBUF(2)=-2 IBUF(3)=103600B+ID IBUF(4)=ISC REG=EXEC(1,LU+2200B,IBUF,4,1,0) IS1=IBUF(2) IS2=IBUF(3) RETURN END END$