*DECK DATEVAL 
          IDENT  DATEVAL
*CALL COPYRITE
          ENTRY  DATEVAL
          SYSCOM B1 
          TITLE  DATEVAL - VALIDATE AND CONVERT DATE. 
          COMMENT  DATEVAL - VALIDATE AND CONVERT DATE. 
          COMMENT - COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
 DATEVAL  SPACE  4,10 
**        DATEVAL - VALIDATE AND CONVERT DATE.
* 
*         *DATEVAL* WILL CONVERT A SUPPLIED DISPLAY CODED DATE TO A 
*         BINARY VALUE AND CHECK THE VALIDITY OF THE ENTRY. 
* 
*         *SYMPL* CALL -
*         DATEVAL (DATEDC, DATEBIN, STATUS) 
* 
*         ENTRY  (DATEDC)  = DATE IN DISPLAY CODE.
*                            YYMMDD, LEFT JUSTIFIED.
* 
*         EXIT   (DATEBIN) = DATE IN 18 BIT FORMAT. 
*                (STATUS)  = 0, VALID DATE. 
*                          = -1, INVALID DATE.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
*                B - 0, 1.
* 
*         CALLS  VDT. 
  
  
 DATEVAL  SUBR               ENTRY/EXIT 
          SB1    1           DEFINE B1=1
          SA1    A1          SAVE PARAMETER ADDRESSES 
          SA2    A1+B1
          SA3    A2+B1
          BX6    X1 
          SA6    DATEDC 
          BX6    X2 
          SA6    DATEBIN
          BX6    X3 
          SA6    STATUS 
          SA1    DATEDC      DATEDC INTO X1 FOR VDT CALL
          SA1    X1 
          SX2    B0          X2=0 TO CONVERT DATE 
          RJ     VDT
          NG     X1,ERROR    DATE ALREADY EXPIRED 
          NG     X6,ERROR    ERROR IN CONVERSION
          SA1    DATEBIN     X6 FROM VDT CALL INTO DATEBIN
          SA6    X1 
          SX7    B0          VALID STATUS 
          SA2    STATUS 
          SA7    X2 
          EQ     DATEVALX    RETURN 
 ERROR    SX7    -1          INVALID STATUS 
          SA2    STATUS 
          SA7    X2 
          EQ     DATEVALX    RETURN 
 DATEDC   BSS    1           ADDR OF DATEDC 
 DATEBIN  BSS    1           ADDR OF DATEBIN
 STATUS   BSS    1           ADDR OF STATUS 
  
 OPL      XTEXT  COMCDXB
 OPL      XTEXT  COMCVDT
  
          END 
