Thursday, March 22, 2012

RPGLE Free FOR op code replaced DO....

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