*DECK STATNDT 
USETEXT COMCBEG 
USETEXT COMRAPL 
USETEXT COMRNAM 
USETEXT COMRNET 
USETEXT COMRQUE 
USETEXT COMRRTN 
    PROC STATNDT; 
# TITLE STATNDT - PROCESS SUPERVISORY MESSAGE STAT/NDT/R/N/A. # 
  
      BEGIN  # STATNDT #
  
# 
**    STATNDT - PROCESS SUPERVISORY MESSAGE STAT/NDT/R/N/A. 
* 
*     STATNDT PROCESSES THE STAT/NDT/R/N/A SUPERVISORY MESSAGES.
* 
*     PROC STATNDT. 
* 
*     ENTRY   -  QU$ADDRESS IS BASED ARRAY CONTAINING STAT/NDT/R/N/A
*                  SUPERVISORY MESSAGE (REQUEST/RESPONSE/REJECT). 
*                APL$HEADER IS BASED ARRAY FOR APPLICATION TABLE HEADER.
* 
*     EXIT   -   STAT/NDT REQUEST PROCESSED.
* 
*     PROCESS -  IF APPLICATION IS NOT SYSTEM-RESIDENT/PRIVILEGED:  
*                  CALL UCPMSG (INVALID STAT/NDT, ABORT). 
*                ELSE:  
*                  IF NDT ORDINAL OUT OF RANGE: 
*                    CALL UCPMSG (INVALID STAT/NDT ORD, ABORT). 
*                  ELSE:  
*                    IF STAT/NDT/A (REJECT):  
*                      CALL RHFMSG (STAT/NDT REJECTED). 
*                    ELSE:  
*                      UPDATE NDT WORD. 
*                      IF STAT/NDT/R (REQUEST): 
*                        CALL SUPRPLY (STAT/NDT/N RESPONSE).
*                    CALL RTNNSUP.
# 
  
# 
****  PROC STATNDT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC FREE;                 # RELEASE QUEUE ENTRY #
        PROC GETFREE;              # GET QUEUE ENTRY #
        PROC RHFMSG;               # ISSUE MESSAGE TO SYSTEM #
        PROC RTNNSUP;              # INITIATE NSUP REPLY #
        PROC SUPRPLY;              # SEND STAT/NDT/N MESSAGE #
        PROC UCPMSG;               # SEND MSG TO UCP #
        END 
  
# 
*     PROC STATNDT - XREF LIST END. 
# 
  
  
      ITEM I          U;           # SCRATCH #
      ITEM NEWSTATE   U;           # NEW STATE #
      ITEM NEWTIMES   U;           # NEW TIMES #
  
      DEF ERR$TEXTL  # 33 #;       # ERROR MESSAGE LENGTH # 
  
      ARRAY [0:2] S(4); 
        BEGIN 
        ITEM ERR$TEXT   C(00,00,ERR$TEXTL) =
                 ["STAT/NDT INVALID FOR APPLICATION." 
                 ,"STAT/NDT ORDINAL OUT OF RANGE.   " 
                 ,"STAT/NDT REJECTED BY APPLICATION." 
                 ]; 
        END 
  
  
CONTROL EJECT;
  
      I = 2;
      IF NOT APL$SYSORG            # IF UCP NOT VALIDATED # 
      THEN
        BEGIN 
        I = 0;
        END 
  
      ELSE
        BEGIN 
        IF QU$NDENTAD GT NDT$LENGTH  # IF NDT ORDINAL OUT OF RANGE #
        THEN
          BEGIN 
          I = 1;
          END 
        END 
  
      IF I LT 2 
      THEN
        BEGIN 
        UCPMSG(APL$JOBID,LOC(ERR$TEXT[I]),ERR$TEXTL,REPLY$ABT,QU$UCPA); 
        FREE; 
        END 
  
      ELSE
        BEGIN 
        IF QU$PFCSFC EQ $STATNDTA 
        THEN
          BEGIN 
          RHFMSG(LOC(ERR$TEXT[I]),ERR$TEXTL); 
          END 
  
        ELSE     # STAT/NDT/R OR STAT/NDT/N # 
          BEGIN 
          IF QU$NDENOFS EQ 0       # UPDATE NDT WORD #
          THEN
            BEGIN 
            NDT$WD1[QU$NDENTAD + 1] = QU$SUPWD2;  # UPDATE NDT WORD # 
            END 
  
          ELSE                     # UPDATE NAD STATUS WORD # 
            BEGIN 
            I = P<NST$ENTRY>;               # SAVE NST ADDR # 
            P<NST$ENTRY> = LOC(QU$SUPWD2);  # NEW NAD STATUS #
            NEWSTATE = NST$STATE; 
            NEWTIMES = NST$TIMES; 
            P<NST$ENTRY> = LOC(NDT$WD1[QU$NDENTAD + 1]);
            NST$STATE = NEWSTATE;           # RESET NAD STATE # 
            NST$TIMES = NEWTIMES;           # RESET TIMES # 
            P<NST$ENTRY> = I;               # RESTORE NST ADDR #
            END 
  
          IF QU$PFCSFC EQ $STATNDTR 
          THEN
            BEGIN 
            I = QU$UCPA;           # SAVE UCPA #
            QU$PFCSFC = $STATNDTN;
            QU$SUPWD2 = NDT$WD1[QU$NDENTAD + 1];
            SUPRPLY;               # SEND STAT/NDT/N #
            GETFREE;               # BUILD SUPR MSG STAT/NDT/N #
            QU$UCPA = I;           # SET UCPA # 
            QU$CHARGE = 0;
            QU$JOBID  = APL$JOBID;
            END 
          END 
  
        RTNNSUP;
        END 
  
      RETURN; 
      END  # STATNDT #
  
    TERM
