Logo2
Name-A-Day
[Home] [Web & .json] [Name-A-Day]
WEBDOW

The DSPF for the Day-of-Week web service demo.
      *  _______________________________________________________________________
      *   __              _    _     __ __             _    _
      *  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      *  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      *  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      *
      *    11/2019                               booth@martinvt.com
      *  _______________________________________________________________________
      *    Web demo of get-day-of-week
      *
      *  _______________________________________________________________________
                                            DSPSIZ(*DS3)
                                            ERRSFL
                                            CHGINPDFT
                                            CA03 CF04
      *  _______________________________________________________________________
                R FMT01
                                            RTNCSRLOC(&CSRRCD &CSRFLD)
                  CSRRCD        10   H
                  CSRFLD        10   H
                                        1  2'System i'
                                        2  2'WEBDOW'
                  HDG5X40      200   B  1 12CNTFLD(40) CHGINPDFT
                                            DSPATR(PR)
        67                                  COLOR(GRN)
        61                                  COLOR(PNK)
        62                                  COLOR(TRQ)
        63                                  COLOR(WHT)
        64                                  COLOR(BLU)
        65                                  COLOR(RED)
        66                                  COLOR(YLW)
                  HDG7X23      161   B  1 54CNTFLD(23) CHGINPDFT
                                            DSPATR(PR)
        61                                  COLOR(GRN)
        62                                  COLOR(PNK)
        63                                  COLOR(TRQ)
        64                                  COLOR(WHT)
        65                                  COLOR(BLU)
        66                                  COLOR(RED)
        67                                  COLOR(YLW)
                  S1USERNAME    50      6  2COLOR(YLW)
                  S1HDG         76      8  2DSPATR(UL) COLOR(BLU)
      *  _______________________________________________________________________
                                       10  7'Date (mmddyy)'
                  S1DATE          L  B   + 1COLOR(WHT) DATFMT(*JOB)
                  POPUP          4   B   + 1COLOR(BLU) DFTVAL('(F4)')
                                       10 40'Day Name                      '
                                            DSPATR(UL) COLOR(BLU)
                  S1DAYNAME     30     11 40COLOR(WHT)
      *  _______________________________________________________________________
                  PB2            2Y 0B 23  3PSHBTNFLD((*GUTTER 2))
                                            PSHBTNCHC(1 'Done' CA03)
                                            PSHBTNCHC(2 'Calendar' CF04)
                                            CHCAVAIL((*COLOR PNK)) 




The SQL RPG for Day-of-Week web service demo .

      //  ______________________________________________________________________
      //  __              _    _     __ __             _
      // | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      // | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      // |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      //
      //  11/2019                                booth@martinvt.com
      //  ______________________________________________________________________
      //    Web demo of get-day-of-week
      //
      //  ______________________________________________________________________
       ctl-opt
       copyright('(C) Copyright Booth Martin, 2019, All rights reserved.')
       option(*nodebugio) dftactgrp(*no) actgrp(*new);

       dcl-f WEBDOWD  workstn;

       dcl-c cTrq x'30';
       dcl-c cHTTP 'http://iseries/api/';

       dcl-s dataIn char(40);

       dcl-ds *n PSDS;
        USERID char(10) pos(358);
       end-ds;
       dcl-pr ShowPopUp extpgm('DATEPOPUPR');
        *n date;
        *n packed(2) const;
        *n packed(3) const;
       end-pr;

        //==================================================================== *
        // MAINLINE                                                            *
        //==================================================================== *
        // The immediately following /EXEC SQL set options is SQL's version of
        // RPG's H Spec. It is never executed; just used at compile time.
        // MUST be in source code above any other exec SQL statements.
          exec sql set option
           Commit = *None,
           SrtSeq = *LangIDShr;   // allows sort & search with upper/lower
        //  ____________________________________________________________________
       /free
         exsr GetHeading;
         S1DATE = %date();       // Get today's date for initial date displayed.
         dow *inkc = *off;
           exsr ChangeColors;
           exsr GetDayName;
           exfmt FMT01;
           select;
             when *inkc;        // exit
             when *inkd or CSRFLD = 'POPUP';
               ShowPopUp(S1DATE: 13: 5);   // Pop-up calendar (row, column)
             other;
           endsl;
         enddo;
         *inlr = *on;
        //====================================================================*
        // MAINLINE-END                                                       *
        //====================================================================*
        //-------------------------------*  Sub-Routine  *
        // Get name of any day           *---------------*
        //-----------------------------------------------*
        begsr GetDayName;
          clear S1DAYNAME;

          dataIn = cHTTP + 'dayofweek/' + %char(S1DATE);
          exec sql select * into :S1DAYNAME
            from json_table(SYSTOOLS.HTTPGETCLOB(
                 :dataIn,''), '$' columns("dayOut" VARCHAR(30)) );
        endsr;
        //-------------------------------*  Sub-Routine  *
        // GetHeading()                  *---------------*
        //-----------------------------------------------*
        begsr GetHeading;
          HDG5X40 =
                    '   _      __    __                      '
                  + '  | | /| / /__ / /   -= Get the name =- '
                  + '  | |/ |/ / -_) _ \  -=  of the day  =- '
                  + '  |__/|__/\__/_.__/  -= for any date =- ';
          HDG7X23 =
                    '.......................'
                  + '.                     .'
                  + '.         ,,,         .'
                  + '.        (O-O)        .'
                  + '. ----oo0-(_)-0oo---- .'
                  + '.                     .'
                  + '.......................';
         exec SQL                            // Get user's name to display.
           select CID.ODOBTX
             into :S1USERNAME
             from Table( QSYS2/USERS() ) AS CID
             where CID.ODOBNM = :USERID;
         evalr S1USERNAME = 'with' + cTrq + %trim(S1USERNAME);
        endsr;
        //-------------------------------*  Sub-Routine  *
        // Change Heading Colors         *---------------*
        //-----------------------------------------------*
        begsr ChangeColors;
          select;
            when *in61;
              *in61 = *off;
              *in62 = *on;
            when *in62;
              *in62 = *off;
              *in63 = *on;
            when *in63;
              *in63 = *off;
              *in64 = *on;
            when *in64;
              *in64 = *off;
              *in65 = *on;
            when *in65;
              *in65 = *off;
              *in66 = *on;
            when *in66;
              *in66 = *off;
              *in67 = *on;
            other;
              *in67 = *off;
              *in61 = *on;
          endsl;
        endsr; 

Please contact our Webmaster with questions or comments.

© Copyright 2010-2019, Contract Programming  All rights reserved.