*DECK QERRLGL 
USETEXT COMCBEG 
USETEXT COMRAPL 
USETEXT COMRQUE 
PROC QERRLGL((LGLERR),(LESC),(UCPA),(BH),(FWOT),SWOFR,(TWOFR)); 
# TITLE QERRLGL - GENERATE AN ENTRY ON THE ERROR LOGICAL QUEUE. # 
  
      BEGIN  # QERRLGL #
  
# 
**    QERRLGL - GENERATE AN ENTRY ON THE ERROR LOGICAL QUEUE. 
* 
*     THIS PROCEDURE TAKES THE INFORMATION GIVEN BY THE INPUT 
*     PARAMETERS AND GENERATES AN ENTRY ON THE ERROR LOGICAL QUEUE. 
* 
*     PROC QERRLGL(LGLERR,LESC,UCPA,BH,FWOT,SWOFR,TWOFR)
* 
*     ENTRY   - P<APL$HEADER> IS THE OFFENDING APPLICATION. 
* 
*     EXIT    - P<QU$ADDRESS> IS PRESERVED. 
*               AN ENTRY HAS BEEN PLACED ON THE ERROR LOGICAL QUEUE.
* 
*     PROCESS - SAVE QUEUE ADDRESS. 
*               GET QUEUE ENTRY.
*               TRANSFER INFORMATION TO QUEUE ENTRY.
*               PUT ENTRY ON ERROR LOGICAL QUEUE. 
*               RESTORE QUEUE ADDRESS.
# 
  
      ITEM LGLERR     I;             # LOGIC ERROR CODE # 
      ITEM LESC       I;             # LOGIC ERROR SUBCODE #
      ITEM UCPA       I;             # UCP REPLY ADDRESS #
      ITEM BH         I;             # SUP MESSAGE BLOCK HEADER # 
      ITEM FWOT       I;             # FIRST WORD OF MESSAGE TEXT # 
      ARRAY SWOFR [0:0] S(1); 
        BEGIN  # SECOND WORD OF FIP REQUEST # 
        ITEM FIPFUNC    U(00,00,12); # REQUESTED APPLICATION FUNCTION # 
        ITEM FIPACN     U(00,12,12); # REQUESTED ACN #
        END 
      ITEM TWOFR      I;             # THIRD WORD OF FIP REQUEST #
  
# 
****  PROC QERRLGL - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC GETFREE;                # OBTAIN AVAILABLE QUEUE ENTRY # 
        PROC QUEUE;                  # ADD ENTRY TO QUEUE # 
        END 
  
# 
****  PROC QERRLGL - XREF LIST END. 
# 
  
  
      ITEM SAVEQP     I;             # QUEUE POINTER SAVE AREA #
  
CONTROL EJECT;
  
      SAVEQP = P<QU$ADDRESS>; 
      GETFREE;
      QU$TYPE = QT$ERRLGL;
      QU$ERROR = LGLERR;
      QU$SUBERRC = LESC;
      QU$UCPA = UCPA; 
      QU$SUPAPAD = P<APL$HEADER>; 
      QU$FIPFUNC = FIPFUNC; 
      QU$FIPACN = FIPACN; 
      QU$BH = BH; 
      QU$FWOT = FWOT; 
      QU$TWOFR = TWOFR; 
      QUEUE(LOC(ERRLGLQ));
      P<QU$ADDRESS> = SAVEQP; 
  
      END  # QERRLGL #
  
      TERM
