COMCDTC 
COMMON
          CTEXT  COMCDTC - PACKED DATE AND TIME CONVERSION ROUTINES.
          SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCDTC
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4
***       DTC - PACKED DATE AND TIME CONVERSION ROUTINES. 
*         G. S. YODER.    89/05/11. 
          SPACE  4
***       DTC CONTAINS ROUTINES TO CONVERT PACKED FORMAT DATES AND
*         TIMES TO ELAPSED DAYS OR SECONDS AND BACK TO PACKED FORMAT. 
 EDP      SPACE  4,10 
***       EDP - CONVERT ELAPSED DAYS SINCE 70/01/01 TO PACKED FORMAT
*         DATE. 
* 
*         ENTRY  (X1) = ELAPSED DAYS SINCE 70/01/01 (0 TO 23375). 
* 
*         EXIT   (X6) = 42/ 0, 18/ YYMMDD.
* 
*         USES   X - 1, 2, 3, 6.
*                A - 2. 
*                B - 2. 
  
  
 EDP      SUBR               ENTRY/EXIT 
          SA2    EDPA 
          MX6    -15
          SB2    -B1
 EDP1     BX3    -X6*X2 
          SB2    B2+B1       COUNT YEAR 
          IX1    X1-X3
          LX2    15 
          PL     X1,EDP1     IF YEARS NOT EXHAUSTED 
          SX6    B2+         YEAR YY
          IX1    X1+X3       DAY IN YEAR YY 
          MX3    -2 
          BX3    -X3*X6 
          LX6    6
          SB2    X3-1 
          SX3    12+1 
          EQ     B2,B1,EDP2  IF YEAR YY IS LEAP YEAR
          SB2    B0+         CLEAR FEBRUARY 29 FLAG 
 EDP2     SX2    X3-2-1 
          SX3    X3-1 
          NZ     X2,EDP3     IF NOT FEBRUARY ENTRY
          SB2    B0+         CLEAR FEBRUARY 29 FLAG 
 EDP3     SA2    TDTM-1+X3   READ ENTRY 
          SX2    X2+B2       DAYS TO BEGINNING OF MONTH 
          IX2    X1-X2
          NG     X2,EDP2     IF NOT CORRECT MONTH 
          BX6    X6+X3       YYMM 
          SX2    X2+B1
          LX6    6
          BX6    X6+X2       YYMMDD 
          EQ     EDPX        RETURN 
  
 EDPA     VFD    15/365,15/366,15/365,15/365
 ETP      SPACE  4,15 
***       ETP - CONVERT ELAPSED SECONDS SINCE 70/01/01 00.00.00 TO
*         PACKED FORMAT DATE AND TIME.
* 
*         ENTRY  (X1) = ELAPSED SECONDS SINCE 70/01/01 00.00.00 (0 TO 
*                       2019686399).
* 
*         EXIT   (X6) = 24/ 0, 18/ YYMMDD, 18/ HHMMSS.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                B - 2. 
* 
*         CALLS  EDP. 
  
  
 ETP      SUBR               ENTRY/EXIT 
          SX3    86400
          PX2    X1 
          PX6    X3 
          NX6    X6 
          FX2    X2/X6
          UX2    B2,X2
          LX2    X2,B2       ELAPSED DAYS 
          IX3    X2*X3
          IX7    X1-X3
          BX1    X2 
          RJ     EDP         CONVERT ELAPSED DAYS 
          SX3    3600 
          PX2    X7 
          PX1    X3 
          NX1    X1 
          FX2    X2/X1
          UX2    X2,B2
          LX6    6
          LX2    X2,B2       HH 
          BX6    X6+X2       YYMMDDHH 
          IX2    X2*X3
          IX7    X7-X2       MM*60 + SS 
          SX3    60 
          PX2    X7 
          PX1    X3 
          NX1    X1 
          FX2    X2/X1
          UX2    X2,B2
          LX6    6
          LX2    X2,B2       MM 
          BX6    X6+X2       YYMMDDHHMM 
          IX2    X2*X3
          LX6    6
          IX7    X7-X2       SS 
          BX6    X6+X7       YYMMDDHHMMSS 
          EQ     ETPX        RETURN 
 PDE      SPACE  4,10 
