Validate a date whether it is a valid Gregorian date using COBOL function

TEST-DATE-YYYYMMDD function tests whether a date in form (YYYYMMDD) is a valid date in the Gregorian calendar. 

Argument to this function must be an integer and it should be of the form YYYYMMDD.

Function returns following values

• If the value of argument is less than 16010000 or greater than 99999999, the returned value is 1,which means the year is not within the range of 1601 to 9999.
• Returned value is 2, when the month is not within the range of 1 to 12.
• Returned value is 3, when the day is not valid for the given year and month.
• Otherwise, the returned value is 0 (zero) , which means the date is valid.

Sample COBOL code is below

        IDENTIFICATION DIVISION.                                   

        PROGRAM-ID. DTCONV.                                        

        ENVIRONMENT DIVISION.                                      

        CONFIGURATION SECTION.                                     

        SPECIAL-NAMES.                                             

        INPUT-OUTPUT SECTION.                                      

        FILE-CONTROL.                                              

        DATA DIVISION.                                             

        FILE SECTION.                                              

        WORKING-STORAGE SECTION.                                   

        01 WS-WORK-AREA.                                           

           05 WS-GREG-DATE                  PIC  9(10).            

        01 RC PIC 9(5).                                            

        PROCEDURE DIVISION.                                        

******** Example 1                                                 

******** returns 0 because the date is valid                       

            MOVE 19950215 TO WS-GREG-DATE                          

            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE) 

            DISPLAY RC                                                  

******** Example 2                                                      

******** returns 1 because the year is invalid and the value of argument

******** is less than 16010000.                                         

            MOVE 12950215 TO WS-GREG-DATE                               

            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      

            DISPLAY RC                                                  

******** Example 3                                                      

******** returns 1 because the year is invalid and the value of argument

******** is greater than 99999999.                                      

            MOVE 912950215 TO WS-GREG-DATE                              

            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      

            DISPLAY RC                                                  

******** Example 4                                                      

******** returns 2 because the month is not within the range            

******** of 1 to 12                                                     

            MOVE 19921415  TO WS-GREG-DATE                              

            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      

            DISPLAY RC                                                  

******** Example 5                                                      

******** returns 3 because the day is invalid                         

            MOVE 19950240  TO WS-GREG-DATE                              

            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      

            DISPLAY RC                                                  

How to pass data to a program present many levels down the calling chain

Let us say we have below calling chain

Program A --> Program B ---> Program C ---> Program D --> Program E

And we want to pass data from "Program B" to "Program E"

We can pass data between programs using Files, DB2 tables, Linkage section, TSQs(in case of CICs) etc.

There is another way. We can create a simple program to act as a cache. This technique works well in both online and batch environments.

Here I am using a sub program called "CACHEPGM" as a cache. 

       IDENTIFICATION DIVISION.  

       PROGRAM-ID.    CACHEPGM.

       ENVIRONMENT DIVISION. 

       DATA DIVISION.       

       WORKING-STORAGE SECTION.  

       01 WS-SAVE-DATA PIC X(80) VALUE SPACES. 

       LINKAGE SECTION.                        

       01 LS-PARAMETERS.  

          05 LS-FUNC          PIC X(4) VALUE SPACES. 

               88 LS-SET-DATA           VALUE 'SET'.  

               88 LS-GET-DATA           VALUE 'GET'.      

           05 LS-DATA         PIC X(80). 

       PROCEDURE DIVISION USING LS-PARAMETERS. 

           EVALUATE TRUE  

             WHEN LS-SET-DATA  

               MOVE LS-DATA      TO WS-SAVE-DATA   

             WHEN LS-GET-DATA 

               MOVE WS-SAVE-DATA TO LS-DATA  

           END-EVALUATE   

           GOBACK.    

From "Program B" invoke CACHEPGM with SET parameter and data to be stored in the cache.

From "Program E" invoke CACHEPGM with GET parameter and to retrieve the data stored in the working storage section of CACHEPGM.

