Saturday, March 24, 2012

RPGLE Free array and external data structure


My current task is to write an ETL program to extract on hand inventory from Island  Pacific DB2 table, transform data to XML, load MIDRetail API, process MID job on  MS Server to update MIDRetail tables, retrieve status of MID job to iSeries. Depending on status additional workflow jobs are initiated.

The first challenge is to extract inventory from Island Pacific. This is a little unique and I have not seen inventory stored like this before. Each record contains 100 fields (BSTK01 thru BSTK00) where each field represents a particular store on hand quantity. If there is more than 100 stores for an item the record identifier field(BRID) is incremented.

BRID = 0  BSTK01 thru BSTK00 = Store 001 thru 100
BRID = 1  BSTK01 thru BSTK00 = Store 101 thru 200 
BRID = 2  BSTK01 thru BSTK00 = Store 201 thru 300 

Island Pacific supports a maximum of 900 stores. So record ID only 0 thru 8 could be used. 

  
After a brief call to my buddy Rick I have an idea of how to pivot the data to the required format. I refreshed my knowledge with the FOR loop earlier in the week but unsure of how. A search of the net revealed a way to use an external data structure to load an array based on pointer. I caught a break in that the inventory fields are contiguous.

I have been working with full procedural files lately staying away from the RPG cycle. Ooops, no *LR = on, dummy! Sometimes the cycle comes in handy and I really never understood why most programmers have moved away from using it.     
         
     fipbsdtl   ip   e           k disk
     fmidinvpf  o  a e             disk

     d myFileRec     e ds                  extname(ipbsdtl)
     d myFilePtr       s               *   inz(%addr(bstk01))    Pointer start
     d MYFILEMap       ds                  based(MYFILEPtr)
     d storeAry                            like(bstk01) dim(100)
     d strIdx          s              3  0                       Store index

      ******************************************************************
      * Main Routine
      ******************************************************************
      /free

         for strIdx = 1 to 100 by 1;
           ivstr = strIdx + (brid * 100);
           ivqty = storeAry(strIdx);
           ivcls = %editc(bcls:'X');
           ivven = %editc(bven:'X');
           ivsty = %editc(bsty:'X');
           ivclr = %editc(bclr:'X');
           ivsiz = %editc(bsiz:'X');
           ivdiv = bdiv;
           ivdep = bdpt;
           write mdinvr;
         endfor;

      /end-free                                                


As you can see my output now has the Store(IVSTR) and On hand quanity(IVQTY) for each item. Item = IVCLS,IVEN,IVSTY, IVCLR,IVSIZ. 


When the record id and item changed(key), it starts all over again. I did notice the quantities looked like the are duplicating but a quick check and they are correct. 

I have to do some more data checking but I think I have the solution. If anyone spot an issue or has question or suggestion please comment.

So I accomplished reeducating myself this week with replacing DO loop from RPGIV to FOR loop in RPG Free, external data structures and array's.

Great fun and I finished of another week successfully advancing my skills and completing another interface program. 

~Richard

Beta.  Software undergoes beta testing shortly before it's released.  Beta is Latin for "still doesn't work."  ~Author Unknown 

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

Wednesday, March 21, 2012

Finish the day with a win.

I have my SQLRPGLE daily sales program to working and loaded sales into the MIDRetail application with a few errors to chase. Only 145 errors in over 45,000 records processed. I’ll be on the hunt in the morning. I also found out that my source data file is missing April thru July sales, don’t think I’ll get 52 weeks of sales from that file. Rut Ro!

I got another service call around 6:00PM, the user could not SNDST from the iSeries to a Domino server. The user is a Unix admin and knew a little about the iSeries. I walked him through checking the TCP setting and Directory entries. Found the problem in the SMTPA configuration, wrong mail router specified.

Always great to finish off the day with a win and a positive email.

Hi Xxx,

Our AS400 issue is solved quickly by Richard.
I really want to you know how happy I am about Richard's work.

He is very knowledgeable about AS400 system and can quickly pin point the
problem with no time.
I would like to say " Thank you very much for your help"

Best Regards,
xxxxxx xxxxxxxxxx
Senior UNIX System Administrator

I am not sure how this has happened, my day work of iSeries operations has become my night job and my night work of programming has become my day job.

