QMOVE 
          IDENT  QMOVE1,OVLA,QMOVE,01,00
          ABS 
          SST 
          SYSCOM B1 
*COMMENT  QMOVE - QUEUE MOVE PROCESSOR. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          TITLE  QMOVE - QUEUE MOVE PROCESSOR.
          SPACE  4
***       QMOVE - QUEUE MOVE PROCESSOR. 
*         A. J. BEEKMAN.     76/03/11.
          SPACE  4
***       *QMOVE* IS A UTILITY PROGRAM THAT MOVES QUEUE FILES FROM ONE
*         MASS STORAGE DEVICE TO ANOTHER AND PROVIDES A LIST OF ALL 
*         FILES MOVED WITH INFORMATION RELATIVE TO EACH.
          SPACE  4
***       *QMOVE* MAY BE CALLED FROM THE CONSOLE BY THE QUEUED FILE 
*         SUPERVISOR PROGRAM (X.QFSP.) OR BY COMMAND.  THE
*         COMMAND FORMAT IS - 
* 
*         QMOVE(P1=A1,P2=A2,...,PN=AN)
* 
*         WHERE P1 - PN ARE ANY OF THE FOLLOWING VALID PARAMETERS - 
* 
*         MI = MACHINE ID.
* 
*         FM = FAMILY NAME TO MOVE FROM.
* 
*         DN = DEVICE NUMBER (FAMILY MUST BE SPECIFIED FIRST).
* 
*                THE FM AND DN PARAMETERS ARE USED TO DESCRIBE THE
*                FAMILY AND DEVICE OR SET OF FAMILIES OR DEVICES FROM 
*                WHICH THE QUEUED FILES SHOULD BE MOVED.  FM MAY BE 
*                *ALL*, IN WHICH CASE DN MUST ALSO BE *ALL*.
* 
*         DF = DESTINATION FAMILY NAME. 
* 
*         DD = DESTINATION DEVICE NUMBER (DESTINATION FAMILY MUST 
*              BE SPECIFIED FIRST). 
* 
*                THE DF AND DD PARAMETERS ARE USED TO DESCRIBE THE
*                FAMILY AND DEVICE TO WHICH THE QUEUED FILES SHOULD BE
*                MOVED.  *ALL* IS NOT A LEGAL VALUE FOR THESE 
*                PARAMETERS.
* 
*         FU = FAMILY NAME FOR USER INDEX.
* 
*         UI = USER INDEX RANGE (0 - 377777B).
* 
*                THE FU AND UI PARAMETERS DESCRIBE THE FAMILY AND USER
*                INDICIES OF THE QUEUED FILES WHICH ARE TO BE MOVED.
* 
*         DA = MOVE DATE RANGE.  FORM IS YYMMDD WHERE YY IS THE 
*              YEAR,  MM THE MONTH, AND DD THE DAY.  IT CAN ALSO BE 
*              SPECIFIED AS ALL (DA=ALL) WHICH WILL SELECT ALL DATES. 
* 
*         FS = FILE SIZE RANGE IN PRUS (0-777777B). 
*              IF 777777B IS SPECIFIED, SIZES LARGER ARE ALSO INCLUDED. 
* 
*         JSN = JOB SEQUENCE NUMBERS OF FILES TO MOVE.  UP TO 5 
*               ALLOWED.  IF PREVIOUSLY ENTERED, THE JSN WILL BE
*               CLEARED.
* 
*         ID = ID RANGE OF BATCH AND SYSTEM ORIGIN FILES TO MOVE
*              (0 - 77B). 
* 
*         LA = LOWER SECURITY ACCESS LEVEL (1-7 CHARACTERS).
* 
*         UA = UPPER SECURITY ACCESS LEVEL (1-7 CHARACTERS).
* 
*         TUI= DESITNATION TUI OF REMOTE BATCH FILES TO MOVE
*              TUI=0 IMPLIES MOVE ALL REMOTE BATCH FILES. 
* 
*         TF = DESTINATION FAMILY FOR TERMINAL FOR SELECTING FILES
*              IN THE REMOTE BATCH QUEUE. 
* 
*         FC = FORMS CODE.  MAY BE A SINGLE ENTRY (FC=F1), A LIST 
*              (FC=F1/F2/F3), OR A RANGE (FC=F1-F2) WHERE F1 IS 
*              2 CHARACTERS, ALL, OR NULL (SPECIFIED BY **).
* 
*         I  = ALTERNATE DIRECTIVE INPUT FILE. THIS IS A
*                COMMAND PARAMETER SPECIFYING WHAT FILE SHOULD
*                BE READ FOR INPUT DIRECTIVES.  THESE DIRECTIVES
*                CONSIST OF ANY LEGAL K-DISPLAY INPUT OR COMMANDS.
*                THESE DIRECTIVES WILL BE PROCESSED AFTER THE 
*                COMMAND DIRECTIVES BUT BEFORE ANY
*                K-DISPLAY INPUT IS ACCEPTED. 
* 
*         L  = FILE NAME TO RECEIVE OUTPUT. 
* 
*         TP = TYPE TO MOVE.
*                A - MOVE ACTIVE QUEUE FILES. 
*                I - MOVE INACTIVE QUEUE FILES. 
*                ALL - MOVE ACTIVE AND INACTIVE QUEUE FILES.
* 
*         OP = MOVE OPTION. 
*                A - LEAVE QUEUE FILES AS ACTIVE FILES. 
*                I - LEAVE QUEUE FILES AS INACTIVE FILES. 
* 
*         DS = DT.  SELECT FILE DESTINATION BY DISPOSITION TYPE.
*              MAY BE ENTERED MORE ONCE.  OPTION WILL BE CLEARED
*              IF PREVIOUSLY SELECTED.
*                OT MAY BE -
*                BC - BATCH.
*                RB - REMOTE BATCH. 
*                DT MAY BE -
*                     SF - SPECIAL INSTALLATION DEFINED QUEUE FILES.
*                     IN - INPUT. 
*                     PU - PUNCH. 
*                     PL - PLOT.
*                     PR - PRINT (ANY PRINTER). 
*                     P2 - PRINT (512 PRINTER). 
*                     LR - PRINT (580-12 PRINTER).
*                     LS - PRINT (580-16 PRINTER).
*                     LT - PRINT (580-20 PRINTER).
*                     LX - PRINT (5870 NIP).
*                     LY - PRINT (5970 NIP).
*                     WT - WAIT.
*                     PRINT - ALL PRINT TYPES.
*                     ALL - ALL TYPES.
*                     NONE - NO TYPES.
* 
*         PO = PROCESSING OPTIONS WHERE OPTIONS ARE DEFINED AS
*              THE FOLLOWING -
*                N - IF SPECIFIED, ONLY COMMAND DIRECTIVES
*                    WILL BE PROCESSED.  K-DISPLAY IS AVAILABLE 
*                    FOR MONITORING THE UTILITY PROGRESS, BUT NO
*                    K-DISPLAY INPUT IS ALLOWED.  THE N PARAMETER 
*                    IS IMPLIED ON ALL NON-SYSTEM ORIGIN JOBS.
*                E - IF SPECIFIED, ERRORED FILE PROCESSING STATUS 
*                    WILL BE TOGGLED. 
*                F - IF SPECIFIED, ON ACTIVATE REQUESTS ENTRIES WILL
*                    BE MADE IN THE FOT FOR THE INACTIVE FAMILIES 
*                    AND THE FILES WILL BE QUEUED.  DEFAULT IS TO 
*                    IGNORE THOSE FILES.
*                I - IF SPECIFIED, INACTIVE INPUT QUEUE FILES WILL BE 
*                    ACTIVATED WHEN THE OWNER FAMILY IS NOT PRESENT.
*                U - IF SPECIFIED, UNCONDITIONALLY LOAD FILES WITHIN
*                    SECURITY RESTRAINTS AND SYSTEM FILE INTEGRITY. 
* 
*         DEFAULT VALUES DEFINED IN *QFSP*. 
* 
*         *K* DISPLAY COMMANDS AVAILABLE TO *QMOVE* ARE - 
* 
*         GO. - PROCEED WITH PROCESSING.
*         STOP. - TERMINATE INPUT, END RUN. 
*         RESET. - RESET PARAMETERS TO DEFAULT VALUES.
*         OUT. - RELEASE FILE SPECIFIED BY L PARAMETER TO PRINTER.
*         ERROR. - TOGGLE STATUS OF ERRORED FILE PROCESSING.  IF SET, 
*                  ERRORED FILES WILL BE MOVED.  DEFAULT IS NOT SET.
*         FAMILY. - IF SPECIFIED, ON ACTIVATE REQUESTS ENTRIES
*                   WILL BE MADE IN THE FOT FOR THE INACTIVE FAMILIES 
*                   AND THE FILES WILL BE QUEUED.  DEFAULT IS 
*                   TO IGNORE THOSE FILES.
          SPACE  4
**        ENTRY CONDITIONS. 
* 
*         *QMOVE* IS ENTERED VIA RETURN JUMP FROM *QFSP*. 
* 
*         *TARA* = FWA OF THE PARAMETER TABLE.
*         *TDAA* = FWA OF DEVICE ACCESS LEVEL TABLE.
*         *TEQA* = FWA OF THE MASS STORAGE EQUIPMENT TABLE. 
*         *QFTA* = *QFTP* WORD FROM CENTRAL MEMORY RESIDENT.
*         *FOTA* = FWA OF THE FAMILY ORDINAL TABLE. 
          SPACE  4
***       DAYFILE MESSAGES. 
* 
*         THE FOLLOWING MESSAGES ARE ISSUED TO THE DAYFILE AND
*         THE *K* DISPLAY UNLESS NOTED OTHERWISE. 
* 
* 
*         * FOT FULL - FILES IGNORED.* - SOME OF THE QUEUED FILES 
*         WERE NOT PROCESSED BECAUSE THERE WAS NO FOT ENTRY FOR THE 
*         CREATION AND/OR THE DESTINATION FAMILY AND THE FOT WAS
*         FULL (MESSAGE ISSUED BY *COMCVQF*).  (DAYFILE ONLY).
* 
*         * JSN      EQNNNN TRACK TTTT LENGTH ERROR.* = THE QUEUE 
*         FILE ON THE SPECIFIED EQUIPMENT AND TRACK WAS 
*         DETECTED AS HAVING A LENGTH ERROR AT RECOVERY TIME. 
*         CONTACT AN ANALYST AND BRING THIS TO HIS ATTENTION. 
*         (DAYFILE ONLY). 
* 
*         * INCORRECT MOVE REQUESTED.* = ONE OF THE FOLLOWING 
*         CONDITIONS IS TRUE -
*         1) DEVICE SPECIFIED IS NOT MASS STORAGE.
*         2) DESTINATION DEVICE IS REMOVABLE AND OPTION IS A. 
*         3) DESTINATION DEVICE HAS ERROR IDLE SET. 
*         ENTER THE CORRECT PARAMETERS AND RETRY OPERATION. 
* 
*         * INCORRECT DEVICE ACCESS LEVEL.* 
*         THE JOB DOING THE *QMOVE* IS NOT VALIDATED FOR THE
*         ACCESS LEVELS OF THE DEVICE.
* 
*         * IQFT FILE ERROR DN XX FAMILY AAAAAAA.* = AN ERROR HAS 
*         BEEN ENCOUNTERED ATTACHING OR READING THE IQFT FILE.
*         THE MESSAGE FOLLOWING THIS MESSAGE IN THE DAYFILE 
*         DESCRIBES THE ERROR.  (DAYFILE ONLY). 
* 
*         * OUTPUT FILE NAME CONFLICT.* = THE SPECIFIED OUTPUT
*         FILE NAME CONFLICTS WITH A NAME ALREADY IN USE. 
*         CHANGE THE OUTPUT FILE NAME AND RETRY.
* 
*         * QFT THRESHOLD LIMIT.* = THE QFT THRESHOLD FOR THE 
*         NUMBER OF QUEUE FILES ALLOWED IN THE QFT AS 
*         A RESULT OF REQUEUING HAS BEEN REACHED.  NO 
*         MORE QUEUE FILES MAY BE ACTIVATED UNTIL SOME OF THESE 
*         FILES ARE RELEASED. 
* 
*         * QMOVE ABORTED.* = AN ERROR HAS BEEN DETECTED WHICH
*         IS NOT PROCESSED BY QMOVE ERROR PROCESSING.  ATTEMPTS 
*         HAVE BEEN MADE TO REMEDY THE SITUATION, BUT DISCRETION
*         SHOULD BE USED IN CONTINUED USE OF QMOVE.  IN ANY 
*         CASE, AN ANALYST SHOULD BE CONTACTED.  CHECK THE
*         DAYFILE FOR THE ERROR THAT CAUSED THE ABORT.
* 
*         * QUEUE STATUS INDEFINITE.* = QMOVE HAS NOT BEEN ABLE TO
*         FINISH THE CLEAN UP AFTER AN ERROR OR ERROR EXIT.  THE
*         STATUS OF IQFTS AND QUEUED FILES IS UNKNOWN.  A LEVEL ZERO
*         DEADSTART IS RECOMMENDED TO CLEAN UP THE IQFT FILES.
* 
*         * IQFT NOT FOUND.* = ALL DEVICES SHOULD HAVE
*         AN IQFT FILE.  DEVICE SHOULD BE INITIALIZED TO CREATE 
*         AN IQFT.
* 
*         * QUEUES UNRECOVERABLE THIS DEVICE.* = THE IQFT FILE
*         ON THE SPECIFIED DEVICE CANNOT BE READ PROPERLY.  AN
*         ANALYST SHOULD BE CONTACTED.  (DAYFILE ONLY). 
* 
*         * XXXX FILES ACTIVATED DNYY  FM AAAAAAA.* = NUMBER OF 
*         QUEUED FILES ACTIVATED THIS DEVICE. 
* 
*         * XXXX QUEUE FILES INTERLOCKED.* = NUMBER OF QUEUE FILES
*         INTERLOCKED ON THE DESTINATION DEVICE DUE TO
*         UNRECOVERABLE WRITE ERRORS OCCURING WHILE WRITING TO THAT 
*         DEVICE. 
* 
*         * XXXX FILES DEQUEUED  DNYY  FM AAAAAAA.* = NUMBER OF 
*         QUEUED FILES DEQUEUED THIS DEVICE.
* 
*         * XXXX FILES IGNORED   DNYY  FM AAAAAAA.* = NUMBER OF 
*         QUEUED FILE IGNORED THIS DEVICE ON THIS OPERATION.
* 
*         * XXXX FILES MOVED (A) DNYY  FM AAAAAAA.* = NUMBER OF 
*         ACTIVE QUEUED FILES MOVED AND LEFT ACTIVE THIS DEVICE.
* 
*         * XXXX FILES MOVED (I) DNYY  FM AAAAAAA.* = NUMBER OF 
*         INACTIVE QUEUED FILES MOVED AND LEFT INACTIVE THIS
*         DEVICE. 
          SPACE  4
***       *K* DISPLAY OPERATOR MESSAGES.
* 
*         * NO OUTPUT FILE EXISTS.* = NO OUTPUT FILE HAS BEEN 
*         CREATED PREVIOUS TO ENTERING THE *OUT* COMMAND. 
* 
*         * OUTPUT FILE RELEASED.* = OUTPUT FILE RELEASED TO PRINTER. 
* 
*         * QMOVE COMPLETE.* = THE SPECIFIED OPERATION HAS BEEN 
*         COMPLETED.
          SPACE  4
*         COMMON DECKS. 
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMSACC 
*CALL     COMSDSP 
*CALL     COMSJIO 
          LIST   X
*CALL     COMSIOQ 
*CALL     COMSQFS 
*CALL     COMSSFM 
          LIST   -X 
*CALL     COMSMLS 
*CALL     COMSSCD 
*CALL     COMSSSE 
*CALL     COMSSSJ 
          TITLE  ASSEMBLY CONSTANTS.
****      ASSEMBLY CONSTANTS. 
  
 BUFL     EQU    1001B       FET CIRCULAR BUFFER LENGTH 
 IBUFL    EQU    1001B       IQFT BUFFER LENGTH 
 QBUFL    EQU    2041B       QUEUED FILE DATA BUFFER LENGTH 
 SBUFL    EQU    101B        SYSTEM SECTOR BUFFER LENGTH
 WBUFL    EQU    110B        WORKING BUFFER LENGTH
 LNUM     EQU    TPPA+PPLN   LINE NUMBER
 PDFE     EQU    TPPA+PPPD   PRINT DENSITY FORMAT EFFECTOR
****
          SPACE  4,10 