Useful ESP commands

Below are some of the useful CA ESP scheduler commands

AJ ALL APPL(TESTFASD.1155) HOLD                     

- HOLD operand stops submission of jobs in the application and places the application in APPLHOLD status.

AJ ALL APPL(TESTFASD.1155) RELEASE                  

- Releases an application (removes it from APPLHOLD status)

AJ ALL APPL(TESTFASD.1155) UNWAIT                   

- Removes an application from APPLWAIT status

AJ ALL APPL(TESTFASD.1155) WITHDRAW                 

- WITHDRAW ENTIRE APPL                                     

AJ ALL APPL(TESTFASD.1155) COMPLETE                 

- Completes All the jobs in the application once there are no APPLHOLD and APPLWAIT conditions on it

AJ ALL APPL(TESTFASD.1155) TERMINATE                

- Completes an application immediately. CA WA ESP Edition removes any APPLHOLD and APPLWAIT conditions 

DELETE CYBER.PAYROLL                                

- Delete an Event

AJ TESTCGP HOLD APPL(TESTPCPM.624)                  

- MANHOLD A JOB called TESTCGP                                 

AJ TESTCGP DROPRES APPL(TESTPCPM.624)               

- Removes all resource requirements for TESTCGP  job

AJ TESTCGP READY APPL(TESTPCPM.624)                 

- Removes all job dependencies (except resources) from TESTCGP job (including time, predecessors, manual hold)

AJ TESTBIP  RELEASE APPL(TEST1MCW.534)              

- RELEASE MANFOLD for TESTBIP JOB    

AJ TESTMZ26 COMPLETE APPL(TESTCCBP.007)             

- FORCE COMPLETE TESTMZ26 JOB     

AJ TESTMZ26 WITHDRAW APPL(TESTCCBP.007)             

- WITHDRAW TESTMZ26 JOB     

AJ TESTMZ26 DROPDEP  APPL(TESTCCBP.007)             

- Drops all predecessor relationships for TESTMZ26 job

AJ TESTMZ26 BYPASS APPL(TESTCCBP.007)               

- Indicates that TESTMZ26 job is no longer required. As soon as the dependencies are met, the job is bypassed. Successor jobs are posted as in a normal job completion. If a job is bypassed, it can be unbypassed at any time up to submission.

AJ TESTMZ26 UNBYPASS APPL(TESTCCBP.007)            

 - Indicates that a job must no longer be bypassed.

AJ TESTR71P REQUEST APPL(TESTORG1.028)              

- TO REQUEST A JOB          

AJ TESTR71P UNREQUEST APPL(TESTORG1.028)            

- Specifies that an on-request job is no longer required

AJ TESTAGET RESET DELAYSUB(RESET) APPL(TESTAGET.12) 

- DROP TIME WAIT                                

AJ PAYJOB7 RESET DELAYSUB('9PM') APPL(PAYROLL.0)    

-  resets PAYJOB7's delayed submission time to 9 pm

AJ PAYJOB8 RESET LATEEND(RESET) APPL(PAYROLL.1)       

 -  removes a job's dueout time. CA WA ESP Edition no longer considers the job overdue if the job has not ended by the late end time specified in the job definition

AJ PAYJOB7 RESET EXPECTEDSTART('2PM') APPL(PAYROLL.3)  

-  sets the expected start time to 2PM for job PAYJOB7 in generation 3 of the PAYROLL application:

AJ PAYJOB8 HOLD REASON('WAITING FOR TAPE 09999') APPL(PAYROLL.0)

-     holds a job with a reason

AJ PAYJOB8 RELEASE REASON(.) APPL(PAYROLL.0)       

 -  releases a job and resets the reason field to null

AJ PAYJOBS BYPASS APPL(PAYROLL.0)                  

 - bypasses a subapplication called PAYJOBS. The BYPASS command indicates that all remaining jobs in this subapplication are no longer required.

