H*³                                                               Ä
     H*³ Ä                                                           ³ Ä
     H*³ ÀAPLICACION..Ä GEBADA (GEstor de BAse de DAtos)             ³ Ä
     H*³ Ä                                                           ³ Ä
     H*³ ÀDESCRIPCION.Ä C lculo de fechas hacia adelante             ³ Ä
     H*³ Ä                                                           ³ Ä
     H*³ ÀANALISTA....Ä Juan Ram¢n Garcia                            ³ Ä
     H*³ ÀPROGRAMADOR.Ä Juan Ram¢n Garcia       ÀFECHA:Ä 22/06/95    ³ Ä
     H*³ Ä                                                           ³ Ä
     H*³ Ÿ COPYRIGHT.ÄJuan Ram¢n Garcia - 1.995Ä                   ³ Ä
     H*
     E*
     E                    DCM    12  12  2 0             DIAS DE CADA MES
     E*
     I*
     I** DESGLOSE DE LA FECHA DE ORIGEN
     I            DS
     I                                        1   80FECHA
     I                                        1   20DIA
     I                                        3   40MES
     I                                        5   80A¥O
     I                                        7   80A¥O1
     I                                        1   2 XXDIA
     I                                        3   4 XXMES
     I                                        5   8 XXA¥O
     I                                        7   8 XXA¥O1
     I*
     C*
     C** DEFINICION DE PARAMETROS
     C           *ENTRY    PLIST
     C                     PARM           P1FECH  80       FECHA
     C                     PARM           P1FORM  4        FORMATO
     C                     PARM           P1DIAS  50       DIAS A SUMAR
     C                     PARM           P1DIA   20       DIA (SALIDA)
     C                     PARM           P1MES   20       MES (SALIDA)
     C                     PARM           P1A¥O   40       A¥O (SALIDA)
     C                     Z-ADD0         P1DIA
     C                     Z-ADD0         P1MES
     C                     Z-ADD0         P1A¥O
     C                     Z-ADD0         FECHA
     C                     MOVELP1FECH    XXFECH  8
     C**
     C** COMPRUEBA EL FORMATO DE LA FECHA
     C**
B01  C                     SELEC
X01  C           P1FORM    WHEQ 'DMAA'
     C                     Z-ADDP1FECH    FECHA
X01  C           P1FORM    WHEQ 'AAMD'
     C                     MOVELXXFECH    XXA¥O
     C           2         SUBSTXXFECH:5  XXMES
     C                     MOVE P1FECH    XXDIA
X01  C           P1FORM    WHEQ 'MDAA'
     C                     MOVELXXFECH    XXMES
     C           2         SUBSTXXFECH:3  XXDIA
     C                     MOVE XXFECH    XXA¥O
X01  C           P1FORM    WHEQ 'DMA '
     C                     MOVELXXFECH    FECHA
     C           2         SUBSTXXFECH:5  XXA¥O1
     C                     EXSR CAMA¥O
X01  C           P1FORM    WHEQ 'AMD '
     C                     MOVELXXFECH    XXA¥O1
     C           2         SUBSTXXFECH:3  XXMES
     C           2         SUBSTXXFECH:5  XXDIA
     C                     EXSR CAMA¥O
X01  C           P1FORM    WHEQ 'MDA '
     C                     MOVELXXFECH    XXMES
     C           2         SUBSTXXFECH:3  XXDIA
     C           2         SUBSTXXFECH:5  XXA¥O1
     C                     EXSR CAMA¥O
X01  C           P1FORM    WHEQ ' DMA'
     C           2         SUBSTXXFECH:3  XXDIA
     C           2         SUBSTXXFECH:5  XXMES
     C                     MOVE XXFECH    XXA¥O1
     C                     EXSR CAMA¥O
X01  C           P1FORM    WHEQ ' AMD'
     C           2         SUBSTXXFECH:3  XXA¥O1
     C           2         SUBSTXXFECH:5  XXMES
     C                     MOVE XXFECH    XXDIA
     C                     EXSR CAMA¥O
X01  C           P1FORM    WHEQ ' MDA'
     C           2         SUBSTXXFECH:3  XXMES
     C           2         SUBSTXXFECH:5  XXDIA
     C                     MOVE XXFECH    XXA¥O1
     C                     EXSR CAMA¥O
X01  C                     OTHER
     C                     GOTO FINAL
E01  C                     ENDSL
     C**
     C** CALCULA NUEVA FECHA
     C**
     C** SI EL MES INICIAL ES ENERO/FEBRERO COMPRB.SI ES A¥O BISIESTO
B01  C           MES       CASLE2         COMA¥O
E01  C                     ENDCS
     C** CALCULA TOTAL DIAS (DIA INICIAL MAS DIAS A SUMAR)
     C                     ADD  DIA       P1DIAS
     C** SI EL DIA ES MAYOR QUE LOS DIAS DE ESE MES PASA AL MES SIGUIENTE
B01  C           P1DIAS    DOWGTDCM,MES
     C                     SUB  DCM,MES   P1DIAS
     C                     ADD  1         MES
     C** SI EL MES ES SUPERIOR A DOCE PASA AL A¥O SIGUIENTE
B02  C           MES       IFGT 12
     C                     Z-ADD1         MES
     C                     ADD  1         A¥O
     C                     EXSR COMA¥O
E02  C                     ENDIF
E01  C                     ENDDO
     C** DESGLOSA LA NUEVA FECHA EN DD MM AAAA
     C                     Z-ADDP1DIAS    P1DIA
     C                     Z-ADDMES       P1MES
     C                     Z-ADDA¥O       P1A¥O
     C**
     C** SALIDA DEL PROGRAMA (SIN DESCARGARLO)
     C**
     C           FINAL     TAG
     C                     RETRN
     C*                                                               *
     C**                                                             **
     C***                                                           ***
     C*****************************************************************
     C*****            S  U  B  R  U  T  I  N  A  S               *****
     C*****************************************************************
     C***                                                           ***
     C**                                                             **
     C*                                                               *
     C*****************************************************************
     C*****      RUTINA DE CAMBIO DE A¥O DE 2 A 4 DIGITOS         *****
     C*****************************************************************
     C           CAMA¥O    BEGSR
B01  C           A¥O1      IFGT 50
     C                     MOVEL'19'      XXA¥O
X01  C                     ELSE
     C                     MOVEL'20'      XXA¥O
E01  C                     ENDIF
     C                     ENDSR
     C*****************************************************************
     C*****       RUTINA DE COMPROBACION DE A¥O BISIESTO          *****
     C*****************************************************************
     C           COMA¥O    BEGSR
B01  C           A¥O1      IFEQ 0                          PRINC.SIGLO
     C                     MOVELA¥O       A¥OBIS  20
X01  C                     ELSE                            A¥O NORMAL
     C                     MOVE A¥O       A¥OBIS
E01  C                     ENDIF
     C                     DIV  4         A¥OBIS
     C                     MVR            A¥OBIS
B01  C           A¥OBIS    IFEQ 0                          BISIESTO
     C                     Z-ADD29        DCM,2
X01  C                     ELSE                            NO BISIESTO
     C                     Z-ADD28        DCM,2
E01  C                     ENDIF
     C                     ENDSR
** SERIE CON LOS DIAS DE CADA MES
312831303130313130313031