B ILE Labs

RPG-ILE LABS

NAVIGATION CHART

DAY 1

DAY 2

DAY3

DAY 4

COMPARISON CHART

COMPILER DIRECTIVE

Data Type Conversion

TESTING

CHEAT SHEETS

ADVANCED DATABASE PROCESSING

PROCEDURES and MODULES. Bind by COPY and REFERENCE

LOGIC CYCLE

FEATURES

FLAT PHYSICAL FILE SERVICE PROGRAM

PROJECT

BINDER LANGUAGE

SIX DAYS BREAKUP

EMBEDDED SQL OPERATION EXTENDERS

API

BASICS ARRAYS

RLU

BUILT IN FUNCTIONS

DATA Q PROGRAMMING

MISC

DATA AREA

ERROR HANDLING*

POINTERS

DATE TIME PROGRAMMING

MESSAGING

FREE

NEW KEYWORDS

MONITOR

KA and KB indicators ODP

ACTIVATION GROUP

DATA STRUCTURES SUBFILES STRING OPERATION

VALIDATION

DISPLAY FILES

SMALL UTILITY PROJECT (imp

Indicator data structure

PROJECT

!!!)

1

RPG-ILE LABS

DATABASE PROCESSING

2

RPG-ILE LABS

SIX DAYS BREAKUP Day

1

Coverage COMPARISON CHART FEATURES CHEAT SHEETS OPERATION EXTENDERS BASICS ARRAYS BUILT IN FUNCTIONS DATE TIME PROGRAMMING DATA STRUCTURES

2

DATA AREA STRING OPERATION VALIDATION SUBFILES API RLU

3

DISPLAY FILES COMPILER DIRECTIVE Data Type Conversion

4

5 6

Remarks

ADVANCED DATABASE PROCESSING ERROR HANDLING ODP PROCEDURES and MODULES. Bind by COPY and REFERENCE SERVICE PROGRAM BINDER LANGUAGE ACTIVATION GROUP DATA Q PROGRAMMING MESSAGING EMBEDDED SQL LOGIC CYCLE MONITOR TESTING POINTERS FREE SMALL UTILITY PROJECT (imp !!!)

Assignments

3

RPG-ILE LABS

SMALL UTILITY PROJECTS ( Use ILE built in functions where possible. ) 1. 2. 3. 4.

Utility to accept object name from user and display locations where the sources of the object are present. Compare utility : Compare contents of 2 members of a source physical file and produce a report. Utility to locate all libraries where specified object is present and write the libraries to a physical file. Utility to locate source member and source physical file of the specified object and store it to a database file. Following report should be created :Objec t Nam e PF001

PF002

Object Library

L1 L2 L3 L4 L11 L22

Src. PF.

MySRC SamSRC SamSRC QDBHSRC MySRC EMOSRCDBF

Src. Member Names PF001 PF001 PFCUST CUSTDATA MPF001 PF002

Source Library

Lib002 Lib003 Lib001 L4 GHOHUBSPH GHOHUBCPH

5.

Utility to display all members of a source PF. User selects a few members. Combine all members and store them to a new member (name specified by user). The data for each member should be easily identifiable.

6.

Write a utility to accept member name and type from user and set of libraries to search. After user finishes entering the libraries (or asks you to refer to the library list), search each for presence of that member (search all source physical files in the library) for presence of that member.

7. RPGLE editor : Create a simple multi-Document Editor, which behaves like Notepad. (Notepad /400 ! ) 8. A utility to display all physical and logical files containing XXXX entered by user ( eg. : User enters “FSTS” as a search string. The utility scans the library list / list of libraries specified by user and displays names and libraies of all Physical files and logical files containing the specified field name.) 9.

Utility to display all source physical files present in all libraries in the library list and write the list to a database.

File compilation utility 1.A Physical file P1 may have several logical files (say L1,L2,L3,L4 … ) based on it. Programmer makes a change to DDS of the Physical file and updates the PF object using CHGPF. This does not automatically update the LFs sicne they all use old definition. To update all Logical files, you need to compile all of them. This can get quite tedious. Build a utility to automatically determine and compile all the logical files. 2.

Write a Utility to read source code of a program (member name will be specified by user) and write it to a spool file after indenting it. Indentation will be provided to IF statements and Do loops. ***

4

RPG-ILE LABS 1. PROJECTS 1.

A new module is to be developed for a bank. The module is for Calculation of interest on Saving A/c. It should allow inputing new customer, and saving any transactions done by the customer. For formula of calculating interest , see EPM.

2.

5

RPG-ILE LABS

RPG - ILE LABS LAB : Source Physical file : QRPGLESRC

LAB : Study of new Specs : HFDICOP. Structure and purpose of each. New Spec : CX. F : SPEC :

6

RPG-ILE LABS

LAB : Data Types in RPGLE.Member type and compilation commands. A B D F G I P S T U Z *

: : : : : : : : : : : :

LAB

Character fixed Binary date Field Floating point Graphics character set Signed Integer Packed Decimal Zoned Field Time field Unsigned Integer Field Timestamp Field Pointer Field : Introduction of RPG programing. Declaring Variables in RPG. DA01 C*

S

2P 0 Inz(-1)

7

RPG-ILE LABS C C* C

A01

DSPLY EVAL

*INLR = *ON

DCON1 C CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ+ D cdefghijklmnopqrstuvwxyz') C CON1 DSPLY C EVAL *INLR = *ON LAB : RPG Constructs IF, DOW, DO, DOU,LEAVE ,ITER. * Declare a variable.Display a string,float and integer * ===================================================== Djsr S 20A Djsr1 S 20A C EVAL jsr1= 'string1' C EVAL jsr = 'string2' C if jsr1 <> jsr C EVAL jsr1='xx' C endif C jsr1 DSPLY C EVAL *INLR = *ON LAB : DO WHILE * (DEMO OF DO WHILE LOOP) DN S C DOW C EVAL C N IFEQ C ITER C ENDIF C N DSPLY C ENDDO C EVAL Output : 1 3 4

Output :

5i 0 N <=4 N=N+1 2

*INLR = *ON

1 2 3 4 5

LAB : ROUNDING RESULTS OF CALCULATION LOGIC : 1.124 + 0.001 ----1.13 (ROUNDED) 1.12 (NOT ROUNDED) DISPLAY FILE DDS : A A R R1 A A

DSPSIZ(24 80 *DS3) 5 7

9'WITHOUT ROUNDING : ' 9'WITH ROUNDING : '

8

RPG-ILE LABS A A

DTOTAMT1 DTOTAMT2

5Y 2B 5Y 2B

5 30EDTCDE(Q) 7 30EDTCDE(Q)

RPGLE PROGRAM : FDSRND CF E WORKSTN DCRS S 5S 3 INZ(1.121) DRATE S 5S 3 INZ(0.001) DTOTAMT1 S 5S 2 INZ(0) DTOTAMT2 S 5S 2 INZ(0) C DO 5 C EVAL TOTAMT1 = RATE + CRS C* now try with (H) for Rounding. C EVAL(H) TOTAMT2 = RATE + CRS C EVAL DTOTAMT1 = TOTAMT1 C EVAL DTOTAMT2 = TOTAMT2 C EXFMT R1 C EVAL RATE = RATE + 0.001 C ENDDO C SETON

