*DECK QUEFIL                       27MAY80
USETEXT COMCBEG 
USETEXT COMCAPR 
USETEXT COMCCAE 
USETEXT COMQCAF 
USETEXT COMQDEF 
USETEXT COMQDSP 
USETEXT COMQFIL 
USETEXT COMQNET 
    PROC QUEFIL;
      BEGIN    # QUEFIL # 
# 
**    QUEFIL     ADD FILE TO INPUT/OUTPUT QUEUE.
* 
*     QUEFIL SETS UP A PARAMETER BLOCK FROM THE AFT ENTRY,
*     AND CALLS DSP TO ROUTE THE FILE TO THE I/O QUEUE. 
* 
*     PROC QUEFIL 
* 
*     ENTRY      ACN = AFT ENTRY INDEX. 
* 
*     EXIT       AFT ENTRY STATUS UPDATED.
*                FILECER = TRUE, IF FATAL DSP ERROR.
* 
*     PROCESS    BUILD DSP PARAMETER BLOCK
*                CALL SYSTEM (DSP)
*                IF DSP ERROR:  
*                  WHILE ERROR IS NON-FATAL:  
*                  RESET PARAMETER BLOCK
*                  CALL SYSTEM (DSP). 
*                IF FATAL DSP ERROR:  
*                  CALL RMTLOG TO SEND MESSAGE TO QTF 
*                  SET FILE ERROR FLAG. 
* 
* 
*     NOTE - THE FOLLOWING TABLE CONSTITUTE THE QTFS PARAMETER
*            DSP REQUEST BLOCK AND ITS ERROR RESPONSE.
* 
*   +------------------------------------------------------------+
*   : QTFS   : ANY --> 2.2 : 2.2 -> 2.2 : 2.1 --> 2.2 : F -> 2.2 :  
*   :  PAR.  :             :            :             :          :  
*   :  SCL   : Y  Y  N  N  :  Y      Y  : N  Y  Y  N  :  -   -   :  
*   :  OT    : -  -  -  -  :  Y      Y  : N  N  N  N  :  N   N   :  
*   :  CUN   : -  -  -  -  :  Y      Y  : Y  Y  Y  Y  :  N   N   :  
*   :  OUN   : -  -  -  -  :  Y      Y  : Y  Y  Y  Y  :  N   N   :  
*   :  DUN   : N  Y  N  Y  :  N      Y  : N  N  Y  Y  :  N   Y   :  
*   :  INPUT : Y  Y  Y  Y  :  N      N  : N  N  N  N  :  N   N   :  
*   :--------:-------------:------------:-------------:----------:  
*   :  DSP   :             :            :             :          :  
*   :  SCL   : Y  Y  N  N  :  Y      Y  : DF Y  Y  DF :  BC  RB  :  
*   :  OT    : BC RB BC RB :  Y      Y  : BC BC RB RB :  BC  RB  :  
*   :  CUN   : N  N  N  N  :  Y      Y  : Y  Y  Y  Y  :  N   N   :  
*   :  OUN   : N  N  N  N  :  Y      Y  : Y  Y  Y  Y  :  N   N   :  
*   :  DUN   : N  Y  N  Y  :  N      Y  : N  N  Y  Y  :  N   Y   :  
*   :--------:-------------:------------:-------------:----------:  
*   :DSP ERR :11/45 :11/45 :   11/45                             :  
*   :        : SCL= :  R   :  IF SC NE DF                        :  
*   :        :   0  :  E   :     AND NOT SCFLAG                  :  
*   :        :      :  J   :       AND CUN NE 0                  :  
*   :        :      :  E   :  THEN SET SC=DF AND RETRY.          :  
*   :        :      :  C   :  ELSE                               :  
*   :        :      :  T   :    IF NOT SCFLAG                    :  
*   :        :      :      :      THEN SET SCFLAG AND RETRY.     :  
*   :        :      :      :      ELSE                           :  
*   :        :      :      :        REJECT.                      :  
*   :        :---------------------------------------------------:  
*   :        :  21   REJECT                                      :  
*   :        :---------------------------------------------------:  
*   :        :  43   IF OUN NE 0 THEN SET OUN=0 ELSE REJECT.     :  
*   :        :---------------------------------------------------:  
*   :        :  45   IF CUN NE 0 THEN SET CUN=0 ELSE REJECT.     :  
*   +------------------------------------------------------------+
  
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC ABORTQ;
        PROC CALLSYS; 
        FUNC CCOUNT     I;
        FUNC CHKCMM     I;
        PROC CONLOG;
        FUNC FREECMM    U;
        PROC NAME;                 # DEBUG CODE # 
        PROC RMTLOG;
        PROC TXTMOV;
        FUNC XCOD       C(10);
        FUNC XSFW       C(10);
        END 
