Easily send source file member to a remote system

This quick "SNDSRC" utility, evoked from PDM user defined options, sends source file member to a remote system.

   
DSPF - SNDSRCD

       A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT
     A          R SNDFMT
     A                                      CF03(03 'EXIT')
     A                                      CF12(12 'CANCEL')
     A                                      OVERLAY
     A                                  1 32'Send Source Member'
     A                                      DSPATR(HI)
     A                                  3  2'From File . . . . . . . :'
     A            FRMFIL        10A  O  3 30
     A                                  4  4'From Library. . . . . :'
     A            FRMLIB        10A  O  4 32
     A                                  7  2'Type the file name, library, and s-
     A                                      ystem to receive the source member.'
     A                                      COLOR(BLU)
     A                                  9  4'To File . . . . . . . :'
     A            TOFIL         10A  B  9 30
     A  50                                  DSPATR(PC)
     A  50                                  DSPATR(RI)
     A                                 10  6'To Library  . . . . :'
     A            TOLIB         10A  B 10 32
     A  51                                  DSPATR(RI)
     A  51                                  DSPATR(PC)
     A                                  5  8'From System . . . :'
     A            TOSYS          8A  B 11 34
     A  52                                  DSPATR(RI)
     A  52                                  DSPATR(PC)
     A                                 13  2'To rename copied member, type New -
     A                                      Name, press Enter.'
     A                                      COLOR(BLU)
     A                                 15  2'Member'
     A                                      DSPATR(HI)
     A                                 15 17'New Name'
     A                                      DSPATR(HI)
     A            FRMMBR        10A  O 16  2
     A            TOMBR         10A  B 16 17
     A  53                                  DSPATR(RI)
     A  53                                  DSPATR(PC)
     A                                 11  8'To System . . . . :'
     A            FRMSYS         8A  O  5 34
     A          R MSGSFL                    SFL
     A                                      SFLMSGRCD(24)
     A            MSGKEY                    SFLMSGKEY
     A            PGMQ                      SFLPGMQ(10)
     A*/
     A          R MSGCTL                    SFLCTL(MSGSFL)
    A                                      OVERLAY
     A                                      SFLSIZ(0050)
     A                                      SFLPAG(0001)
     A                                      SFLDSP
     A                                      SFLDSPCTL
     A                                      SFLINZ
     A N99                                  SFLEND
     A            PGMQ                      SFLPGMQ(10)
     A                                 23  2'F3=Exit'
     A                                      COLOR(BLU)
     A                                 23 11'F12=Cancel'
     A                                      COLOR(BLU)

------------------------------
CLP - SNDSRC

/*------------------------------------------------------------------*/
/* PROGRAM NAME: SNDSRC                                             */
/* DATE WRITTEN: 04/24/2003                                         */
/* AUTHOR......: RICHARD CRANSTON                                   */
/* FUNCTION....: THIS IS USED TO SEND A SOURCE FILE FROM A          */
/*               SOURCE SYSTEM TO A TARGET SYSEM                    */
/*                                                                  */
/* NOTE........: THIS IS CALLED FROM PDM USER OPTION.               */
/*                   EX: CALL PGM(QGPL/SNDSRC) PARM(&F &L &N)       */
/*               THE TARGET SOURCE FILE MUST HAVE QUSER *AUTHORITY  */
/*------------------------------------------------------------------*/

             PGM        PARM(&FRMFIL &FRMLIB &FRMMBR)

             DCLF       FILE(SNDSRCD) RCDFMT(*ALL)

/*------------------------------------------------------------------*/
/* DEFINE ERROR VARIABLES                                           */
/*------------------------------------------------------------------*/
             DCL        VAR(&ERRORSW) TYPE(*LGL)
             DCL        VAR(&MSGID)   TYPE(*CHAR) LEN(7)
             DCL        VAR(&MSGDTA)  TYPE(*CHAR) LEN(100)
             DCL        VAR(&MSGF)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)

