Master Menu - Links the Master Page
Columns . . . : Edit GOLFP/QRPGSRC
SEU==>_______________________________________________________ GETDTE
FMT H HKeywords++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*************** Beginning of data *************************************
H
F*-----------------------------------------------------------------------
F*- GETDTE © ---
F*- Author: Browning, 01/06/2001 ---
F*- ---
F*- PURPOSE: To accept any valid 8 digit date in ---
F*- *ISO format. When passed back to the ---
F*- caller, the variable 'TODAY will ---
F*- contain a date in text format. ---
F*- I.E. Sunday December 31, 1899. If no ---
F*- data is passed to this program the ---
F*- Variable 'Today will contain *DATE ---
F*- in text format. ---
D*AME+++++++++++ETDsFrom+++To/L+++IDc.keywords+++++++++++++++++++++++++
D TODAY S 28A
D YYMMDD S 8A
*-- KNOWNDATE is limited to dates that occur after the one it is
*-- initialized as
D KNOWNDATE S D INZ(D'1899-12-31')
*-- Because this program can be called from many other programs we need
*-- a variable that contains a valid ISO date. Later when we 'TEST' the
*-- 'YYMMDD' field for a valid ISO date and the test fails and
*-- *IN40 comes *ON. The 'ISOVALID' field replaces the value that was
*-- passed to the program and continues processing
D ISO0VALID C CONST('19820101')
D ANYDATE S D
D TEMPFIELD S 5S 0
D WEEKDAY S 1S 0
D WHATDAY S 9A DIM(7) CTDATA PERRCD(7)
D MONTH S 9A DIM(12) CTDATA PERRCD(6)
D CURMONTH S 2S 0
D THEMONTH S 9A
D THEDAY S 9A
D CCYY S 4A
D DD S 2A
D WAIT S 3A
D PARSE S 18A
D TEMP S 9A INZ(' , ')
D HOLDER S 9A
*-- Month variables
D MAY S 12A
D JUNEJULY S 13A
D MARAPRIL S 14A
D AUGUST S 15A
D JANOCTOB S 16A
D FEBNOVDEC S 17A
*-- Day variables
D SUNMONFRI S 25A
D TEMPSMF S 6A
D TEMPTU S 7A
D TUES S 26A
D TEMPSTH S 8A
D SATTHURS S 27A
C*0N01FACTOR1+++++++OPCODE(E)+FACTOR2+++++++RESULT++++++++LEN++D+HILOEQ
*-- For our purposes we are assuming that the date passed to this program
*-- was '20010905'
C *ENTRY PLIST
C PARM TODAY
*-- If this program was called without a value in the TODAY field, we
*-- take today's date and process that value.
C IF TODAY = *BLANKS
C MOVE *DATE YYMMDD
C *USA0 MOVE YYMMDD ANYDATE
C ELSE
*-- we move the 8 digit value into the 'YYMMDD' field
C MOVEL TODAY YYMMDD
*-- and perform the same tests we did in the 'DATE_INFO' program, refer
*-- to it for an explination of the following code.
C *ISO0 TEST (D) YYMMDD 40
C 40*ISO0 MOVE ISO0VALID ANYDATE
C N40*ISO0 MOVE YYMMDD ANYDATE
C MOVEA '0' *IN(40)
C ENDIF
C*- EXTRACT A NUMBER FROM 0-6 REPRESENTING A DAY FROM SUN - SAT
C* 'DATE?' DSPLY ANYDATE
C ANYDATE SUBDUR KNOWNDATE TEMPFIELD:*D
C DIV 7 TEMPFIELD
C MVR WEEKDAY
*-- Because the Move Remainder (MVR) statement can return a result of 0
*-- We increment the 'WEEKDAY' field by one assuring it allways equals
*-- at least 1,
C EVAL WEEKDAY = WEEKDAY + 1
*-- then when we use the is field as an index for the 'WHATDAY' array
*-- and move the value at this index to the field 'THEDAY' and this is
*-- how we know what day it is
C EVAL THEDAY = WHATDAY(WEEKDAY)
C*-- The OPCODE 'EXTRCT' tells the computer to extract the factor 2
*-- value from the date and place it in the result field 'CCYY', in this
*-- case we are extracting a 4 digit year from the date contained in
*-- the 'ANYDATE' field. Note the semicolin and the extender '*Y' which
*-- specifies the Year is to be extracted.
C EXTRCT ANYDATE:*Y CCYY
C EXTRCT ANYDATE:*D DD
C EXTRCT ANYDATE:*M CURMONTH
*-- as we did above we use the CURMONTH field as an index for the
*-- 'MONTH' array and move the value at this index to the field 'THEMONTH'
*-- and this is how we know what month it is
C EVAL THEMONTH = MONTH(CURMONTH)
*-- by moving the 'DD field into the WAIT field we are moving Right a value
*-- of 2 alpha or '05' into the 3 alpha field 'WAIT. So after this statement
*-- the field 'WAIT' will look like this: ' 05'
C MOVE DD WAIT
*-- Now take the WAIT field and move it from the left into the temp field
*-- Now keep in mind the TEMP field was pre-initialized to a value of:
*-- ' , ' so after this executes we have the 'TEMP' field containing
*-- ' 05, '
C MOVEL WAIT TEMP
*-- Now move from the right the 'CCYY field into the 'TEMP' field so we might
*-- end up with something like this: ' 05, 2001'
*-- Then take the 'THEMONTH' value and move it into the 'PARSE' field
*-- We the take the 'TEMP' field and move it Right into the 'PARSE' field
*-- Our example results in a value of: 'September 05, 2001' which is 18A
*-- After we figure out what day it is and execute the REMOVE2 SR this
*-- field will return here untouched, only because it is the largest possible
*-- value the field will hold and not editing is needed.
C MOVE CCYY TEMP
C MOVEL THEMONTH PARSE
C MOVE TEMP PARSE
C EXSR REMOVE1
*-- Our date is now complete and we can send the value back to the calling
*-- program.
*
C EVAL *INLR = *ON
C RETURN
*---------------------------------------------------------------------
*-- Format the field to remove excess spaces depending on what day we
*-- are dealing with. So if the 'WEEKDAY' field equals 1, 2, or 6 we
*-- know that the days length is no longer than 6 places
*-- long (Sunday Monday & Friday) so the field 'TEMPSMF' is defined
*-- as 6 alph so it can contain these values, likewise the other fields
*-- used here are of varying length so they can also hold the corresponding
*-- day value.
C REMOVE1 BEGSR
C SELECT
C WHEN WEEKDAY = 1 OR WEEKDAY = 2 OR +
C WEEKDAY = 6
C MOVE THEDAY TEMPSMF
C MOVEL TEMPSMF SUNMONFRI
C EXSR REMOVE2
C MOVE PARSE SUNMONFRI
C MOVEL SUNMONFRI TODAY
*
C WHEN WEEKDAY = 3
C MOVE THEDAY TEMPTU
C MOVEL TEMPTU TUES
C EXSR REMOVE2
C MOVE PARSE TUES
C MOVEL TUES TODAY
*
C WHEN WEEKDAY = 5 OR WEEKDAY = 7
C MOVE THEDAY TEMPSTH
C MOVEL TEMPSTH SATTHURS
C EXSR REMOVE2
C MOVE PARSE SATTHURS
C MOVEL SATTHURS TODAY
*-- Lets assume the field 'WEEKDAY' equals '4', the following will
*-- execute
C OTHER
C CLEAR TODAY
*-- In this case the value contained in the field 'THEDAY' will have
*-- the word 'Wednesday' So we move that into the 'TODAY' field and
*-- move onto the SR 'REMOVE2' The field 'TODAY' will look like this:
*-- 'Wednesday '
C MOVEL THEDAY TODAY
C EXSR REMOVE2
*-- Now in our example the value of parse will still equal:
*-- 'September 05, 2001' We then move it RIGHT into the 'TODAY' field
*-- Resulting in: 'Wednesday September 05, 2001'. Our date is now complete
*-- So we exit this SR and controll returns to the statement immediately
*-- following EXSR statement
C MOVE PARSE TODAY
C ENDSL
C ENDSR
C*---------------------------------------------------------------------
*-- When we enter this SR we need to determing what month we have so we
*-- go through the WHEN statements, for our example we are assuming that
*-- the 'CURMONTH' field equals '9', which doesn't meet any of the Select
*-- statements, so the SR ends and controll retruns to the 'REMOVE1' SR
C REMOVE2 BEGSR
C SELECT
C WHEN CURMONTH = 5
C MOVE PARSE MAY
C CLEAR PARSE
C MOVEL MAY PARSE
*
C WHEN CURMONTH = 6 OR CURMONTH = 7
C MOVE PARSE JUNEJULY
C CLEAR PARSE
C MOVEL JUNEJULY PARSE
*
C WHEN CURMONTH = 3 OR CURMONTH = 4
C MOVE PARSE MARAPRIL
C CLEAR PARSE
C MOVEL MARAPRIL PARSE
*
C WHEN CURMONTH = 8
C MOVE PARSE AUGUST
C CLEAR PARSE
C MOVEL AUGUST PARSE
*
C WHEN CURMONTH = 1 OR CURMONTH = 10
C MOVE PARSE JANOCTOB
C CLEAR PARSE
C MOVEL JANOCTOB PARSE
*
C WHEN CURMONTH = 2 OR CURMONTH = 11 OR +
C CURMONTH = 12
C MOVE PARSE FEBNOVDEC
C CLEAR PARSE
C MOVEL FEBNOVDEC PARSE
C ENDSL
C ENDSR
C*89123456789123456789123456789123456789123456789123456789
**CTDATA WHATDAY
Sunday Monday TuesdayWednesday Thursday Friday Saturday
**CTDATA MONTH
January February March April May June
July AugustSeptember October November December
Copyright ©1998 - 2001 J. Browning - All rights reserved.
Master Menu - Links the Master Page
