Walter, you would be correct to say it won't work. fixing a few things (hey, i didn't say it was tested;-)... IDENTIFICATION DIVISION. PROGRAM-ID. dtdf. REMARKS. Date-dif but using years months days as result. yes it's ambiguous, but not insurmountably - the result can be correct without being the only result possible, and correct is fuzzy anyway. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. HP3000 WITH DEBUGGING MODE. SPECIAL-NAMES. SW9 IS PARM64, ON STATUS IS KTP-IS-TESTING; CONDITION-CODE IS CONDISHUN-CODE. DATA DIVISION. WORKING-STORAGE SECTION. 01 jafemaapmajujuauseocnode value '312831303130313130313031'. 05 days pic 99 occurs 12. 01 date1. 05 d1ccyy pic 9999. 05 d1mm pic 99. 05 d1dd pic 99. 01 date2. 05 d2ccyy pic 9999. 05 d2mm pic 99. 05 d2dd pic 99. 01 diff. 05 dify pic 9999. 05 difm pic 99. 05 difd pic 99. PROCEDURE DIVISION. MAINL. display 'enter 1st of 2 dates, ccyymmdd format (all 0=3Dexit):' no advancing accept date1 if date1 =3D '00000000' goback end-if display 'enter later of 2 dates, ccyymmdd format:' no advancing accept date2 if date1 < date2 display 'please enter dates in ascending sequence' else if d1dd < d2dd subtract 1 from d1mm add days ( d1mm ) to d1dd if ( d1mm > 2 ) and ( d1ccyy / 4 * 4 =3D d1ccyy ) and not ( d1ccyy / 100 * 100 =3D d1ccyy )=09 * *d1 is a leap year (the 400 year test is omitted sorry) * *but the no-remainder integer divisibility tests work great: * *because the quotient is integer-resolved via truncation * *before the multiply happens, division precision is irrelevant. * *Dunno if leapyear test is even relevant, but cobol doesn't do 'maybe' add 1 to d1dd end-if end-if compute difd =3D d1dd - d2dd if d1mm < d2mm subtract 1 from d1ccyy add 12 to d1mm end-if compute difm =3D d1mm - d2mm compute dify =3D d1ccyy - d2ccyy display 'difference is ' dify ' years, ' difm ' months, ' difd ' days.' end-if GOBACK . works nicely ;-) Tracy Pierce, GGBHTD =20 > -----Original Message----- > From: HP-3000 Systems Discussion=20 > [mailto:HP3000-L@RAVEN.UTC.EDU] On Behalf Of Walter Murray > Sent: Wednesday, February 08, 2006 10:29 PM > To: HP3000-L@RAVEN.UTC.EDU > Subject: Re: HP COBOL routine to calculate the difference=20 > between 2 dates >=20 > I don't want to say that it doesn't work, but some of this code won't > compile with HP COBOL. >=20 > Also, I'd be leery of the check for leap year. I don't see where the > 100-year rule is being implemented, and it looks to me like=20 > the 400-year > check is backwards. >=20 > Also, be careful about using an arithmetic expression with=20 > division and > multiplication, to check for divisibility. This might work with HP > COBOL, but some compilers use more significant digits for intermediate > results in an arithmetic expression, so an expression like (yyyy / 4 * > 4) would always evaluate to true. >=20 > Walter =20 >=20 > Walter J. Murray >=20 >=20 > -----Original Message----- > From: HP-3000 Systems Discussion [mailto:HP3000-L@RAVEN.UTC.EDU] On > Behalf Of Tracy Pierce > Sent: Wednesday, February 08, 2006 2:49 PM > To: HP3000-L@RAVEN.UTC.EDU > Subject: Re: [HP3000-L] HP COBOL routine to calculate the difference > between 2 dates >=20 > Eben, I already sent you my arduously bullet-proofed dtdif=20 > routine, but > it calcs exact days. for the calc you requested, try >=20 > 01 jafemaapmajujuauseocnode value=20 > '312831303130313130313031'. > 05 days occurs 12. > 01 date1. > 05 d1ccyy pic 9999. > 05 d1mm pic 99. > 05 d1dd pic 99. > 01 date2. > 05 d2ccyy pic 9999. > 05 d2mm pic 99. > 05 d2dd pic 99. > 01 diff. > 05 dify pic 9999. > 05 difm pic 99. > 05 difd pic 99. >=20 >=20 > if date1 < date2 > display 'please enter dates in ascending sequence' > else > if d1dd < d2dd =20 > subtract 1 from d1mm > add days ( d1mm ) to d1dd > if ( d1mm > 2 or ( d1mm =3D 2 and d1dd > 28 )) > and ( d1ccyy / 4 * 4 =3D d1ccyy ) > and not ( d1ccyy / 400 * 400 =3D d1ccyy ) > * *d1 is a leap year; this is not pseudo code, it works. > add 1 to d1dd > end-if > end-if > compute difd =3D d1dd - d2dd > if d1mm < d2mm > subtract 1 from d1yy > add 12 to d1mm > endif > compute difm =3D d1mm - d2mm > compute dify =3D d1ccyy - d2ccyy > display 'difference is ' dify ' years, ' difm ' months, ' difd ' > days.' > end-if > . =20 >=20 >=20 > Tracy Pierce, GGBHTD >=20 > =20 >=20 > > -----Original Message----- > > From: Tracy Pierce=20 > > Sent: Wednesday, February 08, 2006 2:21 PM > > To: 'Eben Yong' > > Subject: RE: HP COBOL routine to calculate the difference=20 > > between 2 dates > >=20 > > see prior. after reading the explanation, it occurs to me=20 > > that it could be a lot simpler to state: > >=20 > > 01 date1 pic s9(9) comp. > > 01 date2 pic s9(9) comp. > > 01 diff pic s9(9) comp. > >=20 > > move 19530202 to date1 > > move 20060208 to date2 > > move zero to diff > > call dtdif using date1 date2 diff > > *diff holds my age in days. > >=20 > > or > >=20 > > move 19530202 to date1 > > move 0 to date2 > > move 365 to diff > > *date2 holds the date 365 days after date1. > >=20 > > > -----Original Message----- > > > From: HP-3000 Systems Discussion=20 > > > [mailto:HP3000-L@RAVEN.UTC.EDU] On Behalf Of Eben Yong > > > Sent: Wednesday, February 08, 2006 1:44 PM > > > To: HP3000-L@RAVEN.UTC.EDU > > > Subject: HP COBOL routine to calculate the difference=20 > > between 2 dates > > >=20 > > > I'm slightly embarrassed to even post this question, as I=20 > > > feel I should be=20 > > > able to produce this code in a snap, but for some reason my=20 > > > brain must be=20 > > > somewhat tired today. In any event, excuses aside, here is=20 > > > the question: > > >=20 > > > Would someone pls share their COBOL code that will calculate the=20 > > > difference between two given dates, and return the results in=20 > > > terms of=20 > > > years, months, and days? > > >=20 > > > For example, the difference between 20060125 and 20040611=20 > > is 1 year 7=20 > > > months and 14 days. =20 > > >=20 > > > Care to share? =20 > > > Thanks as always, > > > Eben Yong > > > Health Plan of San Mateo > > >=20 > > > * To join/leave the list, search archives, change list settings, * > > > * etc., please visit http://raven.utc.edu/archives/hp3000-l.html * > > >=20 > >=20 >=20 > * To join/leave the list, search archives, change list settings, * > * etc., please visit http://raven.utc.edu/archives/hp3000-l.html * >=20 > * To join/leave the list, search archives, change list settings, * > * etc., please visit http://raven.utc.edu/archives/hp3000-l.html * >=20 * To join/leave the list, search archives, change list settings, * * etc., please visit http://raven.utc.edu/archives/hp3000-l.html *

0 |

2/9/2006 3:51:57 PM