FTN 
      SUBROUTINE DPTH(INUM,IINDX,PTHCT,IERR),92069-16015 REV.2026 800421
      INTEGER PTHCT 
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 WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18044
C     RELOC:     92069-16015
C 
C     ALTERED:   JANUARY 22, 1980 FOR SORTED CHAINS AND MULTIPLE
C                                 LINKING FEATURES - CEJ
C 
C 
C****************************************************************:
C 
C SUBROUTINE DPTH 
C 
C 
C ABSTRACT: 
C   DPTH PROCESSES THE PATH DEFINITION IN AN ENTRY: COMMAND 
C   FOR DETAIL DATA SETS. 
C 
C INPUT:
C   INUM IS THE ITEM NUMBER FOR WHICH THIS PATH IS SPECIFIED
C   IINDX IS THE ITEM TABLE INDEX INTO ROOT FOR THE ABOVE 
C   PTHCT IS THE CURRENT COUNT OF PATHS DEFINED 
C   IERR IS THE ERROR INDICATOR FOR ALL THAT HAS HAPPENED 
C      IN THE ENTRY PROCESSOR 
C      0 IMPLIES NO ERROR 
C     -1 IMPLIES ERRORS 
C 
C OUTPUT: 
C   IERR CONTAINS AN ERROR INDICATOR
C     0 IMPLIES NO ERROR
C    -1 IMPLIES ERRORS
C 
C 
      INTEGER SNDX2,STYP,SNUM,HASH
      INTEGER WLEV,WLEV2
      INTEGER STYP2 
      INTEGER PCNT,PTR
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980
C 
C 
C                      CONSTANTS IN INTEGER 
C 
C 
C 
      INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 
     1       CAP,CNTRL,COLON,COMMA,CRDLM, 
     2       DATA,DETAIL,DOLLR,DOT, 
     3       ELSE,END,ENTY,EQUAL,ERR, 
     4       FIELD, 
     5       ICODE,INTGR,ITM, 
     6       LEVL,LPARN,LST,
     7       MANU,MXCAP,MAXRC,
     8       MXELE,MXENT,MXITM,MXLEV,MXSTR, 
     9       NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO,
     C       NOLST,NORES,NOTAB, 
     1       OPSET, 
     2       PMAX,
     3       ROOTR,RPARN, 
     4       SEMI,SET,SMAX, 
     5       UPPER
C 
C 
C 
C 
C                      DATA BASE OFFSETS
C 
C 
C 
      INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP,
     1       DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 
     2       DBLVE
C 
C 
C 
C                     ITEM TABLE OFFSETS
C 
C 
C 
      INTEGER ITNME,ITINF,ITTYP,ITSCT,
     1       ITSNO,ITECT,ITLNG,ITMSZ,ITMST
C 
C 
C                     DATA SET TABLE OFFSETS
C 
C 
      INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT,
     1       DSITP,DSCAP,DSCCT,DSPAN,SETSZ
C 
C 
C 
C               OFFSET TO OVERHEAD RECORD 
C 
C 
C 
      INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC 
C 
C 
C 
C              ERROR MESSAGES 
C 
C 
      INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 
     1       DUPIT,ITLIM,ILITP,FLDER,ILXTP, 
     2       ILWR,ILTRM,NAMX,DUPST,STLIM, 
     3       ENTYX,NOITM,BDSET,BDKEY,DUPHS, 
     4       NOPTH,AERR,RCLIM,CAPX,ILCAP, 
     5       EMPTY,MXERR,EOF,NOSEG,NOMEM, 
     6       DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 
     7       ILRD,ILRNG,SETX,IGNSC,INMX,
     8       PTDUP,DBKEY,ENDX,PDEFC,SIMPT,
     9       BDCNT,RTERR,GOODS,GOODR,BADS,
     C       BADR,ABORT,OPNER,XCNTR,ILLVN,
     1       SRCH2,UEND,XITM,ELERR,ROTER, 
     2       UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 
     3       ILLSC,MORIT,ILPTH,DEFIT, 
     4       ILSRT,SIMPS,UNDST
