Simplify export query results

This tip will help simplify export query results.

To simplify requests for PC files from iSeries data, use this export query utility. You or your users can create a query that will print the desired data, and then this utility formats the results in a comma-separated values file for import into most PC software packages. You may choose to have the field names placed in the first row of the file, to serve as column headings.

  
 Commands:
PTEXPQRY:
             CMD        PROMPT('Export a Query') /* Creates a PC +
                          file of results from a query */
             PARM       KWD(QUERY) TYPE(QUALNAME) MIN(1) +
                          PROMPT('Query name')
             PARM       KWD(FILENAME) TYPE(*NAME) LEN(10) DFT(*QRY) +
                          SPCVAL((*QRY ' ')) PROMPT('Name of +
                          generated file')
             PARM       KWD(PATH) TYPE(*CHAR) LEN(128) CASE(*MIXED) +
                          DFT('/patriot/export') PROMPT('Path for +
                          export file')
             PARM       KWD(FLDNAMES) TYPE(*LGL) LEN(1) DFT(N) +
                          SPCVAL((N '0') (Y '1')) +
                          PROMPT('Include Field names? Y/N')

 QUALNAME:   QUAL       TYPE(*NAME) LEN(10) MIN(1)
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +
                          SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
PTWRTTXT:
             CMD        PROMPT('Write line to Text file')
             PARM       KWD(PATH) TYPE(*CHAR) LEN(128) MIN(1) +
                          PROMPT('Full path / filename')
             PARM       KWD(DATA) TYPE(*CHAR) LEN(32766) MIN(1) +
                          VARY(*YES) CASE(*MIXED) INLPMTLEN(132) +
                          PROMPT('Data to be written')
             PARM       KWD(CREATE) TYPE(*LGL) DFT(Y) SPCVAL((Y '1') +
                          (N '0')) PROMPT('Create file if not +
                          existing?')
             PARM       KWD(APPEND) TYPE(*LGL) DFT(Y) SPCVAL((Y '1') +
                          (N '0')) PROMPT('Append to existing file?') CL Program PTEXPQRY:
  PGM PARM(&qualqry &filename &path &fldnames)
  DCL        &qualqry    *CHAR  20
  DCL        &qryname    *CHAR  10
  DCL        &qrylib     *CHAR  10
  DCL        &filename   *CHAR  10
  DCL        &path       *CHAR  128
  DCL        &fldnames   *LGL          LEN(1)
  DCL        &fullpath   *CHAR  128
  DCL        &rcd        *CHAR  2048
  DCLF FILE(QADSPFFD)

  CHGVAR &qryname (%SST(&qualqry 1 10))
  CHGVAR &qrylib (%SST(&qualqry 11 10))
  IF (&qrylib = ' ')  (CHGVAR VAR(&qrylib) VALUE('*LIBL'))

  IF (&filename = ' ' | &filename = '*QRY')  DO
     CHGVAR &filename &qryname
  ENDDO
  CHGVAR &fullpath (&path |< '/' || &filename |< '.csv')

  DLTF FILE(QTEMP/QTEMP1)
  MONMSG CPF0000
  RUNQRY QRY(&qrylib/&qryname)                                        +
         OUTTYPE(*OUTFILE)                                            +
         PRTDFN(*NO)                                                  +
         OUTFILE(QTEMP/QTEMP1 *FIRST *NEWFILE)
  IF &fldnames DO
     /* Retrieve field names                                         */
     DLTF FILE(QTEMP/QADSPFFD)
     MONMSG CPF0000
     DSPFFD FILE(QTEMP/QTEMP1) OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPFFD)
     OVRDBF FILE(QADSPFFD) TOFILE(QTEMP/QADSPFFD)
     /* Write field names to file */
     CALL   PGM(PTEXPQRYR1) PARM(&FULLPATH)
     DLTOVR FILE(QADSPFFD)
     DLTF FILE(QTEMP/QADSPFFD)
     MONMSG CPF0000
  ENDDO
  CPYTOIMPF FROMFILE(QTEMP/QTEMP1)                                    +
            TOSTMF(&fullpath)                                         +
            MBROPT(*ADD)                                              +
            RCDDLM(*CRLF)                                             +
            DATFMT(*USA)                                              +
            TIMFMT(*ISO)
  DLTF FILE(QTEMP/QTEMP1)
  ENDPGM
RPG Programs:
PTEXPQRYR1:
      /IF DEFINED(PROTOTYPES)
     D PtExpQryR1      PR                  ExtPgm('PTEXPQRYR1')
     D  iFileName                   128A   Const
      /EOF
      /ENDIF
     H Copyright('(C) Copyright InfiniTec Inc, 2005')
     H DatFmt(*USA) TimFmt(*ISO)
     H DftActGrp(*no) ActGrp('QILE')
     H OPTION(*NOSHOWCPY:*SRCSTMT)

      /DEFINE PROTOTYPES
      /include PTEXPQRYR1
      /include PTWRTTXT
      /UNDEFINE PROTOTYPES

     D ReadFirstC1     PR              N
     D ReadNextC1      PR              N
     D CloseC1         PR

     D PtExpQryR1      PI
     D  iFileName                   128A   Const

     D SqlSttOK        C                   '00000'
     D SqlSttEOF       C                   '02000'

     D ffd           E DS                  extname(QADSPFFD)
     D                                     qualified

     D FieldDesc       S           8096A   Varying

      /free
       If ReadFirstC1();
           DoU not ReadNextC1();
               If FieldDesc <> '';
                   FieldDesc = FieldDesc + ',';
               Endif;
               FieldDesc = FieldDesc + '"' + %trim(ffd.whflde) + '"';
           EndDo;
           PtWrtTxt(iFileName:FieldDesc:*on:*off);
       Endif;
       *inLR = *on;
       Return;
      /end-free

      // --------------------------------------------------------------
     P ReadFirstC1     B
     D ReadFirstC1     PI              N

     C/exec sql
     C+  Declare   C1 cursor for
     C+  Select    *
     C+  From      Qtemp/QaDspFfd
     C/end-exec
     C/exec sql
     C+  Open      C1
     C/end-exec
     C                   If        SqlStt < SqlSttEOF
     C                   Return    ReadNextC1
     C                   Else
     C                   CallP     CloseC1
     C                   Return    *off
     C                   Endif
     P                 E

      // --------------------------------------------------------------
     P ReadNextC1      B
     D ReadNextC1      PI              N

     C/exec sql
     C+  Fetch next from C1
     C+  Into      :ffd
     C/end-exec
     C                   If        SqlStt < SqlSttEOF
     C                   Return    *on
     C                   Else
     C                   CallP     CloseC1
     C                   Return    *off
     C                   Endif
     P                 E

      // --------------------------------------------------------------
     P CloseC1         B
     D CloseC1         PI

     C/exec sql
     C+  Close     C1
     C/end-exec
     C                   Return
     P                 E

PTWRTTXT:
      /IF DEFINED(PROTOTYPES)
     D PtWrtTxt        PR                  ExtPgm('PTWRTTXT')
     D  FullPath                    128A   const
     D  DataLine                   2046A   const varying options(*varsize)
     D  iCreate                        N   const options(*nopass:*omit)
     D  iAppend                        N   const options(*nopass:*omit)
      /EOF
      /ENDIF

     H Copyright('(C) Copyright InfiniTec Inc, 2005')
     H DatFmt(*USA) TimFmt(*ISO)
     H DftActGrp(*no) ActGrp('QIFS')
     H OPTION(*NOSHOWCPY:*SRCSTMT)

      /DEFINE PROTOTYPES
      /COPY PTWRTTXT
      /UNDEFINE PROTOTYPES

     D PtWrtTxt        PI
     D  FullPath                    128A   const
     D  DataLine                   2046A   const varying options(*varsize)
     D  iCreate                        N   const options(*nopass:*omit)
     D  iAppend                        N   const options(*nopass:*omit)

     D pnCreate        C                   3
     D pnAppend        C                   4
     D Create          S                   like(iCreate)
     D Append          S                   like(iAppend)

      // Send Program Message
     D SndPgmMsg       PR
     D  iMsgId                        7A   value
     D  iMsgFilNm                    10A   value
     D  iMsgData                    256A   value options(*nopass)
     D  iMsgType                     10A   value options(*nopass)
     D  iMsgStack                     5I 0 value options(*nopass)
     D  iMsgPgmQ                     10A   value options(*nopass)
     D  iMsgFilLb                    10A   value options(*nopass)

      // IFS Prototypes
     D open            PR            10I 0 extproc('open')
     D   path                          *   value options(*string)
     D   oflag                       10I 0 value
     D   mode                        10U 0 value options(*nopass)
     D   codepage                    10U 0 value options(*nopass)
     D close           PR            10I 0 extproc('close')
     D   fildes                      10I 0 value
     D read            PR            10I 0 extproc('read')
     D   fildes                      10I 0 value
     D   buf                           *   value
     D   nbyte                       10U 0 value
     D write           PR            10I 0 extproc('write')
     D   fildes                      10I 0 value
     D   buf                           *   value
     D   nbyte                       10U 0 value

     D CRLF            C                   const(x'0d25')

     D*****************************************************************
     D*  Flags for use in open()
     D*
     D* More than one can be used -- add them together.
     D*****************************************************************
     D*                                            Reading Only
     D O_RDONLY        C                   1
     D*                                            Writing Only
     D O_WRONLY        C                   2
     D*                                            Reading & Writing
     D O_RDWR          C                   4
     D*                                            Create File if not exist
     D O_CREAT         C                   8
     D*                                            Exclusively create
     D O_EXCL          C                   16
     D*                                            Truncate File to 0 bytes
     D O_TRUNC         C                   64
     D*                                            Append to File
     D O_APPEND        C                   256
     D*                                            Convert text by code-page
     D O_CODEPAGE      C                   8388608
     D*                                            Open in text-mode
     D O_TEXTDATA      C                   16777216

     D*****************************************************************
     D*      Mode Flags.
     D*         basically, the mode parm of open(), creat(), chmod(),etc
     D*         uses 9 least significant bits to determine the
     D*         file's mode. (peoples access rights to the file)
     D*
     D*           user:       owner    group    other
     D*           access:     R W X    R W X    R W X
     D*           bit:        8 7 6    5 4 3    2 1 0
     D*
     D* (This is accomplished by adding the flags below to get the mode)
     D*****************************************************************
     D*                                         owner authority
     D S_IRUSR         C                   256
     D S_IWUSR         C                   128
     D S_IXUSR         C                   64
     D S_IRWXU         C                   448
     D*                                         group authority
     D S_IRGRP         C                   32
     D S_IWGRP         C                   16
     D S_IXGRP         C                   8
     D S_IRWXG         C                   56
     D*                                         other people
     D S_IROTH         C                   4
     D S_IWOTH         C                   2
     D S_IXOTH         C                   1
     D S_IRWXO         C                   7

      // Program status data structure
     D                SDS
      // Program Name (*PROGRAM)
     D  dProgram               1     10


      // local variables
     D path            S            256A
     D flags           S             10I 0
     D mode            S             10I 0
     D fd              S             10I 0
     D WrData          S           2048A

     c                   If        %parms >= pnCreate and
     c                             %addr(iCreate) <> *null
     c                   eval      Create = iCreate
     c                   else
     c                   eval      Create = *on
     c                   endif
     c                   If        %parms >= pnAppend and
     c                             %addr(iAppend) <> *null
     c                   eval      Append = iAppend
     c                   else
     c                   eval      Append = *on
     c                   endif

     c                   eval      path = fullpath

     c                   eval      flags = O_WRONLY
     c                   if        create
     c                   eval      flags = flags + O_CREAT
     c                   endif
     c                   if        append
     c                   eval      flags = flags + O_APPEND
     c                   else
     c                   eval      flags = flags + O_TRUNC
     c                   endif
     c                   eval      mode =  S_IRUSR + S_IWUSR
     c                                   + S_IRGRP + S_IWGRP
     c                                   + S_IROTH + S_IWOTH
     c                   eval      fd = open(%trimr(path): flags: mode)
     c                   if        fd < 0
     c                   callp     sndpgmmsg('CPF9897':'QCPFMSG':
     c                             'File unable to be opened.':
     c                             '*INFO':2:dProgram)
     c                   else
     c                   eval      wrdata = %trimr(DataLine) + CRLF
     c                   if        write(fd:%addr(wrdata):
     c                             %len(%trimr((wrdata)))) < %len(%trim(wrdata))
     c                   callp     sndpgmmsg('CPF9897':'QCPFMSG':
     c                             'Error writing data.':
     c                             '*INFO':2:dProgram)
     c                   endif
     c                   endif
     c                   callp     close(fd)
     C                   Return

      // -------------------------------------------------------------------------------
      * Send Program Message to program message queue
     P SndPgmMsg       B                   Export

     D SndPgmMsg       PI
     D  iMsgId                        7A   value
     D  iMsgFilNm                    10A   value
     D  iMsgData                    256A   value options(*nopass)
     D  iMsgType                     10A   value options(*nopass)
     D  iMsgStack                     5I 0 value options(*nopass)
     D  iMsgPgmQ                     10A   value options(*nopass)
     D  iMsgFilLb                    10A   value options(*nopass)

      * Constants - Parameter numbers
     D cpData          C                   3
     D cpType          C                   4
     D cpStack         C                   5
     D cpPgmQ          C                   6
     D cpFilLb         C                   7

     D wNum            s              2P 0 Inz(0)
     D wPgmStack       s              8B 0 Inz(0)
     D wDataLngth      s              8B 0 Inz(0)
     D wPgmQ           s             10A
     D wMsgKey         S              4A

     D MsgId           S              7A
     D MsgFile         S             20A
     D MsgType         S             10A
     D MsgPgmQ         S             10A
     D MsgStack        S              8B 0
     D MsgData         S            256A

     ** Message Error Data Structure
     D dsError         ds
     D  ErrPro                 1      4b 0 Inz(0)
     D  ErrAvl                 5      8b 0 Inz(0)
     D  ErrEid                 9     15
     D  ErrrS1                16     16
     D  ErrDta                17     32

      * Message ID
     C                   Eval      MsgId = iMsgId
      * Message file & library
     C                   Eval      MsgFile = iMsgFilNm
     C                   If        %parms < cpFilLb or
     C                             iMsgFilLb = *blanks
     C                   Eval      %subst(MsgFile:11:10) = '*LIBL'
     C                   Else
     C                   Eval      %subst(MsgFile:11:10) = 'iMsgFilLb'
     C                   Endif

      * Message data & data length
     C                   If        %parms < cpData or
     C                              iMsgData = *blanks
     C                   Clear                   MsgData
     C                   Eval      wDataLngth = *zero
     C                   Else
     C                   Eval      MsgData = iMsgData
     C     ' '           Checkr    MsgData       wDataLngth
     C                   Endif

      * Message type (*INFO *STATUS *ESCAPE *DIAG *COMP)
     C                   If        %parms < cpType or
     C                             MsgType = *Blanks
     C                   Eval      MsgType = '*INFO'
     C                   Else
     C                   Eval      MsgType = iMsgType
     C                   EndIf

      * Program message queue (for reference)
     C                   If        %parms < cpPgmQ or
     C                             iMsgPgmq = *blanks
     C                   Eval      wPgmQ = '*'
     C                   Else
     C                   Eval      wPgmQ = iMsgPgmQ
     C                   EndIf

     C                   If        %parms < cpStack or
     C                              (MsgStack = 0 and
     C                               wPgmQ = '*')
     C                   Eval      wPgmStack = 1
     C                   Else
     C                   Eval      wPgmStack = iMsgStack
     C                   EndIf

     C                   Clear                   wMsgKey
     C                   Eval      dsError = *Blanks
     C                   Eval      ErrPro = 0
     C                   Eval      ErrAvl = 0

     C                   Call      'QMHSNDPM'
     C                   Parm                    MsgId
     C                   Parm                    MsgFile
     C                   Parm                    MsgData
     C                   Parm                    wDataLngth
     C                   Parm                    MsgType
     C                   Parm                    wPgmQ
     C                   Parm                    wPgmStack
     C                   Parm                    wMsgKey
     C                   Parm                    dsError

     C                   Return

     P SndPgmMsg       E

  
  


This was first published in April 2005

Dig deeper on iSeries application development tools

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

SearchEnterpriseLinux

SearchDataCenter

Close