%CONSTINTEGER SECSIN24HRS=86400;        ! SECS IN DAY
%CONSTINTEGER DAYS70=25567;             ! DAYS FROM JAN1 1900 TO JAN1 1970
%CONSTLONGINTEGER SECS70=X'0000000083AA7E80';! SECS DITTOM
%ROUTINE KDATE(%INTEGERNAME D,M,Y,%INTEGER K)
!***********************************************************************
!*    K IS DAYS SINCE 1ST JAN 1900                                     *
!*    RETURNS D, M, Y   2 DIGIT Y ONLY                                 *
!***********************************************************************
!      %INTEGER W
!      K=K+693902;                       ! DAYS SINCE CEASARS BDAY
!      W=4*K-1
!      Y=W//146097
!      K=W-146097*Y
!      D=K//4
!      K=(4*D+3)//1461;
!      D=4*D+3-1461*K
!      D=(D+4)//4
!      M=(5*D-3)//153
!      D=5*D-3-153*M
!      D=(D+5)//5
!      Y=K
      *LSS_K; *IAD_693902
      *IMY_4; *ISB_1; *IMDV_146097
      *LSS_%TOS; *IDV_4; *IMY_4; *IAD_3
      *IMDV_1461; *ST_(Y)
      *LSS_%TOS; *IAD_4; *IDV_4
      *IMY_5; *ISB_3; *IMDV_153
      *ST_(M); *LSS_%TOS
      *IAD_5; *IDV_5; *ST_(D)
      %IF M<10 %THEN M=M+3 %ELSE M=M-9 %AND Y=Y+1
%END; ! OF KDATE
%INTEGERFN CURRENT PACKED DT
!***********************************************************************
!*    GIVES CURRENT DT IN NEW PACKED FORM                              *
!***********************************************************************
%CONSTLONGINTEGER MILL=1000000
      *RRTC_0; *USH_-1
      *SHS_1; *USH_1
      *IMDV_MILL
      *ISB_SECS70; *STUH_%B
      *EXIT_-64
%END
%ROUTINE DECWRITE2(%INTEGER VALUE,AD)
!***********************************************************************
!*    WRITES VALUE AS TWO DECIMAL ISO DIGITS INTO AD AND AD+1          *
!***********************************************************************
      *LSS_VALUE; *IMDV_10
      *USH_8; *IAD_%TOS; *IAD_X'3030'
      *LDA_AD; *LDTB_X'58000002'
      *ST_(%DR)
%END; ! OF DECWRITE2
%STRING(8)%FN UPDATE TIME(%INTEGER P)
!***********************************************************************
!*    P IS TIME IN SECS TO BE ADDED TO CURRENT TIME                    *
!***********************************************************************
%INTEGER H,M,SECS,AT,D,Y
%STRING(17)S
      AT=ADDR(S)
      S="00/00/00 00.00.00"
      P=CURRENT PACKED DT+P
      KDATE(D,M,Y,(P//SECSIN24HRS)+DAYS70)
      DECWRITE2(D,AT+1)
      DECWRITE2(M,AT+4)
      DECWRITE2(Y,AT+7)
      *LSS_P; *USH_1; *USH_-1
      *IMDV_60; *IMDV_60; *IMDV_24
      *LSS_%TOS; *ST_H
      *LSS_%TOS; *ST_M
      *LSS_%TOS; *ST_SECS
      DECWRITE2(H,AT+10)
      DECWRITE2(M,AT+13)
      DECWRITE2(SECS,AT+16)
      %RESULT=S
%END
%ENDOFFILE