tldm-universe/Ardent/UV/APP.PROGS/01B0

subroutine U01B0( proc, ibn, pib, sib, ip, obn, pob, sob )
*******************************************************************************
*
*	Return date and/or time to a ProVerb
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	11/21/94 15189 GMH Add READU
*	01/14/91 7930  JWT Added new Ucode for Siemens/Nixdorf
*	24/10/89  BHX  creation of the source
*
*******************************************************************************
*
*	This "user-exit", called from a ProVerb, returns the date and/or time
* of the systeme
*
*	Usage:
*		U11B0
*		What Target
*		error return
*		success return
*
*	Where "What" can be:
*		T - Time of the system
*			U01B0 : in milliseconds since midnight
*			U11B0 : in form hh:mm:ss
*			U31B0 : like U01B0 in hexadecimal
*		D - Date of the system
*			U01B0 : in number of days since 31 DEC 1967
*			U11B0 : in form dd mmm aa
*			U31B0 : like U01B0 in hexadecimal
*		TD - time and date of the system
*			U01B0 : the 2 results are separated by '\'
*			U11B0 : the 2 results are separated by 2 blanks
*			U31B0 : the 2 results are separated by '\'
*
*	Where "Target" can be:
*		T - terminal
*		S - Current output buffer
*		P - Primary input buffer
*		WIdArt - write in private file "nnP", where nn is the user #,
*			 item named IdArt.
*		
*	Arguments to this subroutine are:
*	     proc - the text of the proc itself
*	     ibn  - the current input buffer number (0 = primary;
*						     1 = secondary)
*	     pib  - the primary input buffer
*	     sib  - the secondary input buffer
*	     ip   - the input buffer pointer (character count)
*	     obn  - the current output buffer number (0 = primary;
*						      1 = secondary)
*	     pob  - the primary output buffer
*	     sob  - the secondary output buffer
*
*******************************************************************************
*
	CR = 1

	DIM Words( 10 )
	REMOVE Line FROM proc SETTING x
	Line = TRIM( Line )
	MATPARSE Words FROM Line," "
	What   = Words(1)
	Target = Words(2)

	BEGIN CASE
		CASE What = "T"
			TimeDate = TIME() * 1000
		CASE What = "D"
			TimeDate = DATE()
		CASE What = "TD"
			TimeDate = (TIME() * 1000):"\":DATE()
		CASE 1
			ERRMSG 270
			CR = 0
	END CASE

	IF CR = 0 THEN RETURN

	BEGIN CASE
		CASE Target = "T"
			PRINT TimeDate
		CASE Target = "S"
			IF ( obn ) THEN
				sob := TimeDate
			END ELSE
				pob := TimeDate
			END
		CASE Target = "P"
			IF ip = LEN(pib) THEN
				pib := TimeDate
			END ELSE
				IF pib[ip,1] = @AM THEN ip += 1
				first.part = pib[1,ip-1]:TimeDate:@AM
				last.part  = pib[ip+1,LEN(pib)]
				DEL last.part<1>
				pib = first.part:last.part
			END
		CASE Target[1,1] = "W"
			IdArt = Target[2,LEN(Target)-1]
			OPEN @USER.NO:"P" TO IdFicnnP ELSE
				ERRMSG 201,@USER.NO:"P"
				CR = 0
			END 
			IF CR THEN
            READU Dummy FROM IdFicnnP,IdArt ELSE NULL
				WRITE TimeDate ON IdFicnnP,IdArt ELSE
					ERRMSG 202,IdArt
					CR = 0
				END
			END
		CASE 1
			ERRMSG 270
			CR = 0
	END CASE

*	If no error, we must remove the error return line from the proc.
	IF CR THEN REMOVE Line FROM proc SETTING x
    RETURN

END