FTN SUBROUTINE FLDTB,92069-16015 REV.2026 800124 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-18050 C RELOC: 92069-16015 C C ALTERED: JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ C C C****************************************************************: C C C C C INTEGER PCNT,PINDX,PN INTEGER NUM(10) INTEGER RPTR,PPTR INTEGER START INTEGER TBLH(40),TBLHZ INTEGER YES(2) INTEGER PRTLN(40),PRTLM 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 DATA PRTLM/40/ C 12 34 56 78 90 12 34 56 78 90 DATA TBLH/2H ,2HSE,2HT ,2HNA,2HME,2H ,2HSE,2HT ,2HNO, C 90 12 34 56 78 90 12 34 56 78 12H ,2HIT,2HEM,2H N,2HAM,2HE ,2H I,2HTE,2HM ,2HNO,2H , C 12 34 56 78 90 12 34 56 78 90 12HTY,2HPE,2H ,2HST,2HAR,2HT ,2HWD,2H ,2HEN,2HD , 22HWD,2H ,2HPA,2HTH,2H? ,2H S,2HOR,2HT ,2HIT,2HEM/ C DATA TBLHZ/40/ DATA YES/2HYE,2HS / C C IS ELEMENT REQUESTED? C NDX = NFONX(FIELD) IF(INFO(NDX) .NE. NFO(FIELD)) GOTO 90 C C OUTPUT A TOP OF PAGE C IF(LIST .NE. -1) CALL EXEC(3,1100B+LIST,-1) C C OUTPUT HEADING C CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) CALL OUTLN(TBLH,TBLHZ) CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) C C SET UP CONSTANTS C ITMTB = ROOTA(DBITP) * 2 SCNT = ROOTA(DBSCT) IF(SCNT .LE. 0) GOTO 90 SETTB = ROOTA(DBSTP) * 2 C C PROCESS EACH SET TABLE C DO 90 J = 0,SCNT-1 SINDX = J*SETSZ+SETTB START = 1 CALL OUTLN(BLANK,1) C C BLANK THE PRINT LINE C DO 10 I=1,PRTLM PRTLN(I) = BLANK 10 CONTINUE C C FORMAT THE SET NAME C DO 20 I = 0,2 20 PRTLN(I+2) = ROOTA(SINDX+DSNME+I*2) C C FORMAT SET NUMBER C CALL CITA(J+1,NUM) CALL SMOVE(NUM,5,6,PRTLN,15) C C GET THE SET TYPE C CALL RSGET(SINDX+DSTYP,STYPE) C C GET ALL THE ITEMS IN THE SET C C GET THE ITEM COUNT FROM THE SET TABLE C CALL RSGET(SINDX+DSFCT,ICNT) C GET THE ADDRESS TO THE RECORD DEFINITION TABLE RPTR = ROOTA(DSITP+SINDX)*2 C C GET THE ADDRESS TO THE PATH TABLE C C THE ITEM COUNT MUST BE ROUNDED TO EVEN WORDS THEN IT C MUST BE TURNED BACK INTO A BYTE COUNT FOR THE ROOT C ACCESS ROUTINES (SROOT,RSGET,ETC.). C THEN IT MUST BE ADDED TO THE RECORD DEFINITION TABLE ADDRESS. C PPTR = (ICNT+1) / 2 * 2 + RPTR C GET THE PATH COUNT CALL RSGET(SINDX+DSPCT,PCNT) C C C C IF(ICNT .LT. 1) GOTO 90 DO 80 K=1,ICNT CALL RSGET(RPTR,N) RPTR = RPTR+1 INDEX = (N-1)*ITMSZ+ITMTB C C OUTPUT ITEM NAME C DO 40 I=0,2 PRTLN(I+12) = ROOTA(INDEX+I*2) 40 CONTINUE C C OUTPUT ITEM NUMBER C CALL CITA(N,NUM) CALL SMOVE(NUM,4,6,PRTLN,34) C C OUTPUT ITEM TYPE C CALL RSGET(INDEX+ITTYP,ITYPE) CALL SPUT(PRTLN,43,ITYPE) C C OUTPUT START COLUMN C CALL CITA(START,NUM) CALL SMOVE(NUM,3,6,PRTLN,49) C C OUTPUT END COLUMN C START = START + ROOTA(INDEX+ITLNG) - 1 CALL CITA(START,NUM) CALL SMOVE(NUM,3,6,PRTLN,58) START = START + 1 C C IS THIS A PATH ITEM ? C C GET THE PATH COUNT C IF(STYPE .NE. DETAIL) GOTO 55 C IF(PCNT .LT. 1) GOTO 65 DO 50 I=0,(PCNT-1)*4,4 CALL RSGET (PPTR+I,PN) IF(PN .EQ. N) GOTO 60 50 CONTINUE GOTO 65 C C IS THIS THE HASH ITEM FOR A MASTER DATA SET? C 55 CONTINUE CALL RSGET(SINDX+DSCCT,PN) IF(PN .NE. N) GOTO 65 C C OUTPUT A "YES" TO INDICATE THIS ITEM IS A PATH C 60 CONTINUE CALL SMOVE(YES,1,3,PRTLN,66) C C IF A DETAIL C C IS THE PATH SORTED? C IF (STYPE .NE. DETAIL) GOTO 65 CALL RSGET(PPTR+I+3,PN) IF (PN .EQ. 0) GOTO 65 C C OUTPUT SORT ITEM NAME C INDEX = (PN - 1) * ITMSZ + ITMTB DO 63 I=0,2 PRTLN(I+37) = ROOTA(INDEX+I*2) 63 CONTINUE C C PRINT FORMATTED LINE C 65 CONTINUE CALL OUTLN(PRTLN,PRTLM) C C BLANK THE PRINT LINE C DO 70 I=1,PRTLM PRTLN(I) = BLANK 70 CONTINUE 80 CONTINUE 90 CONTINUE RETURN END