*         *DSP* FLAG BIT EQUIVALENCES.
  
  
 FRDC     EQU    20B         DISPOSITION CODE 
          TITLE  RESERVED LOCATIONS AND FETS. 
*         RESERVED LOCATIONS. 
  
          ORG    OVLA 
  
 QNUM     CON    1           QUEUE FILE NUMBER
 PNUM     CON    1           PAGE NUMBER
 LIST     CON    0           OUTPUT PRESENT FLAG
 RECF     CON    0           LIST ANOTHER RECORD FLAG 
 DSPB     CON    0           TYPE OF FILES TO MOVE
 MVCT     CON    0           MOVE COUNT OF QUEUE FILES MOVED
 IGCT     CON    0           COUNT OF QUEUE FILES IGNORED 
 EFCT     CON    0           COUNT OF QUEUE FILES INTERLOCKED 
 REQF     CON    O           REQUEUE FLAG 
          SPACE  4
*         FETS. 
  
 O        BSS    0           OUTPUT FILE
 OUTPUT   FILEB  OBUF,BUFL,(FET=7)
  
 Q        BSS    0           QUEUE FILE 
 QNAME    FILEB  QBUF,QBUFL,EPR,(FET=13)
  
 S        BSS    0           SYSTEM SECTOR
 E        BSS    0           EOI SECTOR 
 SSEOI    FILEB  SBUF,SBUFL,EPR,(FET=8) 
  
 D        BSS    0           DESTINATION QUEUE FILE 
 DQFILE   FILEB  DBUF,QBUFL,EPR,(FET=13)
  
 IQ       BSS    0           OLD IQFT FILE
 "RFIQ"   FILEB  IBUF,IBUFL,EPR,(FET=8) 
  
 NIQ      BSS    0           NEW IQFT FILE FOR CURRENT DEVICE 
 "RFNI"   FILEB  NBUF,BUFL,(FET=8)
  
 MIQ      BSS    0           NEW IQFT FILE FOR MOVE DEVICE
 "RFMI"   FILEB  MBUF,BUFL,EPR,(FET=8)
  
 T        BSS    0           TEMPORARY IQFT ENTRY BUFFER
 TEMP     FILEB  TBUF,BUFL,EPR,(FET=9)
 QMOVE    TITLE  MAIN ROUTINE.
**        QMOVE - MAIN ROUTINE. 
* 
*         CALL PRESET IF NECESSARY, DETERMINE WHETHER *GO* OR 
*         *OUT* HAS BEEN SPECIFIED, CALL THE ROUTINES TO PROCESS
*         THE FUNCTION, THEN CLEAN UP FOR THE RETURN TO *QFSP*. 
* 
*         ENTRY  (QFTS) = 0 IF INITIAL CALL TO *QMOVE* FROM *QFSP*. 
*                       .NE. 0 ON ALL FOLLOWING CALLS.
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 6, 7. 
*                B - 1. 
* 
*         CALLS  CID, MQF, OFN, OUT, PRS, RAF.
* 
*         MACROS ABORT, MEMORY, RETURN, SETFS, WRITER.
  
  
 QMOVE    SUBR               ENTRY/EXIT 
          SB1    1
          SA1    QFTS 
          SX6    B0+         CLEAR NEW RECORD AND ERROR EXIT FLAGS
          SA6    RECF 
          SA6    ERRC 
          NZ     X1,QMO1     IF PRESET UNNECESSARY
          RJ     PRS         PRESET 
 QMO1     RJ     OFN         SET OUTPUT FILE NAME 
          NZ     X5,QMO3     IF FILE NAME CONFLICT
  
*         DETERMINE FUNCTION. 
  
          SA2    TARA+ARFC   CHECK FUNCTION 
          MX0    -12
          BX3    -X0*X2 
          ZR     X3,QMO2     IF *GO* COMMAND
  
*         PROCESS *OUT* COMMAND.
  
          RJ     OUT         DISPOSE OUTPUT FILE
          BX2    X2-X2       SET NO *K* DISPLAY BUFFER
          EQ     QMOVEX      RETURN 
  
*         PROCESS *GO* COMMAND. 
  
 QMO2     SA1    TARA+ARTP   SET TYPE OF FILES TO MOVE
          MX0    -12
          BX6    -X0*X1 
          SA6    DSPB 
          RJ     CID         CHECK FOR INCORRECT DEVICES
          NZ     X5,QMO3     IF ERROR 
          RJ     MQF         MOVE QUEUED FILES
          NZ     X5,QMO3     IF ERROR 
          SX5    MES1        *QMOVE COMPLETE.*
  
*         RETURN LOCAL FILES AND CLOSE OUTPUT.
  
 QMO3     RETURN Q,R
          RETURN D,R
          RETURN S,R
          RETURN NIQ,R
          RETURN MIQ,R
          SETFS  O,0
          SA1    RECF 
          ZR     X1,QMO4     IF NO NEW OUTPUT RECORD
          WRITER O           FLUSH BUFFER 
  
*         RESET FIELD LENGTH. 
  
 QMO4     SX7    IBUF+IBUFL  RESET POINTERS 
          SA4    IQ+4        RESET *LIMIT*
          MX0    42 
          BX6    X0*X4
          BX7    X6+X7
          SA7    A4 
          SX0    X5          SAVE MESSAGE ADDRESS 
          MEMORY CM,,R,BUFFL RESET ORIGINAL FIELD LENGTH
  
*         EXIT TO *QFSP*. 
  
          SX3    IQ          RETURN ATTACHED IQFT FILE
          RJ     RAF
          SA1    ERRD 
          NZ     X1,QMO5     IF *PO=N* SPECIFIED AND ABORT SET
          SX5    X0 
          BX2    X2-X2       SET NO *K* DISPLAY BUFFER
          EQ     QMOVEX      RETURN 
  
 QMO5     ABORT 
 CID      TITLE  PRIMARY SUBROUTINES. 
**        CID - CHECK FOR INCORRECT DEVICES.
* 
*         ISSUE THE ERROR MESSAGE * INCORRECT MOVE REQUESTED* IF
*         ANY OF THE FOLLOWING CASES IS TRUE -
* 
*         1) DEVICE SPECIFIED IS NOT MASS STORAGE.
*         2) DESTINATION DEVICE HAS ERROR IDLE SET. 
*         3) DESTINATION DEVICE IS REMOVABLE AND OPTION IS A. 
* 
*         ENTRY  (DSPB) = 0, MOVE INACTIVE QUEUES.
*                       = 1, MOVE ACTIVE QUEUES.
*                       = 2, MOVE ALL QUEUES. 
* 
*         EXIT   (X5) = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
*                     = 0 IF NO ERROR.
*                (CEQP) = EST ORDINAL.
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 1, 2, 6. 
* 
*         CALLS  DND. 
* 
*         MACROS  MESSAGE.
  
  
 CID2     SX5    MES3        * INCORRECT MOVE REQUESTED.* 
          MESSAGE X5
  
 CID      SUBR               ENTRY/EXIT 
  
*         DETERMINE FIRST EQUIPMENT TO MOVE FROM. 
  
          SX6    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA6    CEQP 
          RJ     DND         DETERMINE FIRST EQUIPMENT
          ZR     X4,CID2     IF DEVICE NOT IN TABLE (NON-MASS STORAGE)
  
*         CHECK LEGAL DESTINATION FAMILY. 
  
          SA1    TARA+ARDD   CHECK EST ORDINAL
          MX0    -12
          BX6    -X0*X1 
          SA2    TMSA+X6     CHECK FOR ERROR IDLE 
          SA1    TEQA+X6     CHECK FOR REMOVABLE DEVICE 
          LX2    59-11
          LX1    59-1 
          NG     X2,CID2     IF ERROR IDLE ON DEVICE
          PL     X1,CID1     IF NOT REMOVABLE DEVICE
          SA1    TARA+AROP   CHECK MOVE OPTION
          NZ     X1,CID2     IF LEAVE ACTIVE
 CID1     BX5    X5-X5       CLEAR ERROR FLAG 
          EQ     CIDX        RETURN 
 MQF      SPACE  4,20 
**        MQF - MOVE QUEUED FILES.
* 
*         PRESET OUTPUT AND CALL ROUTINES TO PROCESS THE MOVING 
*         OF THE QUEUED FILES, PROCESSING THE FILES ONE DEVICE
*         AT A TIME.
* 
*         ENTRY  (DSPB) = 0, MOVE INACTIVE QUEUES.
*                       = 1, MOVE ACTIVE QUEUES.
*                       = 2, MOVE ALL QUEUES. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 0, 1, 2, 6, 7. 
*                B - 6. 
* 
*         CALLS  CTF, DND, IDM, PAQ, PIQ. 
* 
*         MACROS CLOCK, DATE, EREXIT, MEMORY, WRITE.
  
  
 MQF6     NZ     X4,MQF4     IF NOT END OF DEVICES
          BX5    X5-X5       CLEAR ERROR FLAG 
  
 MQF      SUBR               ENTRY/EXIT 
          SX6    B0+         CLEAR FORCED IQFT FLAG 
          SA6    DEQB 
  
*         SET UP OUTPUT HEADER AND PARAMETERS.
  
          DATE   BOHA1       SET DATE IN HEADER 
          CLOCK  BOHA2       SET TIME IN HEADER 
          WRITE  O,*         PRESET WRITE FUNCTION
          SX6    B1+         SET QUEUE FILE AND PAGE NUMBERS
          SA6    QNUM 
          SA6    PNUM 
          SA6    PDFE+1      SET PRINT DENSITY FORMAT CONTROL FLAG
 MQF1     SX7    99999       FORCE PAGE EJECT 
          SA7    LNUM 
  
*         PROCESS MOVING OF QUEUE FILES.
  
          SX6    B0+         PRESET FILE COUNTS 
          SA6    MVCT 
          SA6    IGCT 
          SA6    EFCT 
          SA6    REQF        CLEAR REQUEUE FLAG 
          SA1    DSPB        CHECK TYPE TO MOVE 
          NZ     X1,MQF2     IF MOVING ACTIVE FILES 
          SA2    TARA+AROP
          ZR     X2,MQF4     IF LEAVING INACTIVE
          RJ     CTF         CREATE TABLE OF ACTIVE FAMILIES
          BX7    X7-X7       CLEAR FOT FULL FLAG
          SA7    FOTF 
          MX6    1           SET REQUEUE FLAG 
          SA6    REQF 
          EQ     MQF4        PROCESS INACTIVE QUEUE FILES 
  
 MQF2     SX0    B0          SET INITIAL CALL 
 MQF3     EREXIT ERR         SET ERROR EXIT 
          RJ     PAQ         PROCESS ACTIVE QUEUE FILES 
          EQ     MQF5        ISSUE MESSAGES 
  
 MQF4     EREXIT ERR         SET ERROR EXIT 
          RJ     PIQ         PROCESS INACTIVE QUEUE FILES 
 MQF5     SA0    X5          SAVE ERROR 
          EREXIT 0           CLEAR ERROR EXIT 
          RJ     IDM         ISSUE DAYFILE MESSAGES 
          SX5    A0+
          NZ     X5,MQFX     IF ERROR 
  
*         CHECK FOR MORE DEVICES TO PROCESS.
  
          RJ     DND         DETERMINE NEXT DEVICE
          SA1    DSPB 
          ZR     X1,MQF6     IF MOVING INACTIVE FILES 
          SB6    RBUF+QFTE   SET QFT BUFFER ADDRESS 
          SX0    B1+         SET NON-INITIAL CALL 
          NZ     X4,MQF3     IF NOT END OF DEVICES
          SA1    DSPB 
          SX5    X1-1 
          ZR     X5,MQFX     IF MOVE ONLY ACTIVE FILES
  
*         SET UP FOR INACTIVE FILE MOVE.
  
          BX6    X6-X6       SET INACTIVE FILE MOVE 
          SA6    A1 
          MEMORY CM,,R,BUFFL RESET FIELD LENGTH 
          SX7    B1          RESET QUEUE NUMBER 
          SA7    QNUM 
          SX6    NOPE-1      INITIALIZE EST ORDINAL FOR SEARCH
          SA6    CEQP 
          RJ     DND
          EQ     MQF1        PROCESS INACTIVE QUEUE FILES 
 OFN      SPACE  4,20 
**        OFN - SET OUTPUT FILE NAME. 
* 
*         SET UP THE OUTPUT FILE FET.  ISSUE AN ERROR MESSAGE 
*         IF THE OUTPUT FILE NAME SPECIFIED IS QNAME, SS, 
*         DQFILE, IQF, NIQFT, MIQFT, TEMP OR ANY OTHER NAME 
*         CURRENTLY EXISTING IN ANOTHER FET.
* 
*         EXIT   (LIST) = 0 IF FILE NAME CHANGED. 
*                (X5) = 0 IF NO FILE NAME CONFLICT. 
*                     = ADDRESS OF *K* DISPLAY MESSAGE IF CONFLICT. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 5, 6.
* 
*         MACROS MESSAGE. 
  
  
 OFN3     SX5    MES4        *OUTPUT FILE NAME CONFLICT.* 
          MESSAGE X5
  
 OFN      SUBR               ENTRY/EXIT 
  
*         COMPARE CURRENT AND SPECIFIED NAMES.
  
          SA1    O           GET CURRENT OUTPUT FILE NAME 
          SA3    TARA+ARLL   CHECK SPECIFIED OUTPUT FILE NAME 
          MX0    42 
          BX4    X1-X3
          BX2    X0*X4
          BX6    X6-X6       INITIALIZE LIST FLAG 
          ZR     X2,OFN2     IF NO FILE NAME CHANGE 
          SA6    LIST 
  
*         CHECK FOR FILE NAME CONFLICTS.
  
          SA1    Q           QUEUE FILE 
          BX1    X0*X1
          BX1    X1-X3
          ZR     X1,OFN3     IF FILE NAME CONFLICT
          SA2    IQ          OLD IQFT FILE
          SA4    NIQ         NEW IQFT ON CURRENT DEVICE 
          SA5    MIQ         NEW IQFT ON MOVE DEVICE
 OFN1     BX2    X0*X2
          BX4    X0*X4
          BX5    X0*X5
          BX2    X2-X3
          BX4    X4-X3
          BX5    X5-X3
          ZR     X2,OFN3     IF CONFLICT
          ZR     X4,OFN3     IF CONFLICT
          ZR     X5,OFN3     IF CONFLICT
          NZ     X6,OFN2     IF ALL NAMES CHECKED 
          SA2    S           SYSTEM SECTOR
          SA4    D           DESTINATION QUEUE FILE 
          SA5    T           TEMPORARY FILE 
          SX6    B1 
          EQ     OFN1        CHECK REMAINDER OF FET-S 
  
*         SET OUTPUT FILE NAME IN FET.
  
 OFN2     SX1    3
          BX6    X3+X1
          BX5    X5-X5       CLEAR ERROR FLAG 
          SA6    O
          EQ     OFNX        RETURN 
 OUT      SPACE  4,20 
**        OUT - RELEASE OUTPUT FILE TO PRINTER. 
* 
*         RELEASE THE OUTPUT FILE, IF ONE EXISTS, TO THE PRINTER
*         AND ISSUE AN INFORMATIVE MESSAGE AS TO WHETHER OR NOT 
*         ONE WAS RELEASED. 
* 
*         ENTRY  (LIST) .NE. 0 IF OUTPUT FILE WRITTEN.
* 
*         EXIT   (LIST) = 0.
*                (X5) = *K* DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - 2, 5, 6. 
*                A - 2, 6.
* 
*         CALLS  CBL. 
* 
*         MACROS ROUTE. 
  
  
 OUT1     SX5    MES7        *NO OUTPUT FILE EXISTS.* 
  
 OUT      SUBR               ENTRY/EXIT 
          SA2    LIST        CHECK IF OUTPUT EXISTS 
          ZR     X2,OUT1     IF NO OUTPUT FILE
  
*         RELEASE OUTPUT FILE.
  
          RJ     CBL         CLEAR ROUTE BLOCK
          SA2    O           GET FILE NAME
          MX6    42 
          BX6    X6*X2
          SA6    BLOCK       *DSP* PARAMETER BLOCK
          SA2    OUTA 
          BX6    X2 
          SA6    A6+B1
          ROUTE  BLOCK,RECALL 
          BX6    X6-X6       CLEAR OUTPUT FLAG
          SA6    LIST 
          SX5    MES8        *OUTPUT FILE RELEASED.*
          EQ     OUTX        RETURN 
  
  
 OUTA     VFD    24/0,12/2HPR,6/0,18/FRDC 
 AQF      TITLE  SECONDARY SUBROUTINES. 