/*------------------------------------------------------------------*/
/* DEFINE AS400 SYSTEM NAMES VARIABLES (PUT YOUR AS400 SYSTEM NAMES HERE)                             */
/*------------------------------------------------------------------*/
             DCL        VAR(&SYSNM1) TYPE(*CHAR) LEN(8) +
                          VALUE('FIRST_SYSNAME')

             DCL        VAR(&SYSNM2) TYPE(*CHAR) LEN(8) +
                          VALUE('SECOND_SYSNAME')

/*------------------------------------------------------------------*/
/* GLOBAL MESSAGE MONITOR TO TRAP ANY UNMONITORED ERRORS            */
/*------------------------------------------------------------------*/
             MONMSG     (CPF9999 CPF0000 MCH0000) EXEC(GOTO ERROR)

/*------------------------------------------------------------------*/
/* SET DEFAULT VALUES                                               */
/*------------------------------------------------------------------*/
             CHGVAR     VAR(&TOFIL) VALUE(&FRMFIL)
             CHGVAR     VAR(&TOLIB) VALUE(&FRMLIB)
             CHGVAR     VAR(&TOMBR) VALUE(&FRMMBR)

             RTVNETA    SYSNAME(&FRMSYS)

             IF         COND(&FRMSYS *EQ &SYSNM1) THEN(CHGVAR +
                          VAR(&TOSYS) VALUE(&SYSNM2))

             IF         COND(&FRMSYS *EQ &SYSNM2) THEN(CHGVAR +
                          VAR(&TOSYS) VALUE(&SYSNM1))

/*------------------------------------------------------------------*/
/* BEGIN PROGRAM LOGIC                                              */
/*------------------------------------------------------------------*/
             CHGVAR     VAR(&PGMQ) VALUE('SNDSRC')
             RMVMSG     PGMQ(*SAME (&PGMQ)) CLEAR(*ALL)

 LOOP:       SNDF       RCDFMT(MSGCTL)
             SNDRCVF    RCDFMT(SNDFMT)
             RMVMSG     PGMQ(*SAME (&PGMQ)) CLEAR(*ALL)

             IF         COND((&IN03 *EQ '1') *OR (&IN12 *EQ '1')) +
                          THEN(GOTO CMDLBL(ENDPGM))

/*------------------------------------------------------------------*/
/* CREATE DDMF TO REMOTE SYSTEM                                     */
/*------------------------------------------------------------------*/
             CRTDDMF    FILE(QTEMP/DDMF) RMTFILE(&TOLIB/&TOFIL) +
                          RMTLOCNAME(&TOSYS)

/*------------------------------------------------------------------*/
/* COPY SOURCE MEMBER TO DDMF                                       */
/*------------------------------------------------------------------*/
             CPYF       FROMFILE(&FRMLIB/&FRMFIL) TOFILE(QTEMP/DDMF) +
                          FROMMBR(&FRMMBR) TOMBR(&TOMBR) +
                          MBROPT(*REPLACE) FMTOPT(*NOCHK)

/*------------------------------------------------------------------*/
/* DELETE THE TEMPORARY DDMFILE                                     */
/*------------------------------------------------------------------*/
             DLTF       FILE(QTEMP/DDMF)

             GOTO       CMDLBL(ENDPGM)

/*-------------------------------------------------------------------*/
/* GLOBAL ERROR HANDLING ROUTINE                                     */
/*-------------------------------------------------------------------*/
ERROR:

 STDERR1:
             IF         COND(&ERRORSW) THEN(SNDPGMMSG MSGID(CPF9999) +
                          MSGF(QCPFMSG) MSGTYPE(*ESCAPE))
             CHGVAR     VAR(&ERRORSW) VALUE('1')
 STDERR2:    RCVMSG     MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)
             IF         COND(&MSGID *EQ '       ') THEN(GOTO +
                          CMDLBL(STDERR3))
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
             GOTO       CMDLBL(LOOP)
 STDERR3:    RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
             GOTO       CMDLBL(LOOP)
/*-------------------------------------------------------------------*/
/* END PROGRAM                                                       */
/*-------------------------------------------------------------------*/
 ENDPGM:     RETURN
             ENDPGM