2001-01-18 如何計算依指定日期計算該指定日期之ＷＥＥＫ ＮＯ？

2001-01-18 如何計算依指定日期計算該指定日期之ＷＥＥＫ ＮＯ？

QRPGLESRC WEEKNUMR RPGLE

      *--------------------------------------------------------------*
      * Vengoal Chang Development Resource               2001.01     *
      *                                                              *
      *                        \\\\\\\                               *
      *                       ( o   o )                              *
      *-------------------oOO----(_)----OOo--------------------------*
      *                                                              *
      * System name  . . . :   Technical Support                     *
      * Program name . . . :   WEEKNUMR                              *
      * Text . . . . . . . :   Caculate ISO 8601 Week number         *
      *                                                              *
      * Author . . . . . . :   Vengoal Chang                         *
      * Description. . . . :   ISO 8601 Week number test             *
      *                                                              *
      *                ooooO              Ooooo                      *
      *                (    )             (    )                     *
      *-----------------(   )-------------(   )----------------------*
      *                  (_)               (_)                       *
      *                                                              *
      * Create method :                                              *
      *        CRTRPGMOD MODULE(WEEKNUMR)                            *
      *                                                              *
      *--------------------------------------------------------------*

     H NoMain

      * Prototypes
     D DayOfWk         PR             1P 0
     D  InpDate                        D   Value

     D WkNum           PR             2P 0
     D  InpDate                        D

      * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
      * DayOfWk - Returns day of week where Monday = 0
     P DayOfWk         B                   Export

     D DayOfWk         PI             1P 0
     D  InpDate                        D   Value

      * Local variables
     D SomeMonday      S               D   Inz( D'1999-03-01' )
     D ElpsdDays       S             11P 0
     D WkNum           S             11P 0
     D RetDayOfWk      S              1P 0

      * Calculate day of week
     C     InpDate       SubDur    SomeMonday    ElpsdDays:*D
     C     ElpsdDays     Div       7             WkNum
     C                   MvR                     RetDayOfWk
     C                   If        RetDayOfWk < *Zero
     C                   Return    RetDayOfWk + 7
     C*                  Eval      RetDayOfWk = RetDayOfWk + 7 + 1
     C                   Else
     C                   Return    RetDayOfWk
     C*                  Eval      RetDayOfWk = RetDayOfWk + 1
     C                   EndIf

     C*                  Return    RetDayOfWk

     P DayOfWk         E

      * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
      * WkNum - Returns the ISO 8601 day of week
      * http://www.cl.cam.ac.uk/~mgk25/iso-time.html

      * Algorithm for Converting Gregorian Dates to ISO 8601 Week Date
      * http://personal.ecu.edu/mccartyr/ISOwdALG.txt

     P WkNum           B                   Export

     D WkNum           PI             2P 0
     D  InpDate                        D

      * Local variables
     D                 DS
     D Jan4                            D   Inz( D'1999-01-04' )
     D  J4Year                        4S 0 Overlay( Jan4 )

     D InpYear         S              4S 0

     D FirstMonday     S               D

     D Jan4DayOfWk     S              1P 0
     D ElpsdDays       S             11P 0

      * Construct a date which is January 4 of the desired year
     C                   Extrct    InpDate:*Y    InpYear
     C                   Eval      J4Year = InpYear

      * Construct the first monday of the ISO year by subtracting the
      * day of the week from the January 4 date.
     C                   Eval      Jan4DayOfWk = DayOfWk( Jan4 )
     C     Jan4          SubDur    Jan4DayOfWk:*DFirstMonday

      * If the input date is before the first monday of the current year
      * then we must construct the first monday of the prior year
     C                   If        InpDate < FirstMonday
     C                   Eval      J4Year = J4Year - 1
     C                   Eval      Jan4DayOfWk = DayOfWk( Jan4 )
     C     Jan4          SubDur    Jan4DayOfWk:*DFirstMonday
     C                   EndIf

      * To get the week number, subtract the first monday of the ISO
      * year from the input date and divide by 7. Adding 1 to that
      * result (since 0 actually means the first week) gives us
      * the week number
     C     InpDate       SubDur    FirstMonday   ElpsdDays:*D
     C                   Return    ( ElpsdDays / 7 ) + 1

     P WkNum           E

====================================================================
QRPGLESRC WEEKNUMRT RPGLE

      *--------------------------------------------------------------*
      * Vengoal Chang Development Resource               2001.01     *
      *                                                              *
      *                        \\\\\\\                               *
      *                       ( o   o )                              *
      *-------------------oOO----(_)----OOo--------------------------*
      *                                                              *
      * System name  . . . :   Technical Support                     *
      * Program name . . . :   WEEKNUMRT                             *
      * Text . . . . . . . :   ISO 8601 Week number test             *
      *                                                              *
      * Author . . . . . . :   Vengoal Chang                         *
      * Description. . . . :   ISO 8601 Week number test             *
      *                                                              *
      *                ooooO              Ooooo                      *
      *                (    )             (    )                     *
      *-----------------(   )-------------(   )----------------------*
      *                  (_)               (_)                       *
      *                                                              *
      * Create method :                                              *
      *        CRTRPGMOD MODULE(WEEKNUMR)                            *
      *        CRTRPGMOD MODULE(WEEKNUMRT)                           *
      *        CRTPGM    PGM(WEEKNUMRT) MODULE(WEEKNUMRT WEEKNUMR)   *
      *                                                              *
      * Usage Sample :                                               *
      *              Call WEEKNUMRT '2001-01-01'                     *
      *                                                              *
      *--------------------------------------------------------------*

     H DEBUG  OPTION(*SRCSTMT:*NODEBUGIO)

     D                 DS
     D DateIso                         D
     D  Year                          4    Overlay( DateIso )

     D IsoDayOfWk      S              1  0
     D WKnumn          S              2  0
     D TempS           S             50

     D DayOfWk         PR             1P 0
     D  InpDate                        D   Value

     D WkNum           PR             2P 0
     D  InpDate                        D

     C     *entry        plist
     C                   parm                    DateIsoC         10

     C                   Movel     DateIsoC      DateISO
      *
      * DayOfWk - Returns day of week where Monday = 0
      * But ISO 8601 define Monday =1, Thuresday =2, ... Sunday =7.
      * So need add 1 to IsoDayOfWk.
      *
     C                   Eval      IsoDayOfWk = DayofWk(DateIso) + 1
     C                   Eval      WkNumn     = WkNum(DateIso)

     C                   Extrct    DateIso:*Y    Year
     C                   Move      WkNumn        WkNumC            2
     C                   Eval      Temps = DateIsoC + ' ' + Year + '-W' +
     C                                     WkNumC      +'-' +
     C                                     %trim(%Editc((IsoDayofWk):'Z'))
     C     TempS         Dsply

     C                   Eval      *InLr = '1'