              <<< EISNER::DUA3:[NOTES$LIBRARY]ALGORITHMS.NOTE;1 >>>
                                -< algorithms >-
================================================================================
Note 33.8  Whats the best way to handle multiple date-time input formats  8 of 8
EISNER::WEISSBORN "BILL WEISSBORN"                  314 lines  16-NOV-1992 22:27
                             -< Here is the code >-
--------------------------------------------------------------------------------
As I promised, albeit a little late, here is the code I am using to verify
date/time in various input formats.  I think I have enough comments in the code
to make it fairly explanatory.  I have also included the "include" file and a
function that is called.  Feel free to comment/use/abuse.

Oh, yeah.  The code is formatted for 132 columns via the OPTIONS /EXTEND_SOURCE
line.

******************************  CUT HERE  *************************************
CMNT=EXTERNAL_TO_INTERNAL.FOR
C
C  NAME:	EXTERNAL_TO_INTERNAL
C
C  PURPOSE:
C	CONVERT A DATE/TIME FROM VARIOUS "EXTERNAL" FORMATS TO 
C	INTERNAL (YYYY/MM/DD:HH:MM) FORMAT.
C
C  SAMPLE CALL:
C	INTERNAL_FORMAT = EXTERNAL_TO_INTERNAL(EXTERNAL_DATE)
C
C  INPUTS:
C	EXTERNAL_DATE	C*17	DATE/TIME IN EXTERNAL FORMAT
C
C  OUTPUTS:
C	INTERNAL_FORMAT	C*16	DATE/TIME IN INTERNAL FORMAT
C
C  PERTINENT INFORMATION:
C	IF THE DATE PASSED TO THE FUNCTION IS INVALID, THEN THE
C	MESSAGE "INVALID DATE" IS RETURNED.
C
C
C  AUTHOR:	W.C. WEISSBORN
C
C  DATE:	31-OCT-1990
C
C  MODIFICATIONS:
C	ADDED SEVERAL VALID EXTERNAL FORMATS:
C		DD-MMM-YYYY:HH:MM
C		MM/DD/YY:HH:MM
C		MM/DD/YYYY:HH:MM
C		YYYY/MM/DD:HH:MM
C******************************************************************************
C

	OPTIONS /EXTEND_SOURCE

	CHARACTER*16	FUNCTION EXTERNAL_TO_INTERNAL(EXTERNAL_DATE)

	CHARACTER*(*)	EXTERNAL_DATE
	CHARACTER*23	MODIFIED_DATE
	INCLUDE 'GLOBAL.TXT'

	CHARACTER*17	CURRENT_TIME
	INTEGER*4 QUAD_TIME(2)
	INTEGER*4 STATUS
 	INCLUDE '($LIBDTDEF)'
	INCLUDE '($LIBDEF)'


C.......Declare the RTL routines we will be calling
	INTEGER*4       LIB$INIT_DATE_TIME_CONTEXT,
	1		LIB$FORMAT_DATE_TIME,
	1               LIB$SIGNAL,
	1		LIB$CONVERT_DATE_STRING

                                    
	INTEGER*4       INPUT_CONTEXT,
	1		OUTPUT_CONTEXT
                                                                               
	INTEGER*4	INPUT_COMPONENT,
	1		OUTPUT_COMPONENT

	INTEGER*4	CONVERT_FLAGS

	INTEGER*4	STR$UPCASE