**        AQF - ATTACH QUEUE FILE AND READ SYSTEM SECTOR. 
* 
*         SEARCH THE IQFT BUFFER UNTIL THE NEXT ENTRY THAT MEETS
*         THE REQUIREMENTS SPECIFIED IN THE FET IS FOUND, THEN
*         ATTACH THAT FILE TO THE CONTROL POINT, ISSUE A *READ* ON
*         THE FILE AND ALSO READ THE SYSTEM SECTOR FOR THE FILE.
* 
*         ENTRY  (X5) = FUNCTION TO ATTACH FILE.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0, SKIP FILE.
*                     .GT. 0, *K* DISPLAY MESSAGE ADDRESS.
*                (X6) .NE. 0 IF END OF BUFFER.
*                (AQFA) .NE. 0 IF READ ERROR. 
*                (AQFB) .EQ. 0 IF ERROR ATTACHING QUEUED FILE.
*                (RTFC) = ENTRY TIME, IF ACTIVE FILE. 
*                       = -1, IF INACTIVE FILE. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 2, 3, 5, 6, 7. 
*                B - 6. 
* 
*         CALLS  CER, EPR.
* 
*         MACROS QCALL, READCW, RENAME, REWIND, WRITECW.
  
  
 AQF      SUBR               ENTRY/EXIT 
          BX6    X6-X6       CLEAR FLAGS
          SA6    AQFA 
          SA6    A6+B1
          SX7    X5          SAVE FUNCTION
          SA7    AQFC 
          REWIND Q,R
          REWIND S,R
          REWIND D,R
  
*         ATTACH QUEUE FILE.
  
          SA0    T           ATTACH FILE
          QCALL  X5,T 
          RJ     CER         CHECK FOR ERROR
          NZ     X5,AQF2     IF ERROR 
          SA1    T+3         ADVANCE *OUT* POINTER
          SA2    A1-B1
          IX2    X2-X1       *IN* - *OUT* 
          SX6    B1+         SET FLAG FOR NO ATTACH 
          SA6    AQFB 
          ZR     X2,AQFX     IF END OF BUFFER 
          SX7    X1+QFEWL 
          SA7    A1 
          MX0    24 
          SA2    X1+         INSERT QUEUE FILE NAME IN FETS 
          BX6    X0*X2
          MX0    -18
          SA3    Q
          BX3    -X0*X3 
          BX7    X6+X3
          SA1    S
          BX1    -X0*X1 
          SA7    A3 
          SA2    D
          BX7    X6+X1
          SA7    A1 
          BX2    -X0*X2 
          BX6    X6+X2
          SA6    A2 
          WRITECW D,*        PRESET WRITE FUNCTION
  
*         READ SYSTEM SECTOR. 
  
          SA0    S
          SX7    -1          SET FLAG 
          SA7    AQFB 
          QCALL  QRSF,S 
          RJ     CER         CHECK FOR ERROR
          NZ     X5,AQF2     IF ERROR 
          SA2    AQFC 
          SX3    X2-AQFF
          SX7    -1 
          NZ     X3,AQF0.1   IF INACTIVE FILE 
          SA1    S+3         SAVE ENTRY TIME
          SX2    5
          SX3    IOSS+ENTQ*5-BFMS-2 
          IX6    X3/X2
          IX1    X1+X6
          SA1    X1 
          MX0    -24
          BX7    -X0*X1 
 AQF0.1   SA7    RTFC 
  
*         RENAME OLD QUEUE FILE.
  
 AQF1     SA1    =5LQNAME 
          SA0    Q
          RENAME Q,X1 
          RJ     CER         CHECK FOR ERROR
          SB6    TLEP        SET ERROR TABLE ADDRESS
          NZ     X5,AQF3     IF ERROR 
          SX7    B1+         SET FLAG FOR NO ATTACH 
          SA7    AQFB 
          READCW Q           READ QUEUE FILE
          BX6    X6-X6       CLEAR END OF BUFFER
          EQ     AQFX        RETURN 
  
*         PROCESS *QFM* ERROR.
  
 AQF2     SB6    TQEP        SET ERROR TABLE ADDRESS
 AQF3     RJ     EPR         PROCESS ERROR
          NZ     X5,AQFX     IF ERROR 
          SA7    AQFA        SAVE READ ERROR MESSAGE ADDRESS
          SA7    CPFA 
          EQ     AQF1        RENAME OLD QUEUE FILE
  
 AQFA     CON    0           READ ERROR FLAG
 AQFB     CON    1           ATTACHING FLAG 
 AQFC     CON    0           FUNCTION 
 BOF      SPACE  4,20 
**        BOF - BUILD OUTPUT FILE.
* 
*         WRITE ONE ENTRY TO THE OUTPUT FILE AND CALL THE 
*         ROUTINE TO WRITE PAGE HEADERS WHEN NECESSARY. 
* 
*         ENTRY  (X7) = DISPOSITION FIELD ADDRESS.
*                (LNUM) = CURRENT LINE NUMBER.
*                (PNUM) = CURRENT PAGE NUMBER.
*                (QNUM) = CURRENT QUEUE FILE NUMBER.
*                (CEQP) = CURRENT EQUIPMENT.
* 
*         EXIT   (LNUM) = NEXT LINE NUMBER. 
*                (PNUM) = NEXT PAGE NUMBER. 
*                (QNUM) = NEXT QUEUE FILE NUMBER. 
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 7. 
* 
*         CALLS  BOH, FQO.
* 
*         MACROS WRITEC, WRITEW.
  
  
 BOF      SUBR               ENTRY/EXIT 
          SA7    BOFA        SAVE DISPOSITION FIELD ADDRESS 
          SA1    LNUM        LINE NUMBER
          SA2    A1+B1
          IX7    X1-X2
          NG     X7,BOF1     IF NOT END OF PAGE 
  
*         WRITE HEADER AND SET RECORD FLAGS.
  
          RJ     BOH         BUILD OUTPUT PAGE HEADER 
          SA2    PNUM        CHECK PAGE NUMBER
          SX6    X2-2 
          NZ     X6,BOF1     IF NOT FIRST PAGE
          SA3    LIST        INCREMENT OUTPUT FLAG
          SX7    X3+B1
          SA7    A3 
          SA7    RECF        SET CURRENT RECORD FLAG
  
*         WRITE ONE LINE TO OUTPUT FILE.
  
 BOF1     SA3    CEQP        CURRENT EQUIPMENT
          SB7    TEQA+X3     ADDRESS OF FAMILY/DEVICE 
          SA1    QNUM        INCREMENT QUEUE NUMBER 
          SX6    X1+B1
          SA6    A1 
          SA2    T+3         IQFT ENTRY ADDRESS 
          SX5    X2-QFEWL    SET IQFT ENTRY ADDRESS 
          SA2    BOFA        GET DISPOSITION FIELD ENTRY
          SA3    X2+
          RJ     FQO         FORMAT OUTPUT LINE 
          WRITEW O,B3,B2-2
  
*         WRITE DISPOSITION FIELD TO OUTPUT.
  
          SA3    BOFA        DISPOSITION FIELD ADDRESS
          WRITEC O,X3 
          SA2    LNUM        INCREMENT LINE NUMBER
          SX7    X2+B1
          SA7    A2 
          EQ     BOFX        RETURN 
  
 BOFA     CON    0           DISPOSITION FIELD ADDRESS
 BOFB     DATA   C*QFT THRESHOLD - FILE IGNORED*
 BOFD     DATA   C*READ ERROR - FILE IGNORED* 
 BOFE     DATA   C*READ ERROR - FILE MOVED* 
 BOFF     DATA   C*SYSTEM SECTOR ERROR - FILE IGNORED*
 BOFG     DATA   C*TRACK LIMIT - FILE IGNORED*
 BOFH     DATA   C*DUPLICATE FILE NAME - FILE IGNORED*
 BOFI     DATA   C*INCORRECT ACCESS LEVEL - FILE IGNORED* 
 BLANK    DATA   C*        *
 BOH      SPACE  4,20 
**        BOH - BUILD OUTPUT FILE PAGE HEADER.
* 
*         BUILD THE HEADER LINES FOR EACH PAGE AND WRITE THESE
*         LINES TO OUTPUT.
* 
*         ENTRY  (PNUM) = PAGE NUMBER.
*                (QNUM) = QUEUE NUMBER. 
*                (DSPB) = DISPOSITION BEFORE MOVE.
*                (PDFE+1) = SET IF PRINT DENSITY FORMAT EFFECTOR
*                           NOT YET WRITTEN.
* 
*         EXIT   (PNUM) = NEXT PAGE NUMBER. 
*                (LNUM) = LINE NUMBER FOLLOWING HEADER. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  CDD, COD, SFN. 
* 
*         MACROS RECALL, WRITEW.
  
  
 BOH      SUBR               ENTRY/EXIT 
  
*         SET PAGE NUMBER IN HEADER.
  
          SA1    PNUM        INCREMENT PAGE NUMBER
          SX6    X1+B1
          SA6    A1 
          RJ     CDD         CONVERT NUMBER 
          MX0    36          SET IN HEADER
          SA1    BOHA3
          BX1    X0*X1
          BX6    -X0*X6 
          BX7    X1+X6
          SA7    A1+
          RECALL O
  
*         WRITE HEADER TO OUTPUT. 
  
          SA1    PDFE+1      GET PRINT DENSITY FORMAT CONTROL FLAG
          BX7    X7-X7
          SA7    A1 
          WRITEW O,A1-B1,X1  CONDITIONALLY WRITE FORMAT EFFECTOR
          WRITEW O,BOHA,BOHAL 
          WRITEW O,BOHB,BOHBL 
          SA1    QNUM        QUEUE NUMBER 
          SX7    X1-1 
          SX5    B0+         SET NO EXTRA LINES 
          NZ     X7,BOH1     IF NOT FIRST QUEUE 
  
*         PUT DESTINATION FAMILY AND DEVICE IN HEADER.
  
          SA2    TARA+ARDF   DESTINATION FAMILY 
          MX0    42 
          BX1    X0*X2
          RJ     SFN         SPACE FILL NAME
          SA3    BOHC2       CLEAR PREVIOUS FAMILY
          MX0    18 
          BX3    X0*X3
          LX6    -18
          BX6    -X0*X6 
          BX7    X6+X3
          SA7    A3 
          SA1    TARA+ARDD   DESTINATION DEVICE 
          MX0    12 
          BX1    X0*X1
          LX1    12 
          RJ     COD         CONVERT TO DISPLAY CODE
          SA2    BOHC3       CLEAR PREVIOUS DEVICE
          MX0    -12
          BX2    X0*X2
          BX6    -X0*X6 
          BX7    X6+X2
          SA7    A2+
  
*         PUT DISPOSITION BEFORE AND AFTER MOVE IN HEADER.
  
          SA3    TARA+AROP
          SA2    BOHC4A+X3   DISPOSITION AFTER MOVE 
          SA1    DSPB 
          SA3    BOHC1A+X1   DISPOSITION BEFORE MOVE
          BX6    X2 
          SA6    BOHC4
          BX7    X3 
          SA7    BOHC1
          WRITEW O,BOHC,BOHCL 
          SX5    2           SET TWO EXTRA LINES
  
*         FINISH WRITING HEADER.
  
 BOH1     WRITEW O,BOHD,BOHDL 
          SX7    X5+8        SET LINE NUMBER
          SA7    LNUM 
          EQ     BOHX        RETURN 
  
 BOHA     DATA   C*1         QMOVE PROCESSOR.               YY/MM/DD. HH
,.MM.SS.  PAGE      * 
 BOHA1    EQU    *-4         DATE 
 BOHA2    EQU    *-3         TIME 
 BOHA3    EQU    *-2         PAGE 
 BOHAL    EQU    *-BOHA 
  
 BOHB     DATA   H*0*        CARRIAGE CONTROL 
          DATA   H/                    *** MOVED QUEUE FILE/
          DATA   C/ DISPOSITION ***/
 BOHBL    EQU    *-BOHB 
  
 BOHC     DATA   H*0           XXXXXXXX FILES MOVED TO FAMILY AAAAAAA*
          DATA   C* DEVICE NN AND LEFT YYYYYYYY  *
 BOHC1    EQU    *-8         DISPOSITION BEFORE MOVE
 BOHC2    EQU    *-5         FAMILY 
 BOHC3    EQU    *-4         DEVICE 
 BOHC4    EQU    *-2         DISPOSITION AFTER MOVE 
 BOHCL    EQU    *-BOHC 
  
 BOHC1A   DATA   H*  INACTIVE*
          DATA   H*    ACTIVE*
          DATA   H*    ACTIVE*
 BOHC4A   DATA   H*INACTIVE  *
          DATA   H*ACTIVE    *
  
 BOHD     DATA   H*0*        CARRIAGE CONTROL 
          DATA   C*                                              LENGTH 
,ACCESS*
          DATA   H* *        CARRIAGE CONTROL 
          DATA   C*   NUM  JSNS MID FAMILY  DN DT DS   DATE      (PRUS) 
,LEVEL  DISPOSITION ERRORS* 
          DATA   C* * 
 BOHDL    EQU    *-BOHD 
 CDI      SPACE  4,20 
**        CDI - REWRITE CURRENT DEVICE IQFT.
* 
*         COPY THE REMAINDER OF THE OLD IQFT TO THE NEW CURRENT 
*         DEVICE IQFT.  IF QFT THRESHOLD HAS BEEN REACHED, THE
*         ENTRIES ARE VERIFIED AND THOSE MEETING SPECIFICATIONS 
*         ARE NOTED ON THE OUTPUT FILE. 
* 
*         ENTRY  (X7) = DISPOSITION FIELD ADDRESS.
*                (IGCT) = COUNT OF FILES IGNORED ON DEVICE. 
*                (NAQS) .LT. 0 IF THRESHOLD REACHED.
* 
*         EXIT   (IGCT) = UPDATED COUNT OF IGNORED FILES. 
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 1, 2, 3, 7.
*                B - 2. 
* 
*         CALLS  BOF, CAF, VIE. 
* 
*         MACROS READW, WRITEW. 
  
  
 CDI      SUBR               ENTRY/EXIT 
          SA7    CDIA        SAVE ADDRESS 
  
*         READ REMAINDER OF OLD IQFT. 
  
 CDI1     BX5    X5-X5       CLEAR ERROR STATUS 
          READW  IQ,IQFE,QFEWL
          NZ     X5,CDIX     IF MASS STORAGE ERROR
          NZ     X1,CDIX     IF EOF/EOI 
  
*         BUILD OUTPUT FILE IF THRESHOLD REACHED. 
  
          SA2    NAQS 
          PL     X2,CDI2     IF THRESHOLD NOT REACHED 
          SA1    IQFE+8 
          NG     X1,CDI2     IF LENGTH ERROR
          SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    X1+
          SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    IQFE+INSQ   GET *INSQ* WORD OF QFT ENTRY 
          RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          NZ     X1,CDI2     IF FILE NOT SELECTED 
          BX6    X6-X6
          RJ     VIE         VERIFY IQFT ENTRY
          NZ     X1,CDI2     IF NO MATCH
          SX7    TBUF        REWIND POINTERS
          SA7    T+2
          SA7    T+3
          SA2    CEQP        SET CURRENT EQUIPMENT IN ENTRY 
          LX2    48 
          MX0    12 
          SA1    IQFE+1 
          BX6    -X0*X1      CLEAR OLD EST ORDINAL
          BX7    X6+X2
          SA7    A1 
          WRITEW T,IQFE,QFEWL MOVE ENTRY TO BUFFER
          SA2    T+2         SET *OUT* = *IN* 
          SX7    X2 
          SA7    A2+B1
          SA1    CDIA        SET DISPOSITION FIELD ADDRESS
          SX7    X1+
          RJ     BOF
  
*         BUILD NEW IQFT. 
  
 CDI2     WRITEW NIQ,IQFE,QFEWL 
          SA2    IGCT        INCREMENT COUNT
          SX7    X2+B1
          SA7    A2 
          EQ     CDI1        READ NEXT ENTRY
  
 CDIA     CON    0           DISPOSITION FIELD ADDRESS
 CED      SPACE  4,15 
**        CED - COPY EOI SECTOR TO DESTINATION DEVICE.
* 
*         ENTRY  OLD QUEUE FILE HAS BEEN RENAMED AS *QNAME*.
* 
*         EXIT   EOI WRITTEN FROM OLD FILE TO NEW FILE. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
* 
*         MACROS QCALL. 
  
  
 CED      SUBR               ENTRY/EXIT 
          SA1    =5LQNAME    SET OLD QUEUE FILE NAME INTO FET 
          SA2    E
          MX0    -18
          BX2    -X0*X2 
          BX6    X1+X2
          SA6    A2 
          SA1    A2+B1       REWIND FET 
          SX6    X1 
          SA6    A1+B1
          SA6    A6+B1
          QCALL  QREF,E      READ EOI SECTOR
          SA1    E           SET NEW FILE INTO FET
          SA2    D
          MX0    42 
          BX2    X0*X2
          BX1    -X0*X1 
          BX6    X1+X2
          SA6    A1 
          QCALL  QWEF,E      WRITE EOI SECTOR 
          EQ     CEDX        RETURN 
 CPF      SPACE  4,20 
