553 lines
17 KiB
Plaintext
553 lines
17 KiB
Plaintext
Subroutine PERIOD_FORMAT( CONV, argANS, argBRANCH, RETURN_DATA)
|
|
/*
|
|
* PERIOD_FORMAT is an example of a developer's custom prompt formatting
|
|
* routine using the square brackets call.
|
|
*
|
|
* It should be placed in square brackets, like this:
|
|
*
|
|
* [PERIOD_FORMAT,branch]
|
|
*
|
|
* See Iso 8601 -- This is not compliant, but could be made so
|
|
* branch values
|
|
branch result
|
|
J yyyy mm
|
|
J2- yy-mm
|
|
J- yyyy-mm
|
|
JM mm (current year assumed on input)
|
|
JY yyyy (month 1 assumed on input)
|
|
J2Y yy (month 1 assumed on input)
|
|
JW ww week number, current year assumed on input, week1 is week containing jan4
|
|
JW- yyyy-ww year, week number
|
|
J2W
|
|
J2W-
|
|
JD yyyy-ddd year, day number
|
|
JFD-
|
|
J2D
|
|
J2
|
|
JQ yyyy Qqq
|
|
JQ- yyyy-Qqq
|
|
J2Q yy Qqq
|
|
|
|
*----------------------------------------------
|
|
Example:
|
|
*----------------------------------------------
|
|
|
|
given table person containing a date field named "CREATED",
|
|
|
|
make calculated columns like below
|
|
|
|
created_year ; @ans = oconv({CREATED},"[PERIOD_FORMAT,JY]")
|
|
created_quarter; @ans = oconv({CREATED},"[PERIOD_FORMAT,JQ-]")
|
|
created_month ; @ans = oconv({CREATED},"[PERIOD_FORMAT,JM-]")
|
|
created_week ; @ans = oconv({CREATED},"[PERIOD_FORMAT,JW-]")
|
|
|
|
you can index these columns, then run reports like
|
|
* ------------------------------------------------
|
|
LIST PERSON WITH CREATED_MONTH EQ "2017-01" BY CREATED CREATED_YEAR CREATED_QUARTER BREAK-ON CREATED_MONTH BREAK-ON CREATED_WEEK CREATED TOTAL CNT
|
|
* ------------------------------------------------
|
|
|
|
Key Year Quarter Month.. Week.. Created... Cnt
|
|
456300 2017 2017-Q1 2017-01 2017-2 01/03/2017 1
|
|
343420 2017 2017-Q1 2017-01 2017-2 01/04/2017 1
|
|
235412 2017 2017-Q1 2017-01 2017-2 01/05/2017 1
|
|
359226 2017 2017-Q1 2017-01 2017-2 01/05/2017 1
|
|
386344 2017 2017-Q1 2017-01 2017-2 01/06/2017 1
|
|
*** 5
|
|
419290 2017 2017-Q1 2017-01 2017-3 01/09/2017 1
|
|
371020 2017 2017-Q1 2017-01 2017-3 01/10/2017 1
|
|
466330 2017 2017-Q1 2017-01 2017-3 01/10/2017 1
|
|
460838 2017 2017-Q1 2017-01 2017-3 01/14/2017 1
|
|
*** 4
|
|
242294 2017 2017-Q1 2017-01 2017-4 01/15/2017 1
|
|
451632 2017 2017-Q1 2017-01 2017-4 01/15/2017 1
|
|
394126 2017 2017-Q1 2017-01 2017-4 01/16/2017 1
|
|
408958 2017 2017-Q1 2017-01 2017-4 01/16/2017 1
|
|
452012 2017 2017-Q1 2017-01 2017-4 01/17/2017 1
|
|
373470 2017 2017-Q1 2017-01 2017-4 01/18/2017 1
|
|
*** 6
|
|
324396 2017 2017-Q1 2017-01 2017-5 01/25/2017 1
|
|
255764 2017 2017-Q1 2017-01 2017-5 01/26/2017 1
|
|
287786 2017 2017-Q1 2017-01 2017-5 01/26/2017 1
|
|
343596 2017 2017-Q1 2017-01 2017-5 01/27/2017 1
|
|
365166 2017 2017-Q1 2017-01 2017-5 01/28/2017 1
|
|
*** 5
|
|
249224 2017 2017-Q1 2017-01 2017-6 01/29/2017 1
|
|
455278 2017 2017-Q1 2017-01 2017-6 01/29/2017 1
|
|
235614 2017 2017-Q1 2017-01 2017-6 01/31/2017 1
|
|
304394 2017 2017-Q1 2017-01 2017-6 01/31/2017 1
|
|
*** 4
|
|
*** 24
|
|
|
|
|
|
|
|
* ------------------------------------------------
|
|
LIST PERSON WITH CREATED_QUARTER EQ "2017-Q1" BY CREATED BREAK-ON CREATED_YEAR "'V'" BREAK-ON CREATED_QUARTER "'V'" BREAK-ON CREATED_MONTH "'V'" BREAK-ON CREATED_WEEK "'V'" TOTAL CNT ID-SUPP DET-SUPP
|
|
* ------------------------------------------------
|
|
|
|
Created Year Created Quarter Created Month CREATED_WEEK Cnt
|
|
2017-2 3465
|
|
2017-3 3526
|
|
2017-4 3393
|
|
2017-5 3585
|
|
2017-6 1475
|
|
|
|
2017-01 15444
|
|
|
|
2017-6 2064
|
|
2017-7 3432
|
|
2017-8 3473
|
|
2017-9 3423
|
|
2017-10 1541
|
|
|
|
2017-02 13933
|
|
|
|
2017-10 1928
|
|
2017-11 3527
|
|
2017-12 3395
|
|
2017-13 3543
|
|
2017-14 3027
|
|
|
|
2017-03 15420
|
|
|
|
2017-Q1 44797
|
|
|
|
2017 44797
|
|
|
|
*** 44797
|
|
|
|
*----------------------------------------------
|
|
|
|
|
|
|
|
* 2006-08-27 rjc Created
|
|
* 2017-12-27 rjc Cleaned up
|
|
|
|
*/
|
|
|
|
#pragma format_Indent_comments
|
|
$insert msg_equates
|
|
$insert logical
|
|
$insert rti_HashTable_Equates
|
|
$insert rti_SSP_Equates
|
|
$insert logical
|
|
|
|
Declare Subroutine Set_Status
|
|
Declare Function rti_HashTable_STL, get_status
|
|
|
|
/*
|
|
*/
|
|
|
|
declare function Msg, rtp_65
|
|
common /period_Format_Com/init%,hCache%
|
|
If init% Else
|
|
hCache% = rti_HashTable_STL(REVSTL_HTBLMTD_CREATETABLE$, REVSTL_HTBLTYPE_SPP$ )
|
|
init% = ( hCache% gt 0 )
|
|
end
|
|
|
|
* Local Equates
|
|
* The STATUS() variable is used to indicated the error condition of the
|
|
* pattern. They are:
|
|
EQU VALID$ TO 0 ;* Successful
|
|
EQU INVALID_MSG$ TO 1 ;* Bad Data - Print error message window
|
|
EQU INVALID_CONV$ TO 2 ;* Bad Conversion - " "
|
|
EQU INVALID_NOMSG$ TO 3 ;* Bad but do not print the error message window
|
|
|
|
|
|
* Begin Conversion
|
|
*
|
|
if assigned(argAns) then ans = argAns else ans = ''
|
|
if assigned(argBranch) then branch = argBranch else branch = ''
|
|
RETURN_DATA = ""
|
|
|
|
|
|
ans = trim(Ans)
|
|
status() = valid$
|
|
|
|
|
|
* parse for period, delim
|
|
if branch[1,1] _nec 'J' then
|
|
Status() = INVALID_CONV$
|
|
return
|
|
end
|
|
|
|
period_types = 'MYWDQ'
|
|
period_type = ''
|
|
delim = ''
|
|
for i = 1 to len(period_types)
|
|
this_type = period_types[i,1]
|
|
period_pos = indexc(branch, this_Type, 1)
|
|
if period_pos then
|
|
period_type = this_type
|
|
delim = branch[period_pos+1,1]
|
|
end
|
|
until period_type
|
|
next
|
|
|
|
* J J2 J2- default to month
|
|
if period_type = '' then
|
|
period_type = 'M'
|
|
if alpha(branch[2,1]) then
|
|
delim = branch[2,1]
|
|
end else
|
|
delim = branch[3,1]
|
|
end
|
|
end
|
|
|
|
* default delim is space
|
|
if delim = '' then
|
|
delim = ' '
|
|
end
|
|
|
|
* 4 digit year?
|
|
begin case
|
|
case Indexc('JM JW JD',branch,1)
|
|
* Special cases, no display of year
|
|
year_digits = 0
|
|
case index(branch, 2, 1)
|
|
year_digits = 2
|
|
case otherwise$
|
|
year_digits = 4
|
|
end case
|
|
|
|
|
|
begin case
|
|
case conv = 'OCONV'
|
|
GoSub OConv
|
|
case conv = 'ICONV'
|
|
GoSub Iconv
|
|
case otherwise$
|
|
Status() = INVALID_CONV$
|
|
end case
|
|
|
|
return
|
|
******
|
|
|
|
|
|
|
|
Iconv:
|
|
/*
|
|
** Iconv returns a standard serial date number ( day 0 = 12/31/1967 )
|
|
** Where the date is the frst day of the period, i.e the first day of the year, month or week
|
|
*/
|
|
|
|
cacheKey = ans:"*I":branch
|
|
cacheVal = null$
|
|
stl_ret = rti_HashTable_STL(REVSTL_HTBLMTD_READROW$, hCache%, cacheKey, cacheVal)
|
|
If stl_Ret gt 0 then
|
|
transfer cacheVal To return_data
|
|
return
|
|
End
|
|
|
|
* If they passed in a number, assume it is an iconv'd date already, oconv it, then iconv again.
|
|
If Num(ans) And Len(ans) gt 4 Then
|
|
ans = Oconv(ans,'D4-')
|
|
end
|
|
|
|
begin case
|
|
case branch _eqc 'JM'
|
|
* Special case, no year supplied, just month
|
|
month = ans[1,2]
|
|
if num(month) else
|
|
status()=Invalid_Msg$
|
|
return
|
|
end
|
|
|
|
odate = Oconv(date(),'D4-')
|
|
odate[1,6] = month:'-01-'
|
|
idate = Iconv(odate, 'D')
|
|
if idate then
|
|
return_data = idate
|
|
end else
|
|
status()=Invalid_Msg$
|
|
end
|
|
|
|
case period_type = 'M'
|
|
|
|
if num(ans[3,1]) then
|
|
delim = ans[5,1]
|
|
end else
|
|
delim = ans[3,1]
|
|
end
|
|
|
|
year = field(ans, delim,1)
|
|
month = field(ans, delim, 2 )
|
|
|
|
odate = month:'-01-':year
|
|
idate = Iconv(odate, 'D')
|
|
if idate then
|
|
return_data = idate
|
|
end else
|
|
status()=Invalid_Msg$
|
|
end
|
|
|
|
case period_type = 'Y'
|
|
year = ans
|
|
if num(year) else
|
|
status()=Invalid_Msg$
|
|
end
|
|
|
|
odate = '01-01-':year
|
|
idate = Iconv(odate, 'D')
|
|
if idate then
|
|
return_data = idate
|
|
end else
|
|
status()=Invalid_Msg$
|
|
end
|
|
|
|
|
|
case period_type = 'W'
|
|
|
|
* Iconv is date of the sunday that starts the week.
|
|
* Week 1 is assumed to start the sunday of the week in the year that contains Jan 4
|
|
delim = ans
|
|
Convert '0123456789' To '' In delim
|
|
delim = delim[1,1]
|
|
|
|
|
|
* Valid Year?
|
|
If delim == '' then
|
|
year = ''
|
|
week_no = ans
|
|
End else
|
|
year = field(ans, delim,1)
|
|
week_no = field(ans, delim,2)
|
|
end
|
|
|
|
if year and num(year) else
|
|
odate = Oconv(date(), 'D4-')
|
|
year = odate[-4,4]
|
|
end
|
|
|
|
* Valid week?
|
|
begin case
|
|
case week_no = ''
|
|
idate = ''
|
|
case alpha(week_no)
|
|
idate = ''
|
|
case week_no < 1
|
|
idate = ''
|
|
case week_no > 53
|
|
idate = ''
|
|
case otherwise$
|
|
|
|
* First week of year always has 1/4 in it
|
|
first_day = Iconv('01/04/':year, 'D')
|
|
day_nr = mod(first_Day,7)
|
|
first_sunday = first_Day - day_nr
|
|
|
|
* Internal date is that number of weeks after first week
|
|
* Adjust by one, so W1 is first week of year, not W0
|
|
week_no -=1
|
|
idate = first_sunday + 7 *week_no
|
|
end case
|
|
|
|
if idate then
|
|
return_data = idate
|
|
end else
|
|
status()=Invalid_Msg$
|
|
end
|
|
|
|
case period_type = 'Q'
|
|
|
|
if num(ans[3,1]) then
|
|
delim = ans[5,1]
|
|
end else
|
|
delim = ans[3,1]
|
|
end
|
|
|
|
year = field(ans, delim,1)
|
|
quarter = field(ans, delim, 2 )
|
|
Convert 'Qq' To '' In quarter
|
|
|
|
quarter = ( int(month/4) ) + 1
|
|
Begin Case
|
|
Case quarter lt 2 ; qmonth = 3
|
|
Case quarter lt 3 ; qmonth = 6
|
|
Case quarter lt 4 ; qmonth = 9
|
|
Case 1 ; qmonth = 12
|
|
End case
|
|
|
|
odate = qmonth:'-01-':year
|
|
idate = Iconv(odate, 'D')
|
|
if idate then
|
|
return_data = idate
|
|
end else
|
|
status()=Invalid_Msg$
|
|
end
|
|
|
|
case period_type = 'D'
|
|
|
|
* Iconv is standard date
|
|
|
|
if year_digits = 0 or ( ans matches '(1,366)' ) then
|
|
day_no = ans
|
|
year = ''
|
|
end else
|
|
delim = ans[3,1]
|
|
|
|
* Valid Year?
|
|
begin case
|
|
case delim = ''
|
|
year = ''
|
|
day_no = ''
|
|
case num(delim)
|
|
year = ans[1,4]
|
|
day_no = ans[5,len(ans)]
|
|
if num(day_no[1,1]) else
|
|
day_no[1,1] = ''
|
|
end
|
|
case otherwise$
|
|
year = field(ans, delim,1)
|
|
day_no = field(ans, delim,2)
|
|
end case
|
|
end
|
|
|
|
if year and num(year) else
|
|
odate = Oconv(date(), 'D4-')
|
|
year = odate[-4,4]
|
|
end
|
|
|
|
* Valid day?
|
|
is_leap = ( mod(year, 4) = 0 ) and not(mod(year, 100) = 0)
|
|
begin case
|
|
case day_no = ''
|
|
idate = ''
|
|
case alpha(day_no)
|
|
idate = ''
|
|
case day_no < 1
|
|
idate = ''
|
|
case is_leap and day_no > 366
|
|
idate = ''
|
|
case day_no > 365
|
|
idate = ''
|
|
case otherwise$
|
|
first_day = Iconv('01/01/':year, 'D')
|
|
zeroth_day = first_Day-1
|
|
idate = zeroth_Day + day_no
|
|
end case
|
|
|
|
if idate then
|
|
return_data = idate
|
|
unused = rti_HashTable_STL(REVSTL_HTBLMTD_WRITEROW$, hCache%, cacheKey, return_Data)
|
|
|
|
end else
|
|
status()=Invalid_Msg$
|
|
end
|
|
end case
|
|
|
|
return
|
|
|
|
|
|
Oconv:
|
|
/*
|
|
** Input is expected to be a serial date number
|
|
** Output will be the requested format
|
|
*/
|
|
|
|
return_Data = ''
|
|
if num(ans) and ( ans # '' ) else
|
|
return
|
|
end
|
|
|
|
|
|
cacheKey = ans:"*O":branch
|
|
cacheVal = null$
|
|
stl_ret = rti_HashTable_STL(REVSTL_HTBLMTD_READROW$, hCache%, cacheKey, cacheVal)
|
|
If stl_Ret gt 0 then
|
|
transfer cacheVal To return_data
|
|
return
|
|
End
|
|
|
|
begin case
|
|
|
|
case period_type = 'M'
|
|
odate = Oconv(ans, 'D4-')
|
|
month = odate[1,2]
|
|
year = odate[7,4]
|
|
begin case
|
|
case year_digits = 4
|
|
return_data = year : delim : month
|
|
case year_Digits = 2
|
|
return_data = year[-2,2] : delim : month
|
|
case year_digits = 0
|
|
return_data = month
|
|
end case
|
|
|
|
case period_type = 'Y'
|
|
|
|
oDate = Oconv(ans, 'D4-')
|
|
year = odate[-1,'B-']
|
|
if year_Digits = 2 then
|
|
return_Data = year[-2,2]
|
|
end else
|
|
return_Data = year
|
|
end
|
|
|
|
case period_type = 'W'
|
|
|
|
* Get date of sunday for the week containing date
|
|
day_nr = mod(ans, 7)
|
|
sunday = ans - day_nr
|
|
|
|
* get date of sunday for date containing Jan 4 of same year
|
|
odate = Oconv(ans, 'D4-')
|
|
year = odate[-4,4]
|
|
jan_4 = iconv('01/-04-':year, 'D')
|
|
day_nr = mod(jan_4, 7)
|
|
first_sunday = jan_4 - day_nr
|
|
|
|
* Calc week nr
|
|
* Week 1 is assumed to start the sunday of the week in the year that contains Jan 4
|
|
* Add one to result as first week is week one, not week zero
|
|
|
|
day_nr = int(sunday - first_sunday)
|
|
week_no = Int(day_nr / 7) + 1
|
|
week_no +=1
|
|
begin case
|
|
case year_digits = 4
|
|
return_data = year : delim : week_no
|
|
case year_Digits = 2
|
|
return_data = year[-2,2] : delim : week_no
|
|
case year_digits = 0
|
|
return_data = week_no
|
|
end Case
|
|
case period_type = 'Q'
|
|
odate = Oconv(ans, 'D4-')
|
|
month = odate[1,2]
|
|
quarter = int(month/4)+1
|
|
year = odate[7,4]
|
|
begin case
|
|
case year_digits = 4
|
|
return_data = year : delim : "Q":quarter
|
|
case year_Digits = 2
|
|
return_data = year[-2,2] : delim : "Q":quarter
|
|
case year_digits = 0
|
|
return_data = "Q":quarter
|
|
end Case
|
|
|
|
case period_type = 'D'
|
|
|
|
odate = Oconv(ans, 'D4/')
|
|
year = odate[-4,4]
|
|
first_day = Iconv('01/01/':year, 'D')
|
|
zeroth_day = first_Day-1
|
|
day_no = ans - zeroth_Day
|
|
day_no = fmt(day_no, 'R(0)#3')
|
|
begin case
|
|
case year_digits = 4
|
|
return_data = year : delim : day_no
|
|
case year_Digits = 2
|
|
return_data = year[-2,2] : delim : day_no
|
|
case year_digits = 0
|
|
return_data = day_no
|
|
end case
|
|
|
|
|
|
end Case
|
|
|
|
|
|
unused = rti_HashTable_STL(REVSTL_HTBLMTD_WRITEROW$, hCache%, cacheKey, return_Data)
|
|
|
|
|
|
return
|