Good News Everybody!
The new search engine is LIVE!
Please report any problems to david (at) midrange.com.
|
midrange.com
Does anyone have samples of their date service programs
to share???
(show me your's - I'll show mine...)
H NOMAIN
*
FFSCL03 IF E K DISK usropn
* Global defined fields
D date_iso S D datfmt(*ISO)
D date_iso2 S D datfmt(*ISO)
D CCU# S 6 0 inz(0)
D CCYYMMDD S 8 0 inz(0)
D #of_days S 5 0
*----------------------------------------------------------------------
* Prototypes for Service Program DATE SERV
D/Copy qrpglesrc,#date_prot
*----------------------------------------------------------------------
*----------------------------------------------------------------------
Pgetnewday B Export
D getnewday pi 8 0
D indate 8 0 const
D numdays 5 0 const
D newday s 8 0
* test the date comming in to see that it is valid
C *ISO TEST (DE) indate
C IF %ERROR
c RETURN *zero
C ELSE
* move the input date to a date data type field
C *ISO MOVE indate date_iso
* add the input parmeter to that date
C date_iso ADDDUR numdays:*D date_iso2
* move the result to a 8 position numeric field
C *ISO MOVE date_iso2 newday
C RETURN newday
C ENDIF
Pgetnewday E
*--------------------------------------------------------------------
*--------------------------------------------------------------------
Pgetdaydif B Export
D getdaydif pi 5 0
D indate 8 0 const
D indate2 8 0 const
C *ISO TEST (DE) indate
C IF %ERROR
c RETURN *zero
C ELSE
C *ISO TEST (DE) indate2
C IF %ERROR
c RETURN *zero
C ELSE
* move the input date to a date data type field
C *ISO MOVE indate date_iso
C *ISO MOVE indate2 date_iso2
* Subtract the two dates to find the difference
C date_iso SUBDUR date_iso2 #of_days:*D
C RETURN #of_days
*
C ENDIF
C ENDIF
Pgetdaydif E
*--------------------------------------------------------------------
*--------------------------------------------------------------------
PgetnewdayK B Export
D getnewdayK pi 8 0
D indate 8 0 const
D numdays 5 0 const
D newday s 8 0
D ccyymmdd_o S 8 0
D date_numbr S 8 0
D wrkdays S 5 0
D incrmt_val S 5 0
* test the date comming in to see that it is valid
C FSCKEY KLIST
C KFLD CCU#
C KFLD CCYYMMDD
C *ISO TEST (DE) indate
C IF %ERROR
c RETURN *zero
C ELSE
* Determine wether we are adding or subtracting days from input date
C EVAL wrkdays = numdays
C wrkdays IFGT 0
C Z-ADD 1 incrmt_val
C ELSE
C Z-SUB 1 incrmt_val
C EVAL wrkdays = wrkdays * -1
C ENDIF
*
C *iso MOVE indate date_iso2
*
C open fscl03
*
C DO wrkdays
C date_iso2 ADDDUR incrmt_val:*D date_iso2
C *ISO MOVE date_iso2 date_numbr
C MOVE date_numbr CCYYMMDD
C DOU *IN99
C FSCKEY CHAIN FSCL03 99
C *in99 ifeq *off
C date_iso2 ADDDUR incrmt_val:*D date_iso2
C *ISO MOVE date_iso2 date_numbr
C MOVE date_numbr CCYYMMDD
C ENDIF
C ENDDO
*
C ENDDO
C close fscl03
C *ISO MOVE date_iso2 ccyymmdd_o
C RETURN ccyymmdd_o
*
C ENDIF
PgetnewdayK E
*--------------------------------------------------------------------
*--------------------------------------------------------------------
PgetnewdayK2 B Export
D getnewdayK2 pi 8 0
D indate 8 0 const
D numdays 5 0 const
D newday s 8 0
D ccyymmdd_o S 8 0
D date_numbr S 8 0
D wrkdays S 5 0
D incrmt_val S 5 0
* test the date comming in to see that it is valid
C FSCKEY KLIST
C KFLD CCU#
C KFLD CCYYMMDD
C *ISO TEST (DE) indate
C IF %ERROR
c RETURN *zero
C ELSE
* Determine wether we are adding or subtracting days from input date
C EVAL wrkdays = numdays
C wrkdays IFGT 0
C Z-ADD 1 incrmt_val
C ELSE
C Z-SUB 1 incrmt_val
C EVAL wrkdays = wrkdays * -1
C ENDIF
*
C *iso MOVE indate date_iso2
*
C open fscl03
*
C DO wrkdays
C date_iso2 ADDDUR incrmt_val:*D date_iso2
C *ISO MOVE date_iso2 date_numbr
C MOVE date_numbr CCYYMMDD
C DOU *IN99
C FSCKEY CHAIN FSCL03 99
C *in99 ifeq *off
C date_iso2 ADDDUR incrmt_val:*D date_iso2
C *ISO MOVE date_iso2 date_numbr
C MOVE date_numbr CCYYMMDD
C ENDIF
C ENDDO
*
C ENDDO
C close fscl03
C *ISO MOVE date_iso2 ccyymmdd_o
C RETURN ccyymmdd_o
*
C ENDIF
PgetnewdayK2 E
*--------------------------------------------------------------------
*--------------------------------------------------------------------
PgetDayOWeek B Export
D getdayoweek pi 3a
D indate 8 0 const
D KnownDate C D'1899-12-31'
D NameData DS
D 21a inz('MONTUEWEDTHUFRISATSUN')
D DayName 3a dim(7) Overlay(NameData)
D WorkNum S 7 0
D WorkDay S 1 0
D DayNameOut S 3a
*
C *ISO TEST (DE) indate
C IF %ERROR
C RETURN *BLANKS
C ELSE
C *ISO MOVE indate Date_iso
C Date_iso SUBDUR KnownDate WorkNum:*D
C DIV 7 WorkNum
C MVR WorkDay
C EVAL DayNameOut = DayName(WorkDay)
C Return DayNameOut
C ENDIF
PgetDayOWeek E
*--------------------------------------------------------------------
*--------------------------------------------------------------------
PgetdaydifK B Export
D getdaydifK pi 5 0
D indate 8 0 const
D indate2 8 0 const
D #of_daysn S 5 0
D #of_Work_days S 5 0
D date_flip S 5 0
D low_date S D
D high_date S D
D date_numbr S 8 0
* This program will calculate the diference in work days
* between the starting and ending date.
C FSCKEY KLIST
C KFLD CCU#
C KFLD CCYYMMDD
*
C *ISO TEST (DE) indate
C IF %ERROR
c RETURN *zero
C ELSE
C *ISO TEST (DE) indate2
C IF %ERROR
c RETURN *zero
C ELSE
* move the input date to a date data type field
C *ISO MOVE indate date_iso
C *ISO MOVE indate2 date_iso2
C ENDIF
C ENDIF
* put the lower date into low_date. put the higher date into high_da
C date_iso IFLT date_iso2
C EVAL low_date=date_iso
C EVAL high_date=date_iso2
C EVAL date_flip=-1
C ELSE
C EVAL low_date=date_iso2
C EVAL high_date=date_iso
C EVAL date_flip=1
C ENDIF
C Open FSCL03
*
C low_date DOUGE high_date
C low_date ADDDUR 1:*D low_date
C *ISO MOVE low_date date_numbr
C MOVE date_numbr CCYYMMDD
C MOVE *OFF *IN99
C DOU *IN99 OR
C low_date > high_date
C FSCKEY CHAIN FSCL03
C IF not %FOUND(FSCL03)
C add 1 #of_work_days
C EVAL *IN99 = *on
C ELSE
C low_date ADDDUR 1:*D low_date
C *ISO MOVE low_date date_numbr
C MOVE date_numbr CCYYMMDD
C ENDIF
C ENDDO
*
C ENDDO
*
C CLOSE FSCL03
C #of_work_days MULT date_flip #of_work_days
C RETURN #of_work_days
PgetdaydifK E
*--------------------------------------------------------------------
*--------------------------------------------------------------------
PgetdaydifK2 B Export
D getdaydifK2 pi 5 0
D indate 8 0 const
D indate2 8 0 const
D date_flip S 3 0
D low_date S D
D high_date S D
D GoodDate S 5a
* This program will calculate the diference in work days
* between the starting and ending date.
C FSCKEY KLIST
C KFLD CCU#
C KFLD CCYYMMDD
*
C *ISO TEST (DE) indate
C IF %ERROR
c RETURN *zero
C ELSE
C *ISO TEST (DE) indate2
C IF %ERROR
c RETURN *zero
C ELSE
* move the input date to a date data type field
C *ISO MOVE indate date_iso
C *ISO MOVE indate2 date_iso2
C ENDIF
C ENDIF
* put the lower date into low_date. put the higher date into high_da
C date_iso IFLT date_iso2
C EVAL low_date=date_iso
C EVAL high_date=date_iso2
C EVAL date_flip=-1
C ELSE
C EVAL low_date=date_iso2
C EVAL high_date=date_iso
C EVAL date_flip=1
C ENDIF
* Subtract the two dates to find the difference
C high_date SUBDUR low_date #of_days:*D
C EVAL GoodDate = 'First'
C Open FSCL03
* now loop through the FSC file, subtracting #of_days when record is
* -REMEMBER, if there is a record in FSC, that denotes a NON-wor
C low_date doWLT high_date
C *ISO MOVE low_date CCYYMMDD
C FSCKEY CHAIN FSCL03
C if %FOUND(FSCL03)
c if GoodDate = 'First'
C eval #of_days = #of_days + 1
C EVAL GoodDate = 'NO '
C ELSE
C if GoodDate <> 'First'
C eval #of_days = #of_days - 1
C EVAL GoodDate = 'NO '
C ENDIF
C ENDIF
C ELSE
C EVAL GoodDate = 'Yes '
C endif
C low_date ADDDUR 1:*D low_date
C endDO
C if GoodDate = 'Yes '
C eval #of_days = #of_days - 1
C endif
C close FSCL03
C eval #of_days = #of_days * date_flip
C RETURN #of_days
PgetdaydifK2 E
*--------------------------------------------------------------------
G Armour (garmour400r@xxxxxxxxx) wrote:
>
> Searched the archives, but with hundreds of results to wade through...
>
> Wishing to not have to reinvent a wheel that's probably been invented several
> times.
> If someone has a link that solves my dilemna, I'd really appreciate it. If
> I end
> up having to write it myself, I'll gladly share.
>
> I am getting a text file whose records contain dates like "October 08, 2002"
> (without quotes), and need to convert these dates to an *ISO date.
>
> Sounds like a perfect addition to a service program of date procedures.
>
> Also, anybody have a quick conversion for "m/d/yyyy" dates, where the month
> may be 1
> or 2 digits and same with the day of the month?
>
> TIA, GA
>
> __________________________________
>
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2026 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.
