*DECK BUILDEM 
USETEXT COMCBEG 
USETEXT COMRQUE 
USETEXT COMRAPL 
USETEXT COMRSFC 
USETEXT COMRUNK 
USETEXT COMRRTN 
PROC BUILDEM(MESSADDR,CHARCNT); 
# TITLE BUILDEM - BUILD ERROR MESSAGE. #
  
      BEGIN  # BUILDEM #
  
# 
**    BUILDEM - BUILD ERROR MESSAGE.
* 
*     THIS PROCEDURE RETURNS THE ADDRESS OF THE APPROPRIATE DIAGNOSTIC
*     MESSAGE FOR THE GIVEN USER ERROR. 
* 
*     PROC BUILDEM(MESSADDR,CHARCNT)
* 
*     ENTRY   - P<APL$HEADER> =  APPLICATION CAUSING ERROR. 
*               P<QU$ADDRESS> =  ERROR LOGICAL QUEUE ENTRY. 
* 
*     EXIT    - (MESSADDR) = ADDRESS OF ERROR MESSAGE.
*               (CHARCNT)  = LENGTH IN CHARACTERS OF MESSAGE. 
* 
*     PROCESS - IF HEADER ADDRESS ERROR 
*               THEN: 
*                 SET UP HEADER ADDRESS ERROR MESSAGE.
*                 RETURN LENGTH AND LOCATION OF MESSAGE.
*               ELSE: 
*                 IF TEXT ADDRESS ERROR 
*                 THEN: 
*                   SET UP TEXT ADDRESS ERROR MESSAGE.
*                   RETURN LOCATION AND LENGTH OF MESSAGE.
*                 ELSE: 
*                   IF FET ADDRESS ERROR
*                   THEN: 
*                     SET UP FET ADDRESS ERROR MESSAGE. 
*                     RETURN LENGTH AND LOCATION OF MESSAGE.
*                   ELSE: 
*                     IF SSF UCP ADDRESS ERROR
*                     THEN: 
*                       SET UP SSF UCP ADDRESS ERROR MESSAGE. 
*                       RETURN LENGTH AND LOCATION OF MESSAGE.
*                     ELSE: 
*                       SET UP SSF ERROR MESSAGE. 
*                       RETURN LENGTH AND LOCATION OF MESSAGE.
# 
  
      ITEM MESSADDR   I;             # ADDRESS OF ERROR MESSAGE # 
      ITEM CHARCNT    I;             # LENGTH OF MESSAGE IN CHARS # 
  
# 
**** PROC BUILDEM - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        FUNC BINTOOD C(10);          # CONVERT BINARY TO OCTAL DIS #
        END 
  
# 
****  PROC BUILDEM - XREF LIST END. 
# 
  
  
      ARRAY [0:0] S(1); 
        BEGIN 
        ITEM FIPADDRS   I(00,00,60); # SPECIAL FIP ADDRESSES #
        ITEM FIPHA      I(00,06,18); # HEADER ADDRESS # 
        ITEM FIPTA      I(00,42,18); # TEXT ADDRESS # 
        ITEM FIPFA      I(00,42,18); # FET ADDRESS #
        END 
  
CONTROL EJECT;
  
      IF QU$SUBERRC EQ LES$HAERR
      THEN
        BEGIN  # HEADER ADDRESS ERROR # 
        FIPADDRS = QU$TWOFR;
        MIA$INVPAR = "HEADER ADDRESS";
        MIA$INPRAD = BINTOOD(FIPHA,6);
        MESSADDR = LOC(MSGINVAD); 
        CHARCNT = MIA$LENGTH; 
        END 
      ELSE
        BEGIN 
  
        IF QU$SUBERRC EQ LES$TAERR
        THEN
          BEGIN  # TEXT ADDRESS ERROR # 
          FIPADDRS = QU$TWOFR;
          MIA$INVPAR = "TEXT ADDRESS";
          MIA$INPRAD = BINTOOD(FIPTA,6);
          MESSADDR = LOC(MSGINVAD); 
          CHARCNT = MIA$LENGTH; 
          END 
        ELSE
          BEGIN 
  
          IF QU$SUBERRC EQ LES$FAERR
          THEN
            BEGIN  # FET ADDRESS ERROR #
            FIPADDRS = QU$TWOFR;
            MIA$INVPAR = "FET PRAM.  FET =";
            MIA$INPRAD = BINTOOD(FIPFA,6);
            MESSADDR = LOC(MSGINVAD); 
            CHARCNT = MIA$LENGTH; 
            END 
          ELSE
            BEGIN 
  
            IF QU$SUBERRC EQ SFRC$UCPA
            THEN
              BEGIN  # SSF UCP ADDRESS ERROR #
              SFC$WD1 = QU$SSFREQW; 
              MIA$INVPAR = "SSF UCP ADDRESS"; 
              MIA$INPRAD = BINTOOD(SFC$UCPA1,6);
              MESSADDR = LOC(MSGINVAD); 
              CHARCNT = MIA$LENGTH; 
              END 
  
            ELSE
              BEGIN  # FATAL USER SSF ERROR # 
              SFC$WD1 = QU$SSFREQW; 
              MSE$FC = BINTOOD(SFC$FC1,2);
              MSE$RC = BINTOOD(SFC$RC1,2);
              MESSADDR = LOC(MSGFATSSFE); 
              CHARCNT = MSE$LENGTH; 
              END 
            END 
          END 
        END 
  
      END  # BUILDEM #
  
      TERM
