Heading602
email me
Date Math


The display screen for the Date Math demo:

      ****************************************************************
      *   ___             _    _     __ __             _    _        *
      *  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _   *
      *  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |  *
      *  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|  *
      *                                                              *
      *  A demo program of various date math techniques.             *
      *                                                              *
      *   12/2010                                booth@martinvt.com  *
      ****************************************************************
                                            DSPSIZ(24 80 *DS3)
                                            CHGINPDFT(HI UL)
                                            ERRSFL
                                            CA03 CF04
                                            MOUBTN(*ULD ENTER)
                R FMT01
                                            RTNCSRLOC(&REC &FLD)
                  REC           10   H
                  FLD           10   H
                  FIGLET       360   B  2  3CNTFLD(60) CHGINPDFT
                                            DSPATR(PR) COLOR(RED)
                  DATEUSA        8      2 70
                  TIMEUSA        8      3 70
                                        4 70'system i'
                                        5 70USER
                                        8 14'      Date Math Demo      '
                                            COLOR(TRQ)
                                            DSPATR(UL)
                                       10 14'Date:         '
                  DAT             L  B   + 1COLOR(WHT) DATFMT(*JOB)
                  DATEF4         4   B   + 1DSPATR(PR) COLOR(BLU)
                                            DFTVAL('(F4)')
                                       11 14'Day of week:  '
                  DOWEEK         9       + 1COLOR(WHT)
                                       12 14'Day of Year:  '
                  JDAY            L      + 1COLOR(WHT) DATFMT(*JUL)
                                       13 14'End-of-month: '
                  EOM             L      + 1COLOR(WHT) DATFMT(*JOB)
                                       14 14'Last Friday:  '
                  LASTFRI         L      + 1COLOR(WHT) DATFMT(*JOB)
                                       15 14'Next Tuesday: '
                  NEXTTUE         L      + 1COLOR(WHT) DATFMT(*JOB)
                  ADDDAYS        5Y 0B 16 19EDTCDE(N)
                  ADDSUB          L      + 4COLOR(WHT) DATFMT(*JOB)
                                         + 1'Add/Sub days:'
                                       10 54'Century Date:'
                  CDAY          10       + 1COLOR(WHT)
                                       11 54'Regular Date:'
                  REGDATE       10       + 1COLOR(WHT)
                                       23  3'F3=Exit' COLOR(BLU)
                                         + 3'F4=Pop-up Calendar' COLOR(BLU) 






