SPL,M,O,C,L 
!     NAME:   VE..  
!     SOURCE: 92064-18051 
!     RELOC:  92064-16017 
!     PGMR:   G.L.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
! 
      NAME VE..(7) " 92064-16017  REV.1650  760807" 
! 
! 
! 
! 
! 
      LET OPEN.,CONV.,READF,WRITF,XEXTL  BE SUBROUTINE,EXTERNAL 
      LET IFBRK BE FUNCTION,EXTERNAL
      LET IDCB1,IDCB2,IDCB3,I.BUF,O.BUF BE INTEGER,EXTERNAL 
      LET TMP.,N.OPL BE INTEGER,EXTERNAL
      LET AB.FM BE LABEL,EXTERNAL 
      LET VE..  BE SUBROUTINE 
      LET WEOF BE SUBROUTINE,DIRECT 
! 
! 
      LET EOFM(2) BE INTEGER
      LET VECOM(8) BE INTEGER 
! 
      INITIALIZE  ST.    TO "ST"
      INITIALIZE  GO.   TO "GO" 
      INITIALIZE  LU.   TO "LU" 
      INITIALIZE  EQ.BL  TO "= "
      INITIALIZE  EOFM   TO "EOF "
      INITIALIZE  VECOM  TO "VERIFY COMPLETE "
! 
!  DEFINE RECORD COUNT AND ERROR TOTAL MESSAGE
! 
      LET RCNT(2) BE INTEGER
      LET RECM(7) BE INTEGER
      INITIALIZE RECM    TO     " RECORDS READ "
      LET EROUT(2) BE INTEGER 
      LET EREM(10) BE INTEGER 
      INITIALIZE EREM     TO    " RECORDS WITH ERRORS" !
! 
! 
! 
      LET A.Z  BE CONSTANT (40400K) 
      LET B.Z  BE CONSTANT (41000K) 
! 
 VE..: SUBROUTINE (NO,LIS,ER) GLOBAL
! 
!  SET ADDRESSES OF ON PARMS
! 
!  :VE,F1,F2,OPTION,#FILES,TYPE 
! 
! 
      OP5_[OP4_[OP4T_[OP3_[NA2_[NA2T_[NA1_ @LIS+1]+3]+1]+4]+3]+1]+4 
! 
! 
!  SETUP VERIFY OPTION FLAGS
! 
!      CHECK FOR ABORT/NO-ABORT ON VERIFY ERROR 
! 
      IF $OP3=ST. THEN [HT_1;GO TO O4]   !ABORT ON ERROR? 
      IF ($OP3=GO.) OR ($OP3=0) THEN HT_0,\  DEFAULT=DON'T ABORT
                                ELSE [ER_56;RETURN] !BAD PARM RETURN
! 
!  FETCH # FILES AND SET IT NEGATIVE
!          NEGATIVE REQUEST NOT ALLOWED 
! 
O4:    IF $(OP5-1)=3 THEN GO TO RJCT  !  DON'T ALLOW ASCII
       IFNOT [TEMP_ $OP5]  THEN  FCNT_ -1 ,\   DEFAULT USES 1 
                        ELSE [IF [FCNT_ -TEMP] > 0 THEN[\ COMPLEMENT
RJCT:                                   ER_56;RETURN]]  !REJECT 
! 
! 
!   CHECK FOR TYPE--AS/BI 
!       THIS IS NEEDED WHEN VERIFYING VIA LU'S
! 
!  IF NUMERIC OR DEFAULT USE VALUE
! 
      IFNOT $OP4T=3  THEN [TYPE_$OP4;GO TO PONG]
!  IF ASCII USE 0 
      IF [TEMP_$OP4 AND 177400K] =A.Z THEN\ 
                 [TYPE_0;GO TO PONG]
! 
!  IF BINARY USE 1OO (SET M BIT)
! 
      IF TEMP=B.Z THEN TYPE_100K,\
                  ELSE [ER_56;RETURN] 
! 
! 
!  ALLOW POS/NEG AND SET DEFAULTS FOR LU'S
! 
! 
! 
PONG:    $NA1,LU1_ [IF $NA1  < 0  THEN - $NA1,\  !IF NEG SET IT POS 
             ELSE [ IFNOT $NA1 THEN 4,\    !IF DEFAULT USE 4(LCTU)
               ELSE  $NA1 ]]