# 
****  XREF END
# 
  
  
      DEF LEMSGQUF   #28#;
      ARRAY EMSGQUF    S(3);
        BEGIN 
        ITEM $DQUF      C(00,00,LEMSGQUF) = 
                 ["QUEUED AS XXXXXXXX FROM YYY."];
        ITEM EMSGQUJN   C(01,00,08);
        ITEM EMSGQUPI   C(02,24,03);
        END 
  
      DEF LEMSGROE   #43#;
      ARRAY EMSGROE    S(5);
        BEGIN 
        ITEM $DROE      C(00,00,LEMSGROE) = 
                 ["ROUTE ERROR NNB - "];
        ITEM EMSGROEERR C(01,12,02);
        ITEM EMSGROETXT C(01,48,25);
        END 
  
      ARRAY            S(1);
        BEGIN 
        ITEM WORDC10    C(00,00,10);
        ITEM WORDR2     C(00,48,02);
        END 
  
    CONTROL IFEQ OS$NOSBE;
      DEF MAXDSPERR  #07#;
      ARRAY [0:MAXDSPERR] S(3); 
        BEGIN 
        ITEM DSPERR$TXT C(00,00,25) = 
                 ["(CONTACT SITE ANALYST)." 
                 ,"INVALID DISPOSITION CODE." 
                 ,"INVALID ST OR DO LID." 
                 ,"INVALID TERMINAL ID."
                 ,"INVALID FORMS CODE." 
                 ,"INVALID JOB STATEMENT."
                 ,"INVALID FILE ID."
                 ,"FNT FULL (RETRY LATER)." 
                 ]; 
        ITEM DSPERR$TYP U(02,30,03) = 
                 [7(0), 1(2)];
        ITEM DSPERR$ORD U(02,42,18) = 
                 [0 
                 ,O"07" 
                 ,O"27" 
                 ,O"21" 
                 ,O"22" 
                 ,O"30" 
                 ,O"10" 
                 ,O"32" 
                 ]; 
        END 
  
    CONTROL ENDIF;
  
    CONTROL IFEQ OS$NOS;
      DEF MAXDSPERR  #20#;
      ARRAY [0:MAXDSPERR] S(3); 
        BEGIN 
        ITEM DSPERR$TXT C(00,00,25) = 
                 ["(CONTACT SITE ANALYST)." 
                 ,"FILE IS EMPTY."
                 ,"INVALID DISPOSITION CODE." 
                 ,"INVALID ST OR DO LID." 
                 ,"INVALID TERMINAL ID."
                 ,"INVALID FORMS CODE." 
                 ,"INVALID JOB COMMAND."
                 ,"INVALID DATA DECLARATION." 
                 ,"INVALID INTERNAL CHAR."
                 ,"INVALID EXTERNAL CHAR."
                 ,"INVALID SPACING CODE." 
                 ,"TOO MANY DEFERRED JOBS." 
                 ,"INVALID USER ACCESS."
                 ,"INVALID USER COMMAND." 
                 ,"QFT FULL (RETRY LATER)." 
                 ,"DISK FULL (RETRY LATER)."
                 ,"INVALID OWNER USER." 
                 ,"INVALID CREATION USER."
                 ,"UNDEFINED SERVICE CLASS."
                 ,"INVALID SERVICE CLASS."
                 ,"INVALID PRINT IMAGE CODE." 
                 ]; 
        ITEM DSPERR$TYP U(02,30,03) = 
                 [12(0),2(1),2(2),2(0),2(3),1(0)];
        ITEM DSPERR$ORD U(02,42,18) = 
                 [0 
                 ,O"06" 
                 ,O"07" 
                 ,O"15" 
                 ,O"21" 
                 ,O"22" 
                 ,O"32" 
                 ,O"14" 
                 ,O"23" 
                 ,O"37" 
                 ,O"41" 
                 ,O"33" 
                 ,O"10" 
                 ,O"34" 
                 ,O"25" 
                 ,O"27" 
                 ,O"43" 
                 ,O"44" 
                 ,O"11" 
                 ,O"45" 
                 ,O"50" 
                 ]; 
        END 
  
    CONTROL ENDIF;
  
      SWITCH DSPORDS
        SWI$REJECT,                # 0 #
        SWI$SECURE,                # 1 #
        SWI$TEMP,                  # 2 #
        SWI$BADSCL;                # 3 #
  
      ITEM I          I;           # SCRATCH INDEX #
      ITEM RETRY      B;           # RETRY DSP REQUEST #
      ITEM IGSCLEF    B;           # IGNORE SERVICE CLASS ERROR # 
  
  
        $BEGIN
        NAME("QUEFIL");            # DEBUG CODE # 
        $END
  
  
      DSPADR = CHKCMM(0, DSPBLEN+DSPXPBL);
      P<DSPB> = DSPADR;            # POINT TO CMM BLOCK # 
      IGSCLEF = FALSE;
      RETRY = TRUE;                # INITIALIZE LOOP CONTROL #
      ASLONGAS RETRY               # WHILE RETRY POSSIBLE # 
      DO
        BEGIN 
        SLOWFOR I = 1 STEP 1 UNTIL DSPBLEN+DSPXPBL
        DO
          BEGIN 
          P<FET> = I + P<DSPB> - 1; 
          FETWD = 0;               # CLEAR PARAMETER BLOCK #
          END 
  
        DSPLFNC = FILELFNC;        # LFN #
        DSPDIS  = FILEDCC;         # DISPOSITION CODE # 
        DSPF17  = TRUE;            # RETURN JOB NAME #
        DSPF12  = TRUE;            # RETURN ERROR CODE #
        DSPF4   = TRUE;            # DC SPECIFIED # 
        DSPF3   = TRUE;            # SLID/DLID SPECIFIED #
        DSPSID  = FILESLD;         # SLID # 
        DSPDID  = FILELID;         # DLID # 
        IF FILEINT                 # IF INPUT FILE #
        THEN
          BEGIN 
          DSPIF43 = TRUE;          # IGNORE JOB STATEMENT ERROR # 
          END 
  
        ELSE                       # OUTPUT FILE #
          BEGIN 
          IF FILEREP NE 0          # IF REPEAT COUNT SPECIFIED #
          THEN
            BEGIN 
            DSPRC   = FILEREP;
            DSPF14  = TRUE; 
            END 
  
          IF FILEICS NE 0          # IF INTERNAL CHAR SPECIFIED # 
          THEN
            BEGIN 
            DSPIC   = FILEICS;
            DSPF8   = TRUE; 
            END 
  
          IF FILEECS NE 0          # IF EXTERNAL CHAR SPECIFIED # 
          THEN
            BEGIN 
            DSPEC   = FILEECS;
            DSPF7   = TRUE; 
            END 
  
          IF FILESPC NE 0          # IF SPACING CODE #
          THEN
            BEGIN 
            DSPSC   = FILESPC;
            DSPF15  = TRUE; 
            END 
  
          IF FILEPFC NE 0          # IF FORMS CODE SPECIFIED #
          THEN
            BEGIN 
            DSPFC   = FILEPFC;
            DSPF10  = TRUE; 
            END 
  
          END 
  
        IF FILEIRT NE 0            # IF IMPLICIT TEXT AVAILABLE # 
        THEN
          BEGIN 
          P<DSPXPB> = P<DSPB> + DSPBLEN;
          TXTMOV(FILEIRT, LOC(DSPXIRTFWA), I);
          DSPXILC = I;             # LENGTH OF IMPLICIT TEXT #
  
        CONTROL IFEQ OS$NOSBE;
          DSPXPP  = P<DSPXPB>;
          DSPF16  = TRUE;          # ROUTING TEXT SPECIFIED # 
        CONTROL ENDIF;
  
        CONTROL IFEQ OS$NOS;
          DSPIADR = LOC(DSPXILC); 
        CONTROL ENDIF;
  
          END 
  
        IF FILEERT NE 0            # IF EXPLICIT TEXT AVAILABLE # 
        THEN
          BEGIN                    # THEN MOVE EXPLICIT TEXT #
          P<DSPXPB> = P<DSPB> + DSPBLEN;
          TXTMOV(FILEERT,LOC(DSPXERTFWA),I);
          DSPXELC = I;             # LENGTH # 
  
        CONTROL IFEQ OS$NOSBE;
          DSPXPP = P<DSPXPB>; 
          DSPF16 = TRUE;
        CONTROL ENDIF;
  
        CONTROL IFEQ OS$NOS;
          DSPEADR = LOC(DSPXELC); 
        CONTROL ENDIF;
  
          END 
  
      CONTROL IFEQ OS$NOSBE;
        DSPFIDC = FILEJBN;         # JOB NAME # 
        IF FILEINT                 # IF INPUT FILE #
          AND FILELIDSH            #   AND STORE-FORWARD TRANSFER # 
        THEN
          BEGIN 
          DSPF5   = TRUE;          # FID SPECIFIED #
          DSPF6   = CCOUNT(DSPFIDC) NE 7; # FID=* IF NOT 7-CHAR FID # 
          DSPIF44 = NOT DSPF6;     # 7-CHAR FID ON INPUT FILE # 
          END 
  
        IF NOT FILEINT             # IF OUTPUT FILE # 
        THEN
          BEGIN 
          DSPF5   = TRUE;          # FID SPECIFIED #
          DSPF6   = CCOUNT(DSPFIDC) NE 7; # FID=* IF NOT 7-CHAR FID # 
          DSPF9   = TRUE;          # PRIORITY SPECIFIED # 
          DSPBB   = TRUE;          # FORCED PRIORITY #
          DSPPRI  = FILEPRI;
          IF FILEDAYF              # IF DAYFILE ATTACHED #
          THEN
            BEGIN 
            DSPF13  = TRUE; 
            DSPDAYF = TRUE; 
            END 
  
          END 
  
        IF FILETID NE 0            # IF TID SPECIFIED # 
        THEN
          BEGIN 
          DSPF2   = TRUE; 
          DSPTID  = FILETID;
          END 
  
        ELSE
          BEGIN 
          IF CCOUNT(FILEDUNC) EQ 2
          THEN
            BEGIN 
            DSPTIDC = FILEDUNC; 
            DSPF2   = TRUE; 
            END 
  
          END 
  
        IF FILEIDDC NE "  "        # IF DSP-DD NEEDS TO BE SAVED #
        THEN
          BEGIN 
          P<DSPXPB> = P<DSPB> + DSPBLEN;
          DSPXPP  = P<DSPXPB>;
          DSPXDDC = FILEIDDC; 
          DSPF16  = TRUE;          # EXTENDED BLOCK PRESENT # 
          END 
  
      CONTROL ENDIF;
  
      CONTROL IFEQ OS$NOS;
        DSPFOT  = TRUE;            # ORIGIN TYPE SPECIFIED #
        DSPF13  = TRUE;            # UJN SPECIFIED #
        DSPF6   = TRUE;            # EXTENDED BLOCK PRESENT # 
        DSPUJNC = FILEJBN;
        IF FILECHGU NE 0           # IF CHARGE NUMBER AVAILABLE # 
        THEN
          BEGIN 
          DSPEF10 = TRUE; 
          DSPCHGU = FILECHGU; 
          DSPPJ1U = FILEPJ1U; 
          DSPPJ2U = FILEPJ2U; 
          END 
  
        DSPEF3  = TRUE;            # SUBSYSTEM CALL # 
        DSPSCLF = IGSCLEF;         # SET SCL ERROR IGNORE FLAG #
        IF FILEIDDC NE "  "        # IF DSP-DD NEEDS TO BE SAVED #
        THEN
          BEGIN 
          DSPDD = FILEIDDC; 
          DSPEF0 = TRUE;           # DSP-DD SPECIFIED # 
          END 
  
        IF FILEPW NE 0             # IF ENCRYPTED BATCH PASSWORD #
        THEN
          BEGIN 
          DSPPWF = TRUE;
          DSPPW = FILEPW;          # ENCRYPTED BATCH PASSWORD # 
          END 
  
        IF FILEPI NE 0             # IF PRINT IMAGE SPECIFIED # 
        THEN
          BEGIN 
          DSPPI   = FILEPI; 
          END 
  
        IF FILEINT                 # IF INPUT FILE #
        THEN
          BEGIN 
          DSPOT = BCOT;            # ASSUME BATCH ORIGIN #
          IF FILEDUN NE 0          # IF DUN SPECIFIED # 
            OR FILEDFM NE 0        # OR DESTINATION FAMILY SPECIFIED #
          THEN
            BEGIN 
            DSPOT = EIOT;          # SET REMOTE BATCH ORIGIN #
            END 
  
          IF FILESCLU NE 0         # IF SERVICE CLASS SPECIFIED # 
          THEN
            BEGIN 
            DSPSCL  = FILESCL;     # SERVICE CLASS #
            DSPS = TRUE;
            END 
  
          END 
  
        ELSE                       # OUTPUT FILE #
          BEGIN 
          IF FILEORG EQ 0          # IF ORIGIN TYPE NOT SPECIFIED # 
          THEN
            BEGIN 
            IF FILEDUN EQ 0        # IF DESTINATION USER NOT SPECIFIED #
              AND FILEDFM EQ 0     # AND NO DESTINATION FAMILY #
            THEN
              BEGIN 
              DSPOT = BCOT;        # SET TO BATCH ORIGIN TYPE # 
              END 
  
            ELSE
              BEGIN 
              DSPOT = EIOT;        # ELSE SET TO REMOTE BATCH # 
              END 
  
            END 
  
          ELSE
            BEGIN 
            DSPOT = FILEORG-1;     # SET ORIGIN TYPE #
            END 
          DSPSCL = FILESCL;        # SET SERVICE CLASS #
          DSPS = TRUE;
          IF FILECUN EQ 0          # IF NO CREATION USER NAME # 
          THEN
            BEGIN 
            IF FILEDUN EQ 0        # IF NO DESTINATION USER # 
              AND FILEDFM EQ 0     # AND NO DESTINATION FAMILY #
            THEN
              BEGIN 
              DSPSCL = BCSC;       # SET BATCH SERVICE CLASS #
              END 
  
            ELSE
              BEGIN 
              DSPSCL = RBSC;       # SET REMOTE BATCH SERVICE CLASS # 
              END 
  
            END 
  
          ELSE
            BEGIN 
            IF FILESCLU EQ 0       # IF NO SERVICE CLASS SPECIFIED #
            THEN
              BEGIN 
              DSPSCL = DFSC;       # SET DEFAULT SERVICE CLASS #
              END 
  
            END 
  
          END 
  
        IF FILEDUN NE 0            # IF DESTINATION UN SPECIFIED #
          OR FILEDFM NE 0          # OR DESTINATION FAMILY SPECIFIED #
        THEN
          BEGIN 
          DSPF2   = TRUE;          # TID SPECIFIED #
          DSPTID  = LNO(LOC(DSPWDTID)); 
          DSPDFMC = FILEDFMC; 
          DSPDUNC = FILEDUNC; 
          END 
  
        ELSE
          BEGIN 
          IF FILEID NE 0           # IF BATCH ID SPECIFIED #
          THEN
            BEGIN 
            DSPTID  = FILEID; 
            DSPF2   = TRUE; 
            DSPF1   = TRUE;        # CENTRAL SITE # 
            END 
  
          END 
  
        IF NOT FILEINT             # IF OUTPUT FILE # 
          AND (FILECUN NE 0)       # AND CREATION UN SPECIFIED #
        THEN
          BEGIN 
          DSPCFMC = FILECFMC; 
          DSPCUNC = FILECUNC; 
          DSPEF2  = TRUE; 
          END 
  
        IF FILEOUN NE 0            # IF OWNER UN SPECIFIED #
        THEN
          BEGIN 
          DSPOFMC = FILEOFMC; 
          DSPOUNC = FILEOUNC; 
          DSPEF1  = TRUE;          # OUN SPECIFIED #
          END 
  
      CONTROL ENDIF;
  
        CALLSYS(DSP);              # ROUTE FILE TO QUEUE #
        RETRY = FALSE;             # ASSUME NO RETRY POSSIBLE # 
        IF DSPER NE 0              # IF DSP RETURNED ERROR CODE # 
        THEN
          BEGIN 
          DSPERR$ORD[0] = DSPER;
          I = MAXDSPERR;
          ASLONGAS DSPER NE DSPERR$ORD[I] 
          DO
            BEGIN 
            I = I - 1;             # SEARCH TABLE OF KNOWN ERROR CODES #
            END 
  
          WORDC10 = XCOD(DSPER);   # CONVERT BINARY TO OCTAL #
          EMSGROEERR = WORDR2;
          EMSGROETXT = DSPERR$TXT[I]; 
          GOTO DSPORDS[DSPERR$TYP[I]]; # SIMULATED CASE STATEMENT # 
  