APPLJOB GLDLYAPPL APPLICATION(GLAPPL.100) WITHDRAW   

- withdraws all incomplete jobs in subapplication GLDLYAPPL of application GLAPPL

AJ PAYJOB4 INSERT APPL(PAYROLL.293) PREDECESSORS(PAYJOB3) SUCCESSORS(PAYJOB5)

 -  inserts PAYJOB4 into generation 293 of the PAYROLL application. PAYJOB4 runs after PAYJOB3 completes successfully, but before PAYJOB5

AJ PAYJOB9 INSERT ATTRIBUTES(HOLD) APPL(PAYROLL.0)  

- inserts PAYJOB9 on hold into the PAYROLL application's current generation

The following AJ commands insert PAYJOB19 on hold into the PAYROLL application's current generation. PAYJOB19 has a time dependency, it's submission time is set to 9 pm and it is then released from hold.

AJ PAYJOB19 INSERT ATTRIBUTE(HOLD) APPL(PAYROLL.0)

AJ PAYJOB19 RESET DELAYSUB('9PM') APPL(PAYROLL.0)

AJ PAYJOB19 RELEASE APPL(PAYROLL.0)

The following AJ command inserts PAYJOB13 into the PAYROLL application's current generation with one predecessor. PAYJOB13 runs after PAYJOB11 completes, whether or not it is successful.

AJ PAYJOB13 INSERT APPL(PAYROLL.0) PREDECESSORS(PAYJOB11(U))

The following AJ command inserts PAYJOB12 with two predecessors into the PAYROLL application's current generation. PAYJOB12 runs after PAYJOB10 and PAYJOB11 complete successfully.

AJ PAYJOB12 INSERT PREDECESSORS(PAYJOB10,PAYJOB11)  APPL(PAYROLL.0)

The following AJ command inserts a task called REPORT.BALANCE into the PAYROLL application's current generation. REPORT.BALANCE runs after PAYJOB6 completes successfully.

AJ REPORT.BALANCE INSERT APPL(PAYROLL) PREDECESSORS(PAYJOB6) ATTRIBUTES(TASK)

The following AJ command resubmits PAYJOB18 using CA WA Restart Option ESP Edition

AJ PAYJOB18 RESUB RESTART APPL(PAYROLL.0)

The following AJ command resubmits PAYJOB2 and selects which steps are rerun.

AJ PAYJOB2 APPL(PAYROLL.0) RESTART RESUB -

FROMSTEP(STEP020) TOSTEP(STEP060) -

EXCLSTEP(STEP0030 STEP0050)

The following AJ command resubmits PAYJOB2 from the CYBER.COPY.JCL library

AJ PAYJOB2 RESUB APPL(PAYROLL.0) -

DATASET('CYBER.COPY.JCL')

SUSPEND ESPM.TESTFMRD - SUSPEND AN EVENT   

The following command TRIGGER AN EVENT STARTING FROM PARTICULAR JOBS   

TR ESPM2D.TEST1DLY ROOT(TEST1DLY,TEST1CDB+)

In the following example, the TRIGGER command suppresses the execution of CYBER.PAYROLL

TRIGGER CYBER.PAYROLL NOXEQ  

Execute CA ESP scheduler commands thru batch jobs

Below job LISTs ESP EVENTS that starts with "PROD"

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                          

//SYSPRINT DD SYSOUT=*                                              

//SYSIN    DD *                                                     

  L LEVEL(PROD) ALL PRINT(OUPUT.LIST.EVENTS)                       

//*                                                                 

Below job PURGE CSF COMPLETED APPLICATIONS AND JOBS 

                        

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'     

//SYSPRINT DD SYSOUT=*  

//SYSIN    DD *                                                      

  OPER PURGSCHF NOW                                                

//*   

                                                                  

Below job GENERATES CURRENT LISTING/SETTING OF ESP RESOURCES    

      

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'         

//SYSPRINT DD SYSOUT=*

