*DECK FCSCCCS 
USETEXT TEXTFCS;
      PROC FCSCCCS; 
*CALL COPYRITE
# TITLE FCSCCCS - PROCESS CHANGE_CODE_SET COMMAND.                     #
  
      BEGIN                            # FCSCCCS                       #
  
# 
**    FCSCCCS - PROCESS CHANGE_CODE_SET COMMAND.
* 
*     J. E. ESLER                      93/10/28 
* 
*     THIS PROCEDURE PROCESSES THE CHANGE_CODE_SET COMMAND. 
* 
*     PROC FCSCCCS
* 
*     ENTRY   PARMS[1]   = NEW CODE SET.
*             PARMS[2]   = STATUS VARIABLE (IGNORED). 
*             FTPDCSET   = DEFAULT CODE SET 
* 
*     EXIT    FTPERROR   = TRUE IF PROTOCOL ERROR DETECTED. 
*             FTPFAIL    = TRUE IF COMMAND FAILURE DETECTED.
*             FTPUSERE   = TRUE IF USER ERROR DETECTED. 
*             FTPDCSET   = DEFAULT CODE SET 
* 
*     METHOD  CHECK FOR REMOTE CONNECTION.
*             SEND *SITE* COMMAND TO LOCAL HOST.
*             WAIT FOR REPLY FOM LOCAL HOST.
* 
# 
  
# 
****  PROC FCSCCCS - XREF LIST
# 
      XREF
        BEGIN 
        PROC FCSNODB;                  # OUTPUT DATA BLOCK             #
        PROC FCSNWFR;                  # WAIT FOR FTP REPLY            #
        FUNC FCSUCRC B;                # CHECK FOR REMOTE CONNECTION   #
        PROC FCSUCRE;                  # COPY FTP REPLY TO ERROR BUFFER#
        PROC NETUCAS;                  # COPY AN ASCII STRING          #
        END 
# 
****
# 
      ITEM CSEQUALS      U = X"2043533D0000000";
CONTROL EJECT;
# 
*     START MAIN PROCEDURE
# 
      IF NOT FCSUCRC
      THEN
        BEGIN                          # NO REMOTE CONNECTION EXISTS   #
        RETURN;                        # GET OUT OF HERE QUICKLY       #
        END 
# 
*     CHECK IF CHANGING TO SAME CODE SET. 
# 
      IF PARAMNB[1] EQ FTPDCSET 
      THEN
        BEGIN                          # CHANGING TO CURRENT CODE SET  #
        RETURN;                        # GET OUT OF HERE QUICKLY       #
        END 
# 
*     SEND *SITE* COMMAND TO LOCAL HOST.
# 
      OUTLEN = AIPIHDR$;               # INITIALIZE OUTPUT LENGTH      #
      NETUCAS (FTPCSITE, 0, 4,         # COPY *SITE* FTP COMMAND       #
               OUTBUF, OUTLEN); 
      NETUCAS (CSEQUALS, 0, 4,         # COPY * CS=* PARAMETER KEYWORD #
               OUTBUF, OUTLEN); 
      NETUCAS (PARMS[1], 0, PARAMSZ[1],# COPY PARAMETER VALUE          #
               OUTBUF, OUTLEN); 
      FCSNODB (AIPISC, LOCALID);       # SEND TO LOCAL HOST            #
      FCSNWFR (LOCALID);               # WAIT FOR FTP REPLY            #
      IF (FTPRPYC1 NQ 2)
      THEN
        BEGIN                          # PROTOCOL ERROR DETECTED       #
        FTPERROR = TRUE;               # SET FTP ERROR FLAG            #
        FCSUCRE;                       # COPY FTP REPLY TO ERROR BUFFER#
        END 
      ELSE
        BEGIN 
        FTPDCSET = PARAMNB[1];         # SAVE DEFAULT CODE SET         #
        FTPDCSAS = PARAM[1];
        FTPDCSSZ = PARAMSZ[1];
        END 
  
      RETURN;                          # RETURN TO CALLER              #
  
      END                              # FCSCCCS                       #
  
      TERM