~Richard

Patience is the companion of wisdom.  ~St. Augustine

RPGLE SQL Joy.....

I have found the enemy and it is me! In cutting up my program to accommodate the SQL host variable issue missed a few lines of code here and there.

I will post the code as soon as I can figure out how to get the code out of WDSC in readable format.

Have a great day!

~Richard


Embedded SQL SQLSTT 42703 and 42618 errors...

Great news, found out yesterday that my contract is extended to the end of May. The company has decided to keep me on to help with implementation of the MIDRetail.

I ran into a problem with my daily sales XML output. I added date selection as a host variable to the Where clause in my SQL Select statements. I ran the program and no output, WTF!

I ran the program in debug and found SQLSTT is throwing an error 42703. After browsing Google I determined that the host variable is the Where clause is suspect. I used sub-procedures to make the SQL as generic as possible. I have a couple of SQL statements in the code and am changing the statements by evaluating a temporary field SQLV as needed.

* Standalone Variables
    d sqlV            s          32000a   varying                              varying as needed
    d sql1            s          32000a   varying                              Store/style/color
    d sql2            s          32000a   varying                              Update sales type
    d sql3            s          32000a   varying                              Store/style/color/sz   


begsr CrtSQLSR;
        // Daily Sales summerized by store, style, color = MAINDS
        sql1 = ('Select stat, vstr, vdte, sum(vqty), vcls, vven, +
             vsty, vclr, vstp +
             from MidSalesPF +
             where vdte = :yesterday and 1 = 1 +
             group by stat, vstr, vdte, vstp, vcls, vven, vsty, vclr +
             order by vstr, vdte, vdte, vstp, vcls, vven, vsty, vclr' );

        // Daily Sales summerized by store, style, color, size = MAIN1DS
        sql3 = ('Select stat, vstr, vdte, sum(vqty), vcls, vven, +
             vsty, vclr, vsiz, vstp +
             from MidSalesPF +
             where vdte = :yesterday and 1 = 1 +
             group by stat, vstr, vdte, vstp, vcls, vven, vsty, vclr, +
             vsiz +
             order by vstr, vdte, vstp, vcls, vven, vsty, vclr, vsiz' );

       endsr;                                                      
-------------------------------------------------
begsr Day_SscsizSR;

      clear sqlV; // Clear temp field
      sqlV = sql3; // SQL statement to run
      first = 'Y';                              // First pass flag
      declare();                                // SQL declare
      openCursor();                             // SQL open cursor
      Exec SQL fetch next from mainCursor       //Load data Structure
            into :main1ds;                 
blah,blah,blah.......

------------------------------------------------

p declare         b
    d declare         pi

    c/exec sql
    c+ declare mainCursor cursor
    c+     for mainStatement
    c/end-exec
    c/exec sql
    c+ prepare mainStatement
    c+    from :sqlV My problem child
    c/end-exec

    p declare         e
     *-------------------------------------------------------------------
    p openCursor      b
    d openCursor      pi

    c/exec sql
    c+ open mainCursor
    c/end-exec

    p openCursor      e
     *-------------------------------------------------------------------
    p closeCursor     b
    d closeCursor     pi

    c/exec sql
    c+ close mainCursor
    c/end-exec

    p closeCursor     e             
------------------------------------------------------------------------------------------------------


From what I can tell SQL does not like a variable inside a variable. The Where clause :yesterday inside :SQLV.

So I took it all apart and got rid of the sub-procedures.

begsr Day_SscsizSR;

      Exec SQL declare mainCursor2 cursor
         for Select stat, vstr, vdte, sum(vqty), vcls, vven, +
             vsty, vclr, vsiz, vstp
             from MidSalesPF
             where vdte = :yesterday
             group by stat, vstr, vdte, vstp, vcls, vven, vsty, vclr, vsiz
             order by vstr, vdte, vdte, vstp, vcls, vven, vsty, vclr, vsiz;

      Exec SQL open mainCursor2;                             // SQL open cursor

      Exec SQL fetch next from mainCursor2       //Load data Structure
            into :main1ds;                        

blah,blah,blah........

So I am on the hunt for why my XML is no longer being written. I must have cut something out by mistake while getting rid of the sub-procedures.

~Richard