Hello everyone!
This is a quick example of how to create a CRUD program using the “new” all free format which helps to have a neat and easy to understand code. I have been practicing this new sintax, basically transforming RPGIV or RPGLE programs with the traditional HFDC sheet so it has been really fun!
Most of the program is written in the very well known free format and the “all free” format is easy to understand. Maybe the challenge is to learn and get used to the new syntax.
Many of the developers I know don’t know how to code in all free mode so they stick even in the old RPGIV with the fixed format which sometimes is way too hard to read (loops and conditionals, everyone?).
Now, you can try this in the SEU but in order to avoid the error syntax messages, you need to disable this option when pressing Shift+F1 (or F13) and then turn off syntax validation. It is a shame that the SEU do not recognize this new way to code and if you have access to RDi it is a big advatange when coding in all free.
The original DDS for the physical and dspf file, and the original RPG code was taken from the great website of David Mount, which content has helped me to understand the basics and more when I was a rookie years ago so feel free to pay him a visit here.
From there I took the RPGLE program and transform it to free format.
Hope this helps you to start learning this new way to work in the iSeries plattform.
DDS for physical file:
A R CSREC
A CSNBR 6S 0 TEXT('CUSTOMER')
A CSNAME 30A TEXT('NAME')
A CSADR1 30A TEXT('ADDRESS 1')
A CSCITY 20A TEXT('CITY')
A CSSTAT 2A TEXT('STATE')
A CSZIP 10A TEXT('ZIP')
A CSPOINTS 6S 0 TEXT('POINTS')
A K CSNBR
DDS Specification for display file:
A*%%TS SD 20170316 162419 SGPLUIS REL-V7R2M0 5770-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A REF(*LIBL/CUST)
A CA03(03 'F3=EXIT')
A R SCR1
A*%%TS SD 20170221 094610 SGPLUIS REL-V7R2M0 5770-WDS
A 1 2USER
A COLOR(BLU)
A 1 28'ADD/UPDATE/DELETE/INQUIRE'
A DSPATR(HI)
A 1 72DATE
A EDTCDE(Y)
A COLOR(BLU)
A 2 2'CUSTR01'
A COLOR(BLU)
A 2 72TIME
A COLOR(BLU)
A 6 12'(A)dd,(U)pdate,(D)elete'
A COLOR(WHT)
A 6 36'(I)nquire, (N)ext'
A COLOR(WHT)
A ACTION 1A B 6 55DSPATR(HI)
A 8 28'Cust#'
A COLOR(YLW)
A CSNBR R B 8 35REFFLD(CSNBR)
A DSPATR(HI)
A EDTCDE(Z)
A CHECK(RZ)
A ERRLIN 78A O 22 2
A 90 DSPATR(RI)
A COLOR(RED)
A 23 14'F3 = Exit'
A COLOR(WHT)
A R SCR2
A*%%TS SD 20170316 162419 SGPLUIS REL-V7R2M0 5770-WDS
A CA09(09 'F9=Delete')
A 1 2USER
A COLOR(BLU)
A 1 28'Customer File Maintenance'
A COLOR(WHT)
A 1 72DATE
A EDTCDE(Y)
A COLOR(BLU)
A 2 2'CUSTR01'
A COLOR(BLU)
A MODE 7A O 2 37
A 2 72TIME
A COLOR(BLU)
A 3 28'Cust#'
A CSNBR R O 3 37EDTCDE(4)
A DSPATR(RI)
A 9 28'Name'
A COLOR(WHT)
A CSNAME R B 9 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 10 28'Address'
A COLOR(WHT)
A CSADR1 R B 10 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 11 28'City'
A COLOR(WHT)
A CSCITY R B 11 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 12 28'State'
A COLOR(WHT)
A CSSTAT R B 12 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A 13 28'Zip'
A COLOR(WHT)
A CSZIP R B 13 42
A N80 DSPATR(HI)
A 80 DSPATR(PR)
A ERRLIN 78A O 22 2
A 90 DSPATR(RI)
A COLOR(RED)
A 23 14'F3 = Exit'
A COLOR(WHT)
A 14 28'Points'
A COLOR(WHT)
A CSPOINTS R B 14 42REFFLD(CSREC/CSPOINTS *LIBL/CUST)
A COLOR(WHT)
RPG program in all free:
Ctl-Opt Option(*nodebugio) Dftactgrp(*No);
*----------------------------------------------------
*Archivos
*----------------------------------------------------
Dcl-F cust disk(*ext) usage(*update:*delete:*output) Keyed;
Dcl-F custd01 workstn;
*----------------------------------------------------------
*constants which stores output messages to users
*----------------------------------------------------------
dcl-c Err1 CONST('Record already on file');
dcl-c Err2 CONST('Record not on file');
dcl-c Err3 CONST('No more records');
dcl-c Err4 CONST('No more records');
dcl-c Err5 CONST('Zip cannot be blank');
dcl-c Err6 CONST('Name is mandatory');
dcl-c Err7 CONST('State is mandatory');
dcl-c Err8 CONST('Invalid action');
dcl-c Err10 CONST('Points are not valid');
dcl-c Msg1 CONST('Record Added');
dcl-c Msg2 CONST('Record Updated');
dcl-c Msg3 CONST('Record Deleted');
dcl-c Msg4 CONST('Hit F9 to delete');
dcl-c Msg9 CONST('No action taken');
*----------------------------------------------------
*variables
*----------------------------------------------------
dcl-s RecOk char(1);
dcl-s cust_ like(csnbr);
dcl-s points_ like(cspoints);
*Program start
*----------------------------------------------------------
exsr main;
*InLR = *On;
*----------------------------------------------------------
* main - Main subroutine
*----------------------------------------------------------
begsr main;
dow *in03 = *off;
exsr clearfld;
exfmt scr1;
ERRLIN = *blanks;
*in90 = *off;
if *in03 = *off;
select;
when Action = 'A';
exsr AddRecord;
when Action = 'D';
exsr DltRecord;
when Action = 'I';
exsr InqRecord;
when Action = 'N';
exsr NextRecord;
when Action = 'U';
exsr UpdRecord;
other;
ERRLIN = Err8;
*in90 = *On;
endsl;
endif;
enddo;
endsr;
//**********************************************
// Add Record Subroutine
// Indicator 80 is used by the display file to
// protect more fields since we are in ADD mode
// set the indicator off to allow field entry
//**********************************************
begSr AddRecord;
*in80 = *off;
MODE = 'ADD';
// See if customer is already on file. If so,
// display error
//chain KEYLST CUST;
chain csnbr CUST;
if %found(CUST);
errlin = err1;
// In90 draws attention to the error line with rev
// display
*in90 = *On;
else;
exSr AddScreen;
endif;
endSr;
// ***End of AddRecord**************************
//**********************************************
// AddScreen subroutine - New record
//**********************************************
begSr AddScreen;
//Clear all fields except the key field
RecOK = 'n';
//Stay on this screen until user gets it right or hits F3
dow RecOK = 'n' and *in03 = *off;
exfmt scr2;
if *in03 = *off;
ExSr EditRecord;
if recOK = 'y';
write CSREC;
*in90 = *On;
errlin = Msg1;
endif;
else;
*in90 = *On;
errlin = Msg9;
endif;
enddo;
*in03 = *off;
endsr;
//*****End of sr*****************
//*****************************************
// DltRecord - Delete a record from file
//*****************************************
begSr DltRecord;
//*in80 is used by the display file to protect
//most fields since we are in DLT mode, set the
//*in on for no field entry
*in80 = *On;
MODE = 'DELETE';
//Display "Hit F9 to delete" in ERRLIN
errlin = Msg4;
*in90 = *on;
//See if customer is in file. If not, show errMsg
// chain KEYLST CUST;
chain csnbr CUST;
if not %found(CUST);
errlin = Err2;
else;
//If customer is on file, show screen again and see
// if user hit F9 to confirm delete
exfmt scr2;
*in90 = *off;
if *in09 = *on;
delete CSREC;
errlin = msg3;
else;
errlin = msg9;
endif;
endif;
*in03 = *off;
endsr;
//*********************************************************
// InqRecord - Looks for one record
// Indicator 80 is used by the display file to protect
// most fields since we are in DLT mode, set the indicator
// on for no field entry
//*********************************************************
begSr InqRecord;
*in80 = *on;
mode = 'INQUIRY';
// chain KEYLST CUST;
chain csnbr CUST;
if not %found(CUST);
errlin = Err2;
*in90 = *On;
else;
exfmt scr2;
endif;
*in03 = *off;
endsr;
// *****end InqRecord *****************
//*************************************************
// NextRecord - See the next record from selected *
//*************************************************
begSr NextRecord;
*in80 = *On;
mode = 'INQUIRY';
errlin = *blanks;
//Set file cursor at cust from screen
// setll KEYLST CUST;
setll csnbr CUST;
if %equal(CUST);
errlin = err3;
*in90 = *On;
endif;
//Read file to get next customer
if errlin = *blanks;
read cust;
if not %equal;
errlin = err3;
*in90 = *On;
endif;
endif;
//If *in93 = *On, we are at an existing record
//and need to read pass it
if errlin = *blanks;
exfmt scr2;
endif;
*in03 = *off;
endsr;
//*******end-sr*****************
//*****************************************************
// updRecord - Updates existing record *
//*****************************************************
begsr updRecord;
*in80 = *off;
mode = 'UPDATE';
// chain KEYLST CUST;
chain csnbr CUST;
if not %found(CUST);
errlin = Err2;
*in90 = *On;
else;
exSr UpdScreen;
endif;
endsr;
//*******end-sr*****************
//******************************************************
// UpdScreen - update the screen during navigation *
//******************************************************
begSr UpdScreen;
RecOK = 'n';
DoW RecOk = 'n' and *in03 = *off;
exfmt scr2;
if *in03 = *off;
exSr EditRecord;
if RecOk = 'y';
update CSREC;
Errlin = Msg2;
endif;
else;
Errlin = Msg9;
endif;
enddo;
*in03 = *off;
endSr;
//******end-sr***************************
//**********************************************
// EditRecord - Updates selected record *
//**********************************************
begSr EditRecord;
RecOK = 'y';
if CSNAME = *blanks;
RecOK = 'n';
errlin = err5;
*in90 = *on;
endif;
if CSSTAT = 'y';
RecOK = 'n';
errlin = Err6;
*in90 = *On;
endif;
if CSZIP = *zero;
RecOK = 'n';
errlin = Err4;
*in90 = *On;
endif;
if CSPOINTS <= 0;
RecOK = 'n';
errlin = Err10;
*in90 = *On;
endSr;
//*****end-sr****************
//***********************************
// ClearFld - Clear all fields used
//***********************************
begSr ClearFld;
ACTION = *blanks;
CSNBR = *zeros;
endsr;
DEVMXV 