home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / fdater.zip / DRIVER.REX < prev    next >
OS/2 REXX Batch file  |  1995-04-29  |  3KB  |  113 lines
  1. signal on novalue
  2.  
  3. BaseDate = Date("B")
  4. DO FOREVER
  5. "cls"
  6. say "┌─────────────────────────────────────────────────────────────────────────────┐"
  7. say "│               DATE CONVERSION USING FDATER                                  │"
  8. say "│─────────────────────────────────────────────────────────────────────────────│"
  9. say "│                                                                             │"
  10. say "│     Base date from previous conversion:" left(BaseDate,34) "│"
  11. say "│                                                                             │"
  12. say "│  C  Calendar date to base date                                              │"
  13. say "│                                                                             │"
  14. say "│  B  Base date to calendar date                                              │"
  15. say "│                                                                             │"
  16. say "└─────────────────────────────────────────────────────────────────────────────┘"
  17. call charout, "Select function letter, or press ENTER to exit> "
  18. pull choice .
  19. choice = left(choice,1)
  20. select
  21.    when choice = "B" then call Base2Cal
  22.    when choice = "C" then call Cal2Base
  23.    when choice = ""  then do; "cls"; exit ; end
  24.    otherwise
  25.         say "Invalid choice:" choice
  26. end /*select*/
  27.  
  28. END /*DO FOREVER*/
  29. EXIT
  30.  
  31. Base2Cal:
  32.   default = BaseDate
  33.   say            "Enter base date as a number (0-999999)"
  34.   call charout , "or press ENTER to take default of:" default "> "
  35.   pull answer  .
  36.   if answer = "" then BaseDate = default
  37.   else                BaseDate = answer
  38.  
  39.   do forever
  40.      if IsInRange(  BaseDate, 0, 9999999 ) then LEAVE
  41.      pull answer .
  42.      if answer = "" then BaseDate = default
  43.      else                BaseDate = answer
  44.   end
  45.  
  46.   result = FdateR("Base2Cal", BaseDate)
  47.   parse var result CalYear CalMonth CalDay .
  48.  
  49.   MonthName = FdateR("Monthname", Calmonth)
  50.   DowNum  =   FdateR("DowNum",      BaseDate )
  51.   DowName =   FdateR("DowName"    , Downum  )
  52.  
  53.   IsLeapYear = FdateR("IsLeapYear", CalYear)
  54.   if IsLeapYear then LY = "(a leap year)"
  55.   else               LY = " (not a leap year)"
  56.  
  57.   say
  58.   say "Calendar date (mm/dd/ccyy):" Calmonth"/"CalDay"/"CalYear LY
  59.   say "Calendar date             :" DowName CalDay MonthName CalYear
  60.   say
  61.   "pause"
  62. RETURN
  63.  
  64.  
  65. Cal2Base:
  66.   call charout ,"Enter day   (number from 1 to 31  ) > "
  67.   pull CalDay  .
  68.   do forever
  69.      if IsInRange(  CALDAY, 1, 31    ) then LEAVE
  70.      pull CalDay  .
  71.   end
  72.  
  73.   call charout ,"Enter month (number from 1 to 12  ) > "
  74.   pull CalMonth .
  75.   do forever
  76.      if IsInRange( CalMonth , 1, 12   ) then LEAVE
  77.      pull CalMonth .
  78.   end
  79.  
  80.   call charout ,"Enter year  (number from 1 to 9999) > "
  81.   pull Calyear .
  82.   do forever
  83.      if IsInRange(  CALYEAR, 1, 9999  ) then LEAVE
  84.      pull Calyear .
  85.   end
  86.  
  87.   BaseDate = FdateR("Cal2Base", CalYear CalMonth CalDay)
  88.   say
  89.   say "Base date is:" BaseDate
  90.   say
  91.   "pause"
  92. RETURN
  93.  
  94.  
  95. IsInRange: procedure
  96.   invalue = arg(1)
  97.   lbound  = arg(2)
  98.   ubound  = arg(3)
  99.  
  100.   if \datatype(invalue,"W") then do
  101.      say             "     ERROR: input value is not an integer."
  102.      call charout ,  "     Please try again.> "
  103.      RETURN 0
  104.   end
  105.  
  106.   if invalue < Lbound | invalue > ubound then do
  107.      say             "     ERROR: input value is not in range" lbound"-"ubound
  108.      call charout ,  "     Please try again.> "
  109.      RETURN 0
  110.   end
  111. RETURN 1
  112.  
  113.