*DECK SENDCLF 
USETEXT COMCBEG 
USETEXT COMCAPR 
USETEXT COMQDEF 
USETEXT COMQDSP 
USETEXT COMQFIL 
    PROC SENDCLF; 
      BEGIN    # SENDCLF #
# 
**    SENDCLF    SEND CONNECTION LOG FILE TO USER.
* 
*     SENDCLF IS CALLED TO SEND THE CONNECTION LOG FILE BACK TO 
*     THE SOURCE HOST/TERMINAL/USER IF POSSIBLE IF ANY PERMANENT
*     ERROR PREVENTS QTF FROM SUCCESSFULLY QUEUEING THE FILE ON 
*     THE REQUESTED DESTINATION HOST. 
* 
*     ENTRY      FILETAB = AFT ENTRY. 
*                FILECLF = FWA OF LOG FILE FET. 
* 
*     EXIT       LOG FILE ROUTED. 
*                FILEUER = FALSE. 
* 
*     PROCESS    CALL DSPQFIL TO EVICT QUEUE FILE.
*                FLUSH LOG FILE BUFFER. 
*                IF NO SOURCE LID OR SOURCE EQ DESTINATION: 
*                  LID = HOST PID 
*                ELSE:  
*                  LID = SOURCE LID.
*                IF NOS/BE: 
*                  CREATE DUMMY INPUT FILE
*                  DSP-SOURCE-LID = LID 
*                  DSP-PREDAYFILE = LOG FILE
*                  CALL DSP TO ROUTE TO INPUT QUEUE WITH PRE-ABORT. 
*                IF NOS:  
*                  DSP-DESTINATION-LID = LID
*                  CALL DSP TO ROUTE TO PRINT QUEUE.
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC CALLSYS;              # ISSUE SYSTEM REQUEST # 
        FUNC CHKCMM     U;         # GET CMM BLOCK #
        PROC CONLOG;               # LOG CONNECTION MESSAGE # 
        PROC DSPQFIL;              # EVICT QUEUE FILE # 
        FUNC FREECMM    U;         # RELEASE CMM BLOCK #
        PROC NAME;                 # DEBUG CODE # 
        PROC REQQDEV;              # REQUEST QUEUE DEVICE # 
        PROC RTNFIL;               # EVICT FILE # 
        PROC TXTMOV;               # GET ROUTING TEXT # 
        PROC WRITEC;               # WRITE CODED LINE # 
        PROC WRITEF;               # WRITE END-OF-FILE #
        FUNC XCOD       C(10);     # CONVERT TO OCTAL DISPLAY CODE #
        FUNC XSFW       C(10);     # CONVERT ZEROS TO BLANKS #
        END 
  
