SQLRPGLE Access Control to Custom Apps Bootstrap Loader

*----------------------------------------------------- * 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.