**        CPF - COPY FILE TO DESTINATION DEVICE.
* 
*         COPY ONE QUEUE FILE FROM THE SOURCE DEVICE TO THE 
*         DESTINATION DEVICE USING CONTROL WORDS. 
* 
*         ENTRY  (AQFA) .NE. 0 IF PREVIOUS READ ERROR.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0, SKIP CURRENT FILE.
*                     .GT. 0, *K* DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 3, 7.
*                B - 6. 
* 
*         CALLS  CED, CER, EPR. 
* 
*         MACROS READW, UTL, WRITECW, WRITEW. 
  
  
 CPF5     UTL    CLEAR       CLEAR *UTL=* ENTRY POINT IN *SEPW* 
          SA0    D           FLUSH BUFFER 
          WRITECW A0,R
          RJ     CER         CHECK FOR ERROR
          NZ     X5,CPF3     IF ERROR 
          RJ     CED         COPY EOI TO DESTINATION DEVICE 
          UTL    SET         RESET *UTL=* ENTRY POINT 
  
 CPF      SUBR               ENTRY/EXIT 
          SA1    AQFA 
          NZ     X1,CPF1     IF PREVIOUS READ ERROR 
          SX7    BLANK       SAVE NO ERROR DISPOSITION FIELD ADDRESS
          SA7    CPFA 
  
*         COPY FILE.
  
 CPF1     UTL    SET         SET *UTL=* ENTRY POINT 
          SA0    Q           READ CONTROL WORD
          READW  A0,WBUF,B1 
          NZ     X1,CPF5     IF EOI 
          SA1    WBUF        CHECK FOR PARITY ERROR 
          SX5    TCEPA       SET PARITY ERROR CODE
          NG     X1,CPF4     IF ERROR 
          RJ     CER         CHECK FOR OTHER ERROR
          ZR     X5,CPF2     IF NO ERROR
          SX6    X5-TCEPA 
          NZ     X6,CPF3     IF ERROR OTHER THAN PARITY ERROR 
 CPF2     SA1    WBUF        FIND BLOCK SIZE
          SX2    5
          SX3    X1+4        ROUND UP 
          IX0    X3/X2
          READW  Q,WBUF+1,X0+B1  READ REST OF BLOCK 
          UTL    CLEAR       CLEAR *UTL=* ENTRY POINT 
          SA0    D
          WRITEW A0,WBUF,X0+2 
          RJ     CER         CHECK FOR ERROR
          ZR     X5,CPF1     IF NO ERROR
  
*         PROCESS ERROR.
  
 CPF3     SX7    X5-11B 
          NZ     X7,CPF4     IF NOT SPECIAL MASS STORAGE ERROR
          SA3    A0+6        GET ERROR CODE 
          MX0    -9 
          BX5    -X0*X3 
          SX5    X5+11B      BIAS ERROR CODE
 CPF4     SB6    TCEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          NZ     X5,CPFX     IF ERROR 
          SA7    CPFA        SAVE DISPOSITION FIELD ADDRESS 
          UTL    SET         RESET *UTL=* ENTRY POINT 
          JP     B6          CONTINUE PROCESSING
  
 CPFA     CON    0           DISPOSITION FIELD ADDRESS
 CUF      SPACE  4,20 
**        CUF - CLEAN UP CURRENT FILE AFTER ERROR.
* 
*         ASSURE THAT THE CURRENT FILE AND IQFT ENTRY, IF 
*         NECESSARY, ARE REPLACED ON THE SOURCE DEVICE AFTER
*         AN ERROR HAS OCCURED. 
* 
*         ENTRY  (X5) = ERROR MESSAGE ADDRESS.
*                     = 0 IF CURRENTLY PROCESSING AN ERROR. 
*                (A0) = FET ADDRESS.
*                (AQFB) = 0 IF ERROR ATTACHING QUEUED FILE. 
*                (DSPB) = 0, MOVE INACTIVE QUEUES.
*                       = 1, MOVE ACTIVE QUEUES.
*                       = 2, MOVE ALL QUEUES. 
* 
*         EXIT   (X4) = ERROR MESSAGE ADDRESS.
*                (X5) = 0 IF NO NEW ERROR.
*                     = MESSAGE ADDRESS IF ERROR RETURNING FILE.
* 
*         USES   X - 1, 4, 5, 6, 7. 
*                A - 1, 4, 5, 6, 7. 
* 
*         CALLS  RTS. 
* 
*         MACROS MOVE, WRITEW.
  
  
 CUF      SUBR               ENTRY/EXIT 
          SX6    X5+         SAVE ERROR ADDRESS 
          SA6    CUFA 
          SA1    AQFB 
          NZ     X1,CUF1     IF NOT ATTACHING ERROR 
          SA5    T+3         *OUT*
          MOVE   QFEWL,X5,IQFE
          SX7    X5+QFEWL    UPDATE *OUT* POINTER 
          SA7    A5 
          BX5    X5-X5       CLEAR ERROR
          SA1    DSPB 
          NZ     X1,CUF2     IF MOVING ACTIVE 
          WRITEW NIQ,IQFE,QFEWL  WRITE ENTRY BACK TO IQFT 
          SA1    IGCT        INCREMENT IGNORED COUNT
          SX6    X1+B1
          SA6    A1 
          EQ     CUF2        RESET ERROR ADDRESS
  
 CUF1     RJ     RTS         RETURN QUEUE FILE TO SOURCE DEVICE 
 CUF2     SA4    CUFA        RESET ERROR ADDRESS
          EQ     CUFX        RETURN 
  
 CUFA     CON    0           ERROR ADDRESS
 DEQ      SPACE  4,30 
**        DEQ - DEQUEUE ACTIVE FILES. 
* 
*         BUILD A NEW IQFT FROM A BUFFER OF PSEUDO IQFT ENTRIES 
*         AND CALL ROUTINES TO PHYSICALLY MOVE THE FILES FROM 
*         ONE DEVICE TO ANOTHER.
* 
*         ENTRY  (DEQB) .NE. 0 IF NEW IQFT ALREADY CREATED ON DEVICE. 
*                (ATTA) .NE. 0 IF IQFT ATTACHED.
*                (PAQA) .NE. 0 IF MORE QFT-S TO PROCESS.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
*                (ATTA) = 0 IF ALL QFT ENTRIES PROCESSED. 
*                (DEQB) .NE. 0 IF NEW IQFT CREATED. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 2, 3, 6, 7.
*                B - 6. 
* 
*         CALLS  AQF, ATT, BOF, CER, CPF, EPR, IIM, 
*                RNI, RTD, SFD, SPF.
* 
*         MACROS MESSAGE, SKIPEI, WRITE.
  
  
*         CHECK FOR END OF QFT. 
  
 DEQ4     SX5    B0+         CLEAR ERROR FLAG 
          SA3    PAQA 
          NZ     X3,DEQX     IF MORE QFT-S TO PROCESS 
 DEQ5     RJ     RNI         RETURN NEW IQFT
          SA6    ATTA 
  
 DEQ      SUBR               ENTRY/EXIT 
          SA1    ATTA 
          NZ     X1,DEQ2     IF FILE ALREADY ATTACHED 
          SX6    DTQF        PRESET DETACH FUNCTION 
          SA6    DEQA 
  
*         CHECK FOR IQFT ON DEVICE TO MOVE TO.
  
          SA2    TARA+ARDD   GET EQUIPMENT TO MOVE TO 
          MX0    -12
          BX5    -X0*X2 
          SA1    TEQA+X5     CHECK FOR IQFT 
          LX1    59-0 
          NG     X1,DEQ1     IF AN IQFT FILE ON THIS DEVICE 
          SA2    DEQB 
          NZ     X2,DEQ1     IF FILE PREVIOUSLY FORCED ON DEVICE
          SX5    MES11       * IQFT NOT FOUND.* 
          MESSAGE  X5 
          EQ     DEQ5        EXIT WITH ERROR
  
*         ATTACH IQFT FILE. 
  
 DEQ1     SA2    TARA+ARDD   EST ORDINAL
          MX0    -12
          BX2    -X0*X2 
          SX3    MIQ         ATTACH IQFT
          SA0    X3+
          RJ     ATT
          WRITE  MIQ,*       PRESET WRITE FUNCTION
          ZR     X5,DEQ2     IF NO ERROR
          SA2    TARA+ARDD   ISSUE IQFT ERROR MESSAGE 
          MX0    -12
          BX2    -X0*X2 
          RJ     IIM
          RJ     CER         CLEAR ERROR
          SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          EQ     DEQX        RETURN 
  
 DEQ2     SKIPEI MIQ,R
          WRITE  MIQ,*
          SA1    T
          RJ     SPF
  
*         ATTACH QUEUE FILES THAT MEET ALL SPECIFICATIONS.
  
 DEQ3     SX5    AQFF        SET ATTACH FUNCTION
          RJ     AQF         ATTACH FILE
          NG     X5,DEQ3     IF SKIP FILE 
          NZ     X5,DEQ5     IF ERROR 
          NZ     X6,DEQ4     IF END OF BUFFER 
  
*         MOVE IQFT ENTRY AND QUEUE FILE TO DESTINATION DEVICE. 
  
          RJ     SFD         SET FILE ON DESTINATION DEVICE 
          NG     X5,DEQ3     IF SKIP FILE 
          NZ     X5,DEQ5     IF ERROR 
          RJ     CPF         COPY FILE TO DESTINATION DEVICE
          NG     X5,DEQ3     IF SKIP FILE 
          NZ     X5,DEQ5     IF ERROR 
          RJ     RTD         RETURN FILES 
          NG     X5,DEQ3     IF SKIP FILE 
          NZ     X5,DEQ5     IF ERROR 
          RJ     BOF         BUILD OUTPUT FILE
          EQ     DEQ3        PROCESS NEXT FILE
  
 DEQA     CON    0           DETACH/PURGE IQFT FUNCTION 
 DEQB     CON    0           IQFT FORCED ON DEVICE FLAG 
 EPR      SPACE  4,30 
**        EPR - ERROR CODE PROCESSOR. 
* 
*         USE THE GIVEN ERROR CODE TO FIND THE CORRECT ERROR
*         MESSAGE OR PROCESSOR IN THE ERROR TABLES.  IF A PROCESSOR 
*         IS NEEDED, IT IS EXECUTED, THEN CONTROL IS SENT BACK TO 
*         THE CALLING SUBROUTINE. 
* 
*         ENTRY  (X5) = ERROR CODE. 
*                (B6) = ERROR TABLE ADDRESS.
*                (A0) = FET ADDRESS.
*                (DSPB) = 0, MOVE INACTIVE QUEUES.
*                       = 1, MOVE ACTIVE QUEUES.
*                       = 2, MOVE ALL QUEUES. 
*                (PAQA) = NEXT ENTRY IN QFT BUFFER IF *DSPB* .NE. 0.
*                (ERRC) .NE. 0 IF ALREADY PROCESSING AN ERROR EXIT. 
* 
*         EXIT   (X5) = 0 IF TO CONTINUE PROCESSING.
*                     .LT. 0 IF SKIP FILE.
*                     .GT. 0 IF *K* DISPLAY MESSAGE ADDRESS.
*                (X7) = DISPOSITION FIELD ADDRESS.
*                (B6) = PROCESSING ADDRESS IF *CIO* ERROR.
*                (IGCT) INCREMENTED IF MOVING INACTIVE. 
*                TO *ERR3* IF PROCESSING AN ERROR EXIT OR SECOND ERROR
*                FOUND WHILE PROCESSING FIRST ERROR.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  BOF, CDI, CER, CUF, PCI, RTS, SFD, SQB.
* 
*         MACROS MESSAGE, QCALL, READCW, REWIND, WRITECW. 
  
  
 EPR      SUBR               ENTRY/EXIT 
          SA1    ERRC 
          NZ     X1,ERR3     IF PROCESSING ERROR EXIT 
  
*         CHECK FOR UNKNOWN ERROR CODE. 
  
          SA2    B6-B1       NUMBER OF TABLE ENTRIES
          IX6    X5-X2
          PL     X6,EPR1     IF NOT IN TABLE
  
*         GET ERROR MESSAGE ADDRESS FROM TABLE. 
  
          SA5    B6+X5
          ZR     X5,EPR1     IF DEFAULT MESSAGE TO BE USED
          NG     X5,EPR2     IF PROCESSOR ADDRESS 
          SB6    A5+
 EPR1     SA5    B6          SET ERROR MESSAGE ADDRESS
          MESSAGE X5
          SX2    IQ          CHECK FOR ATTACH IQFT FILE ERRORS
          SX3    MIQ
          SX1    A0+
          IX6    X2-X1
          IX7    X3-X1
          ZR     X6,EPRX     IF OLD IQFT ERROR
          ZR     X7,EPRX     IF NEW IQFT ERROR
          RJ     CUF         CLEAN UP FILE
          NZ     X5,ERR3     IF ERROR 
          SX5    X4+         RESET ORIGINAL ERROR 
          EQ     EPRX        RETURN 
  
 EPR2     SB7    X5          SET PROCESSOR ADDRESS
          JP     B7          JUMP TO PROCESSOR
  
 EPR3     NZ     X5,ERR3     IF ERROR 
          RJ     BOF         BUILD OUTPUT FILE
          SX5    -B1         SET SKIP FILE
          EQ     EPRX        RETURN 
 EAL      SPACE  4,10 
**        EAL - PROCESS INCORRECT ACCESS LEVEL. 
  
  
 EAL      BX5    X5-X5       SET NO ERROR MESSAGE 
          RJ     CUF         CLEAN UP FILE
          SX7    BOFI        *INCORRECT ACCESS LEVEL - FILE IGNORED*
          EQ     EPR3        COMPLETE PROCESSING
 EDF      SPACE  4
**        EDF - PROCESS DUPLICATE FILE NAME.
  
  
 EDF      BX5    X5-X5       SET NO ERROR MESSAGE 
          RJ     CUF         CLEAN UP FILE
          SX7    BOFH        *DUPLICATE FILE NAME - FILE IGNORED* 
          EQ     EPR3        COMPLETE PROCESSING
 EPE      SPACE  4
**        EPE - PROCESS WRITE PARITY ERRORS.
  
  
 EPE      SX2    Q           CHECK IF READ ERROR
          SX3    A0 
          IX6    X2-X3
          ZR     X6,ERM      IF READ MASS STORAGE ERROR 
          QCALL  IQFF,D      INTERLOCK QUEUED FILE
          RJ     CER         CHECK FOR ERROR
          NZ     X5,ERR3     IF ERROR 
          SA1    EFCT        INCREMENT INTERLOCKED FILE COUNT 
          SX6    X1+B1
          SA6    A1 
          REWIND Q,R
          REWIND D,R
          RJ     SFD         SET FILE ON DEVICE 
          NZ     X5,ERR3     IF ERROR OR SKIP FILE
          WRITECW D,*        PRESET WRITE FUNCTION
          READCW Q           BEGIN READ 
          SB6    CPF1        SET PROCESSING ADDRESS 
          SA2    CPFA        RESET CURRENT DISPOSITION FIELD
          SX7    X2 
          EQ     EPRX        RETURN 
 ERM      SPACE  4
**        ERM - PROCESS READ MASS STORAGE ERRORS. 
  
  
 ERM      SA2    TARA+ARFC   CHECK ERRORED FILE PROCESSING STATUS 
          LX2    59-57
          NG     X2,ERM1     IF PROCESSING SELECTED 
  
*         PROCESS READ ERRORS WITH ERRORED FILE PROCESSING DESELECTED.
  
          RJ     RTS         RETURN FILE TO SOURCE DEVICE 
          SX7    BOFD        *READ ERROR - FILE IGNORED*
          EQ     EPR3        COMPLETE PROCESSING
  
*         PROCESS READ ERRORS WITH ERRORED FILE PROCESSING SELECTED.
  
 ERM1     SX5    B0+         CLEAR ERROR
          SB6    CPF2        SET *CPF* PROCESSING ADDRESS 
          SX7    BOFE        *READ ERROR - FILE MOVED*
          EQ     EPRX        RETURN 
 ESS      SPACE  4
