1.  Home
  2. MIDRANGE-L
  3. October 2006

Re: Convert to RPG400

bob
The call to clp will kill performance in large batch process...
From 1992.... call the subroutine $date6 - it converts (in rpg) date to 
julian and
does date calc. This works for 20th, 21st century dates.
(this and other subroutines were the beginning of our y2k work)

jim franz

use font courier new  10 to get this lined up.
C*****************************************************************
C** $DATE6 - CALC # DAYS BETWEEN TWO DATES (CCYYMMDD)
C*
C* EXAMPLE            Z-ADDXXXXXX    #6#DA1           NEWEST
C*                    Z-ADDYYYYYY    #6#DA2           OLDEST
C*                    EXSR $DATE6
C*                    Z-ADD#6#DA3    ZZZZZZ
C* HISTORY
C*     Date    by   PROJ     Description of Modifications Made
C*   11/24/92  JLF  V1.00  - WRITTEN
C*
C**************************************************************************
C** $DATE6 - CALC # DAYS BETWEEN TWO DATES (CCYYMMDD)
C**************************************************************************
C*
C** FIELDS
C** #6#DA1 - 1ST DATE (CCYYMMDD)                      INPUT   8.0
C** #6#DA2 - 2ND DATE (CCYYMMDD)                      INPUT   8.0
C** #6#DA3 - DAYS BETWEEN TWO DATES                   OUTPUT  6.0
C** #6JULA - HOLD FIELD FOR 1ST DATE IN JULIAN        WORK    6.0
C** #6JULB - HOLD FIELD FOR 2ND DATE IN JULIAN        WORK    6.0
C**
CSR         $DATE6    BEGSR
C**
C** DEFINE INPUT/OUTPUT FIELDS
C                     Z-ADD#6#DA1    #6#DA1  80
C                     Z-ADD#6#DA2    #6#DA2  80
C                     Z-ADD#6#DA3    #6#DA3  60
C**
C** GET 1ST DATE JULIAN
C                     Z-ADD#6#DA1    #9JUL1
C                     EXSR $DATE9
C                     Z-ADD#9JUL2    #6JULA  60
C** GET 2ND DATE JULIAN
C                     Z-ADD#6#DA2    #9JUL1
C                     EXSR $DATE9
C                     Z-ADD#9JUL2    #6JULB  60
C** CALC # DAYS DIFFERENCE
C           #6JULA    SUB  #6JULB    #6#DA3
C**
CSR                   ENDSR

C*****************************************************************
C* @DATE9 - Convert CCYYMMDD TO JULIAN DATE
C*          BREAKDOWN DATE INTO SEPERATE FIELDS
C*
C* EXAMPLE            Z-ADDXXXXXX    #9JUL1           CCYYMMDD
C*                    EXSR $DATE9
C*                    Z-ADD#9JUL2    ZZZZZZ           JULIAN#
C* HISTORY
C*     Date    by   PROJ     Description of Modifications Made
C*   11/24/92  JLF  V1.00  - WRITTEN
C*
C*******************************************************************
C** $DATE9 - CALCULATE JULIAN DATE
C*******************************************************************
C*
C** FIELDS
C** #9JUL1 - DATE (CCYYMMDD) TO CALC JULIAN           INPUT   8.0
C** #9JUL2 - JULIAN DATE                              OUTPUT  6.0
C** #9MM   - MONTH                                    WORK    2.0
C** #9DD   - DAY                                      WORK    2.0
C** #9CCYY - CENTURY & YEAR                           WORK    4.0
C** #9MMDD - MONTH & DAY                              WORK    4.0
C** #9LEAP - # LEAP YEARS                             WORK    2.0
C** #9REMN - IF A LEAP YEAR                           WORK    2.0
C**
C           $DATE9    BEGSR
C**
C** DEFINE FIELDS
C                     Z-ADD#9JUL1    #9JUL1  80       CCYYMMDD
C                     Z-ADD#9JUL2    #9JUL2  60
C**
C** CALCULATE JULIAN DATE
C                     MOVEL#9JUL1    #9CCYY  40
C                     MOVEL#9JUL1    #9CC    20
C                     MOVE #9CCYY    #9CYY   30
C           #9CC      IFEQ 20
C                     MOVEL1         #9CYY
C                     ELSE
C                     MOVEL0         #9CYY
C                     END
C                     MOVE #9JUL1    #9MMDD  40
C                     MOVEL#9MMDD    #9MM    20
C                     MOVE #9MMDD    #9DD    20
C** MAKE MONTHS 3-12 INTO 4-13
C           #9MM      IFGT 02
C                     ADD  1         #9MM
C                     ELSE
C** TRANSFORM MONTHS 1-2 INTO 14-15 OF PREVIOUS YEAR
C                     ADD  13        #9MM
C                     SUB  1         #9CYY
C                     END
C** CONVERT YEARS TO DAYS
C           #9CYY     MULT 365.25    #9JUL2
C** CONVERT MONTHS TO DAYS
C           #9MM      MULT 30.6      #9MMDD
C** SUBTRACT MATHEMATICAL TRANSFORMATION AS DAYS
C                     SUB  63        #9MMDD
C                     ADD  #9MMDD    #9JUL2
C** ADD DAYS OF MONTH
C                     ADD  #9DD      #9JUL2
C**
C                     ENDSR
----- Original Message ----- From: "Bob O." <otis_the_cat@xxxxxxxxxxx> 
To: <midrange-l@xxxxxxxxxxxx>
Sent: Monday, October 02, 2006 8:12 AM
Subject: RE: Convert to RPG400



  There has to be some way in RPG400 to get the duration (in days) between
  two dates.

    ----------------------------------------------------------------------

    From:  "Hauser, Birgitta" <Birgitta.Hauser@xxxxxxxxxxx>
    Reply-To:  Midrange Systems Technical Discussion
    <midrange-l@xxxxxxxxxxxx>