SWI$REJECT: 
            FILESTX = STO$REJECT; 
            GOTO SWI$END; 
  
SWI$SECURE: 
            FILESTX = STO$SECURE; 
            GOTO SWI$END; 
  
SWI$TEMP: 
            FILESTX = STO$RETRY;
            GOTO SWI$END; 
  
CONTROL IFEQ OS$NOSBE;
SWI$BADSCL: 
            ABORTQ("QUEFIL");       # INTERNAL ERROR #
CONTROL ENDIF;
  
CONTROL IFEQ OS$NOS;
SWI$BADSCL: 
            FILESTX = STO$REJECT;   # REJECT FILE # 
            GOTO SWI$END; 
CONTROL ENDIF;
  
SWI$END:         # END OF SIMULATED CASE STATEMENT #
          IF NOT RETRY             # IF RETRY NOT POSSIBLE #
          THEN
            BEGIN 
            FILECER = TRUE;        # SET ERROR FLAG # 
            RMTLOG(LOC(EMSGROE),LEMSGROE);
            END 
  
          END                      # DSP ERROR #
  
        ELSE                       # ROUTE SUCCESSFUL # 
          BEGIN 
          EMSGQUJN = XSFW(DSPLFNC); 
          EMSGQUPI = FILECPDC;
          CONLOG(LOC(EMSGQUF),LEMSGQUF);
          FILEJBN = DSPLFNC;
          END 
  
        END                        # ASLONGAS RETRY # 
  
      P<DSPB> = FREECMM(P<DSPB>);  # RELEASE CMM BLOCK #
  
      END  # QUEFIL # 
    TERM