**        ESS - PROCESS INCORRECT SYSTEM SECTOR ERRORS. 
  
  
 ESS      BX5    X5-X5       SET NO ERROR MESSAGE 
          RJ     CUF         CLEAN UP FILE
          SX7    BOFF        *SYSTEM SECTOR ERROR - FILE IGNORED* 
          EQ     EPR3        COMPLETE PROCESSING
 ETL      SPACE  4
**        ETL - PROCESS TRACK LIMIT.
  
  
 ETL      RJ     RTS         RETURN QUEUE FILE TO SOURCE DEVICE 
          NZ     X5,ERR3     IF ERROR 
          SX7    BOFG        *TRACK LIMIT - FILE IGNORED* 
          RJ     BOF         BUILD OUTPUT FILE
          SA2    DSPB 
          ZR     X2,ETL3     IF MOVING INACTIVE 
  
*         EMPTY BUFFER CONTENTS.
  
 ETL1     SA1    T+2         *IN* 
          SA5    A1+B1       *OUT*
          IX7    X1-X5
          ZR     X7,ETL2     IF END OF BUFFER 
          SX6    X5+QFEWL    ADVANCE *OUT*
          SA6    A5 
          BX7    X7-X7       ZERO FAMILY/MACHINE ID WORD OF IQFT ENTRY
          SA7    X5+9 
          SX7    BOFG        *TRACK LIMIT - FILE IGNORED* 
          RJ     BOF         BUILD OUTPUT FILE
          EQ     ETL1        PROCESS NEXT ENTRY 
  
 ETL2     SA1    PAQA        SET NEXT ENTRY ADDRESS 
          SB6    X1+
          ZR     X1,ETL4     IF ALL QFT ENTRIES PROCESSED 
          RJ     SQB         SEARCH QFT BUFFER
          SA6    PAQA        SAVE STATUS
          EQ     ETL1        PROCESS NEXT ENTRY 
  
*         REWRITE IQFT. 
  
 ETL3     SX6    -1          SET THRESHOLD FLAG 
          SA6    NAQS 
          SX7    BOFG        *TRACK LIMIT - FILE IGNORED* 
          RJ     CDI         COPY OLD TO NEW IQFT 
          NZ     X5,ERR3     IF ERROR 
          SX6    B0+         CLEAR THRESHOLD AND FLAG 
          SA6    NAQS 
          SA6    PIQA 
  
*         SET FOR RETURN. 
  
 ETL4     SX5    MC07        *TRACK LIMIT*
          MESSAGE X5
          EQ     EPRX        RETURN 
 ERP$     SPACE  4,20 