LAB

LR

: Interactive Source Debugger

Step 1 : Compile the program with Debugging Views set to *SOURCE. This allows the Debugger to access the source code of the program and display it. Step 2 : Use STRDBG and press F4. *YES. Press Enter.

Specify “Display Module Source “ parameter as

Step 3 : The Source code will be displayed. Take the cursor to the line that needs a break point and press F6.

In the Figure above, the break point is set at Line 2. Perss F10 to to exit out and call the LE02 program. It is displayed in the debugger. The control will be at first executable line. Press F10 to step through the code. To Display the current value of a variable : Bring the cursor under the variable and press F11.

9

RPG-ILE LABS Press F3 to exit Debugger. Issue the ENDSBG command to end the Debug mode.

LAB : LEAVESR

: to leave a Sub routine !

Linkage : RPLEAVE CODE : da s 4s 0 inz(4) d c 'BEfore SR' dsply c ExSR SR001 c 'After SR' Dsply c Eval *inlr = *on c Return c* c SR001 BegSR c 'SR starting' Dsply c if a = 4 c LeaveSR c EndIf C* ---------------------------------------C* The following line never gets executed ! C* ---------------------------------------c 'Ending SR' Dsply c EndSR PF contents : --OUTPUT DSPLY DSPLY DSPLY

: BEfore SR SR starting After SR

REMARKS : LeaveSR is to leave the currently executing SR.

LAB : For loop dn1 d d d d c c c c c

s

n1

4s 0 inz(0)

For dsply EndFOr Eval Return

n1= 10 DOWNTO 1

by 2

*inlr = *on

10

RPG-ILE LABS If n1 increments : c

For

n1= 1 TO 10

by 2

For

n1= 10 DOWNTO 1

If n1 decrements : c

by 2

in both cases the step size is 2.

11

RPG-ILE LABS

Lab : H-SPECS H DATFMT(*YMD) DJSRDT1 C JSRDT1 C

S

D

INZ(D'04/12/10')

DSPLY SETON

LR

H DATFMT(*YMD) CURSYM('£') H* ALT 156 FOR POUND SIGN H* DJSRDT1 S DCIH S C JSRDT1 DSPLY C CIH DSPLY C SETON

D INZ(D'04/12/10') 7P 2 INZ(120.25) LR

VALID DATE FORMATS : *iso,mdy,*ymd,*jul,*usa,*jis,*eur VALID TIME FORMATS: *HMS *USA *EUR *JIS SPECIFYING THE SEPERATOR FOR THE DATE FORMAT : (SEE THE ONLINE HELP - EXCELLENT !) H DATFMT(*DMY-) H* date format is DMY and seperator char is - (dash) DDT1 S D INZ(D'12-12-04') c DT1 DSPLY c SETON

LR

LAB : USING OVERLAY FOR DATES DDT1 DDAT1 DDATY DDATM DDATD C C C C C C

DS D

4 2 2 DT1 DAT1 DATY DATM DATD

DATFMT(*ISO-) INZ(D'1994-06-16') OVERLAY(DAT1:1) OVERLAY(DAT1:6) OVERLAY(DAT1:9)

DSPLY DSPLY DSPLY DSPLY DSPLY SETON

LR

LAB : Working with dates HDATFMT(*DMY) ddt1 s c adddur c adddur c adddur c dt1 dsply c* output is 04/07/07 c eval HDATFMT(*DMY) ddt1

s

8D inz(D'01/04/04') 3:*days dt1 3:*months dt1 3:*Years dt1 *inlr=*on

8D

inz(D'01/04/04')

12

RPG-ILE LABS ddt2 c c c* c

s

dt1 dt2

adddur dsply eval

8D inz(D'01/03/03') 3:*days dt2 *inlr=*on

EXAMPLE 3 : SUBtract duration HDATFMT(*DMY) ddt1 s ddt2 s c dt1 subdur c dt2 dsply c* Output : 29/03/04 c eval HDATFMT(*DMY) ddt1 s ddt2 s dn s c dt1 adddur c dt2 dsply c* Output : 01/02/04 c dt2 adddur c dt2 dsply c* Output : 03/03/04 c eval HDATFMT(*DMY) dds1 dd dsep1 dm dsep2 dy ddt1 c c d c m c y c

8D inz(D'01/04/04') 8D inz(D'01/03/03') 3:*days dt2 *inlr=*on

8D inz(D'01/01/04') 8D 2s 0 inz(31) n:*days dt2 n:*days

dt2

*inlr=*on

ds

s movel dsply dsply dsply eval

2s 0 1a 2s 0 1a 2s 0 8D inz(D'15/02/04') dt1 ds1

*inlr=*on

LAB : SUBDUR H TIMFMT(*HMS:) DDS1 DSTARTTM DENDTM DH1 DH2 DM1 DM2 DTOTTIME C STARTTM C ENDTM C H1 C H2 C M1 C M2

DS

S

DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY

T T 2S 2S 2S 2S T

0 0 0 0

INZ(T'07:00:00') INZ(T'10:21:00') OVERLAY(STARTTM:1) OVERLAY(ENDTM:1) OVERLAY(STARTTM:4) OVERLAY(ENDTM:4) INZ(T'00:00:00')

13

RPG-ILE LABS C C C C

ENDTM

SUBDUR SUBDUR DSPLY SETON

TOTTIME

H1:*H M1:*MN

TOTTIME TOTTIME LR

OUTPUT : 03:21:00 LAB

: SUBDUR

H TIMFMT(*HMS:) DSTARTTM DENDTM DH1 DM1 C STARTTM C ENDTM C ENDTM C ENDTM C H1 C M1 C

S S S S

T INZ(T'07:00:00') T INZ(T'10:50:00') 3S 0 3S 0 DSPLY DSPLY SUBDUR SUBDUR DSPLY DSPLY SETON

STARTTM STARTTM

H1:*H M1:*MN LR

OUTPUT : DSPLY 07:00:00 DSPLY 10:50:00 DSPLY 3 DSPLY 230 LAB : SUBDUR H DATFMT(*DMY/) DSTARTDT DENDDT DDAYS C ENDDT C DAYS C

S S S

SUBDUR DSPLY SETON

D INZ(D'10/12/04') D INZ(D'15/12/04') 3S 0 STARTDT DAYS:*D LR

OUTPUT : 5 LAB : ADDDUR H DATFMT(*DMY/) DSTARTDT DENDDT DDAYS C STARTDT C ENDDT C OUTPUT

S S S

ADDDUR DSPLY SETON

D INZ(D'10/12/04') D 3S 0 INZ(25) DAYS:*D ENDDT LR

:

04/01/05 LAB : ACCESSING SYSTEM DATE H DATFMT(*DMY/) DENDDT C C ENDDT

S

MOVE DSPLY

D *DATE

DATFMT(*DMY) ENDDT

14

RPG-ILE LABS C

SETON

LR

OUTPUT : CURRENT SYSTEM DATE LAB : Extracting date,month year fromdate H DATFMT(*ISO) DDT1 DTR C C TR C

S S

EXTRCT DSPLY EVAL

D INZ(D'2004-12-10') 4S 0 INZ(0) DT1:*Y TR *INLR = *ON