To: "'Midrange Systems Technical Discussion'" <midrange-l@xxxxxxxxxxxx> 
    Subject:  RE: Convert to RPG400
    Date:  Mon, 2 Oct 2006 14:09:06 +0200
    >
    >Hi,
    >
    >You can't, at least not with pure RPG400!
    >Why do you want to translate back to a language that was not enhanced
    the
    >last 10 (or even more) years?
    >
    >If you really need it, why not simply compiling this program and call
    it
    >from your RPG400 programs?
>Another work around would be to use embedded SQL. But I suspect, if you 
    have
    >to use RPG400 it is not allowed to embed SQL, either.
    >
    >Birgitta
    >
    >-----Original Message-----
    >From: midrange-l-bounces@xxxxxxxxxxxx
    >[mailto:midrange-l-bounces@xxxxxxxxxxxx] On Behalf Of Bob O.
    >Sent: Monday, October 02, 2006 13:59
    >To: midrange-l@xxxxxxxxxxxx
    >Subject: Convert to RPG400
    >
    >    Does somebody know what the code for this should be if written in
    RPG400?
    >
    >    I need to convert this but can't figure out what I need to
    do.  Thanks.
    >
    >
    >
    >
    >
> ********************************************************************* 
    >          *  Definition Specifications
    >
> ********************************************************************* 
    >          *
    >         D ISODate1        S               D
    >         D ISODate2        S               D
    >          *
    >
> ********************************************************************* 
    >          *  Calculation Specifications
    >
> ********************************************************************* 
    >          *
    >         c     *Entry        Plist
    >         c                   Parm                    Date1
    8 0
    >         c                   Parm                    Date2
    8 0
    >         c
    Parm                    DAYS              5 0
    >          *
    >         c                   move      Date1         IsoDate1
    >         c                   move      Date2         IsoDate2
    >          *
    >         C     IsoDate1      SubDur    IsoDate2      Days:*D
    >          *
    >         c                   Eval      *Inlr = *On
    >--
>This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing 
    list
    >To post a message email: MIDRANGE-L@xxxxxxxxxxxx
    >To subscribe, unsubscribe, or change list options,
    >visit: http://lists.midrange.com/mailman/listinfo/midrange-l
    >or email: MIDRANGE-L-request@xxxxxxxxxxxx
    >Before posting, please take a moment to review the archives
    >at http://archive.midrange.com/midrange-l.
    >--
>This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing 
    list
    >To post a message email: MIDRANGE-L@xxxxxxxxxxxx
    >To subscribe, unsubscribe, or change list options,
    >visit: http://lists.midrange.com/mailman/listinfo/midrange-l
    >or email: MIDRANGE-L-request@xxxxxxxxxxxx
    >Before posting, please take a moment to review the archives
    >at http://archive.midrange.com/midrange-l.
    >
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list 
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.

As an Amazon Associate we earn from qualifying purchases.

This thread ...
Follow-Ups:
Replies:
Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.