//SYSIN    DD *                                                      

   RESDEF - LIST                                                

//*                                                                  

Below job GENERATES CURRENT LISTING/SETTING OF ESP VARIABLES

                  

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                          

//SYSPRINT DD SYSOUT=*                                              

//SYSIN    DD *                                                     

   VTLIST                                                           

//*                                                                 

Below job SIMULATEs ESP events

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                       

//SYSPRINT DD DSN=output dataset,

//            DISP=(NEW,CATLG,DELETE),  

//            UNIT=SYSDA,                                          

//            DCB=(RECFM=FBA,BLKSIZE=0,LRECL=133),                

//            SPACE=(133,(60,10),RLSE),AVGREC=K                      

//SYSIN    DD *                                                      

   SIMULATE EVENT(PROD.DAILY)                                       

//*                                                                   

//XCFDG1 EXEC PGM=ESP,PARM='SUBSYS(ESP) MASTER'             

//SYSPRINT DD SYSOUT=*                                      

//SYSUDUMP DD SYSOUT=*                                      

//SYSIN DD *                                                

 SIMULATE EVENT(PROD.DAILY) SCHED('10/15/2021 00.01.00')  

/*                                                          

Below job UPDATES VARIABLE called "VK"

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                           

//SYSPRINT DD SYSOUT=*                                               

//SYSIN    DD *                                                      

   VSET WK 2 TABLE(TABLE1)                                           

//*

Below job Trigger an event

//STEP02   EXEC PGM=ESP,PARM='SUBSYS(ESP)'         

//SYSPRINT DD SYSOUT=*                             

//SYSIN    DD *                                    

  TRIGGER PROD.DEMAND

/*                                                 

//                                                 

Below job lists the history run times of D01D001A job

//XCFDG1 EXEC PGM=ESP,PARM='SUBSYS(ESP) MASTER'     

//SYSPRINT DD SYSOUT=*                              

//SYSUDUMP DD SYSOUT=*                              

//SYSIN DD *                                        

 LJS JOB(D01D001A) I                              

/*                                                  

Below two jobs generates reports of job runs

//XCFDG1 EXEC PGM=ESP,PARM='SUBSYS(ESP) MASTER'                    

//SYSPRINT DD SYSOUT=*                                             

//SYSUDUMP DD SYSOUT=*                                             

//SYSIN DD *                                                       

REPORT                                                             

  SETWIDTH 130                                                     

  FROM OCT 15TH 2021 TO OCT 16TH 2021                              

  DISPLAY JOBNAME EXECSDATE EXECST ENDDATE ENDT CPUTIME CMPC     

ENDR                                                               

/*                                                                 

//STEP010 EXEC PGM=ESP,REGION=4M,PARM='SUBSYS(ESP)'  

//SYSPRINT DD  DSN=output dataset

//             DISP=(NEW,CATLG,DELETE),                  

//             UNIT=SYSDA,SPACE=(CYL,(20,20),RLSE),      

//             DCB=(RECFM=FB,LRECL=240,BLKSIZE=13300)    

//SYSIN    DD *

REPORT                 

DATEFORM YMD DAY(NO)    

DISPLAY EXECSDATE 10,EXECST 8,ENDDATE 10,ENDT 8,APPLSYS 8,

SUBAPPL 8,  

JOBNAME 8,JOBNO 6,RC 5,CMPC 8,FORCED 3,STATUS 8,CPUTIME 8, 

TCBTIME 8,SRBTIME 8,EXECQT 5,MINRUNT 5,MAXRUNT 5,AVGRUNT 5,  

ALLOCQT 5,CRITPATH 3,STEPS 2,EXCP 8,DEXCP 8,TEXCP 8,ESPSUB 3,

SUB# 1,SYSPLEX 8,SRVCLASS 8,OVDSUBAT 15

FROM 12AM TODAY   

  SORT EXECSDATE,EXECST     

 ENDR                                                             

/*