Sample COBOL II and LE COBOL user exit
The following is a sample COBOL II and LE COBOL user exit:
*-----------------------------------------------------------------
* ALL COBOL MODULES MUST BE COMPILED WITH DATA(31) AND DYNAM TO
* EXECUTE PROPERLY!!!!!!!!
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. AMUEDSN2.
AUTHOR. BMC SOFTWARE
DATE-WRITTEN. AUGUST 1995.
DATE-COMPILED.
*-----------------------------------------------------------------
* AMUEDSN2 IS A SAMPLE DB2 COBOL II USER EXIT.
*
* THIS IS A SAMPLE LOADPLUS USER EXIT. THIS EXIT WOULD BE USED
* IN ORDER TO DEFINE USER VARIABLES FOR BUILDING DATASET NAMES
* FOR DYNAMIC WORKFILE ALLOCATION WITH THE DSNPAT KEYWORD.
*
* AMUEDSN2 IS CALLED ONLY ONCE PER EXECUTION OF AMUUMAIN
* THE MODULE IS CALLED AT THE BEGINNING OF EITHER THE PRELOAD
* PHASE OR THE COMBINED PHASE.
*
* THIS EXIT WILL ONLY BE INVOKED WHEN IT IS THE VALUE SET FOR
* DSNUEXIT PARM IN AMU$OPTS DURING INSTALLATION OR IN THE
* DSNUEXIT PARAMETER OF THE LOAD COMMAND. THE LOAD COMMAND
* OPTION WILL OVERRIDE THE PARM IN THE AMU$OPTS MACRO.
*
* PLEASE REVIEW ADDITIONAL DOCUMENTION IN THE REFERENCE MANUAL
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-Control.
DATA DIVISION.
FILE SECTION.
EJECT
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 FILLER PIC X(16) VALUE 'WORKING STORAGE '.
*-----------------------------------------------------------------
* MISCELLANEOUS LITERALS, TABLE SUBSCRIPTS, NUMERIC VALUES
* FOR JULIAN-DATE OR JULIAN/CENTURY-DATE CONVERSION, ETC.
*-----------------------------------------------------------------
01 MISCELLANEOUS.
05 SAVE-DATA PIC X(8) VALUE SPACES.
05 DAYS-SUBX PIC S9(3) COMP VALUE ZERO.
05 SUBX PIC S9(3) COMP VALUE ZERO.
05 ONE PIC S9(1) COMP-3 VALUE +1.
05 TWO PIC S9(1) COMP-3 VALUE +2.
05 FOUR PIC S9(1) COMP-3 VALUE +4.
05 MAX-LENGTH PIC S9(3) COMP-3 VALUE +16.
05 NINETEEN PIC S9(3) COMP-3 VALUE +19.
05 TWENTY PIC S9(3) COMP-3 VALUE +20.
05 NINETY-FIVE PIC S9(3) COMP-3 VALUE +95.
05 ONE-HUNDRED PIC S9(3) COMP-3 VALUE +100.
05 FOUR-HUNDRED PIC S9(3) COMP-3 VALUE +400.
05 JULIAN-DATE-DESC PIC X(9) VALUE '_JDATE'.
05 JULIAN-CDATE-DESC PIC X(9) VALUE '_JCDATE'.
05 UTILITY-PREFIX PIC X(9) VALUE '_UTILPFX'.
05 UTILITY-SUFFIX PIC X(9) VALUE '_UTILSFX'.
05 UTILID-PREFIX PIC X(8) VALUE SPACES.
05 UTILID-SUFFIX PIC X(8) VALUE SPACES.
05 UTILID-POINTER PIC S9(3) VALUE ZERO.
05 UTILID-COUNTER PIC S9(3) VALUE ZERO.
05 UTILID-TALLY PIC S9(3) VALUE ZERO.
01 DATE-WORK-AREA.
05 CONVERTED-DATE.
10 DATE-PREFIX PIC X(1) VALUE 'D'.
10 JULIAN-CDATE PIC 9(7) VALUE ZERO.
10 FILLER REDEFINES JULIAN-CDATE.
15 JULIAN-CC PIC 9(2).
15 JULIAN-DATE PIC 9(5).
15 FILLER REDEFINES JULIAN-DATE.
20 JULIAN-YY PIC 9(2).
20 JULIAN-DAYS PIC 9(3).
05 WORK-YEAR PIC S9(3) COMP-3 VALUE ZERO.
05 YEAR-ANSWER PIC S9(3) COMP-3 VALUE ZERO.
05 YEAR-REMAINDER PIC S9(9) COMP-3 VALUE ZERO.
05 FILLER REDEFINES YEAR-REMAINDER.
10 YEAR-X PIC X(5).
*-----------------------------------------------------------------
* THE FOLLOWING TWO TABLES ARE USED TO CALCULATE THE JULIAN
* DAY DEPENDING ON WHETHER THE YEAR IS A LEAP OR NOT.
*-----------------------------------------------------------------
01 NO-LEAP-MONTHS.
05 JANUARY PIC S9(3) COMP-3 VALUE 00.
05 FEBUARY PIC S9(3) COMP-3 VALUE 31.
05 MARCH PIC S9(3) COMP-3 VALUE 59.
05 APRIL PIC S9(3) COMP-3 VALUE 90.
05 MAY PIC S9(3) COMP-3 VALUE 120.
05 JUNE PIC S9(3) COMP-3 VALUE 151.
05 JULY PIC S9(3) COMP-3 VALUE 181.
05 AUGUST PIC S9(3) COMP-3 VALUE 212.
05 SEPTEMBER PIC S9(3) COMP-3 VALUE 243.
05 OCTOBER PIC S9(3) COMP-3 VALUE 273.
05 NOVEMBER PIC S9(3) COMP-3 VALUE 304.
05 DECEMBER PIC S9(3) COMP-3 VALUE 334.
01 FILLER REDEFINES NO-LEAP-MONTHS.
05 MONTH-DAYS PIC S9(3) COMP-3 OCCURS 12 TIMES.
01 LEAP-MONTHS.
05 LEAP-JANUARY PIC S9(3) COMP-3 VALUE 00.
05 LEAP-FEBRUARY PIC S9(3) COMP-3 VALUE 31.
05 LEAP-MARCH PIC S9(3) COMP-3 VALUE 60.
05 LEAP-APRIL PIC S9(3) COMP-3 VALUE 91.
05 LEAP-MAY PIC S9(3) COMP-3 VALUE 121.
05 LEAP-JUNE PIC S9(3) COMP-3 VALUE 152.
05 LEAP-JULY PIC S9(3) COMP-3 VALUE 182.
05 LEAP-AUGUST PIC S9(3) COMP-3 VALUE 213.
05 LEAP-SEPTEMBER PIC S9(3) COMP-3 VALUE 244.
05 LEAP-OCTOBER PIC S9(3) COMP-3 VALUE 274.
05 LEAP-NOVEMBER PIC S9(3) COMP-3 VALUE 305.
05 LEAP-DECEMBER PIC S9(3) COMP-3 VALUE 335.
01 FILLER REDEFINES LEAP-MONTHS.
05 LEAP-MONTH-DAYS PIC S9(3) COMP-3 OCCURS 12 TIMES.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
* THE TABLE CAN NOT OCCUR MORE THAN 100 TIME OR A STORAGE
* OVERLAY WILL OCCUR.
*-----------------------------------------------------------------
01 LOAD-EXIT-PARMS.
05 FIXED-PARM-VALUES.
10 EXIT-JOBNAME PIC X(8).
10 EXIT-STEPNAME PIC X(8).
10 EXIT-DBNAME PIC X(8).
10 EXIT-TSNAME PIC X(8).
10 EXIT-RESUME PIC X(1).
10 EXIT-REPLACE PIC X(1).
10 EXIT-FILLER1 PIC X(2).
10 EXIT-USERID PIC X(8).
10 EXIT-DB2-SSID PIC X(4).
10 EXIT-DATE.
15 EXIT-MM PIC 9(2).
15 EXIT-DD PIC 9(2).
15 EXIT-YY PIC 9(2).
10 EXIT-TIME PIC X(6).
10 EXIT-UTILID-PARM PIC X(16).
10 FILLER REDEFINES EXIT-UTILID-PARM.
15 EXIT-PREFIX PIC X(8).
15 EXIT-SUFFIX PIC X(8).
10 EXIT-DATE8.
15 EXIT-DATE8-MM PIC 9(2).
15 EXIT-DATE8-DD PIC 9(2).
15 EXIT-DATE8-YEAR PIC 9(4).
15 FILLER REDEFINES EXIT-DATE8-YEAR.
20 EXIT-DATE8-CC PIC 9(2).
20 EXIT-DATE8-YY PIC 9(2).
10 EXIT-GRPNM PIC X(4).
10 EXIT-VCAT PIC X(8).
10 EXIT-DATEJ.
15 EXIT-DATEJ-YEAR PIC 9(4).
15 FILLER REDEFINES EXIT-DATEJ-YEAR.
20 EXIT-DATEJ-CC PIC 9(2).
20 EXIT-DATEJ-CC PIC 9(2).
15 EXIT-DATEJ-DDD PIC 9(3).
10 EXIT-FILLER2 PIC X(13).
05 WORK-AREA-ADDRESSES.
10 WORK-AREA-1 PIC 9(4).
10 WORK-AREA-2 PIC 9(4).
10 WORK-AREA-3 PIC 9(4).
10 WORK-AREA-4 PIC 9(4).
10 WORK-AREA-5 PIC 9(4).
10 WORK-AREA-6 PIC 9(4).
10 WORK-AREA-7 PIC 9(4).
10 WORK-AREA-8 PIC 9(4).
05 USER-DEFINED-VARILABLE-TABLE OCCURS 100 TIMES.
10 VARIABLE-NAME PIC X(9).
10 VARIABLE-VALUE PIC X(8).
10 FILLER REDEFINES VARIABLE-VALUE.
15 VARIABLE-PREFIX PIC X(1).
15 VARIABLE-JUL-DATE PIC X(7).
*-----------------------------------------------------------------
PROCEDURE DIVISION USING LOAD-EXIT-PARMS.
*-----------------------------------------------------------------
0000-MAIN.
MOVE ZERO TO RETURN-CODE.
PERFORM 1000-PROCESS-DATE.
GOBACK.
*-----------------------------------------------------------------
* THE DATE IS PASSED IN A MMDDYYYY FORMAT AND CONVERTED TO
* A JULIAN-DATE(WITH NO CENTURY) FORMAT OR A JULIAN-DATE
* (WITH THE CENTURY) FORMAT.
*-----------------------------------------------------------------
1000-PROCESS-DATE.
MOVE EXIT-DATE8-DD TO JULIAN-DAYS.
MOVE EXIT-DATE8-MM TO DAYS-SUBX.
MOVE EXIT-DATE8-CC TO JULIAN-CC.
MOVE EXIT-DATE8-YY TO JULIAN-YY.
MOVE EXIT-DATE8-YEAR TO WORK-YEAR.
DIVIDE WORK-YEAR BY FOUR
GIVING YEAR-ANSWER
REMAINDER YEAR-REMAINDER.
IF YEAR-REMAINDER > ZERO
THEN
PERFORM 1100-NO-LEAP-YEAR
ELSE
DIVIDE WORK-YEAR BY ONE-HUNDRED
GIVING YEAR-ANSWER
REMAINDER YEAR-REMAINDER
IF YEAR-REMAINDER > ZERO
THEN
PERFORM 1200-LEAP-YEAR
ELSE
DIVIDE WORK-YEAR BY FOUR-HUNDRED
GIVING YEAR-ANSWER
REMAINDER YEAR-REMAINDER
IF YEAR-REMAINDER > ZERO
THEN
PERFORM 1100-NO-LEAP-YEAR
ELSE
ADD LEAP-MONTH-DAYS(DAYS-SUBX)
TO JULIAN-DAYS
PERFORM 1200-LEAP-YEAR
END-IF
END-IF
END-IF.
1000-PROCESS-DATE-EXIT.
EXIT.
1100-NO-LEAP-YEAR.
ADD MONTH-DAYS(DAYS-SUBX) TO JULIAN-DAYS.
PERFORM 1300-CENTURY.
1100-NO-LEAP-YEAR-EXIT.
EXIT.
1200-LEAP-YEAR.
ADD LEAP-MONTH-DAYS(DAYS-SUBX) TO JULIAN-DAYS.
PERFORM 1300-CENTURY.
1200-LEAP-YEAR-EXIT.
EXIT.
1300-CENTURY.
PERFORM 1400-EDIT-UTILID.
1300-CENTURY-EXIT.
EXIT.
*-----------------------------------------------------------------
* THE FULL 16 BYTES OF THE UTILITY ID PARM IS CHECKED FOR
* A DELIMITER. IF ONE IS FOUND AFTER THE FIRST 8 BYTES, IT
* IS INCLUDED IN THE SUFFIX. IF A DELIMITER IS FOUND IN THE
* FIRST 8 BYTES, ONLY THOSE CHARACTERS/NUMBERS UP TO THE
* DELIMITER, WILL BE MOVED INTO THE PREFIX FIELD.
*-----------------------------------------------------------------
* THE DELIMITER CHARACTER IMMEDIATELY FOLLOWING THE FORWARD
* SLASH ('/') IS A BROKEN VERTICAL BAR, HEX 6A, AND IS NOT
* DISPLAYABLE IN BOOKMANAGER
*-----------------------------------------------------------------
1400-EDIT-UTILID.
MOVE ONE TO UTILID-POINTER, UTILID-TALLY.
UNSTRING EXIT-UTILID-PARM
DELIMITED BY ' ' OR '.' OR '+' OR '|' OR ';'
OR '-' OR '/' OR '' OR ',' OR '_' OR ':'
OR '=' OR '/'
INTO UTILID-PREFIX
COUNT IN UTILID-COUNTER
WITH POINTER UTILID-POINTER.
IF UTILID-COUNTER = MAX-LENGTH
THEN
MOVE EXIT-SUFFIX TO UTILID-SUFFIX
ELSE
MOVE UTILID-COUNTER TO UTILID-POINTER
ADD TWO TO UTILID-POINTER
UNSTRING EXIT-UTILID-PARM
INTO UTILID-SUFFIX
WITH POINTER UTILID-POINTER
END-IF.
PERFORM 1500-UTILID-PARMS.
1400-EDIT-UTILID-EXIT.
EXIT.
1500-UTILID-PARMS.
MOVE ONE TO SUBX.
MOVE UTILITY-PREFIX TO VARIABLE-NAME(SUBX).
MOVE UTILID-PREFIX TO VARIABLE-VALUE(SUBX).
ADD ONE TO SUBX.
MOVE UTILITY-SUFFIX TO VARIABLE-NAME(SUBX).
MOVE UTILID-SUFFIX TO VARIABLE-VALUE(SUBX).
ADD ONE TO SUBX.
MOVE JULIAN-DATE-DESC TO VARIABLE-NAME(SUBX).
MOVE DATE-PREFIX TO VARIABLE-PREFIX(SUBX).
MOVE JULIAN-DATE TO VARIABLE-JUL-DATE(SUBX).
ADD ONE TO SUBX.
MOVE JULIAN-CDATE-DESC TO VARIABLE-NAME(SUBX).
MOVE CONVERTED-DATE TO VARIABLE-VALUE(SUBX).
1500-UTILID-PARMS-EXIT.
EXIT.
* ALL COBOL MODULES MUST BE COMPILED WITH DATA(31) AND DYNAM TO
* EXECUTE PROPERLY!!!!!!!!
*-----------------------------------------------------------------
IDENTIFICATION DIVISION.
*-----------------------------------------------------------------
PROGRAM-ID. AMUEDSN2.
AUTHOR. BMC SOFTWARE
DATE-WRITTEN. AUGUST 1995.
DATE-COMPILED.
*-----------------------------------------------------------------
* AMUEDSN2 IS A SAMPLE DB2 COBOL II USER EXIT.
*
* THIS IS A SAMPLE LOADPLUS USER EXIT. THIS EXIT WOULD BE USED
* IN ORDER TO DEFINE USER VARIABLES FOR BUILDING DATASET NAMES
* FOR DYNAMIC WORKFILE ALLOCATION WITH THE DSNPAT KEYWORD.
*
* AMUEDSN2 IS CALLED ONLY ONCE PER EXECUTION OF AMUUMAIN
* THE MODULE IS CALLED AT THE BEGINNING OF EITHER THE PRELOAD
* PHASE OR THE COMBINED PHASE.
*
* THIS EXIT WILL ONLY BE INVOKED WHEN IT IS THE VALUE SET FOR
* DSNUEXIT PARM IN AMU$OPTS DURING INSTALLATION OR IN THE
* DSNUEXIT PARAMETER OF THE LOAD COMMAND. THE LOAD COMMAND
* OPTION WILL OVERRIDE THE PARM IN THE AMU$OPTS MACRO.
*
* PLEASE REVIEW ADDITIONAL DOCUMENTION IN THE REFERENCE MANUAL
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-Control.
DATA DIVISION.
FILE SECTION.
EJECT
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
*-----------------------------------------------------------------
01 FILLER PIC X(16) VALUE 'WORKING STORAGE '.
*-----------------------------------------------------------------
* MISCELLANEOUS LITERALS, TABLE SUBSCRIPTS, NUMERIC VALUES
* FOR JULIAN-DATE OR JULIAN/CENTURY-DATE CONVERSION, ETC.
*-----------------------------------------------------------------
01 MISCELLANEOUS.
05 SAVE-DATA PIC X(8) VALUE SPACES.
05 DAYS-SUBX PIC S9(3) COMP VALUE ZERO.
05 SUBX PIC S9(3) COMP VALUE ZERO.
05 ONE PIC S9(1) COMP-3 VALUE +1.
05 TWO PIC S9(1) COMP-3 VALUE +2.
05 FOUR PIC S9(1) COMP-3 VALUE +4.
05 MAX-LENGTH PIC S9(3) COMP-3 VALUE +16.
05 NINETEEN PIC S9(3) COMP-3 VALUE +19.
05 TWENTY PIC S9(3) COMP-3 VALUE +20.
05 NINETY-FIVE PIC S9(3) COMP-3 VALUE +95.
05 ONE-HUNDRED PIC S9(3) COMP-3 VALUE +100.
05 FOUR-HUNDRED PIC S9(3) COMP-3 VALUE +400.
05 JULIAN-DATE-DESC PIC X(9) VALUE '_JDATE'.
05 JULIAN-CDATE-DESC PIC X(9) VALUE '_JCDATE'.
05 UTILITY-PREFIX PIC X(9) VALUE '_UTILPFX'.
05 UTILITY-SUFFIX PIC X(9) VALUE '_UTILSFX'.
05 UTILID-PREFIX PIC X(8) VALUE SPACES.
05 UTILID-SUFFIX PIC X(8) VALUE SPACES.
05 UTILID-POINTER PIC S9(3) VALUE ZERO.
05 UTILID-COUNTER PIC S9(3) VALUE ZERO.
05 UTILID-TALLY PIC S9(3) VALUE ZERO.
01 DATE-WORK-AREA.
05 CONVERTED-DATE.
10 DATE-PREFIX PIC X(1) VALUE 'D'.
10 JULIAN-CDATE PIC 9(7) VALUE ZERO.
10 FILLER REDEFINES JULIAN-CDATE.
15 JULIAN-CC PIC 9(2).
15 JULIAN-DATE PIC 9(5).
15 FILLER REDEFINES JULIAN-DATE.
20 JULIAN-YY PIC 9(2).
20 JULIAN-DAYS PIC 9(3).
05 WORK-YEAR PIC S9(3) COMP-3 VALUE ZERO.
05 YEAR-ANSWER PIC S9(3) COMP-3 VALUE ZERO.
05 YEAR-REMAINDER PIC S9(9) COMP-3 VALUE ZERO.
05 FILLER REDEFINES YEAR-REMAINDER.
10 YEAR-X PIC X(5).
*-----------------------------------------------------------------
* THE FOLLOWING TWO TABLES ARE USED TO CALCULATE THE JULIAN
* DAY DEPENDING ON WHETHER THE YEAR IS A LEAP OR NOT.
*-----------------------------------------------------------------
01 NO-LEAP-MONTHS.
05 JANUARY PIC S9(3) COMP-3 VALUE 00.
05 FEBUARY PIC S9(3) COMP-3 VALUE 31.
05 MARCH PIC S9(3) COMP-3 VALUE 59.
05 APRIL PIC S9(3) COMP-3 VALUE 90.
05 MAY PIC S9(3) COMP-3 VALUE 120.
05 JUNE PIC S9(3) COMP-3 VALUE 151.
05 JULY PIC S9(3) COMP-3 VALUE 181.
05 AUGUST PIC S9(3) COMP-3 VALUE 212.
05 SEPTEMBER PIC S9(3) COMP-3 VALUE 243.
05 OCTOBER PIC S9(3) COMP-3 VALUE 273.
05 NOVEMBER PIC S9(3) COMP-3 VALUE 304.
05 DECEMBER PIC S9(3) COMP-3 VALUE 334.
01 FILLER REDEFINES NO-LEAP-MONTHS.
05 MONTH-DAYS PIC S9(3) COMP-3 OCCURS 12 TIMES.
01 LEAP-MONTHS.
05 LEAP-JANUARY PIC S9(3) COMP-3 VALUE 00.
05 LEAP-FEBRUARY PIC S9(3) COMP-3 VALUE 31.
05 LEAP-MARCH PIC S9(3) COMP-3 VALUE 60.
05 LEAP-APRIL PIC S9(3) COMP-3 VALUE 91.
05 LEAP-MAY PIC S9(3) COMP-3 VALUE 121.
05 LEAP-JUNE PIC S9(3) COMP-3 VALUE 152.
05 LEAP-JULY PIC S9(3) COMP-3 VALUE 182.
05 LEAP-AUGUST PIC S9(3) COMP-3 VALUE 213.
05 LEAP-SEPTEMBER PIC S9(3) COMP-3 VALUE 244.
05 LEAP-OCTOBER PIC S9(3) COMP-3 VALUE 274.
05 LEAP-NOVEMBER PIC S9(3) COMP-3 VALUE 305.
05 LEAP-DECEMBER PIC S9(3) COMP-3 VALUE 335.
01 FILLER REDEFINES LEAP-MONTHS.
05 LEAP-MONTH-DAYS PIC S9(3) COMP-3 OCCURS 12 TIMES.
*-----------------------------------------------------------------
LINKAGE SECTION.
*-----------------------------------------------------------------
* THE TABLE CAN NOT OCCUR MORE THAN 100 TIME OR A STORAGE
* OVERLAY WILL OCCUR.
*-----------------------------------------------------------------
01 LOAD-EXIT-PARMS.
05 FIXED-PARM-VALUES.
10 EXIT-JOBNAME PIC X(8).
10 EXIT-STEPNAME PIC X(8).
10 EXIT-DBNAME PIC X(8).
10 EXIT-TSNAME PIC X(8).
10 EXIT-RESUME PIC X(1).
10 EXIT-REPLACE PIC X(1).
10 EXIT-FILLER1 PIC X(2).
10 EXIT-USERID PIC X(8).
10 EXIT-DB2-SSID PIC X(4).
10 EXIT-DATE.
15 EXIT-MM PIC 9(2).
15 EXIT-DD PIC 9(2).
15 EXIT-YY PIC 9(2).
10 EXIT-TIME PIC X(6).
10 EXIT-UTILID-PARM PIC X(16).
10 FILLER REDEFINES EXIT-UTILID-PARM.
15 EXIT-PREFIX PIC X(8).
15 EXIT-SUFFIX PIC X(8).
10 EXIT-DATE8.
15 EXIT-DATE8-MM PIC 9(2).
15 EXIT-DATE8-DD PIC 9(2).
15 EXIT-DATE8-YEAR PIC 9(4).
15 FILLER REDEFINES EXIT-DATE8-YEAR.
20 EXIT-DATE8-CC PIC 9(2).
20 EXIT-DATE8-YY PIC 9(2).
10 EXIT-GRPNM PIC X(4).
10 EXIT-VCAT PIC X(8).
10 EXIT-DATEJ.
15 EXIT-DATEJ-YEAR PIC 9(4).
15 FILLER REDEFINES EXIT-DATEJ-YEAR.
20 EXIT-DATEJ-CC PIC 9(2).
20 EXIT-DATEJ-CC PIC 9(2).
15 EXIT-DATEJ-DDD PIC 9(3).
10 EXIT-FILLER2 PIC X(13).
05 WORK-AREA-ADDRESSES.
10 WORK-AREA-1 PIC 9(4).
10 WORK-AREA-2 PIC 9(4).
10 WORK-AREA-3 PIC 9(4).
10 WORK-AREA-4 PIC 9(4).
10 WORK-AREA-5 PIC 9(4).
10 WORK-AREA-6 PIC 9(4).
10 WORK-AREA-7 PIC 9(4).
10 WORK-AREA-8 PIC 9(4).
05 USER-DEFINED-VARILABLE-TABLE OCCURS 100 TIMES.
10 VARIABLE-NAME PIC X(9).
10 VARIABLE-VALUE PIC X(8).
10 FILLER REDEFINES VARIABLE-VALUE.
15 VARIABLE-PREFIX PIC X(1).
15 VARIABLE-JUL-DATE PIC X(7).
*-----------------------------------------------------------------
PROCEDURE DIVISION USING LOAD-EXIT-PARMS.
*-----------------------------------------------------------------
0000-MAIN.
MOVE ZERO TO RETURN-CODE.
PERFORM 1000-PROCESS-DATE.
GOBACK.
*-----------------------------------------------------------------
* THE DATE IS PASSED IN A MMDDYYYY FORMAT AND CONVERTED TO
* A JULIAN-DATE(WITH NO CENTURY) FORMAT OR A JULIAN-DATE
* (WITH THE CENTURY) FORMAT.
*-----------------------------------------------------------------
1000-PROCESS-DATE.
MOVE EXIT-DATE8-DD TO JULIAN-DAYS.
MOVE EXIT-DATE8-MM TO DAYS-SUBX.
MOVE EXIT-DATE8-CC TO JULIAN-CC.
MOVE EXIT-DATE8-YY TO JULIAN-YY.
MOVE EXIT-DATE8-YEAR TO WORK-YEAR.
DIVIDE WORK-YEAR BY FOUR
GIVING YEAR-ANSWER
REMAINDER YEAR-REMAINDER.
IF YEAR-REMAINDER > ZERO
THEN
PERFORM 1100-NO-LEAP-YEAR
ELSE
DIVIDE WORK-YEAR BY ONE-HUNDRED
GIVING YEAR-ANSWER
REMAINDER YEAR-REMAINDER
IF YEAR-REMAINDER > ZERO
THEN
PERFORM 1200-LEAP-YEAR
ELSE
DIVIDE WORK-YEAR BY FOUR-HUNDRED
GIVING YEAR-ANSWER
REMAINDER YEAR-REMAINDER
IF YEAR-REMAINDER > ZERO
THEN
PERFORM 1100-NO-LEAP-YEAR
ELSE
ADD LEAP-MONTH-DAYS(DAYS-SUBX)
TO JULIAN-DAYS
PERFORM 1200-LEAP-YEAR
END-IF
END-IF
END-IF.
1000-PROCESS-DATE-EXIT.
EXIT.
1100-NO-LEAP-YEAR.
ADD MONTH-DAYS(DAYS-SUBX) TO JULIAN-DAYS.
PERFORM 1300-CENTURY.
1100-NO-LEAP-YEAR-EXIT.
EXIT.
1200-LEAP-YEAR.
ADD LEAP-MONTH-DAYS(DAYS-SUBX) TO JULIAN-DAYS.
PERFORM 1300-CENTURY.
1200-LEAP-YEAR-EXIT.
EXIT.
1300-CENTURY.
PERFORM 1400-EDIT-UTILID.
1300-CENTURY-EXIT.
EXIT.
*-----------------------------------------------------------------
* THE FULL 16 BYTES OF THE UTILITY ID PARM IS CHECKED FOR
* A DELIMITER. IF ONE IS FOUND AFTER THE FIRST 8 BYTES, IT
* IS INCLUDED IN THE SUFFIX. IF A DELIMITER IS FOUND IN THE
* FIRST 8 BYTES, ONLY THOSE CHARACTERS/NUMBERS UP TO THE
* DELIMITER, WILL BE MOVED INTO THE PREFIX FIELD.
*-----------------------------------------------------------------
* THE DELIMITER CHARACTER IMMEDIATELY FOLLOWING THE FORWARD
* SLASH ('/') IS A BROKEN VERTICAL BAR, HEX 6A, AND IS NOT
* DISPLAYABLE IN BOOKMANAGER
*-----------------------------------------------------------------
1400-EDIT-UTILID.
MOVE ONE TO UTILID-POINTER, UTILID-TALLY.
UNSTRING EXIT-UTILID-PARM
DELIMITED BY ' ' OR '.' OR '+' OR '|' OR ';'
OR '-' OR '/' OR '' OR ',' OR '_' OR ':'
OR '=' OR '/'
INTO UTILID-PREFIX
COUNT IN UTILID-COUNTER
WITH POINTER UTILID-POINTER.
IF UTILID-COUNTER = MAX-LENGTH
THEN
MOVE EXIT-SUFFIX TO UTILID-SUFFIX
ELSE
MOVE UTILID-COUNTER TO UTILID-POINTER
ADD TWO TO UTILID-POINTER
UNSTRING EXIT-UTILID-PARM
INTO UTILID-SUFFIX
WITH POINTER UTILID-POINTER
END-IF.
PERFORM 1500-UTILID-PARMS.
1400-EDIT-UTILID-EXIT.
EXIT.
1500-UTILID-PARMS.
MOVE ONE TO SUBX.
MOVE UTILITY-PREFIX TO VARIABLE-NAME(SUBX).
MOVE UTILID-PREFIX TO VARIABLE-VALUE(SUBX).
ADD ONE TO SUBX.
MOVE UTILITY-SUFFIX TO VARIABLE-NAME(SUBX).
MOVE UTILID-SUFFIX TO VARIABLE-VALUE(SUBX).
ADD ONE TO SUBX.
MOVE JULIAN-DATE-DESC TO VARIABLE-NAME(SUBX).
MOVE DATE-PREFIX TO VARIABLE-PREFIX(SUBX).
MOVE JULIAN-DATE TO VARIABLE-JUL-DATE(SUBX).
ADD ONE TO SUBX.
MOVE JULIAN-CDATE-DESC TO VARIABLE-NAME(SUBX).
MOVE CONVERTED-DATE TO VARIABLE-VALUE(SUBX).
1500-UTILID-PARMS-EXIT.
EXIT.
Tip: For faster searching, add an asterisk to the end of your partial query. Example: cert*