C 
C 
C                 VARIABLES 
C 
C 
C 
      INTEGER CARD,CHAR,CODE,CRDPR
      REAL CPACK
      INTEGER DSEC,DCRN 
      INTEGER ENTL,ERROR
      LOGICAL NMFLG 
      INTEGER FWAM
      INTEGER GGERR 
      INTEGER ICNT,IDCB,INDX
      INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB
      INTEGER KPACK 
      INTEGER LDCB,LGLOB,LIST,LWAM
      INTEGER MEDIA 
      INTEGER NPACK,NSETS 
      INTEGER OVRHD 
      INTEGER PTHTB 
      INTEGER RDEF,RESNO,RFILE,RINDX
      INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE
      INTEGER TYPE,PRGFLG 
C 
C 
C    EXTERNAL REFERENCES
C 
C 
      INTEGER ROOTA 
C 
C                      CONSTANTS IN COMMON
C 
C 
C 
      COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 
     1       CAP,CNTRL,COLON,COMMA,CRDLM, 
     2       DATA,DETAIL,DOLLR,DOT, 
     3       ELSE,END,ENTY,EQUAL,ERR, 
     4       FIELD, 
     5       ICODE,INTGR,ITM, 
     6       LEVL,LPARN,LST,
     7       MANU,MXCAP(2),MAXRC, 
     8       MXELE,MXENT,MXITM,MXLEV,MXSTR, 
     9       NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10),
     C       NFO(10), 
     C       NOLST,NORES,NOTAB, 
     1       OPSET, 
     2       PMAX,
     3       ROOTR,RPARN, 
     4       SEMI,SET,SMAX, 
     5       UPPER
C 
C 
C 
C 
C                      DATA BASE OFFSETS
C 
C 
C 
      COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 
     1       DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 
     2       DBLVE
C 
C 
C 
C                     ITEM TABLE OFFSETS
C 
C 
C 
      COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 
     1       ITSNO,ITECT,ITLNG,ITMSZ,ITMST
C 
C 
C                     DATA SET TABLE OFFSETS
C 
C 
      COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 
     1       DSITP,DSCAP,DSCCT,DSPAN,SETSZ
C 
C 
C 
C               OFFSET TO OVERHEAD RECORD 
C 
C 
C 
      COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC
C 
C 
C 
C              ERROR MESSAGES 
C 
C 
      COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV,
     1       DUPIT,ITLIM,ILITP,FLDER,ILXTP, 
     2       ILWR,ILTRM,NAMX,DUPST,STLIM, 
     3       ENTYX,NOITM,BDSET,BDKEY,DUPHS, 
     4       NOPTH,AERR,RCLIM,CAPX,ILCAP, 
     5       EMPTY,MXERR,EOF,NOSEG,NOMEM, 
     6       DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 
     7       ILRD,ILRNG,SETX,IGNSC,INMX,
     8       PTDUP,DBKEY,ENDX,PDEFC,SIMPT,
     9       BDCNT,RTERR,GOODS,GOODR,BADS,
     C       BADR,ABORT,OPNER,XCNTR,ILLVN,
     1       SRCH2,UEND,XITM,ELERR,ROTER, 
     2       UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 
     3       ILLSC,MORIT,ILPTH,DEFIT, 
     4       ILSRT,SIMPS,UNDST
C 
C 
C                 VARIABLES 
C 
C 
C 
      COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR 
      COMMON DSEC,DCRN
      COMMON ENTL,ERROR 
      COMMON NMFLG
      COMMON FWAM 
      COMMON GGERR
      COMMON ICNT,IDCB(144),INDX
      COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB
      COMMON KPACK(50)
      COMMON LDCB(144),LGLOB,LIST,LWAM
      COMMON MEDIA
      COMMON NPACK(50),NSETS(50)
      COMMON OVRHD
      COMMON PTHTB(32)
      COMMON RDEF(64),RESNO,RFILE(3),RINDX
      COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE
      COMMON TYPE,PRGFLG
C 
C 
C    EXTERNAL REFERENCES
C 
C 
      EXTERNAL ROOTA
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980
C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB
C 
C 
C 
C 
C 
C IS THERE ROOM FOR ANOTHER PATH? 
C 
      IF (PTHCT .GE. PMAX) GOTO 7060
