Subtracting Julian Dates

Troubleshooting

Problem

This document explains how a CL program takes the Julian date and subtracts a certain number of days from it to determine an earlier date; for example, subtracting 60 days to get a date. At the beginning of each year, this becomes a problem.

Resolving The Problem

The following CL program takes the Julian date and subtracts a certain number of days from it to determine an earlier date; for example, subtracting 60 days to get a date. At the beginning of each year, this becomes a problem. Subtracting 60 days from a Julian date of 01001 (January 1, 2001) produces a value of 00941 which is the 941st day in the year 2000 and is not valid.

Disclaimer: This is an example only. IBM® accepts no responsibility for its correctness.

Notes:

1.	This program does not work if the current year ends in 00 nor does it take into effect nonleap years ending in 00.
2.	The following CL program also takes leap years into account.

Example CL JULDTE1

/* THIS PGM TAKES A DATE (CURRENT IF THE RTVSYSVAL IS UN-COMMENTED), CHANGES  */
/* IT TO JULIAN, THEN SUBTRACTS 60 DAYS.  IT TESTS FOR TIMES IN WHICH THE     */
/* DATE GOES INTO THE PREVIOUS YEAR, WHICH WILL RESULT IN AN INVALID JULIAN   */
/* DATE, SUCH AS 00949.  IF THIS TAKES PLACE, IT CALCULATES THE ACTUAL DATE   */
/* IN JULIAN FORMAT, TAKING INTO EFFECT IF THE PREVIOUS YEAR WAS A LEAP YEAR. */
/* THIS PGM WORKS, AS LONG AS IT IS NOT CURRENTLY YEAR 00.*/

             PGM
             DCL        VAR(&DATE) TYPE(*CHAR) LEN(6) VALUE('010904')
             DCL        VAR(&JULDATE) TYPE(*CHAR) LEN(5)
             DCL        VAR(&JULDATE2) TYPE(*DEC) LEN(5 0)
             DCL        VAR(&JULDATE3) TYPE(*CHAR) LEN(5)
             DCL        VAR(&YEAR) TYPE(*CHAR) LEN(2)
             DCL        VAR(&YEARDEC) TYPE(*DEC) LEN(2 0)
             DCL        VAR(&TEST) TYPE(*DEC) LEN(3 0)
             DCL        VAR(&TEST2) TYPE(*DEC) LEN(3 0)
             DCL        VAR(&TEST3) TYPE(*CHAR) LEN(3)
             DCL        VAR(&X) TYPE(*DEC) LEN(4 2)
             DCL        VAR(&Y) TYPE(*CHAR) LEN(4)
             DCL        VAR(&Z) TYPE(*DEC) LEN(1 0)
             RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&DATE)
             CVTDAT     DATE(&DATE) TOVAR(&JULDATE) TOFMT(*JUL) TOSEP(*NONE)
             CHGVAR     VAR(&JULDATE2) VALUE(&JULDATE)
             CHGVAR     VAR(&JULDATE2) VALUE(&JULDATE2 - 60)
             CHGVAR     VAR(&JULDATE3) VALUE(&JULDATE2)
             CHGVAR     VAR(&YEAR) VALUE(%SST(&JULDATE3 1 2))
             CHGVAR     VAR(&YEARDEC) VALUE(&YEAR)
             CHGVAR     VAR(&TEST) VALUE(%SST(&JULDATE3 3 3))
             CHGVAR     VAR(&X) VALUE(&YEARDEC / 4)
             CHGVAR     VAR(&Y) VALUE(&X)
             CHGVAR     VAR(&Z) VALUE(%SST(&Y 3 1))
             IF         COND(&Z *EQ 0) THEN(DO)
                IF         COND(&TEST *GT 366) THEN(DO)
                   CHGVAR     VAR(&TEST) VALUE(1000 - &TEST)
                   CHGVAR     VAR(&TEST2) VALUE(366 - &TEST)
                   CHGVAR     VAR(&TEST3) VALUE(&TEST2)
                   CHGVAR     VAR(&JULDATE3) VALUE(&YEAR || &TEST3)
                ENDDO
             ENDDO
             IF         COND(&Z *NE 0) THEN(DO)
                IF         COND(&TEST *GT 365) THEN(DO)
                   CHGVAR     VAR(&TEST) VALUE(1000 - &TEST)
                   CHGVAR     VAR(&TEST2) VALUE(365 - &TEST)
                   CHGVAR     VAR(&TEST3) VALUE(&TEST2)
                   CHGVAR     VAR(&JULDATE3) VALUE(&YEAR || &TEST3)
                ENDDO
             ENDDO
             SNDPGMMSG  MSG('Current Date' *BCAT &DATE)
             SNDPGMMSG  MSG('Julian Date' *BCAT %CHAR(&TEST))
             ENDPGM

Compile using CRTBNDCL

> call juldate1
Current Date 111824
Julian Date 263

[{"Type":"MASTER","Line of Business":{"code":"LOB68","label":"Power HW"},"Business Unit":{"code":"BU070","label":"IBM Infrastructure"},"Product":{"code":"SWG60","label":"IBM i"},"ARM Category":[{"code":"a8m3p0000006x8GAAQ","label":"CL"},{"code":"a8m0z0000000CHtAAM","label":"Programming ILE Languages"}],"ARM Case Number":"","Platform":[{"code":"PF012","label":"IBM i"}],"Version":"All Versions"}]

Historical Number

22045425

Was this topic helpful?

Document Information

Modified date:
18 November 2024

UID

nas8N1017535

Tips