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