× 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.



--
Hi
I wrote this program to retain system date, I am
sending it to this forum because someone may need it
during the year end.
Schedule a job using ADDJOBSCDE command with schedule
time 00:00:01 calling this CL program. This program
will change
the system date back to the previous date.

Regards

Shahid Yaqoob
Ph: 966 1 4658882 Ext 231



/***************************************************************/
/* Retain System Date to Previous Date
        */
/* Author:   Shahid Yaqoob
        */
/*
        */
/***************************************************************/
PGM
  DCL &CDATE  *CHAR 6
  DCL &JDATE  *CHAR 5
  DCL &DAY    *DEC  (3 0)
  DCL &DAYC   *CHAR 3
  DCL &YER    *DEC  (2 0)
  DCL &YERC   *CHAR 2
  RTVSYSVAL  QDATE &CDATE        /* Get System date */
  /* Convert System Date to Julian Format
           */
  CVTDAT    &CDATE &JDATE FROMFMT(*SYSVAL) TOFMT(*JUL)
TOSEP(*NONE)
  CHGVAR &YER %SST(&JDATE 1 2)
  CHGVAR &DAY %SST(&JDATE 3 3)
  CHGVAR &DAY (&DAY - 1)
  /* If current date is first day of the year
           */
  IF (&DAY = 0) THEN(DO)
     CHGVAR &YER (&YER - 1)
     CHGVAR &YERC &YER
     CHGVAR &CDATE (&YERC || '1231')
     CVTDAT &CDATE &CDATE FROMFMT(*YMD) TOFMT(*SYSVAL)
TOSEP(*NONE)
     GOTO CHGSYSDAT
  ENDDO
  /* If current date is not the first day of year
          */
  CHGVAR &YERC &YER
  CHGVAR &DAYC &DAY
  CHGVAR &JDATE (&YERC || &DAYC)
  CVTDAT &JDATE &CDATE FROMFMT(*JUL) TOFMT(*SYSVAL)
TOSEP(*NONE)
CHGSYSDAT:      /* Change System Date
          */
  CHGSYSVAL QDATE &CDATE
  SNDMSG     MSG('System Date is changed from ' ||
&CDATE +
                                    || ' to ' ||
&NDATE) TOUSR(*SYSOPR)
ENDPGM

__________________________________________________
Do You Yahoo!?
Send your FREE holiday greetings online!
http://greetings.yahoo.com
--
Content-Description: retaindate

/***************************************************************/
/* Retain System Date to Previous Date                         */
/* Author:   Shahid Yaqoob                                     */
/*                                                             */
/***************************************************************/
PGM
  DCL &CDATE  *CHAR 6
  DCL &JDATE  *CHAR 5
  DCL &DAY    *DEC  (3 0)
  DCL &DAYC   *CHAR 3
  DCL &YER    *DEC  (2 0)
  DCL &YERC   *CHAR 2
  RTVSYSVAL  QDATE &CDATE        /* Get System date */
  /* Convert System Date to Julian Format                         */
  CVTDAT    &CDATE &JDATE FROMFMT(*SYSVAL) TOFMT(*JUL) TOSEP(*NONE)
  CHGVAR &YER %SST(&JDATE 1 2)
  CHGVAR &DAY %SST(&JDATE 3 3)
  CHGVAR &DAY (&DAY - 1)
  /* If current date is first day of the year                     */
  IF (&DAY = 0) THEN(DO)
     CHGVAR &YER (&YER - 1)
     CHGVAR &YERC &YER
     CHGVAR &CDATE (&YERC || '1231')
     CVTDAT &CDATE &CDATE FROMFMT(*YMD) TOFMT(*SYSVAL) TOSEP(*NONE)
     GOTO CHGSYSDAT
  ENDDO
  /* If current date is not the first day of year                */
  CHGVAR &YERC &YER
  CHGVAR &DAYC &DAY
  CHGVAR &JDATE (&YERC || &DAYC)
  CVTDAT &JDATE &CDATE FROMFMT(*JUL) TOFMT(*SYSVAL) TOSEP(*NONE)
CHGSYSDAT:      /* Change System Date                            */
  CHGSYSVAL QDATE &CDATE
  SNDMSG     MSG('System Date is changed from ' || &CDATE +
                                    || ' to ' || &NDATE) TOUSR(*SYSOPR)
ENDPGM



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.