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