LAB : TEST opcode to test validity of Date, time and Timestamp H DATFMT(*ISO) DDT1 S D INZ(D'2004-12-10') DDT2 S 6S 0 INZ(041312) DTR S 4S 0 INZ(0) C TEST DT1 C* ____________________________ C* If date is not a valid date C* with *ISO format, C* IND 55 is TURNED ON. C* ____________________________ C IF *IN55 = *OFF C 'dt1 valid' DSPLY C ENDIF C* OUTPUT : DT1 VALID C* Repeat this test for C* DT2 C* --------------------C *YMD TEST(D) DT2 C* ----------------------C* This date is not valid. C* ----------------------C IF *IN55 = *OFF C 'DT2 valid' DSPLY C ENDIF C EVAL *INLR = *ON

55

55

Notes : 1. 2. 3. 4.

No need to specify *YMD or any other format in Factor 1, if the variable to be tested is defined as Date/Time. Also OPERATION EXTENDER is not required if the variable to be tested is of TYPE DATE TIME or TIMESTAMP. IF a character or numeric variable is to be tested, specify the format in Factor 1. While testing DT1, the format for date is taken as *ISO. While testing DT2, Format is taken from factor 1 and tested against the contents of DT2. The month specified here is 13, which is not valid for a month value. So indicator 55 is turned ON.

TESTING VALIDITY OF TIME H TIMFMT(*ISO) DTM1 DTM2 C

S S TEST

T INZ(T'10.12.14') 6S 0 INZ(101214) TM1

55

15

RPG-ILE LABS C C C C* C* C* C* C C* C* C* C C C c c C

IF DSPLY ENDIF OUTPUT : TM1 VALID Repeat this test for TM2 --------------------*HMS TEST(T) ----------------------This TIME is not valid. ----------------------IF 'TM2 valid' DSPLY ENDIF TM1 dsply TM2 dsply EVAL 'TM1 valid'

*IN55 = *OFF

TM2

55

*IN55 = *OFF

*INLR = *ON

TESTING VALIDITY OF TIMESTAMP H TIMFMT(*ISO) DTS1 S C TEST C IF C 'TS1 valid' DSPLY C ENDIF C* OUTPUT : TS1 VALID c TS1 dsply C EVAL

Z

INZ(Z'2004-12-10-10.12.20.000000') TS1 55 *IN55 = *OFF

*INLR = *ON

LAB: Program to calculate days between 2 dates. Program accepts date values into fields with edit code of Y. If a wrong date is unput by the user, control directly enters PSSR. Better approach of accepting dates is previous lab. RPGLe program RPDATE1 : H DATFMT(*DMY) H* PROGRAM TO CALCULATE PENALTY. ISSUES DATE AND RECPT DATE ARE H* ARE ACCEPTED. IF THE RECPT DATE IS 7 DAYS OR LESS, NO PENALTY. H* FOR EVERY ADDITIONAL DAY, PENALTY IS Rs 5/- PER DAY. H* ---------------------------------------------------------------H* FDSPENAL CF E WORKSTN F* DNODATE S 6S 0 INZ(0) DNOTIME S 6S 0 INZ(0) DDELTA S 4S 0 INZ(0) DISDAT S D INZ(D'01/01/01') DRCDAT S D INZ(D'01/01/01') C DOW *IN03 = *OFF C IF *IN03 = *ON C EVAL *INLR = *ON C RETURN C ENDIF C* C MOVE NODATE DISDAT C MOVE NODATE DRCDAT

16

RPG-ILE LABS C EXFMT RDATE C SETOFF C MOVE DISDAT ISDAT C MOVE DRCDAT RCDAT C RCDAT SUBDUR ISDAT DELTA:*D C EVAL DELTA = DELTA - 7 C IF DELTA<0 C EVAL DPENAL = 0 C ITER C ENDIF C* C DELTA MULT 5 DPENAL C GONXT TAG C ENDDO C EVAL *INLR = *ON C RETURN C* --------------------------------------------------C *PSSR BEGSR C SETON C GOTO GONXT C ENDSR

7778

7778

Display file listing : DSPENAL A A A A A A A A A A A A A A A A A

DSPSIZ(24 80 *DS3) CA03(03) R RDATE DISDAT 77

DRCDAT

78 DPENAL

6 4'ISSUE DATE :' 8 4'RECPT DATE : ' 6Y 0B 6 19EDTWRD(' / / EDTMSK(' & & COLOR(WHT) ERRMSG('INVALID 6Y 0B 8 19EDTWRD(' / / EDTMSK(' & & COLOR(WHT) ERRMSG('INVALID 12 4'PENALTY AMOUNT 4Y 0O 12 23EDTCDE(3) COLOR(RED) 12 29'Rs'

') ') DATA') ') ') DATA') : '

LAB : Loading date values to Physical file : Physical File: PFDATE RPG : RPDATE Display : DSDATE RPDATE Listing : H DATFMT(*DMY) H* PROGRAM LOADS DATA INTO THE PFDATE PF. IT ACCEPTS 2 DATE VALUES H* AND 2 TIME VALUES. THE VALIDATION OF THE VALUES IS DEFAULT BY H* VIRTUE OF THEIR TYPE. NO VALIDATION SPECIFIED IN THE DISPLAY H* FILE. IF WRONG DATA ENTERED, THE CONTROL GOES INTO PSSR. H* CONTROL GOES INTO PSSR DURING A MOVE OPERATION, WHEN DDATE H* IS BEING MOVED INTO DATE FIELD.

17

RPG-ILE LABS H* PSSR CAN DO OUTRAGEOUS THINGS LIKE ENTERING DOW LOOP USING A GOTO H* Program also performs auto generation of CODE value so that next H* record gets a code higher by 1 as comared to the previos rec code. H* ----------------------------------------------------------------FPFDATE UF A E DISK FDSDATE CF E WORKSTN F* DNODATE S 6S 0 INZ(0) DNOTIME S 6S 0 INZ(0) DCD S 4S 0 INZ(0) C EXSR AUTOGENCODE C READ BTIME 44 C DOW *IN03 = *OFF C MOVE NODATE DDATE1 C MOVE NODATE DDATE2 C MOVE NOTIME DTIME1 C MOVE NOTIME DTIME2 C EXFMT RDATE C MOVE DDATE1 DATE1 C MOVE DDATE2 DATE2 C MOVE DTIME1 TIME1 C MOVE DTIME2 TIME2 C ADD 1 CD C Z-ADD CD CODE C WRITE BTIME 77 C UNLOCK PFDATE C END1 TAG C ENDDO C* --------------------------------------------------C EVAL *INLR=*ON C RETURN C AUTOGENCODE BEGSR C *HIVAL SETLL BTIME C READP(N) BTIME 44 C Z-ADD CODE CD C 1 SETLL BTIME C ENDSR C* C *PSSR BEGSR C 'PSSR' DSPLY C DSP_MAJOR DSPLY C DSP_MINOR DSPLY C GOTO END1 C ENDSR Display file DSDATE : A A A A A A A A A A A A A

DSPSIZ(24 80 *DS3) CA03(03) R RDATE

