home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / cronrgf.zip / datergf.cmd < prev    next >
OS/2 REXX Batch file  |  1993-09-20  |  40KB  |  1,066 lines
  1. /*
  2. program: datergf.cmd
  3. type:    REXXSAA-OS/2
  4. purpose: allow transformations and calculations on sorted dates
  5.          (reverse Julian dates into sorted dates)
  6. version: 1.4
  7. date:    1991-05-20
  8. changed: 1992-06-07, RGF, error-message is only displayed on STDERR, if DATERGF was not
  9.                           invoked as a function
  10.          1992-06-18, removed bundling to ATRGF.CMD etc., RGF
  11.          1993-09-20, changed the definition of ANSI-color-sequences; gets them from
  12.                      procedure ScrColor.CMD
  13.  
  14. author:  Rony G. Flatscher,
  15.          Wirtschaftsuniversität/Vienna
  16.          RONY@AWIWUW11.BITNET
  17.          rony@wu-wien.ac.at
  18.  
  19. usage:   DATERGF(argument)
  20.          DATERGF(argument, flag)
  21.          DATERGF(argument1, flag, argument2)
  22.          see enclosed Tutorial "RGFSHOW.CMD" and syntax below
  23.  
  24. needs:   SCRCOLOR.CMD
  25.  
  26. remark:  This program reflects the change in 1582, where the calendar
  27.          was corrected by subtracting 10 days (1582/10/05 - 1582/10/14 were
  28.          skipped) by the Roman Catholic pope Gregor XIII:
  29.          0000/01/01 ---> 1581/12/31 ... Julian Calendar (every 4 years leap year)
  30.          1582/01/01 ---> 9999/12/31 ... Gregorian Calendar, with 10 days less in 1582,
  31.                                         every 4 years leap year, EXCEPT whole centuries
  32.                                         which are not dividable MOD 400 = 0
  33.  
  34.  
  35.  
  36. All rights reserved, copyrighted 1991, 1992, no guarantee that it works without
  37. errors, etc. etc.
  38.  
  39. donated to the public domain granted that you are not charging anything
  40. (money etc.) for it and derivates based upon it, as you did not write it,
  41. etc. if that holds you may bundle it with commercial programs too
  42.  
  43. Please, if you find an error, post me a message describing it, I will
  44. try to fix and rerelease it to the net.
  45.  
  46. procedures:
  47.       CHECK_DATE:  check correct date and parse it
  48.       CHECK_TIME:  check correct time and parse it
  49.       DATE2DAYS:   calculate days based on 0000/01/01 (== 1)
  50.       DAYS2DATE:   generate sorted day from given days
  51.       TIME2FRACT:  calculate decimal fraction for time
  52.       FRACT2TIME:  calculate time from given decimal fraction
  53.       DATE2JULIAN: generate Julian date (YYYYDDD)
  54.       JULIAN2DATE: generate sorted date (YYYYMMDD)
  55.       WEEKDAY:     generate dayname and/or dayindex
  56.  
  57.  
  58. syntax:
  59.     SDATE ...... sorted date (YYYYMMDD)
  60.     JDATE ...... Julian date (YYYYDDD)
  61.     DAYS ....... DATERGF-days, if time supplied, time is a decimal fraction
  62.     TIME ....... on input 24hour- (military) or 12hour-format allowed,
  63.                  output will be allways in 24hour-format (military, computer)
  64.     FRACT ...... decimal fraction of time
  65.     SECONDS .... second-value for DAYS.FRACT
  66.  
  67.    Argument1:      Flag: Argument2:        Result:
  68.  
  69.    "SDATE[ TIME]"                          DAYS[.FRACT] since 00000101 inclusive
  70.    "DAYS[.FRACT]", "S"                     SDATE[ TIME24]
  71.    "SDATE[ TIME]", "J"                     JDATE
  72.    "JDATE",        "JR"                    SDATE ("Julian Reversed")
  73.  
  74.    "TIME",         "F"                     FRACT
  75.    "FRACT",        "FR"                    TIME24 ("Fraction Reversed")
  76.  
  77.    "DAYS[.FRACT]", "SEC"                   SECONDS
  78.    "SECONDS",      "SECR"                  DAYS[.FRACT] ("SEConds Reversed")
  79.  
  80.    "SDATE[ TIME]", "-S", "SDATE[ TIME]"    DAYS[.FRACT]
  81.    "SDATE[ TIME]", "-",  "DAYS[.FRACT]"    SDATE[ TIME24]
  82.    "SDATE[ TIME]", "+",  "DAYS[.FRACT]"    SDATE[ TIME24]
  83.  
  84.    "SDATE[ TIME]", "C"                     SDATE if correct, nothing ('') if false
  85.    "SDATE[ TIME]", "L"                     if leap-year, return 1, else 0
  86.  
  87.    "SDATE[ TIME]", "Y"                     check date & return year
  88.    "SDATE[ TIME]", "YB"[, DAYS[.FRACT]]    year begin [+/- DAYS[.FRACT]]
  89.    "SDATE[ TIME]", "YE"[, DAYS[.FRACT]]    year end [+/- DAYS[.FRACT]]
  90.  
  91.    "SDATE[ TIME]", "HY"                    semester index (1-2)
  92.    "SDATE[ TIME]", "HYB"[, DAYS[.FRACT]]   semester begin [+/- DAYS[.FRACT]]
  93.    "SDATE[ TIME]", "HYE"[, DAYS[.FRACT]]   semester end [+/- DAYS[.FRACT]]
  94.  
  95.    "SDATE[ TIME]", "M"                     check date & return month
  96.    "SDATE[ TIME]", "MN"                    monthname
  97.    "SDATE[ TIME]", "MB"[, DAYS[.FRACT]]    month begin [+/- DAYS[.FRACT]]
  98.    "SDATE[ TIME]", "ME"[, DAYS[.FRACT]]    month end [+/- DAYS[.FRACT]]
  99.  
  100.    "SDATE[ TIME]", "D"                     check date & return day
  101.    "SDATE[ TIME]", "DN"                    dayname
  102.    "SDATE[ TIME]", "DI"                    dayindex (1=monday, ..., 7=sunday)
  103.  
  104.    "SDATE[ TIME]", "W"                     week-number
  105.    "SDATE[ TIME]", "WB"[, DAYS[.FRACT]]    week begin (Monday) [+/- DAYS.[FRACT]]
  106.    "SDATE[ TIME]", "WE"[, DAYS[.FRACT]]    week end (Sunday) [+/- DAYS.[FRACT]]
  107.  
  108.    "SDATE[ TIME]", "Q"                     quarter index (1-4)
  109.    "SDATE[ TIME]", "QB"[, DAYS[.FRACT]]    quarter begin [+/- DAYS[.FRACT]]
  110.    "SDATE[ TIME]", "QE"[, DAYS[.FRACT]]    quarter end [+/- DAYS[.FRACT]]
  111.  
  112. */
  113.  
  114.  
  115. IF ARG(1) = ''|ARG(1) = '?' THEN SIGNAL usage
  116.  
  117.  
  118. /* invoked as a COMMAND (from command-line) or as a FUNCTION ? */
  119. PARSE SOURCE . invocation .
  120. invocation_as_function = (invocation = "FUNCTION")
  121.  
  122. IF \invocation_as_function THEN     /* called as COMMAND or SUBROUTINE and not as a FUNCTION! */
  123. DO                                  /* only one argument-string, which has to be parsed ! */
  124.    IF VERIFY(ARG(1), "(", "M") > 0 THEN
  125.       PARSE ARG "(" tmp ")"
  126.    ELSE
  127.       tmp = ARG(1)
  128.  
  129.    PARSE VAR tmp argument1 "," argument2 "," argument3
  130.  
  131.    argument1 = STRIP(argument1)     /* strip blanks */
  132.    argument2 = STRIP(argument2)
  133.    argument3 = STRIP(argument3)
  134.    argument1 = STRIP(argument1,,"'")/* strip ' */
  135.    argument2 = STRIP(argument2,,"'")
  136.    argument3 = STRIP(argument3,,"'")
  137.    argument1 = STRIP(argument1,,'"')/* strip " */
  138.    argument2 = STRIP(argument2,,'"')
  139.    argument3 = STRIP(argument3,,'"')
  140.  
  141.    SELECT                  /* number of arguments */
  142.       WHEN argument3 <> '' THEN argcount = 3
  143.       WHEN argument2 <> '' THEN argcount = 2
  144.       OTHERWISE                 argcount = 1
  145.  
  146.    END
  147.  
  148. END
  149. ELSE     /* invoked as a function */
  150. DO
  151.     argument1 = ARG(1)
  152.     argument2 = ARG(2)
  153.     argument3 = ARG(3)
  154.     argcount  = ARG()      /* number of arguments */
  155. END
  156.  
  157.  
  158. NUMERIC DIGITS 14          /* set precision to 14 digits after comma */
  159.  
  160. PARSE UPPER VAR argument1 date1 time1
  161. flag = TRANSLATE(argument2)
  162. PARSE UPPER VAR argument3 date2 time2
  163.  
  164. /* build monthdays array */
  165. monthdays.1 = 31
  166. monthdays.2 = 28
  167. monthdays.3 = 31
  168. monthdays.4 = 30
  169. monthdays.5 = 31
  170. monthdays.6 = 30
  171. monthdays.7 = 31
  172. monthdays.8 = 31
  173. monthdays.9 = 30
  174. monthdays.10 = 31
  175. monthdays.11 = 30
  176. monthdays.12 = 31
  177.  
  178.  
  179. /* check sorted dates & numbers */
  180.  
  181. IF argument3 <> '' & flag <> '-S' THEN     /* check whether third argument is a valid number */
  182.    IF \DATATYPE(argument3, 'N') THEN
  183.    DO
  184.       errmsg = argument3': not numeric'
  185.       SIGNAL error
  186.    END
  187.  
  188. SELECT
  189.    /* check sorted date and adjust monthdays. array, if necessary */
  190.    WHEN WORDPOS(flag, "S SEC SECR JR F FR") = 0 | flag = '' THEN
  191.         DO
  192.            date1 = check_date(date1)
  193.            IF time1 <> '' THEN time1 = check_time(time1)
  194.         END
  195.  
  196.    WHEN flag = 'F' THEN time1 = check_time(date1)       /* time in hand ? */
  197.  
  198.    OTHERWISE    /* argument1 a positive number ? */
  199.         DO
  200.            IF \DATATYPE(argument1,'N') THEN
  201.            DO
  202.               errmsg = argument1': not numeric'
  203.               SIGNAL error
  204.            END
  205.            ELSE IF argument1 < 0 THEN
  206.            DO
  207.               errmsg = argument1': must be a positive number'
  208.               SIGNAL error
  209.            END
  210.         END
  211. END
  212.  
  213.  
  214. /* act according to flag */
  215. SELECT
  216.    WHEN flag = '' THEN                  /* SDATE: calculate days of date = DAYS */
  217.         DO
  218.            days1 = date2days(date1)
  219.            if time1 <> '' THEN fraction1 = time2fract(time1)
  220.                           ELSE fraction1 = ''
  221.            result_datergf = days1||SUBSTR(fraction1,2)
  222.         END
  223.  
  224.    WHEN flag = 'S' THEN                 /* DAY: calculate date/time = SDATE */
  225.         DO
  226.           IF date1 < 1 THEN
  227.           DO
  228.                 errmsg = argument1 argument2": yields invalid date (< 0000/01/01) !"
  229.                 SIGNAL error
  230.           END
  231.  
  232.           days_int = date1 % 1
  233.           IF days_int > 3652427 THEN    /* > 9999/12/31 ? */
  234.           DO
  235.                 errmsg = argument1 argument2": yields invalid date (> 9999/12/31) !"
  236.                 SIGNAL error
  237.           END
  238.  
  239.           time_only = date1 - days_int
  240.           date = days2date(days_int)      /* get rid of fraction */
  241.  
  242.           IF time_only > 0 THEN date = date fract2time(time_only)
  243.  
  244.           result_datergf = date
  245.         END
  246.  
  247.    WHEN flag = '-S' THEN                /* SDATE - SDATE = DAYS */
  248.         DO
  249.            days1 = date2days(date1)
  250.            IF time1 <> '' THEN fraction1 = time2fract(time1)
  251.                           ELSE fraction1 = ''
  252.            result_datergf1 = days1||SUBSTR(fraction1,2)
  253.  
  254.            /* check date2 and prepare monthdays. */
  255.            date2 = check_date(date2)
  256.            days2 = date2days(date2)
  257.  
  258.            IF time2 <> '' THEN fraction2 = time2fract(check_time(time2))
  259.            ELSE fraction2 = ''
  260.  
  261.            result_datergf2 = days2||SUBSTR(fraction2,2)
  262.            result_datergf = result_datergf1 - result_datergf2
  263.         END
  264.  
  265.    WHEN (flag = '-') | (flag = '+') THEN        /* SDATE-DAYS = SDATE */
  266.         DO
  267.           days1 = date2days(date1)
  268.  
  269.           IF time1 <> '' THEN fraction1 = time2fract(time1)
  270.                          ELSE fraction1 = ''
  271.  
  272.           temp = days1||SUBSTR(fraction1,2)
  273.  
  274.           IF flag = '-' THEN
  275.              temp = temp - date2           /* subtract */
  276.           ELSE
  277.              temp = temp + date2           /* add */
  278.  
  279.           IF temp < 1 | ABS(temp) > 3652427 THEN        /* < 0000/01/01 or > 9999/12/31 ? */
  280.           DO
  281.                errmsg = argument1 argument2 argument3": does not yield a valid date!"
  282.                SIGNAL error
  283.           END
  284.  
  285.           days1 = temp % 1                  /* days since 0000/01/01 inclusive == 1 */
  286.           time1 = temp // 1                 /* time */
  287.           result_datergf = days2date(days1)
  288.  
  289.           IF time1 > 0 THEN
  290.              result_datergf = result_datergf fract2time(time1)
  291.         END
  292.  
  293.    WHEN flag = 'J' THEN                 /* SDATE = JDATE */
  294.         result_datergf = date2julian(date1)
  295.  
  296.    WHEN flag = 'JR' THEN                /* JDATE = SDATE (reverse Julian date) */
  297.         result_datergf = julian2date(date1)
  298.  
  299.    WHEN flag = 'F' THEN                 /* generate FRACT from TIME */
  300.         result_datergf = time2fract(time1)
  301.  
  302.    WHEN flag = 'FR' THEN                /* generate TIME24 from decimal fraction */
  303.         result_datergf = fract2time(date1 // 1)
  304.  
  305.    WHEN flag = 'SEC' THEN               /* generate SECONDS from DAYS[.FRACTION] */
  306.         result_datergf = (date1 * 86400 + 0.5) % 1  /* round to seconds */
  307.  
  308.    WHEN flag = 'SECR' THEN              /* generate DAYS[.FRACTION] from SECONDS */
  309.         result_datergf = date1 / 86400
  310.  
  311.    WHEN flag = 'C' THEN                 /* check date[ time] */
  312.         result_datergf = argument1
  313.  
  314.    WHEN flag = 'L' THEN                 /* is date in a leap year? */
  315.         DO
  316.            year = WORD(date1, 1)
  317.            IF year > 1582 THEN             /* Gregorian calender */
  318.               result_datergf = (((year // 4) = 0) & \((year // 100) = 0)) | ((year // 400)=0)
  319.            ELSE result_datergf = ((year // 4) = 0) /* Julian calender    */
  320.         END
  321.  
  322.    WHEN flag = 'Y' THEN                 /* return year */
  323.         result_datergf = WORD(date1, 1)
  324.  
  325.    WHEN flag = 'YB' | flag = 'YE' THEN     /* return year-begin or -end  */
  326.         DO
  327.            year = WORD(date1, 1)           /* optionally add (negative) days */
  328.  
  329.            IF argcount < 3 THEN               /* no third argument */
  330.            DO
  331.               IF flag = 'YB' THEN result_datergf = year||'0101'
  332.               ELSE result_datergf = year||'1231'
  333.  
  334.               IF time1 <> '' THEN result_datergf = result_datergf TRANSLATE(time1,':',' ')
  335.            END
  336.            ELSE
  337.            DO
  338.               IF flag = 'YB' THEN result_datergf = year '1 1'
  339.               ELSE result_datergf = year '12 31'
  340.  
  341.               result_datergf = date2days(result_datergf)
  342.               IF time1 <> '' THEN result_datergf = result_datergf + time2fract(time1)
  343.               result_datergf = result_datergf + date2
  344.  
  345.               days = result_datergf % 1
  346.               IF days < 1 | ABS(days) > 3652427 THEN    /* < 0000/01/01 or > 9999/12/31 ? */
  347.               DO
  348.                    errmsg = argument1 argument2 argument3": does not yield a valid date!"
  349.                    SIGNAL error
  350.               END
  351.  
  352.               fraction = result_datergf // 1
  353.               result_datergf = days2date(days)
  354.               IF fraction > 0 THEN result_datergf = result_datergf fract2time(fraction)
  355.            END
  356.         END
  357.  
  358.    WHEN flag = 'M' THEN                 /* return month */
  359.         result_datergf = WORD(date1, 2)
  360.  
  361.    WHEN flag = 'MN' THEN                /* return monthname */
  362.         result_datergf = WORD("January February March April May June July",
  363.                  "August September October November December", WORD(date1, 2))
  364.  
  365.    WHEN flag = 'MB' | flag = 'ME' THEN     /* return month-begin or -end  */
  366.         DO
  367.            PARSE VAR date1 year month .    /* optionally add (negative) days */
  368.  
  369.            IF argcount < 3 THEN               /* no third argument */
  370.            DO
  371.               IF flag = 'MB' THEN result_datergf = year||RIGHT(month,2,'0')||'01'
  372.               ELSE IF year = 1582 & month = 10 THEN result_datergf = year||RIGHT(month,2,'0')||'31'
  373.               ELSE result_datergf = year||RIGHT(month,2,'0')||monthdays.month
  374.  
  375.               IF time1 <> '' THEN result_datergf = result_datergf TRANSLATE(time1,':',' ')
  376.            END
  377.            ELSE
  378.            DO
  379.               IF flag = 'MB' THEN result_datergf = year month '1'
  380.               ELSE IF year = 1582 & month = 10 THEN result_datergf = year month '31'
  381.               ELSE result_datergf = year month monthdays.month
  382.  
  383.               result_datergf = date2days(result_datergf)
  384.               IF time1 <> '' THEN result_datergf = result_datergf + time2fract(time1)
  385.               result_datergf = result_datergf + date2
  386.  
  387.               days = result_datergf % 1
  388.               IF days < 1 | ABS(days) > 3652427 THEN    /* < 0000/01/01 or > 9999/12/31 ? */
  389.               DO
  390.                    errmsg = argument1 argument2 argument3": does not yield a valid date!"
  391.                    SIGNAL error
  392.               END
  393.  
  394.               fraction = result_datergf // 1
  395.               result_datergf = days2date(days)
  396.               IF fraction > 0 THEN result_datergf = result_datergf fract2time(fraction)
  397.            END
  398.         END
  399.  
  400.  
  401.    WHEN flag = 'W' THEN                 /* calculate week of year */
  402.         DO
  403.           PARSE VAR date1 year month day
  404.  
  405.           PARSE VALUE weekday(year "1 1", "ALL") WITH days_a d_ia
  406.  
  407.           /* 1. week or old year's week ? */
  408.           IF d_ia > 4 THEN diff = d_ia - 9
  409.           ELSE diff = d_ia - 2
  410.  
  411.           c1 = SUBSTR(date2julian(date1),5,3) + diff
  412.           result_datergf = c1 % 7 + 1           /* number of weeks */
  413.  
  414.           IF result_datergf > 51 THEN           /* last week in year ?, probably 1st week? */
  415.           DO
  416.  
  417.              PARSE VALUE weekday(year "12 31", "ALL") WITH days_0 di0
  418.  
  419.              IF di0 < 4 THEN
  420.                 IF day > (31-di0) THEN result_datergf = 1 /* first week, as 31st smaller than thursday  */
  421.           END
  422.           ELSE IF result_datergf = 1 THEN       /* beginning of January, is it last year's last week ? */
  423.           DO
  424.              IF (day + diff) < 0 THEN
  425.              DO
  426.                 PARSE VALUE weekday(RIGHT(year-1,4,'0') "1 1", "ALL") WITH days_0 di0
  427.  
  428.                 IF di0 > 4 THEN diff2 = di0 - 9 /* second week is first */
  429.                 ELSE diff2 = di0 - 2            /* first week */
  430.  
  431.                 c1 = SUBSTR(date2julian((RIGHT(year-1,4,'0') "12 31")),5,3) + diff2
  432.                 result_datergf  = c1 % 7 + 1            /* number of weeks */
  433.              END
  434.           END
  435.         END
  436.  
  437.    WHEN flag = 'D' THEN                 /* return day */
  438.         result_datergf = WORD(date1, 3)
  439.  
  440.    WHEN flag = 'DN' THEN                /* return dayname */
  441.         result_datergf = weekday(date1)
  442.  
  443.    WHEN flag = 'DI' THEN               /* return dayindex */
  444.         result_datergf = weekday(date1, "I")
  445.  
  446.    WHEN flag = 'WB' | flag = 'WE' THEN     /* return week-begin (MON) or -end (SUN)  */
  447.         DO
  448.            PARSE VALUE weekday(date1, "ALL") WITH tmp di
  449.  
  450.            IF flag = 'WB' THEN diff = 1 - di
  451.            ELSE diff = 7 - di
  452.  
  453.            new_days = tmp + diff
  454.  
  455.            IF argcount < 3 THEN               /* no third argument */
  456.            DO
  457.               IF new_days < 1 THEN         /* 0000/01/01 = THU, no monday available */
  458.               DO
  459.                    errmsg = argument1 argument2": does not yield a valid date!"
  460.                    SIGNAL error
  461.               END
  462.               result_datergf = days2date(new_days)
  463.               IF time1 <> '' THEN result_datergf = result_datergf TRANSLATE(time1,':',' ')
  464.            END
  465.            ELSE
  466.            DO
  467.               IF time1 <> '' THEN result_datergf = new_days + time2fract(time1)
  468.               ELSE result_datergf = new_days
  469.  
  470.               result_datergf = result_datergf + date2
  471.  
  472.               days = result_datergf % 1
  473.               IF days < 1 | ABS(days) > 3652427 THEN    /* < 0000/01/01 or > 9999/12/31 ? */
  474.               DO
  475.                    errmsg = argument1 argument2 argument3": does not yield a valid date!"
  476.                    SIGNAL error
  477.               END
  478.  
  479.               fraction = result_datergf // 1
  480.               result_datergf = days2date(days)
  481.               IF fraction > 0 THEN result_datergf = result_datergf fract2time(fraction)
  482.            END
  483.         END
  484.  
  485.  
  486.    WHEN flag = 'Q' THEN                 /* return quarter */
  487.         DO
  488.            year = WORD(date1, 1)
  489.            tmp = WORD(argument1, 1)           /* sorted date */
  490.            SELECT
  491.               WHEN tmp < year||'0401' THEN result_datergf = 1
  492.               WHEN tmp < year||'0701' THEN result_datergf = 2
  493.               WHEN tmp < year||'1001' THEN result_datergf = 3
  494.               OTHERWISE result_datergf = 4
  495.            END
  496.         END
  497.  
  498.    WHEN flag = 'QB' | flag = 'QE' THEN  /* return quarter-begin or -end  */
  499.         DO                              /* optionally add (negative) days */
  500.            year = WORD(date1, 1)
  501.            tmp = WORD(argument1, 1)        /* sorted date */
  502.  
  503.            IF argcount < 3 THEN            /* no third argument */
  504.            DO
  505.               IF flag = 'QB' THEN       /* quarter begin */
  506.               DO
  507.                  SELECT
  508.                     WHEN tmp < year||'0401' THEN result_datergf = year||'0101'
  509.                     WHEN tmp < year||'0701' THEN result_datergf = year||'0401'
  510.                     WHEN tmp < year||'1001' THEN result_datergf = year||'0701'
  511.                     OTHERWISE result_datergf = year||'1001'
  512.                  END
  513.               END
  514.               ELSE                      /* quarter end */
  515.               DO
  516.                  SELECT
  517.                     WHEN tmp < year||'0401' THEN result_datergf = year||'0331'
  518.                     WHEN tmp < year||'0701' THEN result_datergf = year||'0630'
  519.                     WHEN tmp < year||'1001' THEN result_datergf = year||'0930'
  520.                     OTHERWISE result_datergf = year||'1231'
  521.                  END
  522.               END
  523.  
  524.               IF time1 <> '' THEN result_datergf = result_datergf TRANSLATE(time1,':',' ')
  525.            END
  526.            ELSE
  527.            DO
  528.               IF flag = 'QB' THEN
  529.               DO
  530.                  SELECT
  531.                     WHEN tmp < year||'0401' THEN result_datergf = year  '1 1'
  532.                     WHEN tmp < year||'0701' THEN result_datergf = year  '4 1'
  533.                     WHEN tmp < year||'1001' THEN result_datergf = year  '7 1'
  534.                     OTHERWISE result_datergf = year  '10 1'
  535.                  END
  536.               END
  537.               ELSE
  538.               DO
  539.                  SELECT
  540.                     WHEN tmp < year||'0401' THEN result_datergf = year  '3 31'
  541.                     WHEN tmp < year||'0701' THEN result_datergf = year  '6 30'
  542.                     WHEN tmp < year||'1001' THEN result_datergf = year  '9 30'
  543.                     OTHERWISE result_datergf = year  '12 31'
  544.                  END
  545.               END
  546.  
  547.               result_datergf = date2days(result_datergf)
  548.               IF time1 <> '' THEN result_datergf = result_datergf + time2fract(time1)
  549.               result_datergf = result_datergf + date2
  550.  
  551.               days = result_datergf % 1
  552.               IF days < 1 | ABS(days) > 3652427 THEN    /* < 0000/01/01 or > 9999/12/31 ? */
  553.               DO
  554.                    errmsg = argument1 argument2 argument3": does not yield a valid date!"
  555.                    SIGNAL error
  556.               END
  557.  
  558.               fraction = result_datergf // 1
  559.               result_datergf = days2date(days)
  560.               IF fraction > 0 THEN result_datergf = result_datergf fract2time(fraction)
  561.            END
  562.         END
  563.  
  564.    WHEN flag = 'HY' THEN                /* return semester (1 = 1.half, 2 = 2.half */
  565.            IF WORD(date1, 2) < 7 THEN result_datergf = 1
  566.            ELSE result_datergf = 2
  567.  
  568.    WHEN flag = 'HYB' | flag = 'HYE' THEN   /* return quarter-begin or -end  */
  569.         DO
  570.            PARSE VAR date1 year month .    /* optionally add (negative) days */
  571.  
  572.            IF argcount < 3 THEN               /* no third argument */
  573.            DO
  574.               IF flag = 'HYB' THEN
  575.               DO
  576.                  IF month < 7 THEN result_datergf = year||'0101'
  577.                  ELSE result_datergf = year||'0701'
  578.               END
  579.               ELSE
  580.               DO
  581.                  IF month < 7 THEN result_datergf = year||'0630'
  582.                  ELSE result_datergf = year||'1231'
  583.               END
  584.  
  585.               IF time1 <> '' THEN result_datergf = result_datergf TRANSLATE(time1,':',' ')
  586.            END
  587.            ELSE
  588.            DO
  589.               IF flag = 'HYB' THEN
  590.               DO
  591.                  IF month < 7 THEN result_datergf = year '1 1'
  592.                  ELSE result_datergf = year '7 1'
  593.               END
  594.               ELSE
  595.               DO
  596.                  IF month < 7 THEN result_datergf = year  '6 30'
  597.                  ELSE result_datergf = year '12 31'
  598.               END
  599.  
  600.               result_datergf = date2days(result_datergf)
  601.               IF time1 <> '' THEN result_datergf = result_datergf + time2fract(time1)
  602.               result_datergf = result_datergf + date2
  603.  
  604.               days = result_datergf % 1
  605.               IF days < 1 | ABS(days) > 3652427 THEN    /* < 0000/01/01 or > 9999/12/31 ? */
  606.               DO
  607.                    errmsg = argument1 argument2 argument3": does not yield a valid date!"
  608.                    SIGNAL error
  609.               END
  610.  
  611.               fraction = result_datergf // 1
  612.               result_datergf = days2date(days)
  613.               IF fraction > 0 THEN result_datergf = result_datergf fract2time(fraction)
  614.            END
  615.         END
  616.  
  617.    OTHERWISE
  618.         DO
  619.           errmsg = flag': unknown flag'
  620.           SIGNAL error
  621.         END
  622. END
  623.  
  624. IF invocation_as_function THEN   /* invoked as function, therefore return the value */
  625.    RETURN result_datergf         /* return value */
  626.  
  627. /* invoked from the COMMAND-line or as a SUBROUTINE, both invocations must not return a value */
  628. SAY "DATERGF - result:" result_datergf       /* show result on standard output */
  629. RETURN
  630. /* end of main routine */
  631.  
  632.  
  633.  
  634.  
  635.  
  636.  
  637. /* parse & check arguments */
  638. CHECK_DATE: PROCEDURE EXPOSE monthdays.
  639.  
  640.     PARSE ARG 1 year 5 month 7 day 9
  641.  
  642.     IF \DATATYPE(year,'N') THEN
  643.     DO
  644.        errmsg = ARG(1)": year is not numeric"
  645.        SIGNAL error
  646.     END
  647.  
  648.     IF year < 0 THEN
  649.     DO
  650.        errmsg = ARG(1)": year must be 0000 or greater"
  651.        SIGNAL error
  652.     END
  653.  
  654.     /* is year a leap year ? */
  655.     IF year > 1582 THEN                 /* Gregorian calender */
  656.        leap_year = (((year // 4) = 0) & \((year // 100) = 0)) | ((year // 400)=0)
  657.     ELSE leap_year = ((year // 4) = 0)  /* Julian calender    */
  658.  
  659.     monthdays.2 = 28 + leap_year
  660.     IF year = 1582 THEN monthdays.10 = 21       /* 1582: October had 10 days less */
  661.  
  662.     SELECT
  663.        WHEN \DATATYPE(month,'N') THEN
  664.             DO
  665.                errmsg = ARG(1)||": month is not numeric"
  666.                SIGNAL error
  667.             END
  668.        WHEN (month < 1) | (month > 12) THEN
  669.             DO
  670.                errmsg = ARG(1)||": month out of range"
  671.                SIGNAL error
  672.             END
  673.        OTHERWISE
  674.             month = month % 1   /* get rid of leading nulls */
  675.     END
  676.  
  677.     SELECT
  678.        WHEN \DATATYPE(day,'N') THEN
  679.             DO
  680.                errmsg = ARG(1)": day is not numeric"
  681.                SIGNAL error
  682.             END
  683.        WHEN (day < 1) THEN
  684.             DO
  685.                errmsg = ARG(1)": day out of range"
  686.                SIGNAL error
  687.             END
  688.        WHEN year = 1582 & month = 10 THEN    /* Gregorian: 1582, October 1-4, 15-31 */
  689.             DO
  690.                IF (day > 4 & day < 15) | day > 31 THEN
  691.                DO
  692.                   IF day > 31 THEN
  693.                      errmsg = ARG(1)": too many days for given month"
  694.                   ELSE
  695.                      errmsg = ARG(1)": day out of range (1582/10/05-1582/10/14 do not exist)"
  696.                   SIGNAL error
  697.                END
  698.             END
  699.        WHEN day > monthdays.month THEN
  700.             DO
  701.                errmsg = ARG(1)": too many days for given month"
  702.                SIGNAL error
  703.             END
  704.        OTHERWISE
  705.             day = day % 1 /* get rid of leading nulls */
  706.     END
  707.  
  708.     RETURN year month day
  709. /* end of CHECK_DATE */
  710.  
  711.  
  712. /* parse & check time, return 24hour-Time (military time) */
  713. CHECK_TIME: PROCEDURE EXPOSE monthdays.
  714.     PARSE UPPER ARG tmp
  715.     time24 = 1                  /* starting with 24 hour time in mind */
  716.     time12 = POS('M', tmp)      /* AM or PM ? */
  717.     IF time12 > 0 THEN
  718.     DO
  719.       time24 = 0                /* 12 hour time in hand */
  720.       letter = SUBSTR(tmp, time12 - 1, 1)
  721.       IF \((letter = 'A') | letter = 'P') THEN
  722.       DO
  723.          errmsg = ARG(1)': not a valid AM/PM-time'
  724.          SIGNAL error
  725.       END
  726.       tmp = SUBSTR(tmp, 1, time12 - 2)  /* remove ?M */
  727.     END
  728.  
  729.     PARSE VAR tmp hours ':' minutes ':' seconds
  730.  
  731.     SELECT
  732.       WHEN hours = '' THEN hours = 0
  733.       WHEN \datatype(hours,'N') THEN     /* no numeric type */
  734.            DO
  735.               errmsg = ARG(1)": hours are not numeric"
  736.               SIGNAL error
  737.            END
  738.       WHEN (hours < 0) | (hours > 23) THEN      /* out of range    */
  739.            DO
  740.               errmsg = ARG(1)": hours out of range"
  741.               SIGNAL error
  742.            END
  743.       OTHERWISE NOP
  744.     END
  745.  
  746.     SELECT
  747.       WHEN minutes = '' THEN minutes = 0
  748.       WHEN \datatype(minutes,'N') THEN     /* no numeric type */
  749.            DO
  750.               errmsg = ARG(1)": minutes are not numeric"
  751.               SIGNAL error
  752.            END
  753.       WHEN (minutes < 0) | (minutes > 59) THEN /* out of range    */
  754.            DO
  755.               errmsg = ARG(1)": minutes out of range"
  756.               SIGNAL error
  757.            END
  758.       OTHERWISE NOP
  759.     END
  760.  
  761.     SELECT
  762.       WHEN seconds = '' THEN seconds = 0
  763.       WHEN \datatype(seconds,'N') THEN     /* no numeric type */
  764.            DO
  765.               errmsg = ARG(1)": seconds are not numeric"
  766.               SIGNAL error
  767.            END
  768.       WHEN (seconds < 0) | (seconds >= 60) THEN /* out of range    */
  769.            DO
  770.               errmsg = ARG(1)": seconds out of range"
  771.               SIGNAL error
  772.            END
  773.       OTHERWISE NOP
  774.     END
  775.  
  776.     IF \time24 THEN             /* received a 12hour time, adjust it to 24hour time */
  777.     DO
  778.        IF (letter = 'A') & (hours = 12) THEN hours = 0
  779.        ELSE IF ((letter = 'P') & (hours < 12)) THEN hours = hours + 12
  780.     END
  781.  
  782.     RETURN hours  minutes seconds
  783. /* end of CHECK_TIME */
  784.  
  785.  
  786.  
  787. /* calculate days based on 0000/01/01 (= 1. day == 1) */
  788. DATE2DAYS: PROCEDURE  EXPOSE monthdays.
  789.     PARSE ARG year month day
  790.  
  791.     days_1    = year * 365
  792.     leap_days = year % 4
  793.  
  794.     IF year > 0 THEN
  795.     DO
  796.        leap_days = leap_days + 1        /* account for leap year in 0000 */
  797.  
  798.        IF year > 1582 THEN days_1 = days_1 - 10 /* account for 1582, which had 10 days less */
  799.  
  800.        IF year > 1600 THEN         /* account for Gregorian calender */
  801.        DO
  802.            diff = year - 1600
  803.            leap_days = leap_days - (diff % 100 - diff % 400)
  804.            leap_year = (((diff // 4) = 0) & \((diff // 100) = 0)) | ((diff // 400)=0) /* leap year in hand ? */
  805.        END
  806.        ELSE leap_year = ((year // 4) = 0)       /* leap year in hand ? */
  807.  
  808.        leap_days = leap_days - leap_year
  809.     END
  810.  
  811.     days_2 = SUBSTR(date2julian(ARG(1)), 5, 3)
  812.  
  813.     RETURN (days_1 + leap_days + days_2)
  814. /* end of DATE2DAYS */
  815.  
  816.  
  817. DAYS2DATE: PROCEDURE  EXPOSE monthdays. /* calculate sorted day from given days */
  818.     days = ARG(1)
  819.  
  820.     avg_days = 365.25        /* average days a year */
  821.  
  822.     /* estimate years */
  823.     IF days > 578181 THEN               /* year greater than 1582/12/31 ? */
  824.        year1 = (days + 10 ) % avg_days  /* account for 10 missing days in 1582 */
  825.     ELSE
  826.        year1 = days % avg_days
  827.  
  828.  
  829.     DO FOREVER
  830.  
  831.        /* is year1 a leap year ? */
  832.        IF year1 > 1582 THEN                     /* Gregorian calender */
  833.           year_days = (((year1 // 4) = 0) & \((year1 // 100) = 0)) | ((year1 // 400)=0)
  834.        ELSE year_days = ((year1 // 4) = 0)      /* Julian calender    */
  835.  
  836.        IF year1 <> 1582 THEN year_days = year_days + 365
  837.        ELSE year_days = 355             /* 1582 had 10 days less */
  838.  
  839.        days_year1 = date2days(year1 "1 1")   /* pad year with 0 */
  840.        diff1 = days - days_year1
  841.  
  842.        IF diff1 < 0 THEN year1 = year1 - 1
  843.        ELSE IF diff1 > (year_days - 1) THEN year1 = year1 + 1
  844.        ELSE LEAVE
  845.     END
  846.     diff1 = diff1 + 1           /* one day off, due to subtraction */
  847.  
  848.     tmp = RIGHT(year1,4,'0')|| RIGHT(diff1,3,'0')       /* build Julian date */
  849.  
  850.     RETURN julian2date(tmp)     /* build sorted day */
  851. /* end of DAYS2DATE */
  852.  
  853.  
  854.  
  855.  
  856. /* calculate decimal fraction from time */
  857. TIME2FRACT: PROCEDURE  EXPOSE monthdays.     /* calculate decimal value for time */
  858.     PARSE ARG hours minutes seconds
  859.  
  860.     /* hour_div = 24      =   24           */
  861.     /* min_div  = 1440    =   24 * 60      */
  862.     /* sec_div  = 86400   =   24 * 60 * 60 */
  863.  
  864.     RETURN ((hours/24) + (minutes/1440) + (seconds/86400))
  865. /* end of TIME2FRACT */
  866.  
  867.  
  868. /* calculate time from fraction */
  869. FRACT2TIME: PROCEDURE  EXPOSE monthdays.     /* calculate time from given value */
  870.     /* hours    = 24      =   24           */
  871.     /* minutes  = 1440    =   24 * 60      */
  872.     /* seconds  = 86400   =   24 * 60 * 60 */
  873.  
  874.     tmp = arg(1) + 0.0000001            /* account for possible precision error */
  875.  
  876.     hours   = (tmp * 24) % 1
  877.     minutes = (tmp * 1440 - hours * 60) % 1
  878.     seconds = (tmp * 86400 - hours * 3600 - minutes * 60) % 1
  879.  
  880.     RETURN RIGHT(hours,2,'0')':'RIGHT(minutes,2,'0')':'RIGHT(seconds,2,'0')
  881.  
  882. /* end of FRACT2TIME */
  883.  
  884.  
  885. /* build Julian date from sorted date, result: yyyyddd */
  886. DATE2JULIAN: PROCEDURE EXPOSE monthdays.
  887.     PARSE ARG year month day
  888.  
  889.     /* is year a leap year ? */
  890.     IF year > 1582 THEN                 /* Gregorian calender */
  891.        leap_year = (((year // 4) = 0) & \((year // 100) = 0)) | ((year // 400)=0)
  892.     ELSE leap_year = (year // 4) = 0    /* Julian calender    */
  893.  
  894.     monthdays.2 = 28 + leap_year
  895.     IF year = 1582 THEN monthdays.10 = 21       /* 1582: October just had 21 days */
  896.  
  897.     result_function = 0
  898.     DO i = 1 TO month - 1
  899.        result_function = result_function + monthdays.i
  900.     END
  901.  
  902.     IF year = 1582 & month = 10 & day > 4 THEN day = day - 10       /* Gregorian: 10 days too many */
  903.     result_function = result_function + day
  904.  
  905.     RETURN year||RIGHT(result_function,3,'0')
  906. /* end of DATE2JULIAN */
  907.  
  908.  
  909.  
  910.  
  911. /* build sorted date from Julian date, result: yyyymmdd */
  912. JULIAN2DATE: PROCEDURE EXPOSE monthdays.
  913.     year = SUBSTR(ARG(1),1,4)
  914.  
  915.     /* is year a leap year ? */
  916.     IF year > 1582 THEN                 /* Gregorian calender */
  917.        leap_year = (((year // 4) = 0) & \((year // 100) = 0)) | ((year // 400)=0)
  918.     ELSE leap_year = (year // 4) = 0    /* Julian calender    */
  919.  
  920.     monthdays.2 = 28 + leap_year
  921.     IF year = 1582 THEN monthdays.10 = 21       /* 1582: October just had 21 days */
  922.  
  923.     jul_days = SUBSTR(ARG(1),5)       /* Julian days */
  924.     SELECT
  925.        WHEN jul_days > (365 + leap_year) THEN
  926.           DO
  927.              errmsg = ARG(1)": too many days for the given year"
  928.              SIGNAL error
  929.           END
  930.        WHEN year = 1582 & jul_days > 355 THEN       /* 1582: 10 days less than other years */
  931.           DO
  932.              errmsg = ARG(1)": too many days for 1582 (had 355 days only)"
  933.              SIGNAL error
  934.           END
  935.        OTHERWISE NOP
  936.     END
  937.  
  938.     /* calculate days */
  939.     tmp = 0
  940.     DO month = 1 TO 12
  941.        tmp = tmp + monthdays.month
  942.        IF tmp = jul_days THEN        /* exactly given days ?       */
  943.        DO
  944.           day = monthdays.month
  945.           LEAVE
  946.        END
  947.  
  948.        IF tmp > jul_days THEN      /* got over month              */
  949.        DO
  950.           day = monthdays.month - (tmp - jul_days)
  951.           LEAVE
  952.        END
  953.     END
  954.  
  955.     /* 1582: October 1-4, 15-31,  adjust for 10 missing days if necessary */
  956.     IF year = 1582 & month = 10 & day > 4 THEN day = day + 10
  957.  
  958.     RETURN year||RIGHT(month,2,'0')||RIGHT(day,2,'0')
  959. /* end of JULIAN2DATE */
  960.  
  961.  
  962.  
  963.  
  964. /* return day of sorted date as name or as index */
  965. WEEKDAY: PROCEDURE EXPOSE monthdays.
  966.     total_days = date2days(ARG(1))
  967.     dayindex = (total_days + 2) // 7 + 1  /* normalize on Mondays = 1, ..., Sunday = 7 */
  968.  
  969.     IF ARG(2) = 'I' THEN result_function = dayindex
  970.     ELSE IF ARG(2) = 'ALL' THEN result_function = total_days dayindex
  971.     ELSE result_function = WORD("Monday Tuesday Wednesday Thursday Friday Saturday Sunday", dayindex)
  972.  
  973.     RETURN result_function
  974.     /* remark:
  975.         According to an advice of ISO a week starts with MONDAY, hence:
  976.         Monday = 1, Tuesday = 2, Wednesday = 3, Thursday = 4, Friday = 5,
  977.         Saturday = 6, Sunday = 7.
  978.         The German DIN-organization already normalized on the ISO advice.
  979.     */
  980. /* end of WEEKDAY */
  981.  
  982. USAGE:
  983. /* get ANSI-color-sequences from ScrColor.CMD */
  984. PARSE VALUE ScrColor() WITH screen_normal screen_inverse text_normal text_info text_highlight text_alarm .
  985.  
  986. SAY
  987. SAY text_info'DATERGF:'screen_normal' manipulate sorted dates, time, days and time-fractions'
  988. SAY
  989. SAY text_alarm'usage as a function in REXX-programs:'
  990. SAY text_highlight'         DATERGF(argument)'
  991. SAY '         DATERGF(argument, flag)'
  992. SAY '         DATERGF(argument1, flag, argument2)'
  993. SAY
  994. SAY text_alarm'usage from command-line:'
  995. SAY text_highlight'         DATERGF argument '
  996. SAY '         DATERGF argument, flag '
  997. SAY '         DATERGF argument1, flag, argument2 '
  998. SAY
  999. SAY screen_normal'         see enclosed Tutorial "RGFSHOW.CMD" and syntax below'
  1000. SAY
  1001. SAY text_alarm'syntax:'
  1002. SAY
  1003. SAY text_info'SDATE'screen_normal' ...... sorted date (YYYYMMDD)'
  1004. SAY text_info'JDATE'screen_normal' ...... Julian date (YYYYDDD)'
  1005. SAY text_info'DAYS'screen_normal' ....... DATERGF-days, if time supplied, time is a decimal fraction'
  1006. SAY text_info'TIME'screen_normal' ....... on input 24hour- (military) or 12hour-format allowed,'
  1007. SAY '             output will be allways in 24hour-format (military, computer)'
  1008. SAY text_info'FRACT'screen_normal' ...... decimal fraction of time'
  1009. SAY text_info'SECONDS'screen_normal' .... second-value for DAYS.FRACT'
  1010. SAY
  1011. SAY 'Argument1:      Flag: Argument2:        Result:'
  1012. SAY
  1013. SAY text_info'"SDATE[ TIME]"                          DAYS[.FRACT]'screen_normal' since 00000101 inclusive'
  1014. SAY text_info'"DAYS[.FRACT]", "S"                     SDATE[ TIME24]'
  1015. SAY '"SDATE[ TIME]", "J"                     JDATE'
  1016. SAY '"JDATE",        "JR"                    SDATE'screen_normal' ("Julian Reversed")'
  1017. SAY
  1018. SAY text_info'"TIME",         "F"                     FRACT'
  1019. SAY '"FRACT",        "FR"                    TIME24'screen_normal' ("Fraction Reversed")'
  1020. SAY
  1021. SAY text_info'"DAYS[.FRACT]", "SEC"                   SECONDS'
  1022. SAY '"SECONDS",      "SECR"                  DAYS[.FRACT]'screen_normal' ("SEConds Reversed")'
  1023. SAY
  1024. SAY text_info'"SDATE[ TIME]", "-S", "SDATE[ TIME]"    DAYS[.FRACT]'
  1025. SAY '"SDATE[ TIME]", "-",  "DAYS[.FRACT]"    SDATE[ TIME24]'
  1026. SAY '"SDATE[ TIME]", "+",  "DAYS[.FRACT]"    SDATE[ TIME24]'
  1027. SAY
  1028. SAY '"SDATE[ TIME]", "C"                     SDATE'screen_normal' if correct, nothing ('text_info''''''screen_normal') if false'
  1029. SAY text_info'"SDATE[ TIME]", "L"'screen_normal'                     if leap-year, return 1, else 0'
  1030. SAY text_info'"SDATE[ TIME]", "Y"'screen_normal'                     check date & return year'
  1031. SAY text_info'"SDATE[ TIME]", "YB"[, DAYS[.FRACT]]'screen_normal'    year begin 'text_info'[+/- DAYS[.FRACT]]'
  1032. SAY '"SDATE[ TIME]", "YE"[, DAYS[.FRACT]]'screen_normal'    year end 'text_info'[+/- DAYS[.FRACT]]'
  1033. SAY '"SDATE[ TIME]", "HY"'screen_normal'                    semester index (1-2)'
  1034. SAY text_info'"SDATE[ TIME]", "HYB"[, DAYS[.FRACT]]'screen_normal'   semester begin 'text_info'[+/- DAYS[.FRACT]]'
  1035. SAY '"SDATE[ TIME]", "HYE"[, DAYS[.FRACT]]'screen_normal'   semester end 'text_info'[+/- DAYS[.FRACT]]'
  1036. SAY
  1037. SAY '"SDATE[ TIME]", "M"'screen_normal'                     check date & return month'
  1038. SAY text_info'"SDATE[ TIME]", "MN"'screen_normal'                    monthname'
  1039. SAY text_info'"SDATE[ TIME]", "MB"[, DAYS[.FRACT]]'screen_normal'    month begin 'text_info'[+/- DAYS[.FRACT]]'
  1040. SAY '"SDATE[ TIME]", "ME"[, DAYS[.FRACT]]'screen_normal'    month end 'text_info'[+/- DAYS[.FRACT]]'
  1041. SAY ''
  1042. SAY '"SDATE[ TIME]", "D"'screen_normal'                     check date & return day'
  1043. SAY text_info'"SDATE[ TIME]", "DN"'screen_normal'                    dayname'
  1044. SAY text_info'"SDATE[ TIME]", "DI"'screen_normal'                    dayindex (1=monday, ..., 7=sunday)'
  1045. SAY
  1046. SAY text_info'"SDATE[ TIME]", "W"'screen_normal'                     week-number'
  1047. SAY text_info'"SDATE[ TIME]", "WB"[, DAYS[.FRACT]]'screen_normal'    week begin (Monday) 'text_info'[+/- DAYS.[FRACT]]'
  1048. SAY '"SDATE[ TIME]", "WE"[, DAYS[.FRACT]]'screen_normal'    week end (Sunday) 'text_info'[+/- DAYS.[FRACT]]'
  1049. SAY
  1050. SAY '"SDATE[ TIME]", "Q"'screen_normal'                     quarter index (1-4)'
  1051. SAY text_info'"SDATE[ TIME]", "QB"[, DAYS[.FRACT]]'screen_normal'    quarter begin 'text_info'[+/- DAYS[.FRACT]]'
  1052. SAY '"SDATE[ TIME]", "QE"[, DAYS[.FRACT]]'screen_normal'    quarter end 'text_info'[+/- DAYS[.FRACT]]'screen_normal
  1053. EXIT
  1054.  
  1055.  
  1056. ERROR:
  1057.    /* invoked as a COMMAND (from command-line) or as a FUNCTION ? */
  1058.    PARSE SOURCE . invocation .
  1059.    invocation_as_function = (invocation = "FUNCTION")
  1060.  
  1061.    /* error message on device "STDERR", only if not called as function */
  1062.    IF \invocation_as_function THEN
  1063.       '@ECHO DATERGF:' errmsg '>&2'
  1064.  
  1065.    EXIT ''                                      /* error, therefore return empty string */
  1066.