Add(H)
Half adjust (round) of the numeric value while adding the values of the variables.
D a s 4S 2 Inz(10.25) D b s 4S 2 Inz(10.20) D Result s 5S 1 D Result2 s 5S 2 //it will add the values of a and b (i.e., 10.25 and 10.20) // and assign a 20.45 value to the Result2 variable. C a ADD b Result2 C 'Result2' DSPLY C Result2 DSPLY //it will add the values of a and b (i.e., 10.25 and 10.20) //and assign a 20.5 value to the Result variable by rounding //the value from 20.45 to 20.5. C a ADD(H) b Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result DSPLY 2045
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Add
Adds the numeric values of the variables.
D a s 4S 2 Inz(10.25) D b s 4S 2 Inz(10.20) D Result s 5S 2 //it will add the values of a and b (i.e., 10.25 and 10.20) // and assign a 20.45 value to the Result variable. C a ADD b Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result2 DSPLY 2045 DSPLY Result
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Adddur
The ADDDUR operation adds the duration specified in factor 2 to a date or time and places the resulting Date, Time, or Timestamp in the result field.
H TIMFMT(*USA) DATFMT(*MDY&) * DDateConst C CONST(D'12 31 92') * * Define a Date field and initialize result variable. * DLoanDate S D DATFMT(*EUR) INZ(D'12 31 92') DDueDate S D DATFMT(*ISO) DTimeStamp S Z DAnswer S T Dxx S 2 0 Inz(1) Dyy S 2 0 Inz(1) Dzz S 2 0 Inz(30) * Determine a DueDate which is xx years, yy months, zz days later * than LoanDate. C LoanDate ADDDUR xx:*YEARS DueDate C ADDDUR yy:*MONTHS DueDate C ADDDUR zz:*DAYS DueDate C 'LOANDATE' DSPLY C LoanDate DSPLY C 'DUEDATE' DSPLY C DueDate DSPLY * Determine the date 23 days later * C ADDDUR 23:*D DueDate C '+ 23 Days' DSPLY C DueDate DSPLY * Add a 1234 microseconds to a timestamp * C 'TIMESTAMP' DSPLY C TimeStamp DSPLY C ADDDUR 1234:*MS TimeStamp C '+ 1234 MS' DSPLY C TimeStamp DSPLY * Add 12 HRS and 16 minutes to midnight * C 'ANSWER' DSPLY C Answer DSPLY C T'00:00 am' ADDDUR 12:*Hours Answer C '+ 12 Hrs' DSPLY C Answer DSPLY C ADDDUR 16:*Minutes Answer C '+ 16 Min' DSPLY C Answer DSPLY * Subtract 30 days from a loan due date * C ADDDUR -30:*D DueDate C 'DUEDATE' DSPLY C DueDate DSPLY C SETON LR
Output
DSPLY LOANDATE DSPLY 31.12.1992 DSPLY DUEDATE DSPLY 1994-03-02 DSPLY + 23 Days DSPLY 1994-03-25 DSPLY TIMESTAMP DSPLY 0001-01-01-00.00.00.000000 DSPLY + 1234 MS DSPLY 0001-01-01-00.00.00.001234 DSPLY ANSWER DSPLY 00:00 AM DSPLY + 12 Hrs DSPLY 12:00 PM DSPLY + 16 Min DSPLY 12:16 PM DSPLY DUEDATE DSPLY 1994-02-23
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
BegSr
The BEGSR operation identifies the beginning of a subroutine.
You may specify the same name on the: –
- EXSR operation referring to the subroutine
- In the result field of the CASxx operation referring to the subroutine
- In the entry of an INFSR file specification keyword of the subroutine is a file-error subroutine.
Dcl-s CharDate Char(6) Inz('031286');
TEST(DE) *MDY0 CharDate;
EXSR ErrCheck;
*INLR = *ON;
BEGSR ErrCheck;
IF %ERROR();
DSPLY 'Invalid Date';
ELSE;
DSPLY 'Valid Date';
ENDIF;
ENDSR;
Output
DSPLY Valid Date
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Call
The CALL operation passes control to the program specified in factor 2.
PROGA
D Up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D Lo c 'abcdefghijklmnopqrstuvwxyz' C *ENTRY PLIST C PARM FieldA 50 C PARM FieldB 50 C Lo:Up XLATE FieldA FieldB C SETON LR
Example Program
D FieldA S 50 Inz('call to proga example')
D FieldB S 50 Inz(' ')
* The CALL operation calls PROGA and allows PROGA to access
* FieldA and FieldB, defined elsewhere. PROGA is run using the content
* of FieldA and FieldB. When PROGA has completed, control
* returns to the statement following the last PARM statement.
*
*
C CALL 'PROGA'
C PARM FieldA
C PARM FieldB
C 'FIELDA' DSPLY
C FieldA DSPLY
C 'FIELDB' DSPLY
C FieldB DSPLY
C SETON LR
Output
DSPLY FIELDA DSPLY call to proga example DSPLY FIELDB DSPLY CALL TO PROGA EXAMPLE
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Callb
This op-code calls a procedure that is bound statically to the main program
PROGB
D Up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D Lo c 'abcdefghijklmnopqrstuvwxyz' C *ENTRY PLIST C PARM FieldA 50 C PARM FieldB 50 C Lo:Up XLATE FieldA FieldB C SETON LR
Example Program
C PLST1 PLIST C PARM a 2 0 C PARM b 2 0 C PARM c 2 0 * C Z-ADD 11 a C Z-ADD 22 b C Z-ADD *zeros c * C CALLB 'PROGB' PLST1 C 'A' DSPLY C a DSPLY C 'B' DSPLY C b DSPLY C 'SUM' DSPLY C c DSPLY C SETON LR
CRTRPGMOD MODULE(LIB/P R O G B) SRCFILE(LIB/QRPGLESRC) SRCMBR(P R O G B) REPLACE(*YES)
CRTRPGMOD MODULE(LIB/CALLBRPG) SRCFILE(LIB/QRPGLESRC) SRCMBR(CALLBRPG) REPLACE(*YES)
CRTPGM PGM(LIB/CALLBRPG) MODULE (LIB/CALLBRPG LIB/P R O G B) ENTMOD(*PGM)
Output
DSPLY A DSPLY 11 DSPLY B DSPLY 22 DSPLY SUM DSPLY 33
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Callp
This op-code calls a prototyped procedures or programs.
Program
H OPTION(*SRCSTMT) DFTACTGRP(*NO) DSumTwoNumbers PR Dp 2 0 Dq 2 0 Dr 2 0 * C Z-ADD 11 a 2 0 C Z-ADD 22 b 2 0 C Z-ADD *zeros c 2 0 * C CALLP SumTwoNumbers(a:b:c) * C 'A' DSPLY C a DSPLY C 'B' DSPLY C b DSPLY C 'SUM' DSPLY C c DSPLY C SETON LR * PSumTwoNumbers B DSumTwoNumbers PI Dp 2 0 Dq 2 0 Dr 2 0 C EVAL r=p+q PSumTwoNumbers E
Output
DSPLY A DSPLY 11 DSPLY B DSPLY 22 DSPLY SUM DSPLY 33
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Cat(P)
The CAT operation concatenates two strings specified and places it in the result field with the right side of result field padded with blanks.
Program
H OPTION(*SRCSTMT) DFTACTGRP(*NO)
D First_Name s 11 inz(*blanks)
D Last_Name s 5 inz(*blanks)
D Name s 25 inz(*blanks)
C MOVEL 'Programmers' First_Name
C MOVE 'IO' Last_Name
*It appends First_Name('Programmers') to First_Name('Programmers')
* and store result in Name variable as 'ProgrammersProgrammers '.
C First_Name CAT First_Name Name
C Name DSPLY
*It appends Last_Name('IO ') to First_Name('Programmers')
*with 1 space in between as specified after Last_Name (:1)
* and store result in Name variable as 'Programmers IOmmers '
C First_Name CAT Last_Name:1 Name
C Name DSPLY
*It appends Last_Name('IO ') to First_Name('Programmers')
* and store result in Name variable as 'Programmers IO '
* with padding done with blanks on right.
C First_Name CAT(P) Last_Name Name
C Name DSPLY
C SETON LR
Output
DSPLY ProgrammersProgrammers DSPLY Programmers IOmmers DSPLY Programmers IO
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Cat
The CAT operation concatenates two strings specified and places it in the result field.
Program
H OPTION(*SRCSTMT) DFTACTGRP(*NO)
D First_Name s 11 inz(*blanks)
D Last_Name s 5 inz(*blanks)
D Name s 25 inz(*blanks)
C MOVEL 'Programmers' First_Name
C MOVE 'IO' Last_Name
*It appends First_Name('Programmers') to First_Name('Programmers')
* and store result in Name variable as 'ProgrammersProgrammers '.
C First_Name CAT First_Name Name
C Name DSPLY
*It appends Last_Name('IO ') to First_Name('Programmers')
*with 1 space in between as specified after Last_Name (:1)
* and store result in Name variable as 'Programmers IOmmers '
C First_Name CAT Last_Name:1 Name
C Name DSPLY
*It appends Last_Name('IO ') to First_Name('Programmers')
* and store result in Name variable as 'Programmers IO '
* with padding done with blanks on right.
C First_Name CAT(P) Last_Name Name
C Name DSPLY
C SETON LR
Output
DSPLY ProgrammersProgrammers DSPLY Programmers IOmmers DSPLY Programmers IO
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Chain
The CHAIN operation retrieves a record from a full procedural file, sets a record identifying indicator on (if specified on the input specifications), and places the data from the record into the input fields.
The CHAIN operation retrieves the first record that matches the search argument even we use chain many times. It will set the pointer then read the equal value.
If no record found, then chain set the HI indicator ON else it would be OFF. We can sue %found built in function which return ‘0’ if no record is found, and ‘1’ if a record is found.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Example Program
/free
dcl-f emphdr disk usage(*input:*update);
// Specify the search keys directly in a list
CHAIN 0000001 emphdr;
// Use the data structure fields
IF (ename = *BLANKS);
ename = 'No Data';
UPDATE emphdrr;
ELSE;
DSPLY ename;
ENDIF;
*INLR = *ON;
/end-free
Output
DSPLY John
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Check(E)
Error handling while checking the non-occurrence of a character in a string.
Program
D T s 3S 0 Inz(6)
D X s 3S 0 Inz(32)
D SubString s 30A Inz(*Blanks)
D Pos s 3S 0
C EVAL SubString ='AABC1ABD2AV3A'
//it will try to check the factor-1 ('ABCD') in the factor-2 variable Substring
//('AABC1ABD2AV3A') and 5 will assign it to the Pos variable.
C 'ABCD' CHECK SubString Pos
C 'CHECK' DSPLY
C Pos DSPLY
//it will try to check the factor-1 ('ABCD') in the factor-2 variable Substring
//('AABC1ABD2AV3A') from starting position T (6) and 9 will assign to Pos variable.
C 'ABCD' CHECK SubString:T Pos
C 'CHECK' DSPLY
C Pos DSPLY
//it will try to check the factor-1 ('ABCD') in the factor-2 variable
//Substring ('AABC1ABD2AV3A') from starting position X (32) but display
//the 'Error' message as the 32 index is not present in SubString variable.
C 'ABCD' CHECK(E) SubString:X Pos
C IF %ERROR
C 'CHECK(E)' DSPLY
C 'Error' DSPLY
C ENDIF
C SETON LR
Output
DSPLY CHECK DSPLY 5 DSPLY CHECK DSPLY 9 DSPLY CHECK(E) DSPLY Error
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Close
The CLOSE opcode is used to explicitly close a file.
Program
dcl-f emphdr disk usropn usage(*input:*output:*update) keyed;
dcl-s xDsply Char(50) inz(*blanks);
IF NOT %OPEN(emphdr);
OPEN emphdr;
DSPLY 'EMPHDR is opened for operation';
ENDIF;
CHAIN 0000001 emphdr;
IF %FOUND();
xDsply = 'Name : ' + ename;
DSPLY xDsply;
ename = 'Maanav Tripathi';
UPDATE emphdrr;
DSPLY 'Name Updated!';
ENDIF;
CHAIN 0000001 emphdr;
IF %FOUND();
DSPLY 'Updated Data';
xDsply = 'Name : ' + ename;
DSPLY xDsply;
ENDIF;
CLOSE emphdr;
DSPLY 'EMPHDR is closed';
*INLR = *ON;
Output
DSPLY EMPHDR is opened for operation DSPLY Name : Manav Tripathi DSPLY Name Updated! DSPLY Updated Data DSPLY Name : Maanav Tripathi DSPLY EMPHDR is closed
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Comp
The COMP opcode is used to compare two values.
- If Factor1>Factor2, High level indicator gets on.
- If Factor1
- If Factor1=Factor2, Equal level indicator gets on.
Program
D A S 2P 0 inz (11) D B S 2P 0 inz (12) D C S 2P 0 inz (11) D D S 2P 0 inz (15) D xDsply S 50 inz (*Blanks) C EVAL xDsply = *ALL'*' C xDsply DSPLY C EVAL xDsply = 'A : ' + %CHAR(A) + C ', B : ' + %CHAR(B) C xDsply DSPLY C EVAL xDsply = *ALL'*' C xDsply DSPLY C A COMP B 212223 C EVAL xDsply = 'A>B : ' + %CHAR(*IN21) C xDsply DSPLY C EVAL xDsply = 'A<B : ' + %CHAR(*IN22) C xDsply DSPLY C EVAL xDsply = 'A=B : ' + %CHAR(*IN23) C xDsply DSPLY C EVAL xDsply = *ALL'*' C xDsply DSPLY C EVAL xDsply = 'A : ' + %CHAR(A) + C ', C : ' + %CHAR(C) C xDsply DSPLY C EVAL xDsply = *ALL'*' C xDsply DSPLY C A COMP C 212223 C EVAL xDsply = 'A>C : ' + %CHAR(*IN21) C xDsply DSPLY C EVAL xDsply = 'A<C : ' + %CHAR(*IN22) C xDsply DSPLY C EVAL xDsply = 'A=C : ' + %CHAR(*IN23) C xDsply DSPLY C EVAL xDsply = *ALL'*' C xDsply DSPLY C EVAL xDsply = 'D : ' + %CHAR(D) + C ', B : ' + %CHAR(B) C xDsply DSPLY C EVAL xDsply = *ALL'*' C xDsply DSPLY C D COMP B 212223 C EVAL xDsply = 'D>B : ' + %CHAR(*IN21) C xDsply DSPLY C EVAL xDsply = 'D<B : ' + %CHAR(*IN22) C xDsply DSPLY C EVAL xDsply = 'D=B : ' + %CHAR(*IN23) C xDsply DSPLY C SETON LR
Output
DSPLY DSPLY A : 11, B : 12 DSPLY DSPLY A>B : 0 DSPLY A<B : 1 DSPLY A=B : 0 DSPLY DSPLY A : 11, C : 11 DSPLY DSPLY A>C : 0 DSPLY A<C : 0 DSPLY A=C : 1 DSPLY DSPLY D : 15, B : 12 DSPLY DSPLY D>B : 1 DSPLY D<B : 0 DSPLY D=B : 0
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Define
Factor-2 represents the name of referenced dataarea name referred by result field. It can be any external dataarea, *LDA, *PDA. Result field represents any internal variable, a data structure, a data-area data structure, program status data structure, file information data structure or any program defined data area. The result field is taken for operation IN and OUT in the program.
CRTDTAARA DTAARA(LIB/DA) TYPE(*CHAR) LEN(30) VALUE(‘1001’)
Display Data Area
Data area . . . . . . . : DA
Library . . . . . . . : LIB
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 30
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 '1001 '
Example Program
D xDsply s 50 Inz(*Blanks)
C *ENTRY PLIST
C PARM A1 30
C *DTAARA DEFINE DA 30
*Locking Data Area DA to get value '1001' in C variable.
C *LOCK IN DA
C MOVEL DA C 12
C EVAL xDsply = 'Value in Data Area DA/C ' +
C 'Variable : ' + C
C xDsply DSPLY
*Moving Integer value of C ('1001') in I (1001) variable.
C MOVEL *ZEROS I 12 0
C EVAL I=%INT(C)
C EVAL xDsply = 'Value in I Varibale : ' + %CHAR(I)
C xDsply DSPLY
*Incrementing I by 1 to make value of I as 1002.
C ADD 1 I
C EVAL C=%CHAR(I)
C EVAL xDsply = 'Value in C Varibale : ' + C
C xDsply DSPLY
*Storing Value 1002 in DA Data Area.
C MOVEL C DA
C MOVEL C A1
C OUT DA
C UNLOCK DA
C EVAL xDsply = 'Value in Data Area DA : ' + C
C xDsply DSPLY
C SETON LR
Output
DSPLY Value in Data Area DA/C Variable : 1001 DSPLY Value in I Varibale : 1001 DSPLY Value in C Varibale : 1002 DSPLY Value in Data Area DA : 1002
DSPDTAARA DTAARA(LIB/DA)
Display Data Area
Data area . . . . . . . : DA
Library . . . . . . . : LIB
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 30
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 '1002 '
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Delete
The DELETE operation deletes a record from a database file.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Example Program
dcl-f emphdr disk usropn usage(*input:*output:*update:*delete) keyed; dcl-s xDsply Char(50) inz(*blanks); IF NOT %OPEN(emphdr); OPEN emphdr; DSPLY 'EMPHDR is opened for operation'; ENDIF; eid = 11; ename = 'Delete Program'; edoj = %date(20200101); edob = %date(19930106); write emphdrr; xDsply = 'Data Added :: ID : ' + %CHAR(eid) + ', Name : ' + ename; DSPLY xDsply; CHAIN 0000011 emphdr; IF %FOUND(); DELETE emphdrr; ENDIF; CHAIN 0000011 emphdr; IF NOT %FOUND(); xDsply = 'Data Deleted :: ID : ' + %CHAR(eid) + ', Name : ' + ename; DSPLY xDsply; ENDIF; CLOSE emphdr; DSPLY 'EMPHDR is closed'; *INLR = *ON;
Output
DSPLY EMPHDR is opened for operation DSPLY Data Added :: ID : 11, Name : Delete Program DSPLY Data Deleted :: ID : 11, Name : Delete Program DSPLY EMPHDR is closed
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Div
It divides two numbers/variables and store the result in a variable.
Example Program
D A s 2P 0 Inz(25) D B s 2P 0 Inz(11) D Result s 2P 0 Inz(*zeros) D Remainder s 2P 0 Inz(*zeros) D xDsply s 50 Inz(*blanks) //it will Divide the value of a by b (i.e., 25 and 11) // and assign a 2 value to the Result variable // and assign a 3 value to the Remainder variable. C A DIV B Result C MVR Remainder C EVAL xDsply = %CHAR(A) + '/' + %CHAR(B) + C ' = ' + %CHAR(Result) C xDsply DSPLY C EVAL xDsply = %CHAR(A) + '%' + %CHAR(B) + C ' = ' + %CHAR(Remainder) C xDsply DSPLY C SETON LR
Output
DSPLY 25/11 = 2 DSPLY 25%11 = 3
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Do
The Do-EndDo loop is used when we have to iterate over a block of statements for specific number (say 10, 20 100) of times.
Example Program
D Count s 2P 0 Inz(1) D Value s 2P 0 Inz(*zeros) D xDsply s 50 Inz(*blanks) * Loop through code starting from 1 till 6 C Count DO 6 Value C EVAL xDsply = *Blanks * Loop through code starting from 1 till Value C 1 DO Value C EVAL xDsply = %TRIM(xDsply) + ' *' C ENDDO C EVAL xDsply = %TRIM(xDsply) C xDsply DSPLY C ENDDO C SETON LR
Output
DSPLY * DSPLY * * DSPLY * * * DSPLY * * * * DSPLY * * * * *
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
DoU
The DoU-EndDo loop continues until the loop condition remains false.
Example Program
D Count s 2P 0 Inz(*zeros) * Loop through code starting from 0 till 5 C DOU Count = 6 C Count DSPLY C EVAL Count = Count + 1 C ENDDO C SETON LR
Output
DSPLY 0 DSPLY 1 DSPLY 2 DSPLY 3 DSPLY 4 DSPLY 5
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
DoW
The DoW-EndDo loop continues while the loop condition remains true.
Example Program
D Count s 2P 0 Inz(*zeros) * Loop through code starting from 0 till 5 C DOW Count < 6 C Count DSPLY C EVAL Count = Count + 1 C ENDDO C SETON LR
Output
DSPLY 0 DSPLY 1 DSPLY 2 DSPLY 3 DSPLY 4 DSPLY 5
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Dsply
This opcode is used for communication between display workstation and the requesting program. The display message can be of maximum length 52 byte.
Example Program
D A s 2P 0 Inz(25)
D B s 2P 0 Inz(11)
D C S 2 INZ('AA')
D D S 2 0 INZ(11)
D Result s 2P 0 Inz(*zeros)
D Remainder s 2P 0 Inz(*zeros)
D xDsply s 50 Inz(*blanks)
//it will Divide the value of a by b (i.e., 25 and 11)
// and assign a 2 value to the Result variable
// and assign a 3 value to the Remainder variable.
C A DIV B Result
C MVR Remainder
C EVAL xDsply = %CHAR(A) + '/' + %CHAR(B) +
C ' = ' + %CHAR(Result)
//it Displays 25/11 = 2
C xDsply DSPLY
C EVAL xDsply = %CHAR(A) + '%' + %CHAR(B) +
C ' = ' + %CHAR(Remainder)
//it Displays 25%11 = 3
C xDsply DSPLY
//if a result field is there,it will send inquiry message which is a combination of
//message and response. Whatever response user provides, result field will be updated
//with that.
C D DSPLY C
//C containes value as response user provided
C C DSPLY
C SETON LR
Output
DSPLY 25/11 = 2
DSPLY 25%11 = 3
DSPLY 11 AA
Type reply, press Enter.
Reply . . . BB
DSPLY BB DSPLY 25/11 = 2 DSPLY 25%11 = 3 DSPLY 11 AA BB DSPLY BB
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Dump(A)
It is used to perform the dump operation to ensure the operation occurs regardless of the debug option set in the H specification.
Example Program
D Num1 s 5S 2 Inz(100) D Num2 s 3S 1 Inz(0) D Result s 5S 1 //it will try to divide the Num1 by Num2 (i.e., 100 and 0) //and assign the default value 1 to Result as 100/0 is not possible. C MONITOR C EVAL Result = Num1/Num2 C ON-ERROR C DUMP(A) C EVAL Result = 1 C ENDMON C C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result DSPLY 10
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Eval (M)
It evaluates the default decimal value in a variable.
Example Program
D Result4 s 6S 5 //it will evaluate the value 2.80000 to the Result4. C EVAL(M) Result4 = (2 / (7.0/10.0)) C 'Result4' DSPLY C Result4 DSPLY C SETON LR
Output
DSPLY Result4 DSPLY 280000
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Eval(R)
It evaluates the expression with right adjust.
Example Program
DB S 15A INZ('Programmers')
C B DSPLY
C EVAL B='Programmers.io'
C B DSPLY
C EVALR B='Programmers.io'
C B DSPLY
C SETON LR
Output
DSPLY PROGRAMMERS DSPLY PROGRAMMERS.IO DSPLY PROGRAMMERS.
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Eval
It is used to evaluate any kind of expression.
Example Program
Femphdr IF E K DISK
D YY s 4 Inz(*Blanks)
D OpnYY s 4 Inz('2024')
D Upcounter s 4S 2 Inz(*Zeros)
D Pagesize s 4S 2 Inz(45.00)
D Lstrrn s 4S 2 Inz(03.00)
D I s 2 0 Inz(1)
D Arr s 2 dim(10)
D Sqlstmt s 200 Inz(*Blanks)
D MyFile1 s 21 Inz(*Blanks)
D OldLib s 10 Inz('PIOLIB')
D OldFile s 10 Inz('PIOFILE')
D MyFile2 s 21 Inz(*Blanks)
D NewLib s 10 Inz('PIOLIB')
D NewFile s 10 Inz('PIOFILE2')
D C_Csnbr c 'YY'
*it will evaluate *IN45 as 1
C EVAL *IN45=%EOF(emphdr)
*it will evaluate YY as 2024
C EVAL YY=%CHAR(Opnyy)
*it will evaluate Upcounter as sum of Pagesize(45.00), Lstrrn(03.00) and 1
C EVAL Upcounter=Pagesize+Lstrrn+1
*it will evaluate first element of array Arr as 'YY'
C EVAL Arr(I)=C_Csnbr
*it will evaluate MyFile1 as PIOLIB/PIOFILE
C EVAL MyFile1= %TRIM(OldLib)+'/'+%TRIM(OldFile)
*it will evaluate MyFile2 as PIOLIB/PIOFILE2
C EVAL MyFile2= %TRIM(NewLib)+'/'+%TRIM(NewFile)
*it will evaluate Sqlstmt as concatenation of all strings
C EVAL Sqlstmt='SELECT A.COMP' +
C ', A.COUNT, B.COUNT'+
C ',A.COUNT-B.COUNT FROM' +
C '(select count(*) AS COUNT, '+
C 'COMP from ' + %TRIM(MYFILE1)+
C ' group by COMP' +
C ' order by COMP )A,'+
C '(select count(*) AS COUNT, '+
C 'COMP from ' + %TRIM(MYFILE2)+
C ' group by COMP' +
C ' order by COMP )B'+
C ' WHERE A.COMP =B.COMP '
C SETON LR
Output
DSPLY Result4 DSPLY 285714
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Except(Rpgle)/Excpt(Rpg)
The EXCEPT opcode is used to write the exception records. Exceptional records are defined at O-spec with ‘E’ as record type. EXCEPT can be used for printing a report and to partially update a physical file.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Example Program
Femphdr IF E K DISK FQPRINT O F 132 PRINTER OFLIND(*In90) *Writes Header for Report C EXCEPT HEADER C *LOVAL SETLL emphdr C READ(N) emphdr C DOW NOT %EOF() C IF *IN90 = *ON *Writes Header for Report C EXCEPT HEADER C ENDIF *Writes Record Details for Report C EXCEPT DETAIL C READ(N) emphdr C ENDDO *Writes Footer for Report C EXCEPT FOOTER C SETON LR * OQPRINT E HEADER O 6 'PAGE' O Page 10 O 47 'PARTY ACCOUNT REPORT' O 65 'DATE' O Udate Y 75 O E HEADER 1 O 10 'EMP ID' O 30 'NAME' O 80 'DOB' O 110 'DOJ' O E DETAIL 1 O EID 10 O ENAME 70 O EDOB 90 O EDOJ 120 O E FOOTER 1 O 42 ' '
Output
PAGE 1 PARTY ACCOUNT REPORT DATE 5/29/24
EMP ID NAME DOB DOJ
0000001 Maanav Tripathi 1992-10-15 2020-08-22
0000002 Priyam Narayan 1987-02-18 2015-02-01
0000003 Priyanka Arora 1985-05-24 2010-04-01
0000004 Naman 1993-01-01 2017-01-01
0000006 Priya Sharma 1992-01-01 2019-01-01
0000010 Raghav Verma 1994-02-01 2018-01-01
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Exfmt
The EXFMT opcode is used to write the exception records. Exceptional records are defined at O-spec with ‘E’ as record type. EXCEPT can be used for printing a report and to partially update a physical file.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
DSP1
A CF03(03) A R DETAIL A 3 10'Employee ID : ' A D_EMPID 7 0B 3 30 A 20 4 10'Employee Name : ' A 20 D_EMPNAME 50 O 4 30 A 23 3'F3 - Exit' A
Example Program
Fdsp1 CF E WORKSTN Femphdr IF E K DISK C DOW *IN03 = *OFF C SETOFF 20 C D_EMPID CHAIN emphdr C IF %FOUND(emphdr) C SETON 20 C EVAL D_EMPNAME = ENAME C ENDIF * *Writes a record on screen and then reads from it. C EXFMT Detail C ENDDO C SETON LR
Output
Employee ID : 1 Employee Name : Maanav Tripathi F3 -
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Exsr
It is used to call and process a saubroutine.
Example Program
Dcl-s CharDate Char(6) Inz('031286');
TEST(DE) *MDY0 CharDate;
EXSR ErrCheck;
*INLR = *ON;
BEGSR ErrCheck;
IF %ERROR();
DSPLY 'Invalid Date';
ELSE;
DSPLY 'Valid Date';
ENDIF;
ENDSR;
Output
DSPLY Valid Date
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Extrct
This opcode extracts:
- Year, month or day segment of a date or timestamp value
- Hours, minutes or seconds segment of a time or timestamp value
- Microseconds segment of a timestamp value
Example Program
Ddate0 S D
Dd1 S 5 0 Inz(*zeros)
Dd2 S 2 0 Inz(*zeros)
Dd3 S 2 0 Inz(*zeros)
DTime0 S T
DT1 S 2 0 Inz(*zeros)
DT2 S 2 0 Inz(*zeros)
DT3 S 2 0 Inz(*zeros)
DTimestp0 S Z
DStp S 6P 0 Inz(*zeros)
DxDsply S 50 Inz(*blanks)
C MOVEL *DATE Date0
*Extracts Year from current date
C EXTRCT Date0:*Y d1
*Extracts Month from current date
C EXTRCT Date0:*M d2
*Extracts Date from current date
C EXTRCT Date0:*D d3
C TIME Time0
*Extracts Hours from current Time
C EXTRCT Time0:*H t1
*Extracts Minutes from current Time
C EXTRCT Time0:*MN t2
*Extracts Seconds from current Time
C EXTRCT Time0:*S t3
C TIME Timestp0
*Extracts Milliseconds from current Time
C EXTRCT Timestp0:*MS stp
C EVAL XDsply = 'Current Date : ' + %CHAR(Date0)
C xDsply DSPLY
C EVAL XDsply = 'Current Year : ' + %CHAR(d1)
C xDsply DSPLY
C EVAL XDsply = 'Current Month : ' + %CHAR(d2)
C xDsply DSPLY
C EVAL XDsply = 'Current Date : ' + %CHAR(d3)
C xDsply DSPLY
C EVAL XDsply = 'Current Time : ' + %CHAR(Time0)
C xDsply DSPLY
C EVAL XDsply = 'Current Hours : ' + %CHAR(t1)
C xDsply DSPLY
C EVAL XDsply = 'Current Minutes : ' + %CHAR(t2)
C xDsply DSPLY
C EVAL XDsply = 'Current Seconds : ' + %CHAR(t3)
C xDsply DSPLY
C EVAL XDsply = 'Current Timestamp : ' +
C %CHAR(Timestp0)
C xDsply DSPLY
C EVAL XDsply = 'Current Milliseconds : ' +
C %CHAR(stp)
C xDsply DSPLY
C SETON LR
Output
DSPLY Current Date : 2024-05-29
DSPLY Current Year : 2024
DSPLY Current Month : 5
DSPLY Current Date : 29
DSPLY Current Time : 09.30.44
DSPLY Current Hours : 9
DSPLY Current Minutes : 30
DSPLY Current Seconds : 44
DSPLY Current Timestamp : 2024-05-29-09.30.44.002000
DSPLY Current Milliseconds : 2000
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
For
For loop is like any other for loop of any language. It consists of initial counter (Starting point), the final counter (Ending point) and the increment value (step by value).
Example Program
D Count s 2P 0 Inz(2) D Itr s 2P 0 Inz(1) D xDsply s 50 Inz(*Blanks) C EVAL xDsply = 'Start Point : 1, ' + C 'End Point : 6, Step By : 2' C xDsply DSPLY C FOR Count = 1 TO 6 BY 2 C IF Count <> 1 C EVAL xDsply = 'Increment Count by 2 ' C xDsply DSPLY C ENDIF C EVAL xDsply = 'Iteration ' + %CHAR(Itr) + ' :: ' + C ' Count Value : ' + %CHAR(Count) C xDsply DSPLY C EVAL Itr += 1 C ENDFOR C RETURN
Output
SPLY Start Point : 1, End Point : 6, Step By : 2 SPLY Iteration 1 :: Count Value : 1 SPLY Increment Count by 2 SPLY Iteration 2 :: Count Value : 3 SPLY Increment Count by 2 SPLY Iteration 3 :: Count Value : 5
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
If
It is used to check the condition and if it is true, the next statement in the IF-ENDIF block gets executed.
Example Program
D Count s 2P 0 Inz(2) D Itr s 2P 0 Inz(1) D xDsply s 50 Inz(*Blanks) C EVAL xDsply = 'Start Point : 1, ' + C 'End Point : 6, Step By : 2' C xDsply DSPLY C FOR Count = 1 TO 6 BY 2 *Perform logic inside if block if condition is met C IF Count <> 1 C EVAL xDsply = 'Increment Count by 2 ' C xDsply DSPLY C ENDIF C EVAL xDsply = 'Iteration ' + %CHAR(Itr) + ' :: ' + C ' Count Value : ' + %CHAR(Count) C xDsply DSPLY C EVAL Itr += 1 C ENDFOR C RETURN
Output
DSPLY Start Point : 1, End Point : 6, Step By : 2 DSPLY Iteration 1 :: Count Value : 1 DSPLY Increment Count by 2 DSPLY Iteration 2 :: Count Value : 3 DSPLY Increment Count by 2 DSPLY Iteration 3 :: Count Value : 5
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
IfXX
It is used to check the condition and if it is true, the next statement in the IFXX-ENDIF block gets executed.
| XX | Meaning |
|---|---|
| LE | Less than or Equal to |
| GE | Greater than or Equal to |
| GT | Greater than |
| LT | Less than |
| EQ | Equal to |
Example Program
D Count s 2P 0 Inz(1) D SumCnt s 3P 0 Inz(0) D xDsply s 50 Inz(*Blanks) C FOR Count = 1 TO 6 C EVAL SumCnt += Count *Perform logic inside if block if condition is met C Count IFEQ 1 C EVAL xDsply = 'For Loop Started :: ' + C 'Sum for Index : ' + %CHAR(SumCnt) C xDsply DSPLY C ENDIF *Perform logic inside if block if condition is met C Count IFEQ 6 C EVAL xDsply = 'For Loop Ended :: ' + C 'Sum for Index : ' + %CHAR(SumCnt) C xDsply DSPLY C ENDIF C ENDFOR C RETURN
Output
DSPLY For Loop Started :: Sum for Index : 1 DSPLY For Loop Ended :: Sum for Index : 21
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
In & Out
This opcode is used to retrieve the value from the dataarea.
CRTDTAARA DTAARA(LIB/DA) TYPE(*CHAR) LEN(30) VALUE(‘100000000001’)
Display Data Area
Data area . . . . . . . : DA
Library . . . . . . . : LIB
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 30
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 '100000000001
Example Program
D xDsply s 50 Inz(*Blanks)
C *ENTRY PLIST
C PARM A1 30
C *DTAARA DEFINE DA 30
*Locking Data Area DA to get value '100000000001' in C variable.
C *LOCK IN DA
C MOVEL DA C 12
C EVAL xDsply = 'Value in Data Area DA/C ' +
C 'Variable : ' + C
C xDsply DSPLY
*Moving Integer value of C ('100000000001') in I (100000000001) variable.
C MOVEL *ZEROS I 12 0
C EVAL I=%INT(C)
C EVAL xDsply = 'Value in I Varibale : ' + %CHAR(I)
C xDsply DSPLY
*Incrementing I by 1 to make value of I as 100000000002.
C ADD 1 I
C EVAL C=%CHAR(I)
C EVAL xDsply = 'Value in C Varibale : ' + C
C xDsply DSPLY
*Storing Value 100000000002 in DA Data Area.
C MOVEL C DA
C MOVEL C A1
C OUT DA
C UNLOCK DA
C EVAL xDsply = 'Value in Data Area DA : ' + C
C xDsply DSPLY
C SETON LR
Output
DSPLY Value in Data Area DA/C Variable : 100000000001 DSPLY Value in I Varibale : 100000000001 DSPLY Value in C Varibale : 100000000002 DSPLY Value in Data Area DA : 100000000002
DSPDTAARA DTAARA(LIB/DA)
Display Data Area
Data area . . . . . . . : DA
Library . . . . . . . : LIB
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 30
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 '100000000002
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Iter
It can be used in DO, DOU, DOUxx, DOW, DOWxx, and FOR loops to transfer control immediately to a loop’s ENDDO or ENDFOR statement.
It causes the next iteration of the loop to be executed immediately.
ITER affects the innermost loop.
Example Program
Dcl-s i packed(2:0) inz;
Dcl-s xDsply char(50) inz;
FOR i = 1 to 10;
//It checks if i is multiple of 2.
IF %REM(i:2) = 0;
ITER;
ENDIF;
//This line will not get processed for all i which are multiple of 2.
xDsply = '3 * ' + %CHAR(I) + ' = ' + %CHAR(i*3);
DSPLY xDsply;
ENDFOR;
*INLR = *ON;
Output
DSPLY 3 * 1 = 3 DSPLY 3 * 3 = 9 DSPLY 3 * 5 = 15 DSPLY 3 * 7 = 21 DSPLY 3 * 9 = 27
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Kfld
It comes into picture when we define a key list. It represents the key fields of a key list. Key field should be defined in the same order in which it is in the file else compiler will throw error.
CMPHDR
A R CMPHDRR
A CID 7 0 COLHDG('Company ID')
A CNAME 50 COLHDG('Company Name')
A CCEO 50 COLHDG('Company CEO')
A CTYPE 30 COLHDG('Company Type')
A K CID
A K CNAME
Example Program
Fcmphdr IF E K DISK D xDsply s 50 Inz *Key fields declared to fetch a record from CMPHDR file C KCMPHDR KLIST C KFLD K_CMPID 7 0 C KFLD K_CMPNAME 50 C EVAL K_CMPID = 1 C EVAL K_CMPNAME = 'Programmers.io' *Key fields are used to point to record in CMPHDR file C KCMPHDR CHAIN cmphdr C IF %FOUND(cmphdr) C EVAL xDsply = 'Company Details' C xDsply DSPLY C EVAL xDsply = 'Company ID : ' + %CHAR(CID) C xDsply DSPLY C EVAL xDsply = 'Company Name : ' + %CHAR(CNAME) C xDsply DSPLY C EVAL xDsply = 'Company CEO : ' + %CHAR(CCEO) C xDsply DSPLY C EVAL xDsply = 'Company Type : ' + %CHAR(CTYPE) C xDsply DSPLY C ENDIF C SETON LR
Output
DSPLY Company Details
DSPLY Company ID : 1
DSPLY Company Name : Programmers.io
DSPLY Company CEO : Anshul Choudhry
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Klist
It is used to create a composite key consisting of many key fields that is used as an argument for performing operation on a file. KLIST is used for file operations CHAIN, DELETE, READE, READPE, SETGT, or SETLL. To define fields of a keylist we use KFLD opcode.
CMPHDR
A R CMPHDRR
A CID 7 0 COLHDG('Company ID')
A CNAME 50 COLHDG('Company Name')
A CCEO 50 COLHDG('Company CEO')
A CTYPE 30 COLHDG('Company Type')
A K CID
A K CNAME
Example Program
Fcmphdr IF E K DISK
D xDsply s 50 Inz
*Key fields declared to fetch a record from CMPHDR file
C KCMPHDR KLIST
C KFLD K_CMPID 7 0
C KFLD K_CMPNAME 50
C EVAL K_CMPID = 1
C EVAL K_CMPNAME = 'Programmers.io'
*Key fields are used to point to record in CMPHDR file
C KCMPHDR CHAIN cmphdr
C IF %FOUND(cmphdr)
C EVAL xDsply = 'Company Details'
C xDsply DSPLY
C EVAL xDsply = 'Company ID : ' + %CHAR(CID)
C xDsply DSPLY
C EVAL xDsply = 'Company Name : ' + %CHAR(CNAME)
C xDsply DSPLY
C EVAL xDsply = 'Company CEO : ' + %CHAR(CCEO)
C xDsply DSPLY
C EVAL xDsply = 'Company Type : ' + %CHAR(CTYPE)
C xDsply DSPLY
C ENDIF
C SETON LR
Output
DSPLY Company Details
DSPLY Company ID : 1
DSPLY Company Name : Programmers.io
DSPLY Company CEO : Anshul Choudhry
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Leave
You can use LEAVE within a DO, DOU, DOUxx, DOW, DOWxx, or FOR loop to transfer control immediately from the innermost loop to the statement following the innermost loop’s ENDDO or ENDFOR operation.
The LEAVE (Leave a Do/For Group) operation is like the ITER operation. The ITER operation takes the control to ENDDO, ENDFOR while LEAVE transfers control to the statement following the ENDDO or ENDFOR operation.
Example Program
D Count s 2P 0 Inz(*zeros) D xDsply s 50 Inz(*zeros) * Loop through code starting from 0 till 5 C DOW Count < 6 C IF Count = 3 C EVAL xDsply = 'Leave at : ' + %CHAR(Count) C xDsply DSPLY C LEAVE C ENDIF C Count DSPLY C EVAL Count = Count + 1 C ENDDO C EVAL xDsply = 'Out of Loop' C xDsply DSPLY C SETON LR
Output
DSPLY 0 DSPLY 1 DSPLY 2 DSPLY Leave at : 3 DSPLY Out of Loop
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
LeaveSr
This opcode is used to take the control out of the subroutine inside which it is defined.
Example Program
Dcl-s F packed(3:0) inz;
Dcl-s Num packed(3:0) inz;
Dcl-s I packed(2:0) inz;
Dcl-s xDsply char(50) inz;
Num = 3;
EXSR calculateFactorial;
Num = 0;
EXSR calculateFactorial;
Num = 5;
EXSR calculateFactorial;
*INLR = *ON;
BEGSR calculateFactorial;
F = 1;
xDsply = %CHAR(Num) + '! = ';
IF Num = 0;
xDsply = %TRIM(xDsply) + ' Left calculateFactorial ' +
'without processing';
DSPLY xDsply;
LEAVESR;
ENDIF;
FOR I = 1 TO Num;
F = F * I;
ENDFOR;
xDsply = %TRIM(xDsply) + ' ' + %CHAR(F);
DSPLY xDsply;
ENDSR;
Output
DSPLY 3! = 6 DSPLY 0! = Left calculateFactorial without processing DSPLY 5! = 120
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Lookup
It is used to look for an element in the array.
Example Program
D Arr2 s 3 0 dim(5) ctdata perrcd(1)
D N s 2 0 inz(1)
D xDsply s 50 inz
C N DO 5
C EVAL xDsply = 'ARR2(' + %CHAR(N) + ') = ' +
C %CHAR(Arr2(N))
C xDsply DSPLY
C EVAL N=N+1
C ENDDO
C SORTA Arr2
C EVAL N=1
C EVAL xDsply = 'After Sorting ARR2'
C xDsply DSPLY
C N DO 5
C EVAL xDsply = 'ARR2(' + %CHAR(N) + ') = ' +
C %CHAR(Arr2(N))
C xDsply DSPLY
C EVAL N=N+1
C ENDDO
C 204 LOOKUP Arr2 81
C IF *IN81=*ON
C EVAL xDsply = '204 is found in ARR2'
C xDsply DSPLY
C ENDIF
C XFOOT Arr2 Sum 4 0
C EVAL xDsply = 'Sum of elements in ARR2 = ' +
C %CHAR(Sum)
C xDsply DSPLY
C SETON LR
** CTDATA Arr2
201
205
203
202
204
Output
DSPLY ARR2(1) = 201
DSPLY ARR2(2) = 205
DSPLY ARR2(3) = 203
DSPLY ARR2(4) = 202
DSPLY ARR2(5) = 204
DSPLY After Sorting ARR2
DSPLY ARR2(1) = 201
DSPLY ARR2(2) = 202
DSPLY ARR2(3) = 203
DSPLY ARR2(4) = 204
DSPLY ARR2(5) = 205
DSPLY 204 is found in ARR2
DSPLY Sum of elements in ARR2 = 1015
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Monitor
If no error indicator or ‘E’ extender is present and the code that generates the exception is in the MONITOR block of a MONITOR group, control will pass to the on-error section of the MONITOR group.
Example Program
HOPTION(*SRCSTMT) Femphdr UF A E DISK USROPN D xDsply s 50 Inz C MONITOR C MONITOR //If the error is 'file EMPHDR not OPEN', then // open the file EMPHDR C 10 SETLL emphdr C ON-ERROR 1211 C EVAL xDsply = 'Error : File is not opened!' C xDsply DSPLY C OPEN emphdr C ENDMON C MONITOR C EVAL ename='OOO' C UPDATE emphdrr //If the error is 'Update without prior INPUT/READ // operation', then READ the file. C ON-ERROR 1215 C EVAL xDsply = 'Error : Update without prior Read!' C xDsply DSPLY C READ(E) emphdr C EVAL ename='OOO' C UPDATE(E) emphdrr C ENDMON //If the error is 'any unhandled file error' then // take the DUMP'. C ON-ERROR *FILE C EVAL xDsply = 'Error : Unhandled!' C xDsply DSPLY C DUMP(A) C ON-ERROR C EVAL xDsply = 'Error!!!' C xDsply DSPLY C DUMP(A) C ENDMON C SETON LR
Output
DSPLY Error : File is not opened! DSPLY Error : Unhandled!
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Movel
The MOVEL operation moves characters from factor 2 to the result field and it does that by moving the leftmost character first.
Example Program
D A1 s 5A Inz('AAAAA')
D B2 s 10A Inz('BBBBBBBBBB')
//it will move the value from A1 ('AAAAA') to B2('BBBBBBBBBB')
//and assign the 'BBBBBAAAAA' value to the B2 variable.
C MOVE A1 B2
C 'B2' DSPLY
C B2 DSPLY
C RESET B2
//it will move the value from A1 ('AAAAA') to B2('BBBBBBBBBB')
//and assign the ' AAAAA' value to the B2 variable.
C MOVE(P) A1 B2
C 'B2' DSPLY
C B2 DSPLY
C RESET B2
//it will move the value from A1 ('AAAAA') to B2('BBBBBBBBBB')
//and assign the 'AAAAABBBBB' value to the B2 variable.
C MOVEL A1 B2
C 'B2' DSPLY
C B2 DSPLY
C RESET B2
//it will move the value from A1 ('AAAAA') to B2('BBBBBBBBBB')
//and assign the 'AAAAA ' value to the B2 variable.
C MOVEL(P) A1 B2
C 'B2' DSPLY
C B2 DSPLY
C RESET B2
C SETON LR
Output
DSPLY B2 DSPLY BBBBBAAAAA DSPLY B2 DSPLY AAAAA DSPLY B2 DSPLY AAAAABBBBB DSPLY B2 DSPLY AAAAA
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Mult & Mult(H)
This op-code multiplies factor-1 with factor-2 and places the result in result field.
Example Program
D a s 4S 2 Inz(10.25) D b s 4S 2 Inz(10.20) D Result s 5S 1 D Result2 s 5S 2 //it will multiply the value of a and b (i.e., 10.25 and 10.20) //and assign a 104.55 value to the Result2 variable.. C b MULT a Result2 C 'Result2' DSPLY C Result2 DSPLY //it will multiply the value of a and b (i.e., 10.25 and 10.20) //and assign 104.6 value to the Result variable by rounding //the value from 104.55 to 104.6. C b MULT(H) a Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result2 DSPLY 10455 DSPLY Result DSPLY 1046
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Mvr
It moves remainder for division happened between two numbers/variables earlier in a variable.
Example Program
D A s 2P 0 Inz(25) D B s 2P 0 Inz(11) D Result s 2P 0 Inz(*zeros) D Remainder s 2P 0 Inz(*zeros) D xDsply s 50 Inz(*blanks) //it will Divide the value of a by b (i.e., 25 and 11) // and assign a 2 value to the Result variable // and assign a 3 value to the Remainder variable. C A DIV B Result C MVR Remainder C EVAL xDsply = %CHAR(A) + '/' + %CHAR(B) + C ' = ' + %CHAR(Result) C xDsply DSPLY C EVAL xDsply = %CHAR(A) + '%' + %CHAR(B) + C ' = ' + %CHAR(Remainder) C xDsply DSPLY C SETON LR
Output
DSPLY 25/11 = 2 DSPLY 25%11 = 3
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Occur
The OCCUR operation establishes which occurrence of a multiple occurrence data structure is used next in a program.
Example Program
D Ds1 DS occurs(10)
D Fld01 1 5
D Fld02 6 10
D X S 2 0 Inz(1)
D N S 2 0 Inz(1)
D xDsply S 50 Inz
C X DO 5
C X OCCUR Ds1 N
C EVAL Fld01=%CHAR(X)
C EVAL Fld02=%CHAR(X)
C EVAL X=X+1
C EVAL xDsply = 'DS1(' + %CHAR(N) + ') : '
C xDsply DSPLY
C Ds1 DSPLY
C ENDDO
C SETON LR
Output
DSPLY DS1(1) : DSPLY 1 1 DSPLY DS1(2) : DSPLY 2 2 DSPLY DS1(3) : DSPLY 3 3 DSPLY DS1(4) : DSPLY 4 4 DSPLY DS1(5) : DSPLY 5 5
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
On-Error
ON-ERROR follows the MONITOR opcode which is used for trapping errors.
Example Program
HOPTION(*SRCSTMT) Femphdr UF A E DISK USROPN D xDsply s 50 Inz C MONITOR C MONITOR //If the error is 'file EMPHDR not OPEN', then // open the file EMPHDR C 10 SETLL emphdr C ON-ERROR 1211 C EVAL xDsply = 'Error : File is not opened!' C xDsply DSPLY C OPEN emphdr C ENDMON C MONITOR C EVAL ename='OOO' C UPDATE emphdrr //If the error is 'Update without prior INPUT/READ // operation', then READ the file. C ON-ERROR 1215 C EVAL xDsply = 'Error : Update without prior Read!' C xDsply DSPLY C READ(E) emphdr C EVAL ename='OOO' C UPDATE(E) emphdrr C ENDMON //If the error is 'any unhandled file error' then // take the DUMP'. C ON-ERROR *FILE C EVAL xDsply = 'Error : Unhandled!' C xDsply DSPLY C DUMP(A) C ON-ERROR C EVAL xDsply = 'Error!!!' C xDsply DSPLY C DUMP(A) C ENDMON C SETON LR
Output
DSPLY Error : File is not opened! DSPLY Error : Unhandled!
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Opcode Extender for File Operations
We have an‘N’ opcode extender that is used to make the record not locked while reading. Before is the simple example of an N opcode extender.
File : EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Program
FEMPHDR UF E K DISK D File_Ind s 2 0 C FOR File_Ind = 1 to 10 //Since EMPHDR is delcared in Update Mode. While reading file N opcode extender //does not locks the record and if any update/delete operation is //performed then it will execute without any error. C READ(N) EMPHDR //If End of file is there C IF %EOF C LEAVE C ENDIF //Logic here C ENDFOR C SETON LR
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Open
The OPEN opcode is used to explicitly open a file.
Program
dcl-f emphdr disk usropn usage(*input:*output:*update) keyed;
dcl-s xDsply Char(50) inz(*blanks);
IF NOT %OPEN(emphdr);
OPEN emphdr;
DSPLY 'EMPHDR is opened for operation';
ENDIF;
CHAIN 0000001 emphdr;
IF %FOUND();
xDsply = 'Name : ' + ename;
DSPLY xDsply;
ename = 'Maanav Tripathi';
UPDATE emphdrr;
DSPLY 'Name Updated!';
ENDIF;
CHAIN 0000001 emphdr;
IF %FOUND();
DSPLY 'Updated Data';
xDsply = 'Name : ' + ename;
DSPLY xDsply;
ENDIF;
CLOSE emphdr;
DSPLY 'EMPHDR is closed';
*INLR = *ON;
Output
DSPLY EMPHDR is opened for operation DSPLY Name : Manav Tripathi DSPLY Name Updated! DSPLY Updated Data DSPLY Name : Maanav Tripathi DSPLY EMPHDR is closed
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Other
If all when statement is not true, then it gets executed.
Program
Dcl-s S Packed(2:0);
Dcl-s K Packed(2:0);
Dcl-s xDsply Char(50);
Dcl-s Error Char(1) Inz(' ');
FOR K = 1 to 6;
SELECT;
WHEN K = 1;
S = 20+K;
xdsply = 'Summation = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 2;
S = 20-K;
xdsply = 'Subtraction = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 3;
S = 20*K;
xdsply = 'Multiplication = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 4;
S = 20/K;
xdsply = 'Division = ' + %CHAR(S);
DSPLY xdsply;
OTHER;
xdsply = 'No operation to perform';
DSPLY xdsply;
ENDSL;
ENDFOR;
*INLR = *ON;
Output
DSPLY Summation = 21 DSPLY Subtraction = 18 DSPLY Multiplication = 60 DSPLY Division = 5 DSPLY No operation to perform DSPLY No operation to perform
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Parm
This opcode is used to define PLIST parameter fields.
Program
D xDsply s 50 Inz D c s 2 0 Inz C *ENTRY PLIST C PARM a 2 0 C PARM b 2 0 * C EVAL C = A + B C EVAL xDsply = %CHAR(A) + ' + ' + %CHAR(B) + C ' = ' + %CHAR(C) C xDsply DSPLY C SETON LR
Call program with parameters as 22 and 11.
Output
DSPLY 22 + 11 = 33
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Plist
It is used to define a list of parameter that will be used for calling a program.
Program
D xDsply s 50 Inz D c s 2 0 Inz C *ENTRY PLIST C PARM a 2 0 C PARM b 2 0 * C EVAL C = A + B C EVAL xDsply = %CHAR(A) + ' + ' + %CHAR(B) + C ' = ' + %CHAR(C) C xDsply DSPLY C SETON LR
Call program with parameters as 22 and 11.
Output
DSPLY 22 + 11 = 33
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Read
Read operation reads the records of a full procedural file. First of all, it reads the record where currently the pointer is and then advances the pointer to the next record.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Example Program
Femphdr IF E K DISK DDs1 ds LIKEREC(emphdrr) DxDsply s 50 C *LOVAL SETLL emphdrr C READ emphdr DS1 90 // *in90 at EQ-position indicates // EOF() condition C DOW *IN90=*OFF C EVAL xDsply = 'Employee ID : ' + %CHAR(Ds1.eid)+ C ', Employee Name : ' + %CHAR(Ds1.ename) C xDsply DSPLY C READ emphdr DS1 90 C ENDDO C IF *IN90=*ON C 'End of File' DSPLY C ENDIF C SETON LR
Output
DSPLY Employee ID : 1, Employee Name : Maanav Tripathi DSPLY Employee ID : 2, Employee Name : Priyam Narayan DSPLY Employee ID : 3, Employee Name : Priyanka Arora DSPLY Employee ID : 4, Employee Name : Naman DSPLY Employee ID : 6, Employee Name : Priya Sharma DSPLY Employee ID : 10, Employee Name : Raghav Verma DSPLY End of File
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Reade
READE reads the matching record for factor-1 and moves the pointer to the next record with the same matching criteria. If the same matching criteria is not found then it foes to EOF.
EMPHDR
A R ORDHDRR
A OID 7 0 COLHDG('Order ID')
A OITEM 7 0 COLHDG('Order Item')
A OQTY 3 0 COLHDG('Order Qty.')
A OPRICE 5 0 COLHDG('Order Price')
A K OID
A K OITEM
Example Program
Dcl-f ordhdr keyed;
Dcl-s order_id packed(7:0) inz(1);
Dcl-s Tprice packed(7:0) inz(0);
Dcl-s xDsply char(50) inz;
xDsply = 'Order ID | Item Number | Quantity | Price ';
DSPLY xDsply;
SETLL order_id ordhdr;
READE order_id ordhdr;
DOW NOT %EOF();
xDsply = %CHAR(oid) + ' | ' + %CHAR(oitem) + ' | ' +
%CHAR(oqty) + ' | ' + %CHAR(oprice);
DSPLY xDsply;
Tprice = Tprice + oprice;
READE order_id ordhdr;
ENDDO;
xDsply = 'Total Price for Order ' + %CHAR(Order_id) +
' is $' + %CHAR(Tprice);
DSPLY xDsply;
*INLR = *ON;
Output
DSPLY Order ID | Item Number | Quantity | Price DSPLY 1 | 1 | 2 | 200 DSPLY 1 | 2 | 1 | 400 DSPLY 1 | 4 | 3 | 1200 DSPLY Total Price for Order 1 is $1800
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Readp
READP moves the pointer to the previous record and reads the record and again moves the pointer to next previous position. If there are no more records it sets EOF *ON.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Example Program
Femphdr IF E K DISK DDs1 ds LIKEREC(emphdrr) DxDsply s 50 C *HIVAL SETLL emphdrr C READP emphdr DS1 90 // *in90 at EQ-position indicates // EOF() condition C DOW *IN90=*OFF C EVAL xDsply = 'Employee ID : ' + %CHAR(Ds1.eid)+ C ', Employee Name : ' + %CHAR(Ds1.ename) C xDsply DSPLY C READP emphdr DS1 90 C ENDDO C IF *IN90=*ON C 'End of File' DSPLY C ENDIF C SETON LR
Output
DSPLY Employee ID : 10, Employee Name : Raghav Verma DSPLY Employee ID : 6, Employee Name : Priya Sharma DSPLY Employee ID : 4, Employee Name : Naman DSPLY Employee ID : 3, Employee Name : Priyanka Arora DSPLY Employee ID : 2, Employee Name : Priyam Narayan DSPLY Employee ID : 1, Employee Name : Maanav Tripathi DSPLY End of File
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Readpe
READPE moves the pointer to the previous record and reads the record and again moves the pointer to next previous position and read the same matching record for factor-1.
ORDHDR
A R ORDHDRR
A OID 7 0 COLHDG('Order ID')
A OITEM 7 0 COLHDG('Order Item')
A OQTY 3 0 COLHDG('Order Qty.')
A OPRICE 5 0 COLHDG('Order Price')
A K OID
A K OITEM
Example Program
Dcl-f ordhdr keyed;
Dcl-s order_id packed(7:0) inz(1);
Dcl-s Tprice packed(7:0) inz(0);
Dcl-s xDsply char(50) inz;
xDsply = 'Order ID | Item Number | Quantity | Price ';
DSPLY xDsply;
SETGT order_id ordhdr;
READPE order_id ordhdr;
DOW NOT %EOF();
xDsply = %CHAR(oid) + ' | ' + %CHAR(oitem) + ' | ' +
%CHAR(oqty) + ' | ' + %CHAR(oprice);
DSPLY xDsply;
Tprice = Tprice + oprice;
READPE order_id ordhdr;
ENDDO;
xDsply = 'Total Price for Order ' + %CHAR(Order_id) +
' is $' + %CHAR(Tprice);
DSPLY xDsply;
*INLR = *ON;
Output
DSPLY Order ID | Item Number | Quantity | Price DSPLY 1 | 4 | 3 | 1200 DSPLY 1 | 2 | 1 | 400 DSPLY 1 | 1 | 2 | 200 DSPLY Total Price for Order 1 is $1800
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Return
Return ends the program and gives the control to the calling program. Return doesn’t release the resources.
PROGB
D Up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D Lo c 'abcdefghijklmnopqrstuvwxyz' C *ENTRY PLIST C PARM FieldA 50 C PARM FieldB 50 C Lo:Up XLATE FieldA FieldB C RETURN
Example Program
C PLST1 PLIST C PARM a 2 0 C PARM b 2 0 C PARM c 2 0 * C Z-ADD 11 a C Z-ADD 22 b C Z-ADD *zeros c * C CALLB 'PROGB' PLST1 C 'A' DSPLY C a DSPLY C 'B' DSPLY C b DSPLY C 'SUM' DSPLY C c DSPLY C SETON LR
CRTRPGMOD MODULE(LIB/PROGB) SRCFILE(LIB/QRPGLESRC) SRCMBR(PROGB) REPLACE(*YES)
CRTRPGMOD MODULE(LIB/CALLBRPG) SRCFILE(LIB/QRPGLESRC) SRCMBR(CALLBRPG) REPLACE(*YES)
CRTPGM PGM(LIB/CALLBRPG) MODULE (LIB/CALLBRPG LIB/PROGB) ENTMOD(*PGM)
Output
DSPLY A DSPLY 11 DSPLY B DSPLY 22 DSPLY SUM DSPLY 33
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Scan(E)
Error handling while searching the string.
Example Program
D X s 3S 0 Inz(32)
D K s 3S 0 Inz(5)
D Pos s 3S 0
D String s 30A Inz('Search String')
//it will try to search the blank in the variable String ('Search String')
//from starting position K (5) and 7 will assign it to the Pos variable.
C ' ' SCAN String:K Pos
//it will try to search the blank in the variable String ('Search String')
// from starting position X (32) but display the 'Error' message as the 22 index
//is not present in a String variable.
C ' ' SCAN(E) String:X Pos
C IF %ERROR
C 'SCAN(E)' DSPLY
C 'Error' DSPLY
C ENDIF
C SETON LR
Output
DSPLY SCAN(E) DSPLY Error
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Select
It is used to make a case statement so that only statements satisfying the condition will be executed. The condition is mentioned with WHEN.
Example Program
Dcl-s S Packed(2:0);
Dcl-s K Packed(2:0);
Dcl-s xDsply Char(50);
Dcl-s Error Char(1) Inz(' ');
DOW Error = ' ';
FOR K = 1 to 6;
SELECT;
WHEN K = 1;
S = 20+K;
xdsply = 'Summation = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 2;
S = 20-K;
xdsply = 'Subtraction = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 3;
S = 20*K;
xdsply = 'Multiplication = ' + %CHAR(S);
DSPLY xdsply;
WHEN K >= 4;
IF K = 4;
S = 20/K;
xdsply = 'Division = ' + %CHAR(S);
DSPLY xdsply;
ELSEIF K = 5;
MONITOR;
S = 20/(K-5);
ON-ERROR;
S = 0;
Error = 'Y';
xdsply = 'Divide by 0 Error';
DSPLY xdsply;
Leave;
ENDMON;
ENDIF;
ENDSL;
ENDFOR;
ENDDO;
*INLR = *ON;
Output
DSPLY Summation = 21 DSPLY Subtraction = 18 DSPLY Multiplication = 60 DSPLY Division = 5 DSPLY Divide by 0 Error
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Setgt
This opcode positions the file pointer at the next record which is having the key/RRN value just greater than the current key /RRN value.
After positioning the file pointer, we can go for any file operation e.g. READ, READP, READPE, READE. In factor-1 we can use figurative constants *LOVAL, *HIVAL, *START, *END or we can use RRN VALUE or KEY VALUE or KEY LIST.
SETGT if successful sets EOF () to *OFF, else if not successful doesn’t do anything to EOF().
Example Program
Dcl-f ordhdr keyed; Dcl-s order_id packed(7:0) inz(1); Dcl-s Tprice packed(7:0) inz(0); Dcl-s xDsply char(50) inz; SETGT *HIVAL ordhdr; READ ordhdr; IF %EOF(); DSPLY 'End Of File'; ENDIF; SETGT order_id ordhdr; IF %FOUND(); DSPLY 'Higher Value'; ELSE; DSPLY 'No Records'; ENDIF; IF NOT %EOF(); DSPLY 'Not EOF'; ENDIF; *INLR = *ON;
Output
DSPLY End Of File DSPLY Higher Value
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Setll
SETLL sets the file pointer at the first occurrence of the record where the key field/RRN value is greater than or equal to the factor-1 search argument value.
After positioning the file pointer we can go for any file operation e.g. READ, READP, READPE, READE. If the SETLL operation is not successful (no records found condition), the file is positioned to the end of the file.
In factor-1 we can use figurative constant *LOVAL, *HIVAL, *START, *END or we can use RRN VALUE or KEY VALUE or KEY LIST.
We use %FOUND to determine if the record found is having the key field/RRN value greater than or equal to the key field. In this case HI indicator will be *on.
Example Program
Dcl-f ordhdr keyed; Dcl-s order_id packed(7:0) inz(1); Dcl-s xDsply char(50) inz; SETLL order_id ordhdr; IF %EQUAL(); DSPLY 'Exact Match!'; ELSEIF %FOUND(); DSPLY 'Higher Match!'; ELSEIF %EOF(); DSPLY 'End Of File'; ELSE; DSPLY 'No Records'; ENDIF; *INLR = *ON;
Output
DSPLY Exact Match!
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Setoff
It is used to off indicator. (assign ‘0’)
Example Program
D Arr2 s 3 0 dim(5) ctdata perrcd(1)
D N s 2 0 inz(1)
D xDsply s 50 inz
C N DO 5
C IF %REM(Arr2(N):2) = 0
*30 indicator is set on for even numbers
C SETON 30
C ELSE
*30 indicator is set off for odd numbers
C SETOFF 30
C ENDIF
C 30 EVAL xDsply = 'ARR2(' + %CHAR(N) + ') = ' +
C %CHAR(Arr2(N))
C 30xDsply DSPLY
C EVAL N=N+1
C ENDDO
C SETON LR
** CTDATA Arr2
201
205
203
202
204
Output
DSPLY ARR2(4) = 202 DSPLY ARR2(5) = 204
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Seton
It is used to on indicator. (assign ‘1’)
Example Program
D Arr2 s 3 0 dim(5) ctdata perrcd(1)
D N s 2 0 inz(1)
D xDsply s 50 inz
C N DO 5
C IF %REM(Arr2(N):2) = 0
*30 indicator is set on for even numbers
C SETON 30
C ELSE
*30 indicator is set off for odd numbers
C SETOFF 30
C ENDIF
C 30 EVAL xDsply = 'ARR2(' + %CHAR(N) + ') = ' +
C %CHAR(Arr2(N))
C 30xDsply DSPLY
C EVAL N=N+1
C ENDDO
C SETON LR
** CTDATA Arr2
201
205
203
202
204
Output
DSPLY ARR2(4) = 202 DSPLY ARR2(5) = 204
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Sorta
It is used to sort the array element.
Example Program
D Arr2 s 3 0 dim(5) ctdata perrcd(1)
D N s 2 0 inz(1)
D xDsply s 50 inz
C N DO 5
C EVAL xDsply = 'ARR2(' + %CHAR(N) + ') = ' +
C %CHAR(Arr2(N))
C xDsply DSPLY
C EVAL N=N+1
C ENDDO
C SORTA Arr2
C EVAL N=1
C EVAL xDsply = 'After Sorting ARR2'
C xDsply DSPLY
C N DO 5
C EVAL xDsply = 'ARR2(' + %CHAR(N) + ') = ' +
C %CHAR(Arr2(N))
C EVAL N=N+1
C ENDDO
C SETON LR
** CTDATA Arr2
201
205
203
202
204
Output
DSPLY ARR2(1) = 201 DSPLY ARR2(2) = 205 DSPLY ARR2(3) = 203 DSPLY ARR2(4) = 202 DSPLY ARR2(5) = 204 DSPLY After Sorting ARR2 DSPLY ARR2(1) = 201 DSPLY ARR2(2) = 202 DSPLY ARR2(3) = 203 DSPLY ARR2(4) = 204 DSPLY ARR2(5) = 205
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Subdur
SUBDUR operation code is used to perform arithmetic difference of duration in factor-2 from DATE, TIME, or TIMESTAMP value in factor-1. The result is placed in result field.
Example Program
H TIMFMT(*USA) DATFMT(*MDY&) * DDateConst C CONST(D'12 31 92') * * Define a Date field and initializeesult variable. * DLoanDate S D DATFMT(*EUR) INZ(D'12 31 92') DDueDate S D DATFMT(*ISO) DTimeStamp S Z DAnswer S T Dxx S 2 0 Inz(1) Dyy S 2 0 Inz(1) Dzz S 2 0 Inz(30) * Determine a LoanDate which is xx years, yy months, zz days earlier * than DueDate. C DueDate SUBDUR xx:*YEARS LoanDate C SUBDUR yy:*MONTHS LoanDate C SUBDUR zz:*DAYS LoanDate C 'LOANDATE' DSPLY C LoanDate DSPLY C 'DUEDATE' DSPLY C DueDate DSPLY * Determine the date 23 days earlier * C SUBDUR 23:*D LoanDate C '- 23 Days' DSPLY C LoanDate DSPLY * Subtract a 1234 microseconds to a timestamp * C 'TIMESTAMP' DSPLY C TimeStamp DSPLY C SUBDUR -1234:*MS TimeStamp C '- 1234 MS' DSPLY C TimeStamp DSPLY * Subtract 12 HRS and 16 minutes to midnight * C 'ANSWER' DSPLY C Answer DSPLY C T'00:00 am' SUBDUR 12:*Hours Answer C '- 12 Hrs' DSPLY C Answer DSPLY C SUBDUR 16:*Minutes Answer C '- 16 Min' DSPLY C Answer DSPLY C SETON LR
Output
DSPLY LOANDATE DSPLY 1991-10-31 DSPLY DUEDATE DSPLY 31.12.1992 DSPLY - 23 Days DSPLY 1991-10-08 DSPLY TIMESTAMP DSPLY 0001-01-01-00.00.00.000000 DSPLY - 1234 MS DSPLY 0001-01-01-00.00.00.001234 DSPLY ANSWER DSPLY 00:00 AM DSPLY - 12 Hrs DSPLY 12:00 PM DSPLY - 16 Min DSPLY 11:44 AM
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Subst(E P)
Error handling or padding with blank while substring the string variable.
Example Program
D T s 3S 0 Inz(4)
D X s 3S 0 Inz(22)
D Length s 3S 0 Inz(3)
D String1 s 8A
D Target s 8A
C MOVE 'TEST123' String1
C MOVE *ALL'X' Target
//it will substring the variable Target ('XXXXXXXX') with String1 ('TEST123')
//from starting position T(4) till length (3) and substring the
//value of target from 'XXXXXXXX' to 'T12XXXXX'.
C Length SUBST String1:T Target
C 'SUBST' DSPLY
C Target DSPLY
//it will substring the variable Target ('XXXXXXXX') with String1 ('TEST123')
//from starting position X(22) till length (3) but display the 'Error' message
//as the 22 index is not present in Target variable.
C Length SUBST(E) String1:X Target
C IF %ERROR
C 'SUBST(E)' DSPLY
C 'Error' DSPLY
C ENDIF
C MOVE *ALL'X' Target
//it will substring the variable Target ('XXXXXXXX') with String1 ('TEST123')
//from starting position T(4) till length (3) and substring the
//value of target from 'XXXXXXXX' to 'T12 '.
C Length SUBST(P) String1:T Target
C 'SUBST(P)' DSPLY
C Target DSPLY
C SETON LR
Output
DSPLY SUBST DSPLY ST1XXXXX DSPLY SUBST(E) DSPLY Error DSPLY SUBST(P) DSPLY ST1
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Time
It gets the current system time.
Example Program
DTime0 S T DxDsply S 50 Inz(*blanks) C TIME Time0 C EVAL XDsply = 'Current Time : ' + %CHAR(Time0) C xDsply DSPLY C SETON LR
Output
DSPLY Current Time : 09.09.12
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Unlock
This opcode is used to unlock the dataarea.
CRTDTAARA DTAARA(LIB/DA) TYPE(*CHAR) LEN(30) VALUE(‘1001’)
Display Data Area
Data area . . . . . . . : DA
Library . . . . . . . : LIB
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 30
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 '1001 '
Example Program
D xDsply s 50 Inz(*Blanks)
C *ENTRY PLIST
C PARM A1 30
C *DTAARA DEFINE DA 30
*Locking Data Area DA to get value '1001' in C variable.
C *LOCK IN DA
C MOVEL DA C 12
C EVAL xDsply = 'Value in Data Area DA/C ' +
C 'Variable : ' + C
C xDsply DSPLY
*Moving Integer value of C ('1001') in I (1001) variable.
C MOVEL *ZEROS I 12 0
C EVAL I=%INT(C)
C EVAL xDsply = 'Value in I Varibale : ' + %CHAR(I)
C xDsply DSPLY
*Incrementing I by 1 to make value of I as 1002.
C ADD 1I
C EVAL C=%CHAR(I)
C EVAL xDsply = 'Value in C Varibale : ' + C
C xDsply DSPLY
*Storing Value 1002 in DA Data Area.
C MOVEL C DA
C MOVEL C A1
C OUT DA
C UNLOCK DA
C EVAL xDsply = 'Value in Data Area DA : ' + C
C xDsply DSPLY
C SETON LR
Output
DSPLY Value in Data Area DA/C Variable : 1001 DSPLY Value in I Varibale : 1001 DSPLY Value in C Varibale : 1002 DSPLY Value in Data Area DA : 1002
DSPDTAARA DTAARA(LIB/DA)
Display Data Area
Data area . . . . . . . : DA
Library . . . . . . . : LIB
Type . . . . . . . . . : *CHAR
Length . . . . . . . . : 30
Text . . . . . . . . . :
Value
Offset *...+....1....+....2....+....3....+....4....+....5
0 '1002 '
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Update
The UPDATE opcode is used to update a record in a file.
dcl-f emphdr disk usropn usage(*input:*output:*update) keyed;
dcl-s xDsply Char(50) inz(*blanks);
IF NOT %OPEN(emphdr);
OPEN emphdr;
DSPLY 'EMPHDR is opened for operation';
ENDIF;
CHAIN 0000001 emphdr;
IF %FOUND();
xDsply = 'Name : ' + ename;
DSPLY xDsply;
ename = 'Maanav Tripathi';
UPDATE emphdrr;
DSPLY 'Name Updated!';
ENDIF;
CHAIN 0000001 emphdr;
IF %FOUND();
DSPLY 'Updated Data';
xDsply = 'Name : ' + ename;
DSPLY xDsply;
ENDIF;
CLOSE emphdr;
DSPLY 'EMPHDR is closed';
*INLR = *ON;
Output
DSPLY EMPHDR is opened for operation DSPLY Name : Manav Tripathi DSPLY Name Updated! DSPLY Updated Data DSPLY Name : Maanav Tripathi DSPLY EMPHDR is closed
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
When
The operations controlled by the WHEN operation are performed when the expression in the indicator-expression operand is true.
Dcl-s S Packed(2:0);
Dcl-s K Packed(2:0);
Dcl-s xDsply Char(50);
Dcl-s Error Char(1) Inz(' ');
FOR K = 1 to 6;
SELECT;
WHEN K = 1;
S = 20+K;
xdsply = 'Summation = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 2;
S = 20-K;
xdsply = 'Subtraction = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 3;
S = 20*K;
xdsply = 'Multiplication = ' + %CHAR(S);
DSPLY xdsply;
WHEN K = 4;
S = 20/K;
xdsply = 'Division = ' + %CHAR(S);
DSPLY xdsply;
OTHER;
xdsply = 'No operation to perform';
DSPLY xdsply;
ENDSL;
ENDFOR;
*INLR = *ON;
Output
DSPLY Summation = 21 DSPLY Subtraction = 18 DSPLY Multiplication = 60 DSPLY Division = 5 DSPLY No operation to perform DSPLY No operation to perform
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Write
The WRITE operation writes a record in a database file.
EMPHDR
A R EMPHDRR
A EID 7 0 COLHDG('Employee ID')
A ENAME 50 COLHDG('Employee Name')
A EDOB L COLHDG('Employee DOB')
A EDOJ L COLHDG('Employee DOJ')
A K EID
Example Program
dcl-f emphdr disk usropn usage(*input:*output:*update:*delete) keyed; dcl-s xDsply Char(50) inz(*blanks); IF NOT %OPEN(emphdr); OPEN emphdr; ENDIF; eid = 11; ename = 'Ramesh Kapoor'; edoj = %date(20200101); edob = %date(19930106); write emphdrr; xDsply = 'Data Added :: ID : ' + %CHAR(eid) + ', Name : ' + ename; DSPLY xDsply; CLOSE emphdr; *INLR = *ON;
Output
DSPLY Data Added :: ID : 11, Name : Ramesh Kapoor
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Xfoot
This op-code adds the elements of a numeric array.
D Arr2 s 3 0 dim(5) ctdata perrcd(1) D xDsply s 50 inz C XFOOT Arr2 Sum 4 0 C EVAL xDsply = 'Sum of elements in ARR2 = ' + C %CHAR(Sum) C xDsply DSPLY C SETON LR ** CTDATA Arr2 201 205 203 202 204
Output
DSPLY Sum of elements in ARR2 = 1015
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Xlate(E P)
Error handling or padding with blank while translating from character to character by the protocol specified in factor-1.
D T s 3S 0 Inz(4)
D X s 3S 0 Inz(22)
D ChgCase2 s 10A Inz('rpg dept')
D Result2 s 15A Inz('XXXXXXXXXXXXXXX')
D Up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
D Lo c 'abcdefghijklmnopqrstuvwxyz'
//it will try to translate the Chgcase2 ('rpg dept') variable
//with Result2 ('XXXXXXXXXXXXXXX') by the protocol specified
//in factor-1 and assignthe new value 'RPG DEPT XXXXX' to theResult2.
C Lo:Up XLATE ChgCase2 Result2
C 'XLATE' DSPLY
C Result2 DSPLY
C CLEAR Result2
//it will try to translate the Chgcase2 ('rpg dept') variable
//with Result2 ('XXXXXXXXXXXXXXX') by the protocol specified
//in factor-1 and assignthe new value 'RPG DEPT ' to
//the Result2 while padding the ?XXXXX? with blank of Result2.
C Lo:Up XLATE(P) ChgCase2 Result2
C 'XLATE(P)' DSPLY
C Result2 DSPLY
C CLEAR Result2
C Lo:Up XLATE ChgCase2:T Result2
C 'XLATE' DSPLY
C Result2 DSPLY
C CLEAR Result2
//it will try to translate the Chgcase2 ('rpg dept') variable
//with Result2 ('XXXXXXXXXXXXXXX') from starting position X (22)
//by the protocol specified in factor-1 but diplay the 'Error'
//message as the 22 index is not present in ChgCase2 variable.
C Lo:Up XLATE(E) ChgCase2:X Result2
C IF %ERROR
C 'XLATE(E)' DSPLY
C 'Error' DSPLY
C ENDIF
C CLEAR Result2
C SETON LR
Output
DSPLY XLATE DSPLY RPG DEPT XXXXX DSPLY XLATE(P) DSPLY RPG DEPT DSPLY XLATE DSPLY rpg DEPT DSPLY XLATE(P) DSPLY Error
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Xlate
This opcode is used for character-to-character translation by the protocol specified in factor-1.
D Up c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D Lo c 'abcdefghijklmnopqrstuvwxyz' C *ENTRY PLIST C PARM FieldA 50 C PARM FieldB 50 C Lo:Up XLATE FieldA FieldB C FieldB DSPLY C SETON LR
Call above program with parameter as ‘programmers.io’ and ‘ ‘.
Output
DSPLY PROGRAMMERS.IO
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Z-add(H)
Half adjust (round) of the numeric value while adding zero to factor 2.
D b s 4S 2 Inz(10.20) D Result s 5S 1 //it will add the value of b and Result (i.e., 10.20 and 0) //and assign a 10.2 value to the Result variable by rounding //the value from 10.20 to 10.2. C EVAL Result = 50 //Result value will automatically change from 50 to zero because of Z-ADD C Z-ADD(H) b Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result DSPLY 102
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Z-add
Adds the numeric value in factor 2 with zero and store the result in result field.
D b s 4S 2 Inz(10.20) D Result s 4S 2 //it will add the value of b and Result (i.e., 10.20 and 0) //and assign a 10.20 value to the Result variable. C EVAL Result = 50 //Result value will automatically change from 50 to zero because of Z-ADD C Z-ADD b Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result DSPLY 1020
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Z-sub(H)
Half adjust (round) of the numeric value while subtracting factor-2 from 0.
D b s 4S 2 Inz(10.20) D Result s 5S 1 //it will subtract the value from Result to b (i.e., 0 and 10.20) // and assign -10.2 value to the Result variable by rounding off . //the value from 10.20 to 10.2. C EVAL Result = 50 //Result value will automatically change from 50 to zero because of Z-ADD C Z-SUB(H) b Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result DSPLY 102-
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch
Z-sub
It subtracts numeric value in factor 2 from 0.
D b s 4S 2 Inz(10.20) D Result s 4S 2 //it will subtract the value from Result to b (i.e., 0 and 10.20) // and assign -10.2 value to the Result variable. C EVAL Result = 50 //Result value will automatically change from 50 to zero because of Z-SUB C Z-SUB b Result C 'Result' DSPLY C Result DSPLY C SETON LR
Output
DSPLY Result DSPLY 1020-
For additional insights on this topic, check out our detailed YouTube video from Programmers.io. Click here to watch