In February of 2010 I asked my friend Ken Killian to update the RPG program RPG-ILE subfile pgm (1) to FREE FORMAT. (the DSPF and etc. are at “RPG-ILE subfile pgm (1)”)
Now, things are even better. the EVAL opcode is no longer needed. MOVE is not needed. Z-ADD is not needed. You simply write statements, like
If *In26 = *Off;
Count +=1;
...
You can indent blocks of code to easily see the ranges of nested loops and ifs.
It is easy to look up and see where an ENDIF came from! Finally!
[ to see the display file and PF & LF definitions and some sample data you can use, see the previous ILE version ]
// =============================================================
// Program Name: CUSUPDR search and update via. subfile.
// ~~~~~~~
// Author (ID) : Greg Smith ( SPgks ) INIT. DATE: 10-27-91
// converted to RPG-ILE on 4-22-98
// Author (ID) Ken Killian (ILE RPG Developer) Date: 02/11/2010
// Convert to FREE-Format on 02-11-2010
// Notes: o Convert "Add 1" to " += 1;"
// o Convert OpCode "LOOKUP" to "%TLookup"
// o Convert OpCode "MOVE" to "=" statement
// =============================================================
// combined and enhanced example (compile in this order):
// 1 cufldref field definitions for all applications
// 2 cusmst0 customer master file (in # key order)
// 3 CUSMST2 logical view of 2. in name order
// 4 cusupdd display file (DSPF)
// 5 cusupdr (this) RPG program
// In addition to searching by name and by number,
// the prog. enables subfile viewing (2x2 views)
// by pageing up (as well as down) and selecting
// individual records for viewing and updating.
// expanded from RPG USERS GUIDE, book 26, Chap.8, pg.59 (V1R3)
// combining of Sample Programs, book 26 Chap.8, pgms. 3 & 5
// and adding to them.
// DSPF: CUSMLGD MLG265D on page 8-55, book 26
// PF: CUSMST0 CusMstP on page 8-54, book 26
// LF: CUSMST2 not from book: logical view by last name.
// ===============================================================
// If CUSMST0 and CUSMST2 have the same record names,
// at least one of them must be renamed.
// -----------------------------------------------------
// PF: CUSMST0 --- record name: CUSMSTR
// LF: CUSMST1 --- record name: CUSMSTR
// LF: CUSMST2 --- record name: CUSMSTR
// DSPF: CUSUPDD
// ----------------------------------------------------------------
// -------- := - - --- - ------- ------------------------------------
FCUSUPDD CF E WORKSTN SFILE(SUBCTRL:RREC#)
FCUSMST1 UF A E K DISK RENAME(CUSMSTR:RECNUMR)
FCUSMST2 IF E K DISK RENAME(CUSMSTR:RECNAME)
// -------- := - - --- - ------- ------------------------------------
// The Chain, SetLL, and Read operations are all done on the
// internally kRENAME'd record names (RECNUMR & RECNAME).
// ================================================================
// ----------------- 1 T A B L E -----------------------
// TAB# = the reference line message # (see bottom).
// TABMSG = the message
// 3 0 = 3 diget numeric with 0 decimals
// # of lines/Records/strings/messages = 11
// 72 character string
// -----------------------------------------------------------------------
D TAB# S 3 0 DIM(11) CTDATA PERRCD(1) table of msgs
D TABMSG S 72 DIM(11) ALT(TAB#)
D RREC# S 4 0
D Count S 3 0
// ----------------------------------------------------------------**
// C A L C U L A T I O N S **
// ----------------------------------------------------------------**
// I N I T I A L I Z A T I O N s
C NUMRKY KList
C KFLD CUST# only the 1st
C NAMEKY KList
C KFLD NAMEL field is used.
// set default order here (IN20 on or not)
// numeric order is *In20 *On (otherwise last name order)
// ** SETON 20
/FREE
If *In20 = *On; // logical views.
SetGT *LoVal RECNUMR; // #LF
Read RECNUMR; // = empty file.
*In99 = %EOF;
Else;
SetGT *LoVal RECNAME; // NLF
Read RECNAME; // = empty file.
*In99 = %EOF;
EndIf;
If *In99 = *On; // If empty
*In26 = *On;
Exsr ADDSUB; // create 1st record
EndIf;
If *In26 = *Off;
Count +=1 ; // Z-ADD 01 COUNT
Exsr RESET;
Write BOTTOM; // main screen
EXFMT SUBSCRN;
// note: endIf and EndDo; rather than end; are for clarity, not for
// control, and are not necessary. EndSr is necessary.
// ############## M A I N L I N E ################** C A S E :
Dow *In03 = *Off and // while not F3
*In12 = *Off; // & not F12
Count += 1; // ADD 1 COUNT
If *In94 = *On and // 94 = PAGE UP key
*In91 = *Off; // ifnot t.o.f.
*In77 = *Off;
*In99 = *Off;
Exsr PAGEUP;
EndIf;
If *In95 = *On and // 95 = PG.DN.key
*In99 = *Off; // If not e.o.f.
*In77 = *Off;
*In91 = *Off;
Exsr PGDOWN;
EndIf;
If *In06 = *On; // = add a rec.
Exsr ADDSUB;
EndIf;
If *In11 = *On; // : switch
If *In21 = *Off; // half of record
*In21 = *On;
Else; // fields viewed)
*In21 = *Off;
EndIf;
EndIf;
If *In10 = *On; // : switch
If *In20 = *Off; // logical views.
*In20 = *On;
Else;
*In20 = *Off;
EndIf;
*In77 = *Off;
*In99 = *Off;
EndIf;
If SFNAME <> *Blanks; // If there
NAMEL = SFNAME; // MOVEL SFNAME NAMEL // is a
SetLL NAMEKY RECNAME; // NEW NAME
ReadP RECNAME; // to find.
*In91 = %EOF;
ReadP RECNAME;
*In91 = %EOF;
If *In91 = *On;
NAMEL = *Blanks; // MOVE *Blanks NAMEL - tof
SetLL NAMEKY RECNAME; // tof
EndIf;
*In77 = *Off;
Exsr PGDOWN;
SFName = *Blanks; // MOVE *Blanks SFNAME
EndIf;
If SFNUMR <> 0; // If there is a
CUST# = SFNUMR; // Z-ADD SFNUMR CUST# // NEW NUMBER
SetLL NUMRKY RECNUMR; // to find.
ReadP RECNUMR;
*In91 = %EOF;
ReadP RECNUMR;
*In91 = %EOF;
If *In91 = *On;
CUST# = *Zeros;
SetLL NUMRKY RECNUMR; // tof
EndIf;
*In77 = *Off;
Exsr PGDOWN;
SFNUMR = *Zeros; // Z-ADD 0 SFNUMR
EndIf;
ReadC SUBCTRL; // process
*In31 = %EOF;
// O P T I O N S :
If *In31 = *Off;
Dow *In31 = *Off;
// turn off error indicators
*In35 = *Off; // MOVE *Off *In35 // SFLNXTCHG
*In51 = *Off; // MOVE *Off *In51 // DSPATR(RI PC)
SELECT;
WHEN OPTN = '2';
Exsr UPDATE;
WHEN OPTN = '4';
Exsr DELETE;
WHEN OPTN = '5';
Exsr DSPLAY;
OTHER;
*In35 = *On; // MOVE *On *In35 // SFLNXTCHG
*In51 = *On; // MOVE *On *In51 // DSPATR(RI PC)
*In77 = %TLookup(010:Tab#:TabMsg);
// 010 LOOKUP TAB# TABMSG 77 <-- the old code
EndSl;
Update SUBCTRL;
ReadC SUBCTRL;
*In31 = %EOF;
EndDo;
Chain 1 SUBCTRL;
*In52 = NOT %Found;
//
If *In20 = *On;
SetLL NUMRKY RECNUMR;
Exsr PGDOWN;
EndIf;
EndIf;
Exsr RESET; // re-display
Write BOTTOM; // main screen
EXFMT SUBSCRN;
EndDo; // while not F3/F12
EndIf;
*InLR = *On;
// ## E N D O F ##
// ############## M A I N L I N E ################**
// ==============================================================
// S U B R O U T I N E S
// re-display the MAIN SCREEN
BegSr RESET;
*In71 = *Off; // top-of-file msg.
Exsr PAGEUP;
If *In91 = *On; // TOF
*In71 = *On; // top-of-file msg.
EndIf;
If *In99 = *On; // EOF
*In77 = %TLookup(009:Tab#:TabMsg); // 009 LOOKUP TAB# TABMSG 77
EndIf;
Exsr PGDOWN;
EndSr;
// ==============================================================
// Read previous records PAGE UP
// ==============================================================
BegSr PAGEUP;
Exsr CLRSUB; // clear subfile
Dow *In89 = *Off; // while subf notFull
If *In20 = *On; // #LF
ReadP RECNUMR; // = top-of-#file.
*In91 = %EOF;
Else; // NLF
ReadP RECNAME; // = top-of-Nfile.
*In91 = %EOF;
EndIf;
If *In91 = *On; // TOF
*In89 = *On;
If *In20 = *On; // #LF
Chain NUMRKY RECNUMR;
*In52 = NOT %Found;
SetLL NUMRKY RECNUMR;
Else; // NLF
Chain NAMEKY RECNAME;
*In52 = NOT %Found;
SetLL NAMEKY RECNAME;
EndIf;
Else;
RREC# += 1; // ADD 1 RREC#
OPTN = *Blanks; // MOVE *BLANK OPTN
Write SUBCTRL; // = subfile filled.
*In89 = %EOF;
EndIf;
EndDo;
*In89 = *Off;
EndSr;
// =============================================================
// clear subfile records
// =============================================================
BegSr CLRSUB;
*In55 = *On;
Write SUBSCRN; // subfile clear
*In55 = *Off;
RREC# = *Zeros; // Z-ADD 0 RREC#
EndSr;
// =============================================================
// Fill the Subfile (screen/page) PAGE DOWN
// =============================================================
BegSr PGDOWN;
Exsr CLRSUB; // clear subfile
Dow *In89 = *Off; // while subf notFull
If *In20 = *On; // #LF
Read RECNUMR; // = end-of-#file.
*In99 = %EOF;
Else;
Read RECNAME; // = end-of-Nfile.
*In99 = %EOF;
EndIf;
If *In99 = *On; // end-of-file.
If *In20 = *On; // #LF
SetLL NUMRKY RECNUMR;
Else; // NLF
SetLL NAMEKY RECNAME;
EndIf;
*In89 = *On;
Else;
RREC# += 1; // ADD 1 RREC#
OPTN = *Blanks; // MOVE *BLANK OPTN
Write SUBCTRL; // = subfile filled.
*In89 = %EOF;
EndIf;
EndDo;
*In89 = *Off;
EndSr;
// ============================================================
// 4. subroutine D E L E T E 4 = delete option
// ============================================================
BegSr DELETE;
Chain NUMRKY RECNUMR;
*In52 = NOT %Found;
If *In52 = *Off; // If found
*In07 = *On;
*In72 = %TLookup(004:Tab#:TabMsg) ; // 004 LOOKUP TAB# TABMSG 72
EXFMT RECDSP;
If *In03 = *Off; // If not F3
Delete RECNUMR; // delete If not F3
Else;
Except RLS; // or release it.
EndIf;
Else;
*In77 = %TLookup(003:Tab#:TabMsg); // 003 LOOKUP TAB# TABMSG 77
EndIf; // end If found
*In52 = *Off;
*In07 = *Off;
OPTN = *Blanks; // MOVE *BLANK OPTN
EndSr;
// ===========================================================
// 5. subroutine DISPLAY-INQUIRY 5 = display option
// ===========================================================
BegSr DSPLAY;
*In77 = *Off;
Chain NUMRKY RECNUMR; // = rec. NOT found
*In52 = NOT %Found;
If *In52 = *Off; // If found
*In07 = *On;
*In72 = %TLookup(005:Tab#:TabMsg); // 005 LOOKUP TAB# TABMSG 72
EXFMT RECDSP;
EXCEPT RLS;
Else;
*In77 = %TLookup(003:Tab#:TabMsg); // 003 LOOKUP TAB# TABMSG 77
EndIf;
*In52 = *Off;
*In07 = *Off;
OPTN = *Blanks; // MOVE *BLANK OPTN
EndSr;
// ===========================================================
// 6. subroutine C R E A T E a new rec. /ADD
// ===========================================================
BegSr ADDSUB;
*In77 = *Off;
EXFMT GETKEY; // get a rec.key.#
Dow *In03 = *Off and // If not F3 &
CUST# <> 0; // key# /= 0
Chain(E) NUMRKY RECNUMR; // 51=not yet
*In51 = %ERROR;
*In51 = NOT %Found;
If *In51 = *On; // on file.
NAMEF = *Blanks; // MOVE *BLANK NAMEF
NAMEL = *Blanks; // MOVE *BLANK NAMEL clear all
ADDR = *Blanks; // MOVE *BLANK ADDR fields:
CITY = *Blanks; // MOVE *BLANK CITY
STATE = *Blanks; // MOVE *BLANK STATE Fields not
// * MOVE *BLANK SRCHC
// * MOVE *BLANK CUSTY
// * Z-ADD *ZERO ZIP
ARBAL = *Zeros; // Z-ADD *ZERO ARBAL
// function keys could be used to toggle "dup." on and off (41
*In72 = %TLookup(006:Tab#:TabMsg); // 006 LOOKUP TAB# TABMSG
EXFMT RECDSP; // add a record
If *In03 = *Off; // If not F3
Write RECNUMR; // Write the rec.
*In26 = *Off;
EndIf;
*In51 = *Off;
*In77 = *Off;
Else;
*In77 = %TLookup(007:Tab#:TabMsg); // 007 LOOKUP TAB# TABMSG
EndIf; // in51=1
EXFMT GETKEY; // get a rec.key.#
EndDo; // while Not03 & #Not0
OPTN = *Blanks; // MOVE *BLANK OPTN
EndSr; // ADDSR EndSr ADDSub
// ===========================================================
// 2. subroutine UPDATE-CHANGE
// ===========================================================
BegSr UPDATE;
EndSr;
*In77 = *Off;
Chain NUMRKY RECNUMR; // 52=rec.not found
*In52 = NOT %Found;
If *In52 = *Off; // rec.found
*In72 = %TLookup(002:Tab#:TabMsg); // 002 LOOKUP TAB# TABMSG 72
EXFMT RECDSP;
If *In03 = *Off; // If not F3
Update RECNUMR; // update the rec.
Else;
EXCEPT RLS; // or release it.
EndIf;
Else;
*In77 = %TLookup(003:Tab#:TabMsg); // 003 LOOKUP TAB# TABMSG 77
*In52 = *Off;
EndIf; // rec.found
OPTN = *Blanks; // MOVE *BLANK OPTN
EndSr;
/END-FREE
// =============================================================
ORECNUMR E RLS
// =============================================================
** .------.-------.----.---- M E S S A G E S ----.----.-------.-------.
001.------.-------.----.------=-------|-------=------.----.-------.-------.
002 <<<<<< U P D A T E >>>>>>
003 -------------------- The record was not found. ---------------------
004 <<<<<< D E L E T E >>>>>>
005 <<<<<< D I S P L A Y >>>>>>
006 <<<<<< C R E A T E >>>>>>
007 ------------------ The record is already on file. ------------------
008 ----------------------<< THE FILE IS EMPTY >>-----------------------
009 ------------------------- Bottom of file. --------------------------
010 the options are 2, 4, or 5
You could make a couple enhancements:
- get rid of the KLISTS
SetLL NUMRKY RECNUMR becomes
SetLL cust# CUSMST1
- replace all indicators with named indicators
Dow *In03 = *Off and *In12 = *Off becomes
dow not (exit or cancel)
If *In94 = *On becomes
If PageUp
- use named constants
’2′ becomes Edit
’4′ becomes Delete
etc.
these are all good suggestions.
-ed
hiii
I am new to Subfile Programming. I want to add data in physical file using the subfile.
How can I achieve this.
plz tell me at vickyaggarwal20@gmail.com
or update here.
Thanks
Hi,
Could somebody please tell me where can I find
RPG USERS GUIDE, book 26, Chap.8, pg.59 (V1R3)
combining of Sample Programs, book 26 Chap.8, pgms. 3 & 5?
Thanks.