0% found this document useful (0 votes)
191 views

RPGLE - Example Chaining To Logical File To Write/update Data

This document provides examples of RPGLE code for chaining to a logical file to write or update records based on a search key, loading data to a subfile one page at a time, and reading a file to calculate total sales dollars and quantity by product.

Uploaded by

rinkutimmu
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOC, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
191 views

RPGLE - Example Chaining To Logical File To Write/update Data

This document provides examples of RPGLE code for chaining to a logical file to write or update records based on a search key, loading data to a subfile one page at a time, and reading a file to calculate total sales dollars and quantity by product.

Uploaded by

rinkutimmu
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOC, PDF, TXT or read online on Scribd
You are on page 1/ 9

RPGLE  -  Example chaining to logical file to

write/update data
Posted By: JimmyOctane    Contact

C*===============================================
C* Chaining to a logical file, if record found
C* then update quantities else write record.
C*===============================================
C TheKey02 Klist
C Kfld PGPGRP
C Kfld PGPCA1
C Kfld PGPCA2
C Kfld PGPRDCS2
C*
C* Chain to file with keylist if found add to existing values
C* else Z-ADD (Zero out and add)
C*
C TheKey02 Chain AVAILABLEW
C*
C* This snippet of code is getting total quantity on hand/pick
C*
C If %Found(AVAILABLEW)
C Eval ONHAND = ONHAND + LPLOQT
C Eval ONPICK = ONPICK + LPPIQT
C + MOMQTY
C Update AVAILR
C Else
C Movel(p) PGPRDCS2 PRODUCT
C Movel(p) PGPGRP PGROUP
C Movel(p) PGPCA1 CAT1
C Movel(p) PGPCA2 CAT2
C Movel(p) PGDESC DESC
C Z-add LPLOQT ONHAND
C Z-add LPPIQT ONPICK
C Write AVAILR
C Endif
C*===============================================

RPGLE  -  Example loading subfile one page at a time


Posted By: JimmyOctane    Contact

C*===============================================
C* $LoadSFL - Load the Main Menu.
C* load all errors so can total
C*===============================================
CSR $LoadSFL Begsr
C*
C If SavRrn > *Zeros
C Z-add SavRrn RRN1
C Z-add SavRrn SCRRN
C Endif
C*
C* Subfile page is set to 12. show 12 records to user at a time
C* This load function sequences the data by customer # or Name
C* Depending on what the value of ReadBy is.
C*
C Do 12
C Select
C When ReadBy = 'C'
C Read C40NAM1
89
C When ReadBy = 'N'
C Read C40NAM2
89
C Endsl
C*
C If Not*In89
C Movel(p) C4NUM S1CUSTOMER
C Movel(p) C4NAME S1CNAME
C Add 1. RRN1
C Add 1. SCRRN
C Write SUB01
C Endif
C*
C Enddo
C*
C Z-add SCRRN SavRrn
C*
C* If no records in subfile then do not disply the subfile.
C*
C If SavRrn = *Zeros And *In89
C Eval *In50 = *Off
C Endif
C
C*
C Endsr
C*===============================================

RPGLE  -  Example position file to product read equal


to total sales dollars
Posted By: JimmyOctane    Contact
C*===============================================
C* This code reads the file C40ISD by product
C* and Totals Dollars and Qty Sold.
C*===============================================
C Clear Sales
C Clear Count
C*
C PRDC Setll C40ISD
C PRDC Reade C40ISD
C Dow Not%Eof(C40ISD)
C*
C* The "+" preforms the same function as ADD.
C*
C Eval Sales = (Sales + C4DOL$)
C Eval Count = (Count + C4QTY)
C*
C PRDC Reade C40ISD
C Enddo
C*===============================================

Keyword:

DDS  -  Logical file with select logic


Posted By: JimmyOctane    Contact

A R PHYR PFILE(PHYSICAL)
A K PHPRDC
A K PHRDDT
A S PHSTAT COMP(NE 'D')
A PHORDS RANGE(20 59)
A PHORDT COMP(NE 'SA')
A PHRDDT COMP(GE 20030901)

