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)
Saturday, January 30, 2016
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
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
Subscribe to:
Posts (Atom)