I made a small variaton on SvargasD demo...
I will calculate a bit more precise number of years, months and days.
It will return the difference between two (complete dates) in number of years + number remaining months + number of remaining days.
Code: Select all
#INCLUDE "hmg.ch"
FUNCTION MAIN()
/**************/
SET DATE TO FRENCH
SET CENTURY ON
SET PRINTER TO C:\test\DAT.TXT
SET PRINTER ON
SET CONSOLE OFF
xFI := '08-11-1992'
xFF := '04/02/1985'
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := '1992' // error
xFF := '04/02/1985'
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/03/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/04/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/05/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/08/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/11/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/1954')
xFF := CTOD('04/12/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/01/1954')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/11/2024')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFF := CTOD('08/11/2024')
xFI := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('08/01/2022')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('04/02/2023')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('01/02/2023')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('01/01/2023')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('24/03/2023')
xFF := CTOD('04/02/2023')
aOUT := ZCALC_MONTHS(xFI, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
xFI := CTOD('24/03/2023')
xFI2 := CTOD('24/03/2024')
xFF := CTOD('04/02/2022')
FOR A := xFI TO xFI2
aOUT := ZCALC_MONTHS(A, xFF)
? xFI, xFF, aOUT[1,1], aOUT[1,2], aOUT[1,3]
?'********************************'
NEXT
QUIT
FUNCTION ZCALC_MONTHS(dFI, dFF)
/*********************************/
LOCAL aOUT := {}, dA, dD, nJR, nJX, dFIX, dD2, nMD
IF VALTYPE(dFI) == 'C'
IF LEN(dFI) == 10
dFI := CTOD(dFI)
ELSE
// ERROR
AADD(aOUT, {999999,999999,999999})
RETURN aOUT
ENDIF
ENDIF
IF VALTYPE(dFF) == 'C'
IF LEN(dFF) == 10
dFF := CTOD(dFF)
ELSE
// ERROR
AADD(aOUT, {999999,999999,999999})
RETURN aOUT
ENDIF
ENDIF
//?'ZCALC_MONTHS', dFI, dFF, xOUT
dA := YEAR(dFF) - YEAR(dFI)
dD := dFF - dFI
IF dD < 0
dx1 := dFI
dFI := dFF
dFF := dx1
dD := dFF - dFI
ENDIF
DO CASE
CASE dD == 0
//? 'CASE 1 DATES ARE EQUAL'
AADD(aOUT, {0,0,0})
RETURN aOUT
CASE dD > 0
nJR := 0
ndD := dD
DO WHILE ndD >= 365
ndD := ndD - 365.25 /// 365.25 <---> 365
nJR++
ENDDO
nJX := YEAR(dFI)
//? 'CASE 31-2', nJR, ndD
dFIX := DTOC(dFI)
//? 'CASE 31-2 dFIX', dFIX
nJX := nJX + nJR
dFIX := SUBSTR(dFIX,1,6) + STRVALUE(nJX)
//? 'CASE 31-3 dFIX', dFIX
dFIX := CTOD(dFIX)
//? 'dFF - dFIX', dFF - dFIX
dD2 := dFF - dFIX
IF dFIX > dFF
nJX := nJX - 1
dFIX := SUBSTR(dFIX,1,6) + STRVALUE(nJX)
//? 'CASE 31-4 dFIX', dFIX
dFIX := CTOD(dFIX)
dD2 := dFF - dFIX
//? 'dD2', dD2
ENDIF
nMD := 0
//ndD := dD
DO WHILE dD2 >= 31
dD2 := dD2 - 30.44 /// 30.44 <---> 31
nMD++
ENDDO
//? 'CASE 31-3', nJR, nMD, dD2
AADD(aOUT, {nJR, nMD, INT(dD2)})
OTHERWISE
ENDCASE
/*
?'=================================='
?
?
?
*/
RETURN aOUT
FUNCTION STRVALUE( string )
/*********************************/
LOCAL retval := ''
DO CASE
CASE VALTYPE( string ) = 'C'
retval := ALLTRIM(string)
CASE VALTYPE( string ) = 'N'
retval := LTRIM( STR( string ) )
CASE VALTYPE( string ) = 'M'
retval := IF( (LEN(string) > (MEMORY(0) * 1024) * .80), ;
SUBSTR(string,1, INT((MEMORY(0) * 1024) * .80)), ;
string )
CASE VALTYPE( string ) = 'D'
retval := DTOC( string )
CASE VALTYPE( string ) = 'L'
retval := IIF(string, "True", "False")
OTHERWISE
retval := ''
ENDCASE
RETURN( ALLTRIM(retval) )