# 
****  XREF END
# 
  
  
      ARRAY DUMJOB     S(1);
        BEGIN 
        ITEM DUMJOBLFN  C(00,00,07);
        ITEM $DDUMJA    C(00,42,01) = ["."];
        ITEM $DDUMJB    U(00,48,12) = [ 0 ];
        END 
  
      DEF LEMSGCLD   #42#;
      ARRAY EMSGCLD    S(5);
        BEGIN 
        ITEM $DCLD      C(00,00,LEMSGCLD) = 
                 ["LOG FILE NOT SENT - DSP ERROR CODE = XXXB."];
        ITEM EMSGCLDEC  C(03,42,03);
        END 
  
      ARRAY            S(1);
        BEGIN 
        ITEM WORDC      C(00,00,10);
        ITEM WORDR3     C(00,42,03);
        END 
  
      ITEM LID        U;
      ITEM CLFBLK     U;
      ITEM I          U;
      ITEM TMPLFNC    C(7); 
  
        $BEGIN
        NAME("SENDCLF");
        $END
  
      TMPLFNC = FILEQFNC;          # SAVE FILE NAME # 
      FILEANW = TRUE;              # EVICT FILE # 
      DSPQFIL;
      FILEUER = FALSE;
      FILECER = FALSE;
      IF FILECLF NE 0 
      THEN
        BEGIN 
        P<FET> = FILECLF; 
        WRITEF(FET, 1);            # FLUSH FET #
        IF (FILESLD EQ 0) 
          OR (FILESLD EQ FILELID) 
        THEN
          BEGIN 
          LID = HD;                # SEND TO THIS HOST #
          END 
  
        ELSE
          BEGIN 
          LID = FILESLD;           # SEND TO SOURCE HOST #
          END 
  
      CONTROL IFEQ OS$NOSBE;
        CLFBLK = CHKCMM(0,CLFCMMLNG); 
        P<FET> = CLFBLK + CLFFETLNG;
        FOR I = 1 STEP 1 UNTIL CLFFETLNG
        DO
          BEGIN 
          P<FET> = P<FET> - 1;
          FETWD = 0;
          END 
  
        FETLFNC = "DUMMYLF";
        FETCOMP = TRUE; 
        FETFETL = CLFFETLNG - 5;
        FETFIR  = CLFBLK + CLFFETLNG; 
        FETIN   = FETFIR; 
        FETOUT  = FETFIR; 
        FETLIM  = FETFIR + CLFBUFFER; 
        REQQDEV(FETLFNC, TRUE); 
        DUMJOBLFN = XSFW(TMPLFNC);
        WRITEC (FET, DUMJOB);      # WRITE DUMMY JOB STATEMENT #
        WRITEF (FET, 1);           # FLUSH FET #
        CLFBLK = CHKCMM(CLFBLK,DSPBLEN+DSPXPBL);
        P<DSPB> = CLFBLK; 
        DSPADR = CLFBLK;
        SLOWFOR I = 1 STEP 1 UNTIL DSPBLEN+DSPXPBL
        DO
          BEGIN 
          P<FET> = I + CLFBLK - 1;
          FETWD = 0;
          END 
  
        DSPLFNC = "DUMMYLF";
        DSPDIS  = "IN";            # ROUTE TO INPUT # 
        DSPIF46 = TRUE;            # PRE-ABORT JOB #
        DSPIF44 = TRUE;            # SEVEN-CHARACTER FID #
        DSPIF43 = TRUE;            # IGNORE JOB CARD ERROR #
        DSPF11  = TRUE;            # PREDAYFILE SPECIFIED # 
        DSPF5   = TRUE;            # USE FID #
        DSPF4   = TRUE;            # DC SPECIFIED # 
        DSPF3   = TRUE;            # DID/SID #
        DSPSID  = LID;             # SOURCE LID # 
        DSPDID  = HD;              # DESTINATION LID #
        IF FILETID NE 0 
        THEN
          BEGIN 
          DSPTID = FILETID; 
          DSPF2  = TRUE;
          END 
  
        DSPFIDC = TMPLFNC;
        P<FET> = FILECLF; 
        DSPPDF = FETLFNC;          # PREDAYFILE LFN # 
        IF FILEIRT NE 0 
        THEN
          BEGIN 
          DSPF16 = TRUE;
          P<DSPXPB> = P<DSPB> + DSPBLEN;
          DSPXPP = P<DSPXPB>; 
          TXTMOV(FILEIRT, LOC(DSPXIRTFWA), I);
          DSPXILC = I;
          END 
  
      CONTROL ENDIF;
  
      CONTROL IFEQ OS$NOS;
        CLFBLK = CHKCMM(CLFBLK,DSPBLEN+IRTLEN+1); 
        P<DSPB> = CLFBLK; 
        DSPADR = CLFBLK;
        SLOWFOR I = 1 STEP 1 UNTIL DSPBLEN+IRTLEN+1 
        DO
          BEGIN 
          P<FET> = I + CLFBLK - 1;
          FETWD = 0;
          END 
  
        P<FET> = FILECLF; 
        DSPLFNC = FETLFNC;         # LOG FILE LFN # 
        DSPFOT  = TRUE;            # FORCE ORIGIN TYPE #
        DSPOT   = FILEORG-1;       # USE FILE ORIGIN TYPE # 
        DSPS    = TRUE;            # SERVICE CLASS SPECIFIED #
        DSPSCL  = FILESCL;         # SERVICE CLASS #
        IF (FILEDCC EQ "TO")       # IF TERMINAL WAIT QUEUE # 
          OR (FILEDCC EQ "TT")
          OR (FILEDCC EQ "WT")
        THEN
          BEGIN 
          DSPDIS = "TT";           # SEND LOG FILE TO WAIT QUEUE #
          END 
  
        ELSE
          BEGIN 
          DSPDIS = "PR";           # ELSE SEND TO PRINT QUEUE # 
          END 
  
        DSPF17  = TRUE;            # RETURN JOB NAME #
        DSPF13  = TRUE;            # USE UJN #
        DSPF12  = TRUE;            # RETURN ERROR CODE #
        DSPF6   = TRUE;            # EXTENDED BLOCK PRESENT # 
        DSPF4   = TRUE;            # DC SPECIFIED # 
        DSPF3   = TRUE;            # SID/DID #
        DSPSID  = HD;              # SOURCE LID # 
        DSPDID  = LID;             # DESTINATION LID #
        IF FILEDUN NE 0            # IF DESTINATION UN #
          OR FILEDFM NE 0          # OR DESTINATION FAMILY SPECIFIED #
        THEN
          BEGIN 
          DSPTID  = LNO(LOC(DSPWDTID)); 
          DSPF2  = TRUE;
          DSPDFMC = FILEDFMC; 
          DSPDUNC = FILEDUNC; 
          END 
  
        DSPUJNC = FILEUJNC; 
        DSPEF3  = TRUE;            # SUBSYSTEM CALL # 
        IF FILEOUN NE 0            # IF OWNER UN AVAILABLE #
        THEN
          BEGIN 
          DSPOUNC = FILEOUNC; 
          DSPOFMC = FILEOFMC; 
          DSPEF1 = TRUE;           # OUN SPECIFIED #
          END 
  
        IF FILECUN NE 0            # IF CREATION UN AVAILABLE # 
        THEN
          BEGIN 
          DSPCUNC = FILECUNC; 
          DSPCFMC = FILECFMC; 
          DSPEF2 = TRUE;           # CUN SPECIFIED #
          END 
  
        IF FILEIRT NE 0            # IF IMPLICIT TEXT # 
        THEN
          BEGIN 
          P<DSPXPB> = P<DSPB> + DSPBLEN;
          DSPIADR = P<DSPXPB>;
          TXTMOV(FILEIRT, LOC(DSPXIRTFWA), I);
          DSPXILC = I;
          END 
  
      CONTROL ENDIF;
  
        CALLSYS (DSP);
        FILECLF = FREECMM(FILECLF); 
        IF DSPER NE 0              # IF ROUTE FUNCTION ERROR #
        THEN
          BEGIN 
          WORDC = XCOD(DSPER);
          EMSGCLDEC = WORDR3; 
          RTNFIL(DSPLFNC, TRUE);   # EVICT LOG FILE # 
          CONLOG(LOC(EMSGCLD),LEMSGCLD);
          END 
  
        CLFBLK = FREECMM (CLFBLK);
        END 
  
      END  # SENDCLF #
    TERM
