星期二, 10月 31, 2023

2001-04-10 如何於 CL 中取得指定日期為星期幾 ?


如何於 CL 中取得指定日期為星期幾 ?

FILE : QCLSRC
Member:DayOfWeeKC
Type: CLLE

             PGM    (&Date)

             DCL    &Date         *Char  10
             DCL    &LDateB       *Char   4    /* Binary */
             DCL    &LDateN       *Dec   15 0  /* Decimal*/
             DCL    &DAYARRAY     *CHAR  63 +
                          ('Sunday   Monday   Tuesday  +
                          WednesdayThursday Friday   Saturday ')
             DCL    &IndexB       *Char   4    /* Binary */
             DCL    &IndexN       *Dec   15 0  /* Decimal*/
             DCL    &Start        *Dec   15 0  /* Decimal*/
             DCL    &DayOfWeek    *Char   9
             DCL    &Msg          *Char 100

             DCL     &msgid   *CHAR 7
             DCL     &msgf    *CHAR 10
             DCL     &msgflib *CHAR 10
             DCL     &msgdta  *CHAR 100

             MONMSG     CEE0000  EXEC(GOTO ERROR)
             MONMSG     CPF0000  EXEC(GOTO ERROR)

             CALLPRC 'CEEDAYS' (&Date        +
                                'MM/DD/YYYY' +
                                &LDateB      +
                                *OMIT)

     /* Convert to Dayofweek */
     /* For the day of week, 1 indicates Sunday, 2 indicates Monday, */
     /* 7 indicates Saturday.                                        */
             CALLPRC 'CEEDYWK' (&LDateB +
                                &IndexB +
                                *OMIT)

             CHGVAR &IndexN    %BIN(&IndexB)
             CHGVAR &Start     (&IndexN * 9 - 8)
             CHGVAR &DayOfWeek %SST(&DayArray &Start 9)

             SNDPGMMSG  MSG(&DATE |> 'Falls on' |> &DAYOFWEEK |< +
                          '.') TOPGMQ(*PRV *PGMBDY)

             Return
/*==================================================================*/
/* Error processing routine                                         */
/*==================================================================*/
ERROR:       RCVMSG     MSGTYPE(*LAST)               +
                        MSGDTA(&msgdta)              +
                        MSGID(&msgid)                +
                        MSGF(&msgf)                  +
                        SNDMSGFLIB(&msgflib)
          /* Prevent loop, just in case           */
             MONMSG     CPF0000
             SNDPGMMSG  MSGID(&msgid)                +
                        MSGF(&msgflib/&msgf)         +
                        MSGDTA(&msgdta)              +
                        MSGTYPE(*ESCAPE)
          /* Prevent loop, just in case           */
             MONMSG     CPF0000

             ENDPGM
      


使用說明

1. CRTBNDCL (DayofWeekc) DFTACTGRP(*NO)

2. 使用方法:

 CALL DayOfWeekC '04/09/2001' 
 

沒有留言: