home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
trl14db.zip
/
TRLPRG.EXE
/
CDTOS.PRG
< prev
next >
Wrap
Text File
|
1990-10-22
|
1KB
|
37 lines
***********
* CDTOS.PRG
* by Tom Rettig and Leonard Zerman
* Placed in the Public Domain by Tom Rettig Associates, 10/22/1990.
*
* SYNTAX: DO CDTOS WITH <expC date>, <format>
* RETURN: Date string of <expC date in format "YYYYMMDD".
*********
PARAMETERS tr_date, tr_format
PRIVATE temp_retc, year
tr_format = UPPER( tr_format )
* Get number of digits in year.
year = "Y"
CALL trpass WITH year
CALL trpass WITH tr_format
CALL trexe WITH "CHRCOUNT"
* Calculate date string.
temp_retc = IIF(tr_retn=2, SUBSTR(STR(YEAR(DATE()),4),1,2), []) +;
SUBSTR( tr_date, AT( "Y", tr_format ), tr_retn ) +;
SUBSTR( tr_date, AT( "M", tr_format ), 2 ) +;
SUBSTR( tr_date, AT( "D", tr_format ), 2 )
* Put date string in tr_retc through library.
CALL trpass WITH temp_retc
CALL trexe WITH "retc"
CALL Trexe WITH "TRRETCLEN"
IF fox
PRIVATE tr_temp
tr_temp = SUBSTR(tr_retc,1,tr_retn)
RETURN (tr_temp)
ENDIF
* eof cdtos *