! 
! CHECK 2ND PARM
! 
      $NA2,LU2_ [IF $NA2 < 0 THEN - $NA2,\ IF NEG SET IT POS
              ELSE [ IFNOT $NA2 THEN 5,\   ! IF DEFAULT USE 5(RCTU) 
                  ELSE $NA2 ]]
! 
! 
!  OPEN FILE1,FILE2,LIST
! 
      CALL OPEN.(IDCB1,$NA1,N.OPL,TYPE)!  OPEN FILE1
      CALL OPEN.(IDCB2,$NA2,$(@N.OPL+5),TYPE) !  OPEN FILE2 
      CALL OPEN.(IDCB3,TMP.,(@TMP.+3),0)!   OPEN LIST 
! 
!   SET UP NAME OF FILE OR LU IN CASE OF VERIFY ERROR 
! 
!  FIRST FILE WORK
! 
      IF LIS=3 THEN GO TO CHNA2  !IF NAME,CONTINUE
      $NA1_LU.        !SET "LU" INTO NAME BUF 
      $(NA1+1)_EQ.BL      !SET  "= " INTO NAME BUF
      CONV.(LU1,$(NA1+2),2)  !CONVERT LU AND SET INTO BUF 
! 
!  2ND FILE WORK
! 
CHNA2: IF $NA2T=3 THEN GO TO GORP  !IF NAME, CONTINUE 
      $NA2_LU.     !SET "LU" IN BUF 
      $(NA2+1)_EQ.BL     ! SET "= " IN BUF
      CONV.(LU2,$(NA2+2),2)     ! CONVERT LU AND SET INTO BUF 
! 
!  RESET COUNTERS 
! 
GORP: ERRCT,RC_0
! 
NEXT: IF IFBRK THEN [ER_0;GO TO AB.FM]  !CHECK BREAK FLAG 
! 
      CALL READF(IDCB1,ER,I.BUF,128,LEN) !READ RECORD FILE 1
        IF ER THEN RETURN 
! 
      CALL READF(IDCB2,ER,O.BUF,128,LEN2) !READ RECORD FILE 2 
        IF ER THEN RETURN 
! 
      IF LEN#LEN2 THEN [RC_RC+1;GO TO ERROR]
      IF LEN= -1 THEN GO TO EOF 
      RC_RC+1    !BUMP RECORD COUNT 
! 
!  DO VERIFY OPERATION
! 
!  SET UP POINTERS
! 
      TEMP_@I.BUF 
      TEMP2_@O.BUF
      COUN_ -LEN
! 
! 
MATCH: IF $TEMP# $TEMP2 THEN GO TO ERROR
      TEMP_TEMP+1 
      TEMP2_TEMP2+1 
      IF [COUN_ COUN+1] THEN GO TO MATCH
! 
!  THIS RECORD OK--CONTINUE 
! 
      GO TO NEXT
! 
! 
! 
EOF: WEOF   !!WRITE "EOF" ON LIST DEV. 
      IF [FCNT_ FCNT+1] THEN GO TO NEXT 
      CALL WRITF(IDCB3,ER,VECOM,8) !WRITE "VERIFY COMPLETE" 
      CONV.(RC,$(@RCNT+1),4)  !SET # RECORDS READ 
      CONV.(ERRCT,$(@EROUT+1),4)  ! SET TOTAL ERRORS FOUND
      WRITF(IDCB3,.E.R,RCNT,21) 
      RETURN
! 
! 
! 
ERROR: ERRCT_ERRCT+1  !BUMP ERROR COUNT 
      IFNOT HT THEN [IF LEN= -1 OR LEN2= -1 THEN\ 
                   GO TO EOF,\
                      ELSE GO TO NEXT]
       CALL WRITF(IDCB3,ER,$NA1,3) !WRITE FILE NAME/LU
      IF LEN = -1 THEN [WEOF;GO TO URRP]
      CALL XEXTL(LEN,@I.BUF,RC) !GO LIST RECORD 
! 
URRP: CALL WRITF(IDCB3,ER,$NA2,3)   !WRITE 2ND NAME LU
      IF LEN2= -1 THEN [WEOF;RETURN]
      CALL XEXTL(LEN2,@O.BUF,RC)   !LIST 2ND BAD RECORD 
! 
! 
      RETURN
      END 
! 
! 
WEOF: SUBROUTINE DIRECT 
      CALL WRITF(IDCB3,ER,EOFM,2) 
      RETURN
      END 
      END 
      END$
                                                                                                                                                                                                                                