*DECK,QCMCALL 
USETEXT IP$COM
USETEXT MISC$ 
USETEXT QAC$COM 
USETEXT TSB$COM 
USETEXT ACN$COM 
USETEXT GLOBALI 
USETEXT QAB$COM 
USETEXT QCB$COM 
      PROC QCMCALL (QAB$ORDINAL); 
      BEGIN # QCMCALL # 
*IF DEF,IMS 
 #
*1DC  QCMCALL 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        QCMCALL             B. M. WEST          1 MARCH 1977 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        QCMCALL PLACES QAC ACTION BLOCK ON EITHER THE IMMEDIATE OR 
*        EXTEND CHAIN OF QAB"S TO BE SUBMITTED TO QAC DEPENDING ON
*        THE QAB$EXTFLAG SETTING. 
* 
*     3. METHOD USED. 
*        CALLING MODULE PASSES ORDINAL OF QAB TO BE CHAINED.
*        QCMCALL EXAMINES THE QAB$EXTFLAG. IF SET TRUE, THEN THE QAB IS 
*        CHAINED ON THE EXTENDED ACTION CHAIN ELSE IT IS PLACED ON
*        THE IMMEDIATE ACTION CHAIN.
* 
*     4. ENTRY PARAMETERS.
*        QAB$ORDINAL         ORDINAL OF QUEUE ACTION BLOCK
* 
*     5. EXIT PARAMETERS. NONE
* 
*     6. COMDECKS CALLED. 
*        TSBMDEFS 
*        TSBMBASE 
*        QAB$COM
*        RBF$COM
*        QCB$COM
* 
*     7. ROUTINES CALLED. NONE
* 
*     8. DAYFILE MESSAGES. NONE 
* 
 #
*ENDIF
  
# 
      PARAMETER DEFINITIONS 
# 
      ITEM QAB$ORDINAL U; 
# 
      SET UP QCB
# 
      P<QCB> = ADDRESS [ACN$CB[QCBACN]];
# 
      DETERMINE WHICH CHAIN QAB IS TO BE PLACED ON
# 
      P<QAB> = ADDRESS [QAB$ORDINAL]; 
      QAB$NEXT = 0; 
      QAB$ORD = QAB$ORDINAL;
      QAB$ACN = ACN;
      IF QAB$EXTFLAG
      THEN
        BEGIN                # PLACE QAB IN QUEUE CONTAINING "EXT" QABS#
        IF QCB$EXTTBSF EQ 0        # TO BE SUBMITTED TO QAC            #
        THEN
          BEGIN              # QUEUE EMPTY - START NEW ONE             #
          QCB$EXTTBSF = QAB$ORDINAL;
          QCB$EXTTBSL = QAB$ORDINAL;
          END                # QUEUE EMPTY ...                         #
  
        ELSE
  
          BEGIN              # QUEUE NON-EMPTY - ADD QAB TO END        #
          P<QAB> = ADDRESS[QCB$EXTTBSL];
          QAB$NEXT = QAB$ORDINAL; 
          QCB$EXTTBSL = QAB$ORDINAL;
          END                # QUEUE NON-EMPTY ...                     #
  
  
        END                  # PLACE QAB IN QUEUE CONTAINING "EXT" ... #
  
      ELSE
  
        BEGIN                # PLACE QAB IN QUEUE WITH NEW "IMD" QAB-S #
        IF QCB$IMDTBSF EQ 0        # TO BE SUBMITTED TO QAC            #
        THEN
          BEGIN              # QUEUE EMPTY - START NEW ONE             #
          QCB$IMDTBSF = QAB$ORDINAL;
          QCB$IMDTBSL = QAB$ORDINAL;
          END                # QUEUE EMPTY ...                         #
  
        ELSE
  
          BEGIN              # QUEUE NON-EMPTY - ADD QAB TO END        #
          P<QAB> = ADDRESS[QCB$IMDTBSL];
          QAB$NEXT = QAB$ORDINAL; 
          QCB$IMDTBSL = QAB$ORDINAL;
          END                # QUEUE NON-EMPTY ...                     #
  
        END                  # PLACE QAB IN QUEUE WITH NEW "IMD" QAB-S #
  
      RETURN;                               # RETURN                   #
      END   # QCMCALL # 
      TERM; 
