Learn RPG-IV-AS400 with Real Code Examples

FQPRINT   O    F  132        PRINTER
DCL-S Msg CHAR(50);
Msg = 'Hello, AS400 World!';
DSPLY Msg;
*INLR = *ON;

Display a simple greeting message on the screen.

DCL-S Price PACKED(7:2) INZ(100);
DCL-S TaxRate PACKED(5:2) INZ(0.13);
DCL-S TaxAmount PACKED(7:2);
DCL-S Total PACKED(7:2);
TaxAmount = Price * TaxRate;
Total = Price + TaxAmount;
DSPLY ('Total Price: ' + %CHAR(Total));
*INLR = *ON;

Compute total price including tax.

FEMPFILE  IF   A E           K DISK
DCL-S EmpName CHAR(30);
READ EMPFILE;
DOW NOT %EOF(EMPFILE);
    EmpName = EMPNAME;
    DSPLY EmpName;
    READ EMPFILE;
ENDDO;
*INLR = *ON;

Read records from a physical file and display them.

FEMPFILE  UF   E           K DISK
DCL-S NewSalary PACKED(7:2) INZ(5000);
CHAIN '1001' EMPFILE;
IF %FOUND(EMPFILE);
    SALARY = NewSalary;
    UPDATE EMPFILE;
ENDIF;
*INLR = *ON;

Change the salary of an employee in the file.

DCL-S Status CHAR(1);
Status = 'A';
IF Status = 'A';
    DSPLY 'Employee is Active';
ELSE;
    DSPLY 'Employee is Inactive';
ENDIF;
*INLR = *ON;

Check employee status and display a message.

FEMPFILE  IF   A E           K DISK
DOW '1';
    READ EMPFILE;
    IF %EOF(EMPFILE); LEAVE; ENDIF;
    DSPLY EMPNAME;
ENDDO;
*INLR = *ON;

Process all employees in a file using a loop.

DCL-PROC CalcBonus;
DCL-PI CalcBonus PACKED(7:2) END-PI;
DCL-PI Amount PACKED(7:2) END-PI;
RETURN Amount * 0.10;
END-PROC;
DCL-S Bonus PACKED(7:2);
Bonus = CalcBonus(5000);
DSPLY ('Bonus: ' + %CHAR(Bonus));
*INLR = *ON;

Call a subprocedure to calculate bonus.

DCL-S DeptCodes CHAR(5) DIM(5) INZ;
DeptCodes(1) = 'HR';
DeptCodes(2) = 'IT';
DeptCodes(3) = 'FIN';
FOR i = 1 TO 3;
    DSPLY DeptCodes(i);
ENDFOR;
*INLR = *ON;

Store and display multiple department codes using an array.

FEMPFILE  IF   A E           K DISK
DOW '1';
    READ EMPFILE;
    IF %EOF(EMPFILE); LEAVE; ENDIF;
    IF SALARY > 10000; LEAVE; ENDIF;
    DSPLY EMPNAME;
ENDDO;
*INLR = *ON;

Process records until a condition is met, then exit the loop.

FEMPFILE  IF   A E           K DISK
DCL-S TotalSalary PACKED(9:2) INZ(0);
READ EMPFILE;
DOW NOT %EOF(EMPFILE);
    TotalSalary += SALARY;
    READ EMPFILE;
ENDDO;
DSPLY ('Total Salary: ' + %CHAR(TotalSalary));
*INLR = *ON;

Sum salaries of all employees and display the total.