FTN4
      SUBROUTINE DBERR(ICODE,ITTY),92069-16061 REV.1912 781221
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 WITH OUT THE PRIOR 
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18116
C     RELOC:     92069-16060
C 
C 
C****************************************************************:
C 
C 
C 
C 
C 
C  DBERR IS A UTILITY SUBROUTINE FOR QUERY WHICH ACCEPTS A DBMS ERROR 
C  CODE AND PRINTS OUT AN APPROPRIATE ERROR MESSAGE FOR THE ERROR 
C  RECEIVED.
C 
C  THE CALLING SEQUENCE FOR DBERR IS: 
C 
C      CALL DBERR(ICODE,ITTY) 
C 
C  WHERE
C 
C      ICODE
C      IS THE DBMS ERROR CODE FOR WHICH A MESSAGE IS TO BE PRINTED. 
C 
C      ITTY 
C      IS THE LU OF THE DEVICE ON WHICH THE ERROR MESSAGE IS TO BE PRINTED. 
C 
C 
      INTEGER ICODE,ITTY
      INTEGER IEARY(63),IMESS(21),IEMES(9)
C 
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
C DOES NOT NEED COMMON
      DATA IEARY/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, 
     1           16,17,18,19,20,21,22,23,24,25,26,0,
     2           0,27,28,0,29,30,0,31,32,33,34,0,0, 
     3           35,0,0,0,0,0,0,0,0,0,36,0,37,38,39,
     4           40,41,42,43,44,45,46,47/ 
      DATA IEMES/2H E,2HRR,2HOR,2H N,2HO ,2H  ,2H  ,2H  ,2H  /
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  BEGIN
C 
C 
C  BOUND CHECK THE ERROR CODE (ICODE).  ONLY 100 THROUGH 162 ERROR CODES
C  ARE RECOGNIZED BY THIS ROUTINE.
C 
      IF (ICODE .LT. 100 .OR. ICODE .GT. 162) GO TO 10
C 
C  DETERMINE THE INDEX INTO THE ERROR CODE TABLE IN DBMES FOR THIS ERROR. 
C  THIS INDEX IS THE ENTRY IN THE ARRAY IEARY SUBSCRIPTED BY: 
C               ICODE - 99. 
C 
      INDEX = IEARY(ICODE - 99) 
C 
C  IF THE INDEX IS ZERO, THIS IS AN ERROR CODE WHICH FALLS WITHIN RANGE 
C  BUT IS UNRECOGNIZABLE BECAUSE THERE ARE HOLES IN THE DBMS ERROR CODE 
C  SEQUENCE.
C 
      IF (INDEX .EQ. 0) GO TO 10
C 
C  ERROR CODE RECOGNIZABLE, CALL DBMES TO GET ITS CORRESPONDING ASCII MES-
C  SAGE, PRINT IT, AND RETURN.
C 
      CALL DBMES(INDEX,IMESS,ISZ) 
      CALL ERIO(2,ITTY,IMESS,ISZ) 
      GO TO 20
C 
C  ERROR CODE UNRECOGNIZABLE.  SET UP MESSAGE:
C         ERROR NO    XXX 
C  WHERE XXX IS THE ASCII OF THE ERROR CODE.  PRINT THE MESSAGE AND 
C  RETURN.
C 
10    CALL CNUMD(ICODE,IEMES(7))
      CALL ERIO(2,ITTY,IEMES,9) 
C 
20    RETURN
      END 
                                                                                                    