Wednesday, November 30, 2016

Extract emailed attachment and upload to IBMi


New challenge – Extract Excel spreadsheet of yesterday’s bank settled credit card transactions from an E-mailed zip file attachment, send spreadsheet to the IBMi, appending data to SQL table and launch balancing program to match the transactions with the backend ERP deposits table.

Background information -

Our previous credit card software, Payware Transact was discontinued and no longer supported. We decided to stay with Payware and upgrade to Payware Connect. Several years ago, I created an automated process that matched ERP deposits with Transact Request file and send me an Email with totals for each store and subject line telling me if in balance or not. Nothing worse than accountant coming to me two months later with a failed transaction and wanting to know why and to fix it.

The process has one flaw, it does not capture the Internet transactions processed through Authorize.net. At the time, I was working on store close out balancing and I was able to complete project since Internet was not the focus. Internet has their own outsourced IT resources not managed by me.

The process of upgrading the ERP software was brutal. I was at mercy of ERP vendor and not able to figure out what the resulting process is going to be. During the 18-month sales cycle, I was told we would have same capability as we currently have. So, I held my breath and took my lumps as they occurred.

As it turned out we did not get what we had and I had to change processes to fit what the ERP vendor wanted to code for. Settlement was by push and now set as a timer on Payware portal. I also discovered that the new programming marks the deposits records settled just because the transactions were sent. The transactions are not actually settled until PNC accepts and processes the transactions from Payware starting at 11:40pm. I brought this to the ERP vendor's attention and was told that "we have not seen any failure with this so we are not going to enhance programming".  The API's exist to do this correctly but unfortunately I have limited Java experience and smart enough to know I do not want my fingerprints on Credit Card transaction processing code. There is more to the nightmare but of no value to mention here.  Bottom line is new software is running and processing credit card transactions.

Since Payware Connect does not have a Request file holding status of processed credit card transactions I must change the process I created to balance with the ERP deposits table. 

*Note - To complete the following process, I had to first set up Client Solutions to run from the IFS. See instructions later in this document.  

New process outline –

1) When email is received, automatically extract attachment to folder on my desktop.

2) Unzip .XLSX from extracted attachment to IBMi IFS shared folder IACOUT. 

3) Delete PNC upload.xlsx from IFS shared folder IACOUT.

4) Rename *.xlsx file in IFS shared folder IACOUT to PNC upload.xlsx.  

5) Run Client Solutions extract to append PNC upload.xlsx to PNCTRAN table on IBMi.

6) Run program to generate spreadsheet and email.

New process details –

When email is received automatically, extract attachment to folder on my desktop:

I searched Google looking for email extractor programs. If I was handy with VB there are examples that I could have worked with. 

After looking over a few programs available I settled on Outlook Email Extractor. It will work with Exchange Server, enables extraction to any folder, has subsequent processing option and non-recurring low price.

The software was easy to install and setup. I have been running trial version for a couple of weeks and works flawlessly.

Outlook Email Extractor –

Selecting existing profile and Edit displays profile setting dialog. Obviously if one does not exist you would select New.


General tab you give the Profile a name. E-mail Folder is where you specify what folder you want to watch.



Lots of filters to choose from, I am monitoring for sender name and subject.


Storage location, this is where it starts to get a little tricky. I am directing the output to a folder on my desktop and renaming to a generic name to so I can hardcode the batch with name of .zip to extract from. Files is received as Transaction Listing (9999999999).zip and I output as PNC daily upload.zip.

Example of email received –
  

Subsequent – this is where I tell the extractor to run batch file PNC IBMi upload.bat located in my Google Drive folder.

  

The last tab, Catch Up, is awesome. Allows me to run as many times as I need to test the process.

Batch file – PNC IBMi upload.bat

This batch program unzips the emailed zip file and launches IBMi Client Solutions command line processing to call a CLLE program on the IBMi. The CLLE program called is a wrapper that submits the actual program that transfers file from IFS and appends to SQL table on IBMi.
I attempted to adjust my PC path environment variable but was unsuccessful and decided to not get bogged down figuring out why and hard coded the path to executables as needed.