Various Date Math techniques:
      //*********************************************************************
      //      ___             _    _     __ __             _    _           *
      //     | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _      *
      //     | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |     *
      //     |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|     *
      //                                                                    *
      //     A Demo program of various date math techniques.                *
      //                                                                    *
      //  12/2010                                       booth@martinvt.com  *
      //*********************************************************************
      //   5/2014    Added Pop-up Calendar & updated code.                  *
      //*********************************************************************
     H option(*nodebugio) dftactgrp(*no) actgrp(*new)
     FDATEMATHD cf   e             workstn

      *  ASCII art panel for heading. (Use a Figlet generator.)
     D FIGLET          ds
     D Figar                         60    dim(6) ctdata perrcd(1)
      * Constants
     D  cTRQ           c                   x'30'
      // Work fields
     D wTestDate       s               d   inz(d'2010-01-04')
     D wNdx            s             10i 0
     D wS1Exit         s               n

     D GetCalendar     pr                  extpgm('POPUPCALR')
     D  pDate                          d

      /FREE
        //====================================================================*
        // MAIN CALCULATIONS                                                  *
        //====================================================================*
         // Loop until exit.
         wS1Exit = *off;
         dow wS1Exit = *off;
           //   Display screen.
           exsr S1Fill;
           exfmt FMT01;
           //   Perform keypress.
           select;
             //     F3=Exit.
           when *inkc = *on;
             wS1Exit = *on;
           when *inkd or FLD = 'DATEF4';
             GetCalendar(DAT);
           other;  // everything else; process the enter key
             exsr S1KeyEnter;
           endsl;
         enddo;
         exsr ExitPgm;
         //====================================================================*   
         // MAINLINE-END                                                       *
         //====================================================================*
         //-------------------------------*  Sub-Routine  *
         // *inzsr()                      *---------------*
         // Initialize variables, set constants.          *
         //-----------------------------------------------*
       begsr *inzsr;
         DAT = %date();
         // change color in heading
         Figar(6) = %subst(Figar(5): 1:49) + cTRQ + '& Friends';
       endsr;
         //-------------------------------*  Sub-Routine  *
         // ExitPgm()                     *---------------*
         // Exit program.                                 *
         //-----------------------------------------------*
         begsr ExitPgm;
           *inlr = *on;
           return;
         endsr;
         //--------------------------------------------------------------------*
         // Screen 1 procedures.        Screen1                                *
         //--------------------------------------------------------------------*
         //-------------------------------*  Sub-Routine  *
         // S1Fill()                      *---------------*
         // Screen - Fill screen.                         *
         //-----------------------------------------------*
         begsr S1Fill;
           exsr GetDayOfWeek;
           exsr GetJulianDate;
           exsr GetEndOfMonth;
           exsr GetLastFriday;
           exsr GetNextTuesday;
           exsr AddDaysToDate;
           exsr SetCYYMMDDDate;
           TIMEUSA = (%char(%time(): *usa));
           DATEUSA = %char(%date(): *mdy);
         endsr;
         //-------------------------------*  Sub-Routine  *
         // S1KeyEnter()                  *---------------*
         // Enter key                                     *
         //-----------------------------------------------*
         begsr S1KeyEnter;
           exsr S1Validate;
           if *in90 = *off;  // If no errors then proceed.
             exsr S1Process;
           endif;
         endsr;
         //-------------------------------*  Sub-Routine  *
         // S1Validate()                  *---------------*
         // Screen - Validate entry fields.               *
         //-----------------------------------------------*
         begsr S1Validate;
           *in90 = *off;
         endsr;
         //-------------------------------*  Sub-Routine  *
         // S1Process()                   *---------------*
         // Process screen 1                              *
         //-----------------------------------------------*
         begsr S1Process;
         endsr;
         //-------------------------------*  Sub-Routine  *
         // GetDayOfWeek()                *---------------*
         // Get the day of the week                       *
         //-----------------------------------------------*
         begsr GetDayOfWeek;
            wNdx = %diff(DAT: wTestDate: *days);
            wNdx = %rem(wNdx: 7);
            select;
            when wNdx = 0;
              DOWEEK = 'Monday';
            when wNdx = 1;
              DOWEEK = 'Tuesday';
            when wNdx = 2;
              DOWEEK = 'Wednesday';
            when wNdx = 3;
              DOWEEK = 'Thursday';
            when wNdx = 4;
              DOWEEK = 'Friday';
            when wNdx = 5;
              DOWEEK = 'Saturday';
            when wNdx = 6;
              DOWEEK = 'Sunday';
            endsl;
         endsr;
        //-------------------------------*  Sub-Routine  *
        // GetJulianDate()               *---------------*
        // Get the Julian date                           *
        //-----------------------------------------------*
         begsr GetJulianDate;
           JDAY = DAT;
         endsr;
        //-------------------------------*  Sub-Routine  *
        // GetEndOfMonth()               *---------------*
        // Get the end of this month                     *
        //-----------------------------------------------*
        begsr GetEndOfMonth;
          EOM = DAT + %months(1);
          EOM = EOM - %days(%subdt(EOM: *days));
        endsr;
        //-------------------------------*  Sub-Routine  *
        // GetLastFriday()               *---------------*
        // Get a day in the past (next Friday, for demo.)*
        //-----------------------------------------------*
        begsr GetLastFriday;
          wNdx = %diff(DAT: wTestDate: *days);
          wNdx = %rem(wNdx: 7);
          wNdx = 3 + wNdx;
          LASTFRI = DAT - %days(wNdx);
        endsr;
        //-------------------------------*  Sub-Routine  *
        // GetNextTueday()               *---------------*
        // Get some day in the future (Tuesday as a demo)*
        //-----------------------------------------------*
        begsr GetNextTuesday;
          wNdx = %diff(DAT: wTestDate: *days);
          wNdx = %rem(wNdx: 7);
          if wNdx = 0;
            wNdx = 7;
          endif;
          wNdx = (8 - wNdx);
          NEXTTUE = DAT + %days(wNdx);
        endsr;
        //-------------------------------*  Sub-Routine  *
        // AddDaysToDate()               *---------------*
        // Add/subtract days from a date                 *
        //-----------------------------------------------*
        begsr AddDaysToDate;
          ADDSUB = DAT + %days(ADDDAYS);
        endsr;
        //-------------------------------*  Sub-Routine  *
        // SetCYYMMDDDate()              *---------------*
        // Deal with C datess                            *
        //-----------------------------------------------*
        begsr SetCYYMMDDDate;
          CDAY = %char(DAT: *CYMD0);
          REGDATE = %char(%date(CDAY: *CYMD0));
        endsr;
      /END-FREE
** FIGAR 1....+....2....+,,,,3,,,,+,,,,4,,,,+....5....+....6....+

  _ )              |    |        \  |            |   _)
  _ \   _ \   _ \   _|    \     |\/ |   _` |   _| _|  |    \
 ___/ \___/ \___/ \__| _| _|   _|  _| \__,_| _| \__| _| _| _|
 
 

Please contact our Webmaster with questions or comments.
© Copyright 2010, Contract Programming All rights reserved.