C.......Define the date-formats that are valid
	CHARACTER*31	INTERNAL_FORMAT /'|!Y4/!MN0/!D0:!H04:!M0:!S0.!C2|'/
	INTEGER*2	NUM_FORMATS
	PARAMETER	(NUM_FORMATS=10)
	CHARACTER*35	EXTERNAL_FORMAT(NUM_FORMATS),NULLSTR

	DATA	EXTERNAL_FORMAT(1) /'|!D0-!MAAU-!Y4:!H04:!M0:!S0.!C2|'/		! DD-MMM-YYYY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(2) /'|!MN0/!D0/!Y2:!H04:!M0:!S0.!C2|'/		! MM/DD/YY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(3) /'|!MN0/!D0/!Y4:!H04:!M0:!S0.!C2|'/		! MM/DD/YYYY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(4) /'|!Y4/!MN0/!D0:!H04:!M0:!S0.!C2|'/		! YYYY/MM/DD:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(5) /'|!MN0-!D0-!Y2:!H04:!M0:!S0.!C2|'/		! MM-DD-YY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(6) /'|!MN0-!D0-!Y4:!H04:!M0:!S0.!C2|'/		! MM-DD-YYYY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(7) /'|!MAAU !D0, !Y2:!H04:!M0:!S0.!C2|'/	! MMM DD, YY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(8) /'|!MAAU !D0, !Y4:!H04:!M0:!S0.!C2|'/	! MMM DD, YYYY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(9) /'|!MAAU !D0,!Y2:!H04:!M0:!S0.!C2|'/		! MMM DD,YY:HH:MM:SS.SS
	DATA	EXTERNAL_FORMAT(10)/'|!MAAY !D0,!Y4:!H04:!M0:!S0.!C2|'/		! MMM DD,YYYY:HH:MM:SS.SS

	LOGICAL*1	VIRGIN /.TRUE./
	BYTE 		COLON_LOCATION
	INTEGER*4	I


	IF (EXTERNAL_DATE .EQ. ' ') THEN
	   EXTERNAL_TO_INTERNAL = ' '
	   RETURN
	ELSE IF (EXTERNAL_DATE .EQ. 'TODAY') THEN
	   CALL SYS$ASCTIM(,CURRENT_TIME,,)
	   CURRENT_TIME(12:12) = ':'
	   MODIFIED_DATE = CURRENT_TIME

	ELSE IF (EXTERNAL_DATE .EQ. 'NOW') THEN
	   CALL SYS$ASCTIM(,CURRENT_TIME,,)
	   CURRENT_TIME(12:12) = ':'
	   MODIFIED_DATE = CURRENT_TIME

	END IF

C.......There is a "bug" in the convert_date routine in that the seconds and fractional-seconds must be in the date/time.
C.......However, since there are 4 different formats that may be valid here, there is no longer any set location for 
C.......me to use to append the seconds/frac-seconds to.  Soooo, have to look for the ":" that seperates the time portion
C.......from the date portion.  Once I know that I can determine where to add the ":00.00"
	COLON_LOCATION = INDEX(EXTERNAL_DATE,':')
	MODIFIED_DATE = EXTERNAL_DATE(1:COLON_LOCATION+5)//':00.00'
	STATUS = STR$UPCASE(MODIFIED_DATE,MODIFIED_DATE)	!NO need to take chances here

	IF (VIRGIN) THEN
C..........Now define the external date context
	   OUTPUT_CONTEXT = 0
	   OUTPUT_COMPONENT = LIB$K_OUTPUT_FORMAT
	   STATUS = LIB$INIT_DATE_TIME_CONTEXT(OUTPUT_CONTEXT,OUTPUT_COMPONENT,INTERNAL_FORMAT)
	   IF (.NOT. STATUS) THEN
	      STATUS = LIB$SIGNAL(%VAL(STATUS))
	   END IF

C..........Make sure we do this for the first call only
	   VIRGIN = .FALSE.
                                     
	END IF

C.......NOW, we don't know what input format is being used so we have to loop thru all possible types
	I = 1
	STATUS = 0
	DO WHILE ((I .LE. NUM_FORMATS) .AND. (.NOT. STATUS))

C..........Have to "null-string" external_format(i) because lib$init_date_time_context does not like trailing blanks
	   EXTERNAL_FORMAT(I) = NULLSTR(EXTERNAL_FORMAT(I))

C..........Define the input date context
	   INPUT_CONTEXT = 0
	   INPUT_COMPONENT = LIB$K_INPUT_FORMAT
	   STATUS = LIB$INIT_DATE_TIME_CONTEXT(INPUT_CONTEXT,INPUT_COMPONENT,
	1	    				EXTERNAL_FORMAT(I)(1:INDEX(EXTERNAL_FORMAT(I),NULL)-1))
	   IF (.NOT. STATUS) THEN
	      STATUS = LIB$SIGNAL(%VAL(STATUS))
	   END IF


C..........Convert to VMS-internal 64-bit time format
	
	   STATUS = LIB$CONVERT_DATE_STRING(MODIFIED_DATE,
	1				 QUAD_TIME,
	1				 INPUT_CONTEXT,
	1				 ,	!FLAGS
	1				 ,		!DEFAULTS
	1				 )		!DEFAULTED-FIELD
	   IF (.NOT.STATUS) THEN
	      IF (STATUS .EQ. LIB$_IVTIME) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE IF (STATUS .EQ. LIB$_AMBDATTIM) THEN