3 14'BOTH DATES AS FOLLOWS :' COLOR(WHT) DSPATR(UL) 5 14'DATE 1 :' 7 14'DATE 2 :' 10 14'BOTH TIME VALUES AS FOLLOW COLOR(WHT) DSPATR(UL) 12 15'TIME 1 : ' 14 15'TIME 2 : '

18

RPG-ILE LABS A A A A A A A A

DDATE1 DDATE2 DTIME1 DTIME2

6Y 0B

5 25EDTWRD(' EDTMSK(' 6Y 0B 7 25EDTWRD(' EDTMSK(' 6Y 0B 12 25EDTWRD(' EDTMSK(' 6Y 0B 14 25EDTWRD(' EDTMSK('

& & : & : &

& & : & : &

') ') ') ') ') ') ') ')

Lisiting if PFDATE : A A A A A A

R BTIME CODE DATE1 DATE2 TIME1 TIME2

4S 0 L L T T

Only program is that of control goes into PSSR , I cannot say exactly which MOVE operation forced it into the PSSR. This way, you canot tell which field to high light. LAB : Time and Time stamp validation Rpgle listing : RPTIME H TIMFMT(*HMS) H* ------------------------------------------------------FDSTIME CF E WORKSTN DTM1 S T INZ(T'00:00:00') C* DISPLAY TIME DISPLAY FILE AND INPUT TIME FROM THE USER C* CHECK IF THIS TIME IS VALID. C* ------------------------------------------------------C DOW *IN03 = *OFF C MOVE *ZEROS DTIMEFLD C EXFMT RTIME C *HMS TEST(T) DTIMEFLD C IF *IN77 = *ON C EVAL *IN77 = *OFF C 'INCORRECT' DSPLY C ITER C ENDIF C *HMS MOVE DTIMEFLD TM1 C TM1 DSPLY C ENDDO C EVAL *INLR = *ON Display file listing A A A A A A A A A A A

77

DSTIME : DSPSIZ(24 80 *DS3) CA03(03)

R RTIME

DTIMEFLD

4

6Y 0B

8'ENTER A TIME VALUE TO BE T COLOR(BLU) 6 13'===>' COLOR(WHT) 6 19EDTWRD(' : : ') EDTMSK(' & & ') COLOR(WHT) 7 19'hh mm ss'

19

Display file fields RPG-ILE LABS A A

7

9'Format :-' COLOR(BLU)

LAB : Calculate Time difference H* PROGRAM TO CALCULATE THE TIME DIFFERENCE BETWEEN 2 TIME VALUES. H* -------------------------------------------------------------H* Assumes that Factor 1 tim e value is greater than Factor 2 time H* value. h* -------------------------------------------------------------h* H TIMFMT(*HMS) DT1 s T INZ(T'07:15:30') DT2 S T INz(T'10:10:05') DRslt S T INz(T'00:00:00') DSEC S 10S 0 INZ(0) D* C* C T2 SUBDUR T1 SEC:*S C Rslt Adddur sec:*S Rslt C 'Diff Is : ' DSPLY C Rslt DSPLY C EVAL *INLR = *ON C* Output : 2:54:35 LAB : Read date and time data from PF which stores data as date and time. Create a PF called PFDAT in QGPL. DDS as follows : A* DATE AND TIME PROCESSING A* DATE IS STORED HERE A* -----------------------A R RDATE A BCODE 4S 0 A DISSUE L A DRETURN L A TISSUE T A TRETURN T

DATFMT(*DMY) DATFMT(*DMY) TIMFMT(*HMS) TIMFMT(*HMS)

STRSQL and F4 : Specify DATFMT as *DMY and press ENTER. Use INSERT SQL stmt to insert some sample values into PFDAT. Create a display file DSDAT with fields : DDISSUE,DDRETURN,DTISSUE, DTRETURN with ‘Y’ as edit code. (created as +9(8) and then edit code Y is applied). Write following RPDAT program to load the data into RPGLE and display it. H Datfmt(*DMY/) TimFmt(*HMS:) FPFdat If E Disk FDSdat CF E Workstn c Do 1 c Read RDate c DIssue dsply c* DReturn dsply c TIssue dsply c* TReturn dsply c Movel DIssue c Movel DReturn c Movel TIssue c Movel TReturn

DDIssue DDreturn DTIssue DTReturn

// dont use EVAL !

20

RPG-ILE LABS c c c

Exfmt EndDo Eval

R1 *inlr = *on

OUTPUT : DSPLY DSPLY Date Time

24/12/05 09:45:00 of issue : of issue :

24/12/0500 9/45/0000

 ___ Display file output ⌡

LAB : Using Date in IF statement. H Datfmt(*DMY/) TimFmt(*HMS:) FPFdat If E Disk c Do 1 c Read RDate c DIssue dsply c TIssue dsply c If DIssue = d'24/12/05' c '24 DEC 2005' Dsply c Endif c EndDo c Eval *inlr = *on c Return

LAB : PASS DATE TIME BY Reference to a prceodure H* PROGRAM TO CALCULATE THE TIME DIFFERENCE BETWEEN 2 TIME VALUES. H* -------------------------------------------------------------H* Assumes that Factor 1 tim e value is greater than Factor 2 time H* value. h* -------------------------------------------------------------h* H TIMFMT(*HMS) DFind_Difference PR DT1 T DT2 T DRslt T DT1 s T INZ(T'07:15:30') DT2 S T INz(T'10:10:05') DRslt S T INz(T'00:00:00') D* C CAllp Find_Difference(T1:T2:Rslt) C Rslt DSPLY C Eval *inlr = *on C Return C* C* ------------------------------------------------------PFind_Difference B DFind_Difference PI DT1 T DT2 T DRslt T DTempTime S T INZ(T'00:00:00') DSec S 10s 0 inz(0)

21

RPG-ILE LABS C T2 C TempTime C PFind_Difference

E

SUBDUR Adddur MOVE

T1 sec:*S TempTime

SEC:*S TempTime Rslt

LAB : *NOPASS FOR PASSING OPTIONAL PARAMATERS H* PROGRAM TO CALCULATE THE TIME DIFFERENCE BETWEEN 2 TIME VALUES. H* -------------------------------------------------------------H* Assumes that Factor 1 tim e value is greater than Factor 2 time H* value. h* -------------------------------------------------------------h* H TIMFMT(*HMS) DFind_Difference PR DT1 T DT2 T DRslt T options (*nopass) DT1 s T INZ(T'07:15:30') DT2 S T INz(T'10:10:05') DRslt S T INz(T'00:00:00') D* C CAllp Find_Difference(T1:T2:Rslt) C Rslt DSPLY C CAllp Find_Difference(T1:T2) C Eval *inlr = *on C Return C* C* -----------------------------------------------------PFind_Difference B DFind_Difference PI LAB : Accessing Indidator ARRay dn1 s 4s 0 inz(1) c Dow n1 < 100 c Eval *in(n1) = *off c Eval n1 = n1 + 1 c Enddo c Exsr TestSR c Eval *inlr = *on c Return c* ---------------------------------------c* c TestSR Begsr c Eval *in(45) = *ON c If *in45 = *on c '45 on' Dsply c Endif c Eval *in45 = *off c If *in(45) = *on c '45 on' Dsply c Endif c Endsr OUTPUT : Dsply

'45 on'

A short cut method to set off all indicators is :

