|
midrange.com
I created a subprocedure(ILE) to do the exact thing you are trying to do,
and it makes handling dates much easier!
Here is what the code looks like in your pgm:
/COPY QSRVSRC,P.DATE - this goes at the beginning of your pgm before the
'D' specs
C eval NewDate = #ChgDtFmt(Date1:'*ISO':'*USA')
what I am doing is passing in the date I want converted(Date1), pass in the
format the date is currently in(*ISO) and pass in what I want to receive
back(*USA), and NewDate holds the new value. Easy as heck and a lot less
confusing!
I have the module that contains the code in an attachment called F.DATE.TXT
I have found that this is a lot easier than have date fields defined in
every program and having to do multiple moves from one date field to
another.
Aaron Bartell
<<F.DATE.TXT>>
> -----Original Message-----
> From: Ray, Adam [mailto:aray@fhp.org]
> Sent: Thursday, February 01, 2001 8:56 AM
> To: 'RPG400-L@midrange.com'
> Subject: convert 8 digit date to ISO date
>
> This may be a silly question and I'm hoping it has a simple answer.
> What is the easiest way to convert an 8 digit numeric date (defined as 8P
> 0) in the format CCYYMMDD to an ISO format date field (defined as 10D)?
> I need to do some date calculations using the SUBDUR command.
> TIA
> Adam Ray
0011.00 H NOMAIN
0012.00 ****************************************************************
0013.00 ****************************************************************
0014.00 * Prototypes *
0015.00 ****************************************************************
0016.00 /COPY QSRVSRC,P.DATE
0017.00 ****************************************************************
0018.00 * Global Definitions *
0019.00 ****************************************************************
0020.00 D EURDate S D DATFMT(*EUR)
0021.00 D ISODate S D DATFMT(*ISO)
0022.00 D JISDate S D DATFMT(*JIS)
0023.00 D JULDate S D DATFMT(*JUL)
0024.00 D USADate S D DATFMT(*USA)
0025.00 *//////////////////////////////////////////////////////////////*
0026.00 * (#ValidDate) Returns '0' for a valid date and '1' for invalid*
0027.00 *//////////////////////////////////////////////////////////////*
0028.00 P #ValidDate B EXPORT
0029.00 *--------------------------------------------------------------*
0030.00 D #ValidDate PI 1
0031.00 D Date 8 0 VALUE
0032.00 D Format 4 VALUE
0033.00 *--------------------------------------------------------------*
0034.00 C select
0035.00 C when (Format = '*USA')
0036.00 C *USA TEST(d) Date 99
0037.00 C when (Format = '*ISO')
0038.00 C *ISO TEST(d) Date 99
0039.00 C when (Format = '*EUR')
0040.00 C *EUR TEST(d) Date 99
0041.00 C when (Format = '*JIS')
0042.00 C *JIS TEST(d) Date 99
0043.00 C other
0044.00 C eval *IN99 = *ON
0045.00 C endsl
0046.00 *
0047.00 C RETURN *IN99
0048.00 *--------------------------------------------------------------*
0049.00 P #ValidDate E
0138.00 *//////////////////////////////////////////////////////////////*
0139.00 * (#ChgDtFmt) Returns '0' if the date sent in is invalid. *
0140.00 *//////////////////////////////////////////////////////////////*
0141.00 P #ChgDtFmt B EXPORT
0142.00 *--------------------------------------------------------------*
0143.00 D #ChgDtFmt PI 8 0
0144.00 D Date 8 0 VALUE
0145.00 D FFormat 4 VALUE
0146.00 D TFormat 4 VALUE
0147.00 *--------------------------------------------------------------*
0148.00 C select
0149.00 C when FFormat = '*USA' and
USA to ISO
0150.00 C TFormat = '*ISO' and
0151.00 C (#ValidDate(Date:'*USA') = '0')
0152.00 C move Date USADate
0153.00 C move USADate ISODate
0154.00 C move ISODate Date
0155.00 *
0156.00 C when FFormat = '*USA' and
USA to EUR
0157.00 C TFormat = '*EUR' and
0158.00 C (#ValidDate(Date:'*USA') = '0')
0159.00 C move Date USADate
0160.00 C move USADate EURDate
0161.00 C move EURDate Date
0162.00 *
0163.00 C when FFormat = '*USA' and
USA to JIS
0164.00 C TFormat = '*JIS' and
0165.00 C (#ValidDate(Date:'*USA') = '0')
0166.00 C move Date USADate
0167.00 C move USADate JISDate
0168.00 C move JISDate Date
0169.00 *
0170.00 C when FFormat = '*ISO' and
ISO to USA
0171.00 C TFormat = '*USA' and
0172.00 C (#ValidDate(Date:'*ISO') = '0')
0173.00 C move Date ISODate
0174.00 C move ISODate USADate
0175.00 C move USADate Date
0176.00 *
0177.00 C when FFormat = '*ISO' and
ISO to EUR
0178.00 C TFormat = '*EUR' and
0179.00 C (#ValidDate(Date:'*ISO') = '0')
0180.00 C move Date ISODate
0181.00 C move ISODate EURDate
0182.00 C move EURDate Date
0183.00 *
0184.00 C when FFormat = '*ISO' and
ISO to JIS
0185.00 C TFormat = '*JIS' and
0186.00 C (#ValidDate(Date:'*ISO') = '0')
0187.00 C move Date ISODate
0188.00 C move ISODate JISDate
0189.00 C move JISDate Date
0190.00 *
0191.00 C when FFormat = '*JIS' and
JIS to USA
0192.00 C TFormat = '*USA' and
0193.00 C (#ValidDate(Date:'*JIS') = '0')
0194.00 C move Date JISDate
0195.00 C move JISDate USADate
0196.00 C move USADate Date
0197.00 *
0198.00 C when FFormat = '*JIS' and
JIS to EUR
0199.00 C TFormat = '*EUR' and
0200.00 C (#ValidDate(Date:'*JIS') = '0')
0201.00 C move Date ISODate
0202.00 C move ISODate JISDate
0203.00 C move JISDate Date
0204.00 *
0205.00 C when FFormat = '*JIS' and
JIS to ISO
0206.00 C TFormat = '*ISO' and
0207.00 C (#ValidDate(Date:'*JIS') = '0')
0208.00 C move Date JISDate
0209.00 C move JISDate ISODate
0210.00 C move ISODate Date
0211.00 *
0212.00 C when FFormat = '*EUR' and
EUR to USA
0213.00 C TFormat = '*USA' and
0214.00 C (#ValidDate(Date:'*EUR') = '0')
0215.00 C move Date EURDate
0216.00 C move EURDate USADate
0217.00 C move USADate Date
0218.00 *
0219.00 C when FFormat = '*EUR' and
EUR to JIS
0220.00 C TFormat = '*JIS' and
0221.00 C (#ValidDate(Date:'*EUR') = '0')
0222.00 C move Date EURDate
0223.00 C move EURDate JISDate
0224.00 C move JISDate Date
0225.00 *
0226.00 C when FFormat = '*EUR' and
EUR to ISO
0227.00 C TFormat = '*ISO' and
0228.00 C (#ValidDate(Date:'*EUR') = '0')
0229.00 C move Date EURDate
0230.00 C move EURDate ISODate
0231.00 C move ISODate Date
0232.00 *
0233.00 C other
0234.00 C eval Date = 0
0235.00 C endsl
0236.00 *
0237.00 C RETURN Date
0238.00 *--------------------------------------------------------------*
0239.00 P #ChgDtFmt E
Binder Lanuage: - put this in file QSRVSRC in member F.DATE
0001.00 STRPGMEXP
0002.00 EXPORT SYMBOL(#VALIDDATE)
0006.00 EXPORT SYMBOL(#ChgDtFmt)
0007.00 ENDPGMEXP
For /COPY QSRVSRC,P.DATE: - put this code in a file called QSRVSRC in member
P.DATE
0001.00 D #ValidDate PR 1
0002.00 D PR_Date 8 0 VALUE
0003.00 D PR_Format 4 VALUE
0010.00 D #ChgDtFmt PR 8 0
0011.00 D Date 8 0 VALUE
0012.00 D FFormat 4 VALUE
0013.00 D TFormat 4 VALUE
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