1) Change directory to 7-Zip.Extract PNC daily upload.zip (renamed from email earlier in the process)

2) Change directory to Client Solutions.To get around the password requirement you use PLUGIN=cfg 

3) PLUGIN=logon, to logon with my credentials. 

4) PLUGIN=rmtcmd, calls my submit program on IBMi. 

5) PLUGIN=cfg /del, this will remove the configuration set in step four. This is for security purposes. 

6)Pause, I put a pause in so the command window will hang telling me all has completed. I will remove this after a few weeks and when I am satisfied with the process.



PNC Transfer and Call Balancing program – 

Submit program call by PLUGIN=rmtcmd.


Why JOBQ QS36EVOKE? The queue is multithreaded and not a production job queue. If something gets stuck I am notified and I can address. MSGW will not hold up production jobs if failure occurs. This type of job is ok to leave here for now.

Submit Client Solutions transfer and balancing program –

1) Delete existing object PNC upload.xlsx

2) Rename transferred spreadsheet to PNC upload.xlsx

3) Qshell java command to run command line transfer. (See set up Client Solutions in IFS later in this document.)

4)Run program to balance data to deposits and generate E-mail.


Balancing and email program –

This is a jewel and unfortunately, I do not have the time to go through it step by step. If you have any questions about any to the SQL code let me know.

I have since replaced CEELOCT with my own date service program. I am not converting this program to use the service program as it is a good example of CEELOCT API.

I do push the limits of CLLE. New RUNSQL command is awesome.