22

RPG-ILE LABS c c c

Eval Eval Return

DT1 DT2 DRslt DTempTime S DSec S C T2 SUBDUR C TempTime Adddur C If C MOVE C Return C Else C 'No param!' Dsply c TempTime Dsply c Endif PFind_Difference E

*in(*) = *off *inlr = *on

T T T options(*nopass) T INZ(T'00:00:00') 10s 0 inz(0) T1 SEC:*S sec:*S TempTime %Parms = 3 TempTime Rslt

After one of the parameters is specified as a nopass parameters, the following parameters HAVE to be nopass parameters. NOPASS means OPTIONAL. LAB : Calculate years,months and days between 2 dates : H* PROGRAM TO CALCULATE THE TIME DIFFERENCE BETWEEN 2 date VALUES. H* -------------------------------------------------------------H* Assumes that Factor 1 tim e value is greater than Factor 2 time H* value. h* -------------------------------------------------------------h* H DATFMT(*DMY) DDs001 ds DDys 2s 0 inz(0) DMnt 2s 0 inz(0) DYrs 2s 0 inz(0) DFind_Difference PR DD1 d DD2 d D*--------------------------------------------------DD1 s D INZ(D'10/01/04') DD2 S D INz(D'15/01/04') ddelta s 4s 0 inz(0) D* C CAllp Find_Difference(D1:D2) C Eval *inlr = *on C Return C* ------------------------------------------------------PFind_Difference B DFind_Difference PI DD1 d DD2 d C D2 SUBDUR D1 Yrs:*Y C D1 addDUR Yrs:*Y D1 C D2 SUBDUR D1 Mnt:*M C D1 addDUR Mnt:*M D1 C D2 SUBDUR D1 Dys:*D C* ==================================================== c Ds001 dsply

23

RPG-ILE LABS C PFind_Difference

E

Return

24

RPG-ILE LABS LAB : Built-in functions : %TRIM, %SUBSTR, *LEN, %SIZE %ABS DA01 DA02 C* C C C* C C C* C C C* C

S S

2P 0 Inz(-1) 10P 3 Inz(-14.567)

A01

EVAL DSPLY

A01 = %ABS(A01)

EVAL DSPLY

A02 = %ABS(A02)

A02 A02

EVAL DSPLY

A02 = %ABS(A01 - -2)

EVAL

*INLR = *ON

%TRIM %EDITC DNAME DDATE DTIME DRESULT DMSG DSALARY D* C C C C* C MSG C DATE C TIME C UDATE C* C

S S S S S S

20A D INZ(D'2003-05-05') T INZ(T'12.12.12') 10A 50A 9P 2 INZ(1000) EVAL

MSG = 'Annual Salary : ' +%TRIM(%EDITC(Salary*12 :'A': *CURSYM))

DSPLY DSPLY DSPLY DSPLY EVAL

*INLR = *ON

%SUBSTR DLEN DSTR C C C C C C

S S

STR LEN STR

OUTPUT : TEST STRING

4S 0 INZ(0) 12A INZ('TEST STRING')

DSPLY EVAL DSPLY EVAL DSPLY SETON

12

LEN=%LEN(STR) STR=%SUBST(STR:2:3) LR

EST

%SIZE DSTR1 DN

S S

14A INZ('TEST STRING') 4S 0 INZ(0)

25

RPG-ILE LABS C C C C

STR1 N

DSPLY EVAL DSPLY SETON

N=%SIZE(STR1) LR

Output : TEST STRING 14 %EDITC D* Demo of converting Numeric to String. D* -----------------------------------Dsal s 5i 0 inz(4000) Dx s 20a C eval x=%editc(sal:'A') C x dsply C seton

lr

LAB : Working on SCAN Opcode and SCAN function Scan will look for occruance of the sSrc string in the sStr string and write the position of nSrc (if found in sStr) to nPos. NPos is zero based so add 1 to nPos. Specify nPos in SubSt() function to get the rest of the characters after nPos. dsStr s dsSrc s dnPos s dsRes s d* c sSrc c c c sRes c* ---------------c* output : xyz mno c* ---------------c c

12a inz('abc xyz mno') 1a inz(' ') 4s 0 inz(0) 12a SCAN Eval Eval Dsply

sStr nPos nPos = nPos + 1 sRes = %SubSt(sStr:nPos)

Eval Return

*INLR= *ON

RPGLE program listing : RPSCAN Arguments to %SCAN : First arg : String to be searched Sec Arg : Main string containing the data Third Arg : START POSITION dString1 s 10a inz('abcdefghij') dsrcstr s 1a inz('d') dLoc s 2s 0 inz(0) d* d*----------------------------------------------------c Eval Loc = %Scan(srcstr:String1:1) c 'd loc :' Dsply c Loc Dsply c* c Eval srcstr = 'b'

26

RPG-ILE LABS c c c c* c c c c c

'b loc :' Loc 'x loc :' Loc

Eval Dsply Dsply

Loc = %Scan(srcstr:String1:3)

Eval Dsply Eval Dsply Eval

srcstr = 'x' Loc = %Scan(srcstr:String1:1) *inlr = *on

OUTPUT : DSPLY d loc : DSPLY 4 DSPLY b loc : DSPLY 0 DSPLY x loc : DSPLY 0

27

RPG-ILE LABS

LAB : STRING OPERATIONS : XLATE UPPER CASE TO LOWER CASE DUC DLC DSTRINP DSTROUT C UC:LC C STRINP C STROUT C

S S S S XLATE DSPLY DSPLY SETON

26A 26A 7A 7A STRINP

INZ('ABCDEFGHIJKLMNOPQRSTUVWXYZ') INZ('abcdefghijklmnopqrstuvwxyz') INZ('ASTRIX') STROUT LR

LAB : Special use of CAT Linkage : RPCAT CODE : ds1 ds2 ds3 ds4 c s1 c s1 c s3 c s4 c* output : c* abcd# c* abcd # c

s s s s cat cat Dsply Dsply

Eval

4a 4a 8a 8a '#':0 '#':2

inz('abcd') inz('qrst') s3 s4

*inlr = *on

PF contents : --OUTPUT

:

‘#’:2

appends # to the 2nd position after

‘abcd’. Ei at abcdBB#

REMARKS : ‘#’:2

ß leaves a gap of 2 positions after d of abcd.

28

RPG-ILE LABS LAB : ARRAY DECLARATION *************** Beginning of data ********************************** DAR1 S 4S 0 DIM(5) DN S 4S 0 INZ(1) C N DOWLT 5 C EVAL AR1(N)=N C AR1(N) DSPLY C EVAL N=N+1 C ENDDO C SETON LR OUTPUT : 1 2 3 4 H*PRG FOR PRE RUN TIME ARRAY FPFDEL IT F 25 D ARR1 S C MOVEL C VAR LOOKUP c* C *IN35 IFEQ C 'FOUND' DSPLY C ELSE C 'NOT FND' DSPLY C ENDIF C ARR1(2) DSPLY C ARR1(4) DSPLY C ARR1(12) DSPLY c*data beyond limit C ARR1(14) DSPLY C SETON

DISK 25 'one' ARR1

DIM(16) FROMFILE(PFDEL) PERRCD(1) VAR 25 35

*ON

