FTN FUNCTION MEMBR(IBASE,DSNUM,DINUM,ISTAT),92069-16061 REV.1912 780915 LOGICAL MEMBR INTEGER IBASE(10),DSNUM,DINUM,ISTAT(10) C C C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WIOTH OUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18097 C RELOC: 92069-16060 C C C****************************************************************: C C C C C C ABSTRACT: C C THIS IS A LOGICAL FUNCTION THAT DETERMINES WHETHER A ITEM IS C A MEMBER OF A DATA SET. C C CALLING SEQUENCE: C C CALL MEMBR(IBASE,DSNUM,DINUM,ISTAT) C C WHERE: C C IBASE C IS THE BASE PARAMETER OF THE DATA BASE C C DSNUM C IS THE DATA SET NUMBER OR IS ZERO WHEN THE DATA SET IS C NOT YET DECLARED. C C DINUM C IS THE ITEM NUMBER C C ISTAT C IS A TEN WORD INTEGER ARRAY USED FOR A DBMS STATUS C ARRAY C C C ON EXIT: C C MEMBR = .TRUE. WHEN THE ITEM IS A MEMBER OF THE DATA SET C MEMBR = .FALSE. WHEN IT IS NOT C C DSNUM = DATA SET NUMBER WHEN THE DATA SET IS IMPLIED C FROM THE ITEM NUMBER. THE DATA SET CAN ONLY C BE IMPLIED FROM THE DATA ITEM WHEN THE ITEM BELONGS C TO ONLY ONE SET. C C ISTAT WILL CONTAIN A DBMS ERROR CODE IN THE FIRST WORD C C INTEGER IBUF(51) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C DOES NOT NEED COMMON C C C C C C C BEGIN C C C VERIFY ITEM BELONGS TO DECLARED SET C MEMBR = .FALSE. CALL DBINF(IBASE,DINUM,204,ISTAT,IBUF) IF(ISTAT .NE. 0) GOTO 50 C C IF THERE ISN'T A SET DECLARED YET, THEN LET THIS C ITEM NUMBER DETERMINE THE SET NAME C IF(DSNUM .NE. 0) GOTO 20 IF(IBUF .NE. 1) GOTO 50 DSNUM = IABS(IBUF(2) ) GOTO 40 C C BE SURE ITEM BELONGS TO SET WHEN IT IS ALREADY DECLARED C 20 CONTINUE DO 30 I=2,IBUF(1) + 1 IF(DSNUM .EQ. IABS(IBUF(I))) GOTO 40 30 CONTINUE GOTO 50 C C ITEM'S SET IS GOOD C 40 CONTINUE MEMBR = .TRUE. 50 CONTINUE RETURN END