PL1 program to convert date into day of week using Zellers algorithm

/*================================================================= */
Zeller:proc(ccyy,mm,dd) returns(fixed bin(31));
/* 0=sat 1=sun 2=mon 3=tue 4=wed 5=thu 6=fri */

dcl   ccyy           fixed bin(31);
dcl   dd             fixed bin(31);
dcl   mm             fixed bin(31);
dcl   n1             fixed bin(31) init(000);
dcl   n2             fixed bin(31) init(000);
dcl   r              fixed bin(31) init(000);
dcl   wccyy          fixed bin(31) init(000);
dcl   wm             fixed bin(31) init(000);
dcl   wccyyd400      fixed bin(31) init(000);
dcl   wccyyd100      fixed bin(31) init(000);
dcl   zday_num       fixed bin(31) init(000);

       wccyy=ccyy ;
       wm=mm ;
       If wm < 3 then do;
          wm = wm + 12;
          wccyy = ccyy - 1;
          End;

       n1 = (wm + 1) * 26    / 10     ;
       n2 = wccyy    * 125   / 100    ;
       wccyyd400 = wccyy / 400;
       wccyyd100 = wccyy / 100;
       zday_num = wccyyd400 - wccyyd100 + dd + n1 + n2 ;

       r       = zday_num / 7;

       zday_num = zday_num - r * 7 ;

     return(zday_num);
  end Zeller;
/*================================================================= */

COBOL program to convert date into day of week using Zellers algorithm

 IDENTIFICATION DIVISION.
  PROGRAM-ID.    ZELLER.
  AUTHOR.        William Evers email:wevers@allmerica.com

******************************************************************
* --- COBOL 3 ---                                                *
* RECEIVE A DATE IN FORMAT CCYYMMDD AND RETURNS AN INTEGER       *
* THAT REPRESENTS THE DAY OF THE WEEK.                           *
* (BASED ON ZELLER'S ALGORITM)                                   *
* 1 = SUNDAY                                                     *
* 2 = MONDAY                                                     *
* 3 = TUESDAY                                                    *
* 4 = WEDNESDAY                                                  *
* 5 = THURSDAY                                                   *
* 6 = FRIDAY                                                     *
* 7 = SATURDAY                                                   *
******************************************************************
 ENVIRONMENT DIVISION.
  CONFIGURATION SECTION.
  INPUT-OUTPUT SECTION.
    FILE-CONTROL.

******************************************************************
 DATA DIVISION.
  FILE SECTION.
  WORKING-STORAGE SECTION.
    01 WS-CCYY                       PIC 9(04) COMP-3.
    01 WS-MM                         PIC 9(02) COMP-3.
    01 WS-N1                         PIC 9(10) COMP-3.
    01 WS-N2                         PIC 9(10) COMP-3.
    01 WS-DAY-INTEGER                PIC 9(10) COMP-3.
    01 WS-CCYYD400                   PIC 9(10) COMP-3.
    01 WS-CCYYD100                   PIC 9(10) COMP-3.

  LINKAGE SECTION.
    01 LK-CCYYMMDD.
       05  LK-CCYY                   PIC 9(4).
       05  LK-MM                     PIC 99.
       05  LK-DD                     PIC 99.
    01 LK-DAY                        PIC 9.

******************************************************************
 PROCEDURE DIVISION USING LK-CCYYMMDD
                          LK-DAY.
 0000-MAIN.

     IF LK-MM < 3
        COMPUTE WS-MM    = LK-MM + 12
        COMPUTE WS-CCYY  = LK-CCYY - 1
     ELSE
        MOVE LK-MM       TO WS-MM
        MOVE LK-CCYY     TO WS-CCYY
     END-IF

     COMPUTE WS-N1          = (WS-MM + 1) * 26 / 10
     COMPUTE WS-N2          = WS-CCYY * 125 / 100
     COMPUTE WS-CCYYD400    = WS-CCYY / 400
     COMPUTE WS-CCYYD100    = WS-CCYY / 100
     COMPUTE WS-DAY-INTEGER = WS-CCYYD400 - WS-CCYYD100
                            + LK-DD + WS-N1 + WS-N2
     COMPUTE LK-DAY         = FUNCTION REM (WS-DAY-INTEGER, 7)

    IF LK-DAY = 0
       MOVE 7 TO LK-DAY
    END-IF.

    EXIT PROGRAM.

****************************************************************