LR

LAB : COMPILE TIME ARRAY D ARR C C VAR C *IN25 C 'FOUND' C C 'NOT FND ' C C ARR(2) C ARR(4) C ARR(12) C

S

MOVE LOOKUP IFEQ DSPLY ELSE DSPLY ENDIF DSPLY DSPLY DSPLY SETON

3 'JJL' ARR *ON

DIM(12) CTDATA PERRCD(6) VAR 3 25

LR

** JANFEBMARAPRMAYJUN

29

RPG-ILE LABS LAB : Compile time table

:

LAB : TABLE

** JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC ** 01 02 03 04 05 06 07 08 09 10 11 12

DTAB01 DTAB02 D$DATE D$YY D$MM D$TEMP D$DD D$SEP D$MON

S S S S S S S S S

12A DIM(3) CTDATA ASCEND 12S 0 DIM(12) CTDATA ASCEND 6 2 0 2 0 4 2 1 3

30

RPG-ILE LABS LAB : ALTERNATE TABLE DTAB01 DTAB02 D*

S S

12A DIM(12) CTDATA PERRCD(2) ASCEND 2S 0 ALT(TAB01) DIM(12)

** 01JAN 02FEB 03MAR 04APR 05MAY 06JUN 07JUL 08AUG 09SEP 10OCT 11NOV 12DEC PRE-RUN TIME TABLE H*PROGRAM FOR PRE RUN TIME TABLE F* FTEST33 IF E DISK D TABROL S 3 0 DIM(12) EXTFMT(P) FROMFILE(TEST33) D PERRCD(1) C* C Z-ADD 125 VAR 3 0 C VAR LOOKUP TABROL 25 C *IN25 IFEQ *ON C 'FOUND' DSPLY C ENDIF C SETON LR

31

RPG-ILE LABS LAB : INTRODUCTION TO DATA STRUCTURE AND TYPES OF DATA STRUCTURES PSDS D D D D D I* C* C* C* C C* C C C C

SDS PGNAM UNAME DATE TIME

1 254 270 282

10 263 275 287

Main Logic ---- ----*IN03

DOWEQ

*OFF

MOVEL MOVEL MOVE MOVE

PGNAM UNAME DATE TIME

DNAME DUNAM DDATE DTIME

MULTI OCCURANCE DS D JSRDS D SCODE D SROLL D SNAME C 1 C C C 2 C C C C 1 C SNAME C SCODE C SROLL C 2 C SCODE C SROLL C '---' C JSRDS C

DS

1 6 11 OCCUR MOVEL Z-ADD OCCUR MOVEL Z-ADD MOVEL OCCUR DSPLY DSPLY DSPLY OCCUR DSPLY DSPLY DSPLY DSPLY SETON

30 OCCURS(20) 5 10 0 30 JSRDS 'S001' SCODE 1 SROLL JSRDS 'S002' SCODE 2 SROLL 'TRIAL' SNAME JSRDS

JSRDS

LR

DATA AREA DATA STRUCTURE D JSRDTA D BCODE D BNAME C BCODE C BNAME C

UDS DSPLY DSPLY SETON

1 5

4 20 LR

FILE INFORMATION DATA STRUCTURE :

32

RPG-ILE LABS FPF001 IF D INFDS1 D FILE D CODE D STATUS D RECORD D ROUTIN C FILE C CODE C STATUS C RECORD C ROUTIN C

E

DISK

INFDS(INFDS1)

DS

*FILE *OPCODE *STATUS *RECORD *ROUTINE DSPLY DSPLY DSPLY DSPLY DSPLY SETON

LR

LAB : INTRODUCTION TO DATA AREAS AND TYPES OF DATA AREAS Infds : FTEST1 IF E FTEST1D UF A E F D STR1 DS D STA *STATUS C READ C Z-ADD C READ C *IN25 DOWEQ C Z-ADD C NUM DSPLY C* C WRITE C READ C ENDDO C SETON C* C *PSSR BEGSR C READ C ENDSR

DISK DISK

INFDS(STR1) INFSR(*PSSR)

PFREC1D 0 PFREC *OFF NUMBER

VAR

26

2 0

25 NUM

PFREC1D PFREC

25 LR

PFREC

25

NOW IF YOU DO A READ, THE DATA IS TAKEN FROM THE PF AND WRITTEN TO THE FIRST OCCURANCE OF DS. AND SO ON… LAB : Error Handling a Multi occurance Data structure dNOccur s 4s 0 inz(12) dds001 ds occurs(10) dN1 4s 0 dN2 4s 0 d** d sds dStatus *status d* c* specify impossible occurance c* c NOccur Occur ds001

66

33

RPG-ILE LABS c If *in66 = *on c 'unreachable' dsply c Status Dsply c* c* value of Status will be 122 c* c EndIf C Eval *inlr =*on C Return PASSING A DS AS A

PARAMETER

(RPG/400)

RPRCV : RECIEVER PROGRAM LISTING : IDS001 I I C C C C C C C C

DS *ENTRY NAME CODE

PLIST PARM DSPLY DSPLY MOVEL'XML' Z-ADD22 SETON RETRN

1 5

40CODE 14 NAME

DS001 NAME CODE

LR

RPSENDER : CALLING PROGRAM IDS001 I I C C C C C C C C C

DS 1 5

'PARENT' NAME CODE

Z-ADD12 MOVEL'SAM' CALL 'RPRCV' PARM DSPLY DSPLY DSPLY SETON RETRN

40CODE 14 NAME

CODE NAME DS001

LR

LAB : Demo of OVERLAY and Multi occurance. Linkage : RPOVR. CODE : * _____________________________________________________ * RPOVR. * Demo of overlay and multi occurances of variable being * overlayed. * a is broken into 2 sections identified by b and c * There are 10 instances of a , so there are 10 inst of b and c * * ########## <-- a(1) * -----~~~~~ * b(1) c(1) * _____________________________________________________ dds001 ds da 10a Dim(10)

34

RPG-ILE LABS db dc dcount s dtemp s dabc s c* c Dow c* conv to character c Movel c 'ABC' cat c* ABC01... c Eval c 'xyz' cat c* xyz01... c Eval c a(count) dsply c* ABC01xyz01 ... c Eval c End c Eval

5a overlay(a) 5a overlay(a:6) 2s 0 inz(1) 5 2 count<4 count abc

abc temp

b(count) = temp abc temp c(count) = temp count = count + 1 *inlr = *on

PF contents : nil OUTPUT DSPLY DSPLY DSPLY

: ABC01xyz01 ABC02xyz02 ABC03xyz03

REMARKS : Overlay can access sections of a variable LAB : MULTI OCCURANCE EXTERNALLY DESCRIBED DS CREATE EXTDS : A TYPICAL BCODE, BNAME BPRICE PHYSICAL FILE WITH RECORD SIZE 21 CREATE DDS, COMPILE AND WRITE 5-6 RECORDS TO THE SAME. DECLARING A EXTERNALLY DESCRIBED DS : Prompt type . . . Data Struct Name DS001 FEXTDS IDS001 C C C C C C C C C

DS

Number E

Sequence number . . .

E EIDSEXTDS 1

Option I

DS DS

IF

DS001 2 DS001 1 DS001

External File Name EXTDS DISK

