home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / trl14db.zip / TRLPRG.EXE / CDTOS.PRG < prev    next >
Text File  |  1990-10-22  |  1KB  |  37 lines
  1. ***********
  2. * CDTOS.PRG
  3. * by Tom Rettig and Leonard Zerman
  4. * Placed in the Public Domain by Tom Rettig Associates, 10/22/1990.
  5. *
  6. * SYNTAX: DO CDTOS WITH <expC date>, <format> 
  7. * RETURN: Date string of <expC date in format "YYYYMMDD". 
  8. *********
  9. PARAMETERS tr_date, tr_format
  10. PRIVATE temp_retc, year
  11. tr_format = UPPER( tr_format )
  12.  
  13. * Get number of digits in year.
  14. year = "Y"
  15. CALL trpass WITH year
  16. CALL trpass WITH tr_format
  17. CALL trexe  WITH "CHRCOUNT"
  18.  
  19. * Calculate date string.
  20. temp_retc = IIF(tr_retn=2, SUBSTR(STR(YEAR(DATE()),4),1,2), []) +;
  21.                SUBSTR( tr_date, AT( "Y", tr_format ), tr_retn ) +;
  22.                SUBSTR( tr_date, AT( "M", tr_format ), 2 ) +;
  23.                SUBSTR( tr_date, AT( "D", tr_format ), 2 )
  24.  
  25. * Put date string in tr_retc through library.
  26. CALL trpass WITH temp_retc
  27. CALL trexe WITH "retc"
  28. CALL Trexe   WITH "TRRETCLEN"
  29. IF fox
  30.    PRIVATE tr_temp
  31.    tr_temp = SUBSTR(tr_retc,1,tr_retn)
  32.    RETURN (tr_temp)
  33. ENDIF
  34. * eof cdtos *
  35.  
  36.  
  37.