SeanHoppe.com › EXTOL EDI Examples › EXTOL External Call RPG Programs › EXTOL RPG Program: ADDDAYS
*****************************************************************
/TITLE API: Add Days to a Date -- External Process Code Table
********************************************************************
* SYNOPSIS: Convert date from/to format and optionally add/sub
* number of days to the date. This program makes use
* of the DATECONV code table, which must also exist in
* the *LIBL.
*
* USE: Standard Code Table Parms (Parm List 1 short)
* Inbound ( P1CDTT = "I" )
* P0RTN = *BLANKS when valid conversion
* STD = From Date (unchanged)
* QUAL = Fmts & # Days (see below)
* LCL = To Date (when valid STD & QUAL passed)
* Outbound ( P1CDTT = "O" )
* P0RTN = *BLANKS when valid conversion
* STD = To Date (when valid LCL & QUAL passed)
* QUAL = Fmts & # Days (see below)
* LCL = From Date (unchanged)
* QUAL -- positional values
* Any formats supported by DATECONV code table
* can be used for Std or Lcl here, including
* but not limited to YMD, MDY, ZMD.
* 01-03: Std Format
* 04-06: Lcl Format
* 07-12: Days to Add/Subtract
* Integer followed by optional minus sign
* Eg. 015 00015 15 are all the same
* 1- 01- 00001- are all the same
* Ex: Inbound QUAL YMDZMD0015
* Convert YYMMDD to CCYYMMDD and add 15 days.
* Ex: Outbound QUAL YMDZMD30-
* Convert CCYYMMDD to YYMMDD and subtract 30 days.
********************************************************************
* Company : ExtoL, Inc.
* System : ExtoL EDI Integrator
* Programmer : DJS
* Date : 11/23/1999
* (C) Copyright : ExtoL, Inc. 1999
********************************************************************
H Y
*****************************************************************
E LY 49 3 0A Leap Year List
*****************************************************************
IDAY#DS DS
I 1 150DAY#
*****************************************************************
IJYYDDD DS
I 1 30JYY
I 4 60DDD
*****************************************************************
I '0123456789' C $DIGIT
*****************************************************************
* Entry parameters
C *ENTRY PLIST
C PARM P0RTN 7
C PARM P1CDTT 1 Code trans dire
C PARM P2TABL 10 Code table refe
C PARM P3CDST 80 Code in standar
C PARM P4CDQD 80 Code qualifier
C PARM P5CDLC 80 Code in local f
*
C EXSR @TOJUL Cvt Usr to Jul
C P0RTN IFEQ *BLANK
C EXSR @PARSE Parse # of Days
C EXSR @ADD Add # of Days
C EXSR @TOUSR Cvt Jul to Usr
C ENDIF
*
C MOVE *OFF *INLR
C RETRN
*****************************************************************
C @TOJUL BEGSR Cvt Usr to Jul
* Use Date Convert Code Table to get any date in Julian format.
* Regardless of whether doing Inbound or Outbound, the from
* date is left justified. 'CJL' is hardcoded and right justified
* in FRMFMT which is used as "code qualifier" to DATECONV pgm.
C P1CDTT IFEQ 'I'
C 3 SUBSTP4CDQD:1 IFMT 3
C IFMT CAT 'CJL' FRMFMT 6
C MOVELP3CDST FRMDAT 80
C ENDIF
C P1CDTT IFEQ 'O'
C 3 SUBSTP4CDQD:4 OFMT 3
C OFMT CAT 'CJL' FRMFMT 6
C MOVELP5CDLC FRMDAT 80
C ENDIF
*
* Use DATECONV code table to convert date to julian.
* "I" is used regardless of the direction of previous caller.
C MOVE *BLANKS JULDAT 80
C CALL 'DATECONV'
C PARM *BLANK P0RTN 7 Return Code
C PARM 'I' O#CDTT 1 "Inbound"
C PARM P2TABL O#TABL 10 Code table ref
C PARM FRMDAT O#CDST 80 Original Fmt
C PARM FRMFMT O#CDQD 80 Code qualifier
C JULDAT PARM I#CDLC 80 Code in local
*
C TOJUL@ ENDSR Cvt Usr to Jul
*****************************************************************
C @PARSE BEGSR Parse # Days
* Parse # of days from code qualifier.
* In: P4CDQD
* Out: DAY# Number of Days to Add to date (can be negative)
C Z-ADD0 DAY#
*
* Strip leading 6 characters (StdLcl formats).
C SUBSTP4CDQD:7 DAYC 6
*
* Find first non-digit.
C $DIGIT CHECKDAYC IX
*
* Sign (if any) is first non-digit.
C IX IFGE 1
C IX ANDLE31
C SUBSTDAYC:IX SIGN 1
C ELSE
C MOVE *BLANK SIGN 1
C ENDIF
*
* Get integer days.
C IX IFGT 1
C IX ANDLE15
C 16 SUB IX IX
C MOVE *BLANK DAY#DS
C CAT DAYC:IX DAY#DS
C ' ':'0' XLATEDAYC DAYC
*
* Reverse numeric sign if '-' appended to integer.
C SIGN IFEQ '-'
C Z-SUBDAY# DAY#
C ENDIF
C ENDIF
*
C PARSE@ ENDSR Parse # Days
*****************************************************************
C @ADD BEGSR Add Days to Dat
* Add # of days offset to julian date.
* In: JULDAT
* DAY#
* Out: JULDAT adjust by DAY#
*
* Load to *DS to break out year and days.
C MOVELJULDAT JYYDDD
*
* Determine if leap year.
C EXSR @LEAP
*
* Add day number from julian date to # of days to add.
C ADD DDD DAY#
*
* Increment year while subtracting days per year.
* Note: Leap is determined after subtracting MAXDAY from year.
C DAY# DOWGTMAXDAY
C SUB MAXDAY DAY#
C ADD 1 JYY
C EXSR @LEAP
C ENDDO
*
* Decrement year while adding days per year.
* Note: Leap is determined before adding MAXDAY to year.
C DAY# DOWLE0
C SUB 1 JYY
C EXSR @LEAP
C ADD MAXDAY DAY#
C ENDDO
*
* Put normalized number days back in Julian Date *DS.
C Z-ADDDAY# DDD
*
* Move *DS to user date work field.
C MOVELJYYDDD JULDAT P
*
C ADD@ ENDSR Add Days to Dat
*****************************************************************
C @TOUSR BEGSR Cvt Jul to Usr
* Use Date Convert Code Table to convert Julian format to user Fmt.
* Regardless of whether doing Inbound or Outbound, the from
* date is left justified and 'CJL' hardcoded and right justified
* in TOFMT which is used as "code qualifier to DATECONV pgm.
C P1CDTT IFEQ 'I'
C 3 SUBSTP4CDQD:4 IFMT 3
C 'CJL' CAT IFMT TOFMT 6
C MOVELJYYDDD FRMDAT 80 P
C ENDIF
C P1CDTT IFEQ 'O'
C 3 SUBSTP4CDQD:1 OFMT 3
C 'CJL' CAT OFMT TOFMT 6
C MOVELJYYDDD FRMDAT 80 P
C ENDIF
*
* Use DATECONV code table to convert date from julian.
* "I" is used regardless of the direction of previous caller.
C MOVE *BLANKS TODATE 80
C CALL 'DATECONV'
C PARM *BLANK P0RTN 7 Return Code
C PARM 'I' O#CDTT 1 "Inbound"
C PARM P2TABL O#TABL 10 Code table ref
C PARM JULDAT O#CDST 80 Original Fmt
C PARM TOFMT O#CDQD 80 Code qualifier
C TODATE PARM I#CDLC 80 Code in local
*
C P1CDTT IFEQ 'I'
C MOVELTODATE P5CDLC P
C ENDIF
C P1CDTT IFEQ 'O'
C MOVELTODATE P3CDST P
C ENDIF
*
C TOUSR@ ENDSR Cvt Jul to Usr
*****************************************************************
C @LEAP BEGSR Chk if Leap Yr
* Determine if leap year
* In: JYY
* Out: ISLY = *ON/*OFF
* MAXDAY = 365 or 366
*
C Z-ADD1 IX 30
C JYY LOKUPLY,IX 60
C MOVE *IN60 ISLY 1
C ISLY IFEQ *ON
C Z-ADD366 MAXDAY 30 Leap Year Days
C ELSE
C Z-ADD365 MAXDAY 30 Not Leap Year
C ENDIF
C LEAP@ ENDSR Chk if Leap Yr
*****************************************************************
C *INZSR BEGSR
*
* Build list of leap years from 1904--2096.
* (JYY format 004 -- 196)
C Z-ADD04 LEAP 30
C Z-ADD1 IX 30
C IX DOWLE49
C Z-ADDLEAP LY,IX
C ADD 4 LEAP
C ADD 1 IX
C ENDDO
C SORTALY
*
C INZSR@ ENDSR
*****************************************************************