*DECK ERRLGL
USETEXT COMCBEG 
USETEXT COMRAPL 
USETEXT COMRQUE 
USETEXT COMRRTN 
USETEXT COMRSFC 
USETEXT COMRUNK 
USETEXT COMRNAM 
PROC ERRLGL;
# TITLE ERRLGL - PROCESS ENTRIES ON THE ERR/LGL QUEUE. #
  
      BEGIN  # ERRLGL # 
  
# 
**    ERRLGL - PROCESS ENTRIES ON THE ERR/LGL QUEUE.
* 
*     REMOVE ALL ENTRIES FROM THE ERROR LOGICAL QUEUE AND NOTIFY OR 
*     ABORT THE USER INVOLVED IN EACH ENTRY.
* 
*     PROC ERRLGL.
* 
*     ENTRY   - NONE. 
* 
*     EXIT    - NONE. 
* 
*     PROCESS - ASLONGAS THE ERR/LGL QUEUE IS NOT EMPTY 
*               DO: 
*                 IF USER LOGIC ERROR 
*                 THEN: 
*                   IF USER IS ABOVE LIMIT
*                   THEN: 
*                     RELEASE QUEUE ENTRY.
*                   ELSE: 
*                     IF ERR/LGL LIMIT REACHED
*                     THEN: 
*                       GIVE ERR/LGL LIMIT REACHED RESPONSE.
*                     ELSE: 
*                       GIVE ACTUAL ERR/LGL RESPONSE. 
*                     CREATE AN ERR/LGL ASYNC SUP MESSAGE.
*                     QUEUE ON APPLICATION MESSAGE QUEUE. 
*                   IF USER IS REQUESTING A REPLY 
*                   THEN: 
*                     RETURN NSUP REPLY.
*                 ELSE: 
*                   IF ALREADY ATTEMPTED TO ABORT THIS APPL 
*                   THEN: 
*                     FORCE NETOFF PROCESSING.
*                     DAYFILE ERROR MESSAGE.
*                   ELSE: 
*                     BUILD ERROR MESSAGE.
*                     RELEASE QUEUE ENTRY.
*                     SEND MESSAGE TO USER"S DAYFILE. 
*                     ABORT UCP.
# 
  
# 
****  PROC ERRLGL - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC BUILDEM;                # BUILD ERROR MESSAGE #
        PROC DEQUEUE;                # GET ENTRY FROM QUEUE # 
        PROC FREE;                   # FREE QUEUE ENTRY # 
        PROC GETFREE;                # GET FREE QUEUE ENTRY # 
        PROC UCPMSG;                 # SEND MESSAGE TO UCP #
        PROC RTNNSUP;                # RETURN NSUP REPLY #
        PROC RHFMSGJ;                # DAYFILE RHF MESSAGE #
        PROC QUEUE;                  # ADD ENTRY TO QUEUE # 
        END 
  
# 
****  PROC ERRLGL - XREF LIST END.
# 
  
  
      ITEM TEMPQ      I;             # TEMPORARY QUEUE POINTER #
      ITEM SAVEUCPA   I;             # UCP RETURN ADDRESS # 
      ITEM MESSADDR   I;             # DAYFILE MESSAGE ADDRESS #
      ITEM CHARCNT    I;             # MESSAGE LENGTH IN CHARS #
      ITEM JOBID      I;             # JOB IDENTIFIER # 
  
CONTROL EJECT;
  
      TEMPQ = ERRLGLQ;
      ERRLGLQ = 0;
  
      ASLONGAS  TEMPQ NE 0
      DO
        BEGIN  # FOR EACH ERR/LGL ENTRY # 
  
        DEQUEUE(LOC(TEMPQ));
        P<APL$HEADER> = QU$SUPAPAD; 
        SAVEUCPA = QU$UCPA; 
  
        IF QU$ERROR NE LGL$NULERR 
        THEN
          BEGIN  # USER LOGIC ERROR # 
  
          IF APL$ERRLGL GT MAXERRLGLS 
          THEN
            BEGIN  # USER BEYOND ERR/LGL LIMIT #
            FREE; 
            END 
  
          ELSE
            BEGIN  # QUEUE AN ERR/LGL MESSAGE # 
            IF APL$ERRLGL EQ MAXERRLGLS 
            THEN
              BEGIN 
              QU$RC = LGL$ERRLMT; 
              END 
            ELSE
              BEGIN 
              QU$RC = QU$ERROR; 
              END 
            QU$TYPE = QT$UCPMSGR; 
            QU$PFCSFC = $ERRLGL;
            QU$ERRLGL = TRUE; 
            $SUPTLC = 4;
            QU$BLKHDR = $SUPHDR;
            QUEUE(LOC(APL$MSGQ)); 
            APL$MSGCNT = APL$MSGCNT + 1;
            APL$ERRLGL = APL$ERRLGL + 1;
            END 
  
          IF SAVEUCPA NE 0
          THEN
            BEGIN  # NEED TO GIVE UCP REPLY # 
            GETFREE;
            QU$UCPA = SAVEUCPA; 
            RTNNSUP;
            END 
          END 
  
        ELSE
          BEGIN  # FATAL APPLICATION ERROR #
          IF NOT APL$AATABT 
          THEN
            BEGIN  # ABORT APPLICATION #
            BUILDEM(MESSADDR,CHARCNT);
            FREE; 
            JOBID = APL$JOBID;
            IF NOT APL$NETON
            THEN
              BEGIN  # CLEAR APPL HEADER #
              APL$JOBID = 0;
              END 
            ELSE
              BEGIN  # ONLY ALLOW ONE REPRIEVE #
              APL$AATABT = TRUE;
              END 
            UCPMSG(JOBID,MESSADDR,CHARCNT,REPLY$ABT,SAVEUCPA);
            END 
  
          ELSE
            BEGIN  # CANNOT ABORT UCP # 
            QU$JOBID = APL$JOBID; 
            QU$APLADR = P<APL$HEADER>;
            QU$FUNCT = UCP$NETOFF;
            QU$UCPA = 0;
            QU$STAT = STATUCPABT; 
            QU$WC = 1;
            QU$CHARGE = 1;
            QUEUE(LOC(NETOFFQ));
            RHFMSGJ(APL$JOBID,LOC(MSGCNBA),CNA$LENGTH); 
            END 
          END 
        END 
  
      END  # ERRLGL # 
  
      TERM
