*-----------------------------------------------------
* Files
*-----------------------------------------------------
// added INDDS ... see (A) below
Fchevy372 CF E WORKSTN INDDS(inds)
F sfile(subfile:sflrrn)
// remove usropn ... see (B) below.
Fsfusers UF E DISK rename(sfusers:sfusersr)
*-----------------------------------------------------
* Data Structures
*-----------------------------------------------------
// changed below to use OVERLAY to eliminate
// ugly from/to syntax. added exit, cancel, sflclr indicators.
// see (A) below
Dinds ds
D exit N overlay(inds:03)
D cancel N overlay(inds:12)
D sflclr N overlay(inds:21)
D sfldsp N overlay(inds:22)
*-----------------------------------------------------
* Variables
*-----------------------------------------------------
Dsflrrn s 5 0
*-----------------------------------------------------
* Code
*-----------------------------------------------------
/free
//--------------------------------------------------
// Set commit option
//--------------------------------------------------
// exec sql
// set option commit=*none; <-- Pointless. Not using SQL (see (C) below)
//if not %open(sfusers); <-- Pointless. might as well
// open sfusers; let RPG open it for you (see (B) below)
//endif;
dou exit or cancel; // <-- Use names, not numbers. (see (A) below)
exsr clrsfl;
exsr loadsf;
exsr procsf;
enddo;
//if %open(sfusers); <-- Pointless. RPG automatically
// close sfusers; closes all open files
//endif; (whether USROPN or not) (see (B) below)
*inlr = *on;
//--------------------------------------------------
// loadsf - Load Subfile Subroutine
//--------------------------------------------------
begsr loadsf;
setll *start sfusers; // *start is nicer than 1
read sfusers;
dow not %eof;
$usr_name = user_name;
$lms = lms;
$sws = sws;
$cms = cms;
$infin = infinium;
$kronos = kronos;
sflrrn = sflrrn + 1; // move before the write. see (D) below
write subfile;
read sfusers;
enddo;
if sflrrn > 0; // see (E) below
sfldsp = *on;
endif;
endsr;
//--------------------------------------------------
// clrsfl - Clear Subfile Subroutine
//--------------------------------------------------
begsr clrsfl;
clear sflrrn;
sfldsp = *off; // using sflclr to clear
sflclr = *on; // and sfldsp to display. (E) below.
write subfilec;
sflclr = *off;
sflrrn = 0; // make sflrrn = num recs loaded see (D) below.
endsr;
//--------------------------------------------------
// procsf - Process Subfile Subroutine
//--------------------------------------------------
begsr procsf;
dsprecord = 1;
write top;
write bottom;
exfmt subfilec;
endsr;
/end-free
SQL ILE RPG Object for db2 in iSeries (AS400)
Be the first to comment
You can use [html][/html], [css][/css], [php][/php] and more to embed the code. Urls are automatically hyperlinked. Line breaks and paragraphs are automatically generated.