dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
This from Bill O'Boyle:
| Code: |
************************************************************************
* FOR COBOL/370 AND GREATER. NOT VALID FOR VS/COBOL II OR *
* OS/VS COBOL. *
************************************************************************
03 WS-CURRENT-DATE-REC PIC X(21).
03 FILLER REDEFINES WS-CURRENT-DATE-REC.
05 WS-CURRENT-DATE PIC 9(08).
05 WS-CURRENT-TIME PIC 9(08).
05 WS-CURRENT-GMT-SIGN
PIC X(01).
05 WS-CURRENT-GMT-HHMM
PIC 9(04).
03 WS-NEXT-DAY-DATE PIC 9(08).
*
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE-REC.
COMPUTE WS-NEXT-DAY-DATE = (FUNCTION DATE-OF-INTEGER
(FUNCTION INTEGER-OF-DATE
(WS-CURRENT-DATE) + 1)).
************************************************************************
* FOR 'LANGUAGE ENVIRONMENT' LPAR'S, WITH VS/COBOL II OR *
* OS/VS COBOL. OPTIONALLY, CAN ALSO BE USED IN COBOL/370 AND *
* GREATER AS 'LANGUAGE ENVIRONMENT' WAS INTEGRATED WITH THE *
* COMPILER. *
************************************************************************
03 WS-CEELOCT PIC X(08) VALUE 'CEELOCT'.
03 WS-CEELOCT-LILIAN-DAYS
PIC S9(09) COMP.
03 WS-CEELOCT-SECONDS COMP-2.
03 WS-CEELOCT-GREG-REC PIC X(17).
03 FILLER REDEFINES WS-CEELOCT-GREG-REC.
05 WS-CEELOCT-GREG PIC 9(08).
05 WS-CEELOCT-GREG-X
REDEFINES WS-CEELOCT-GREG
PIC X(08).
05 WS-CEELOCT-TIME PIC 9(09).
03 WS-CEELOCT-FEEDBACK PIC X(12).
03 WS-CEEDATE PIC X(08) VALUE 'CEEDATE'.
03 WS-CEEDATE-DATA-REC PIC X(258).
03 FILLER REDEFINES WS-CEEDATE-DATA-REC.
05 WS-CEEDATE-DATA-LGTH
PIC S9(04) COMP.
05 WS-CEEDATE-DATA PIC X(256).
03 WS-CEEDATE-PICTURE-REC
PIC X(258).
03 FILLER REDEFINES WS-CEEDATE-PICTURE-REC.
05 WS-CEEDATE-PICTURE-LGTH
PIC S9(04) COMP.
05 WS-CEEDATE-PICTURE
PIC X(256).
03 WS-CEEDATE-FEEDBACK PIC X(12).
03 WS-FWORD PIC 9(08) COMP.
03 WS-FWORD-X REDEFINES WS-FWORD
PIC X(04).
03 FILLER REDEFINES WS-FWORD.
05 WS-HWORD-1 PIC 9(04) COMP.
05 WS-HWORD-2 PIC 9(04) COMP.
03 WS-DISPLAY-MSG PIC X(69).
03 FILLER REDEFINES WS-DISPLAY-MSG.
05 FILLER PIC X(39).
05 WS-DISPLAY-SEVERITY
PIC 9(02).
05 FILLER PIC X(15).
05 WS-DISPLAY-MSG-NBR
PIC 9(02).
05 FILLER PIC X(11).
*
CALL WS-CEELOCT USING WS-CEELOCT-LILIAN-DAYS,
WS-CEELOCT-SECONDS,
WS-CEELOCT-GREG-REC,
WS-CEELOCT-FEEDBACK.
*
MOVE WS-CEELOCT-FEEDBACK TO WS-FWORD-X.
*
IF WS-FWORD NOT = ZERO
MOVE 'ERROR CALLING ''CEELOCT'', SEVERITY ===> , MSG-NB
- 'R ===>' TO WS-DISPLAY-MSG
MOVE WS-HWORD-1 TO WS-DISPLAY-SEVERITY
MOVE WS-HWORD-2 TO WS-DISPLAY-MSG-NBR
DISPLAY WS-DISPLAY-MSG
STOP RUN.
*
ADD 1 TO WS-CEELOCT-LILIAN-DAYS
GIVING WS-CEEDATE-LILIAN-DAYS.
MOVE 8 TO WS-CEEDATE-DATA-LGTH.
MOVE WS-CEELOCT-GREG-X TO WS-CEEDATE-DATA.
MOVE 8 TO WS-CEEDATE-PICTURE-LGTH.
MOVE 'YYYYMMDD' TO WS-CEEDATE-PICTURE.
*
CALL WS-CEEDATE USING WS-CEEDATE-DATA-REC,
WS-CEEDATE-PICTURE-REC,
WS-CEEDATE-LILIAN-DAYS,
WS-CEEDATE-FEEDBACK.
*
MOVE WS-CEEDATE-FEEDBACK TO WS-FWORD-X.
*
IF WS-FWORD NOT = ZERO
MOVE 'ERROR CALLING ''CEEDATE'', SEVERITY ===> , MSG-NB
- 'R ===>' TO WS-DISPLAY-MSG
MOVE WS-HWORD-1 TO WS-DISPLAY-SEVERITY
MOVE WS-HWORD-2 TO WS-DISPLAY-MSG-NBR
DISPLAY WS-DISPLAY-MSG
STOP RUN. |
Bill |
|
