Century Support Products for CA-IDMS
Julian/Gregorian Date Conversion
Century Support Products for CA-IDMS
Julian/Gregorian Date Conversion
1) Modify your DC COBOL program using the following as an example:
*DMLIST
IDENTIFICATION DIVISION.
PROGRAM-ID. progname.
ENVIRONMENT DIVISION.
IDMS-CONTROL SECTION.
PROTOCOL. MODE IS IDMS-DC DEBUG
IDMS-RECORDS MANUAL.
DATA DIVISION.
SCHEMA SECTION.
DB userss01 WITHIN userschm.
MAP SECTION.
MAP usermap.
WORKING-STORAGE SECTION.
COPY IDMS MAP-CONTROLS.
COPY IDMS DC-AID-CONDITION-NAMES.
COPY IDMS MAP-RECORDS.
01 COPY IDMS SUBSCHEMA-CTRL.
.
.
01 200-WORKFIELDS.
05 200-DATE.
10 200-YY PIC 9(2) VALUE ZERO.
10 200-MM PIC 9(2) VALUE ZERO.
10 200-DD PIC 9(2) VALUE ZERO.
05 200-TIME.
10 200-HH PIC 9(2) VALUE ZERO.
10 200-MIN PIC 9(2) VALUE ZERO.
10 200-SS PIC 9(2) VALUE ZERO.
*
* ADD THE FOLLOWING THREE LINES IN WORKING-STORAGE
*
01 COPY IDMS HSLW9090-01.
01 COPY IDMS HSLW9090-02.
01 COPY IDMS HSLW9090-03.
LINKAGE SECTION.
PROCEDURE DIVISION.
0000-MAIN-LINE.
.
.
*
* TO REPLACE THE ILLEGAL ACCEPT DATE AND TIME COMMANDS,
* REPLACE THE ILLEGAL CODE WITH THE FOLLOWING.
*
* ACCEPT 200-DATE FROM DATE.
* ACCEPT 200-TIME FROM TIME.
PERFORM 9999-GET-DATE-TIME.
MOVE HSLE9090-01-GREG-YY-34 TO 200-YY.
MOVE HSLE9090-01-GREG-MM TO 200-MM.
MOVE HSLE9090-01-GREG-DD TO 200-DD.
MOVE HSLE9090-03-HH TO 200-HH.
MOVE HSLE9090-03-MM TO 200-MIN.
MOVE HSLE9090-03-SS TO 200-SS.
.
.
*
* INCLUDE THE FOLLOWING COPY AT THE END OF THE PROGRAM
*
COPY IDMS HSLC9090.
IDMS-ABORT.
EXIT.
COPY IDMS IDMS-STATUS.
MSEND
.
2) Add the following three records and one module to your CA-IDMS
dictionary:
ADD
RECORD NAME IS HSLW9090-01 VERSION IS 1
.
05 HSLE9090-01-GREG-DATE
USAGE IS DISPLAY
.
10 HSLE9090-01-GREG-MM
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 HSLE9090-01-GREG-DD
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 HSLE9090-01-GREG-YYYY
USAGE IS DISPLAY
.
15 HSLE9090-01-GREG-YY-12
PICTURE IS 9(2)
USAGE IS DISPLAY
.
15 HSLE9090-01-GREG-YY-34
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 HSLE9090-01-GREG-YYYY-R
REDEFINES HSLE9090-01-GREG-YYYY
PICTURE IS 9(4)
USAGE IS DISPLAY
.
05 HSLE9090-01-GREG-DATE-R
REDEFINES HSLE9090-01-GREG-DATE
PICTURE IS X(8)
USAGE IS DISPLAY
.
05 HSLE9090-01-JUL-DATE
USAGE IS DISPLAY
.
10 HSLE9090-01-JUL-YYYY
USAGE IS DISPLAY
.
15 HSLE9090-01-JUL-YY-12
PICTURE IS 9(2)
USAGE IS DISPLAY
.
15 HSLE9090-01-JUL-YY-34
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 HSLE9090-01-JUL-YYYY-R
REDEFINES HSLE9090-01-JUL-YYYY
PICTURE IS 9(4)
USAGE IS DISPLAY
.
10 HSLE9090-01-JUL-DDD
PICTURE IS 9(3)
USAGE IS DISPLAY
.
05 HSLE9090-01-JUL-DATE-R
REDEFINES HSLE9090-01-JUL-DATE
PICTURE IS X(7)
USAGE IS DISPLAY
.
05 HSLE9090-01-DAY-OF-WEEK
PICTURE IS 9
USAGE IS DISPLAY
.
88 HSLE9090-01-DOW-MONDAY
USAGE IS CONDITION-NAME
.
05 HSLE9090-01-FIRST-DAY-OF-YEAR
PICTURE IS S9
USAGE IS DISPLAY
.
88 HSLE9090-01-FDOY-MONDAY
USAGE IS CONDITION-NAME
VALUE IS ( 1 )
.
05 HSLE9090-01-RETURN-CODE
PICTURE IS 99
USAGE IS DISPLAY
.
05 HSLE9090-01-MONTH-LITERAL
PICTURE IS X(9)
USAGE IS DISPLAY
.
05 HSLE9090-01-END
PICTURE IS X
USAGE IS DISPLAY
.
ADD
RECORD NAME IS HSLW9090-02 VERSION IS 1
.
05 HSLE9090-02-START-YEAR
PICTURE IS 9(4)
USAGE IS DISPLAY
VALUE IS ( 1985 )
.
05 HSLE9090-02-START-YEAR-R
REDEFINES HSLE9090-02-START-YEAR
USAGE IS DISPLAY
.
10 HSLE9090-02-START-YY-12
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 HSLE9090-02-START-YY-34
PICTURE IS 9(2)
USAGE IS DISPLAY
.
05 HSLE9090-02-START-COUNTER
PICTURE IS 9
USAGE IS DISPLAY
VALUE IS ( 1 )
.
05 HSLE9090-02-TARGET-YEAR
PICTURE IS 9(4)
USAGE IS DISPLAY
.
05 HSLE9090-02-YEAR-JUNK
USAGE IS DISPLAY
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 JANUARY' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '28 FEBRUARY' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 MARCH' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '30 APRIL' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 MAY' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '30 JUNE' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 JULY' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 AUGUST' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '30SEPTEMBER' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 OCTOBER' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '30 NOVEMBER' )
.
10 FILLER
PICTURE IS X(11)
USAGE IS DISPLAY
VALUE IS ( '31 DECEMBER' )
.
05 HSLE9090-02-YEAR-JUNK-R
REDEFINES HSLE9090-02-YEAR-JUNK
USAGE IS DISPLAY
.
10 HSLE9090-02-DAYS-MONTH
USAGE IS DISPLAY
OCCURS 12 TIMES
.
15 HSLE9090-02-DAYS-IN-MONTH
PICTURE IS 99
USAGE IS DISPLAY
.
15 HSLE9090-02-MONTH-DESC
PICTURE IS X(9)
USAGE IS DISPLAY
.
05 HSLE9090-02-SS
PICTURE IS 99
USAGE IS DISPLAY
.
05 HSLE9090-02-TEMP-DDD
PICTURE IS 999
USAGE IS DISPLAY
.
05 HSLE9090-02-END
PICTURE IS X
USAGE IS DISPLAY
.
ADD
RECORD NAME IS HSLW9090-03 VERSION IS 1
.
05 HSLE9090-03-TIME
USAGE IS DISPLAY
.
10 HSLE9090-03-HH
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 FILLER
PICTURE IS X
USAGE IS DISPLAY
.
10 HSLE9090-03-MM
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 FILLER
PICTURE IS X
USAGE IS DISPLAY
.
10 HSLE9090-03-SS
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 FILLER
PICTURE IS X(3)
USAGE IS DISPLAY
.
05 HSLE9090-03-DATE-COMP-3
PICTURE IS S9(7)
USAGE IS COMP-3
.
05 HSLE9090-03-DATE-DISPLAY
PICTURE IS 9(7)
USAGE IS DISPLAY
.
05 HSLE9090-03-DATE-DISPLAY-R
REDEFINES HSLE9090-03-DATE-DISPLAY
USAGE IS DISPLAY
.
10 FILLER
PICTURE IS X(2)
USAGE IS DISPLAY
.
10 HSLE9090-03-YY
PICTURE IS 9(2)
USAGE IS DISPLAY
.
10 HSLE9090-03-DDD
PICTURE IS 9(3)
USAGE IS DISPLAY
.
05 HSLE9090-03-END
PICTURE IS X
USAGE IS DISPLAY
.
ADD
MODULE NAME IS HSLC9090 VERSION IS 1
PUBLIC ACCESS IS ALLOWED FOR ALL
MODULE SOURCE FOLLOWS
*
* ! *********************************************************
* ! * *
* ! * ***** N O T I C E ***** *
* ! * *
* ! * THIS ROUTINE IS PROVIDED AS FREEWARE BY: *
* ! * *
* ! * HYBRID SYSTEMS LTD., INC. *
* ! * 200 UNIVERSITY PARK DRIVE *
* ! * SUITE 250 *
* ! * EDWARDSVILLE, IL 62025-3636 *
* ! * 618-692-4757 *
* ! * 800-779-2802 *
* ! * *
* ! * CONDITIONS OF ITS USE ARE AS FOLLOWS: *
* ! * *
* ! * 1) USER AGREES NOT TO REMOVE THIS NOTICE OF *
* ! * ORIGIN AND LIMITATION OF WARRANTY FROM THE *
* ! * SOFTWARE *
* ! * 2) THE SOFTWARE SHALL NOT BE RE-PACKAGED AND SOLD *
* ! * 3) USER AGREES TO ASSUME THE ENTIRE RISK OF USING *
* ! * THE SOFTWARE. HSL IS NOT RESPONSIBLE FOR ERRORS *
* ! * OR OMISSIONS IN THE SOFTWARE. NO WARRANTIES, *
* ! * WHETHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT *
* ! * LIMITATION, THE IMPLIED WARRANTIES OF *
* ! * MERCHANTIBILITY AND FITNESS FOR A PARTICULAR *
* ! * PURPOSE, ARE MADE BY HSL. IN NO EVENT WILL HSL *
* ! * BE LIABLE TO ANY PARTY FOR ANY LOSS, INCLUDING *
* ! * TIME, MONEY, GOODWILL AND CONSEQUENTIAL DAMAGES, *
* ! * WHICH MAY ARISE FROM THE USE, OPERATION OR *
* ! * MODIFICATION OF THE SOFTWARE ENHANCEMENTS OR *
* ! * ROUTINES, OR MATERIAL, INFORMATION, CONCLUSIONS, *
* ! * TECHNIQUES OR PROCEDURES PROVIDED HEREIN. *
* ! * *
* ! * ***** N O T I C E ***** *
* ! * *
* ! *********************************************************
*
9999-GET-DATE-TIME.
GET TIME INTO HSLE9090-03-TIME EDIT
DATE INTO HSLE9090-03-DATE-COMP-3.
MOVE HSLE9090-03-DATE-COMP-3 TO HSLE9090-03-DATE-DISPLAY.
MOVE SPACE TO HSLE9090-01-GREG-DATE.
MOVE HSLE9090-03-YY TO HSLE9090-01-JUL-YY-34.
IF (HSLE9090-03-YY IS GREATER THAN 90)
MOVE 19 TO HSLE9090-01-JUL-YY-12
ELSE
MOVE 20 TO HSLE9090-01-JUL-YY-12.
MOVE HSLE9090-03-DDD TO HSLE9090-01-JUL-DDD.
PERFORM 9999-VALIDATE-DATE THRU 9999-VALIDATE-DATE-EXIT.
IF (HSLE9090-01-RETURN-CODE IS NOT EQUAL TO ZERO)
GO TO 9999-DATE-ABORT.
9999-VALIDATE-DATE.
MOVE ZERO TO HSLE9090-01-DAY-OF-WEEK
HSLE9090-01-FIRST-DAY-OF-YEAR
HSLE9090-01-RETURN-CODE.
MOVE SPACE TO HSLE9090-01-MONTH-LITERAL.
MOVE 1985 TO HSLE9090-02-START-YEAR.
MOVE 1 TO HSLE9090-02-START-COUNTER.
MOVE ZERO TO HSLE9090-02-TARGET-YEAR
HSLE9090-02-SS
HSLE9090-02-TEMP-DDD.
IF (HSLE9090-01-JUL-DATE-R IS NOT NUMERIC)
MOVE 1 TO HSLE9090-01-RETURN-CODE
GO TO 9999-VALIDATE-DATE-EXIT.
MOVE HSLE9090-01-JUL-YYYY
TO HSLE9090-02-TARGET-YEAR.
MOVE HSLE9090-01-JUL-YYYY TO HSLE9090-01-GREG-YYYY
MOVE 2 TO HSLE9090-01-FIRST-DAY-OF-YEAR.
PERFORM 9999-INCREMENT-YEAR
UNTIL (HSLE9090-02-TARGET-YEAR IS EQUAL TO
HSLE9090-02-START-YEAR).
IF (HSLE9090-02-START-COUNTER IS EQUAL TO 4)
MOVE 29 TO HSLE9090-02-DAYS-IN-MONTH (2).
MOVE 1 TO HSLE9090-02-SS.
MOVE HSLE9090-01-JUL-DDD TO HSLE9090-02-TEMP-DDD.
PERFORM 9999-SUBTRACT-DAYS
UNTIL (HSLE9090-02-DAYS-IN-MONTH (HSLE9090-02-SS)
IS NOT LESS THAN HSLE9090-02-TEMP-DDD) OR
(HSLE9090-02-SS IS NOT LESS THAN 12).
IF (HSLE9090-02-SS IS EQUAL TO 12) AND
(HSLE9090-02-DAYS-IN-MONTH (12) IS LESS THAN
HSLE9090-02-TEMP-DDD)
MOVE 2 TO HSLE9090-01-RETURN-CODE
GO TO 9999-VALIDATE-DATE-EXIT
ELSE
MOVE HSLE9090-02-SS TO HSLE9090-01-GREG-MM
MOVE HSLE9090-02-TEMP-DDD TO HSLE9090-01-GREG-DD
MOVE HSLE9090-02-MONTH-DESC (HSLE9090-01-GREG-MM)
TO HSLE9090-01-MONTH-LITERAL
MOVE HSLE9090-01-JUL-DDD TO HSLE9090-02-TEMP-DDD
ADD HSLE9090-01-FIRST-DAY-OF-YEAR
TO HSLE9090-02-TEMP-DDD
SUBTRACT 1 FROM HSLE9090-02-TEMP-DDD
PERFORM 9999-SUBTRACT-7
UNTIL (HSLE9090-02-TEMP-DDD IS NOT GREATER THAN 7)
MOVE HSLE9090-02-TEMP-DDD TO HSLE9090-01-DAY-OF-WEEK.
9999-VALIDATE-DATE-EXIT.
EXIT.
9999-INCREMENT-YEAR.
ADD 1 TO HSLE9090-02-START-YEAR.
IF (HSLE9090-02-START-COUNTER IS NOT EQUAL TO 4)
ADD 1 TO HSLE9090-01-FIRST-DAY-OF-YEAR
ELSE
ADD 2 TO HSLE9090-01-FIRST-DAY-OF-YEAR.
IF (HSLE9090-01-FIRST-DAY-OF-YEAR IS GREATER THAN 7)
SUBTRACT 7 FROM HSLE9090-01-FIRST-DAY-OF-YEAR.
ADD 1 TO HSLE9090-02-START-COUNTER.
IF (HSLE9090-02-START-COUNTER IS EQUAL TO 5)
MOVE 1 TO HSLE9090-02-START-COUNTER.
9999-SUBTRACT-7.
SUBTRACT 7 FROM HSLE9090-02-TEMP-DDD.
9999-SUBTRACT-DAYS.
SUBTRACT HSLE9090-02-DAYS-IN-MONTH (HSLE9090-02-SS)
FROM HSLE9090-02-TEMP-DDD.
ADD 1 TO HSLE9090-02-SS.
9999-DATE-ABORT.
SNAP FROM HSLW9090-01 TO HSLE9090-01-END.
SNAP FROM HSLW9090-02 TO HSLE9090-02-END.
SNAP FROM HSLW9090-03 TO HSLE9090-03-END.
MOVE 'HSL' TO ERROR-STATUS.
PERFORM IDMS-STATUS.
MSEND
.
Back to Project 2000.
Back to HSL.
Hybrid Systems Ltd., Inc.
200 University Park Drive
Edwardsville, IL 62025
US 1-800-779-2802
Outside US 1-618-692-4757
E-mail: HSL