lunes, 22 de octubre de 2012

RPGLE --Rutina devuelve numeros de dias hábiles por rango de fecha


                                                                
                                             
      *-********************************************************************
      *-
      *- Rutina devuelve numeros de dias hábiles por rango de fecha
      *-
      *- Realizado por el Ingeniero:
      *-
      *-            --**  Leonardo Arévalo  **--
      *-            --**   27-08-2007       **--
      *-
      *-
      *-********************************************************************
     H DATEDIT(*DMY) DECEDIT(',') DATFMT(*EUR)
     FRVPF01    IF   E           K DISK
     D XFEC1           S               D   DATFMT(*EUR)
     D XFEC2           S               D   DATFMT(*EUR)
     D pdiahab         s              3p 0
     D des             s              8A
     D has             s              8A
     D diasht          s              3A
     D                 DS
     D xfecha1                 1      8  0
     D  diad                   1      2  0
     D  mesd                   3      4  0
     D  anod                   5      8  0
     D                 DS
     D xfecha2                 1      8  0
     D  diah                   1      2  0
     D  mesh                   3      4  0
     D  anoh                   5      8  0
     D                 DS
     D xfechab                 1      8  0
     D  diaa                   1      2  0
     D  mesa                   3      4  0
     D  anoa                   5      8  0
     d*
     C     *ENTRY        PLIST
     C                   PARM                    DES
     C                   PARM                    HAS
     C                   PARM                    DIASHT
     c
     C     KEYB          KLIST
     C                   KFLD                    ANOA
     C                   KFLD                    MESA
     C                   KFLD                    DIAA
      *--
     c                   move      des           xfecha1
     c                   move      has           xfecha2
      *--
     C     *EUR          MOVE      xfecha1       XFEC1
     C     *EUR          MOVE      xfecha2       XFEC2
      *--
     C                   Z-ADD     0             pDIAHAB
     C
     C                   DOW       XFEC1<XFEC2
     C
     C                   MOVE      XFEC1         xfechab
     c
     C     KEYB          CHAIN     RVPF01
     C                   IF        %FOUND(RVPF01)
     C                   ADD       1             pDIAHAB
     C                   ENDIF
     C
     C     XFEC1         ADDDUR    1:*D          XFEC1
     C
     C                   ENDDO
     C
     C                   MOVE      pDIAHAB       DIASHT
     C
     C                   seton                                        lr
     c                   return 

0 comentarios :

Publicar un comentario