CLLE  -  Example of code to return previous program


name
Posted By: JimmyOctane    Contact

PGM PARM(&CALLER &PGM)

DCL VAR(&CALLER) TYPE(*CHAR) LEN(10)


DCL VAR(&PGM) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
CHGVAR VAR(&CALLER) VALUE(' ')
SNDPGMMSG MSG('WHO CALLED ME?') TOPGMQ(*PRV (&PGM)) +
KEYVAR(&MSGKEY)
RCVMSG PGMQ(*PRV (&PGM)) MSGTYPE(*INFO) +
MSGKEY(&MSGKEY) RMV(*YES)
SENDER(&SENDER)
CHGVAR VAR(&CALLER) VALUE(%SST(&SENDER 56 10))
GOTO CMDLBL(ENDPGM)
ERROR: CHGVAR VAR(&CALLER) VALUE(' ')
ENDPGM: ENDPGM

DDS  -  Message subfile example


Posted By: Reynoo Moore    Contact

*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* MSGSFL: Message Subfile.
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
A R MSGSFL SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMQ SFLPGMQ(10)
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* MSGCTL: Subfile Control for MSGSFL
*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
A R MSGCTL SFLCTL(MSGSFL)
A OVERLAY
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N03 SFLEND
A SFLSIZ(0002)
A SFLPAG(0001)
A PGMQ SFLPGMQ(10)

DDS  -  Subfile and Subfile control example


Posted By: Reynoo Moore    Contact

A*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-
=-=-=-=-=
A* SUB01: Subfile #01
A* Selection of All Survey Question Type.
A*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-
=-=-=-=-=
A R SUB01 SFL
A*
A SFLNXTCHG
A S01OPTN 1A B 9 3
A 40 DSPATR(RI)
A 40 DSPATR(PC)
A S01SPLF 10A O 9 6
A S01UDTA 10A O 9 28
A S01HTML 1A O 9 40
A S01PDF 1A O 9 45
A S01JNAM 10A O 9 17
A*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-
=-=-=-=-=
A* SFL01CTL: Subfile Control for SUB01
A*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-
=-=-=-=-=
A R SUB01CTL SFLCTL(SUB01)
A*
A SFLSIZ(0014)
A SFLPAG(0013)
A CF06(06 'Add')
A CF12(12 'Cancel')
A RTNCSRLOC(&#REC &#FLD)
A OVERLAY
A SFLCSRRRN(&WHERE01)
A 50 SFLDSP
A 51 SFLDSPCTL
A 52 SFLCLR
A 89 SFLEND(*MORE)
A SCRRN01 4S 0H SFLRCDNBR(CURSOR)
A #REC 10A H
A #FLD 10A H
A WHERE01 5S 0H
A 2 2TIME
A COLOR(BLU)
A EDTWRD('0 : : ')
A 1 2DATE
A COLOR(BLU)
A EDTWRD('0 / / ')
A 1 71USER
A COLOR(BLU)
A 2 71SYSNAME
A COLOR(BLU)
A S01CDAY 9A O 1 11COLOR(BLU)
A 5 2'Type options, press Enter.'
A COLOR(BLU)
A 6 4'2=Edit'
A COLOR(BLU)
A 8 6'SPLF Name '
A DSPATR(UL)
A COLOR(WHT)
A 8 2'Opt'
A DSPATR(UL)
A COLOR(WHT)
A 3 69'DRPT001R/01'
A 2 26'Daily Reports SPLF
Maintenance'
A S01CNAM 30A O 1 26
A 8 17'Job Name '
A DSPATR(UL)
A COLOR(WHT)
A 8 39'HTML'
A DSPATR(UL)
A COLOR(WHT)
A 8 44'PDF'
A DSPATR(UL)
A COLOR(WHT)
A 6 12'4=Delete'
A COLOR(BLU)
A 6 22'5=Display'
A COLOR(BLU)
A 8 28'User Data '
A DSPATR(UL)
A COLOR(WHT)

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

You might also like

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy