I discovered the DO operation code does not exist in RPGLE Free, it has been replaced with the FOR operation code. I have not had to code a DO loop in some time so this is a pleasant surprise.
Old way -
C 2 Do 20 Index
C Eval Array(Index) = Index;
C Index Chain SubfileRec
C If %found
C Eval SF_Field_1 = 44
C Endif
C Enddo 2
RPGLE Free -
/free
For Index = 2 to 20 by 2; // Set up a controlled loop
Array(Index) = Index; // Set Array element
Chain Index SubfileRec; // Get subfile record
If %found; // If found
SF_Field_1 = 44; // Set subfile field
Endif;
Endfor;
/End-free
For my purpose it is real easy to change the starting point for my sales history ETL process. This process is a onetime load so when we are ready to go live I can easily set the starting member name. Currently I am testing with sales from 04/2011 through today. Each member of the multi-member file represents a month of sales.
** MID112R: Extract sales from history and identify type of sales and **
** identify week ending date. Update VWEK and VSTP accordingly. **
** Output file midslyrspf is used in MID0113R to create XML **
** Document for MID plan/history load. **
** Intended to only run at initial load of MID. **
** **
** Richard Bryant - Tek Systems Mar. 15, 2012 **
********************** M O D I F I C A T I O N S *************************
** Date Programmer Description **
** ---------- ------------ -------------------------------------------- **
** **
**************************************************************************
fvog012d3 if e disk usropn extmbr(@mbr)
fmidslyrspfo a e disk
D @mbr s 5a Member name
D mbrCnt s 2s 0 Member number
D D_Date s d DATFMT(*ISO)
D DayofWeek s 1s 0
D WK_date s 8p 0 Week Ending date
D Cents S 2S 2 cents
D Centsa S 2S 2 cents absolute
************************************************************************
* Main Routine
************************************************************************
/free
for mbrCnt = 4 to 12 by 1; // Start at member 4 = sales month april 2011
@mbr = 'R0M' + %editc(mbrCnt:'X'); // Member name variable
if not %open(vog012d3);
open vog012d3; // Sales history open the file
endif;
read vog012d3; // Read all records
dow not %eof(vog012d3);
if dscde <> '3' or dscde <> '4'; // Exclude discount codes 3 and 4
exsr SetDate;
exsr SalesSR;
vstr = str; // Store
vdte = date; // Transaction date
vseq = seq; // transaction sequece
vcls = cls; // Class code
vtr# = tran; // Register ID
vqty = qty; // Quantity
vpri = price; // Price
vdsc = dscnt; // Discount
vven = vend; // Vendor
vsty = styl; // Style
vclr = color; // Color
vsiz = size; // Size
vwek = %int(WK_date);
write mdslsr;
endif;
read vog012d3;
enddo;
close vog012d3; // Close file
endfor;
*inlr = *on; // See ya!
//************************************************************************
// * Sub Routines
//************************************************************************
//************************************************************************
// SetDate - update date field VWEK with week end date. Saturday is the
// current sales cut-off.
//************************************************************************
begsr setDate;
D_Date = %date(%int(date):*YMD); // Convert sales date to real date
DayofWeek = %Rem(%Diff(d_date:d'2001-12-16':*days):7); // Get day of week
// 2001-12-16 = Sun
select;
when DayofWeek = 0; // Sunday
D_date = D_date + %days(6);
WK_date = %dec(d_date: *iso);
when DayofWeek = 1; // Monday
D_date = D_date + %days(5);
WK_date = %dec(d_date: *iso);
when DayofWeek = 2; // Tuesday
D_date = D_date + %days(4);
WK_date = %dec(d_date: *iso);
when DayofWeek = 3; // Wednesday
D_date = D_date + %days(3);
WK_date = %dec(d_date: *iso);
when DayofWeek = 4; // Thursday
D_date = D_date + %days(2);
WK_date = %dec(d_date: *iso);
when DayofWeek = 5; // Friday
D_date = D_date + %days(1);
WK_date = %dec(d_date: *iso);
when DayofWeek = 6; // Saturday
D_date = D_date + %days(0);
WK_date = %dec(d_date: *iso);
endsl;
endsr;
//************************************************************************
// SalesSR - Identify type of sales to update field VSTP
//************************************************************************
begsr SalesSR;
centsa = %int(price) - price; // Strip out cents
centsa = %abs(cents); // Remove negitive convert to absolute
select;
when centsa <> .99 and dscnt = 0; // Sales Regular
vstp = 'Sales Reg';
when centsa = .99 and dscnt = 0; // Sales Mkdn
vstp = 'Sales Mkdn';
when dscnt <> 0; // Sales Promo
vstp = 'Sales Promo';
endsl;
endsr;
/end-free
Have a great day!
~Richard
Common sense is instinct. Enough of it is genius. ~George Bernard Shaw
No comments:
Post a Comment