OpenVMS Source Code Demos

This function returns the current date and time in "ccyymmddhhmmss" format.

WCSM_dt_stamp.fun

	!
	function string Wcsm_DT_Stamp
	!+
	!===================================================================================================================
	! Title  : Wcsm_DT_Stamp_100?.inc
	! Author : Neil S. Rieck
	! Purpose: an external function to return a y2k compliant system time in the form ccyymmddhhmmss (14 chars)
	! Notes  : all our programs call this function so optimizations here will speed up the whole system
	! History:
	! 100a NSR 911229 1. original work
	!      NSR 940423 2. changed 'ON ERROR' to 'WHEN ERROR'
	! 100b NSR 961108 1. cleaned up
	! 100c NSR 961108 1. optimized
	! 100d NSR ?????? 1. optimized
	! 100e NSR 980618 1. optimized
	!		  2. added XX to month names so adding a skew wouldn't be necessary
	!		  3. replaced left hand mid$ with tens mapping
	! 100f NSR 980619 1. optimized
	!		  2. added some code so I could remove the call to RSET (this may increase the size of both $PDATA
	!		     and $CODE but might reduce execution time by avoiding one call to the BASIC RTL. Only
	!		     benchmarking will determine wether this change is better or worse)
	!===================================================================================================================
	! Usage:
	!
	! 1. please include the next line near the top of your source
	!    program (after 'option type=explicit' )
	!
	!	external string function Wcsm_DT_Stamp (string, long)
	!
	! 2. please include the next 2 lines near the bottom of of your
	!    source program (after 'END' of the main module)
	!
	!	%include "[.fun]wcsm_dt_stamp.fun"
	!!	! function string Wcsm_DT_Stamp
	!===================================================================================================================
	!-
	option   type=explicit							! cuz tricks are for kids...
	!
	external long function sys$asctim
	!
	declare  long sys_status
	!
	!	this map is required for the call to sys$asctim (format: 19-JUN-1998 23:59:59.1)
	!
	map (WcsmDTStamp0)	string	Sys_buf_22	= 22
	map (WcsmDTStamp0)	string	Sys_day		=  2,	!	&
					Sys_dash1	=  1,	!-	&
					Sys_month	=  3,	!	&
					Sys_dash2	=  1,	!-	&
					Sys_year	=  4,	!	&
					Sys_space	=  1,	!	&
					Sys_Hour	=  2,	!	&
					Sys_colon1	=  1,	!:	&
					Sys_Minute	=  2,	!	&
					Sys_colon2	=  1,	!:	&
					Sys_Second	=  2,	!	&
					Sys_period	=  1,	!.	&
					Sys_Tenth	=  1	!
	!
	!	map for Wcsm date (output)
	!
	map (WcsmDTStamp1)	string	Wcsm_buf_14	= 14	!
	map (WcsmDTStamp1)	string	Wcsm_year	=  4,	!	&
					Wcsm_month	=  2,	!	&
					Wcsm_day	=  2,	!	&
					Wcsm_Hour	=  2,	!	&
					Wcsm_Minute	=  2,	!	&
					Wcsm_Second	=  2
	map (WcsmDTStamp1)	string	Wcsm_year	=  4,	!	&
					Wcsm_month_tens	=  1,	!	&
					Wcsm_month_ones	=  1,	!	&
					Wcsm_day_tens	=  1,	!	&
					Wcsm_day_ones	=  1,	!	&
					Wcsm_Hour	=  2,	!	&
					Wcsm_Minute	=  2,	!	&
					Wcsm_Second	=  2
	!
	!	string constants
	!					  00000000011111111112222222222333333333
	!					  12345678901234567890123456789012345678
	declare string constant k_month_names$ = "XXJANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
	!					  ||
	!					  ++-- so I don't have to provide an offset in pos()
	declare string constant my_space = '32'C
	!
	!	<<< function 'code' starts here >>>
	!
	when error in
		!
		sys_status = sys$asctim(,Sys_buf_22,,)				! get ASCII time into sys_buf_22
!~~~		if (sys_status and 7%) <> 1% then cause error 11		x  not required - call will never fail
		!
		!	transfer data from one map to the other
		!	
		Wcsm_year	= Sys_year					!
!~~~	rset	Wcsm_month	= str$( pos(k_month_names$,Sys_Month,1%) / 3%)	x					bf_100f
		Wcsm_day	= Sys_day					!
		Wcsm_hour	= Sys_hour					!
		Wcsm_minute	= Sys_minute					!
		Wcsm_second	= Sys_second					!
		!
		declare long temp%						!					bf_100f
		temp% = pos(k_month_names$,Sys_Month,1%) / 3%			! compute month number			bf_100f
		if temp% < 10% then						! if less than 10...			bf_100f
		    Wcsm_month_ones	= str$(temp%)				! ...then this goes into ONES		bf_100f
		    Wcsm_month_tens	= "0"					! ...and this goes into TENS		bf_100f
		else								! else >= 10				bf_100f
		    Wcsm_month		= str$(temp%)				!					bf_100f
		end if
		!
		!	make sure there are no spaces in the TENS area of our mapped variables (pad with '0' if necessary)
		!
!~~~		Wcsm_month_tens = "0"	if Wcsm_month_tens	= my_space	x disabled - see above code		bf_100f
		Wcsm_day_tens	= "0"	if Wcsm_day_tens	= my_space	!
		!
		!	now pass result back to caller
		!
		Wcsm_DT_Stamp = Wcsm_Buf_14					! this is it folks
	use
		Wcsm_DT_Stamp = ""						! error so return blank
	end when
	!
	END Function

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.