C 
C VERIFY SET NAME EXISTS AND IS A MASTER
C 
      CALL SSRCH(SCNT,SNUM,IGLOB) 
      IF (SNUM .LE. 0) GOTO 7020
      SNDX2 = (SNUM-1) * SETSZ + SETTB
      CALL RSGET(SNDX2+DSTYP,STYP2) 
C 
C VERIFY PATH SET IS A MASTER 
C 
      IF (STYP2 .EQ. DETAIL) GOTO 7030
C 
C VERIFY ITEM'S SPECIFICATIONS MATCH THE MASTER'S HASH ITEM'S 
C 
      CALL RSGET(SNDX2+DSCCT,HASH)
      HASH = (HASH-1) * ITMSZ + ITMTB 
C 
      CALL RSGET(IINDX+ITTYP,ITYP)
      CALL RSGET(HASH+ITTYP,ITYP2)
      IF (ITYP2 .NE. ITYP) GOTO 7070
C 
      IF (ROOTA(HASH + ITLNG) .NE. ROOTA(IINDX+ITLNG) ) GOTO 7070 
C 
C VERIFY IF MASTER IS AN AUTOMATIC MASTER 
C   THAT THIS ITEM'S WRITE LEVEL IS LESS THAN OR EQUAL TO 
C     THE MASTER'S HASH ITEM'S WRITE LEVEL
C 
      IF (STYP2 .NE. AUTO) GOTO 30
      CALL RSGET(HASH+ITINF,WLEV2)
      CALL RSGET(IINDX+ITINF,WLEV)
      IF( IAND(WLEV2,17B) .GT. IAND(WLEV,17B) ) GOTO 7050 
C 
C GET INDEX INTO MASTER'S PATH TABLE
C 
30    CONTINUE
      PCNT = 0
      PTR = ROOTA(SNDX2+DSITP)*2
      IF(PTR .EQ. 0) GOTO 7060
C 
C SKIP THE RECORD DEFINITION TABLE
C 
      CALL RSGET(SNDX2+DSFCT,N) 
      PTR = PTR + (N+1)/2 * 2 
C 
      CALL RSGET(SNDX2+DSPCT,N) 
      IF(N .EQ. 0) GOTO 7060
C 
C FIND AN EMPTY SLOT IN PATH TABLE
C 
      DO 22 I = 1,N 
      IF(ROOTA(PTR) .EQ. 0) GOTO 25 
      PTR = PTR+4 
22    CONTINUE
      GOTO 7060 
C 
C PUT ITEM & SET INTO MASTER'S PATH TABLE 
C 
25    CONTINUE
      CALL RSPUT(PTR,INUM)
      CALL RSPUT(PTR+1,SCNT+1)
C 
C PUT ITEM AND SET INTO DETAIL PATH TABLE 
C 
      CALL SPUT(PTHTB,PTHCT*4+1,INUM) 
      CALL SPUT(PTHTB,PTHCT*4+2,SNUM) 
C 
C INCREASE THE PATH COUNT 
C 
40    CONTINUE
      RETURN
C 
C 
C 
C ERROR PROCESSOR 
C 
C 
C 
C OUTPUT "UNDEFINED SET REFERENCE." 
C 
7020  CALL EMESS(BDSET) 
      GOTO 7055 
C 
C OUTPUT "ILLEGAL TYPE DESIGNATOR." 
C 
7030  CALL EMESS(ILITP) 
      GOTO 7055 
C 
C OUTPUT "AUTO-MASTER'S WRT LEV LESS THAN DETAIL."
C 
7050  CALL EMESS(DBKEY) 
7055  IERR = -1 
      GOTO 40 
C 
C OUTPUT "TOO MANY PATHS" 
C 
7060  CALL EMESS(DUPHS) 
      GOTO 7055 
C 
C OUTPUT "KEY ITEMS NOT OF SAME LENGTH, OR TYPE"
C 
7070  CALL EMESS(BDKEY) 
      GOTO 7055 
      END 
                                                                                                                                                                                