*     COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979, 1980
*
      BLOCK DATA COPYRIT5
      INTEGER COPYRITE(16)
     1   /'COPYRIGHT, (C) HONEYWELL INFORMATION SYSTEMS INC., 1979,'
     2  , ' 1980.  '/
      GLOBAL COPYRITE
      END
************************************************************************
*                                                                      *
*     MAIN PROGRAM VALIDATION                  @1978 11 01       *
*                                                                      *
*     THIS ROUTINE FORMS AN INTERNAL REPRSENTATION OF THE              *
*     USER'S DATABASE AND USES IT TO VALIDATE THE RECORDS              *
*     PRODUCED BY THE EXTRACTION PROCESS.                              *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD
      CALL VALINI
      CALL SCHINI
      CALL BLSCHM(ERRCD)
      IF(ERRCD.NE.0)CALL ABORT
      CALL VALDAT(ERRCD)
      IF(ERRCD.NE.0)CALL ABORT
      STOP 'NORMAL COMPLETION'
      END
      SUBROUTINE VALINI
************************************************************************
*                                                                      *
*            SUBROUTINE VALINI                       @1978 11 01       *
*                                                                      *
*     VALIDATION PROCESS INITIALIZATIONS:                              *
*            DEFINES & INITIALIZES /VALID/                             *
*            DEFINES ELEMENTS OF /VALDIO/                              *
*            DEFINES ELEMENTS OF /USERIO/                              *
*            DEFINES ELEMENTS OF /PTINT/                               *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INCLUDE EVAL_IN03,LIST
      UERROR=7
      UUSERI=5
      UUSERO=6
      UEGFIL=3
      UPTFIL=4
      UEXCTL=2
      EGLIR=.FALSE.
      EGLSTR=.FALSE.
      PTLIR=.FALSE.
      PTLSTR=.FALSE.
      PPTSTY=0
      PTSCNT=1
      RETURN
      END
      SUBROUTINE VALDAT(ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE VALDAT                       @1978 11 01       *
*                                                                      *
*     ROUTINE IMPLEMENTING THE MAIN DECISION TABLES. CONTROLS THE      *
*     FILE MATCHING PROCESS AND CALLS THE ROUTINES TO PERFORM THE      *
*     SUBSIDARY DECISION TABLES AND DUMP ERROR MESSAGES                *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD
      LOGICAL EGEOD,EGEOF,PTEOD,PTEOF,MULNXT,HASNXT
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*                                 OPERATION. ERRCD=0 NO ERROR.         *
*            EGEOD    LOGICAL     FLAG SIGNALLING AN END OF DATA       *
*                                 CONDITION ON THE EG FILE. I.E. LAST  *
*                                 SET IN THE CURRENT REFCODE.          *
*            EGEOF    LOGICAL     FLAG SIGNALLING END OF EG FILE       *
*            PTEOD    LOGICAL     SAME AS EGEOD BUT FOR PT FILE        *
*            PTEOF    LOGICAL     FLAG SIGNALLING END OF PT FILE       *
*            MULNXT   LOGICAL     FLAG TRUE WHEN MULTIPLE NEXT POINTERS*
*                                 HAVE BEEN DETECTED                   *
*            HASNXT   LOGICAL     FLAG TRUE WHEN CURENT EG RECORD HAS  *
*                                 A NEXT POINTER                       *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN03
      WRITE(UUSERO,3000)
3000  FORMAT('1',15X,'VALIDATION PROCESS INITIATED')
      MULNXT=.FALSE.
      HASNXT=.FALSE.
      CALL EGINIT(EGEOD,EGEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      CALL PTINIT(PTEOD,PTEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
*
*  START OF MAIN DECISION TABLE PROCESSING
*
10    CONTINUE
*      WRITE(UUSERO,1001)EGEOF,EGREF,EGEOD,EGSET,PTEOF,PTREF,PTEOD,PTSET
*1001  FORMAT(1X,L1,1X,Z8,2X,1L,1X,Z8,4X,L1,1X,Z8,2X,L1,1X,Z8)
*
*  CHECK AND MATCH THE REFCODES
*
      IF(EGEOF.AND.PTEOF)GOTO 20
      IF(EGEOF)GOTO 30
      IF(PTEOF)GOTO 40
      IF(EGREF.GT.PTNXT)GOTO 30
      IF(EGREF.LT.PTNXT)GOTO 40
****************************************
*                                      *
*  THE PT NEXT POINTER MATCHES         *
*  THE EG REFCODE;                     *
*  NOW CHECK AND MATCH THE SETS        *
*                                      *
****************************************
      IF(EGEOD.AND.PTEOD)GOTO 90
      IF(PTEOD)GOTO 60
      IF(EGEOD)GOTO 80
      IF(EGSET.LT.PTSET)GOTO 60
      IF(EGSET.GT.PTSET)GOTO 80
****************************************
*                                      *
*  THE PT ANG EG SETS MATCH            *
*                                      *
****************************************
      IF(PTSET.NE.PPTSTY)GOTO 100
*
*  FOUND MULTIPLE NEXT POINTERS. SET THE ERROR FLAG, STORE THE
*  NEXT POINTER AND SET OF THE OFFENDER FOR USE BY THE ERROR ROUTINE
*
      MULNXT=.TRUE.
      MNPTR=PTNXT
      MNSET=PTSET
*
*  CHECK TO SEE IF THE ERROR BUFFER IS FULL AND IF SO DUMP AN ERROR
*  MOVE THE BUFFER POINTER TO THE NEXT EMPTY SLOT.
*
      IF(PTSCNT.EQ.5)CALL VENXT2;PTSCNT=0
      PTSCNT=PTSCNT+1
      GOTO 130
100   CONTINUE
      IF(.NOT.MULNXT)GOTO 130
*
*  NO MORE ENTRIES TO A MULTIPLE NEXT ERROR MESSAGE, DUMP THE INFO
*  RESET THE FLAG AND BUFFER POINTER
*
      CALL VENXT2
      MULNXT=.FALSE.
      PTSCNT=1
130   CONTINUE
      HASNXT=.TRUE.
*
*  STORE THE PT DATA IN A BUFFER IN CASE OF MULTIPLE NEXT POINTERS
*  SO THE INFO CAN BE USED IN AN ERROR MESSAGE
*
      PTSAVE(PTSCNT,1)=PTGRP
      PTSAVE(PTSCNT,2)=PTREF
      PPTSTY=PTSET
*
*  NOW CHECK THE POINTERS: PRIOR, NEXT, THEN OWNER
*
      CALL CHKPRI
      CALL CHKNXT
      IF(EGOWN.NE.PTOWN.AND.EGOWN.NE.0.AND.PTOWN.NE.0)CALL VEOWN1
*
*  IF EGDEL IS SET THEN ALL THIS DIDN'T REALLY HAPPEN.
*  WRITE A LOGICALLY DELETED RECORD MESSAGE
*
      IF(EGDEL.NE.0)CALL VEDEL1
*
*  TRY TO GET ANOTHER PT RECORD WITH THIS REFCODE
*
      CALL RDPTR(PTEOD,PTEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      GOTO 10
****************************************
*                                      *
*            EGSET < PTSET             *
*                                      *
****************************************
60    CONTINUE
*
*  GET RID OF ANY MULTIPLE NEXT POINTER ERROR MESSAGE
*
      IF(.NOT.MULNXT)GOTO 120
      CALL VENXT2
      MULNXT=.FALSE.
      PTSCNT=1
120   CONTINUE
      IF(.NOT.HASNXT)CALL VENXT4
*
*  TRY TO GET ANOTHER EG RECORD WITH THIS REFCODE
*
      CALL RDEGR(EGEOD,EGEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      HASNXT=EGEOD
      GOTO 10
****************************************
*                                      *
*            EGSET > PTSET             *
*                                      *
****************************************
80    CONTINUE
*
*  GENERATE DANGLING NEXT POINTER ERROR
*
      CALL VENXT5
*
*  TRY TO GET ANOTHER PT RECORD WITH THIS REFCODE
*
      CALL RDPTR(PTEOD,PTEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      GOTO 10
************************************************************************
*                                                                      *
*  EOD ON BOTH EG AND PT FILES                                         *
*                                                                      *
90    CONTINUE
      CALL RDPTR(PTEOD,PTEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      PPTSTY=0
      GOTO 10
****************************************
*                                      *
*            EGREF > PTNXT             *
*                                      *
****************************************
30    CONTINUE
*
*  THE PT NEXT POINTER IS GARBAGE. GENERATE ERROR MESSAGE
*  OR, IT IS AN OPTIONAL AUTO GROUP AND IT GOT MANUALLY DELINKED
*  IN WHICH CASE PTNXT IS ZERO, AND THERE IS NO REAL ERROR...
*
      IF(PTNXT.NE.0)CALL VENXT1
      PPTSTY=0
*
*  GET A NEW PT RECORD, IGNORE END OF REFCODE CONDITION
*
      CALL RDPTR(PTEOD,PTEOF,ERRCD)
      IF(PTEOD)CALL RDPTR(PTEOD,PTEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      GOTO 10
****************************************
*                                      *
*            EGREF < PTNXT             *
*                                      *
****************************************
40    CONTINUE
*
*  EGREF<PTNXT. CLEAN UP ANY MULTIPLE NEXT MESSAGE AND
*  CHECK FOR MISSING POINTERS
*
      IF(MULNXT)CALL VENXT2;MULNXT=.FALSE.;PTSCNT=1
      PPTSTY=0
      IF(.NOT.HASNXT)CALL VENXT4
*
*  GET A NEW EG RECORD, IGNORE END OF REFCODE CONDITION
*
      CALL RDEGR(EGEOD,EGEOF,ERRCD)
      IF(EGEOD)CALL RDEGR(EGEOD,EGEOF,ERRCD)
      IF(ERRCD.NE.0)GOTO 50
      HASNXT=.FALSE.
      GOTO 10
*
*  END OF MAIN DECISION TABLE
*
20    CONTINUE
      WRITE(UUSERO,1000)
1000  FORMAT(//16X,'VALIDATION PROCESS COMPLETED')
      RETURN
50    CONTINUE
      WRITE(UERROR,2000)
2000  FORMAT(' VALIDATION PROCESS ABORTED')
      RETURN
      END
      SUBROUTINE CHKNXT
************************************************************************
*                                                                      *
*            SUBROUTINE CHKNXT                       @1978 11 01       *
*                                                                      *
*     THIS ROUTINE CHECKS FOR A MEMBER POINTING AT ITSELF              *
*     THROUGH THE NEXT POINTER.                                        *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
*
*  DOES THE RECORD POINT AT ITSELF
*
      IF(EGREF.NE.PTREF)GOTO 10
*
*  THINGS THAT POINT AT THEMSELVES SHOULD BE OWNERS...
*  OR MANUAL.
*
      IF(SETOWN(PTSET).EQ.GROUP(EGGRP))GOTO 10
      IF(GRPINM(TPYLNK(PTSET,EGGRP)))GOTO 10
*
*  NOT AN OWNER...  TELL THE WORLD THAT THIS IS WRONG
*
      CALL VENXT3
10    CONTINUE
      RETURN
      END
      SUBROUTINE CHKPRI
************************************************************************
*                                                                      *
*            SUBROUTINE CHKPRI                       @1978 11 01       *
*                                                                      *
*     THIS ROUTINE CHECKS THE PRIOR LINK FROM THE CURENT EG            *
*     RECORD TO THE CURRENT PT RECORD, AND GENERATES ERRORS            *
*     IF INCONSISTENCIES ARE FOUND.                                    *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
*
*  DOES THE PRIOR POINT BACK PROPERLY?
*
      IF(EGPRI.EQ.PTREF)GOTO 10
*
*  IS THE POINTER REALLY THERE (I.E. NONZERO)?
*  THEN WE HAVE AN ERROR
*
      IF(EGPRI.NE.0)CALL VEPRI1;GOTO 10
      GOTO 20
10    CONTINUE
*
*  DOES THE RECORD POINT AT ITSELF
*
      IF(EGREF.NE.PTREF)GOTO 20
*
*  THINGS THAT POINT AT THEMSELVES SHOULD BE OWNERS...
*  OR MANUAL
*  AND IF THEY AREN'T THEN THE WORLD SHOULD BE INFORMED
*
      IF(SETOWN(PTSET).EQ.GROUP(EGGRP))GOTO 20
      IF(GRPINM(TPYLNK(PTSET,EGGRP)))GOTO 20
      CALL VEPRI2
20    CONTINUE
      RETURN
      END
      SUBROUTINE EGINIT(EODFLG,EOFFLG,ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE EGINIT                       @1978 11 01       *
*                                                                      *
*     INITIALIZES THE BUFFERS AND FLAGS IN THE EG READ PROCEDURE.      *
*     LOADS THE FIRST RECORD OF THE EG FILE INTO /EGREC/               *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD
      LOGICAL EODFLG,EOFFLG
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            ----     ----        -----------                          *
*            ERRCD    INTEGER     CONDITION CODE ON COMPLETION OF AN   *
*                                 OPERATION. ERRCD=0 NO ERROR.         *
*            EODFLG   LOGICAL     PARAMETER; TRUE WHEN END OF DATA     *
*                                 CONDITION OCCURS                     *
*            EOFFLG   LOGICAL     PARAMETER; TRUE WHEN END OF EG       *
*                                 FILE ENCOUNTERED                     *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN03
      EODFLG=.FALSE.
      EOFFLG=.FALSE.
*
*  READ THE FIRST RECORD INTO EGBUF
*
      CALL RDEGBF(ERRCD)
      IF(ERRCD.NE.0)GOTO 10
*
*  IF THERE WAS NO FIRST RECORD, RETURN WITH END OF FILE TRUE.
*
      IF(EGBSIZ.EQ.0)EOFFLG=.TRUE.;RETURN
      EGREF=EGBUF(1)
      EGGRP=EGBUF(2)
      EGSET=EGBUF(3)
      EGPRI=EGBUF(4)
      EGOWN=EGBUF(5)
      EGDEL=EGBUF(6)
      EGBPTR=6
*
*  IF ITS NOT IN THE BLOCKING BUFFER, READ THE SECOND RECORD
*
      IF(EGBPTR.LT.EGBSIZ)GOTO 20
      CALL RDEGBF(ERRCD)
      IF(ERRCD.NE.0)GOTO 10
*
*  IF THERE WAS NO SECOND RECORD, SET EGLSTR TRUE AND RETURN
*
      IF(EGBSIZ.EQ.0)EGLSTR=.TRUE.;EGLIR=.TRUE.;RETURN
*
*  CHECK THE REFCODES IN THE BUFFERS FOR THE "LAST IN
*  REFCODE" (LIR) CONDITION.
*
20    CONTINUE
      EGLSTR=.FALSE.
      IF(EGREF.NE.EGBUF(EGBPTR+1))EGLIR=.TRUE.
      RETURN
*
*  THERE WAS AN ERROR CONDITION ON EG READ
*
      ERRCD=1
      WRITE(UERROR,1000)
1000  FORMAT(' ERRORED INITIALIZING EG READ PROCESS')
      RETURN
      END
      SUBROUTINE RDEGR(EODFLG,EOFFLG,ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE RDEGR                        @1978 11 01       *
*                                                                      *
*     READS RECORDS FROM THE EG FILE THROUGH THE BLOCKING              *
*     BUFFER TO ALLOW SIGNALLING OF END OF DATA CONDITIONS.            *
*     A CHANGE OF REFCODE IS CONSIDERED AN END OF DATA.                *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD
      LOGICAL EODFLG,EOFFLG
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            ERRCD    INTEGER     CONDITION CODE ON COMPLETION OF AN   *
*                                 OPERATION. ERRCD=0 NO ERROR.         *
*            EODFLG   LOGICAL     PARAMETER; TRUE WHEN END OF DATA     *
*                                 CONDITION OCCURS                     *
*            EOFFLG   LOGICAL     PARAMETER; TRUE WHEN END OF EG       *
*                                 FILE ENCOUNTERED                     *
*                                                                      *
      INCLUDE EVAL_IN03
      EODFLG=.FALSE.
      EOFFLG=.FALSE.
      ERRCD=0
*
*  IF THE BLOCKING BUFFER HAS A NEW REFCODE AND THIS IS THE FIRST
*  READ THEN RETURN EODFLG TRUE
*
      IF(EGLIR)EGLIR=.FALSE.;EODFLG=.TRUE.;GOTO 30
*
*  MOVE DATA FROM THE BLOCKING BUFFER INTO /EGREC/
*
      EGREF=EGBUF(EGBPTR+1)
      EGGRP=EGBUF(EGBPTR+2)
      EGSET=EGBUF(EGBPTR+3)
      EGPRI=EGBUF(EGBPTR+4)
      EGOWN=EGBUF(EGBPTR+5)
      EGDEL=EGBUF(EGBPTR+6)
      EGBPTR=EGBPTR+6
*
*  IF THE BUFFER HELD THE LAST RECORD THEN SET THE END OF FILE
*  FLAG TRUE AND RETURN
*
      IF(EGLSTR)EOFFLG=.TRUE.;GOTO 30
*
*  CHECK FOR END OF FILE
*
      IF(EGBPTR.LT.EGBSIZ)GOTO 20
      CALL RDEGBF(ERRCD)
      IF(ERRCD.NE.0)GOTO 10
      IF(EGBSIZ.EQ.0)EGLSTR=.TRUE.;EGLIR=.TRUE.;GOTO 30
*
*  CHECK TO SEE IF THIS IS THE LAST WITH THE OLD REFCODE
*
20    CONTINUE
      IF(EGREF.NE.EGBUF(EGBPTR+1))EGLIR=.TRUE.
30    CONTINUE
      RETURN
10    CONTINUE
      ERRCD=1
      WRITE(UERROR,1000)
1000  FORMAT(' ERRORED WHILE READING AN EG RECORD.')
      RETURN
      END
      SUBROUTINE RDEGBF(ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE RDEGBF                       @1978 11 01       *
*                                                                      *
*     READS IN A BLOCKED EG BUFFER AND RESETS THE BUFFER POINTER,      *
*     EGBPTR. IF AN END OF FILE IS ENCOUNTERED, THE BUFFER SIZE,       *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD,READST
      INCLUDE EVAL_IN03
      CALL BUFFER IN(UEGFIL,1,EGBUF,4995,READST,EGBSIZ)
      GOTO(10,20,30),READST
      GOTO 10
30    CONTINUE
      EGBSIZ=0
20    CONTINUE
      EGBPTR=0
      ERRCD=0
      RETURN
10    CONTINUE
      ERRCD=1
      WRITE(UERROR,1000)READST,UEGFIL
1000  FORMAT(' BUFFER IN ERROR, CODE=',I,'READING EG BUFFER'/
     @' ERRORED ON UNIT #',I)
      RETURN
      END
      SUBROUTINE PTINIT(EODFLG,EOFFLG,ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE PTINIT                       @1978 11 01       *
*                                                                      *
*     INITIALIZES THE BUFFERS AND FLAGS IN THE PT READ PROCEDURE.      *
*     LOADS THE FIRST RECORD OF THE PT FILE INTO /PTREC/               *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD
      LOGICAL EODFLG,EOFFLG
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*                                 OPERATION. ERRCD=0 NO ERROR.         *
*            EODFLG   LOGICAL     PARAMETER; TRUE WHEN END OF DATA     *
*                                 CONDITION OCCURS                     *
*            EOFFLG   LOGICAL     PARAMETER; TRUE WHEN END OF PT FILE  *
*                                 ENCOUNTERED                          *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN03
      EODFLG=.FALSE.
      EOFFLG=.FALSE.
*
*  READ THE FIRST PT RECORD INTO PTBUF
*
      CALL RDPTBF(ERRCD)
      IF(ERRCD.NE.0)GOTO 10
*
*  IF THERE WAS NO FIRST RECORD, RETURN WITH END OF FILE TRUE.
*
      IF(PTBSIZ.EQ.0)EOFFLG=.TRUE.;RETURN
      PTREF=PTBUF(1)
      PTGRP=PTBUF(2)
      PTSET=PTBUF(3)
      PTNXT=PTBUF(4)
      PTOWN=PTBUF(5)
      PTBPTR=5
*
*  IF ITS NOT IN THE BLOCKING BUFFER, READ THE SECOND RECORD
*
      IF(PTBPTR.LT.PTBSIZ)GOTO 20
      CALL RDPTBF(ERRCD)
      IF(ERRCD.NE.0)GOTO 10
*
*  IF THERE WAS NO SECOND RECORD, SET PTLSTR TRUE AND RETURN
*
      IF(PTBSIZ.EQ.0)PTLSTR=.TRUE.;PTLIR=.TRUE.;RETURN
*
*  CHECK THE REFCODES IN THE BUFFERS FOR THE "LAST IN
*  REFCODE" (LIR) CONDITION.
*
20    CONTINUE
      PTLSTR=.FALSE.
      IF(PTNXT.NE.PTBUF(PTBPTR+4))PTLIR=.TRUE.
      RETURN
*
*  THERE WAS A BUFFER IN ERROR CONDITION
*
10    CONTINUE
      ERRCD=1
      WRITE(UERROR,1000)
1000  FORMAT(' ERRORED INITIALIZING PT READ PROCESS')
      RETURN
      END
      SUBROUTINE RDPTR(EODFLG,EOFFLG,ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE RDPTR                        @1978 11 01       *
*                                                                      *
*     READS RECORDS FROM THE PT FILE THROUGH THE BLOCKING              *
*     BUFFER TO ALLOW SIGNALLING OF END OF DATA CONDITIONS.            *
*     A CHANGE OF REFCODE IS CONSIDERED AN END OF DATA.                *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD
      LOGICAL EODFLG,EOFFLG
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            ERRCD    INTEGER     ERROR CODE ON COMPLETION OF AN       *
*                                 OPERATION. ERRCD=0 NO ERROR.         *
*            EODFLG   LOGICAL     PARAMETER; TRUE WHEN END OF DATA     *
*                                 CONDITION OCCURS                     *
*            EOFFLG   LOGICAL     PARAMETER; TRUE WHEN END OF PT FILE  *
*                                 ENCOUNTERED                          *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN03
      EODFLG=.FALSE.
      EOFFLG=.FALSE.
      ERRCD=0
*
*  IF THE BLOCKING BUFFER HAS A NEW REFCODE AND THIS IS THE FIRST
*  READ THEN RETURN EODFLG TRUE
*
      IF(PTLIR)PTLIR=.FALSE.;EODFLG=.TRUE.;GOTO 30
*
*  MOVE DATA FROM THE BLOCKING BUFFER INTO /PTREC/
*
      PTREF=PTBUF(PTBPTR+1)
      PTGRP=PTBUF(PTBPTR+2)
      PTSET=PTBUF(PTBPTR+3)
      PTNXT=PTBUF(PTBPTR+4)
      PTOWN=PTBUF(PTBPTR+5)
      PTBPTR=PTBPTR+5
*
*  IF THE BUFFER HELD THE LAST RECORD THEN SET THE END OF FILE
*  FLAG TRUE AND RETURN
*
      IF(PTLSTR)EOFFLG=.TRUE.;GOTO 30
*
*  CHECK FOR END OF FILE
*
      IF(PTBPTR.LT.PTBSIZ)GOTO 20
      CALL RDPTBF(ERRCD)
      IF(ERRCD.NE.0)GOTO 10
      IF(PTBSIZ.EQ.0)PTLSTR=.TRUE.;PTLIR=.TRUE.;GOTO 30
*
*  CHECK TO SEE IF THIS IS THE LAST WITH THE OLD REFCODE
*
20    CONTINUE
      IF(PTNXT.NE.PTBUF(PTBPTR+4))PTLIR=.TRUE.
30    CONTINUE
      RETURN
10    CONTINUE
      ERRCD=1
      WRITE(UERROR,1000)
1000  FORMAT(' ERRORED WHILE READING A PT RECORD.')
      RETURN
      END
      SUBROUTINE RDPTBF(ERRCD)
************************************************************************
*                                                                      *
*            SUBROUTINE RDPTBF                       @1978 11 01       *
*                                                                      *
*     READS IN A BLOCKED PT BUFFER AND RESETS THE BUFFER POINTER,      *
*     PTBPTR. IF AN END OF FILE IS ENCOUNTERED, THE BUFFER SIZE,       *
*     PTBSIZ IS SET TO 0.                                              *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER ERRCD,READST
      INCLUDE EVAL_IN03
      CALL BUFFER IN(UPTFIL,1,PTBUF,4995,READST,PTBSIZ)
      GOTO(10,20,30),READST
      GOTO 10
30    CONTINUE
      PTBSIZ=0
20    CONTINUE
      PTBPTR=0
      ERRCD=0
      RETURN
10    CONTINUE
      ERRCD=1
      WRITE(UERROR,1000)READST,UPTFIL
1000  FORMAT(' BUFFER IN ERROR, CODE=',I,'READING PT BUFFER'/
     @' ERRORED ON UNIT #',I)
      RETURN
      END
      SUBROUTINE VEDEL1
************************************************************************
*                                                                      *
*            SUBROUTINE VEDEL1                       @1979 07 01       *
*                                                                      *
*     VALIDATION ERROR FOR DELETED RECORD                              *
*                                                                      *
*            THIS ROUTINE INFORMS THE USER OF A DELETED                *
*     RECORD, AS POINTED TO BY A NEXT POINTER                          *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT,NXTBUF,NXTCNT
      DIMENSION REFBUF(16),NXTBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*            NXTBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            NXTCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/23X,'DELETED RECORD'//)
      CALL REFFMT(PTREF,REFBUF)
      REFCNT=REFBUF(1)+1
      CALL REFFMT(PTNXT,NXTBUF)
      NXTCNT=NXTBUF(1)+1
      NAMCNT=GRPNAM(PTGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(PTGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT),(NXTBUF(I),I=1,NXTCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,
     @/' HAS NEXT POINTER ',NA1)
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(PTGRP),(REFBUF(I),I=1,REFCNT),
     @(NXTBUF(I),I=1,NXTCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1,
     @/' HAS NEXT POINTER ',NA1)
20    CONTINUE
      NAMCNT=SETNAM(PTSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(SETNAM(PTSET,I),I=1,NAMEND)
4000  FORMAT(' IN ',NA1,' -- THAT RECORD IS LOGICALLY DELETED')
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)SET(PTSET)
5000  FORMAT(' IN SET #',I,'-- THAT RECORD IS LOGICALLY DELETED')
40    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VENXT1
************************************************************************
*                                                                      *
*            SUBROUTINE VENXT1                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR NEXT POINTERS-- ERROR 1                     *
*                                                                      *
*            THIS ROUTINE INFORMS THE USER OF A GARBAGE                *
*     NEXT POINTER. THAT IS, A NEXT POINTER HAS BEEN FOUND             *
*     TO POINT AT A NONEXISTENT RECORD                                 *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT,NXTBUF,NXTCNT
      DIMENSION REFBUF(16),NXTBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*            NXTBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/20X,'GARBAGE NEXT POINTER'//)
      CALL REFFMT(PTREF,REFBUF)
      REFCNT=REFBUF(1)+1
      CALL REFFMT(PTNXT,NXTBUF)
      NXTCNT=NXTBUF(1)+1
      NAMCNT=GRPNAM(PTGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(PTGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT),(NXTBUF(I),I=1,NXTCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,
     @/' HAS NEXT POINTER ',NA1)
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(PTGRP),(REFBUF(I),I=1,REFCNT),
     @(NXTBUF(I),I=1,NXTCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1,
     @/' HAS NEXT POINTER ',NA1)
20    CONTINUE
      NAMCNT=SETNAM(PTSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(SETNAM(PTSET,I),I=1,NAMEND)
4000  FORMAT(' IN ',NA1,' -- NO RECORD WITH THAT REFCODE EXISTS')
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)SET(PTSET)
5000  FORMAT(' IN SET #',I,'-- NO RECORD WITH THAT REFCODE EXISTS')
40    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VENXT2
************************************************************************
*                                                                      *
*            SUBROUTINE VENXT2                       @1978 11 01       *
*                                                                      *
*                                                                      *
*            THIS ROUTINE INFORMS THE USER OF MULTIPLE                 *
*     NEXT POINTERS. THAT IS, TWO OR MORE RECORDS WHICH                *
*     POINT TO THE SAME RECORD THROUGH THE SAME SET.                   *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,INDEX0,REFBUF,REFCNT
      DIMENSION REFBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            INDEX0   INTEGER     A SCRATCH VARIABLE                   *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/19X,'MULTIPLE NEXT POINTERS'//)
      DO 10 INDEX0=1,PTSCNT
      CALL REFFMT(PTSAVE(INDEX0,2),REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(PTSAVE(INDEX0,1),1)
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(PTSAVE(INDEX0,1),I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1)
      GOTO 10
20    CONTINUE
      WRITE(UUSERO,3000)GROUP(PTSAVE(INDEX0,1)),
     @(REFBUF(I),I=1,REFCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1)
10    CONTINUE
      CALL REFFMT(MNPTR,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=SETNAM(MNSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(REFBUF(I),I=1,REFCNT),
     @(SETNAM(MNSET,I),I=1,NAMEND)
4000  FORMAT(' ALL HAVE THE SAME NEXT POINTER, ',NA1,' IN ',NA1)
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)(REFBUF(I),I=1,REFCNT),SET(MNSET)
5000  FORMAT(' ALL HAVE THE SAME NEXT POINTER, ',NA1,' IN SET #',I)
40    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VENXT3
************************************************************************
*                                                                      *
*            SUBROUTINE VENXT3                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR NEXT POINTERS-- ERROR 3                     *
*                                                                      *
*            THIS ROUTINE TELLS THE USER OF A MEMBER TYPE              *
*     RECORD WHICH IS LINKED TO ITSELF THROUGH A NEXT                  *
*     POINTER.                                                         *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT
      DIMENSION REFBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/12X,'MEMBER POINTS AT ITSELF THROUGH NEXT'//)
      CALL REFFMT(PTREF,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(PTGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(PTGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,' POINTS AT')
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(PTGRP),(REFBUF(I),I=1,REFCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1,' POINTS AT')
20    CONTINUE
      NAMCNT=SETNAM(PTSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(SETNAM(PTSET,I),I=1,NAMEND)
4000  FORMAT(' ITSELF BUT IS NOT AN OWNER IN ',NA1)
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)SET(PTSET)
5000  FORMAT(' ITSELF BUT IS NOT AN OWNER IN SET #',I)
40    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VENXT4
************************************************************************
*                                                                      *
*            SUBROUTINE VENXT4                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR NEXT POINTERS-- ERROR 4                     *
*                                                                      *
*            THIS ROUTINE TELLS THE USER THAT THERE                    *
*     IS A MISSING NEXT POINTER.                                       *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT
      DIMENSION REFBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/21X,'MISSING NEXT POINTER'//)
      CALL REFFMT(EGREF,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(EGGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(EGGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,' HAS NO')
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(EGGRP),(REFBUF(I),I=1,REFCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1,' HAS NO')
20    CONTINUE
      NAMCNT=SETNAM(EGSET,1)
      IF(NAMCNT.LE.0)GOTO 50
      NAMEND=NAMCNT+1
      WRITE(UUSERO,6000)(SETNAM(EGSET,I),I=1,NAMEND)
6000  FORMAT(' NEXT POINTER IN ',NA1)
      GOTO 60
50    CONTINUE
      WRITE(UUSERO,7000)SET(EGSET)
7000  FORMAT(' NEXT POINTER IN SET #',I)
60    CONTINUE
      WRITE(UUSERO,8000)
8000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VENXT5
************************************************************************
*                                                                      *
*            SUBROUTINE VENXT5                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR NEXT POINTERS-- ERROR 5                     *
*                                                                      *
*            THIS ROUTINE INFORMS THE USER THAT A NEXT                 *
*     POINTER WAS FOUND WITH NO CORRESPONDING RECORD IN                *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT
      DIMENSION REFBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/19X,'DANGLING NEXT POINTER'//)
      CALL REFFMT(EGREF,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(EGGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(EGGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,' HAS')
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(EGGRP),(REFBUF(I),I=1,REFCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1,' HAS')
20    CONTINUE
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(SETNAM(PTSET,I),I=1,NAMEND)
4000  FORMAT(' A DANGLING NEXT POINTER IN ',NA1,' FROM')
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)SET(PTSET)
5000  FORMAT(' A DANGLING NEXT POINTER IN SET #',I,'FROM')
40    CONTINUE
      CALL REFFMT(PTREF,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(PTGRP,1)
      IF(NAMCNT.LE.0)GOTO 50
      NAMEND=NAMCNT+1
      WRITE(UUSERO,7000)(GRPNAM(PTGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
7000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1)
      GOTO 60
50    CONTINUE
      WRITE(UUSERO,8000)GROUP(PTGRP),(REFBUF(I),I=1,REFCNT)
8000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1)
60    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VEOWN1
************************************************************************
*                                                                      *
*            SUBROUTINE VEOWN1                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR OWNER POINTERS-- ERROR 1                    *
*                                                                      *
*            THIS ROUTINE INFORMS THE USER OF INCONSISTENT             *
*     OWNER POINTERS IN TWO LOGICALLY ADJAENT DATABASE RECORDS         *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT,OWNBUF,OWNCNT
      DIMENSION REFBUF(16),OWNBUF(16)
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*            OWNBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            OWNCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/15X,'INCONSISTENT OWNER POINTERS'//)
      CALL REFFMT(PTREF,REFBUF)
      REFCNT=REFBUF(1)+1
      CALL REFFMT(PTOWN,OWNBUF)
      OWNCNT=OWNBUF(1)+1
      NAMCNT=GRPNAM(PTGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(PTGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1)
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(PTGRP),(REFBUF(I),I=1,REFCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1)
20    CONTINUE
      NAMCNT=SETNAM(PTSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(OWNBUF(I),I=1,OWNCNT),
     @(SETNAM(PTSET,I),I=1,NAMEND)
4000  FORMAT(' HAS OWNER POINTER ',NA1,' IN ',NA1,' AND POINTS AT')
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)(OWNBUF(I),I=1,OWNCNT),SET(PTSET)
5000  FORMAT(' HAS OWNER POINTER ',NA1,' IN SET #',I,'AND POINTS AT')
40    CONTINUE
      CALL REFFMT(EGREF,REFBUF)
      REFCNT=REFBUF(1)+1
      CALL REFFMT(EGOWN,OWNBUF)
      OWNCNT=OWNBUF(1)+1
      NAMCNT=GRPNAM(EGGRP,1)
      IF(NAMCNT.LE.0)GOTO 50
      NAMEND=NAMCNT+1
      WRITE(UUSERO,6000)(GRPNAM(EGGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT),(OWNBUF(I),I=1,OWNCNT)
6000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1/
     @' WHICH HAS OWNER POINTER ',NA1)
      GOTO 60
50    CONTINUE
      WRITE(UUSERO,7000)GROUP(EGGRP),(REFBUF(I),I=1,REFCNT),
     @(OWNBUF(I),I=1,OWNCNT)
7000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1/
     @' WHICH HAS OWNER POINTER ',NA1)
60    CONTINUE
      WRITE(UUSERO,8000)
8000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VEPRI1
************************************************************************
*                                                                      *
*            SUBROUTINE VEPRI1                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR PRIOR POINTERS-- ERROR 1                    *
*                                                                      *
*            THIS ROUTINE INFORMS THE USER OF A BAD PRIOR              *
*     POINTER. THAT IS, A PRIOR POINTER DOES NOT AGREE WITH            *
*     THE CORRESPONDING PT RECORD.                                     *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT,PRIBUF,PRICNT
      DIMENSION REFBUF(16),PRIBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*            PRIBUF   INTEGER     BUFFER FOR FORMATTED PRIOR POINTER   *
*            PRICNT   INTEGER     LENGTH OF PRIOR POINTER FOR FORMAT   *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/21X,'BAD PRIOR POINTER'//)
      CALL REFFMT(EGREF,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(EGGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(EGGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,
     @' HAS PRIOR POINTER')
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(EGGRP),(REFBUF(I),I=1,REFCNT)
     @' HAS PRIOR POINTER')
20    CONTINUE
      CALL REFFMT(PTREF,REFBUF)
      REFCNT=REFBUF(1)+1
      CALL REFFMT(EGPRI,PRIBUF)
      PRICNT=PRIBUF(1)+1
      NAMCNT=SETNAM(EGSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(PRIBUF(I),I=1,PRICNT),
     @(SETNAM(EGSET,I),I=1,NAMEND),(REFBUF(I),I=1,REFCNT)
4000  FORMAT(1X,NA1,' IN ',NA1,' WHICH IS INCONSISTENT WITH'
     @/' THE CORRESPONDING NEXT POINTER. EXPECTED ',NA1)
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)(PRIBUF(I),I=1,PRICNT),
     @SET(EGSET),(REFBUF(I),I=1,REFCNT)
5000  FORMAT(1X,NA1,' IN SET #',I,'WHICH IS INCONSISTENT WITH'
     @/' THE CORRESPONDING NEXT POINTER. EXPECTED ',NA1)
40    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
      SUBROUTINE VEPRI2
************************************************************************
*                                                                      *
*            SUBROUTINE VEPRI2                       @1978 11 01       *
*                                                                      *
*     VALIDATION ERROR FOR PRIOR POINTERS-- ERROR 2                    *
*                                                                      *
*            THIS ROUTINE TELLS THE USER THAT THE CURRENT              *
*     RECORD POINTS AT ITSELF THROUGH THE PRIOR LINK                   *
*     WHEN THE RECORD IS NOT AN OWNER IN THE SET.                      *
*                                                                      *
************************************************************************
      IMPLICIT LOGICAL(A-Z)
      INTEGER I,NAMCNT,NAMEND,REFBUF,REFCNT
      DIMENSION REFBUF(16)
************************************************************************
*                                                                      *
*     LOCAL VARIABLES:                                                 *
*            NAME     TYPE        DESCRIPTION                          *
*            ----     ----        -----------                          *
*            I        INTEGER     AN OUTPUT LOOP SCRATCH INDEX         *
*            NAMCNT   INTEGER     NUMBER OF CHARS IN A NAME            *
*            NAMEND   INTEGER     LENGTH OF A NAME FOR FORMAT          *
*            REFBUF   INTEGER     BUFFER FOR FORMATTED REFCODE         *
*            REFCNT   INTEGER     LENGTH OF REFCODE FOR FORMAT         *
*                                                                      *
************************************************************************
      INCLUDE EVAL_IN01
      INCLUDE EVAL_IN03
      WRITE(UUSERO,1000)
1000  FORMAT(/12X,'MEMBER POINTS AT ITSELF THROUGH PRIOR')
      CALL REFFMT(EGREF,REFBUF)
      REFCNT=REFBUF(1)+1
      NAMCNT=GRPNAM(EGGRP,1)
      IF(NAMCNT.LE.0)GOTO 10
      NAMEND=NAMCNT+1
      WRITE(UUSERO,2000)(GRPNAM(EGGRP,I),I=1,NAMEND),
     @(REFBUF(I),I=1,REFCNT)
2000  FORMAT(1X,NA1,' OCCURANCE WITH REFCODE ',NA1,' POINTS AT')
      GOTO 20
10    CONTINUE
      WRITE(UUSERO,3000)GROUP(EGGRP),(REFBUF(I),I=1,REFCNT)
3000  FORMAT(' GROUP #',I,'OCCURANCE WITH REFCODE ',NA1,' POINTS AT')
20    CONTINUE
      NAMCNT=SETNAM(EGSET,1)
      IF(NAMCNT.LE.0)GOTO 30
      NAMEND=NAMCNT+1
      WRITE(UUSERO,4000)(SETNAM(EGSET,I),I=1,NAMEND)
4000  FORMAT(' ITSELF BUT IS NOT AN OWNER IN ',NA1)
      GOTO 40
30    CONTINUE
      WRITE(UUSERO,5000)SET(EGSET)
40    CONTINUE
      WRITE(UUSERO,6000)
6000  FORMAT(/1X,60('-'))
      RETURN
      END
