Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Calc age in years+months+days - help, please
Message
De
09/07/1998 12:00:05
Ernie Veniegas
Micro System Solutions, Inc.
Calistoga, Californie, États-Unis
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Divers
Thread ID:
00115698
Message ID:
00115772
Vues:
14
Gerry:

Here's one I got from Cetin here on UT. He says it conforms to the standard for the medical industry in which he's involved. I like it a lot -- you can monkey with it so it's not so accurate as I have. Here's what I use.

Have fun.

**************

** From Cetin on the Universal Thread 1/30/98
*************
* AgeInYMD
* Parameters : tcdetail Degree of accuracy to return --
(i.e. Years, Years+Months, or Years+Months+Days)
* date DateOfBirth,
* date TargetDateToCalculateAge (If not passed date() assumed),
* array [array aYMD] if passed info placed in array also
*
* return : Age in YYYYMMDD format - like val(dtos) containing 0 values for MM,DD as needed
* Age in YYMMDD format, that is "x Years, y Months, and z Days old"
*************

function AgeInYMD

lparameters tcDetail, dBirthDate, dTargetDate, aYMD
if parameters() < 2
return {}
endif

if empty(dTargetDate)
dTargetDate = date()
endif

nYears = year(dTargetDate)-year(dBirthDate)

if gomonth(dBirthDate,nYears*12) > dTargetDate
nYears = nYears - 1
endif

dBirthDate = gomonth(dBirthDate,nYears*12)

nMonths = 0

do while month(dBirthDate) # month(dTargetDate)
dBirthDate = gomonth(dBirthDate,1)
nMonths = nMonths + 1
enddo

if day(dBirthDate) > day(dTargetDate)
nMonths = nMonths - 1
dBirthDate = gomonth(dBirthDate,-1)
endif

nDays = dTargetDate - dBirthDate

if type("aYMD") # "U"
dimension aYMD[3]
aYMD[1] = nYears
aYMD[2] = nMonths
aYMD[3] = nDays
endif

do case
case tcDetail = "Y"
return nYears
case tcDetail = "YM"
return nYears * 10^4 + nMonths
case tcDetail = "YMD"
return nYears * 10^4 + nMonths * 10^2 + nDays
endcase
Ernie Veniegas
Micro System Solutions
... sensible software by design
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform