home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a069 / 1.img / TRSOURCE.EXE / TR_DTOS.PRG < prev    next >
Encoding:
Text File  |  1990-10-22  |  1.0 KB  |  33 lines
  1. *********
  2. * Function :  CDTOS
  3. * By : Tom Rettig
  4. * Placed in the public domain by Tom Rettig Associates, 10/22/1990.
  5. *********
  6.  
  7.  
  8. FUNCTION CDTOS
  9. * Syntax: CDTOS( <expC date>, <format> )
  10. * Return: <date string> in the DTOS() format "YYYYMMDD" of <expC date>
  11. * Note  : <format> is specified as Y for year, M for month, and D for date
  12. *         <format> must be same len as <expC date> and contain
  13. *            delimiters in the same positions
  14. *         Current century is assumed if 2 digit year
  15. *         Does not trap invaild entry.
  16. * Examples:
  17. *         CDTOS( "122586", "MMDDYY" )
  18. *         CDTOS( "86/12/25", "YY/MM/DD" )
  19. *         CDTOS( "25.12.1986", "DD.MM.YYYY" )
  20. *
  21. PARAMETERS tr_date, tr_format
  22. MEMVAR tr_yearlen
  23. PRIVATE tr_yearlen
  24. tr_format  = UPPER(tr_format)
  25. tr_yearlen = CHRCOUNT("Y",tr_format)
  26. RETURN IF(tr_yearlen=2, SUBSTR(STR(YEAR(DATE()),4),1,2), []) +;
  27.        SUBSTR( tr_date,AT("Y",tr_format), tr_yearlen ) +;
  28.        SUBSTR( tr_date,AT("M",tr_format), 2 ) +;
  29.        SUBSTR( tr_date,AT("D",tr_format), 2 )
  30. * eofunc cdtos
  31.  
  32.  
  33.