Note: To save this file onto your PC, use your browser's "File, Save as file"
menu option.

/*********************************************************************/
/*                                                                   */
/*  THIS FILE CONTAINS 3 PARTS:                                      */
/*    1. SOURCE FOR COMMAND CPYTOSAVF                                */
/*    2. SOURCE FOR CL PROGRAM CPYTOSAVF                             */
/*    3  SOURCE FOR RPG PROGRAM CPY2SAVF                             */
/*                                                                   */
/*  COPY EACH PART TO A DIFFERENT SOURCE MEMBER AND COMPILE EACH     */
/*  ONE, USING THE COMMAND DEFAULTS.                                 */
/*                                                                   */
/*********************************************************************/
             CMD        PROMPT('Copy To Save File')

             PARM       KWD(FROMFILE) TYPE(FROMFILE) MIN(1) +
                          PROMPT('From source file' 1)
 FROMFILE:   QUAL       TYPE(*NAME)
             QUAL       TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
                          (*CURLIB)) PROMPT('Library')

             PARM       KWD(SAVF) TYPE(SAVF) MIN(1) PROMPT('To save +
                          file' 3)
 SAVF:       QUAL       TYPE(*NAME)
             QUAL       TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
                          (*CURLIB)) PROMPT('Library')

             PARM       KWD(FROMMBR) TYPE(*NAME) DFT(*FIRST) +
                          SPCVAL((*FIRST)) PROMPT('From source +
                          member' 2)
             PARM       KWD(REPLACE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
                          DFT(*NO) SPCVAL((*YES) (*NO)) +
                          PROMPT('Replace existing save file')

/****************************************************************/
/*                                                              */
/* PURPOSE.. COPY TO SAVE FILE (COMMAND PROCESSING PROGRAM)     */
/* AUTHOR... BUG BUSTERS SOFTWARE ENGINEERING                   */
/* DATE.....  6/04/97                                           */
/*                                                              */
/****************************************************************/
             PGM        PARM(&QFILE &QSAVF &MBR &REPLACE)
             DCL        VAR(&QSAVF) TYPE(*CHAR) LEN(20)
             DCL        VAR(&SAVF) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SAVFL) TYPE(*CHAR) LEN(10)
             DCL        VAR(&QFILE) TYPE(*CHAR) LEN(20)
             DCL        VAR(&FILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FILEL) TYPE(*CHAR) LEN(10)
             DCL        VAR(&MBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TEXT) TYPE(*CHAR) LEN(50)
             DCL        VAR(&REPLACE) TYPE(*CHAR) LEN(4)
/********************************************************************** RDMON1*/
/* GLOBAL MESSAGE MONITOR DECLARES                                    * RDMON1*/
/********************************************************************** RDMON1*/
             DCL        VAR(&##MSGFLIB) TYPE(*CHAR) LEN(10) /* +
                          Message File Library */
             DCL        VAR(&##MSGF) TYPE(*CHAR) LEN(10) /* Message +
                          File */
             DCL        VAR(&##MSGID) TYPE(*CHAR) LEN(7) /* Message +
                          ID */
             DCL        VAR(&##MSGDTA) TYPE(*CHAR) LEN(256) /* +
                          Message data */
/****************************************************************/
/*   GLOBAL MESSAGE MONITOR                                     */
/****************************************************************/
             MONMSG     MSGID(CPF0000 RPG0000 QRG0000 MCH0000) +
                          EXEC(GOTO CMDLBL(##ERROR))
             GOTO       CMDLBL(##NOERROR)
##ERROR:     RCLRSC
             MONMSG     MSGID(CPF0000 MCH0000) /* Just in case */
             RCVMSG     MSGTYPE(*EXCP) MSGDTA(&##MSGDTA) +
                          MSGID(&##MSGID) MSGF(&##MSGF) +
                          MSGFLIB(&##MSGFLIB)
             MONMSG     MSGID(CPF0000 MCH0000) /* Just in case */
             SNDPGMMSG  MSGID(&##MSGID) MSGF(&##MSGFLIB/&##MSGF) +
                          MSGDTA(&##MSGDTA) TOPGMQ(*PRV) +
                          MSGTYPE(*ESCAPE)
             MONMSG     MSGID(CPF0000 MCH0000) /* Just in case */
             RETURN
##NOERROR:
/****************************************************************/
/*   SPLIT QUALIFIED PARMS                                      */
/****************************************************************/
             CHGVAR     VAR(&SAVF) VALUE(%SST(&QSAVF 1 10))
             CHGVAR     VAR(&SAVFL) VALUE(%SST(&QSAVF 11 10))
             CHGVAR     VAR(&FILE) VALUE(%SST(&QFILE 1 10))
             CHGVAR     VAR(&FILEL) VALUE(%SST(&QFILE 11 10))
/****************************************************************/
/*   GET SOURCE MEMBER TEXT                                     */
/****************************************************************/
             RTVMBRD    FILE(&FILEL/&FILE) MBR(&MBR) TEXT(&TEXT)
/****************************************************************/
/*   CREATE SAVE FILE IF NECESSARY                              */
/****************************************************************/
             CHKOBJ     OBJ(&SAVFL/&SAVF) OBJTYPE(*FILE)

             MONMSG     MSGID(CPF9801) EXEC(DO)
             CRTSAVF    FILE(&SAVFL/&SAVF) TEXT(&TEXT) AUT(*USE)
             ENDDO
/****************************************************************/
/*   HANDLE REPLACE(*YES)                                       */
/****************************************************************/
             IF         COND(&REPLACE = '*YES') THEN(DO)
             CLRSAVF    FILE(&SAVFL/&SAVF)
             MONMSG     MSGID(CPF0000)
             ENDDO
/****************************************************************/
/* COPY IT                                                      */
/****************************************************************/
             OVRDBF     FILE(INPUT) TOFILE(&FILEL/&FILE) MBR(&MBR)
             OVRSAVF    FILE(OUTPUT) TOFILE(&SAVFL/&SAVF)
             CALL       PGM(CPY2SAVF)

RETURN
ENDPGM


     ******************************************************************
      *                                                              *
      *  PURPOSE: COPY TO A SAVE FILE                                *
      *  DATE:     6/03/97                                           *
      *  AUTHOR:  BUG BUSTERS SOFTWARE ENGINEERING                   *
      *                                                              *
      *                                                              *
     ******************************************************************
     FINPUT   IF  F     540            DISK
     FOUTPUT  O   F     528            DISK
     C**************************************************
     C* INPUT SPECS
     C**************************************************
     IINRCD       DS                            540
     IOUTRCD      DS                            528
     C**************************************************
     C* MAINLINE
     C**************************************************
     C                     READ INPUT     INRCD          98
     C*
     C           *IN98     DOWNE*ON
     C                     MOVE INRCD     OUTRCD
     C                     WRITEOUTPUT    OUTRCD
     C                     READ INPUT     INRCD          98
     C                     ENDDO
     C*
     C                     SETON                     LR
     C                     RETRN
     C**************************************************