C................Usually this is the status code we have returned when the input format doesn't match
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE IF (STATUS .EQ. LIB$_INCDATTIM) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE IF (STATUS .EQ. LIB$_ILLFORMAT) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE
	         STATUS = LIB$SIGNAL(%VAL(STATUS))
	      END IF
	   END IF
	   I = I + 1
	END DO

	IF (STATUS) THEN
C..........Came out of the loop ok
C..........Now format for output                               
	   STATUS = LIB$FORMAT_DATE_TIME(EXTERNAL_TO_INTERNAL,QUAD_TIME,OUTPUT_CONTEXT,,)   

	   IF (.NOT.STATUS) THEN
	      IF (STATUS .EQ. LIB$_IVTIME) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE IF (STATUS .EQ. LIB$_AMBDATTIM) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE IF (STATUS .EQ. LIB$_INCDATTIM) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE IF (STATUS .EQ. LIB$_ILLFORMAT) THEN
	         EXTERNAL_TO_INTERNAL = 'INVALID DATE'
	      ELSE
	         STATUS = LIB$SIGNAL(%VAL(STATUS))
	      END IF
	   END IF
	END IF

	RETURN

	END

*************************  CUT HERE *****************************************
! RENAME FROM GLOBAL.DEF TO GLOBAL.TXT
! 14-OCT-1992	W. C. WEISSBORN


! maximum character string lengths and string termination
      character*1   NULL
      parameter     (NULL = char(0))
      integer       MAXLINE
      parameter     (MAXLINE = 132)
      integer       MAXSTR
      parameter     (MAXSTR = 255)

!  file i/o parameters
      integer       MAXOPEN
      parameter     (MAXOPEN = 30)
      character*1   NEWLINE
      parameter     (NEWLINE = char(10))
      character*1   EOF
      parameter     (EOF = char(26))
      character*2   EOL
      parameter     (EOL = NEWLINE//NULL)
!  standard units
      integer       STDIN
      parameter     (STDIN = 5)
      integer       STDOUT
      parameter     (STDOUT = 6)
      integer       STDERR
      parameter     (STDERR = 7)
!  i/o unit access codes
      integer       IOERROR
      parameter     (IOERROR = -1)
      integer       IOREAD
      parameter     (IOREAD = -2)
      integer       IOWRITE
      parameter     (IOWRITE = -3)
      integer       IOAPPEND
      parameter     (IOAPPEND = -4)
      integer       IOFORTRAN
      parameter     (IOFORTRAN = -5)

!  command line arguments
      integer       MAXARGS
      parameter     (MAXARGS = 10)
      character*1   QUALIFIER
      parameter     (QUALIFIER = '-')

!  preprocessor buffer size
      integer       PPLINESIZE
      parameter     (PPLINESIZE = 2048)
!  other standard definitions
      character*1   COMMENT
      parameter     (COMMENT = '!')
      character*1   ESCAPE
      parameter     (ESCAPE = '\')
      character*1   WILDCARD
      parameter     (WILDCARD = '*')
      character*1   SKIPCARD
      parameter     (SKIPCARD = '~')
      integer       ENDLIST
      parameter     (ENDLIST = -2147483647)   ! -(2**31)

!  ascii characters
      character*1   BELL
      parameter     (BELL = char(7))
      character*1   BACKSPACE
      parameter     (BACKSPACE = char(8))
      character*1   TAB
      parameter     (TAB = char(9))
      character*1   LINEFEED
      parameter     (LINEFEED = char(10))
      character*1   FORMFEED
      parameter     (FORMFEED = char(12))
      character*1   CR
      parameter     (CR = char(13))
      character*1   ESC
      parameter     (ESC = char(27))
      character*1   BLANK
      parameter     (BLANK = char(32))
      character*1   APOSTROPHE
      parameter     (APOSTROPHE = char(39))  !' '
      character*1   DQUOTE
      parameter     (DQUOTE = char(34))      !" "
      character*1   QUOTE
      parameter     (QUOTE = APOSTROPHE)


******************************  CUT HERE **************************************

! nullstr  -  null-terminate an unterminated string

      character*(*) function nullstr (str)
      character*(*) str
      include       'global.txt'
      integer       i

      i = len(str)
      do while (i .gt. 0 .and. str(i:i) .eq. BLANK)
         i = i - 1
      end do
      if (i .eq. 0) then
         nullstr = NULL
      else
         nullstr = str(1:i)//NULL
      end if

      return
      end