**        ERP$ - *READW*/*WRITEW* ERROR PROCESSOR.
* 
*         PROCESS ERRORS FOUND DURING A *READW* OR *WRITEW* CALL. 
* 
*         ENTRY  FROM *COMCCIO*.
*                (X2) = FET ADDRESS.
*                (X7) = ERROR CODE FROM FET.
* 
*         EXIT   (X5) .NE. 0 IF TRACK LIMIT.
*                (X5) .EQ. *MES5* IF IQFT READ ERROR. 
*                (X2) = FET ADDRESS IF READ PARITY ERROR. 
*                TO *CPFX* IF TRACK LIMIT.
*                TO *CPF1* IF WRITE PARITY ERROR. 
*                TO *ERPX$* IF READ PARITY ERROR. 
*                TO *RDW=* IF IQFT READ ERROR.
* 
*         USES   X - 1, 2, 3, 5, 6. 
*                A - 1, 2, 6. 
*                B - 6. 
* 
*         CALLS  CER, EPR, IIM, PCI.
* 
*         MACROS MESSAGE. 
  
  
 ERP$     SX6    X2-Q 
          ZR     X6,ERP1     IF READ PARITY ERROR 
          SX6    X2-IQ
          ZR     X6,ERP2     IF IQFT READ ERROR 
  
*         PROCESS WRITE ERRORS. 
  
          SB6    TCEP        SET ERROR TABLE ADDRESS
          RJ     CER         CHECK FOR ERROR
          RJ     EPR         PROCESS ERROR
          NZ     X5,CPFX     IF TRACK LIMIT 
          EQ     CPF1        JUMP TO PROCESS WRITE PARITY ERROR 
  
*         CLEAR READ PARITY STATUS IN FET.
  
 ERP1     SA1    X2          CLEAR ERROR STATUS 
          SX3    17BS10 
          BX6    -X3*X1 
          SA6    A1 
          EQ     ERPX$       RESUME *CIO* FUNCTION
  
 ERP2     SX3    11B
          IX3    X7-X3
          NZ     X3,ERP1     IF NOT MASS STORAGE ERROR
          RJ     PCI         PURGE OLD AND COMPLETE NEW IQFT
          SA2    CEQP 
          RJ     IIM
          SX5    MES5        * QUEUES UNRECOVERABLE THIS DEVICE.* 
          MESSAGE  X5 
          EQ     RDW=        RETURN TO CONTINUE PROCESSING
 ERR      SPACE  4,20 
**        ERR - ERROR EXIT PROCESSOR. 
* 
*         CALL ROUTINES TO CLEAN UP FILES AND SEND OUT A
*         MESSAGE FOLLOWING AN ERROR EXIT.
* 
*         ENTRY  (DSPB) = 0 - MOVE INACTIVE, 1 - MOVE ACTIVE, 2 - ALL.
*                AT *ERR3* IF SECOND ERROR EXIT OR IF DOUBLE ERROR. 
* 
*         EXIT   (ERRD) .NE. 0 IF TO ABORT AFTER CLEAN UP FINISHED. 
*                TO *QMO3* IF POSSIBLE TO CLEAN UP FILES. 
* 
*         USES   X - 1, 2, 3, 5, 6. 
*                A - 1, 2, 3, 5, 6. 
*                B - 6. 
* 
*         CALLS  CUF, RAF, RNI. 
* 
*         MACROS ABORT, EREXIT, MESSAGE.
  
  
 ERR      SX6    B1+         SET ERROR EXIT FLAG
          SA6    ERRC 
          EREXIT ERR3        SET SECOND ERROR EXIT ADDRESS
          RJ     CUF         CLEAN UP FILE
          NZ     X5,ERR3     IF ERROR 
          SA1    DSPB 
          SA2    TARA+AROP
          ZR     X1,ERR1     IF MOVING INACTIVE 
  
*         PROCESS ACTIVE FILE ERROR EXIT. 
  
          NZ     X2,ERR2     IF LEAVE ACTIVE
          RJ     RNI         RETURN NEW IQFT
          SA6    ATTA 
          EQ     ERR2        ISSUE ERROR MESSAGE
  
*         JUMP TO INACTIVE FILE ERROR PROCESSING ADDRESSES. 
  
 ERR1     SA3    ERRB+X2     GET ADDRESS
          SA2    ERRA        SET RETURN JUMP
          BX6    X2 
          SX1    X3 
          SA6    X1 
          AX3    30          SET ERROR PROCESSING ADDRESS 
          SB6    X3 
          JP     B6          JUMP TO CLEAN UP AFTER ERROR 
  
*         ISSUE ERROR MESSAGE AND JUMP TO MAIN ROUTINE. 
  
 ERR2     SX5    MES2        *QMOVE ABORTED.* 
          MESSAGE X5
          SA1    TARA+ARFC
          PL     X1,QMO3     IF *PO=N* NOT SPECIFIED
          SX6    B1+         SET ABORT FLAG 
          SA6    ERRD 
          EQ     QMO3        CLEAN UP FILES 
  
*         ABORT ON SECOND ERROR OR ERROR EXIT.
  
 ERR3     SA1    TARA+AROP
          NZ     X1,ERR5     IF LEAVE ACTIVE
          SA5    ATTA        FIRST IQFT FLAG
          SA1    DSPB 
          NZ     X1,ERR4     IF MOVING ACTIVE 
          SA5    MIIA        SECOND IQFT FLAG 
 ERR4     ZR     X5,ERR5     IF NO NEW IQFT ATTACHED
          RJ     RNI         RETURN NEW IQFT
          SA6    A5 
 ERR5     SX3    IQ          RETURN ATTACHED IQFT FILE
          RJ     RAF
          MESSAGE MES10      *QUEUE STATUS INDEFINITE.* 
          MESSAGE MES2       *QMOVE ABORTED.* 
          ABORT 
  
 ERRA     EQ     ERR2        RETURN JUMP PLUG 
 ERRB     VFD    30/MII4,30/MIIX  INACTIVE TO INACTIVE
          VFD    30/REQ2,30/REQX  INACTIVE TO ACTIVE
 ERRC     CON    0           ERROR EXIT FLAG
 ERRD     CON    0           ABORT AFTER CLEAN UP (*PO=N* SPECIFIED)
 IDM      SPACE  4,20 
**        IDM - ISSUE DAYFILE MESSAGES. 
* 
*         FORMAT AND ISSUE MESSAGES APPLICABLE TO THE COMPLETED 
*         QUEUE OPERATION.
* 
*         ENTRY  (MVCT) = COUNT OF FILES MOVED ON DEVICE. 
*                (IGCT) = COUNT OF FILES IGNORED. 
*                (EFCT) = COUNT OF ERRORED FILES CREATED. 
*                (CEQP) = CURRENT EQUIPMENT.
*                (DSPB) = 0 IF MOVING INACTIVE. 
* 
*         EXIT   (MVCT) = (IGCT) = (EFCT) = 0.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  CDD, COD, SFN. 
* 
*         MACROS  MESSAGE.
  
  
 IDM      SUBR               ENTRY/EXIT 
  
*         CALCULATE INDEX INTO MESSAGE TABLE. 
  
          SA1    DSPB 
          SX6    B1+
          NZ     X1,IDM1     IF MOVING ACTIVE 
          SX6    B0+
 IDM1     LX6    1           2*(DSPB) 
          SA2    TARA+AROP   2*(DSPB)+(AROP)
          IX7    X6+X2
  
*         CHECK MOVED FILE COUNT. 
  
          SA5    TFCM+X7     GET MESSAGE ADDRESS
          SA1    MVCT        MOVED FILE COUNT 
          ZR     X1,IDM3     IF NO COUNT
  
*         SET UP MESSAGE. 
  
 IDM2     BX6    X6-X6       CLEAR COUNT
          SA6    A1 
          RJ     CDD         CONVERT COUNT
          LX6    30 
          SA5    X5 
          MX0    -30
          BX6    X0*X6
          SA3    CEQP        CURRENT EQUIPMENT
          SA4    TEQA+X3
          BX5    -X0*X5 
          MX0    42 
          IX6    X6+X5
          BX1    X0*X4       FAMILY NAME
          SA6    A5 
          RJ     SFN         SPACE FILL NAME
          MX0    48 
          SA2    A5+3 
          LX4    48 
          LX6    54 
          BX2    -X0*X2      CLEAR PREVIOUS FAMILY
          BX6    X0*X6
          MX0    -6 
          IX6    X6+X2       APPEND *.* 
          BX1    -X0*X4 
          SA6    A2+
          RJ     COD         CONVERT DEVICE NUMBER
          MX0    -12
          SA3    A6-B1
          BX6    -X0*X6      CLEAR SPACES 
          LX0    24 
          BX3    X0*X3       CLEAR OLD DEVICE NUMBER
          LX6    24 
          IX7    X6+X3
          SA7    A3 
          MESSAGE A5         ISSUE MESSAGE
  
*         CHECK IGNORED COUNT.
  
 IDM3     SA1    IGCT 
          ZR     X1,IDM4     IF NO COUNT
          SA5    TFCM+4      GET IGNORED MESSAGE ADDRESS
          EQ     IDM2        SET UP IGNORED MESSAGE 
  
*         CHECK ERRORED FILE COUNT. 
  
 IDM4     SA1    EFCT 
          ZR     X1,IDMX     IF NO COUNT
          BX6    X6-X6       CLEAR COUNT
          SA6    A1 
          RJ     CDD         CONVERT COUNT
          LX6    30 
          SA5    MSG6        SET IN MESSAGE 
          MX0    -30
          BX6    X0*X6
          BX5    -X0*X5 
          IX6    X6+X5
          SA6    A5 
          MESSAGE A5
          EQ     IDMX        RETURN 
 TFCM     SPACE  4
 TFCM     BSS    0           FILE COUNT MESSAGE TABLE 
          CON    MSG1        INACTIVE MOVED 
          CON    MSG2        ACTIVATED
          CON    MSG3        DEQUEUED 
          CON    MSG4        ACTIVE MOVED 
          CON    MSG5        IGNORED
  
  
 MSG1     DATA   C* XXXX FILES MOVED (I) DNYY  FM AAAAAAA.* 
 MSG2     DATA   C* XXXX FILES ACTIVATED DNYY  FM AAAAAAA.* 
 MSG3     DATA   C* XXXX FILES DEQUEUED  DNYY  FM AAAAAAA.* 
 MSG4     DATA   C* XXXX FILES MOVED (A) DNYY  FM AAAAAAA.* 
 MSG5     DATA   C* XXXX FILES IGNORED   DNYY  FM AAAAAAA.* 
 MSG6     DATA   C* XXXX QUEUE FILES INTERLOCKED.*
 IIM      SPACE  4,20 
**        IIM - ISSUE IQFT ERROR MESSAGE. 
* 
*         SET UP AND ISSUE THE MESSAGE * IQFT FILE ERROR DN XX
*         FAMILY AAAAAAA.* TO THE DAYFILE.
* 
*         ENTRY  (X2) = IQFT EST ORDINAL. 
* 
*         USES   X - 0, 1, 4, 6, 7. 
*                A - 1, 4, 6, 7.
* 
*         CALLS  COD, SFN.
* 
*         MACROS MESSAGE. 
  
  
 IIM      SUBR               ENTRY/EXIT 
  
*         SET FAMILY NAME IN MESSAGE. 
  
          SA4    TEQA+X2     FAMILY NAME
          MX0    42 
          BX1    X0*X4
          RJ     SFN         SPACE FILL NAME
          SA1    IIMA+3      SET IN MESSAGE 
          BX1    -X0*X1 
          BX6    X0*X6
          BX7    X1+X6
          SA7    A1 
  
*         SET DEVICE NUMBER IN MESSAGE. 
  
          LX4    -12         DEVICE NUMBER
          MX0    -6 
          BX1    -X0*X4 
          RJ     COD         CONVERT TO DISPLAY CODE
          SA1    IIMA+2      SET IN MESSAGE 
          MX0    12 
          BX4    X0*X4
          BX1    -X0*X1 
          BX6    X1+X4
          SA6    A1+
          MESSAGE  IIMA      * IQFT FILE ERROR DN XX FAMILY AAAAAAA.* 
          EQ     IIMX        RETURN 
  
 IIMA     DATA   C* IQFT FILE ERROR DN XX FAMILY AAAAAAA.*
 MAA      SPACE  4,20 
**        MAA - MOVE ACTIVE QUEUE FILES AND LEAVE ACTIVE. 
* 
*         SELECT FILES FROM A BUFFER OF PSEUDO IQFT ENTRIES AND 
*         CALL ROUTINES TO PHYSICALLY MOVE THE FILES FROM ONE 
*         DEVICE TO ANOTHER, LEAVING THEM IN AN ACTIVE STATE. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 1, 5.
*                A - 1. 
* 
*         CALLS  AQF, BOF, CPF, RTD, SFD, SPF.
  
  
 MAA      SUBR               ENTRY/EXIT 
          SA1    T           SET *QFM* PARAMETERS IN FET
          RJ     SPF
  
*         ATTACH QUEUE FILES THAT MEET ALL SPECIFICATIONS.
  
 MAA1     SX5    AQFF        SET ATTACH FUNCTION
          RJ     AQF         ATTACH FILE
          NG     X5,MAA1     IF SKIP FILE 
          NZ     X5,MAAX     IF ERROR 
          NZ     X6,MAAX     IF END OF BUFFER 
  
*         MOVE QUEUE FILE TO DESTINATION DEVICE.
  
          RJ     SFD         SET FILE ON DESTINATION DEVICE 
          NG     X5,MAA1     IF SKIP FILE 
          NZ     X5,MAAX     IF ERROR 
          RJ     CPF         COPY FILE TO DESTINATION DEVICE
          NG     X5,MAA1     IF SKIP FILE 
          NZ     X5,MAAX     IF ERROR 
          RJ     RTD         RETURN FILES 
          RJ     BOF         BUILD OUTPUT FILE
          EQ     MAA1        PROCESS NEXT FILE
 MII      SPACE  4,30 
**        MII - MOVE INACTIVE QUEUE FILES AND LEAVE INACTIVE. 
* 
*         CALL ROUTINES TO PHYSICALLY MOVE THE FILE SPECIFIED 
*         BY THE GIVEN IQFT ENTRY FROM ONE DEVICE TO ANOTHER, 
*         LEAVING IT AS AN INACTIVE FILE.  CREATE A NEW IQFT, 
*         IF NECESSARY, ON THE DEVICE TO BE MOVED TO FOR
*         THOSE FILES MOVED.
* 
*         ENTRY  (IGCT) = COUNT OF FILES IGNORED ON THIS DEVICE.
*                (PIQA) = 0 IF ALL ENTRIES PROCESSED FROM IQFT. 
*                (MIIA) .NE. 0 IF IQFT CURRENTLY ATTACHED.
*                (DEQB) .NE. 0 IF NEW IQFT CREATED ON DEVICE. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
*                (ATTA) = (MIIA) = 0 IF ALL IQFT ENTRIES PROCESSED. 
*                (DEQB) .NE. 0 IF NEW IQFT CREATED. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 2, 3, 6, 7.
*                B - 6. 
* 
*         CALLS  AQF, ATT, BOF, CDI, CER, CPF, EPR, IIM,
*                PCI, RNI, RTD, SFD.
* 
*         MACROS MESSAGE, SKIPEI, WRITE.
  
  
 MII6     SA2    TARA+ARDD   ISSUE IQFT ERROR MESSAGE 
          MX0    -12
          BX2    -X0*X2 
          RJ     IIM
          RJ     CER         CLEAR ERROR
          SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
  
 MII      SUBR               ENTRY/EXIT 
          SA1    MIIA 
          NZ     X1,MII2     IF FILE ATTACHED 
          SX6    DTQF        PRESET DETACH FUNCTION 
          SA6    DEQA 
  
*         CHECK FOR IQFT ON DEVICE TO MOVE TO.
  
          SA2    TARA+ARDD   GET EQUIPMENT TO MOVE TO 
          MX0    -12
          BX5    -X0*X2 
          SA1    TEQA+X5     CHECK FOR IQFT 
          LX1    59-0 
          NG     X1,MII1     IF AN IQFT FILE ON THIS DEVICE 
          SA2    DEQB 
          NZ     X2,MII1     IF FILE PREVIOUSLY FORCED ON DEVICE
          SX5    MES11       * IQFT NOT FOUND.* 
          MESSAGE  X5 
          EQ     MII4        EXIT WITH ERROR
  
*         ATTACH IQFT FILE. 
  
 MII1     SA2    TARA+ARDD   EST ORDINAL
          MX0    -12
          BX2    -X0*X2 
          SX3    MIQ         ATTACH IQFT
          SA0    X3+
          RJ     ATT
          WRITE  MIQ,*
          NZ     X5,MII6     IF ERROR 
          SKIPEI X3,R        POSITION FILE
          WRITE  MIQ,*       PRESET WRITE FUNCTION
          SX6    B1+         SET SECOND ATTACHED FLAG 
          SA6    MIIA 
  
*         ATTACH QUEUE FILES. 
  
 MII2     SX5    AIQF        SET ATTACH FUNCTION
          RJ     AQF         ATTACH FILE
          NG     X5,MII3     IF SKIP FILE 
          NZ     X5,MII4     IF ERROR 
          NZ     X6,MII3     IF END OF BUFFER 
  
*         MOVE QUEUE FILE TO DESTINATION DEVICE.
  
          RJ     SFD         SET FILE ON DESTINATION DEVICE 
          NG     X5,MII3     IF SKIP FILE 
          NZ     X5,MII4     IF ERROR 
          RJ     CPF         COPY FILE TO DESTINATION DEVICE
          NG     X5,MII3     IF SKIP FILE 
          NZ     X5,MII4     IF ERROR 
          RJ     RTD         RETURN FILES 
          NG     X5,MII3     IF SKIP FILE 
          NZ     X5,MII4     IF ERROR 
          RJ     BOF         BUILD OUTPUT FILE
  
*         CHECK FOR END OF ENTRIES. 
  
 MII3     SX5    B0+         CLEAR ERROR FLAG 
          SA3    PIQA 
          NZ     X3,MIIX     IF MORE ENTRIES TO PROCESS 
 MII4     RJ     RNI         RETURN NEW IQFT
          SA6    MIIA 
          SA2    PIQA 
          ZR     X2,MII5     IF ALL ENTRIES PROCESSED 
          SX7    B0+         COPY OLD TO NEW IQFT 
          RJ     CDI
 MII5     RJ     PCI         PURGE OLD AND COMPLETE NEW IQFT
          EQ     MIIX        RETURN 
  
 MIIA     CON    0           SECOND IQFT ATTACHED FLAG
 NIF      SPACE  4,20 
**        NIF - FORCE NEW IQFT ON DEVICE. 
* 
*         ENTRY  (A0) = FET ADDRESS.
*                (X5) = EST ORDINAL.
*                (X4) = ACCESS LEVEL FOR REQUEST. 
* 
*         USES   X - 0, 1, 3, 5, 6. 
*                A - 1, 3, 6. 
* 
*         MACROS RETURN, REQUEST. 
  
  
 NIF      SUBR               ENTRY/EXIT 
          RETURN A0,R 
          BX4    X3          SAVE ACCESS LEVEL
          SX5    X5+7000B    SET ASSIGN-BY-ORDINAL FLAG 
          SA3    A0+1        SET EST ORDINAL IN FET 
          LX5    48 
          MX0    12 
          BX3    -X0*X3 
          BX6    X5+X3
          SX1    B1          SET SPECIAL PROCESSING FLAG
          LX1    39 
          BX6    X6+X1
          SA6    A3 
          SA1    A0+4        SET ACCESS LEVEL 
          MX0    -3 
          LX4    36 
          LX0    36 
          BX1    X0*X1
          BX6    X1+X4
          SA6    A1 
          REQUEST  A0,R 
          EQ     NIFX        RETURN 
 PAQ      SPACE  4,20 
**        PAQ - PROCESS ACTIVE QUEUE FILES. 
* 
*         CALL ROUTINES TO READ AND SEARCH THE QFT FOR ACTIVE 
*         QUEUE FILES THAT MEET THE SPECIFICATIONS OF THE 
*         *K* DISPLAY INPUT AND MOVE THOSE FILES. 
* 
*         ENTRY  (X0) = 0 IF INITIAL CALL.
*                     = 1 IF NON-INITIAL CALL.
*                (CEQP) = CURRENT EQUIPMENT.
*                (B6) = QFT BUFFER ADDRESS, IF NON-INITIAL CALL.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 6. 
*                B - 6. 
* 
*         CALLS  DEQ, MAA, RQT, SQB.
* 
*         MACROS WRITE. 
  
  
*         DEQUEUE ACTIVE FILES. 
  
 PAQ2     RJ     DEQ         DEQUEUE FILES
  
*         CHECK FOR MORE TABLE TO SEARCH. 
  
 PAQ3     NZ     X5,PAQX     IF ERROR 
          SA1    PAQA 
          SB6    X1+         SET NEXT TABLE ADDRESS 
          NZ     X1,PAQ1     IF ENTIRE TABLE NOT SEARCHED 
  
 PAQ      SUBR               ENTRY/EXIT 
          WRITE  MIQ,*       PRESET WRITE FUNCTION
          NZ     X0,PAQ1     IF NON-INITIAL CALL
  
*         SEARCH QFT FOR QUEUE FILES TO MOVE. 
  
          RJ     RQT         READ QFT 
          SB6    RBUF+QFTE   SET QFT BUFFER ADDRESS 
 PAQ1     RJ     SQB         SEARCH QFT BUFFER ON SPECIFIED OPTIONS 
          SA6    PAQA        SAVE END OF BUFFER STATUS
          SA1    T+2
          SA2    A1+B1
          IX5    X1-X2
          ZR     X5,PAQX     IF BUFFER EMPTY
          SA2    TARA+AROP
          ZR     X2,PAQ2     IF LEAVE INACTIVE
  
*         MOVE ACTIVE TO ACTIVE.
  
          SA1    TARA+ARDD   CHECK EQUIPMENT TO MOVE TO 
          SA2    CEQP        CURRENT EQUIPMENT
          MX0    -12
          BX6    -X0*X1 
          IX7    X6-X2
          BX5    X5-X5       CLEAR ERROR FLAG 
          ZR     X7,PAQX     IF SAME EQUIPMENT
          RJ     MAA         MOVE ACTIVE TO ACTIVE
          EQ     PAQ3        CHECK FOR MORE ENTRIES 
  
 PAQA     CON    0           END OF QFT BUFFER STATUS 
 PCI      SPACE  4,10 
**        PCI - PURGE OLD IQFT AND COMPLETE NEW IQFT. 
* 
*         ENTRY  (IGCT) = COUNT OF FILES IGNORED ON THIS DEVICE.
* 
*         EXIT   (ATTA) = 0.
* 
*         USES   X - 3, 6.
*                A - 3, 6.
* 
*         MACROS QCALL, WRITER. 
  
  
 PCI      SUBR               ENTRY/EXIT 
          BX6    X6-X6       CLEAR ATTACHED FLAG
          SA6    ATTA 
          WRITER NIQ,R
          QCALL  STQF,NIQ    SET NEW IQFT IN MST
          EQ     PCIX        RETURN 
 PIQ      SPACE  4,20 
**        PIQ - PROCESS INACTIVE QUEUE FILES. 
* 
*         CALL ROUTINES TO ATTACH, READ AND SEARCH THE IQFT 
*         FILE FOR INACTIVE QUEUES THAT MEET THE SPECIFICATIONS 
*         OF THE *K* DISPLAY INPUT AND MOVE THOSE FILES.
* 
*         ENTRY  (CEQP) = CURRENT EQUIPMENT.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6, 7. 
*                A - 0, 1, 2, 5, 6, 7.
*                B - 6. 
* 
*         CALLS  ATT, CAS, CER, DAL, EPR, IIM, MII, NIF, RAF, REQ, SIB. 
* 
*         MACROS READEI, RECALL, REWIND, WRITE. 
  
  
 PIQ8     SA2    CEQP        ISSUE IQFT ERROR MESSAGE 
          RJ     IIM
          RJ     CER         CLEAR ERROR
          SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
 PIQ9     BX5    X5-X5       CLEAR ERROR TO CONTINUE
  
 PIQ      SUBR               ENTRY/EXIT 
          SA2    CEQP        CHECK FOR IQFT 
          SA1    TEQA+X2
          LX1    59-0 
          BX5    X5-X5       CLEAR ERROR FLAG 
          PL     X1,PIQX     IF NO IQFT ON DEVICE 
  
*         CALCULATE NUMBER OF AVAILABLE QFT SLOTS IF TO LEAVE ACTIVE. 
  
          SA1    TARA+AROP
          ZR     X1,PIQ1     IF LEAVE INACTIVE
          RJ     CAS         CALCULATE NUMBER OF AVAILABLE SLOTS
  
*         CREATE NEW IQFT FILE. 
  
 PIQ1     SA5    CEQP        CREATE IQFT FILE 
          SA3    TDAA+X5
          RJ     DAL         DETERMINE VALID ACCESS LEVEL 
          PL     X3,PIQ2     IF VALID ACCESS LEVEL FOUND
          SA2    CEQP        ISSUE IQFT ERROR MESSAGE 
          RJ     IIM
          SX5    MES12       * INCORRECT DEVICE ACCESS LEVEL.*
          MESSAGE  X5 
          EQ     PIQ9        CONTINUE WITH NEXT DEVICE
  
 PIQ2     SA0    NIQ
          RJ     NIF
          RECALL Q
          RECALL D
          WRITE  NIQ,*       PRESET WRITE FUNCTION
          WRITE  MIQ,*
          SX3    IQ          RETURN ATTACHED IQFT FILE
          RJ     RAF
  
*         ATTACH AND READ IQFT. 
  
          SA2    CEQP        CURRENT EST ORDINAL
          SA0    X3 
          RJ     ATT         ATTACH IQFT FILE 
          NZ     X5,PIQ8     IF ERROR 
          REWIND IQ 
          READEI IQ,R        READ IQFT FILE 
  
*         SEARCH IQFT FOR QUEUE FILES TO MOVE.
  
 PIQ3     RJ     SIB         SEARCH IQFT BUFFER ON SPECIFIED OPTIONS
          NZ     X5,PIQ7     IF ERROR 
          SA6    PIQA        SAVE END OF BUFFER STATUS
          SA2    TARA+AROP
          ZR     X2,PIQ4     IF LEAVE INACTIVE
  
*         MOVE INACTIVE TO ACTIVE.
  
          RJ     REQ         REQUEUE FILES
          EQ     PIQ6        CHECK FOR MORE ENTRIES 
  
*         MOVE INACTIVE TO INACTIVE.
  
 PIQ4     SA1    TARA+ARDD   CHECK EQUIPMENT TO MOVE TO 
          SA2    CEQP        CURRENT EQUIPMENT
          MX0    -12
          BX6    -X0*X1 
          IX7    X6-X2
          BX5    X5-X5       CLEAR ERROR FLAG 
          NZ     X7,PIQ5     IF NOT SAME EQUIPMENT
          SA7    IGCT        CLEAR IGNORED FILE COUNT FOR DEVICE
          REWIND NIQ
          EQ     PIQX        RETURN 
  
 PIQ5     RJ     MII         MOVE INACTIVE TO INACTIVE
  
*         CHECK FOR MORE TABLE TO SEARCH. 
  
 PIQ6     NZ     X5,PIQ7     IF ERROR 
          SA1    PIQA 
          NZ     X1,PIQ3     IF ENTIRE TABLE NOT SEARCHED 
          EQ     PIQX        RETURN 
  
 PIQ7     SX1    MES5 
          IX1    X5-X1
          NZ     X1,PIQ9     IF IQFT READ ERROR 
          EQ     PIQX        RETURN 
  
 PIQA     CON    0           END OF IQFT BUFFER STATUS
 REQ      SPACE  4,20 
**        REQ - REQUEUE INACTIVE FILES. 
* 
*         CALL ROUTINES TO PHYSICALLY MOVE THE FILE SPECIFIED 
*         BY THE GIVEN IQFT ENTRY FROM ONE DEVICE TO
*         ANOTHER, CHANGING IT TO AN ACTIVE STATE.  ALSO, 
*         PROCESS THE REMAINING FILES WHEN THRESHOLD LIMIT HAS
*         BEEN REACHED. 
* 
*         ENTRY  (IGCT) = COUNT OF FILES IGNORED ON THIS DEVICE.
*                (PIQA) = 0 IF ALL ENTRIES PROCESSED FROM IQFT. 
*                (NAQS) .LT. 0 IF THRESHOLD REACHED.
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
*                (ATTA) = 0 IF ALL IQFT ENTRIES PROCESSED.
* 
*         USES   X - 2, 3, 5, 6, 7. 
*                A - 2, 3.
* 
*         CALLS  AQF, BOF, CDI, CPF, PCI, RTD, SFD. 
* 
*         MACROS MESSAGE. 
  
  
 REQ      SUBR               ENTRY/EXIT 
  
*         ATTACH QUEUE FILE.
  
          SX5    AIQF        SET ATTACH FUNCTION
          RJ     AQF         ATTACH FILE
          NG     X5,REQ1     IF SKIP FILE 
          NZ     X5,REQ2     IF ERROR 
          NZ     X6,REQ1     IF END OF BUFFER 
  
*         MOVE QUEUE FILE TO DESTINATION DEVICE.
  
          RJ     SFD         SET FILE ON DESTINATION DEVICE 
          NG     X5,REQ1     IF SKIP FILE 
          NZ     X5,REQ2     IF ERROR 
          RJ     CPF         COPY FILE TO DESTINATION DEVICE
          NG     X5,REQ1     IF SKIP FILE 
          NZ     X5,REQ2     IF ERROR 
          RJ     RTD         RETURN FILES 
          RJ     BOF         BUILD OUTPUT FILE
  
*         PROCESS THRESHOLD LIMIT.
  
 REQ1     SA2    PIQA 
          SX5    B0+         SET NO ERROR 
          NZ     X2,REQX     IF NOT ALL ENTRIES PROCESSED 
 REQ2     SA3    NAQS 
          PL     X3,REQ3     IF THRESHOLD NOT REACHED 
          SX7    BOFB        *QFT THRESHOLD - FILE IGNORED* 
          RJ     CDI         REWRITE CURRENT DEVICE IQFT
          MESSAGE  MES6      * QFT THRESHOLD LIMIT.*
          BX6    X5          CHECK FOR PREVIOUS ERROR 
          SX5    MES6 
          NZ     X6,REQX     IF IQFT READ ERROR 
          EQ     REQ4        PURGE OLD IQFT FILE
  
 REQ3     SA2    PIQA 
          ZR     X2,REQ4     IF ALL ENTRIES PROCESSED 
          SX7    B0+         COPY OLD TO NEW IQFT 
          RJ     CDI
 REQ4     RJ     PCI         PURGE OLD AND COMPLETE NEW IQFT
          EQ     REQX        RETURN 
 RNI      SPACE  4,20 
**        RNI - RETURN NEW IQFT FILE. 
* 
*         DETACH OR PURGE THE NEW IQFT FILE ACCORDING TO THE
*         FUNCTION SPECIFIED. 
* 
*         ENTRY  (DEQA) = DETACH OR PURGE FUNCTION. 
*                (MVCT) = NUMBER OF FILES MOVED ON DEVICE.
* 
*         EXIT   (DEQB) .NE. 0 IF FILE DETACHED.
*                (X6) = 0.
* 
*         USES   X - 2, 4, 6. 
*                A - 2, 4, 6. 
* 
*         MACROS QCALL, WRITER. 
  
 RNI      SUBR               ENTRY/EXIT 
          SA4    DEQA        SET FUNCTION 
          SA2    MVCT 
          ZR     X2,RNI1     IF NO FILES DEQUEUED 
          WRITER MIQ,R
          SX4    DTQF        FORCE DETACH FUNCTION
 RNI1     SX6    X4-PGQF
          SA6    DEQB 
          QCALL  X4,MIQ 
          BX6    X6-X6       CLEAR ATTACHED FLAG
          EQ     RNIX        RETURN 
 RTD      SPACE  4,20 
**        RTD - RETURN FILE TO DESTINATION DEVICE.
* 
*         MONITOR THE RETURNING OF THE LOCAL QUEUED FILES TO
*         THE DESTINATION DEVICES COMPLETING THE CURRENT MOVE.
* 
*         ENTRY  (MVCT) = COUNT OF FILES MOVED. 
*                (CPFA) = DISPOSITION FIELD ADDRESS.
*                (REQF) .NE. 0 IF NEW SEQUENCE NUMBER ASSIGNED. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0 IF SKIP FILE.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
*                (X7) = DISPOSITION FIELD ADDRESS FOR OUTPUT. 
*                (MVCT) INCREMENTED BY ONE IF NO ERROR. 
* 
*         USES   X - 0, 1, 5, 6, 7. 
*                A - 1, 5, 6. 
*                B - 6. 
* 
*         CALLS  EPR, RTF.
* 
*         MACROS RETURN, UTL, WRITEW. 
  
  
*         PROCESS ERRORS. 
  
 RTD3     SB6    TQEP        SET ERROR TABLE ADDRESS
          RJ     EPR         PROCESS ERROR
          UTL    SET         RESET *UTL=* ENTRY POINT 
  
 RTD      SUBR               ENTRY/EXIT 
  
*         CHECK FOR NEW SEQUENCE NUMBER.
  
          SA1    REQF 
          ZR     X1,RTD1     IF NO NEW SEQUENCE NUMBER
          SA5    D           SET NEW NAME IN BUFFER 
          MX0    42 
          BX6    X0*X5
          SA1    T+3
          SA1    X1-QFEWL 
          BX7    -X0*X1 
          BX6    X6+X7
          SA6    A1+
  
*         RETURN FILE.
  
 RTD1     UTL    CLEAR       CLEAR *UTL=* ENTRY POINT 
          SA5    TARA+AROP   RETURN LOCAL QUEUED FILE 
          RJ     RTF
          NZ     X5,RTD3     IF ERROR 
          SA1    TARA+AROP
          NZ     X1,RTD2     IF LEAVE ACTIVE
          WRITEW MIQ,IQFE,QFEWL 
 RTD2     RETURN Q,R         RETURN OLD FILE
          UTL    SET         RESET *UTL=* ENTRY POINT 
  
*         ADVANCE COUNT OF FILES MOVED. 
  
          SA1    MVCT 
          SX6    X1+B1
          SA6    A1 
          SA1    CPFA        SET DISPOSITION FIELD ADDRESS
          SX7    X1+
          EQ     RTDX        RETURN 
 RTF      SPACE  4,20 
**        RTF - RETURN LOCAL FILE.
* 
*         RETURN THE CURRENT LOCAL COPY OF THE QUEUED FILE. 
* 
*         ENTRY  (X5) = 0 IF RETURN INACTIVE FILE.
*                     .GT. 0 IF RETURN ACTIVE FILE. 
*                (RTFC) = ENTRY TIME, IF ACTIVE FILE. 
*                       = -1, IF INACTIVE FILE. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     = ERROR CODE IF ERROR.
* 
*         USES   X - 0, 1, 5, 6, 7. 
*                A - 0, 1, 5, 6, 7. 
* 
*         CALLS  CBL, CER.
* 
*         MACROS MOVE, QCALL, RECALL, ROUTE.
  
  
*         RETURN ACTIVE QUEUED FILE.
  
 RTF1     RJ     CBL         CLEAR CALL BLOCK 
          SA1    T+3         SET UP ROUTE BLOCK 
          SA1    X1-QFEWL 
          MX0    24 
          BX6    X0*X1
          SA6    BLOCK
          SA1    RTFA        SET EXTENDED BLOCK/PRIORITY FLAGS
          BX6    X1 
          SA6    A6+B1
          SA1    RTFB        SET SPECIAL REQUEUE OPERATION FLAG 
          BX7    X1 
          SA7    BLOCK+7
          SA1    RTFC        SET ENTRY TIME 
          BX6    X1 
          SA6    BLOCK+3
          BX5    X5-X5       CLEAR ERROR
          ROUTE  BLOCK,RECALL 
  
 RTF      SUBR               ENTRY/EXIT 
          RECALL Q           MAKE QUEUED FILE FETS QUIET BEFORE RETURN
          RECALL D
          NZ     X5,RTF1     IF RETURN ACTIVE FILE
  
*         RETURN INACTIVE QUEUED FILE.
  
          SA1    T+3         SET BACK *OUT* POINTER 
          SX7    X1-QFEWL 
          SA7    A1+
          SA0    T
          QCALL  RIQF,T 
          SA5    T+3         UPDATE *OUT* POINTER 
          MOVE   QFEWL,X5,IQFE  SET NEW IQFT DATA 
          SX7    X5+QFEWL 
          SA7    A5+
          RJ     CER         CHECK FOR ERROR
          EQ     RTFX        RETURN 
  
  
 RTFA     VFD    42/0,18/FREB+FRPR  EXTENDED BLOCK/PRIORITY FLAGS 
 RTFB     VFD    42/0,18/EFRQ  SPECIAL REQUEUE OPERATION FLAG 
 RTFC     CON    -1          ENTRY TIME 
 RTS      SPACE  4,20 
**        RTS - RETURN FILE TO SOURCE DEVICE. 
* 
*         MONITOR THE RETURNING OF THE LOCAL QUEUED FILES TO
*         THE SOURCE DEVICES AFTER AN ERROR.
* 
*         ENTRY  (AQFB) .LT. 0 IF ERROR FROM SUBROUTINE *AQF*.
*                (RTSA) = ERROR RETURNED FROM *QFM* ON FILE ATTACH. 
* 
*         EXIT   (X5) = 0 IF NO ERROR IN RETURNING FILES. 
*                     = ERROR CODE IF ERROR.
* 
*         USES   X - 0, 1, 2, 5, 6. 
*                A - 0, 1, 2, 5, 6. 
* 
*         CALLS  CER, RTF.
* 
*         MACROS RENAME, RETURN, WRITEW.
  
  
 RTS      SUBR               ENTRY/EXIT 
  
*         RENAME QUEUED FILES.
  
          SA1    RTSA        CHECK FOR INCORRECT ACCESS LEVEL 
          SX2    NSEE 
          BX1    X1-X2
          ZR     X1,RTS0     IF ERROR 
          SA2    AQFB 
          NG     X2,RTS1     IF RENAME NOT NECESSARY
          SA1    =6LDQFILE   RENAME DESTINATION QUEUE FILE
          RENAME D,X1 
          SA0    D           CHECK FOR ERROR
          RJ     CER
          NZ     X5,RTSX     IF ERROR 
 RTS0     SA1    T+3         PUT QUEUE FILE NAME BACK IN FET
          SA1    X1-QFEWL 
          MX0    24 
          BX1    X0*X1
          RENAME Q,X1 
          SA0    Q           CHECK FOR ERROR
          RJ     CER
          NZ     X5,RTSX     IF ERROR 
  
*         RETURN FILES. 
  
 RTS1     SA5    DSPB        RETURN LOCAL QUEUED FILE 
          RJ     RTF
          NZ     X5,RTSX     IF ERROR 
          SA1    DSPB 
          NZ     X1,RTS2     IF MOVING ACTIVE 
          WRITEW NIQ,IQFE,QFEWL  WRITE IQFT ENTRY BACK
          SA1    IGCT        INCREMENT IGNORED COUNT
          SX6    X1+B1
          SA6    A1 
 RTS2     RETURN D,R         RETURN NEW FILE
          EQ     RTSX        RETURN 
  
 RTSA     CON    0           *QFM* ERROR FLAG 
 SFD      SPACE  4,20 
**        SFD - SET QUEUE FILE ON DESTINATION DEVICE. 
* 
*         SET UP THE CALLING BLOCKS AND CALL *QFM*
*         TO CREATE A FILE ON THE SPECIFIED EQUIPMENT.
* 
*         ENTRY  (SBUF) = FIRST WORD OF SYSTEM SECTOR.
*                (DSPB) = 0 IF MOVING INACTIVE FILES. 
* 
*         EXIT   (X5) = 0 IF NO ERROR.
*                     .LT. 0, SKIP CURRENT FILE.
*                     .GT. 0, *K* DISPLAY MESSAGE ADDRESS.
* 
*         USES   X - 0, 1, 2, 4, 5, 6, 7. 
*                A - 0, 1, 2, 7.
*                B - 6. 
* 
*         CALLS  CER, EPR, WSF. 
* 
*         MACROS QCALL, UTL.
  
  
 SFD      SUBR               ENTRY/EXIT 
  
*         SET EQUIPMENT IN SYSTEM SECTOR. 
  
          UTL    CLEAR       CLEAR *UTL=* ENTRY POINT 
          SA2    TARA+ARDD   GET EQUIPMENT TO MOVE TO 
          MX0    -12
          BX6    -X0*X2 
          LX6    48 
          MX4    12 
          SX5    EQSS        WRITE SYSTEM SECTOR FIELD
          RJ     WSF
          SA1    TARA+AROP
          SX6    B1 
          LX6    1-0
          ZR     X1,SFD1     IF LEAVING INACTIVE
          SA2    DSPB 
          BX6    X2 
          ZR     X2,SFD1     IF MOVING INACTIVE 
          SX6    B1 
 SFD1     SX5    GQSS 
          LX6    -12
          MX4    12 
          RJ     WSF         WRITE SYSTEM SECTOR FIELD
          SA0    S
          QCALL  CQFF,S      CREATE QUEUE FILE
          SX2    IOSS-BFMS-2 SET NEW JSN IN FET 
          SX1    5
          IX6    X2/X1
          SA2    SBUF+X6
          MX0    24 
          BX6    X0*X2
          SA1    D
          MX0    42 
          BX7    -X0*X1 
          BX7    X6+X7
          SA7    A1 
          RJ     CER
          BX6    X5          SAVE ERROR CODE
          SA6    RTSA 
          ZR     X5,SFD2     IF NO ERROR
          SB6    TQEP 
          RJ     EPR         PROCESS ERROR
 SFD2     UTL    SET         RESET *UTL=* ENTRY POINT 
          EQ     SFDX        RETURN 
 SIB      SPACE  4,20 
**        SIB - SEARCH IQFT BUFFER ON SPECIFIED OPTIONS.
* 
*         SEARCH THE IQFT FOR QUEUE FILES THAT MEET THE 
*         SPECIFICATIONS GIVEN BY THE *K* DISPLAY INPUT,
*         BUILDING A NEW IQFT FOR THOSE THAT DO NOT MEET THE
*         SPECIFICATIONS AND RETURNING WHEN ONE IS FOUND THAT DOES. 
* 
*         ENTRY  (NAQS) = NUMBER OF AVAILABLE ENTRIES TO ACTIVATE.
*                (CEQP) = CURRENT EQUIPMENT.
* 
*         EXIT   (X6) = 1 IF MORE BUFFER TO SEARCH. 
*                     = 0 IF ENTIRE BUFFER SEARCHED.
*                (IGCT) = NUMBER OF FILES IGNORED ON DEVICE.
*                (NAQS) .LT. 0 IF THRESHOLD REACHED.
*                (IQFE) = FIRST WORD OF IQFT ENTRY. 
*                (X5) = 0 IF NO ERROR.
*                     = *K* DISPLAY MESSAGE ADDRESS IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 7.
*                B - 2. 
* 
*         CALLS  CAF, CLD, PLE, VIE.
* 
*         MACROS READW, WRITEW. 
  
  
 SIB4     BX6    X6-X6
  
 SIB      SUBR               ENTRY/EXIT 
          SX7    TBUF        REWIND POINTERS
          SA7    T+2
          SA7    A7+B1
          EQ     SIB3        VERIFY IQFT ENTRY
  
 SIB1     RJ     PLE         PROCESS LENGTH ERROR 
  
*         WRITE ENTRY TO NEW IQFT.
  
 SIB2     WRITEW NIQ,IQFE,QFEWL 
          SA2    IGCT        INCREMENT IGNORED FILE COUNT 
          SX7    X2+B1
          SA7    A2 
  
*         VERIFY IQFT ENTRY.
  
 SIB3     BX5    X5-X5       CLEAR ERROR STATUS 
          READW  IQ,IQFE,QFEWL
          NZ     X5,SIBX     IF IQFT READ ERROR 
          NZ     X1,SIB4     IF EOF/EOI 
          SA2    IQFE+8 
          NG     X2,SIB1     IF LENGTH ERROR
          SA3    IQFE+2      CHECK LOGICAL IDENTIFIER 
          SX4    B1+         SET CHECK FOR LID IN TABLE 
          RJ     CLD
          NZ     X3,SIB2     IF NO MATCH
          SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    X1+
          SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    IQFE+INSQ   GET *INSQ* WORD OF QFT ENTRY 
          RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          NZ     X1,SIB2     IF FILE NOT SELECTED 
          SA3    REQF 
          BX6    X3 
          RJ     VIE         VERIFY IQFT ENTRY
          NZ     X1,SIB2     IF NO MATCH
          SA2    CEQP        SET CURRENT EQUIPMENT IN ENTRY 
          LX2    48 
          MX0    12 
          SA3    IQFE+1 
          BX6    -X0*X3 
          BX7    X6+X2
          SA7    A3+
  
*         MOVE ENTRY TO BUFFER. 
  
          WRITEW T,IQFE,QFEWL 
          SX6    B1+         SET MORE TO PROCESS
          SA2    TARA+AROP
          ZR     X2,SIBX     IF LEAVE INACTIVE
  
*         DECREMENT THRESHOLD COUNT.
  
          SA3    NAQS 
          SX7    X3-1 
          SA7    A3+
          NG     X7,SIB4     IF THRESHOLD REACHED 
          EQ     SIBX        RETURN 
 SQB      SPACE  4,20 
**        SQB - SEARCH QFT BUFFER ON SPECIFIED OPTIONS. 
* 
*         SEARCH THE QFT FOR QUEUE FILES THAT MEET THE
*         SPECIFICATIONS GIVEN BY THE *K* DISPLAY INPUT AND 
*         BUILD A PSEUDO IQFT ENTRY IN THE TEMPORARY IQFT 
*         BUFFER FOR THOSE THAT DO. 
* 
*         ENTRY  (B6) = BUFFER ADDRESS OF NEXT ENTRY TO SEARCH. 
*                (QFTS) = QFT LENGTH. 
*                (CEQP) = CURRENT EQUIPMENT.
* 
*         EXIT   (X6) = 0 IF ENTIRE BUFFER SEARCHED.
*                     = ADDRESS OF NEXT ENTRY OTHERWISE.
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 6. 
* 
*         CALLS  CAF, CLD, VQE. 
* 
*         MACROS MOVE.
  
  
 SQB4     SX6    B6          SET ADDRESS OF NEXT ENTRY
  
 SQB      SUBR               ENTRY/EXIT 
          SX7    TBUF        REWIND POINTERS
          SA7    T+2
          SA7    A7+B1
          BX5    X5-X5       PRESET BUFFER NOT FULL 
  
*         VERIFY QFT ENTRY. 
  
 SQB1     NG     X5,SQB4     IF FULL BUFFER 
          SA4    B6          READ QFT ENTRY 
          MX0    -12         CLEAR LINKAGE FIELD
          BX3    X0*X4
          ZR     X3,SQB3     IF EMPTY QFT SLOT
          LX4    59-1 
          NG     X4,SQB3     IF ATTACHED TO A JOB 
          SA3    B6+2        CHECK LOGICAL IDENTIFIER 
          SX4    B1          SET CHECK FOR LID IN TABLE 
          RJ     CLD
          NZ     X3,SQB3     IF NO MATCH
          SA1    TARA+AROP   SELECT ORIGIN TYPE ACCESS LEVEL CHECK
          SB2    X1+
          SA1    TARA+ARUA   SET ACCESS LEVEL LIMITS
          SA2    TARA+ARLA
          SA3    B6+INSQ     GET *INSQ* WORD OF QFT ENTRY 
          RJ     CAF         CHECK ACCESS LEVEL OF FILE 
          NZ     X1,SQB3     IF FILE NOT SELECTED 
          SX1    B6+         SET QFT ADDRESS
          RJ     VQE         VERIFY QFT ENTRY 
          NZ     X1,SQB3     IF NO MATCH
          SA3    CEQP        SET CURRENT EQUIPMENT
          IX7    X3-X2
          NZ     X7,SQB3     IF NOT CORRECT EQUIPMENT 
  
*         MOVE PSEUDO IQFT ENTRY TO BUFFER. 
  
          SA5    T+2         *IN* 
          SX6    B6-RBUF     SET QFT ORDINAL IN ENTRY 
          SX1    QFTE 
          IX6    X6/X1
          SA6    X5+QFEWL-1 
          SB3    QFEWL-QFTE-1  NUMBER OF WORDS TO CLEAR 
          BX6    X6-X6
 SQB2     SB3    B3-B1
          SA6    A6-B1
          NZ     B3,SQB2     IF MORE WORDS TO CLEAR 
          MOVE   QFTE,B6,X5 
          SX7    X5+QFEWL    UPDATE *IN* POINTER
          SA7    A5+
          SA3    A5+2        *LIMIT*
          SX3    X3          CHECK FOR FULL BUFFER
          IX6    X3-X7
          SX5    X6-QFEWL 
  
*         CHECK FOR END OF QFT. 
  
 SQB3     SB6    B6+QFTE     SET NEXT ENTRY ADDRESS 
          SA3    QFTS        QFT LENGTH 
          SX6    RBUF+X3
          SX3    B6+QFTE
          IX4    X3-X6
          BX6    X6-X6       SET BUFFER SEARCHED
          NG     X4,SQB1     IF NOT END OF QFT
          ZR     X4,SQB1     IF NOT END OF QFT
          EQ     SQBX        RETURN 
 WSF      SPACE  4,20 
**        WSF - WRITE SYSTEM SECTOR FIELD.
* 
*         ENTER THE SPECIFIED DATA IN A GIVEN FIELD OF THE
*         SYSTEM SECTOR BLOCK.
* 
*         ENTRY  (X4) = FIELD MASK. 
*                (X5) = FIELD ADDRESS BIASED BY *BFMS*+2. 
*                (X6) = FIELD LEFT JUSTIFIED. 
*                (SBUF) = SYSTEM SECTOR BLOCK.
* 
*         USES   X - ALL. 
*                A - 2, 3, 6, 7.
*                B - 5, 6.
  
  
 WSF      SUBR               ENTRY/EXIT 
          SX3    X5-BFMS-2   ADJUST ADDRESS 
          SX0    X3+
          SX2    5           COMPUTE *CM* ADDRESS 
          SX1    X2 
          IX7    X3/X2
          IX2    X1*X7
          IX2    X0-X2       GET BYTE NUMBER
  
*         FORM MASK OF BITS AVAILABLE IN WORD OR TOTAL BITS WANTED, 
*         WHICHEVER IS LESS.
  
          IX1    X1-X2       BYTES AVAILABLE IN WORD
          SX0    12 
          IX1    X0*X1       FORM SHIFT COUNT 
          CX5    X4          GET SIZE OF FIELD
          SA2    X7+SBUF     GET SYSTEM SECTOR WORDS
          SA3    A2+B1
          IX7    X5-X1       FIELD SIZE - SHIFT COUNT 
          NG     X7,WSF1     IF MORE BITS AVAILABLE THAN NEEDED 
          SX5    X1+         SET BITS AVAILABLE 
 WSF1     SB5    X5-1 
          SB6    X1 
          MX0    1           FORM MASK
          AX0    B5,X0
  
*         MERGE DATA IN FIELDS. 
  
          LX6    B6,X6       POSITION DATA
          LX0    B6,X0       POSITION MASK
          BX7    -X0*X2      CLEAR FIELD
          BX5    X0*X6       MASK OFF DATA
          LX4    B6,X4
          BX7    X5+X7       MERGE DATA 
          BX4    -X0*X4      ADJUST MASK
          SA7    A2 
          BX6    X4*X6       MASK DATA
          BX7    -X4*X3      CLEAR FIELD
          BX6    X6+X7       MERGE DATA 
          SA6    A3 
          EQ     WSFX        RETURN 
          TITLE  ERROR PROCESSING TABLES. 
**        TCEP - TABLE OF *CIO* ERROR PROCESSING. 
* 
*         INDEX INTO TABLE IS *CIO* ERROR CODE IF FET+0 CODE IS 1 
*         OR 2.  IF FET+0 CODE IS 11B, INDEX INTO TABLE IS ERROR
*         CODE BIASED BY 11B. 
  
  
          CON    21B         NUMBER OF TABLE ENTRIES
 TCEP     BSS    0           TABLE OF *CIO* ERROR PROCESSING
          LOC    0
          CON    MC00        *CIO* ERROR
          VFD    1/1,59/ETL  TRACK LIMIT
 TCEPA    VFD    1/1,59/EPE  PARITY ERROR 
          BSSZ   7
          VFD    1/1,59/EPE  PARITY ERROR 
          CON    MC02        ADDRESS ERROR
          CON    MC03        DEVICE STATUS ERROR
          CON    MC04        FUNCTION REJECT ERROR
          CON    MC05        DEVICE RESERVED
          CON    MC06        DEVICE NOT READY 
          VFD    1/1,59/ETL  TRACK LIMIT
          LOC    *O 
          SPACE  4
**        TLEP - TABLE OF *LFM* ERROR PROCESSING. 
* 
*         INDEX INTO TABLE IS *LFM* ERROR CODE. 
  
  
          CON    21B         NUMBER OF TABLE ENTRIES
 TLEP     BSS    0           TABLE OF *LFM* ERROR PROCESSING
          LOC    0
          CON    ML00        *LFM* ERROR
          CON    ML01        FILE NOT FOUND 
          CON    ML02        FILE NAME ERROR
          CON    ML03        INCORRECT FILE TYPE
          CON    ML04        FILE EMPTY 
          CON    ML05        WAITING FOR COMMON FILE
 TLEPA    CON    ML06        DUPLICATE COMMON FILE NAME 
          CON    ML07        INCORRECT EQUIPMENT
          CON    ML10        EQUIPMENT NOT AVAILABLE
          CON    ML11        DUPLICATE FILE NAME
          CON    ML12        USER ACCESS NOT VALID
          CON    ML13        INCORRECT USER NAME
          CON    ML14        INCORRECT ID CODE
          CON    ML15        RESEX ERROR
          CON    ML16        I/O SEQUENCE ERROR 
          CON    ML17        OUTPUT FILE LIMIT
          CON    ML20        LOCAL FILE LIMIT 
          LOC    *O 
          SPACE  4
**        TQEP - TABLE OF *QFM* ERROR PROCESSING. 
* 
*         INDEX INTO TABLE IS *QFM* ERROR CODE. 
  
  
          CON    TQEPL       NUMBER OF TABLE ENTRIES
 TQEP     BSS    0           TABLE OF *QFM* ERROR PROCESSING
          LOC    0
          CON    MQ00        *QFM* ERROR
 FNFE     CON    MQ01        FILE NOT FOUND 
 FAIE     CON    MQ02        FILE ALREADY INTERLOCKED 
 TASE     BSSZ   1
 FTHE     CON    MQ04        FNT/QFT FULL 
 INSE     VFD    1/1,59/ESS  INCORRECT SYSTEM SECTOR
 RMSE     VFD    1/1,59/ERM  RMS ERROR
          BSSZ   2
 DUNE     CON    MQ03        IGNORED - UNAVAILABLE
          BSSZ   4
 DFNE     VFD    1/1,59/EDF  DUPLICATE FILE NAME
 NSEE     VFD    1/1,59/EAL  INCORRECT ACCESS LEVEL 
 TQEPL    EQU    *
          LOC    *O 
          SPACE  4
          TITLE  OPERATOR/DAYFILE AND ERROR MESSAGES. 
**        OPERATOR/DAYFILE MESSAGES.
  
 MES1     DATA   C* QMOVE COMPLETE.              *
 MES2     DATA   C* QMOVE ABORTED.               *
 MES3     DATA   C* INCORRECT MOVE REQUESTED.    *
 MES4     DATA   C* OUTPUT FILE NAME CONFLICT.   *
 MES5     DATA   C* QUEUES UNRECOVERABLE THIS DEVICE.*
 MES6     DATA   C* QFT THRESHOLD LIMIT.         *
 MES7     DATA   C* NO OUTPUT FILE EXISTS.       *
 MES8     DATA   C* OUTPUT FILE RELEASED.        *
 MES9     DATA   C* ERRORED TRACK NAME LIMIT.    *
 MES10    DATA   C* QUEUE STATUS INDEFINITE.     *
 MES11    DATA   C* IQFT NOT FOUND.*
 MES12    DATA   C* INCORRECT DEVICE ACCESS LEVEL. *
  
**        *CIO* ERROR MESSAGES. 
  
 MC00     DATA   C/ *CIO* ERROR.                 /
 MC02     DATA   C* ADDRESS ERROR.               *
 MC03     DATA   C* DEVICE STATUS ERROR.         *
 MC04     DATA   C* 6681 FUNCTION REJECT ERROR.  *
 MC05     DATA   C* DEVICE RESERVED.             *
 MC06     DATA   C* DEVICE NOT READY.            *
 MC07     DATA   C* TRACK LIMIT.                 *
  
**        *LFM* ERROR MESSAGES. 
  
 ML00     DATA   C/ *LFM* ERROR.                 /
 ML01     DATA   C* FILE NOT FOUND.              *
 ML02     DATA   C* FILE NAME ERROR.             *
 ML03     DATA   C* INCORRECT FILE TYPE.         *
 ML04     DATA   C* FILE EMPTY.                  *
 ML05     DATA   C* WAITING FOR COMMON FILE.     *
 ML06     DATA   C* DUPLICATE COMMON FILE NAME.  *
 ML07     DATA   C* INCORRECT EQUIPMENT.         *
 ML10     DATA   C* EQUIPMENT NOT AVAILABLE.     *
 ML11     DATA   C* DUPLICATE FILE NAME.         *
 ML12     DATA   C* USER ACCESS NOT VALID.       *
 ML13     DATA   C* INCORRECT USER NAME.         *
 ML14     DATA   C* INCORRECT ID CODE.           *
 ML15     DATA   C* RESEX ERROR.                 *
 ML16     DATA   C* I/O SEQUENCE ERROR.          *
 ML17     DATA   C* OUTPUT FILE LIMIT.           *
 ML20     DATA   C* LOCAL FILE LIMIT.            *
  
**        *QFM* ERROR MESSAGES. 
  
 MQ00     DATA   C/ *QFM* ERROR.                 /
 MQ01     DATA   C* FILE NOT FOUND.              *
 MQ02     DATA   C* FILE ALREADY INTERLOCKED.    *
 MQ03     DATA   C* DEVICE UNAVAILABLE.          *
 MQ04     DATA   C* FNT/QFT FULL.                *
  
          TITLE  COMMON DECKS.
*         COMMON DECKS. 
  
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCOD 
*CALL     COMCCPM 
*CALL     COMCEDT 
*CALL     COMCFQO 
*CALL     COMCIQP 
*CALL     COMCLFM 
*CALL     COMCMVE 
*CALL     COMCQFM 
*CALL     COMCQFP 
*CALL     COMCRDW 
*CALL     COMCSCB 
*CALL     COMCSFM 
*CALL     COMCSFN 
*CALL     COMCSYS 
*CALL     COMCVLC 
*CALL     COMCVQF 
 WRIF$    EQU    1
*CALL     COMCWTC 
*CALL     COMCWTW 
*CALL     COMCZTB 
          TITLE  BUFFERS. 
          USE    LITERALS 
  
*         BUFFERS.
  
 RSBS     BSS    1           *RSB* STATUS WORD
 BLOCK    BSSZ   EPBL        *DSP* CALL BLOCK 
 IQFE     BSSZ   QFEWL       INACTIVE QUEUED FILE ENTRY BUFFER
 WBUF     EQU    *           WORKING BUFFER 
 TBUF     EQU    WBUF+WBUFL  TEMPORARY IQFT ENTRY BUFFER
 NBUF     EQU    TBUF+BUFL   NEW IQFT FILE BUFFER FOR CURRENT DEVICE
 MBUF     EQU    NBUF+BUFL   NEW IQFT FILE BUFFER FOR MOVE DEVICE 
 OBUF     EQU    MBUF+BUFL   OUTPUT FILE BUFFER 
 QBUF     EQU    OBUF+BUFL   QUEUE FILE BUFFER
 DBUF     EQU    QBUF+QBUFL  DESTINATION QUEUE FILE BUFFER
 SBUF     EQU    DBUF+QBUFL  SYSTEM SECTOR BUFFER 
 TACF     EQU    SBUF+SBUFL  TABLE OF ACTIVE FAMILIES 
  
*         READ FNT OR QFT INTO FIELD LENGTH STARTING AT *RBUF*. 
  
 RBUF     EQU    TACF+ESMX+1 FNT/QFT BUFFER 
  
*         THE LENGTH OF *IBUF* MAY BE EXPANDED TO READ THE ENTIRE 
*         FNT OR QFT IF NECESSARY.
  
 IBUF     EQU    RBUF        OLD IQFT FILE BUFFER 
 BUFFL    EQU    IBUF+IBUFL+4  END OF BUFFERS 
          TITLE  PRESET.
 PRS      SPACE  4,20 
**        PRS - PRESET. 
* 
*         PRESET ADJUSTS FIELD LENGTH, PERFORMS THRESHOLD 
*         CALCULATION FOR A GIVEN SIZE QFT, AND SETS UP A 
*         CONTROL WORD TO READ THE QFT. 
* 
*         ENTRY  (QFTA) = *QFTP* WORD IN CMR. 
* 
*         EXIT   (QFTS) = LENGTH OF QFT.
*                (QFTT) = QFT THRESHOLD.
*                (RQTA) = *RSB* CONTROL WORD FOR QFT READ.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 2, 6, 7. 
* 
*         MACROS MEMORY.
  
  
 PRS      SUBR               ENTRY/EXIT 
          MEMORY CM,,R,BUFFL
  
*         SET QFT FWA AND LENGTH. 
  
          SA2    QFTA        *QFTP* WORD
          MX0    -24         GET FWA OF QFT 
          LX2    24 
          BX7    -X0*X2 
          LX2    12          GET MAXIMUM NUMBER OF QFT ENTRIES
          MX0    -12
          BX2    -X0*X2 
          SX3    QFTE 
          IX6    X2*X3       NUMBER OF ENTRIES * ENTRY LENGTH 
          SA6    QFTS        QFT LENGTH 
  
*         SET UP *RSB* CONTROL WORD TO READ QFT.
  
          SX4    100B        WORD COUNT 
          LX4    18 
          BX7    X4+X7       ADD ON QFT FWA 
          SX1    RBUF        BUFFER ADDRESS 
          LX7    18 
          BX7    X7+X1
          SA7    RQTA 
  
*         CALCULATE NUMBER OF RESERVED QFT ENTRIES. 
  
          SX3    SQTL        STATIC QFT THRESHOLD LIMIT 
          SX7    100
          IX3    X7-X3
          IX3    X2*X3       NUMBER OF QFT ENTRIES * 100-*SQTL* 
          IX6    X3/X7
          BX7    X7-X7       CLEAR LID TABLE FULL FLAG
          SA7    LTFL 
          SA6    QFTT 
          EQ     PRSX        RETURN 
          SPACE  4,10 
          ERRPL  *-RFL       IF DEFAULT FIELD LENGTH TOO SMALL
          SPACE  4
          END    QMOVE
