× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



DAYSAVTIM:   PGM
/******************************************************************************/
/* NAME     - DAYSAVTIM    */
/* FUNCTION - Perform automatic Daylight Savings Time adjustments.    */
/*     NOTE - Program should be compiled with USRPRF(*OWNER), and    */
/*            the owner should have authority to CHGSYSVAL QHOUR    */
/*            - OR -    */
/*            the Job Schedule entry should name a USER that has    */
/*            authority to CHGSYSVAL QHOUR.    */
/*    */
/* ===>>>  Date of last mods. :  1999/06/25    */
/*    */
/*  Taken from: Midrange Computing, December 1997, page 13.    */
/*              (from David Hummell, modification of program by Lori
Nesje)   */
/*              Further mods by Neil Palmer, DPS Canada Ltd.    */
/*    */
/*  Add to system job scheduler as follows (substitute valid USER):    */
/*           ADDJOBSCDE JOB(AUTO_DST) CMD(CALL PGM(QGPL/DAYSAVTIM)) +  */
/*                        FRQ(*MONTHLY) SCDDATE(*NONE) SCDDAY(*SUN) +  */
/*                        SCDTIME(020000) RELDAYMON(1 *LAST) +    */
/*                        JOBQ(QSYSNOMAX) USER(????) TEXT('Daylight +  */
/*                        Savings Time adjustment program')    */
/*    */
/******************************************************************************/

             DCL        &MONTH  *CHAR  2
             DCL        &DAY    *CHAR  2
             DCL        &HOUR   *CHAR  2
             DCL        &HOUR#  *DEC   (2 0)
             DCL        &UTCOFFSET  *CHAR  5
             DCL        &UTCOFFSET# *DEC  (5 0)

             RTVSYSVAL  QMONTH  &MONTH
             RTVSYSVAL  QDAY    &DAY
             RTVSYSVAL  QHOUR   &HOUR
             RTVSYSVAL  QUTCOFFSET &UTCOFFSET

             CHGVAR     &HOUR#  &HOUR
             CHGVAR     &UTCOFFSET#  &UTCOFFSET

             IF         (&MONTH = '04' *AND &DAY < '15') THEN(DO)
              CHGVAR     &HOUR#  (&HOUR# +1)
              CHGVAR     &UTCOFFSET#  (&UTCOFFSET# +100)
             ENDDO

             IF         (&MONTH = '10' *AND &DAY > '15') THEN(DO)
              CHGVAR     &HOUR#  (&HOUR# -1)
              CHGVAR     &UTCOFFSET#  (&UTCOFFSET# -100)
             ENDDO

             IF         ((&MONTH = '04' *AND &DAY < '15') *OR +
                         (&MONTH = '10' *AND &DAY > '15')) THEN(DO)
              CHGVAR     &HOUR   &HOUR#
              CHGSYSVAL  QHOUR   &HOUR
              IF         (&UTCOFFSET# > 2400) +
                            CHGVAR &UTCOFFSET# (&UTCOFFSET# - 2400)
              IF         (&UTCOFFSET# < -2400) +
                            CHGVAR &UTCOFFSET# (&UTCOFFSET# + 2400)
              IF         ((&UTCOFFSET# < -45) & (&UTCOFFSET# > -100)) +
                            CHGVAR &UTCOFFSET# (&UTCOFFSET# + 40)
              IF         ((&UTCOFFSET# > 45) & (&UTCOFFSET# < 100)) +
                            CHGVAR &UTCOFFSET# (&UTCOFFSET# - 40)
              CHGVAR     &UTCOFFSET &UTCOFFSET#
              IF         (&UTCOFFSET# >= 0) THEN(CHGVAR +
                            &UTCOFFSET ('+' *CAT %SST(&UTCOFFSET 2 4)))
              CHGSYSVAL  QUTCOFFSET &UTCOFFSET
             ENDDO

             ENDPGM

Neil Palmer      DPS Data Processing Services Canada Ltd.
50 Acadia Avenue, Ste.102                   OS/400~~~~~
Markham, Ontario, Canada.   ____________          ___  ~
Phone:(905) 474-4890 x303   |OOOOOOOOOO| ________  o|__||=
Cell.:(416) 565-1682 x303   |__________|_|______|_|______)
Fax:  (905) 474-4898         oo      oo   oo  oo   OOOo=o\
mailto:NeilP@DPSlink.com  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
http://www.DPSlink.com     IBM iSeries  The Ultimate Business Server





Lurton Keel <LKeel@UNARCORACK.com>
Sent by: midrange-l-admin@midrange.com
2001/10/31 07:42
Please respond to midrange-l


        To:     "'midrange-l@midrange.com'" <midrange-l@midrange.com>
        cc:
        Subject:        RE: Real rookie question


Don't forget to change the QUTCOFFSET.







As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.