FTN4 SUBROUTINE GTSRT(IBASE,DSNUM,DINUM,INFO),92069-16061 REV.2026 800122 INTEGER IBASE(10),DSNUM,DINUM,INFO(3) C C C C C************************************************************* C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C************************************************************* C C C SOURCE: 92069-18123 C RELOC: 92069-16061 C C C************************************************************* C C C GTSRT IS A SUBROUTINE THAT DETERMINES THE SORT ITEM NAME FOR C A DETAIL PATH. C C CALLING SEQUENCE: C C CALL GTSRT(IBASE,DSNUM,DINUM,INFO) C C WHERE: C C IBASE C IS THE BASE PARAMETER FOR THE DATA BASE C C DSNUM C IS THE DETAIL DATA SET'S NUMBER C C DINUM C IS THE ITEM NUMBER OF THE KEY ITEM FOR THE PATH C C INFO C IS A 3 WORD INTEGER ARRAY IN WHICH THE NAME OF THE C SORT ITEM FOR THE PATH, OR BLANKS, IS RETURNED C C INTEGER IBUF(49),ISTAT(10) C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C NEEDS NO COMMON DECLARATION C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ C C C C BEGIN C C C BLANK-FILL INFO C DO 10 I=1,3 INFO(I)=2H 10 CONTINUE C C MAKE DBINF CALL TO GET PATH INFORMATION C CALL DBINF(IBASE,DSNUM,301,ISTAT,IBUF) IF (ISTAT .NE. 0) GO TO 60 C C SEARCH EACH PATH FOR KEY ITEM NUMBER C DO 30 I=3,3*IBUF(1),3 IF (IABS(IBUF(I)) .EQ. DINUM) GOTO 40 30 CONTINUE GOTO 60 C C GET SORT ITEM NUMBER FROM PATH INFO AND IF ITS NON-ZERO C CALL DBINF TO GET THE ITEM'S NAME C 40 ITEM=IABS(IBUF(I+1)) IF (ITEM .EQ. 0) GOTO 60 C CALL DBINF(IBASE,ITEM,102,ISTAT,IBUF) IF (ISTAT .NE. 0) GOTO 60 C C MOVE NAME INTO INFO C DO 50 I=1,3 INFO(I)=IBUF(I) 50 CONTINUE 60 CONTINUE RETURN END