User:MrDolomite/SAVEANDIPL

From MidrangeWiki
Jump to: navigation, search
  • Created with Craig Rutledge's XMLPREVIEW family of utilities available here
  • No warranty, no deposit, no return, your mileage may vary.
  • Watchout for hardcode, kludges
  • Currently runs fine on V5R3
<?xml version="1.0" encoding="UTF-8"?>
<upload  appname=""  appauthor="Craig Rutledge"  appblddate=" 8/30/2006">
<install_instructions><![CDATA[
//---------------------------------------------------------------------------
*  1. Upload entire XML to your AS/400 to a source file 112 long, into any mbr
*     name not in this XML (suggest member name like ABCX or XYZX). The source
*     file must be in the library where source and objects are to be installed.
*
*  2. If you have XMLPREVIEW installed, skip to step 3.

*     Copy the text between the start tag <install_program> and the end
*     tag </install_program> into any member name (your choice)
*     in file QRPGLESRC member type RPGLE.   CRTBNDRPG to compile.
*     NOTE: You need extract the install program only once, this same program
*           will install any upload on this page.
*
*  3. Call the install program (or execute XmlPrevew) passing these 3 parms.
*       'your-member-name you uploaded this text into'
*       'your-source-file-name the member is in'
*       'your-library-name the source file is in'
*
*  The various source members will be extracted and the objects required
*   for the application will be created in your-library-name.
*
*  Members in this install: (to view or manually extract members, scan <mbr )
*   README     TXT
*   RESTRICTEC CLP
*   RESTRICTED CMD
*   SAVEANDIPC CLP
*   SAVEANDIPL CMD
*   SAVENOIPL  CMD
*   SAVENOIPLC CLP
*   SAVE21     CMD
*   SAVE21C    CLP        *WARNING* Hardcoded Tape Drive Device Name
*
//---------------------------------------------------------------------------
]]>  </install_instructions>
<install_program><![CDATA[
      * /// START OF INSTALL PGM HERE   ************************** ///
      //-------------------------------------------------------------
      // Parse / Install from xml text into source members and objects. v5r1
      // Use xml tags in text to trigger:
      // 1. Parse text into source members (create srcfile & member if required).
      // 2. Compile source into objects.
      // 3. Send installation progress user messages.
      // 4. Execute qcmdexc as required.
      //-------------------------------------------------------------
     Fxmlinput  if   f  112        disk    extfile(extIfile) extmbr(ParseSrcMbr)   uploaded text
     F                                     usropn
     Fqxxxsrc   o    f  112        disk    extfile(extOfile) extmbr(mbrname)       parsed out
     F                                     usropn
      //-------------------------------------------------------------
     D extIfile        s             21a
     D extOfile        s             21a
     D vrcvar          s            145a
     D qm_msgid        s              7a
     D qm_msgtxt       s             65a
     D qm_msgq         s             10a
     D qm_msgtyp       s             10a
     D mbrname         s             10a
     D mbrtype         s             10a
     D mbrtext         s             50a
     D srcfile         s             10a
     D srclen          s              5a
     D srccssid        s              5a
     D bldexc          s            500a
     D IsWrite         s               n   inz(*off)
     D srcSeqno        s              6s 2 inz(0)
     D aa              s              5u 0 inz(0)
     D ll              s              5u 0 inz(0)
     D qs              c                   ''''
      // Error return code parm for APIs.
     D vApiErrDs       ds
     D  vbytpv                       10i 0 inz(%size(vApiErrDs))                bytes provided
     D  vbytav                       10i 0 inz(0)                               bytes returned
     D  vmsgid                        7a                                        error msgid
     D  vresvd                        1a                                        reserved
     D  vrpldta                      50a                                        replacement data
      //-------------------------------------------------------------
     D qusrmbrd        PR                  ExtPgm('QUSRMBRD')                   MEMBER DESC
     Db                                    like(vrcvar)                         RCVR
     D                               10i 0 const                                RCVR LEN
     D                                8    const                                TYPE
     D                               20    const                                FILE   LIB
     D                               10                                         MBR NAME
     D                                1    const                                OVERRIDE?
     Db                                    like(vApiErrDS)
     D qmhsndpm        PR                  ExtPgm('QMHSNDPM')                   SEND MESSAGE
     D                                7                                         ID
     D                               20    const                                FILE
     Db                                    like(qm_msgtxt)                      TEXT
     D                               10i 0 const                                LENGTH
     D                               10    const                                TYPE
     D                               10                                         QUEUE
     D                               10i 0 const                                STACK ENTRY
     D                                4    const                                KEY
     Db                                    like(vApiErrDS)
     D  qcmdexc        PR                  ExtPgm('QCMDEXC')
     D                              500A   options(*varsize)
     D                               15P 5 Const
      //-----------------------------------------------
     Ixmlinput  ns
     I                                 13   21  xmltag1
     I                                 18   27  xmltag2
     I                                 13  112  xmlcode
      //-----------------------------------------------
     C     *entry        plist
     C                   parm                    ParseSrcMbr      10            source member
     C                   parm                    ParseSrcFile     10            source file
     C                   parm                    ParseSrcLib      10            source lib
      // xmlpreview uses this parm to redirect to user selected source file. optional
     C                   parm                    OvrSrcFile       10            override to source
      /free
       exsr  srValidate; //make sure exists
       // Set user selected library *first for remainder of program
       bldexc = 'RMVLIBLE LIB('+%trimr(ParseSrcLib) + ')';
       callp(e)  qcmdexc(bldexc:%len(%trimr(bldexc)));

       bldexc = 'ADDLIBLE LIB('+
       %trimr(ParseSrcLib) + ') POSITION(*FIRST)';
       callp(e)  qcmdexc(bldexc:%len(%trimr(bldexc)));

       // Override Input file to uploaded text file
       extIfile = %trimr(ParseSrcLib)+'/'+ParseSrcFile;
       open  xmlinput;
       read  xmlinput;
 1b    dow  not %eof;
          // write records to outfile if flag is on
 2b       if IsWrite;
 3b          if  xmltag2<>'</copysrc>';
                srcSeqno=srcSeqno+1;
                except  write_one;
 3x          else;
                IsWrite=*off;
                close  qxxxsrc;
 3e          endif;
             // Extract values based on xml tags.
 2x       elseif xmltag1 = 'mbrname =';
             mbrname = %subst(xmlcode:13:10);
 2x       elseif xmltag1 = 'mbrtype =';
             mbrtype =%subst(xmlcode:13:10);
 2x       elseif xmltag1 = 'mbrtext =';
             mbrtext =%subst(xmlcode:13:50);
 2x       elseif xmltag1 = 'srcfile =';
 3b          if  %parms=4;     //xmlpreview override
                srcfile=OvrSrcFile;
 3x          else;
                srcfile =%subst(xmlcode:13:10);
 3e          endif;
 2x       elseif xmltag1 = 'srclen  =';
 3b          if  %parms=4;      //xmlpreview override
                srclen='00112';
 3x          else;
                srclen  =%subst(xmlcode:13:5);
 3e          endif;
 2x       elseif xmltag1 = 'srccssid=';
             srccssid=%subst(xmlcode:13:5);
             // Start of data to copy.  Create source files/mbrs as required.
 2x       elseif xmltag1='<copysrc>';
             // crtsrcpf
             bldexc = 'CRTSRCPF FILE(' +
             %trimr(ParseSrcLib)+'/'+
             %trimr(srcfile) + ') RCDLEN(' +
             srclen + ') CCSID(' +
             srccssid + ')';
             callp(e)  qcmdexc(bldexc:%len(%trimr(bldexc)));
             // addpfm
             bldexc = 'ADDPFM   FILE(' +
             %trimr(ParseSrcLib)+'/'+
             %trimr(srcfile) + ') MBR(' +
             %trimr(mbrname) + ') SRCTYPE(' +
             %trimr(mbrtype) + ') TEXT(' +
             qs+%trimr(mbrtext)+qs + ')';
             callp(e)  qcmdexc(bldexc:%len(%trimr(bldexc)));
 3b          if  %error;
                // chgpfm
                bldexc = 'CHGPFM   FILE(' +
                %trimr(ParseSrcLib)+'/'+
                %trimr(srcfile) + ') MBR(' +
                %trimr(mbrname) + ') TEXT(' +
                qs+%trimr(mbrtext)+qs + ')';
                callp  qcmdexc(bldexc:%len(%trimr(bldexc)));
                // clr mbr
                bldexc = 'CLRPFM   FILE(' +
                %trimr(ParseSrcLib)+'/'+
                %trimr(srcfile) + ') MBR(' +
                %trimr(mbrname) + ')';
                callp  qcmdexc(bldexc:%len(%trimr(bldexc)));
 3e          endif;
             // ovr to outfile mbr
             extOfile=%trimr(ParseSrcLib) +'/'+srcfile;
             clear   srcSeqno;
             open  qxxxsrc;
             IsWrite = *on;
             // ------------------------------------------------------
             // Compile statement.  Read next record and execute it.
             // The subroutine srTolibToken will replace &tolib with the
             // library the user has selected at run time.
             // ------------------------------------------------------
 2x       elseif xmltag1 = '<compile>';
             read  xmlinput;
             bldexc = %trimr(xmlcode);
             exsr  srTolibToken;
             callp  qcmdexc(bldexc:%len(%trimr(bldexc)));
             // ------------------------------------------------------
             // qcmdexc statement. Build statement from each record between start
             // and stop tags.  When stop tag is found, execute statement.
             // if dltxxx command, allow errors to be ignored.
             // ------------------------------------------------------
 2x       elseif xmltag1 = '<qcmdexc>';
             clear   bldexc;
             aa=1;
             read  xmlinput;
 3b          dow  xmltag2<>'</qcmdexc>';
                %subst(bldexc:aa:100)=xmlcode;
                aa=aa+100;
                read  xmlinput;
 3e          enddo;
             exsr  srTolibToken;
 3b          if  %subst(bldexc:1:3)='DLT';
                callp(e)  qcmdexc(bldexc:%len(%trimr(bldexc)));
 3x          else;
                callp  qcmdexc(bldexc:%len(%trimr(bldexc)));
 3e          endif;
             // ------------------------------------------------------
             // Send messages to user as program executes
             // Extract message ID, Message Type, from <sendmsg>
             // read a record and get the single line of message text.
             // ------------------------------------------------------
 2x       elseif xmltag1 = '<sendmsg ';
             qm_msgid = %subst(xmlcode:22:7);
             qm_msgtyp = %subst(xmlcode:46:10);
             read  xmlinput;
             qm_msgq   = '*EXT   ';
 3b          if  qm_msgtyp='*COMP ';
                qm_msgq   = '*PGMBDY';
 3e          endif;
             qm_msgtxt = xmlcode;
             exsr  srSndMessage;
 2e       endif;
          read  xmlinput;
 1e    enddo;
       *inlr=*on;
       return;
       // ------------------------------------------------------
       // Replace &tolib (no matter how many times it is in string)
       // with whatever library the user has selected at run time.
       // ------------------------------------------------------
       begsr  srTolibToken;
       aa=%scan('&tolib':bldexc);
 1b    dow  aa>0;
          bldexc=%replace(%trimr(ParseSrcLib):bldexc:aa:6);
          aa=%scan('&tolib':bldexc);
 1e    enddo;
       // user has selected to override source, reset SRCFILE parm in bldexcs.
 1b    if  %parms=4;                        //xmlpreview override
          aa=%scan('SRCFILE(':bldexc);
 2b       if  aa>0;
             aa=%scan('/':bldexc:aa);
 3b          if  aa>0;
                ll=%scan(')':bldexc:aa);
                bldexc=%replace(%trimr(OvrSrcFile):bldexc:aa+1:ll-(aa+1));
 3e          endif;
 2e       endif;
 1e    endif;
       endsr;
       // ------------------------------------------------------
       // Check of file, lib, member exist.
       begsr  srValidate;
       callp  QUSRMBRD(vrcvar:145:'MBRD0100':
              ParseSrcFile + ParseSrcLib:ParseSrcMbr:
              '0':vapierrds);
       // ------------------------------------------------------
       // If error occurred on call, send appropriate message back to user.
 1b    if  vBytav>0;                                   //error occurred
 2b       if vmsgid = 'CPF9810';                     // lib not found
             qm_msgtxt = '0000 Library ' +
             %trimr(ParseSrcLib) + ' was not found.';
 2x       elseif vmsgid = 'CPF9812';                     // src file not found
             qm_msgtxt = '0000 Source file ' +
             %trimr(ParseSrcFile)+' was not found in ' +
             %trimr(ParseSrcLib) + '.';
 2x       elseif vmsgid = 'CPF9815';                     // member not found
             qm_msgtxt = '0000 Member ' +
             %trimr(ParseSrcMbr)+' was not found in ' +
             %trimr(ParseSrcLib)+'/'+ %trimr(ParseSrcFile);
 2x       else;                                        // unexpected
             qm_msgtxt = '0000 Unexpected message ' +
             vmsgid + ' received. ';
 2e       endif;
          // send message
          qm_msgid = 'CPD0006';
          qm_msgtyp = '*DIAG';
          qm_msgq   = '*CTLBDY';
          exsr  srSndMessage;
          qm_msgtxt = *blanks;
          qm_msgid = 'CPF0002';
          qm_msgtyp = '*ESCAPE';
          exsr  srSndMessage;
          *inlr=*on;
          return;
 1e    endif;
       endsr;
       // ------------------------------------------------------
       begsr  srSndMessage;
       callp QMHSNDPM(qm_msgid:'QCPFMSG   *LIBL     ':
             qm_msgtxt:%size(qm_msgtxt):qm_msgtyp:qm_msgq:
             1:'    ': vApiErrDS);
       endsr;
      /end-free
     Oqxxxsrc   e            write_one
     O                       srcSeqno             6
     O                                           12 '000000'
     O                       xmlcode            112
      * /// END OF INSTALL PGM HERE  /// do not copy past this point  ********** ///
]]>  </install_program>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing README  type TXT - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "README    "
mbrtype =  "TXT       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
2005/mm/dd - Brian Dolinar (BCD)
Objects compiled into QGPL
Objects protected by *PUBLIC *EXCLUDE.
Operations staff are member of the BSYOPER group, which are *ALL for these objec
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing RESTRICTEC  type CLP - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "RESTRICTEC"
mbrtype =  "CLP       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
/********************************************************************/
/* DATE:   08/24/2001 */
/* USER:   BDOLIN */
/* NOTES:  CREATED PROGRAM */
/********************************************************************/
             PGM
/********************************************************************/
/* PRINT DISK USAGE */
/********************************************************************/
             DSPSYSSTS  OUTPUT(*PRINT)
             MONMSG     MSGID(CPF0000)
             CHGSPLFA   FILE(QPDSPSTS) JOB(*) SPLNBR(*LAST) +
                          SELECT(*CURRENT *ALL *ALL RESTRICTED)
             MONMSG     MSGID(CPF0000)

/********************************************************************/
/* END OTHER SUBSYSTEMS */
/********************************************************************/
             ENDSBS     SBS(*ALL) OPTION(*IMMED)
ENDPGM:
             ENDPGM
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing RESTRICTED  type CMD - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "RESTRICTED"
mbrtype =  "CMD       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
             CMD        PROMPT('Goto Restricted State')
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing SAVEANDIPC  type CLP - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "SAVEANDIPC"
mbrtype =  "CLP       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
/********************************************************************/
/* DATE:   08/24/2001 */
/* USER:   BDOLIN */
/* NOTES:  CREATED PROGRAM */
/********************************************************************/
             PGM

             CHGJOB     LOG(4 0 *SECLVL) LOGCLPGM(*YES)

             RESTRICTED

             SAVE21

             PWRDWNSYS  OPTION(*IMMED) RESTART(*YES)

ENDPGM:
             ENDPGM
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing SAVEANDIPL  type CMD - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "SAVEANDIPL"
mbrtype =  "CMD       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
             CMD        PROMPT('Begin Save And IPL')
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing SAVENOIPL  type CMD - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "SAVENOIPL "
mbrtype =  "CMD       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
             CMD        PROMPT('Begin Save And IPL')
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing SAVENOIPLC  type CLP - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "SAVENOIPLC"
mbrtype =  "CLP       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
/********************************************************************/
/* DATE:   08/24/2001 */
/* USER:   BDOLIN */
/* NOTES:  CREATED PROGRAM */
/********************************************************************/
             PGM

             CHGJOB     LOG(4 0 *SECLVL) LOGCLPGM(*YES)

             RESTRICTED

             SAVE21

ENDPGM:
             ENDPGM
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing SAVE21  type CMD - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "SAVE21    "
mbrtype =  "CMD       "
mbrtext =  "                                                  "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
             CMD        PROMPT('Start Save21')
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*STATUS   "><![CDATA[
Installing SAVE21C  type CLP - in progress.
]]>  </sendmsg>
<!-- START OF MEMBER  -->
<mbr
mbrname =  "SAVE21C   "
mbrtype =  "CLP       "
mbrtext =  "*WARNING* Hardcoded Tape Drive Device Name        "
srcfile =  "SAVEANDSRC"
srclib  =  "selected  "
srclen  =  "00112"
srccssid=  "00037">
<copysrc><![CDATA[
/******************************************************************************/
/* PROGRAM:    SAVE21C */
/* CALLED BY:  */
/* CALLS TO:   */
/* CREATED:    2005-08-08 BY BRIAN DOLINAR FOR V5R3 */
/* PURPOSE:    TO BE USED INSTEAD OF THE "GO SAVE, OPTION 21" */
/*             THAT OPTION STARTS THE CONTROLLING SBS, WHICH IN TURN STARTS */
/*             ALL THE SBS, WHICH DEFEATS THE PURPOSE OF IPL'ING AFTER SAVING */
/******************************************************************************/
/* MODIFICATIONS */
/******************************************************************************/
/* BDOLINAR 08/08/2005 CREATED                                                */
/******************************************************************************/
             PGM

/* CONSTANTS */
             DCL        VAR(&TAPDEV) TYPE(*CHAR) LEN(10) VALUE('TAP08')
             DCL        VAR(&NOTIFYUSER) TYPE(*CHAR) LEN(10) +
                          VALUE('BDOLINAR')

/* USE THE SYSTEM REPLY LIST TO ANSWER TAPE MESSAGES */
/*           CHGJOB     INQMSGRPY(*SYSRPYL)          */

/* WE NEED THE QSYSOPR MESSAGE QUEUE TO OURSELVES TO SEE TAPE MSGS */
             CHGMSGQ    MSGQ(QSYSOPR) DLVRY(*BREAK) SEV(10)

/* FORMAT THE TAPE */
             INZTAP     DEV(&TAPDEV) NEWVOL(SAVE21) +
                          NEWOWNID(QSECOFR) CHECK(*NO) +
                          DENSITY(*ULTRIUM1) ENDOPT(*REWIND) CLEAR(*NO)

/* GET READY */
             CHGMSGD    MSGID(CPI8009) MSGF(QSYS/QCPFMSG) SEV(0)
             CHGMSGD    MSGID(CPF2753) MSGF(QSYS/QCPFMSG) SEV(0)
             CHGMSGD    MSGID(CPI5906) MSGF(QSYS/QCPFMSG) SEV(0)
             CHGMSGD    MSGID(CPF9E72) MSGF(QSYS/QCPFMSG) SEV(0)
             /* CHANGE THE MESSAGE SEVERITY TO ZERO SO IT DOESN'T BREAK */

RETRYSAVE:
             DLYJOB     DLY(60) /* WAIT 60 SECS FOR ENDSBS TO +
                          FINISH, THEN TRY SAVE AGAIN */
             SAVSYS     DEV(&TAPDEV) ENDOPT(*LEAVE) OUTPUT(*PRINT) +
                          CLEAR(*NONE)
             MONMSG     MSGID(CPF3785) EXEC(GOTO CMDLBL(RETRYSAVE)) +
                          /* CPF3785-NOT ALL SUBSYSTEMS ENDED. */
             MONMSG     MSGID(CPF0000)
                          /* CPF3772-ONE OR MORE OBJ NOT SAVED */

             SAVLIB     LIB(*NONSYS) DEV(&TAPDEV) ENDOPT(*LEAVE) +
                          CLEAR(*NONE) PRECHK(*NO) SAVACT(*NO) +
                          ACCPTH(*NO) OMITLIB(QMGPDATA BCDLIBASP2) +
                          OUTPUT(*PRINT)

             SAVDLO     DLO(*ALL) FLR(*ANY) DEV(&TAPDEV) +
                          ENDOPT(*LEAVE) OUTPUT(*PRINT) SAVACT(*YES)
             MONMSG     MSGID(CPF0000) EXEC(DO)
             SNDMSG     MSG('SAVE21 - ERROR ON SAV OF DLO.') +
                          TOUSR(&NOTIFYUSER)
             MONMSG     MSGID(CPF0000)
             ENDDO

/* KLUDGE - STILL HAS HARDCODED TAPE DEVICE NAME INSTEAD OF &TAPDEV.  SORRY */
             SAV        DEV('/QSYS.LIB/TAP08.DEVD') OBJ(('/*') +
                          ('/QSYS.LIB' *OMIT) ('/QDLS' *OMIT) +
                          ('/NOBACKUP' *OMIT) ('/OPTVRT' *OMIT)) +
                          SAVACT(*SYNC) OUTPUT(*PRINT) ENDOPT(*UNLOAD)
             MONMSG     MSGID(CPF0000) EXEC(DO)
             SNDMSG     MSG('SAVE21 - ERROR ON SAV OF IFS.') +
                          TOUSR(&NOTIFYUSER)
             MONMSG     MSGID(CPF0000)
             ENDDO

/* PUT THINGS BACK THE WAY THEY BELONG */
             CHGMSGD    MSGID(CPI8009) MSGF(QSYS/QCPFMSG) SEV(70)
             CHGMSGD    MSGID(CPF2753) MSGF(QSYS/QCPFMSG) SEV(30)
             CHGMSGD    MSGID(CPI5906) MSGF(QSYS/QCPFMSG) SEV(70)
             CHGMSGD    MSGID(CPF9E72) MSGF(QSYS/QCPFMSG) SEV(40)
             /* CHANGE THE MESSAGE SEVERITY TO BACK TO WHERE IT BELONGS */

/* PRINT A PARANOID JOB LOG */
             DSPJOBLOG  OUTPUT(*PRINT)
             CHGSPLFA   FILE(QPJOBLOG) JOB(*) SPLNBR(*LAST) +
                          SELECT(*CURRENT *ALL *ALL 'SAVE21')

ENDPGM:
             ENDPGM
]]>  </copysrc>
</mbr>
<sendmsg  sendmsgid="CPF9897" sendmsgtype = "*COMP     "><![CDATA[
Application  successfully installed.
]]>  </sendmsg>
</upload>