OCUR DS001 READ BM DSPLY OCUR DS001 READ BM DSPLY OCUR DS001 DSPLY SETON

0001.00

4

Occurs 4

Length 21

21 55 55

LR

35

RPG-ILE LABS 1 OCCUR DS001 SETS THE FIRST OCCURANCE OF DS AS CURRENT OCCURANCE. LAB : External Data structure DMYDS c c C c c C C C

E DS

EXTNAME(BM001) Occurs(4) Bcode = 1 MyDS

Eval Occur Dsply Occur Eval Dsply Eval Return

1 BCODE 3 BCode

MyDS Bcode = 12 *INLR = *ON

LAB : External data structures. DMYDS C C* C C* C

E DS 1 BCODE BNAME BPRICE

EXTNAME(BM001) Occurs(4) Occur Dsply Dsply Dsply Eval

MyDS

*INLR = *ON

LAB : External data structure. FBM001 IF DMYDS D* c 1 c C BCODE C BNAME C BPRICE c 2 c C BCODE C BNAME C BPRICE c 1 C BCODE C BNAME C BPRICE C

E E DS

Disk EXTNAME(BM001) Occurs(90) Occur Read Dsply Dsply Dsply Occur Read Dsply Dsply Dsply Occur Dsply Dsply Dsply Eval

MyDS BM

MyDS BM

MyDS

// data here is preserved.

*INLR = *ON

LAB :

36

RPG-ILE LABS

37

RPG-ILE LABS

38

RPG-ILE LABS LAB : LDA Lda : FD002 CF C *IN03 C *DTAARA C C C C C C C C C

E

WORKSTN *OFF *LDA CYNAM

DOWEQ DEFINE IN CLEAR MOVE OUT MOVEL EXFMT ENDDO MOVE SETON

CYNAM

10

CYNAM CYNAM

'test st' CYNAM CYNAM DATA

DCYNAM

*ON

*INLR LR

User defined DATA AREA : FD001 CF C *IN03 C *DTAARA C C C C *IN03 C C C C

E

LAB : Implementing

WORKSTN *OFF

DOWEQ DEFINE IN Z-ADD EXFMT IFEQ LEAVE ENDIF ENDDO MOVE

EMPN

EMPN EMPN DATA *ON

5 0

DEMPNO

*ON

*INLR

a dataarea

Create a dataarea called “JSRDTA” fo the type *CHAR and length 10. Listing : dDta1 dtemp c *Lock c Dta1 c c c c c c

s s IN Dsply Movel Clear movel Out Unlock Eval

10a 10a Dta1

dtaara(jsrdta)

Dta1 'new data' Dta1 Dta1 *inlr = *on

temp Dta1 dta1

SIGNIFICANCE OF LOCKING THE DATA AREA : NOTE : If you do not lock the data area during the IN operation, you cannot UPDATE (ie Change) its contents. You can then only read the data area. LAB : Handling a locked data area Listing of CLDTAARA2 :

39

RPG-ILE LABS Pgm

END1: end: Endpgm

ALCOBJ OBJ((QGPL/MYDTA *DTAARA *excl)) WAIT(0) monmsg msgid(CPF1002) exec(goto end1) CHGDTAARA DTAARA(QGPL/MYDTA) VALUE('sec') SNDPGMMSG MSG('hi2!') TOPGMQ(*EXT) MSGTYPE(*INQ) DLCOBJ OBJ((QGPL/MYDTA *DTAARA *excl)) goto end SNDPGMMSG MSG('cannot allocate')

LISTING OF CLDTAARA1 : Pgm ALCOBJ OBJ((QGPL/MYDTA *DTAARA *excl)) WAIT(0) monmsg msgid(CPF1002) exec(goto end1) /* cannot alocate since it is already locked. */ CHGDTAARA DTAARA(QGPL/MYDTA) VALUE('FIRST') SNDPGMMSG MSG('hi !') TOPGMQ(*EXT) MSGTYPE(*INQ) DLCOBJ OBJ((QGPL/MYDTA *DTAARA *excl)) goto end SNDPGMMSG MSG('cannot allocate')

END1:

LAB : Opening file under User Control. (UC). FPF001 IF C C C BCODE C

E OPEN READ DSPLY SETON

DISK PF001 BM

USROPN 77 LR

LAB : Ending a program without setting on LR causes files to remain open RPPARENT c c c c* c* c* c* c* c* c* c* c c

'Parent go:' 'Parent Bk'

dsply Call Dsply

'RPCHILD'

do a shift + esc notice that the file PFBMAST is not closed although Child has ended Use RCLRSC from command line to close the PFBMAST file Eval Return

*inlr = *on

RPCHILD fpfbmast if c c 'child!' c c 44 c c

e

Read dsply Eval Eval Return

disk bm

88

*in44 = *off *inlr = *on

40

RPG-ILE LABS Child does not allow the SETON LR to take place. Result is that child returns without Closing the PFBMAST file. This can be confirmed by Shift + Esc and 14 to see open files. LAB

: Handling database errors. PSSR, INFSR.INFDS. FTEST1 IF E DISK FTEST1D UF A E DISK INFDS(STR1) F INFSR(*PSSR) D STR1 DS D STA *STATUS C READ PFREC1D 26 C Z-ADD 0 VAR 2 0 C READ PFREC 25 C *IN25 DOWEQ *OFF C Z-ADD NUMBER NUM C NUM DSPLY C* --------------------------------------------------------------------C WRITE PFREC1D C READ PFREC 25 C ENDDO C SETON LR C* --------------------------------------------------------------------C *PSSR BEGSR C READ PFREC 25 C ENDSR C* ---------------------------------------------------------------------

41

RPG-ILE LABS LAB : Declaration of sub files. (rest pf the code is same,no need to cover all that ) FDSP1 F

CF

E

WORKSTN

SFILE(SFLDATA:RRN)

LAB : Updating file records under Commitment control. Selecting the correct lock type. FPF001 UF C C C BCODE C C C

E OPEN READ DSPLY UPDATE CLOSE SETON

DISK PF001 BM

COMMIT

BM PF001

usropn 77

LR

LAB : Database basics : How access is done when you try to get a non-keyed access to a LF which has a K on a certain field. Database files : PFBMK : typical book master file. LFBMK : Typical book master based on pfbmk and keys on BPRICE. Linkage : RPREAD CODE : FLfbmk IF c 5 c c bcode c bprice c c c

E

setll Read dsply dsply

PF contents :

Eval Return

Disk bm bm

*inlr=*on

BCODE 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

BNAME ACAD C C++ PAS COB AI HISTORY ENGLISH HINDI MARATHI Pascal Cobol C++ RPG CL DB2 ILE

OUTPUT

:

LFBMK BPRICE 120.00 220.00 320.00 120.00 220.00 430.00 100.00 120.00 90.00 75.00 120.00 220.00 420.00 2,420.00 420.00 520.00 220.00

42

