*===============================================================
      *  Source Name: eventsfile - Events File Procedures
      *
      *  Desc:     This module contains procedures used to maintain
      *             events file members.
      *
      *===============================================================
     h nomain expropts(*resdecpos) option(*srcstmt:*nodebugio)
      *===============================================================
     d/copy qcpysrc,modstsds
      *===============================================================
      *  Define Named Constants
      *===============================================================
      *
      *===============================================================
      *  Miscellaneous Fields
      *===============================================================
      *
      *===============================================================
      *  Procedure Prototypes
      *===============================================================
     d/copy qcpysrc,eventsfile
      *===============================================================
     d qcmdexc         pr                  extpgm('QCMDEXC')
     d  p_command                  3000a   const options(*varsize)
     d  p_commandlen                 15p 5 const
     d  p_commandopt                  3a   const options(*nopass)
      *===============================================================
      *  Procedure:   #crtevtfilembr - Create Events File Member
      *       Input parms:
      *            Object Library
      *            Source Library
      *            Source File
      *            Source Member
      *       Output parms:
      *            None
      *       Return Value:
      *            None
      *===============================================================
     p #crtevtfilembr...
     p                 b                   export
      *===============================================================
     d #crtevtfilembr...
     d                 pi
     d  objlib                       10a   const
     d  srclib                       10a   const
     d  srcfile                      10a   const
     d  srcmbr                       10a   const
      *===============================================================
     d command         s           3000a   varying
     d sqlstmt         s             80a
      *===============================================================
      /free

         // Create file EVFEVENT in Object Library
                   command = 'CRTDUPOBJ '
                           + 'OBJ(EVFEVENT) '
                           + 'FROMLIB(QGPL) '
                           + 'OBJTYPE(*FILE) '
                           + 'TOLIB('
                           + %trim(objlib)
                           + ')';

                   callp(e) qcmdexc(command:%len(command));

         // Add Member to file EVFEVENT in Object Library
                   command = 'ADDPFM '
                           + 'FILE('
                           + %trim(objlib)
                           + '/EVFEVENT) '
                           + 'MBR('
                           + %trim(srcmbr)
                           + ')';

                   callp(e) qcmdexc(command:%len(command));

         // Clear Member in file EVFEVENT in Object Library
                   command = 'CLRPFM '
                           + 'FILE('
                           + %trim(objlib)
                           + '/EVFEVENT) '
                           + 'MBR('
                           + %trim(srcmbr)
                           + ')';

                   callp(e) qcmdexc(command:%len(command));

         // Build Create Alias Statement
                   sqlstmt = 'create alias qtemp/evtfilembr for '
                           + %trim(objlib)
                           + '/EVFEVENT('
                           + %trim(srcmbr)
                           + ')';

      /end-free
      *===============================================================
     c/exec sql
     c+  execute immediate :sqlstmt
     c/end-exec
      *===============================================================
      /free

         // Write Processor Record
                   #wrtevtfiletimestamp();

         // Write Processor Record
                   #wrtevtfileprocessor();

         // Write FileID Record
                   #wrtevtfilefileid(srclib:
                                     srcfile:
                                     srcmbr);

         // Return
                   return;

      /end-free
      *===============================================================
     p                 e
      *===============================================================
      *  Procedure:   #wrtevtfiletimestamp - Write TimeStamp Format
      *       Input parms:
      *            None
      *       Output parms:
      *            None
      *       Return Value:
      *            None
      *===============================================================
     p #wrtevtfiletimestamp...
     p                 b                   export
      *===============================================================
     d #wrtevtfiletimestamp...
     d                 pi
      *===============================================================
     d timestamp       s             14a   inz
      *===============================================================
      /free

         // Determine TimeStamp
                   timestamp = %char(%date():*iso0)
                             + %char(%time():*hms0);

      /end-free
      *===============================================================
     c/exec sql
     c+ insert
     c+   into qtemp/evtfilembr
     c+ values ('TIMESTAMP  1 ' || :timestamp)
     c/end-exec
      *===============================================================
      /free

         // Return
                   return;

      /end-free
      *===============================================================
     p                 e
      *===============================================================
      *  Procedure:   #wrtevtfileprocessor - Write Processor Format
      *       Input parms:
      *            None
      *       Output parms:
      *            None
      *       Return Value:
      *            None
      *===============================================================
     p #wrtevtfileprocessor...
     p                 b                   export
      *===============================================================
     d #wrtevtfileprocessor...
     d                 pi
      *===============================================================
     c/exec sql
     c+ insert
     c+   into qtemp/evtfilembr
     c+ values ('PROCESSOR  1 000 1')
     c/end-exec
      *===============================================================
      /free

         // Return
                   return;

      /end-free
      *===============================================================
     p                 e
      *===============================================================
      *  Procedure:   #wrtevtfilefileid - Write FileID Format
      *       Input parms:
      *            Source Library
      *            Source File
      *            Source Member
      *       Output parms:
      *            None
      *       Return Value:
      *            None
      *===============================================================
     p #wrtevtfilefileid...
     p                 b                   export
      *===============================================================
     d #wrtevtfilefileid...
     d                 pi
     d  srclib                       10a   const
     d  srcfile                      10a   const
     d  srcmbr                       10a   const
      *===============================================================
     d command         s           3000a   varying
     d lstchgcen       s              2a   inz
     d sourcelen       s              3s 0 inz
     d sourcelena      s              3a   inz
     d sourcename      s             33a   inz varying
      *
     d lstchgds        ds                  inz
     d  lstchgc                       1a
     d  lstchgd                       6a
     d  lstchgt                       6a
      *===============================================================
      /free

         // Determine Source Name Length
                   sourcename = %trim(srclib)
                              + '/'
                              + %trim(srcfile)
                              + '('
                              + %trim(srcmbr)
                              + ')';

                   sourcelen  = %len(sourcename);
                   sourcelena = %editc(sourcelen:'X');

         // Determine Source Change Date/Time
                   command = 'DSPFD '
                           + 'FILE('
                           + %trim(srclib)
                           + '/'
                           + %trim(srcfile)
                           + ') '
                           + 'TYPE(*MBRLIST) '
                           + 'OUTPUT(*OUTFILE) '
                           + 'OUTFILE(QTEMP/$MBRLIST$)';

                   callp(e) qcmdexc(command:%len(command));

      /end-free
      *===============================================================
     c/exec sql
     c+ select mlchgc,
     c+        mlchgd,
     c+        mlchgt
     c+   into :lstchgds
     c+   from qtemp/$mbrlist$
     c+  where mlname = :srcmbr
     c/end-exec
      *===============================================================
      /free

                   select;
                     when lstchgc = '0';
                       lstchgcen = '19';
                     other;
                       lstchgcen = '20';
                   endsl;

      /end-free
      *===============================================================
     c/exec sql
     c+ insert
     c+   into qtemp/evtfilembr
     c+ values ('FILEID     1 001 000001 ' || :sourcelena || ' ' ||
     c+         :sourcename || ' ' || :lstchgcen || :lstchgd ||
     c+         :lstchgt || ' 0')
     c/end-exec
      *===============================================================
      /free

         // Return
                   return;

      /end-free
      *===============================================================
     p                 e
      *===============================================================
      *  Procedure:   #wrtevtfileerror - Write Error Format
      *       Input parms:
      *            Message ID
      *            Message Text
      *       Output parms:
      *            None
      *       Return Value:
      *            None
      *===============================================================
     p #wrtevtfileerror...
     p                 b                   export
      *===============================================================
     d #wrtevtfileerror...
     d                 pi
     d  msgid                         7a   const
     d  msgtext                     235a   const options(*varsize)
      *===============================================================
     d msgtextlen      s              3s 0 inz
     d msgtextlena     s              3a   inz
     d msgtextvar      s            235a   inz varying
      *===============================================================
      /free

         // Determine Message Text Length
                   msgtextvar  = %trim(msgtext);
                   msgtextlen  = %len(msgtextvar);
                   msgtextlena = %editc(msgtextlen:'X');

      /end-free
      *===============================================================
     c/exec sql
     c+ insert
     c+   into qtemp/evtfilembr
     c+ values ('ERROR      1 001 0 000000 000000 000 000000 000 ' ||
     c+         :msgid || ' E 40 ' || :msgtextlena || ' ' || :msgtextvar)
     c/end-exec
      *===============================================================
      /free

         // Return
                   return;

      /end-free
      *===============================================================
     p                 e
      *===============================================================
      *  Procedure:   #wrtevtfilefileend - Write FileEnd Format
      *       Input parms:
      *            None
      *       Output parms:
      *            None
      *       Return Value:
      *            None
      *===============================================================
     p #wrtevtfilefileend...
     p                 b                   export
      *===============================================================
     d #wrtevtfilefileend...
     d                 pi
      *===============================================================
     c/exec sql
     c+ insert
     c+   into qtemp/evtfilembr
     c+ values ('FILEEND    1 001 000000')
     c/end-exec
      *===============================================================
     c/exec sql
     c+  drop alias qtemp/evtfilembr
     c/end-exec
      *===============================================================
      /free

         // Return
                   return;

      /end-free
      *===============================================================
     p                 e
      *===============================================================