***       PDE - CONVERT PACKED FORMAT DATE TO ELAPSED DAYS SINCE
*         70/01/01. 
* 
*         ENTRY  (X1) = 42/ 0, 18/ YYMMDD.
* 
*         EXIT   (X6) = ELAPSED DAYS. 
* 
*         USES   X - 1, 2, 3, 6.
*                A - 3. 
  
  
 PDE      SUBR               ENTRY/EXIT 
          MX3    -6 
          BX6    -X3*X1 
          AX1    6
          SX6    X6-1        DAYS SINCE FIRST OF MONTH
          BX2    -X3*X1 
          AX1    6           YEARS FROM 1970 TO YEAR YY 
          SX3    X2-3 
          NG     X3,PDE1     IF NOT PAST FEBRUARY 
          MX3    -2 
          BX3    -X3*X1 
          SX3    X3-2 
          NZ     X3,PDE1     IF NOT LEAP YEAR 
          SX6    X6+1        ADD FEBRUARY 29
 PDE1     SA3    TDTM-1+X2   DAYS FROM FIRST OF YEAR TO MONTH MM
          SX2    365
          IX6    X6+X3       DAYS SINCE FIRST OF YEAR 
          IX2    X1*X2       DAYS TO YY/01/01 EXCLUDING FEBRUARY 29 
          SX1    X1+B1
          AX1    2           LEAP YEARS TO YEAR YY
          IX6    X6+X2       DAYS TO YY/MM/DD EXCLUDING FEBRUARY 29 
          IX6    X6+X1       DAYS TO YY/MM/DD 
          EQ     PDEX        RETURN 
 PTE      SPACE  4,10 
***       PTE - CONVERT PACKED FORMAT DATE AND TIME TO ELAPSED SECONDS
*         SINCE 70/01/01 00.00.00.
* 
*         ENTRY  (X1) = 24/ 0, 18/ YYMMDD, 18/ HHMMSS.
* 
*         EXIT   (X6) = ELAPSED SECONDS.
* 
*         USES   X - 1, 2, 3, 6, 7. 
* 
*         CALLS  PDE. 
  
  
 PTE      SUBR               ENTRY/EXIT 
          MX3    -6 
          SX6    60 
          BX7    -X3*X1      SECONDS SINCE HH.MM.00 
          AX1    6
          BX2    -X3*X1 
          IX2    X2*X6
          IX6    X6*X6
          AX1    6
          BX3    -X3*X1 
          IX7    X7+X2       SECONDS SINCE HH.00.00 
          IX3    X3*X6
          AX1    6
          IX7    X7+X3       SECONDS SINCE 00.00.00 
          RJ     PDE         COMPUTE ELAPSED DAYS 
          SX3    86400
          IX6    X6*X3       SECONDS TO YY/MM/DD
          IX6    X6+X7       SECONDS TO YY/MM/DD HH.MM.SS 
          EQ     PTEX        RETURN 
 TDTM     SPACE  4,10 
*         TABLE OF DAYS TO BEGINNING OF MONTH EXCLUDING FEBRUARY 29.
  
  
 TDTM     BSS    0
          CON    0           JANUARY
          CON    31          FEBRUARY 
          CON    59          MARCH
          CON    90          APRIL
          CON    120         MAY
          CON    151         JUNE 
          CON    181         JULY 
          CON    212         AUGUST 
          CON    243         SEPTEMBER
          CON    273         OCTOBER
          CON    304         NOVEMBER 
          CON    334         DECEMBER 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 EDP      EQU    /COMCDTC/EDP 
 ETP      EQU    /COMCDTC/ETP 
 PDE      EQU    /COMCDTC/PDE 
 PTE      EQU    /COMCDTC/PTE 
 QUAL$    ENDIF 
          ENDX
