I wrote this cobol program years ago to fix problems I kept seeing
with the hardware clock being out of sync with the software clock and
that can cause all sorts of problems when switching your clock when
DST comes and goes. I also wrote a short command file to take care
of the date change years ago, basically I had it in our MasterOp
scheduler so it was all automatic, but you can just schedule it for
Sundays and you're set (adjust the W#:## for your timezone offset).
!IF HPMONTH = 10 AND HPDATE > 24 THEN
! ECHO We are going back to Standard Time
! SETCLOCK TIMEZONE = W8:00
!ENDIF
!IF HPMONTH = 4 AND HPDATE < 8 THEN
! ECHO Setting clock for Daylight Savings Time
! SETCLOCK TIMEZONE = W7:00
!
!ENDIF
002000$CONTROL USLINIT, NOWARN, BOUNDS, POST85
003400 IDENTIFICATION DIVISION.
003500 PROGRAM-ID. CLOCKFIX.
003600 AUTHOR. Shawn M. Gordon.
003700 INSTALLATION. S.M.GORDON & ASSOCIATES.
003800 DATE-WRITTEN. FRI, APR 17, 1998.
003900*
004000************************************************************
004100* This program will check your system to see if you hardware
004200* and software clocks are out of sync. If they are then
004300* we prompt for a few pieces of information.
004400*
004500* ----------- change history ---------------
004600*
004700* 1998/12/10 SMG - Added test for SM or OP cap, and gracefully
004800* terminate if it's not there.
004900************************************************************
005000*
005100 ENVIRONMENT DIVISION.
005200 CONFIGURATION SECTION.
005300 DATA DIVISION.
005400 WORKING-STORAGE SECTION.
005500
005600 01 ERR PIC S9(4) COMP VALUE 0.
005700 01 ERR-LEN PIC S9(4) COMP VALUE 0.
005800 01 ERR-PARM PIC S9(4) COMP VALUE 0.
005900 01 MSG-LEVEL PIC S9(4) COMP VALUE 0.
006000 01 CALC-TZ PIC S9(1) VALUE 0.
006100 01 HOLD-TZ PIC 9 VALUE 0.
006200
006300 01 MY-TZ PIC X(08) VALUE SPACES.
006400 01 MY-INTERVAL PIC X(08) VALUE SPACES.
006500 01 MY-TIME PIC X(06) VALUE SPACES.
006600 01 MY-TIMEZONE.
006700 03 MYT-HEM PIC X VALUE SPACES.
006800 03 MYT-ZONE PIC X(05) VALUE SPACES.
006900 01 MY-BUFF PIC X(80) VALUE SPACES.
007000
007100
007200 01 WS-DST PIC X VALUE SPACES.
007300 01 WS-TZ PIC X VALUE SPACES.
007400 01 WS-GN PIC X VALUE SPACES.
007500 01 VAR-NAME PIC X(40) VALUE "TZ".
007600 01 VAR-STRING PIC X(255) VALUE SPACES.
007700*
007800 01 VAR-STATUS.
007900 03 VS-1 PIC S9(4) COMP VALUE 0.
008000 03 VS-2 PIC S9(4) COMP VALUE 0.
008100*
008200 01 COM-IMAGE.
008300 03 COMMAND-IMAGE PIC X(255) VALUE SPACES.
008400 03 PIC X VALUE %15.
008500 01 COMMAND-ERROR PIC S9(4) BINARY VALUE 0.
008600
008700 01 CAPS.
008800 03 CFULL PIC S9(9) COMP VALUE 0.
008900 03 CREDEF REDEFINES CFULL.
009000 05 CWORD1 PIC S9(4) COMP.
009100 05 CWORD2 PIC S9(4) COMP.
009200
009300 01 NUMBYTES PIC S9(4) COMP VALUE 16.
009400 01 BYTEFUNC PIC S9(4) COMP VALUE 1.
009500 01 BYTERR PIC S9(4) COMP VALUE 0.
009600
009700 01 BYTEMAP.
009800 03 PIC X VALUE SPACE.
009900 88 SMCAP VALUE "1".
010000 03 PIC X(04) VALUE SPACES.
010100 03 PIC X VALUE SPACES.
010200 88 OPCAP VALUE "1".
010300 03 PIC X(10) VALUE SPACES.
010400
010500 01 FULL-CURRENT-DATE.
010600 03 F-DATE.
010700 05 F-YEAR PIC 9(4).
010800 05 F-MONTH PIC 99.
010900 05 F-DAY PIC 99.
011000 03 F-TIME.
011100 05 F-HOUR PIC 99.
011200 05 F-MINUTES PIC 99.
011300 05 F-SECONDS PIC 99.
011400 05 F-SEC-HUND PIC 99.
011500 03 C-TIME-DIFF.
011600 05 C-GMT-DIR PIC X.
011700 05 C-HOUR PIC 99.
011800 05 C-MINUTES PIC 99.
011900
012000 01 DATE-BUFF PIC X(27) VALUE SPACES.
012100 01 C-DATE PIC X(08) VALUE SPACES.
012200 01 C-TIME PIC X(08) VALUE SPACES.
012300 01 CURR-DATE PIC X(10) VALUE SPACES.
012400 01 HOLD-DATE PIC X(06) VALUE SPACES.
012500
012600 PROCEDURE DIVISION.
012700 A0000-MACROS.
012800$DEFINE %COMIMAGE=
012900 DISPLAY !1
013000 INITIALIZE COMMAND-IMAGE
013100 MOVE !1
013200 TO COMMAND-IMAGE
013300 CALL INTRINSIC 'HPCICOMMAND' USING COM-IMAGE,
013400 COMMAND-ERROR,
013500 ERR-PARM,
013600 MSG-LEVEL#
013700*
013800
013900 A1000-INTRO.
014000 CALL INTRINSIC "WHO" USING \\, CFULL.
014100 CALL "BITMAPCNV" USING CWORD1, @BYTEMAP, NUMBYTES,
014200 BYTEFUNC, BYTERR.
014300 IF BYTERR <> 0
014400 DISPLAY 'Failure in BITMAPCNV ' BYTERR.
014500 IF SMCAP OR OPCAP
014600 GO TO A1000-BEGIN.
014700
014800 DISPLAY 'Must have SM or OP capability.'
014900 STOP RUN.
015000
015100 A1000-BEGIN.
015200* retrieve all the dates in all the formats.
015300 MOVE FUNCTION CURRENT-DATE TO FULL-CURRENT-DATE.
015400 DISPLAY 'Current offset from GMT: ' C-GMT-DIR C-HOUR ":"
015500 C-MINUTES.
015600 MOVE CURRENT-DATE TO CURR-DATE.
015700 ACCEPT C-DATE FROM DATE.
015800 CALL INTRINSIC 'DATELINE' USING DATE-BUFF.
015900 ACCEPT C-TIME FROM TIME.
016000
016100* format the century into the applicable dates.
016200 MOVE C-DATE TO HOLD-DATE.
016300 MOVE CURR-DATE(7:2) TO CURR-DATE(9:2).
016400 MOVE DATE-BUFF(14:2) TO C-DATE(1:2)
016500 CURR-DATE(7:2).
016600 MOVE HOLD-DATE TO C-DATE(3:).
016700
016800* get the TZ variable.
016900 CALL INTRINSIC "HPCIGETVAR" USING VAR-NAME, VAR-STATUS,
017000 2, VAR-STRING,
017100 0.
017200 IF VS-1 = -8106 OR VAR-STRING = SPACES
017300 DISPLAY SPACES
017400 DISPLAY 'No TZ variable is set, I will '
017500 'show you the correct value,'
017600 DISPLAY 'after you answer some questions.'
017700 DISPLAY SPACES
017800 GO TO A1000-TEST
017900 ELSE
018000 DISPLAY 'Current value of TZ var: ' VAR-STRING(1:16).
018100
018200* if the date and time match then there is nothing to do.
018300 IF (F-TIME(1:4) = C-TIME(1:4)) AND (F-DATE = C-DATE)
018400 DISPLAY 'Your hardware clock is properly set'.
018500 STOP RUN.
018600
018700 A1000-TEST.
018800 IF F-TIME(1:4) <> C-TIME(1:4)
018900 DISPLAY 'WARNING: '
019000 "Hardware clock doesn't match the software clock"
019100 DISPLAY 'Hardware clock = ' F-HOUR ":" F-MINUTES
019200 DISPLAY 'Software clock = ' C-TIME(1:2) ":" C-TIME(3:2)
019300 DISPLAY SPACES.
019400
019500 IF F-DATE <> C-DATE
019600 DISPLAY "WARNING: Hardware date doesn't match the "
019700 'software date'
019800 DISPLAY 'Hardware date = ' F-DATE
019900 DISPLAY 'Software date = ' C-DATE
020000 DISPLAY SPACES.
020100
020200 DISPLAY 'Is it currently Daylight Savings Time? '
020300 NO ADVANCING.
020400 ACCEPT WS-DST FREE.
020500
020600 DISPLAY 'Please select one of the following as your '
020700 'TimeZone'.
020800 A1000-TZ.
020900 DISPLAY SPACES.
021000 DISPLAY '1. Eastern European Time (EET-2DST)'.
021100 DISPLAY '2. Middle European Time (MET-1DST)'.
021200 DISPLAY '3. Western European Time (GMT0BST)'.
021300 DISPLAY '4. Atlantic Time (AST4ADT)'.
021400 DISPLAY '5. Eastern Time (EST5EDT)'.
021500 DISPLAY '6. Central Time (CST6CDT)'.
021600 DISPLAY '7. Mountain Time (MST7MDT)'.
021700 DISPLAY '8. Pacific Time (PST8PDT)'.
021800 DISPLAY '9. Yukon Time (YST9YDT)'.
021900 DISPLAY SPACES.
022000 DISPLAY ' Enter Option: ' NO ADVANCING.
022100 ACCEPT WS-TZ FREE.
022200 EVALUATE WS-TZ
022300 WHEN '1' MOVE 'EET-2DST' TO MY-TZ
022400 WHEN '2' MOVE 'MET-1DST' TO MY-TZ
022500 WHEN '3' MOVE 'GMT0BST' TO MY-TZ
022600 WHEN '4' MOVE 'AST4ADT' TO MY-TZ
022700 WHEN '5' MOVE 'EST5EDT' TO MY-TZ
022800 WHEN '6' MOVE 'CST6CDT' TO MY-TZ
022900 WHEN '7' MOVE 'MST7MDT' TO MY-TZ
023000 WHEN '8' MOVE 'PST8PDT' TO MY-TZ
023100 WHEN '9' MOVE 'YST9YDT' TO MY-TZ
023200 WHEN ' ' GO TO C9000-EOJ
023300 WHEN OTHER DISPLAY 'Invalid value' GO TO A1000-TZ
023400 END-EVALUATE.
023500
023600 DISPLAY SPACES.
023700 DISPLAY 'I am now ready to fix your hardware clock.'.
023800 DISPLAY 'Choose one of the following options'.
023900 DISPLAY '1. Gradually change the time over an hour'.
024000 DISPLAY '2. Change the time immediately.
024100 DISPLAY SPACES.
024200 DISPLAY ' Enter Option: ' NO ADVANCING.
024300 ACCEPT WS-GN FREE.
024400 IF WS-GN = '2'
024500 MOVE 'NOW' TO MY-INTERVAL
024600 ELSE
024700 MOVE 'GRADUAL' TO MY-INTERVAL.
024800
024900 PERFORM B1000-DO-IT THRU B1000-EXIT.
025000 PERFORM B2000-SHOW-TZ THRU B2000-EXIT.
025100 GO TO C9000-EOJ.
025200 A1000-EXIT. EXIT.
025300*
025400 B1000-DO-IT.
025500 MOVE CURRENT-DATE TO CURR-DATE.
025600 MOVE CURR-DATE(7:2) TO CURR-DATE(9:2).
025700 CALL INTRINSIC 'DATELINE' USING DATE-BUFF.
025800 MOVE DATE-BUFF(14:2) TO CURR-DATE(7:2).
025900 MOVE TIME-OF-DAY TO C-TIME.
026000 MOVE SPACES TO MY-TIME.
026100 STRING C-TIME(1:2) ":" C-TIME(3:2)
026200 DELIMITED BY SIZE INTO MY-TIME.
026300
026400* Fix the timezone first - construct the offset by calculating
026500* the dst value first, and putting the right hemisphere in it
026600 IF MY-TZ(4:1) IS NUMERIC
026700 MOVE MY-TZ(4:1) TO CALC-TZ.
026800 IF MY-TZ(5:1) IS NUMERIC
026900 MOVE MY-TZ(5:1) TO CALC-TZ
027000 MULTIPLY -1 BY CALC-TZ.
027100
027200 MOVE SPACES TO MY-TIMEZONE
027300 IF CALC-TZ < 0
027400 MOVE 'E' TO MYT-HEM
027500 ELSE
027600 MOVE 'W' TO MYT-HEM.
027700
027800 IF WS-DST = 'Y' OR 'y'
027900 SUBTRACT 1 FROM CALC-TZ.
028000
028100 MOVE CALC-TZ TO HOLD-TZ.
028200 IF MYT-HEM = 'E'
028300 STRING "-" HOLD-TZ ":00" DELIMITED BY SIZE
028400 INTO MYT-ZONE.
028500 IF MYT-HEM = 'W'
028600 STRING HOLD-TZ ":00" DELIMITED BY SIZE
028700 INTO MYT-ZONE.
028800
028900 MOVE SPACES TO MY-BUFF.
029000 STRING "SETCLOCK TIMEZONE=" DELIMITED BY SIZE
029100 MY-TIMEZONE DELIMITED BY SPACES
029200 INTO MY-BUFF.
029300 %COMIMAGE(MY-BUFF#).
029400
029500* Cancel the change to get an immediate timezone impact.
029600 %COMIMAGE("SETCLOCK;CANCEL"#).
029700
029800* Now set the correct date and time values.
029900 STRING "SETCLOCK DATE="
030000 CURR-DATE
030100 ";TIME="
030200 MY-TIME
030300 ";"
030400 MY-INTERVAL DELIMITED BY SIZE
030500 INTO MY-BUFF.
030600 %COMIMAGE(MY-BUFF#).
030700
030800 B1000-EXIT. EXIT.
030900*
031000 B2000-SHOW-TZ.
031100 DISPLAY SPACES.
031200 DISPLAY 'You will want to set up the following command '
031300 'as a system logon UDC;'.
031400 DISPLAY 'SETVAR TZ,"' MY-TZ '"'.
031500 DISPLAY SPACES.
031600 B2000-EXIT. EXIT.
031700
031800 C9000-EOJ.
031900 DISPLAY 'Normal termination at ' TIME-OF-DAY.
032000 STOP RUN.
Regards,
Shawn Gordon
President
theKompany.com
www.thekompany.com
www.mindawn.com
949-713-3276
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
