Calcular meses

[jorge.posadas]

Grupo

¿Alguno de uds. tiene una funciión donde calcule MESES entre 2 fechas, pero únicamente meses.

De antemano agradezco su ayuda.

[SvargasD]

Buen día, desde hace un tiempo yo utilizo la siguiente función:

Code: Select all

// Funcion para calcular la diferencia entre dos fechas, puede tetornar la diferencia en Años, Meses o Días
// fi = fecha inicial, ff = fecha final, dato = dato a retornar (A=Año, M=Mes, D=Dia)
FUNCTION dFechas (fi, ff, dato)
  
  LOCAL diferencia := 0, dA := 0, dM := 0, dD := 0
    
  dA = YEAR(ff) - YEAR(fi)
  dM = MONTH(ff) - MONTH(fi)
  dD = ff - fi
  dM = (dA * 12) + dM
  
  IF (DAY(ff) - DAY(fi) < 0)
    dM -= 1
  ENDIF
  
  SWITCH dato
    CASE "A"
      diferencia = dA
      EXIT
    CASE "M"
      diferencia = dM
      EXIT
    OTHERWISE
      diferencia = dD
      EXIT
  END
  
RETURN (diferencia)

En mi caso, las rutinas donde las ejecuto, pueden solicitar la diferencia en Años, Mes o Días. La diferencia en meses se basa tomando en cuenta los días de los parametros, es decir, 10/Feb/2023 a 09/Marzo/2023, te debe de retornar 0 meses, este comportamiento es el deseado para mí, pero puedes alterarlo si deseas la diferencia tomado un parametro de días. Otra cosa, la fecha final se espera que sea mayor a la fecha inicial, si es a la inversa, solo cambia los parametros.

[serge_girard]

Hi,

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.
It is not 100% precise so not suitable for accountancy or financial purposes!

Serge

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) )

[brunellopulix]

HI
Try this the tests i did look OK
Brunello

[serge_girard]

Brunello,

There is a small error: 08-11-1954 - 08-02-2023 gives anni 68, mesi 2 and giorni 31.
This should be anni 68 and mesi 3

Serge

[serge_girard]

08-02-1954 minus 08-02-2023 gives 68 anni and 12 mesi

I added this code at the end:

Code: Select all

IF nGiorni >= 31
   nGiorni := 0
   nMese++
ENDIF

IF nMese >= 12
   nMese := nMese-12
   nAnno++
ENDIF

08-02-1954 minus 08-02-2023 now gives 69 anni and 0 mesi!

For the time being is seems OK.

[serge_girard]

Need some test...

29-02-2024 - 01-03-2024 gives 0 !

[brunellopulix]

Serge
I rewrote the procedure and it seems to work correctly. Please do some tests to verify.
Thank you
Brunello

[jorge.posadas]

Grupo
Agradezco el interés por ayudarme, pero ya solucioné el problema con una de las opciones que amablemente me mandaron