|
 |
|
SQLRPGLE - Deleting records with SQL
Posted By: Reynoo Moore Contact |
C/EXEC SQL
C+ DELETE FROM SRBFFI
C+ WHERE FFPRDC = :OLDPROD1 OR
C+ FFPRDC = :OLDPROD2 OR
C+ FFPRDC = :OLDPROD3
C/END-EXEC
| |
SQLRPGLE - Updating file with SQL
Posted By: Reynoo Moore Contact |
C/EXEC SQL
C+ UPDATE XAOAUD
C+ SET XADFLG = 'Y'
C+ WHERE XADFLG = ' '
C/END-EXEC
| |
SQLRPGLE - Program using SQL to Process data
Posted By: Reynoo Moore Contact |
FRUSF072A O A E K DISK
D PRMDTA DS
D @PRDG1 1 5
D @PRDG2 6 10
D @LOW_MI_DSM 11 13
D @HIGH_MI_DSM 14 16
D @PRIME1 17 22
D @PRIME2 23 28
D @PRIME3 29 34
D @PRIME4 35 40
D @THANDLER 41 41
D @TMREP1 42 44
D @TMREP2 45 47
D SRLDA E DS EXTNAME(SRDLDA)
D XXFDAT 6 0 OVERLAY(LDUSR1:16)
D XXTDAT 6 0 OVERLAY(LDUSR1:22)
D SDS
D PGMNAME 1 10
DINVDETL E DS EXTNAME(SROISDPL)
D ISO S D
D @FDATE S 8 0
D @TDATE S 8 0
C EXSR SQLOPEN
C EXSR GETDETAIL
C EXSR SQLCLOSE
C MOVE *ON *INLR
C/EJECT
C GETDETAIL BEGSR
* Read selected invoice detail records
C EXSR GET
C SQLCOD DOWEQ 0
C IF IDAMOU <> 0
C CLEAR TYPE
C SELECT
C WHEN IDCCA1 = @PRIME1 OR IDCCA1 = @PRIME2 OR
C IDCCA1 = @PRIME3 OR IDCCA1 = @PRIME4
C EVAL TYPE = '2'
C WHEN %SUBST(IDHAND:1:1) <> @THANDLER AND
C IDSALE >= @LOW_MI_DSM AND
C %SUBST(IDSALE:1:1) <> %SUBST(@TMREP1:1:1)
C EVAL TYPE = '3'
C WHEN %SUBST(IDHAND:1:1) = @THANDLER AND
C IDSALE >= @LOW_MI_DSM AND
C %SUBST(IDSALE:1:1) <> %SUBST(@TMREP1:1:1)
C EVAL TYPE = '4'
C WHEN %SUBST(IDHAND:1:1) = @THANDLER AND
C IDSALE >= @TMREP1 AND IDSALE <= @TMREP2
C EVAL TYPE = '5'
C ENDSL
* Reverse credit memo amount
C IF IDTYPP = 2
C EVAL IDQTY = IDQTY * -1
C EVAL IDAMOU = IDAMOU * -1
C END
C WRITE R072A
C ENDIF
C EXSR GET
C ENDDO
C ENDSR
C/EJECT
C *INZSR BEGSR
C *DTAARA DEFINE *LDA SRLDA
C IN SRLDA
* Convert entered date range to CCYYMMD and report headings
C *MDY MOVE XXFDAT ISO
C MOVE ISO @FDATE
C *MDY MOVE XXTDAT ISO
C MOVE ISO @TDATE
C KEY KLIST
C KFLD PRMTYP
C KFLD PSARCH
C EVAL PRMTYP = 'RPGPGM'
C EVAL PSARCH = PGMNAME
* Get parameter definition record
C KEY CHAIN XABCTLPM
C ENDSR
C/EJECT
C SQLOPEN BEGSR
* Execute SQL prepare and open statement
C/EXEC SQL
C+ DECLARE A CURSOR FOR
C+ SELECT *
C+ FROM SR3ISD
C+ WHERE IDIDAT BETWEEN :@FDATE AND :@TDATE AND
C+ IDPGRP BETWEEN :@PRDG1 AND :@PRDG2 AND
C+ IDSALE <= :@HIGH_MI_DSM AND
C+ IDFOCC <> 'Y'
C/END-EXEC
C/EXEC SQL
C+ OPEN A
C/END-EXEC
C ENDSR
C/EJECT
C GET BEGSR
* Get invoice detail records using dealer cursor
C/EXEC SQL
C+ FETCH A INTO :INVDETL
C/END-EXEC
C ENDSR
C/EJECT
C SQLCLOSE BEGSR
* Execute close of cursor
C/EXEC SQL
C+ CLOSE A
C/END-EXEC
C ENDSR
C/EJECT
| |
SQLRPGLE - Date manipulation within SQL
Posted By: Jamie Flanary Contact |
Date manipulation within SQL has been simpler
ever since IBM introduced DATE and DAYS
functions in SQL/400.
I have had situations were I had to subtract
a specific number of days from a given date
nd also display the result date, or determine
the number of days between two dates and display
the resulting days, etc.
The DATE and DAYS function in SQL provides a powerful
solution for these situations. It doesn't matter whether
the fields for calculation are numeric/alphanumeric or date type.
Here is an example SQL that will explain the DATE functions:
SELECT Item, Date(Days(SUBSTR(CHAR(MFDATE),1,4)||'-'||
SUBSTR(CHAR(MFDATE),5,2)|| '-'||
SUBSTR(CHAR(MFDATE),7,2)) + EXPIRE)
FROM ITEMMASTER
In the above example, ITEMMASTER is a database file that has
all the item information. Basically, the above SQL will return
a list of items and their expiry date from the file ITEMMASTER.
MFDATE is a numeric field with the manufactured date in YYYYMMDD
format and EXPIRE is an alphanumeric field with the product life
in days. Our default system date separator is '-'.
Hence any input date format to the function DAYS should be YYYY-MM-DD
and the function will return the integer representation of the date.
The Date function then adds the value in EXPIRE to the integer date
and will then convert that back to the normal date format.
The following are the date functions available in SQL:
DATE
DAY
DAYS
DAYOFMONTH
DAYOFWEEK
DAYOFWEEK_ISO
DAYOFYEAR
| |
SQLRPGLE - determine the last non-weekend day of a given month
Posted By: Jamie Flanary Contact |
Ever need to determine the last non-weekend day of a given month
in an SQL statement, without having to look at a calendar
or look it up in a table, and then hard-code it in your statement?
Scenario: Marketing has asked for a quick calculation of the sales
dollars invoiced for the last day of a given month.
All you have to do is use the first day of the requested month,
which will always be 1, add one month to it, then subtract one day.
Then check the day of the week using a CASE statement.
If the DAYOFWEEK = 1, this is Sunday, back up two more days (total of three days).
If the DAYOFWEEK = 7, this is Saturday, back up one more day (total of two days).
Otherwise, just back up a total of one day. If you CAST your field as either a DATE
or TIMESTAMP then you can add and/or subtract durations of months and/or days,
and determine the day of week.
Code
SELECT INVDATE, SUM(SELLPRICE*SHIPQTY) FROM LIBRARY/FILENAME
GROUP BY INVDATE
HAVING INVDATE =
CASE WHEN DAYOFWEEK(CAST('2002-03-01' AS DATE) + 1 MONTH - 1 DAY) = 1
THEN CAST('2002-03-01' AS DATE) + 1 MONTH - 3 DAY
WHEN DAYOFWEEK(CAST('2002-03-01' AS DATE) + 1 MONTH - 1 DAY) = 7
THEN CAST('2002-03-01' AS DATE) + 1 MONTH - 2 DAY ELSE
CAST('2002-03-01' AS DATE) + 1 MONTH - 1 DAY END
This will also work with the date formatted as '03/01/2003'.
Or, if you want to set this up to run for the previous month,
whatever that month might be, use CURRENT_DATE, changing the day
portion to 01, then subtract 1 day:
SELECT INVDATE, SUM(SELLPRICE*SHIPQTY) FROM LIBRARY/FILENAME
GROUP BY INVDATE
HAVING INVDATE =
CASE WHEN DAYOFWEEK(CAST(SUBSTR(CHAR(CURRENT_DATE),1,3) || '01' ||
SUBSTR(CHAR(CURRENT_DATE),6,5) AS DATE) - 1 DAY) = 1
THEN CAST(SUBSTR(CHAR(CURRENT_DATE),1,3) || '01' ||
SUBSTR(CHAR(CURRENT_DATE),6,5) AS DATE) - 3 DAY
WHEN DAYOFWEEK(CAST(SUBSTR(CHAR(CURRENT_DATE),1,3) || '01' ||
SUBSTR(CHAR(CURRENT_DATE),6,5) AS DATE) - 1 DAY) = 7
THEN CAST(SUBSTR(CHAR(CURRENT_DATE),1,3) || '01' ||
SUBSTR(CHAR(CURRENT_DATE),6,5) AS DATE) - 2 DAY
ELSE CAST(SUBSTR(CHAR(CURRENT_DATE),1,3) || '01' ||
SUBSTR(CHAR(CURRENT_DATE),6,5) AS DATE) - 1 DAY END
DATE fields are in the format of 'YYYY-MM-DD'. TIMESTAMP fields are
in the format of 'YYYY-MM-DD-HH.MM.SS.000000'.
Note: These formats may vary slightly depending on your system.
The easiest way to determine your format is to do a simple SQL
like the following, then adjust the above SQLs accordingly:
SELECT INVDATE, CAST(INVDATE AS DATE), CAST(INVDATE AS TIMESTAMP) FROM LIBRARY/FILENAME
Invoice Date CAST function CAST function
| |
SQLRPGLE - update with substring
Posted By: Jamie Flanary Contact |
Update FILE1
set csfill = (substr(csfill,1,37) || 'N' || substr(csfill,39,12)
where FILE1/cstno in (
select FILE2/cscstn
from FILE2
where ORDERTYPE = 'FE'
or ORDERTYPE = 'CE')
and substr(csfill,38,1) = 'Y'
| |
SQLRPGLE - Connect to PC table
Posted By: Jamie Flanary Contact |
C/EXEC SQL
C+ CONNECT TO :CPRDBN USER :CPUNAM USING :CPUPWD
C/END-EXEC
You can specify RDB(*LOCAL) on the compile command
| |
SQLRPGLE - Count records with SQL
Posted By: Jamie Flanary Contact |
SELECT count(*) FROM cusms WHERE cmstat = ‘FL’
| |
SQLRPGLE - SQL sum function
Posted By: Jamie Flanary Contact |
SELECT cmstat, SUM(cmslyd) FROM cusms GROUP BY cmstat ORDER BY 2 DESC
returns a summary of year to date sales by state, in descending order of sales.
| |
SQLRPGLE - SQL increase by 10%
Posted By: Jamie Flanary Contact |
UPDATE cusms SET cmcrlm = cmcrlm * 1.1 WHERE cmoryd > 10
increases the credit limit of customers with more than ten orders this year, by ten percent.
| |
SQLRPGLE - SQL add some records
Posted By: Jamie Flanary Contact |
INSERT INTO custfile VALUES(124585, ‘Code400’)
adds a single record to custfile with customer number, name and credit limit.
Note that every field in custfile must be accounted for.
INSERT INTO custfile (cmcsno, cmcsnm) SELECT prcust, prcsnm FROM prospects where porder > 0
adds one record to custfile for each prospect who has issued a purchase order.
In this case, only the customer number and name are initialized.
| |
SQLRPGLE - SQL Delete
Posted By: Jamie Flanary Contact |
DELETE FROM cusms
removes all records from customer file.
DELETE FROM prospects WHERE porder = 0 AND scdate < 20000000
removes all prospects with no purchase order,
whose last sales call was prior to the year 2000
DELETE FROM prospects WHERE prcust NOT IN (SELECT cmcsno FROM cusms)
removes all prospects without a matching customer record.
| |
SQLRPGLE - SQL average selection
Posted By: Jamie Flanary Contact |
Using the PROJECT table, set the host variable AVERAGE (decimal(5,2))
to the average
staffing level (PRSTAFF) of projects in department (DEPTNO) ‘D11’.
SELECT AVG(PRSTAFF)
INTO :AVERAGE
FROM PROJECT
WHERE DEPTNO = ’D11’
| |
SQLRPGLE - SQL count functions
Posted By: Jamie Flanary Contact |
Using the EMPLOYEE table, set the host variable FEMALE (int) to the number of rows
where the value of the SEX column is ‘F’.
SELECT COUNT(*)
INTO :FEMALE
FROM EMPLOYEE
WHERE SEX = ’F’
Using the EMPLOYEE table, set the host variable FEMALE_IN_DEPT (int) to the number of
departments (WORKDEPT) that have at least one female as a member.
SELECT COUNT(DISTINCT WORKDEPT)
INTO :FEMALE_IN_DEPT
FROM EMPLOYEE
WHERE SEX=’F’
Using the PROJECT table, set the host variable SUB_PROJECT_COUNT (int)
to the number of projects that are sub-projects of a major project.
SELECT COUNT(MAJPROJ)
INTO :SUB_PROJECT_COUNT
FROM PROJECT
| |
SQLRPGLE - SQL dynamic selection
Posted By: Jamie Flanary Contact |
D**********************************************
D* Declare program variables. *
D* STMT initialized to the *
D* listed SQL statement. *
D**************************************************
D EMPNUM S 6A
D NAME S 15A
D STMT S 500A INZ('SELECT LASTNAME -
D FROM CORPDATA.EMPLOYEE WHERE -
D EMPNO = ?')
...
C*************************************************************
C* Prepare STMT as initialized in declare section *
C*************************************************************
C/EXEC SQL
C+ PREPARE S1 FROM :STMT
C/END-EXEC
C*
C*************************************
C* Declare Cursor for STMT *
C*************************************
C/EXEC SQL
C+ DECLARE C1 CURSOR FOR S1
C/END-EXEC
C*
C*****************************************************
C* Assign employee number to use in select statement *
C*****************************************************
C eval EMPNUM = '000110'
C**********************
C* Open Cursor *
C**********************
C/EXEC SQL
C+ OPEN C1 USING :EMPNUM
C/END-EXEC
C*
C***********************************************
C* Fetch record and put value of *
C* LASTNAME into NAME *
C***********************************************
C/EXEC SQL
C+ FETCH C1 INTO :NAME
C/END-EXEC
...
C********************************
C* Program processes NAME here *
C********************************
...
C******************
C* Close cursor *
C******************
C/EXEC SQL
C+ CLOSE C1
C/END-EXEC
| |
SQLRPGLE - SQLRPGLE - SUM example
Posted By: JimmyOctane Contact |
C/EXEC SQL
C+ SELECT SUM(OLOQTY)
C+ INTO :XXCSOQ
C+ FROM SROORSPL
C+ WHERE OLALNO <> 0 AND OLORDS < 30 AND OLDELT < :X9DATE AND
C+ OLPRDC = :X1PRDC AND OLSROM = :X1SROM
C/END-EXEC
| |
SQLRPGLE - SQLRPGLE - Order by
Posted By: JimmyOctane Contact |
C/EXEC SQL
C+ DECLARE A CURSOR FOR
C+ SELECT *
C+ FROM SR2ISD
C+ WHERE IDIDAT BETWEEN :@FDATE AND :@TDATE AND
C+ IDSROM = :XXWHSE AND
C+ IDTYPP = :@SALTYP
C+ ORDER BY IDPRDC
C/END-EXEC
| |
SQLRPGLE - SQLRPGLE - Large Select
Posted By: JimmyOctane Contact |
C/EXEC SQL
C+ DECLARE A CURSOR FOR
C+ SELECT *
C+ FROM SR2ISD
C+ WHERE IDCUNO = :@CUSNO AND
C+ IDIDAT BETWEEN :@FDATE AND :@TDATE AND
C+ IDPGRP BETWEEN :@PRDG1 AND :@PRDG2 AND
C+ IDSALE BETWEEN :@FSALE AND :@TSALE AND
C+ IDPGRP <> :@EXGPF1 AND
C+ IDPGRP <> :@EXGPF2 AND
C+ IDFOCC <> 'Y'
C+ ORDER BY IDCUNO, IDIDAT, IDINVN
C/END-EXEC
| |
SQLRPGLE - SQL select multiple rows
Posted By: JimmyOctane Contact |
Multiple Row FETCH
Based on host structure array
RPG - Multiple Occurence Data Structure
COBOL - Occurs clause on declaration of the group item
Clause on FETCH
FOR n ROWS (n = number of rows to be returned)
Specifies the number of rows to be retrieved to fill the array structure.
D EMP DS Occurs(10)
D NBR 5 0
D NAME 25
D JOB 1
C*
C Z-ADD 5 JOB
C/EXEC SQL
C+ FETCH Next
C+ FROM CustomerCursor
C+ FOR 10 ROWS
C+ INTO EMP
C/End-EXEC
C Eval ErrCond = SQLErrD(5)
C*
| |
SQLRPGLE - SQL Character to decimal conversion
Posted By: JimmyOctane Contact |
D Character S 15 Inz( '51123.45' )
D Numeric S 7S 2
D Numeric2 S 15S 2
D TheEnd S 1
C*
C* The key here is this does work but must contain
C* no commas and no spaces.
C*
C/Exec SQL
C+ Set :Numeric = Cast( :Character as Dec( 7,2 ))
C/End-Exec
C*===========>Numeric = 51123.45
C/Exec SQL
C+ Set :Numeric2 = Cast( :Character as Dec(15,2))
C/End-Exec
C*===========>Numeric2 = 0000000051123.45
C Eval *Inlr = *On
| |
SQLRPGLE - SQL delete duplicate records
Posted By: JimmyOctane Contact |
Delete From CODE400/CUSTOMERP A
Where RRN(A) >
(Select Min(RRN(B)) From CODE400/CUSTOMERP B
Where A.LastName = B.LastName)
| |
SQLRPGLE - RGZPFM - using api's write to log file
Posted By: JimmyOctane Contact |
FFINDDELP UF A E K DISK
D SQLQDBXREF ds
D qDBXFIL 10
D qDBXLIB 10
D qDBXATR 2
D qDBXTYP 1
D qDBXTXT 50
D szMD szMsgText S 255A
** Tells the APIs how long the buffers are that are being used.
D nBufLen S 10I 0
** The structure returned by the QusRMBRD API.
D szMbrd0100 DS INZ
D nBytesRtn 10I 0
D nBytesAval 10I 0
D szFileName 10A
D szLibName 10A
D szMbrName 10A
D szFileAttr 10A
D szSrcType 10A
D dtCrtDate 13A
D dtLstChg 13A
D szMbrText 50A
D bIsSource 1A
D RmtFile 1A
D LglPhyFile 1A
D ODPSharing 1A
D filler2 2A
D RecCount 10I 0
D DltRecCnt 10I 0
D DataSpaceSz 10I 0
D AccpthSz 10I 0
D NbrBasedOnMbr 10I 0
**----------------------------------------------------------------
** Input Parameters for the program.
**----------------------------------------------------------------
** Source file name
D szSrcFile S 10A
D szSrcLib S 10A
D szSrcMbr S 10A
D CmdString S 256A
D CmdLength S 015 5
**----------------------------------------------------------------
** Input Parameters to the QUSRMBRD API
**----------------------------------------------------------------
** Format to be returned
D szFmt S 8A Inz('MBRD0200')
** Qualified source file and library name
D szQualName S 20A
** Whether or not to ignore overrides (0=Ignore, 1 = Apply)
D bOvr S 1A Inz('0')
C/EXEC SQL
C+ DECLARE A CURSOR FOR
C+ SELECT DBXFIL, DBXLIB, DBXATR, DBXTYP, DBXTXT
C+ FROM QADBXREF
C+ WHERE DBXATR = 'PF' AND DBXLIB = 'RC1380BFR1'
C/END-EXEC
C/EXEC SQL
C+ OPEN A
C/END-EXEC
**----------------------------------------------------------------
** Call this program with 3 parameters:
** Parm(QRPGLESRC myLibr ORDENTRY)
** srcfile srclib srcmbr
**----------------------------------------------------------------
C EXSR SRFTSQL
C SQLCOD DOWEQ 0
C*
C Eval szSrcFile = QDBXFIL
C Eval szSrcLib = QDBXLIB
C Eval szSrcMbr = '*FIRST'
**----------------------------------------------------------------
** Call QusRMBRD to retrieve the specified source member's
**----------------------------------------------------------------
C Eval szQualName = szSrcFile + szSrcLib
C Eval nBufLen = %size(szMbrD0100)
**----------------------------------------------------------------
C Call(E) 'QUSRMBRD'
C Parm szMbrD0100
C Parm nBufLen
C Parm szFmt
C Parm szQualName
C Parm szSrcMbr
C Parm bOvr
**----------------------------------------------------------------
** If RTFMBRD failed, we tell the FTP client that it failed.
**----------------------------------------------------------------
C if %Error
C Eval szMsgText = 'RTVMBRD Failed'
C Else
C*
C* get the deleted number of records
C*
C If DltRecCnt > *Zeros
C Movel(p) QDBXLIB LIBRARY
C Movel(p) QDBXFIL FILE
C Z-add DltRecCnt Deleted
C Movel(p) QDBXTXT DESC
C* RGZPFM FILE(SOMELIB/SOMEFILE)
C Eval CmdString = 'RGZPFM FILE(' +
C %Trim(LIBRARY) + %Trim('/') +
C %Trim(FILE) + %Trim(')')
C Eval CmdLength = %Len(%Trim(CmdString))
C Call 'QCMDEXC' 99
C Parm CmdString
C Parm CmdLength
C Eval *in99 = *off
C If *in99
C Eval STATUS = 'E'
C Else
C Clear STATUS
C Endif
C Write WFINDR
C endif
C*
C endif
C*
C EXSR SRFTSQL
C ENDDO
C/EXEC SQL
C+ CLOSE A
C/END-EXEC
C Eval *INLR = *On
CSR SRFTSQL BEGSR
C*
C/EXEC SQL
C+ FETCH A INTO :SQLQDBXREF
C/END-EXEC
C*
CSR ENDSR
******Physical file source**********
A*
A*
A R WFINDR TEXT('Find deleted')
A*
A STATUS 01 COLHDG('Status')
A LIBRARY 10 COLHDG('Library')
A FILE 10 COLHDG('File')
A DESC 50 COLHDG('Description')
A DELETED 08 0 COLHDG('Deleted')
| |
SQLRPGLE - SQLRPGLE - ROLLBACK
Posted By: JimmyOctane Contact |
H
F* File declaration for QPRINT
F*
FQPRINT O F 132 PRINTER
I*
I* Structure for report 1.
I*
IRPT1 E DSPROJECT
I PROJNAME PROJNM
I RESPEMP RESEM
I PRSTAFF STAFF
I PRSTDATE PRSTD
I PRENDATE PREND
I MAJPROJ MAJPRJ
I*
I DS
I 1 6 EMPNO
I 7 36 NAME
I P 37 412SALARY
I*
I* Structure for report 2.
I*
IRPT2 DS
I 1 6 PRJNUM
I 7 42 PNAME
I B 43 440EMPCNT
I P 45 492PRCOST
I*
I DS
I B 1 20WRKDAY
I P 3 62COMMI
I 7 16 RDATE
I P 17 202PERCNT
C*
C Z-ADD253 WRKDAY
C Z-ADD2000.00 COMMI
C Z-ADD1.04 PERCNT
C MOVEL'1982-06-'RDATE
C MOVE '01' RDATE
C SETON LR
C*
C* Update the selected projects by the new percentage. If an
C* error occurs during the update, ROLLBACK the changes.
C*
C/EXEC SQL WHENEVER SQLERROR GOTO UPDERR
C/END-EXEC
C*
C/EXEC SQL
C+ UPDATE CORPDATA/EMPLOYEE
C+ SET SALARY = SALARY * :PERCNT
C+ WHERE COMM >= :COMMI
C/END-EXEC
C*
C* Commit changes.
C*
C/EXEC SQL COMMIT
C/END-EXEC
C*
C/EXEC SQL WHENEVER SQLERROR GO TO RPTERR
C/END-EXEC
C*
C* Report the updated statistics for each employee assigned to
C* selected projects.
C*
C* Write out the header for report 1.
C*
C EXCPTRECA
C/EXEC SQL DECLARE C1 CURSOR FOR
C+ SELECT DISTINCT PROJNO, EMP_ACT.EMPNO,
C+ LASTNAME||', '||FIRSTNME, SALARY
C+ FROM CORPDATA/EMP_ACT, CORPDATA/EMPLOYEE
C+ WHERE EMP_ACT.EMPNO = EMPLOYEE.EMPNO AND
C+ COMM >= :COMMI
C+ ORDER BY PROJNO, EMPNO
C/END-EXEC
C*
C/EXEC SQL
C+ OPEN C1
C/END-EXEC
C*
C* Fetch and write the rows to QPRINT.
C*
C/EXEC SQL WHENEVER NOT FOUND GO TO DONE1
C/END-EXEC
C SQLCOD DOUNE0
C/EXEC SQL
C+ FETCH C1 INTO :PROJNO,:EMPNO,:NAME, :SALARY
C/END-EXEC
C EXCPTRECB
C END
C DONE1 TAG
C/EXEC SQL
C+ CLOSE C1
C/END-EXEC
C*
C* For all project ending at a date later than the raise date
C* (i.e. those projects potentially affected by the salary raises)
C* generate a report containing the project number, project name,
C* the count of employees participating in the project and the
C* total salary cost of the project.
C*
C* Write out the header for report 2.
C*
C EXCPTRECC
C/EXEC SQL
C+ DECLARE C2 CURSOR FOR
C+ SELECT EMP_ACT.PROJNO, PROJNAME, COUNT(*),
C+ SUM((DAYS(EMENDATE) - DAYS(EMSTDATE)) * EMPTIME *
C+ DECIMAL((SALARY/:WRKDAY),8,2))
C+ FROM CORPDATA/EMP_ACT, CORPDATA/PROJECT, CORPDATA/EMPLOYEE
C+ WHERE EMP_ACT.PROJNO = PROJECT.PROJNO AND
C+ EMP_ACT.EMPNO = EMPLOYEE.EMPNO AND
C+ PRENDATE > :RDATE
C+ GROUP BY EMP_ACT.PROJNO, PROJNAME
C+ ORDER BY 1
C/END-EXEC
C*
C/EXEC SQL OPEN C2
C/END-EXEC
C*
C* Fetch and write the rows to QPRINT.
C*
C/EXEC SQL WHENEVER NOT FOUND GO TO DONE2
C/END-EXEC
C SQLCOD DOUNE0
C/EXEC SQL
C+ FETCH C2 INTO :RPT2
C/END-EXEC
C EXCPTRECD
C END
C DONE2 TAG
C/EXEC SQL CLOSE C2
C/END-EXEC
C RETRN
C*
C* Error occurred while updating table. Inform user and rollback
C* changes.
C*
C UPDERR TAG
C EXCPTRECE
C/EXEC SQL WHENEVER SQLERROR CONTINUE
C/END-EXEC
C*
C/EXEC SQL
C+ ROLLBACK
C/END-EXEC
C RETRN
C*
C* Error occurred while generating reports. Inform user and exit.
C*
C RPTERR TAG
C EXCPTRECF
C*
C* All done.
C*
C FINISH TAG
OQPRINT E 0201 RECA
O 45 'REPORT OF PROJECTS AFFEC'
O 64 'TED BY EMPLOYEE RAISES'
O E 01 RECA
O 7 'PROJECT'
O 17 'EMPLOYEE'
O 32 'EMPLOYEE NAME'
O 60 'SALARY'
O E 01 RECB
O PROJNO 6
O EMPNO 15
O NAME 50
O SALARYL 61
O E 22 RECC
O 42 'ACCUMULATED STATISTIC'
O 54 'S BY PROJECT'
O E 01 RECC
O 7 'PROJECT'
O 56 'NUMBER OF'
O 67 'TOTAL'
O E 02 RECC
O 6 'NUMBER'
O 21 'PROJECT NAME'
O 56 'EMPLOYEES'
O 66 'COST'
O E 01 RECD
O PRJNUM 6
O PNAME 45
O EMPCNTL 54
O PRCOSTL 70
O E 01 RECE
O 28 '*** ERROR Occurred while'
O 52 ' updating table. SQLCODE'
O 53 '='
O SQLCODL 62
O E 01 RECF
O 28 '*** ERROR Occurred while'
O 52 ' generating reports. SQL'
O 57 'CODE='
O SQLCODL 67
| |
SQLRPGLE - SQLRPGLE - Trigger
Posted By: JimmyOctane Contact |
DB2 Example: After Update Trigger
*========================================================*
* This program is intended to illustrate an after update *
* trigger that simulates an update cascade. *
* *
* *
* CRTSQLRPGI OBJ(CORPDATA/TRG03) SRCFILE(MJASRC/RPG) *
* COMMIT(*NONE) OUTPUT(*PRINT) *
* OPTION(*XREF *NOGEN) DBGVIEW(*SOURCE) *
* USRPRF(*OWNER) DYNUSRPRF(*ONER) *
* *
* CRTBNDRPG PGM(CORPDATA/TRG03) SRCFILE(QTEMP/QSQLTEMP1) *
* DFTACTGRP(*NO) ACTGRP(*CALLER) *
* DBGVIEW(*SOURCE) ALWNULL(*YES) *
* USRPRF(*OWNER) *
* *
* ADDPFTRG FILE(CORPDATA/DEPARTMENT) *
* TRGTIME(*AFTER) TRGEVENT(*UPDATE) *
* PGM(CORPDATA/TRG03) ALWREPCHG(*YES) *
* *
* *
*========================================================*
*
*========================================================*
* Definition of the structure passed as the first *
* parameter from database to the trigger program. *
* The include is used so that any additional fields *
* in the interface template in the future will be *
* brought into the program if it is recompiled. *
* *
* The includes in the QSYSINC library must be on *
* your system to compile this program. Option 13 of *
* the OS/400 install will install them. *
* *
*========================================================*
D/COPY QSYSINC/QRPGLESRC,TRGBUF
*
*========================================================*
* This is an overlay used to set addressability *
* to the various sections of the interface buffer *
* such as the before and after record images. *
*========================================================*
D INTARR S 1A BASED(INTPTR) DIM(32767)
D INTPTR S *
*
*========================================================*
* Definition of the trigger buffer length passed as *
* the second parameter from database to the trigger *
* program. *
*========================================================*
D PARM2 DS
D LENG 1 4B 0
*
*========================================================*
* These pointers are used to point to the before *
* and after images. The before and after images *
* are passed in the first parameter structure. *
*========================================================*
D BIMAGE S *
D AIMAGE S *
*
*========================================================*
* These based structures provide the subfields of *
* the record images. Externally defined data *
* structures are used so a recompile of the *
* program will always pick up the latest field *
* defintions. *
*========================================================*
D BEMP E DS EXTNAME(DEPARTMENT)
D BASED(BIMAGE)
D PREFIX(B)
D AEMP E DS EXTNAME(DEPARTMENT)
D BASED(AIMAGE)
D PREFIX(A)
*
*========================================================*
* Error output from QMHSNDPM *
*========================================================*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D RTNDTA 17 56
*
*========================================================*
* Parameters for QMHSNDPM *
*========================================================*
D FLDS DS
D MSGLEN 1 4B 0
D PGMSTK 5 8B 0
D RTVLEN 9 12B 0
D MSGQLEN 13 16B 0
D PGMWTT 17 20B 0
D LASTOPEN 21 21A
*
*========================================================*
* If an error occurs, the trigger program should send an *
* error to database to indicate that the operation has *
* failed. To send an escape message, use the QMHSNDPM *
* API. We must send the message to the call stack entry *
* that comes immediately before the trigger program. *
* The first call stack entry in an ILE RPG trigger *
* program is the PEP. Below, we have defined the *
* name of the PEP for this ILE trigger program. *
*========================================================*
D MSGQNAM C CONST('_QRNP_PEP_TRG02')
*
*========================================================*
* Place the name of your message file in the first 10 *
* characters, padding with blanks to the 10th character. *
* Place the library name in the second 10 characters *
* padding with blanks. *
*========================================================*
D MSGFNAME C CONST('MSGF MJATST ')
D LEN C CONST(15)
D MODNAME C CONST('*NONE *NONE ')
*
C *ENTRY PLIST
C QDBTB PARM QDBTB
C PARM2 PARM PARM2
*
*========================================================*
* This is the parameter list of QMHSNDPM. *
*========================================================*
C PLIST1 PLIST
C PARM MSGID 7
C PARM MSGF 20
C PARM MSGDTA 25
C PARM MSGLEN
C PARM MSGTYP 10
C PARM MSGQUE 19
C PARM PGMSTK
C PARM MSGKEY 4
C PARM QUSEC
C PARM MSGQLEN
C PARM CSEQUAL 20
C PARM PGMWTT
*========================================================*
* Set the basing pointers for the interface *
* structure and the before and after images *
*========================================================*
C EVAL INTPTR = %ADDR(QDBTB)
C EVAL BIMAGE = %ADDR(INTARR(QDBORO+1))
C EVAL AIMAGE = %ADDR(INTARR(QDBNRO+1))
*
*========================================================*
* Only open or perform an update if the manager *
* number has changed. *
*========================================================*
C AMGRNO IFNE BMGRNO
*
*========================================================*
* Update the employee record. Note that SQL will keep *
* any of the used ODPs open. *
* Also SQL is able to use a specific isolation level *
* either by using the SET TRANSACTION statement or *
* by statement level isolation levels. *
*========================================================*
C QDBCLL IFEQ '0'
C/EXEC SQL UPDATE CORPDATA/EMPLOYEE SET WORKDEPT = :ADEPTNO
C+ WHERE EMPNO = :AMGRNO WITH NC
C/END-EXEC
C ELSE
C QDBCLL IFEQ '1'
C/EXEC SQL UPDATE CORPDATA/EMPLOYEE SET WORKDEPT = :ADEPTNO
C+ WHERE EMPNO = :AMGRNO WITH UR
C/END-EXEC
C ELSE
C QDBCLL IFEQ '2'
C/EXEC SQL UPDATE CORPDATA/EMPLOYEE SET WORKDEPT = :ADEPTNO
C+ WHERE EMPNO = :AMGRNO WITH CS
C/END-EXEC
C ELSE
C QDBCLL IFEQ '3'
C/EXEC SQL UPDATE CORPDATA/EMPLOYEE SET WORKDEPT = :ADEPTNO
C+ WHERE EMPNO = :AMGRNO WITH RS
C/END-EXEC
C ELSE
C/EXEC SQL UPDATE CORPDATA/EMPLOYEE SET WORKDEPT = :ADEPTNO
C+ WHERE EMPNO = :AMGRNO WITH RR
C/END-EXEC
C ENDIF
C ENDIF
C ENDIF
C ENDIF
*
*========================================================*
* If the SQL operation is unsuccessful for *
* some reason return a message to the application to *
* make the update fail. *
*========================================================*
C SQLCOD IFLT 0
*
*========================================================*
* Place the appropriate message ID here. *
*========================================================*
C MOVEL 'TRG0001' MSGID
C MOVEL MSGFNAME MSGF
C MOVE ' ' MSGDTA
C Z-ADD 25 MSGLEN
C MOVEL(P) '*ESCAPE' MSGTYP
C MOVEL(P) MSGQNAM MSGQUE
C MOVEL(P) MODNAME CSEQUAL
C MOVE ' ' MSGDTA
C Z-ADD 1 PGMSTK
C Z-ADD LEN MSGQLEN
C MOVE ' ' MSGKEY
C Z-ADD 66 QUSBPRV
C Z-ADD 0 QUSBAVL
C MOVE ' ' QUSEI
C MOVE ' ' QUSERVED
C MOVE ' ' RTNDTA
C CALL 'QMHSNDPM' PLIST1
C ENDIF
C ENDIF
*
C RETURN
| |
SQLRPGLE - Build Dynamic SQL statement based on display entries
Posted By: Michael Haston Contact |
**** compile with option: *********************************************
Delay PREPARE . . . . . . . . . DLYPRP *yes
************************************************************************
*
BUILD AN SQL STATEMENT
20 fields for store# that users can fill. this logic will take 0-20
store# and build an sql select statement accordingly.
Here's the sql statement before it's executed:
> EVAL sql_statement
SQL_STATEMENT =
....5...10...15...20...25...30...35...40...45...50...55...60
1 'select * from ediinvl5 where insol in ( 'H449 ', 'H440 ', 'H'
61 '436 ' ) and indiv in ( '3T', '1E', '1C' ) and insea in ( 'H''
121 ' )
**********************************************************************
* Procedure: #getInventory *
* Useage: *
**********************************************************************
p #getInventory b
d #getInventory pi
/free
// start to build the sql statement
sql_statement = 'select * from ediinvl5';
// if store numbers are passed build selection statement
nbrStores = %lookup( *blanks : store# ) - 1;
if nbrStores > 0;
sql_statement += ' where insol in (';
for i = 1 to nbrStores;
if i > 1;
sql_statement += comma;
endif;
sql_statement += ' ' + apos + store#(i) + apos;
endfor;
sql_statement += ' )';
endif;
// week ending date range
if nbrStores = 0;
sql_statement += ' where inend between '
+ %editc( pwedt1 : 'X' ) + ' and '
+ %editc( pwedt2 : 'X' );
else;
sql_statement += ' and inend between '
+ %editc( pwedt1 : 'X' ) + ' and '
+ %editc( pwedt2 : 'X' );
endif;
// if divisions are passed add to selection statement
nbrDivisions = %lookup( *blanks : division ) - 1;
if nbrDivisions > 0;
sql_statement += ' and indiv in (';
for i = 1 to nbrDivisions;
if i > 1;
sql_statement += comma;
endif;
sql_statement += ' ' + apos + division(i) + apos;
endfor;
sql_statement += ' )';
endif;
// if seasons are passed add to selection statement
nbrSeasons = %lookup( *blanks : season ) - 1;
if nbrSeasons > 0;
sql_statement = sql_statement + ' and insea in (';
for i = 1 to nbrSeasons;
if i > 1;
sql_statement += comma;
endif;
sql_statement += ' ' + apos + season(i) + apos;
endfor;
sql_statement += ' )';
endif;
/end-free
* prepare sql statement
c/exec sql
c+ prepare sql from :sql_statement
c/end-exec
* declare cursor
c/exec sql
c+ declare c1 cursor for sql
c/end-exec
* open cursor
c/exec sql
c+ open c1
c/end-exec
* fetch cursor
c/exec sql
c+ fetch c1 into :wrkediinv
c/end-exec
/free
dow ( sqlcod >= 0 ) and ( sqlcod <> 100 );
chain deptKey2 CHKDPTWF;
if %found( CHKDPTWF );
cdwinv = 'X';
cdwict = cdwict + 1;
update DPTREC;
else;
cdwsol = insol;
cdwdiv = indiv;
cdwdpt = indpt;
cdwsea = insea;
cdwsls = *blanks;
cdword = *blanks;
cdwinv = 'X';
cdwsct = 0;
cdwict = 1;
write DPTREC;
endif;
/end-free
* fetch cursor
c/exec sql
c+ fetch next from c1 into :wrkediinv
c/end-exec
/free
enddo;
/end-free
* close cursor
c/exec sql
c+ close c1
c/end-exec
p #getInventory e
| |
SQLRPGLE - Expression with CONCAT (& numeric-to-char conversion)
Posted By: Gerard Contact |
C/EXEC SQL
C+ INSERT INTO outfile
C+ (field1char, field2num)
C+ SELECT file1.field1char, file1.field2num
C+ FROM file1
C+ WHERE file1.field1char CONCAT file1.char(field2num) IN
C+ (SELECT file2.field1char CONCAT file2.char(field2num)
C+ FROM file2)
C/END-EXEC
| |
SQLRPGLE - Converting Nulls in SQL
Posted By: Bill Muntz Contact |
Select Customer.CustId,
Customer.Name As 'Customer Name',
IfNull( SalesRep.Name, 'Not assigned' ) As 'Sales Rep Name'
From Customer
Left Outer Join
SalesRep
On Customer.CustId = SalesRep.CustId
| |
SQLRPGLE - Update table using sql update with a join.
Posted By: sources of all Contact |
In the following example the header file will only be updated if one of the
detail records has state 'X', '0', '1'
update Header A
set A.Field = 'X'
where exists (select distinct C.OrderNo
from Header C join Detail B
on C.OrderNo = B.OrderNo
where A.OrderNo = C.OrderNo
and B.State in ('X', '0', '1'))
If you only have to update the header if none of the associated records has
state 'X', '0', '1', it's a little more tricky.
update Header A
set A.Field = 'X'
where exists (select distinct C.OrderNo
from Header C join Detail B
on C.OrderNo = B.OrderNo
where A.OrderNo = C.OrderNo
and c.OrderNo not in (select distinct d.OrderNo
from Detail d
where d.state not in
('X', '0', '1')))
| |
SQLRPGLE - SQL - Select INTO multiple fields
Posted By: jimmy Octane Contact |
MOVE ’000220’ TO PERSON.
EXEC SQL
SELECT "A", LASTNAME, SALARY, :RAISE, SALARY + :RAISE INTO :PROCESS, :PERSON-NAME, :EMP-SAL, :EMP-RAISE, :EMP-
TTL
FROM CORPDATA.EMPLOYEE
WHERE EMPNO = :PERSON
END-EXEC.
| |
SQLRPGLE - Evaluate an arithmetic expresion.
Posted By: Nicolas Machado Contact |
*================================================================
* SISTEMA.....: Modulo de Indicadores de Gestion.
* PROGRAMA....: ZGFCFIGI
* DESCRIPCION.: Envia consulta de SQL formada por una formula
* ANALISIS....: Nicolas Machado
* PROGRAMACION: Nicolas Machado
* FECHA.......: 12/11/2004
* (c) COPYRIGHT METODO Argentina S.A.
*================================================================
H DEBUG DATEDIT(*YMD)
*
* -------------------------------------------------------------- *
* Definicion de Prototipos
* -------------------------------------------------------------- *
D Qcmd PR ExtPgm('QCMDEXC')
D Command 32702A const options(*varsize)
D Length 15P 5 const
* -------------------------------------------------------------- *
* Definicion de Variables Globales
* -------------------------------------------------------------- *
D SqlStmt S 1024A
D Resultado S 30 9
D Formula S 1024A
D Comando S 1024a
D Form S 40a
*
D time_start s z
D time_end s z
D diffSecsMs s 26s 0
D diffSecs s 30s 6
D dum s 30
*
D piFormula S 1024A
D poResult S 30 9
D poError S 10A
* -------------------------------------------------------------- *
* Parametros de Entrada / Salida *
* -------------------------------------------------------------- *
C *ENTRY PLIST
C PARM piFormula
C PARM poResult
C PARM poError
* -------------------------------------------------------------- *
* *
* -------------------------------------------------------------- *
C
C If %Parms = 0
* // Para Ejemplo
C eval Formula = '( 125 + 30 + ( 1.5 * 2 ) )'
C eval Form = %trim(formula)
C 'Formula' Dsply Form
C if Form <> *blanks
C eval Formula = %trim(Form)
C Endif
*
C Else
C eval Formula = piFormula
C Endif
* ------
* ---------------------------------------------------------------
* Inicializacion de Archivo Temporal
* // Borra Archivo temporal
C eval comando = 'DLTF FILE(QTEMP/DUMMY)'
C callp(e) Qcmd(%trim(comando) :
C %len(%trim(comando)))
*
* // crea Archivo temporal
c eval comando = 'Crtpf FILE(QTEMP/DUMMY) ' +
c 'RCDLEN(100)'
C callp Qcmd(%trim(comando) :
C %len(%trim(comando)))
*
C eval time_start = %timestamp()
*
C/EXEC SQL
C+
C+ INSERT INTO QTEMP/DUMMY (DUMMY) VALUES('nada')
C+
C/END-EXEC
* ---------------------------------------------------------------
* Definición de sentencias SQL.
C/EXEC SQL
C+ DECLARE C1 DYNAMIC SCROLL CURSOR FOR S1
C/END-EXEC
*
/free
SqlStmt = 'Select distinct ' +
%trim(Formula) +
' from qtemp/dummy' ;
//
/end-free
*
C/EXEC SQL
C+ PREPARE S1 FROM :SqlStmt
C/END-EXEC
*
C/EXEC SQL
C+ OPEN C1
C/END-EXEC
*
C/EXEC SQL
C+ FETCH NEXT FROM C1 INTO :Resultado
C/END-EXEC
*
*
C/EXEC SQL
C+ CLOSE C1
C/END-EXEC
* ---
*
C eval time_end = %timestamp()
C time_end Subdur time_start DiffSecsMs:*MS
C eval DiffSecs = DiffSecsMS / 1000000
*
* ---
C SQLCOD IFNE *ZEROS
C eval Resultado = 0
C eval poResult = Resultado
C eval poError = SQLERR
C else
*
C if %parms = 0
C 'Resultado:' Dsply
C Resultado Dsply
*
C eval dum = %trim(%editc(DiffSecs:'J'))
C 'Elapsed T.' Dsply
C dum Dsply
C eval form = *blanks
C 'Oprima Enter'Dsply form
*
c else
c eval poResult = Resultado
C eval poError = *blanks
c endif
C END
*
C eval *inlr = *on
| |
SQLRPGLE - Get the month name from SQL
Posted By: jimmy octane Contact |
Select CYYMMDD,
Case Substr( Digits( CYYMMDD ), 4, 2 )
When '01' Then 'JAN'
When '02' Then 'FEB'
When '03' Then 'MAR'
When '04' Then 'APR'
When '05' Then 'MAY'
When '06' Then 'JUN'
When '07' Then 'JUL'
When '08' Then 'AUG'
When '09' Then 'SEP'
When '10' Then 'OCT'
When '11' Then 'NOV'
When '12' Then 'DEC'
Else 'Uh Oh..Bad Data!'
End
From FileName
Select CYYMMDD,
Substr( ' JANFEBMARAPRJUNJULAUGSEPOCTNOVDEC' ),
(Integer( Substr( Digits( CYYMMDD ), 4, 2 ) ) * 3 + 1 ), 3 )
From FileName
| |
SQLRPGLE - Some date processing with SQL
Posted By: jimmy octane Contact |
SQL Date Support
Raw Data
Order No. Ship Date
1 19,970,620
2 19,970,907
3 19,970,824
4 0
5 19,970,927
6 0
7 19,970,929
8 0
9 19,970,903
10 0
This query gives us a more readable date
Recall from last month that the Digits
function converts a numeric expression
to a character string. It’s necessary
to use the Digits function here because
we can’t perform character-string operations
such as concatenation on numeric columns
(e.g., OhShDt). Also recall that the Substr
function extracts the portion of the character
string named in the first argument, starting in
the position specified in the second argument,
for the length specified in the third argument.
The concatenation operator adds a hyphen to the
first and second substrings and connects the
three substrings to form one long string.
Select OhNum,
Substr( Digits( OhShDt ), 1, 4 )|| '-' ||
Substr( Digits( OhShDt ), 5, 2 )|| '-' ||
Substr( Digits( OhShDt ), 7, 2 )
As ShipDate
From OrdHdr
This query produces these results:
Order No. Ship Date
1 1997-06-20
2 1997-09-07
3 1997-08-24
4 0000-00-00
5 1997-09-27
6 0000-00-00
7 1997-09-29
8 0000-00-00
9 1997-09-03
10 0000-00-00
SQL has strong support for native date, time, and timestamp data types.
To see how to take advantage of SQL’s date support,
let’s start with another numeric column in the OrdHdr table called
OhDtOr (order date), which is stored in the same packed 8,0 format
as OhShDt (YYYYMMDD). To calculate an estimated ship date,
we use the Date function to convert the numeric order dates
to native, or true, dates and then use SQL’s date support to
add 10 days to the order dates (SQL lets us add durations
only to date fields, not to numeric or character values):
Select OhNum,
Substr( Digits( OhDtOr ), 1, 4 )|| '-' ||
Substr( Digits( OhDtOr ), 5, 2 )|| '-' ||
Substr( Digits( OhDtOr ), 7, 2 )
As OrderDate,
Date( Substr( Digits( OhDtOr ), 1, 4 )
|| '-' ||
Substr( Digits( OhDtOr ), 5, 2 )
|| '-' ||
Substr( Digits( OhDtOr ), 7, 2 ) )
+ 10 Days As EstShipDate
From OrdHdr
This query produces these results:
Order No. Order Date EstShipDa
1 1997-06-15 06/25/97
2 1997-09-01 09/11/97
3 1997-08-15 08/25/97
4 1997-09-29 10/09/97
5 1997-09-20 09/30/97
6 1997-09-28 10/08/97
7 1997-09-18 09/28/97
8 1997-09-25 10/05/97
9 1997-08-24 09/03/97
10 1997-09-27 10/07/97
The third entry in the Select clause uses the Date
function to return a native date rather than a
character string. In this case, the Date function
has a complex character string expression as its argument;
however, it can take several other types of arguments.
When the Date function’s argument is a character string,
the string must be in one of several valid date formats.
Because the ISO format used in the query is one of the valid
formats, the Date function returns a native date representing
the order date. Notice how I added 10 days to the native
date by specifying a value of 10 and a duration of Days.
You can add other values. For example, to calculate a purge
date, I can add 1 year, 2 months, and 5 days to the order date
as follows:
Select
OhNum,
Date('
Substr( Digits( OhDtOr ), 1, 4 ) || '-'||
Substr( Digits( OhDtOr ), 5, 2 ) || '-'||
Substr( Digits( OhDtOr ), 7, 2 ) )
+ 1 Year + 2 Months + 5 Days
As PurgeDate
From OrdHdr
| |
SQLRPGLE - SQL Replacing Strings
Posted By: jimmy octane Contact |
QUESTION:
Using SQL, how do I fill a 128-byte character field with
asterisks? Please don't tell me I have to key every one
of those puppies into my SQL command.
--Jack
I've got good news. Use the SPACE function to generate
128 spaces. Use the TRANSLATE function to convert the
spaces into asterisks.
insert into somefile (somefield)
values (translate(space(128),'*',' '))
Or use the REPLACE function to convert the spaces
into asterisks.
insert into somefile (somefield)
values (replace(space(128),' ','*'))
I haven't run any speed tests, but TRANSLATE seems
to run faster than REPLACE.
If you had wanted to fill your field with a literal longer
than one character, you would have had to use REPLACE.
The following SQL command repeats the word VOID, followed
by one blank, throughout the field.
insert into somefile (somefield)
values (replace(space(128),' ','VOID '))
| |
SQLRPGLE - Using SQL to create CSV file (QShell)
Posted By: jimmy octane Contact |
SQL presents an easy way to create CSV files. Use the CHAR function to convert
numeric fields to alpha format. SQL puts in the necessary minus signs and decimal
points. Concatenate all the fields together to get one big comma-delimited output field.
The following SQL command is an example of the technique. I use Qshell
to retrieve the data and load it into a file in the Integrated File System (IFS).
db2 "SELECT char(CUSNUM)||','||LSTNAM||','||INIT||','||
CITY||','||STATE||','||char(baldue) from qiws.qcustcdt"
| sed -n '/,/p' >> custdata.CSV
The CSV file looks like this:
938472 ,Henning ,G K,Dallas,TX,37.00
839283 ,Jones ,B D,Clay ,NY,500.00
392859 ,Vine ,S S,Broton,VT,439.00
938485 ,Johnson ,J A,Helen ,GA,3987.50
397267 ,Tyron ,W E,Hector,NY,.00
389572 ,Stevens ,K L,Denver,CO,58.75
846283 ,Alison ,J S,Isle ,MN,10.00
475938 ,Doe ,J W,Sutter,CA,250.00
693829 ,Thomas ,A N,Casper,WY,.00
593029 ,Williams,E D,Dallas,TX,25.00
192837 ,Lee ,F L,Hector,NY,489.50
583990 ,Abraham ,M T,Isle ,MN,500.00
It isn't necessary to run SQL under Qshell, of course, but doing so sure makes
it easy to build an IFS file.
| |
SQLRPGLE - Using SQL to change time in TimeStamp field
Posted By: Ringer Software Contact |
QUESTION:I have a timestamp field with the value of (1989-11-30-24.00.00.000000). Using SQL how can I change
the time value from '24.00.00.000000' to '00.00.00.000000'?
ANSWER:update myfile
set mystamp = timestamp(date(mystamp),time('00.00.00'))
where hour(mystamp) = 24
| |
SQLRPGLE - SQL Can Return One or a Few Records
Posted By: Ted Holt Contact |
SQL Can Return One or a Few Records
Hey Ted: (Ted Holt)
SQL's SELECT INTO statement works fine as long as only one record
matches the criteria in the WHERE clause. If the query returns more
than one record, the host variables are loaded with data, but the
SQL State variable, SQLSTT, has a value of 21000, which according
to the manual indicates a "Cardinality Violation." Can I assume
that the record loaded into the host variables really is the
first record in the returned dataset? Or do you have a better
suggestion?
--Brad
I suspect that the data in the host variables comes from the record
you're looking for, but being the ultra-conservative I am
(compared to me, Ronald Reagan is in the same league with Karl Marx),
I wouldn't count on it. Let me give you another suggestion.
If you're at V5R1 or above, add the FETCH FIRST n ROWS ONLY clause to
the SELECT statement. The number n can be omitted and defaults to the
value one, and either ROW and ROWS is acceptable. Here's an example:
select * into :SomeDataStructure
from SomeTable
Where Something = SomethingElse
order by SomeField
fetch first row only
If you're running an earlier release, you'll have to go to the
trouble of declaring a cursor, opening it, and fetching
from it one time.
You can use the FETCH FIRST n ROWS ONLY clause with the regular
SELECT statement, not just SELECT INTO. I threw together the
following short program to illustrate this usage. It lists the
first five customers in alphabetical order by name.
That is to say, it sorts the records in alphabetical order,
then returns the first five records from the sorted data.
Fqsysprt o f 132 printer
D SqlNormal c const('00000')
D SqlEOF c const('02000')
D Error s 12a
D CustRec e ds extname(QCUSTCDT)
C/exec sql
C+ set option closqlcsr=*endmod
C/end-exec
C/exec sql
C+ declare input cursor for
C+ select * from qcustcdt
C+ order by lstnam,init
C+ fetch first 5 rows only
C/end-exec
C eval *inlr = *on
C/exec sql
C+ open input
C/end-exec
C if SqlStt <> SqlNormal
C eval Error = 'Open'
C return
C endif
C dow '1'
C/exec sql
C+ fetch input into :CustRec
C/end-exec
C if SqlStt = SqlEOF
C leave
C endif
C if SqlStt <> SqlNormal
C eval Error = 'Fetch'
C except ErrorLine
C return
C endif
C except DtlLine
C enddo
Oqsysprt e ErrorLine 1
O Error
O SqlStt +0001
Oqsysprt e DtlLine 1
O CusNum
O LstNam +0001
O Init +0001
I sometimes use FETCH FIRST n ROWS only in interactive SQL
to create a small result set. It's similar to using the
Number of Records to Copy (NBRRCDS) parameter of the
Copy File (CPYF) command.
| |
SQLRPGLE - Creating table in QTEMP with SQPRPGLE
Posted By: jamie flanary Contact |
À*-------------------------------------------------------------------
À* CREATETBL - Create a table on the fly into QTEMP
À*
À* Had to create query over QSYS/QADBXFIL and extract my 5 fields
À* to a file called workfile.
À*-------------------------------------------------------------------
fWORKFILE if e k Disk rename(workfile:workfile2)
*
* Defined variables
*
d CmdString s 256
d CmdLength s 15 5
*
* Delete Work file incase it exists
*
c/Exec Sql
c+ DELETE FROM qtemp/somefile
c/End-Exec
*
* Create Work file in Qtemp
*
c/Exec Sql
c+ CREATE TABLE QTEMP/SOMEFILE (
c+ Filename Char (10) ,
c+ Library Char (10) ,
c+ Owner Char (10) ,
c+ Text Char (50) ,
c+ FileType Char (01)
c+ )
c/End-Exec
*
* File Description
*
c/Exec Sql
c+ LABEL ON TABLE QTEMP/SOMEFILE IS 'this is a junk file'
c/End-Exec
*
* Field examples only one field here TEXT and COLHDG
*
c/Exec Sql
c+ LABEL ON COLUMN QTEMP/SOMEFILE (FileName TEXT IS 'Test text')
c/End-Exec
c/Exec Sql
c+ LABEL ON COLUMN QTEMP/SOMEFILE(FileName IS 'Test column ')
c/End-Exec
c *start setll WORKFILE
c read WORKFILE
c dow not%eof(WORKFILE)
*
c/exec sql
c+ INSERT INTO QTEMP/SOMEFILE VALUES(:DBXFIL, :DBXLIB, :DBXOWN,
c+ :DBXTXT, :DBXTYP)
c/end-exec
*
c read WORKFILE
c enddo
*
c seton lr
*
| |
SQLRPGLE - SQL DELETE EXISTS
Posted By: jimmy octane Contact |
You should use the EXISTS command word, as follows:
C/EXEC SQL
C+ DELETE
C+ FROM FILEA A
C+ WHERE EXISTS (SELECT B.BDATE, B.BSTORE#
C+ FROM FILEBB B
C+ WHERE A.ADATE = B.BDATE
C+ AND A.ASTORE# = B.BSTORE#)
C/END-EXEC
For performance considerations, please make sure that FILEA has an index
defined as ADATE, ASTORE# and FILEBB has an index defined as BDATE, BSTORE#.
| |
SQLRPGLE - Listing fields by table using SYSCOLUMNS
Posted By: Gregory G. Ayca Contact |
SELECT SUBSTR(COLUMN_NAME,1,10) AS FIELD_NAME,
SUBSTR(DATA_TYPE,1,6) AS TYPE, LENGTH,
DIGITS(NUMERIC_SCALE) AS DEC,
SUBSTR(COLUMN_TEXT,1,20) AS DESCRIPTION,
IS_NULLABLE AS NULL,
SUBSTR(TABLE_NAME,1,10) AS TABLE_NAME,
SUBSTR(TABLE_SCHEMA,1,10) AS TABLE_SCHEMA,
SUBSTR(SYSTEM_TABLE_NAME,1,10) AS SYSTAB_NAME,
SUBSTR(SYSTEM_TABLE_SCHEMA,1,10) AS SYSTAB_SCHEMA
FROM SYSCOLUMNS
WHERE COLUMN_NAME LIKE \'%PRDC%\'
Note: The substr is needed only if you want to fit most info in one screen.
| |
SQLRPGLE - Having example
Posted By: jimmy octane Contact |
SELECT xWHS, xLOC into
C+ :savwhse, :savloca
C+ FROM xFile where xID='XI' and LLOT=:@Bins and xFAC=:@facode
C+ Group by xWHSE, XLOC
C+ Having sum(xOpen+xRcpt+xAdju-xIssue) > 0
| |
SQLRPGLE - Fetch variable number of records and process
Posted By: jimmy octane Contact |
The FETCH retrieves the number of rows specified by the first parameter.
Fqsysprt o f 132 printer
D CustData ds occurs(12)
D CustNumber 6 0
D CustName 12
D Rows s 3p 0
D Ndx s 3p 0
C *entry plist
C parm Rows
C/exec sql
C+ declare Customers cursor for
C+ select cusnum, lstnam || ' ' || init
C+ from qiws/qcustcdt
C/end-exec
C/exec sql
C+ open Customers
C/end-exec
C/exec sql
C+ fetch Customers for :Rows Rows
C+ into :CustData
C/end-exec
C for ndx = 1 to Rows
C ndx occur CustData
C except PLine
C endfor
C/exec sql
C+ close Customers
C/end-exec
C eval *inlr = *on
Oqsysprt e pline 1
O Ndx 4
O CustNumber + 1
O CustName + 1
After the FETCH retrieves the number of rows indicated by the ROWS variable, a simple loop lists the retrieved
records.
| |
SQLRPGLE - sql
Posted By: pbj Contact |
| |
SQLRPGLE - Retrieve the data from second or another member of pyhsical file
Posted By: Vellapandi.S.M Contact |
CREATE ALIAS libname/secondmember FOR Lib/filename(membername)
SELECT * FROM secondmember
this is equal for OVRDBF
| |
SQLRPGLE - Function to use SQL LIKE Predicate within RPG
Posted By: Birgitta Hauser Contact |
**************************************************************************
P* Procedure name: Like
P* Purpose: Search Pattern Like SQL Predicate LIKE
P* Returns: *ON = Found
P* Parameter: PPText => Text
P* Parameter: PPSearch => Search String (incl.% and/or _)
P* Parameter: PPEscape => Escape Char. for special Values % and _
**************************************************************************
P Like B Export
D Like PI N
D PPText 32740A varying Const
D PPSearch 32740A varying Const
D PPEscape 1A Const Options(*NoPass)
D ParmEscape C const(3)
D Found S 1A
*--------------------------------------------------------------------
C If %Parms >= ParmEscape
C/EXEC SQL
C+ Set :Found = Case when :PPText like :PPSearch escape :PPEscape
C+ then '1' else '0' End
C/End-EXEC
C else
C/EXEC SQL
C+ Set :Found = Case when :PPText like :PPSearch
C+ then '1' else '0' End
C/End-EXEC
C EndIf
C Return Found
P Like E
This function can be used as follows:
D Text S 256A Varying
D Search S 256A Varying
D Escape S 1A
*--------------------------------------------------------------------
/Free
Text = 'The quick brown fox';
Search = '%quick%fox';
If Like(Text: Search);
Dsply 'True';
EndIf;
Text = 'Discount 10%';
Search = '%10!%%';
Escape = '!';
If Like(Text: Search: Escape);
Dsply 'True';
EndIf;
*InLR = *On;
/End-Free
| |
SQLRPGLE - Using Procedures to Embed SQL in Free Format RPGIV
Posted By: Joe DeRoche Contact |
H DftActGrp(*NO)
DPgmRefRecs E DS ExtName(PGMREF)
D#OpenSQL PR
D#ReadSQL PR
D#CloseSQL PR
DRecCount S 3S 0 Inz(*Zeros)
/Free
CallP #OpenSQL();
CallP #ReadSQL();
DoW SQLCod = 0;
RecCount += 1;
CallP #ReadSQL();
EndDo;
CallP #CloseSQL();
*INLR = *On;
Return;
/End-Free
*----------------------------------------------------------------
P#OpenSQL B Export
D#OpenSQL PI
C/Exec SQL
C+ Declare PGMRefCsr Cursor for
C+ Select * from PGMREF
C/End-Exec
C/Exec SQL
C+ Open PgmRefCsr
C/End-Exec
P#OpenSQL E
*----------------------------------------------------------------
P#ReadSQL B Export
D#ReadSQL PI
C/Exec SQL
C+ Fetch PgmRefCsr into :PgmRefRecs
C/End-Exec
P#ReadSQL E
*----------------------------------------------------------------
P#CloseSQL B Export
D#CloseSQL PI
C/Exec SQL
C+ Close PgmRefCsr
C/End-Exec
P#CloseSQL E
| |
SQLRPGLE - Using Procedures to Embed SQL in RPG Part II
Posted By: Kenneth McMenamy Contact |
*
D PrepareSql Pr
*
D CloseSQL Pr
*
D ReadNext Pr N
*
D isPrepared S N Inz( *Off )
*
D SqlData Ds Inz
D sqlDEXPC Like(DEXPC)
D sqlDPOUT Like(DPOUT) /free
Dow ReadNext() ;
//Each time you hit ReadNext a new record is retrieved from the cursor.
//The ReadNext Procedure bails on EOF or if an error occurs.
// Do your Program processing here
EndDo ;
*InLr = *On ;
/end-free
*--------------------------------------------------------------------*
* Prepare Select Statement *
*--------------------------------------------------------------------*
P PrepareSql B
D PrepareSql PI
C/EXEC SQL
C+ DECLARE A CURSOR FOR
C+ SELECT DEXPC AS CODE, SUM(DPOUT) AS VALUE
C+ FROM DAILY01F
C+ GROUP BY DEXPC
C/END-EXEC
C/EXEC SQL
C+ OPEN A
C/END-EXEC
*
P PrepareSql E
*--------------------------------------------------------------------*
* Read Next *
*--------------------------------------------------------------------*
P ReadNext B
D ReadNext PI N
*
* Lazy Initialization of Prepared Statment *
C If Not isPrepared
C CallP PrepareSQL()
C Eval isPrepared = *On
C EndIf
*
C/Exec SQL
C+ FETCH NEXT FROM A INTO :SqlData
C/End-exec
C If SqlCod < 0 Or SqlCod = 100
C CallP CloseSQL()
C Return *Off
C Else
C Return *On
C EndIf
P ReadNext E
*--------------------------------------------------------------------*
* Close Cursor *
*--------------------------------------------------------------------*
P CloseSQL B
D CloseSQL PI
C/Exec SQL
C+ Close A
C/End-exec
P CloseSQL E
| |
SQLRPGLE - Remove duplicate records
Posted By: J Albert Contact |
Remove duplicate records in FILE1 that
* also exist in FILE2
C/exec sql
C+ Delete From FILE1
C+ Where Exists (select * from FILE2 where
C+ FILE1.field1 = FILE2.field1 and
C+ FILE1.field2 = FILE2.field2 and
C+ FILE1.field3 = FILE2.field3 and
C+ FILE1.field4 = FILE2.field4)
C/end-exec
| |
|
|
|