/*-------------------------------------------------------------------*/
/* Create and send via Email yesterday First Data Settlements        */
/*-------------------------------------------------------------------*/
             PGM

             DCL        VAR(&QTIME) TYPE(*CHAR) LEN(6)


             DCL        VAR(&RPTDT)  TYPE(*CHAR) LEN(6)
             DCL        VAR(&SQL)  TYPE(*CHAR) LEN(500)
             DCL        VAR(&IFS) TYPE(*CHAR) LEN(100) +
                          VALUE('\\qcapibmi\excel\')
             DCL        VAR(&USER) TYPE(*CHAR) LEN(10)

             DCL        VAR(&VIEWAS) TYPE(*CHAR) LEN(02) VALUE('01') /* +
                          Excel */
             DCL        VAR(&SPLF) TYPE(*CHAR) LEN(10) VALUE(SETTLED) /* +
                          Program name */
             DCL        VAR(&FILE) TYPE(*CHAR) LEN(60) VALUE('Yesterday +
                          settled amounts')
             DCL        VAR(&FILEF) TYPE(*CHAR) LEN(60) VALUE('Yesterday +
                          settled amounts')
             DCL        VAR(&FILENAME) TYPE(*CHAR) LEN(100)
             DCL        VAR(&PATHEXL) TYPE(*CHAR) LEN(100) VALUE('/excel/')

             DCL        VAR(&EXLMSG) TYPE(*CHAR) LEN(100)

             DCL        VAR(&EXLH_DT) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SETL_DT) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SETL) TYPE(*CHAR) LEN(9) VALUE('SETTLED:%')

             DCL        VAR(&MSG_STAT) TYPE(*CHAR) LEN(100)


/* Date routine variables ----------------------------------------------*/

             DCL        VAR(&YESTERDAY) TYPE(*DEC) LEN(8 0)
             DCL        VAR(&LILIAN) TYPE(*CHAR) LEN(4)
             DCL        VAR(&JUNK1) TYPE(*CHAR) LEN(8)
             DCL        VAR(&JUNK2) TYPE(*CHAR) LEN(23)
             DCL        VAR(&WDATE) TYPE(*CHAR) LEN(8)

             DCLF       FILE(SETTBALA) OPNID(SETTBAL)


/* Get local time from system: When this call is      */
/* complete,  &LILIAN will contain the number of      */
/* days between today and Oct 14, 1582.               */

             CALLPRC    PRC(CEELOCT) PARM(&LILIAN &JUNK1 &JUNK2 *OMIT)

/* Subtracting 1 from &LILIAN will produce yesterday's date */

             CHGVAR     VAR(%BIN(&LILIAN)) VALUE(%BIN(&LILIAN) - 1)

/* Convert Lillian to yyymmdd date */

             CALLPRC    PRC(CEEDATE) PARM(&LILIAN 'YYYYMMDD' &WDATE *OMIT)

             CHGVAR     VAR(&YESTERDAY) VALUE(&WDATE)

 /* End date routine --------------------------------------------------*/


             CHGVAR     VAR(&SETL_DT) VALUE(%SST(&WDATE 1 4) *CAT '-' *CAT +
                          %SST(&WDATE 5 2) *CAT '-' *CAT %SST(&WDATE 7 2))

             CHGVAR     VAR(&EXLH_DT) VALUE(%SST(&WDATE 5 2) *CAT '/' *CAT +
                          %SST(&WDATE 7 2) *CAT '/' *CAT %SST(&WDATE 1 4))

             CHGVAR     VAR(&EXLMSG) VALUE(&EXLH_DT *BCAT 'First Data +
                          Settlements')

             RTVJOBA    USER(&USER) DATE(&RPTDT)

/* ERP program to retrieve file name for this run */
             CALL       PGM(XAFILENAME) PARM(&VIEWAS &SPLF &FILE &FILEF)

             CHGVAR     VAR(&FILENAME) VALUE(&PATHEXL *TCAT &USER *TCAT +
                          '/' *TCAT %SST(&FILE 1 29))
            
/* Create table to hold summarized transaction dollars from uploaded data */
             RUNSQL     SQL('create table r50modsdta.pncssum as (select f2 +
                          as rzclid, f5 as settle_date, +
                          cast(ifnull(sum(case when f1 = ''Refund'' then +
                          f12 end),0) as decimal(11,2)) as crdt_crdt_amt, +
                          cast(ifnull(sum(case when f1 = ''Sale'' then f12 +
                          end),0) as decimal(11,2)) as crdt_sale_amt from +
                          r50modsdta.pnctrans where f5 = ''' *CAT &SETL_DT +
                          *CAT ''' group by f2,f5 order by f2) with DATA') +
                          COMMIT(*NONE) NAMING(*SQL)
            
/* Create table to output in email based on summarized transaction dollars */
             RUNSQL     SQL('create table r50modsdta.sett_ord as (select +
                          owstr, owname, rzclid, settle_date, +
                          ifnull(dec(crdt_sale_amt,11,2),0) as +
                          debit_sale,ifnull(dec(crdt_crdt_amt,11,2),0) as +
                          credit_sale, ifnull(dec(crdt_sale_amt,11,2),0) - +
                          ifnull(abs(dec(crdt_crdt_amt,11,2)),0) as +
                          settle_net from r50files.vcostore inner join +
                          r50modsdta.rtccxref on cxvaiid = owmrch left +
                          outer join r50modsdta.pncssum on rzclid = +
                          cxpncid and settle_date = ''' *CAT &SETL_DT *CAT +
                          '''  where owdel = ''A'') WITH DATA') +
                          COMMIT(*NONE) NAMING(*SQL)
            
/* Add ERP deposits net column to output table */
             RUNSQL     SQL('alter table r50modsdta.sett_ord add column +
                          deposit_net dec(11,2) default 0 not null') +
                          COMMIT(*NONE) NAMING(*SQL)
            
/* Add ERP deposits debit column to output table */
             RUNSQL     SQL('alter table r50modsdta.sett_ord add column +
                          deposit_debit dec(11,2) default 0 not null') +
                          COMMIT(*NONE) NAMING(*SQL)
            
/* Add ERP deposits credit column to output table */
             RUNSQL     SQL('alter table r50modsdta.sett_ord add column +
                          deposit_credit dec(11,2) default 0 not null') +
                          COMMIT(*NONE) NAMING(*SQL)
            
/* Update output table with ERP summarized debits */
             RUNSQL     SQL('update r50modsdta.sett_ord a set +
                          a.deposit_debit = ifnull((select cast(sum(tdamt) +
                          as dec(11,2)) as debit from r50files.vardeps b +
                          inner join r50files.vcohead on oaord = b.tdord +
                          and oabocd = b.tdbocd where a.owstr = oastr and +
                          b.tddate = ''' *CAT &WDATE *CAT ''' and +
                          (b.tdpdby = ''A'' or b.tdpdby = ''D'' or +
                          b.tdpdby = ''M'' or b.tdpdby = ''V'' or tdpdby = +
                          ''WA'' or tdpdby = ''WD'' or tdpdby = ''WM'' or +
                          tdpdby = ''WV'') and b.tdaut# <> ''B/O***'' and +
                          b.tddc = ''D'' group by oastr),0)') +
                          COMMIT(*NONE) NAMING(*SQL)

/* Update output table with ERP summarized credits */
             RUNSQL     SQL('update r50modsdta.sett_ord a set +
                          a.deposit_credit = ifnull((select +
                          cast(sum(tdamt) as dec(11,2)) as debit from +
                          r50files.vardeps b inner join r50files.vcohead +
                          on oaord = b.tdord and oabocd = b.tdbocd where +
                          a.owstr = oastr and b.tddate = ''' *CAT &WDATE +
                          *CAT ''' and (b.tdpdby = ''A'' or b.tdpdby = +
                          ''D'' or b.tdpdby = ''M'' or b.tdpdby = ''V'' or +
                          tdpdby = ''WA'' or tdpdby = ''WD'' or tdpdby = +
                          ''WM'' or tdpdby = ''WV'') and b.tdaut# <> +
                          ''B/O***'' and b.tddc = ''C'' group by +
                          oastr),0)') COMMIT(*NONE) NAMING(*SQL)

/* Update output table with ERP summarized net of credits and debits */
             RUNSQL     SQL('update r50modsdta.sett_ord a set +
                          a.deposit_net = ifnull((select cast(sum(tdamt) +
                          as dec(11,2)) as debit from r50files.vardeps b +
                          inner join r50files.vcohead on oaord = b.tdord +
                          and oabocd = b.tdbocd where a.owstr = oastr and +
                          b.tddate = ''' *CAT &WDATE *CAT ''' and +
                          (b.tdpdby = ''A'' or b.tdpdby = ''D'' or +
                          b.tdpdby = ''M'' or b.tdpdby = ''V'' or tdpdby = +
                          ''WA'' or tdpdby = ''WD'' or tdpdby = ''WM'' or +
                          tdpdby = ''WV'') and b.tdaut# <> ''B/O***'' and +
                          b.tddc = ''D'' group by oastr),0) - +
                          ifnull((select cast(sum(tdamt) as dec(11,2)) as +
                          debit from r50files.vardeps c inner join +
                          r50files.vcohead on oaord = c.tdord and oabocd = +
                          c.tdbocd where a.owstr = oastr and c.tddate = +
                          ''' *CAT &WDATE *CAT ''' and (c.tdpdby = ''A'' +
                          or c.tdpdby = ''D'' or c.tdpdby = ''M'' or +
                          c.tdpdby = ''V'' or tdpdby = ''WA'' or tdpdby = +
                          ''WD'' or tdpdby = ''WM'' or tdpdby = ''WV'') +
                          and c.tdaut# <> ''B/O***'' and c.tddc = ''C'' +
                          group by oastr),0)') COMMIT(*NONE) NAMING(*SQL)

/* Create temp table used to check if in balance */
             RUNSQL     SQL('Drop Table qtemp.settbala') COMMIT(*NONE)
             MONMSG     MSGID(SQL9010)
             RUNSQL     SQL('create table qtemp.settbala as (select +
                          dec(sum(settle_net),11,2) - +
                          dec(sum(deposit_net),11,2) as balance from +
                          r50modsdta.sett_ord) with data') COMMIT(*NONE) +
                          NAMING(*SQL)
            
/* Linoma Suveyor export table to IFS as Excel workbook */
             SURVEYOR/EXPDTA USEQRY(*NO) INFILE(R50MODSDTA/SETT_ORD) +
                          TYPEOFEXP(*EXCEL) XLSTITLEYN(*YES) +
                          XLSTITLE(&EXLMSG) XLSTBOLD(*YES) +
                          HEADTYPE(*HEADINGS) XLSHSTROW(4) XLSBOLD(*NO) +
                          XLSHUNDERL(*YES) XLSHBCOLOR('*LIGHT_GRAY') +
                          XLSAUTOSIZ(*YES) XLSSHEET(RTSETTDCL) +
                          IFSDEST(&FILENAME) OUTPUT(*NONE)
            
 /* Set up subject line - .10 threshold */
             RCVF       OPNID(SETTBAL)
             IF         COND((&SETTBAL_BALANCE *LE .10) *AND +
                          (&SETTBAL_BALANCE *GE -.10))  THEN(DO)
                CHGVAR     VAR(&MSG_STAT) VALUE('Yesterday PNC Settlement +
                             is in balance! Have a great day!')

                CHGVAR     VAR(&MSG_STAT) VALUE(%trim(&MSG_STAT))

                SNDMAIL    RECIPIENT((RICHARD xxxxxxx@xxxxxx.com) (JASON +
                             xxxxxxxxx@xxxxx.COM)) SENDER(QCAPIBMI +
                             xxxxxx@xxx.com) SUBJECT(&MSG_STAT) +
                             MESSAGE(&EXLMSG) ATTACHMENT(&FILENAME)
             ENDDO

             ELSE       DO
                CHGVAR     VAR(&MSG_STAT) VALUE('Yesterday PNC Settlement, +
                             one or more stores are OUT OF BALANCE!')

                CHGVAR     VAR(&MSG_STAT) VALUE(%trim(&MSG_STAT))

                SNDMAIL    RECIPIENT((RICHARD xxxx@xxxx.com) (JASON +
                             xxxxxxxxx@xxxxx.COM) (HELPDESK +
                             HELPDESK@1800LIGHTING.COM)) SENDER(QCAPIBMI +
                             xxxxxx@xxx.com) SUBJECT(&MSG_STAT) +
                             MESSAGE(&EXLMSG) ATTACHMENT(&FILENAME)
             ENDDO

/* Delete the temp tables */
             DLTF       FILE(r50modsdta/SETT_ORD)
             DLTF       FILE(r50modsdta/PNCSSUM)

END:


Running IBMi Client solutions from IFS.

While searching with Google I found this PDF by Craig Pelkie. He does an awesome job of showing us how to set up Client Solutions to run from IFS.

Complete Instructions –


The email I receive contains the excel spreadsheet created during the balancing process. I removed the data for this example. Basically, if out of balance subject is received I look and Column G and H looking for the mismatch. Then the real fun begins.

  





Ran automatically this morning without issue. 

Have your best day!

~Richard

Wednesday, February 17, 2016

Stumped, SQLRPGLE nomain module with data structure

I am stumped and have exhausted all clues provided by searching with Google high and low. My current challenge is a big one. Create an SQL nomain module, copybook member, service program that will enable to manage my backend ERP date fields that are eight digit numeric and not true date field. 

I do a lot of CLLE to automate the ERP reports which usually require date ranges. I also have the need to create CLLE programs that can do some date math.

I currently use RDI 9.5.0.2 exclusively and IBMi OS 7.1. I could do all of this with CEEDATE and play with Lillian but where the fun in that?  

All of this could be resolved by the good folks at IBM by giving us the option to use SQL Select or Set to populate a CLLE variable. ;-)

I successfully figured out how to create and compile SQLRPGLE Nomain module. The trick was the compile type option OBJTYPE, this needs to be *module when using the CRTSQLRPGI. The other stumbling point is RPGPOPT type needs to be set to *LVL1 if Data Structure is in your Prototype member.

This is where I am failing, I can make it work until got to the data structure. I am being a little hard headed and I could just fall back to what works passing one parameter per procedure call. But I believe I need to learn this technique for future use.

I managed to create module, prototype, service program, binding directory. I learned I could add DCLPRCOPT to my CLLE to set the binding directory.
So my main CLLE program DYSLSRPTC that needs dates looks like this,

DCLPRCOPT  DFTACTGRP(*NO) ACTGRP(*CALLER)  BNDDIR(R50MODS/CAPITOL)
             CALLPRC    PRC(GETPRVQTR) PARM(' ') RTNVAL(&RTNQTR)
             CALLPRC    PRC(GETTODAY) PARM(' ') RTNVAL(&TODAY)

I have GETTODAY working. I believe I can enhance this with *nopass and eliminate the PARM. I do not need to send the procedure data, just need to get back today's date.

My problem arose when I needed to get last quarter beginning and ending dates. I just want to call the procedure and have it return the two dates in one 16 alpha field as yyyymmddyyyymmdd. This seems like a perfect use for prototyping with data structure and pass back as one field.
I have tried many different permeation's with no luck. Currently getting pointer not referenced when debugging. Here is my current prototype source used for /copy.
      *--------------------------------------------------------------------
      * Get previous beginning and ending quarter date yyyymmdd
      *---------------------------------------------------------------------
       dcl-pr getPrvqtr char(16);
        *n likeds(quarterdt);
       end-pr;

       dcl-ds quarterdt qualified;
         lbegqtr char(8);
         lendqtr char(8);
       End-Ds;
                 
Here is my procedure in my nomain module,
       //****************************************************
       // getPrvqtr returns previous beginning and ending quarter yyyymmdd
       dcl-proc getPrvqtr export;
         dcl-pi *n char(16);
           qtrdt likeds(quarterdt);
         End-Pi;

       dcl-s last_quarter int(10);
       dcl-s current_quarter int(10);
       dcl-s medate char(8);

       Exec SQL Set :medate = replace(char((current_date -
                       day(current_date) days), iso), '-', '');

        // Last beginning and ending quarter
       Exec SQL Set :current_quarter = quarter(current_date);

       if current_quarter = 1;
         last_quarter = 4;
         else;
           last_quarter = current_quarter - 1;
       EndIf;

       Exec SQL Set :quarterdt.lbegqtr =
           case :last_quarter
             when 1 then substring(:medate,1,4) concat '0101'
             when 2 then substring(:medate,1,4) concat '0401'
             when 3 then substring(:medate,1,4) concat '0701'
             when 4 then substring(:medate,1,4) concat '1001'
           end;

       Exec SQL Set :quarterdt.lendqtr =
           case :last_quarter
             when 1 then substring(:medate,1,4) concat '0331'
             when 2 then substring(:medate,1,4) concat '0630'
             when 3 then substring(:medate,1,4) concat '0930'
             when 4 then substring(:medate,1,4) concat '1231'
           end;

       return quarterdt;

       End-Proc;                                   

Any assistance with this will be greatly appreciated.

Thanks,


Richard

Saturday, January 30, 2016

DB2 IBM i SQLRPGLE Free and Date conversion

One annoying capability missing from RUNSQL in CLLE is the ability to use Select into a variable. Sure you can create temporary file with create table as and use RCVF to retrieve into our variable but that can be a pain if QTEMP is not where I believe it should be. The QTEMP story is for another day.

I am currently automating month end and daily sales reporting and wanted a better way than CEEDATE and wanted to use SQL. I decided to create a little SQLRPGLE program, when called, would return dates based on current date.

My CLLE programs need last month end date, last beginning quarter, last ending quarter, yesterday, and last month name for report selection criteria.

I took the opportunity to code completely in SQLRPGLE Free. This is my first totally Free program.

There is some default code that I copy from program to program and not used. I wanted to have examples of Free code for future programs.

Feel free (no pun intended) to critic my code. I never claimed to be a programmer but for some reason find myself programming. Go figure.


 ctl-opt option(*nodebugio) dftactgrp(*no) bnddir('QC2LE');
      //********************** M O D I F I C A T I O N S *************************
           //                                                                      **
      //                 Jacksonville, Florida 32223                          **
      //                                                                      **
      // This program returns last month end date, last month name, yesterday,**
      // last beginning quarter and last ending quarter.                      **
      //                                                                      **
      //                                                                      **
      //                                                                      **
      //                                                                      **
      //                                                                      **
      //******************** M O D I F I C A T I O N S *************************
      // Date       Programmer   Description                                  **
      // ---------- ------------ -------------------------------------------- **
      // 01/11/16   Richard Bryant                                            **
      //                                                                      **
      //                                                                      **
      //                                                                      **
      //*************************************************************************
      // ------------------------------------- Prototypes
       dcl-pr rtvdate ExtPgm;
         *n char(8);
         *n char(10);
         *n char(9);
         *n char(8);
         *n char(8);
         *n char(8);
       End-Pr;

       dcl-pi *n;
         medate char(8);     // YYYYMMDD Prior month end date
         medatef char(10);   // YYYY-MM-DD Prior month end date
         mename char(9);     // Month name Prior month end name
         lbegqtr char(8);    // YYYYMMDD last beginning quarter date
         lendqtr char(8);    // YYYYMMDD last ending quarter date
         yesterday char(8);  // YYYYMMDD yesterday
       End-Pi;


      // Program Status Data Structure
       dcl-ds PgmDs PSDS;
         pgmnam *PROC;
         prmnbr *PARMS;
         job char(10) pos(244);
         user char(10) pos(254);
       End-Ds;

      // Data Structures

      // Program Constants
       dcl-c crlf x'0d25';  // Carridge return / Line feed
       dcl-c s ' ';         // Space
       dcl-c d '-';         // Dash
       dcl-c @Apostr x'7d'; // '
       dcl-c @Dblqt x'7f';  // "
       dcl-c @Gt x'6e';     // >
       dcl-c @slgt x'616e'; // />

      // Date conversion fields
       dcl-s @numA zoned(6:0) inz(041205);
       dcl-s @dateA date(*YMD) inz(D'2004-12-04');

      // Standalone Variables
       dcl-s fd int(10);
       dcl-s $xml char(512);

       dcl-s @CmdStr char(512) inz;
       dcl-s message char(52) inz;
      *
       dcl-s sdays zoned(3:0);
       dcl-s ts timestamp;
       dcl-s date date;
       dcl-s sdate date;          // Sales date
       dcl-s currdt zoned(8:0);
       dcl-s currtm zoned(6:0);
       dcl-s current_quarter int(10);
       dcl-s last_quarter int(10);

      //************************************************************************
      //    MainLine
      //


       // Set SQL options
       Exec Sql Set Option Datfmt=*Iso, Commit=*None, Closqlcsr=*Endmod;

       ts = %timestamp();        // Get current date and time
       date = %date(ts);         // Load current date field
       currdt = %dec(%date: *ISO); // Current date yyyymmdd
       currtm = %dec(%time: *HMS); // Currrent time

       // Formated last month end character date YYYY_MM_DD
       Exec SQL Set :medatef = replace(char((current_date + 1 Month - DayofMonth
                   (current_date + 1 Month) Days - 1 month), iso), '-', '_');

       // Last month character date YYYYMMDD
       Exec SQL Set :medate = replace(char((current_date + 1 Month - DayOfMonth
                 (current_date + 1 Month) Days - 1 month), iso), '-', '');

       // Last month name
       Exec SQL Set :mename = monthname(current_date + 1 Month - DayOfMonth
                     (current_date + 1 Month) Days - 1 month);

       // Yesterday YYYYMMDD
       Exec SQL Set :yesterday = replace(char((current_date - 1 day),
                    iso), '-', '');

       // Last beginning and ending quarter
       Exec SQL Set :current_quarter = quarter(current_date);

       if current_quarter = 1;
         last_quarter = 4;
         else;
           last_quarter = current_quarter - 1;
       EndIf;

       Exec SQL Set :lbegqtr =
           case :last_quarter
             when 1 then substring(:medate,1,4) concat '0101'
             when 2 then substring(:medate,1,4) concat '0401'
             when 3 then substring(:medate,1,4) concat '0701'
             when 4 then substring(:medate,1,4) concat '1001'
           end;

       Exec SQL Set :lendqtr =
           case :last_quarter
             when 1 then substring(:medate,1,4) concat '0331'
             when 2 then substring(:medate,1,4) concat '0630'
             when 3 then substring(:medate,1,4) concat '0930'
             when 4 then substring(:medate,1,4) concat '1231'
           end;


       *inlr = *on ;    

2/1/16 - Whoops, my SQL is flawed. Today, 2/1/16, returned previous month end 1/29/16. I found a blog written by Sam Lennon, programmer who opened my eyes to SQL, to figure out where I went wrong. Here is the corrected code...

 // Formated last month end character date YYYY_MM_DD                                         
       Exec SQL Set :medatef = replace(char((current_date -                                         
                               day(current_date) days), iso), '-', '_');                            
                                                                                                    
       // Last month character date YYYYMMDD                                                        
       Exec SQL Set :medate = replace(char((current_date -                                          
                              day(current_date) days), iso), '-', '');                              
                                                                                                    
       // Last month name                                                                           
       Exec SQL Set :mename = monthname(current_date -                                              
                              day(current_date) days);                                              
                                                                                                    
       // Yesterday YYYYMMDD                                                                        
       Exec SQL Set :yesterday = replace(char((current_date - 1 day),                               
                    iso), '-', '');                                                                 
                                                                                                    
       // Last beginning and ending quarter                                                         
       Exec SQL Set :current_quarter = quarter(current_date);                                       
                                                                                                    
       if current_quarter = 1;                                                                      
         last_quarter = 4;                                                                          
         else;                                                                                      
           last_quarter = current_quarter - 1;                                                      
       EndIf;                                                                                       
                                                                                                    
       Exec SQL Set :lbegqtr =                                                                      
           case :last_quarter                                                                       
             when 1 then substring(:medate,1,4) concat '0101'                                       
             when 2 then substring(:medate,1,4) concat '0401'                                       
             when 3 then substring(:medate,1,4) concat '0701'                                       
             when 4 then substring(:medate,1,4) concat '1001'                                       
           end;                                                                                     
                                                                                                    
       Exec SQL Set :lendqtr =                                                                      
           case :last_quarter                                                                       
             when 1 then substring(:medate,1,4) concat '0331'                                       
             when 2 then substring(:medate,1,4) concat '0630'                                       
             when 3 then substring(:medate,1,4) concat '0930'                                       
             when 4 then substring(:medate,1,4) concat '1231'                                       
           end;                                           


~Richard 


“f u cn rd ths, u cn gt a gd jb n sftwr tstng.” (Anonymous) 
                    

Friday, January 29, 2016

IBM i Access Client Solutions, AWESOME!

I have been running Client Solutions since October and have found it is now a full replacement for Iseries Access and Ops Navigator. The last update added the last missing piece, Run SQL scripts.

For the most part I use Linoma's Surveyor/400 software which is awesome and I really miss it when I have to work on machine it is not licensed on. That's where Client Solutions comes to play, and play well, it now does.


I have to say even over remote VPN client it all works very well. I am starting to use Navigator i for all monitoring replacing green screen.

One gotcha to be aware of. I went to delete 125mb save file from IFS folder and the machine ground to a halt. Not a good thing in the middle of the day. Had to sweat it out for 20 minutes before the machine would respond.

I knew there was a December update that I had not loaded so I downloaded and installed. Install was painless and now have run SQL option.

Planning to wait until off hours on Sunday to try deleting from IFS and see if issue was resolved in last update.

Have a great day!

~Richard

Friday, August 28, 2015

SQL is cool!

SQL is cool!



~ Richard

I really hate this darn machine;
I wish that they would sell it.
It won't do what I want it to,
but only what I tell it.
~Author Unknown