RPG-ILE LABS 5 220.00 REMARKS : Even if it is a keyed file, here we access it in sequential fashion. SETLL has 5 in factor 1. This gives access to the 5th from top record. The records are not even arranged in asc order of BPRICE. LAB : Access LFBMK in keyed fashion. Linkage : RPREAD1 CODE : FLfbmk IF E k Disk dsrc s 7p 2 inz(320) c src setll bm c Read bm c bcode dsply c bprice dsply c Eval src = 90 c* c* SETLL starts searching from the top of the Database file. c* Record with BPRICE=90 comes way before rec with BPRICE=320 c src setll bm c Read bm c bcode dsply c bprice dsply c Eval *inlr=*on c Return PF contents : Same as prev lab. OUTPUT

:

DSPLY DSPLY DSPLY DSPLY

3 32000 9 9000

REMARKS : SETLL starts searching from the top. LAB : Too less and too large values to setll. Linkage : RPREAD2 CODE : FLfbmk dsrc D*

IF

E

s

k Disk 7p 2 inz(20)

43

RPG-ILE LABS c* Too less. No rec c* c src c *in44 c *in45 c *in46 c c c bcode c bprice c c* c* Too large value. c* c src c *in44 c *in45 c *in46 c c c bcode c bprice c c

has bprice = 20. The least value=75. setll dsply dsply dsply Setoff Read dsply dsply Eval

bm

bm

444546

444546

src = 3000

No record has bprice = 3000.Largest val is 2,400 setll dsply dsply dsply Setoff Read dsply dsply Eval Return

bm

bm

444546

444546

*inlr=*on

PF contents : Same as prev. OUTPUT

:

DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY REMARKS

0 0 0 10 7500 1 0 0

ß at the first record. ß too high a value.

10 7500

ß still at the first record.

:

44

RPG-ILE LABS LAB :

Behavior of SETLL.

Linkage : RPREAD2 CODE : FLfbmk IF E dsrc s D* c src c *in44 c *in45 c *in46 c c c* Too less. No rec c* c src c *in44 c *in45 c *in46 c c c bcode c bprice c c* c* Too large value. c* c src c *in44 c *in45 c *in46 c c c bcode c bprice c c

k Disk 7p 2 inz(420) setll bm dsply dsply dsply Setoff Eval src=20 has bprice = 20. The least value=75.

444546

setll dsply dsply dsply Setoff Read dsply dsply Eval

444546

bm

444546

444546 bm src = 3000

No record has bprice = 3000 setll dsply dsply dsply Setoff Read dsply dsply Eval Return

bm

444546

444546 bm *inlr=*on

PF contents :

OUTPUT

:

DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY

0 0 1 0 0 0 10 7500 1 0 0

10 7500

REMARKS :

45

RPG-ILE LABS

To start with, 420 is passed as search argument to setll. SETLL finds an exact match so the file pointer is positioned to that record and EQ indicator is set on (*in46 = *ON) . So we get 0 0 1 as the output. Next we put 20 as factor-one to setll. There is no record with this value of bprice. The rec with the least bprice value is 75 which is the first record. Hence file pointer is positioned to the first record and this is read. No indicator is changed.SETLL does not complain. So output : 0 0 0

10 75

Next we put 3000 as factor 1 argument to SETLL which is too high. The rec with largest BPRICE value is 2,400. Hence file pointer is not moved at all and HI indicator is set on. Hence Output : 1 0 0

10 75

46

RPG-ILE LABS LAB : Working on CHAIN, READE Linkage : RPREAD3 CODE : FLfbmk IF dsrc D* c src c c BCode c BPrice c src c c c

E

k Disk 7p 2 inz(120)

s chain Dow dsply dsply ReadE EndDo Eval Return

bm Not %EOF bm *inlr=*on

PF contents : The contents are re-ordered in ascending order of bprice. Thus the file will NOT be read in the followign order. BCODE 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

BNAME ACAD C C++ PAS COB AI HISTORY ENGLISH HINDI MARATHI Pascal Cobol C++ RPG CL DB2 ILE

OUTPUT

:

DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY DSPLY

BPRICE 120.00 220.00 320.00 120.00 220.00 430.00 100.00 120.00 90.00 75.00 120.00 220.00 420.00 2,420.00 420.00 520.00 220.00

1 12000 4 12000 8 12000 11 12000

REMARKS : First CHAIN locates the first record from top. Remaining records with same bprice can be located using READE.

47

RPG-ILE LABS LAB : Single page subfile KEYED access to LFBMK LFBMK : Logical file. Linkage : RPLFBMK, DSLFBMK. CODE : DSLFBMK : A A A A A A A A A A A A A A A A A A A A A A A A

R SFLDT DCODE DNAME DPRICE

4 20 7

0B B 2B

5 5 5

DSPSIZ(24 80 *DS3) PAGEUP(25) PAGEDOWN(26) SFL 10COLOR(WHT) 21COLOR(WHT) 49EDTWRD(' . ') COLOR(WHT) 61'Rs' SFLCTL(SFLDT) CA03(03) SFLDSP SFLDSPCTL SFLCLR SFLSIZ(0005) SFLPAG(0004) 23'Book Master Record' COLOR(WHT) 10'Code' COLOR(WHT) 28'Name' COLOR(WHT) 53'Price' COLOR(WHT)

5

R SFLCTL 50 51 52

1 3 3 3

RPSFLK : F* FLfbmk IF E Fdslfbmk CF E drrn s D* C* c Exsr c ExSR c Dow c ExSR c ExSR c EndDO c Eval c Return c* c UsrSR BegSR c* Pg up c If c Eval c* c* go back 8 records. c* c do c ReadP

k Disk Workstn sfile(sfldt:rrn) 4s 0 inz(0) CLRSR LDSR *in03 = *off DspSR UsrSR *inlr = *on

*in25 = *on *in25 = *Off

8 bm

48

RPG-ILE LABS c c c c c c* c* c c c c* c* c* c c c* c c c c c c c* c c c* c* c* c c c* c c c c* c c c c c c c c c* c c c c c c c

end of PG UP Pg Dn

if Leave EndIf EndDo EndIf

%EOF(lfbmk)

If Eval EndIf

*in26 = *on *in26 = *Off

In either case,Load is necessary. Exsr EndSr ClrSR

BegSR Eval Eval Write Eval EndSR

LdSR

BegSR Exsr

LDSR

rrn = 0 *in52 = *on SflCtl *in52 = *off

ClrSR

load next 4 records to subfile

DspSR

Read Do

bm 4

if Leave EndIf

%EOF

Eval Eval Eval Eval Write Read EndDO EndSR

DCode = BCode DName = BName DPrice = BPrice rrn = rrn + 1 SFLDT bm

BegSR Eval Eval Exfmt Eval Eval EndSR

*in50 = *in51 = SflCTL *in51 = *in50 =

*on *on *off *off

PF contents : Logical file OUTPUT

: Book Master. Keyes on BPRICE.

:

The records are displayed in single page subfile in ascending order of Bprice.

49

RPG-ILE LABS REMARKS : Algorithm changes since the access is keyed.

50

RPG-ILE LABS LAB : Introduction to logic cycle : Default program processing algorithm. FPFBM FQPRINT IPFBM I I I C 20 OQPRINT O O O O O O O

IP O AA

F F

H

1P

21 80

DISK PRINTER OFLIND(*IN20) 1 5 15

SETOFF

4 0CODE 14 NAME 21 2PRICE 1

1

1

D

1

T

CODE NAME PRICE

20

Z 1

Q

1

20 40 '