*DECK,HPA31 
      OVCAP.
      SUBROUTINE HPA31
*CALL HPACOM1 
  
      IF (FROG(6) .NE. L"T") GO TO 10 
      CALL SECOND (CP)
      PRINT 9,CP
    9 FORMAT ( ' ENTER HPA31, SECOND = ',F10.3) 
   10 CONTINUE
      CALL INITEM 
      END 
          IDENT  INTEM31
          ENTRY  INITEM 
OVLNO     SET    0
INITEM    BSS    1
          SA1    PLST        GET ADDRESS OF PARAMETER LIST
          RJ     =XPERR31    GO PRINT ERROR CODE REPORT 
          JP     INITEM      EXIT 
  
PLST      VFD    42/0,18/ET 
          VFD    42/0,18/LEN
          VFD    42/0,18/0
LEN       VFD    42/0,18/ETLMT-ET 
          EJECT 
*CALL COMHPAERT 
          END 
      SUBROUTINE PERR31(NEC,LEN)
*CALL HPACOM1 
      DIMENSION NEC(4,1000),YBUF(2),XBUF(4) 
  
      IHDR=14 
      LEN=LEN/4 
      LC=0
      PLMT=PLF-6
  
*     PRINT ERROR MESSAGE LIST IN NUMERIC ORDER 
  
      DO 100 I=1,LEN
      RT1=AND(SHIFT(NEC(1,I),6),O"77")
      RT2=AND(SHIFT(NEC(1,I),12),O"77") 
      RT3=AND(SHIFT(NEC(1,I),18),O"77") 
      RT4=AND(SHIFT(NEC(1,I),24),O"77") 
      QUAL=AND(SHIFT(NEC(1,I),30),O"77")
      EC=AND(NEC(1,I),O"7777")
      ENCODE(20,9000,YBUF)RT1,RT2,RT3,RT4 
      IF(RT1.NE.O"77")GO TO 10
      YBUF(1)=3HALL 
      YBUF(2)=1H
   10 CONTINUE
  
      IF(LC.EQ.0)CALL HEADER
      IF(LC.EQ.0)PRINT 9001 
      LC=LC+1 
      IF(LC.EQ.PLMT)LC=0
      PRINT 9002,EC,YBUF,QUAL,NEC(2,I),NEC(3,I),NEC(4,I)
  100 CONTINUE
  
*     SORT TABLE ALPHABETICALLY 
  
      DO 230 I=1,LEN
      IF(I.EQ.LEN)GO TO 230 
  
      JJ=I+1
      DO 220 J=JJ,LEN 
      I1=AND(SHIFT(NEC(2,I),-6),(.NOT.MASK(6))) 
      J1=AND(SHIFT(NEC(2,J),-6),(.NOT.MASK(6))) 
      IF(I1.LE.J1)GO TO 220 
  
      DO 210 K=1,4
      S=NEC(K,J)
      NEC(K,J)=NEC(K,I) 
  210 NEC(K,I)=S
  
  220 CONTINUE
  
  230 CONTINUE
  
* 
*     PRINT OUT MESSAGES ALPHABETICALLY 
  
      IBASE=0 
  300 CALL HEADER 
      PRINT 9003
      DO 350 I=1,PLMT 
      IF(IBASE+I.GT.LEN)GO TO 400 
      DO 310 J=1,4
  310 XBUF(J)=1H
      IF(IBASE+PLMT+I.GT.LEN)GO TO 320
      ENCODE(40,9005,XBUF)(NEC(J,IBASE+PLMT+I),J=1,4) 
  320 PRINT 9004,(NEC(J,IBASE+I),J=1,4),XBUF
  350 CONTINUE
      IF(XBUF(1).EQ.1H )GO TO 400 
      IBASE=IBASE+2*PLMT
      GO TO 300 
  400 CONTINUE
  
      RETURN
  
 9000 FORMAT(I2.0,1X,I2.0,1X,I2.0,1X,I2.0)
 9001 FORMAT(/,' ERROR   USED IN',/,
     .         '  CODE   OVERLAYS  QUALIFIER MESSAGE',/)
 9002 FORMAT(2X,O4,1X,A10,A1,4X,O2,5X,3A10) 
 9003 FORMAT(/,' ERROR        ',26X,'ERROR        ',/,
     .         '  CODE MESSAGE',26X,' CODE MESSAGE',/)
 9004 FORMAT(2X,O4,1X,3A10,4X,A4,1X,3A10) 
 9005 FORMAT(O4,6X,3A10)
  
      END 
