home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / friday2.zip / RCALCUR.ASC < prev   
Text File  |  1986-12-16  |  3KB  |  80 lines
  1. *( RCALCUR Produces a calendar for the current year and month )
  2. *(         Created November 1985 by Richard T. Traband)
  3. *(         Modified December 1986 by Forrest L. Barbee )
  4. NEWPAGE
  5. SET ESCAPE OFF
  6. SET COLOR FORE WHITE
  7. SET COLOR BACK BLUE
  8. SET MESSAGES OFF
  9. SET ERROR MESSAGES OFF
  10. SET DATE FOR MM/DD/YYYY
  11. SET DATE SEQ MMDDYYYY
  12. SET BELL OFF
  13. SET NULL " "
  14. SET VAR T6 INTEGER; SET VAR T6 = 0
  15. SET VAR CURDATE DATE ; SET VAR CURDATE TO #DATE
  16. SET VAR CDMON INTEGER ; SET VAR CDMON TO IMON(.CURDATE)
  17. SER VAR CDYR INTEGER ; SET VAR CDYR TO IYR(.CURDATE)
  18. OPEN FRIDAY
  19. *( FILLIN YEAR USING "Enter the year (1900-2120) or [ENTER] to quit > "  )
  20. SET VAR YEAR TO .CDYR
  21. IF YEAR FAILS THEN; QUIT; ENDIF
  22. IF YEAR LT 1900 OR YEAR GT 2120 THEN
  23.          NEWPAGE;WRITE "OUTSIDE DATE RANGE....PRESS ANY KEY TO CONTINUE"
  24.          PAUSE; QUIT TO SHOWCAL
  25. ENDIF
  26. *( FILLIN MONTH USING "Enter the month   (1-12)   or [ENTER] to quit > "   )
  27. SET VAR MONTH TO .CDMON
  28. IF MONTH FAILS THEN; QUIT; ENDIF
  29. IF MONTH LT 1 OR MONTH GT 12 THEN
  30.          NEWPAGE; WRITE "OUTSIDE DATE RANGE...PRESS ANY KEY TO CONTINUE"
  31.          PAUSE; QUIT TO SHOWCAL
  32. ENDIF
  33. NEWPAGE
  34. SET VAR DAYS TEX; SET V DAYS = "SUN MON TUE WED THU FRI SAT"
  35. SET VAR TYPE INT; SET V TYPE = YEARTYPE IN YEARS WHE YEAR = .YEAR
  36. SET POI #3 EOF FOR TYPES WHERE MONTH = .MONTH AND YEARTYPE = .TYPE
  37.          SET VAR T1 = LN1 IN #3
  38.          SET VAR T2 = LN2 IN #3
  39.          SET VAR T3 = LN3 IN #3
  40.          SET VAR T4 = LN4 IN #3
  41.          SET VAR T5 = LN5 IN #3
  42.          SET VAR T6 = LN6 IN #3
  43.          SET VAR L1 = CAL IN SINTAB WHERE LINETYPE = .T1
  44.          SET VAR L2 = CAL IN SINTAB WHERE LINETYPE = .T2
  45.          SET VAR L3 = CAL IN SINTAB WHERE LINETYPE = .T3
  46.          SET VAR L4 = CAL IN SINTAB WHERE LINETYPE = .T4
  47.          SET VAR L5 = CAL IN SINTAB WHERE LINETYPE = .T5
  48.          IF T6 GT 0 THEN
  49.                    SET VAR L6 = CAL IN SINTAB WHERE LINETYPE = .T6
  50.          ELSE
  51.                    CLEAR T6; SET VAR T6 INTEGER
  52.          ENDIF
  53. IF MONTH = 1 THEN; SET VAR MON = "JANUARY"; ENDIF
  54. IF MONTH = 2 THEN; SET VAR MON = "FEBRUARY"; ENDIF
  55. IF MONTH = 3 THEN; SET VAR MON = "  MARCH"; ENDIF
  56. IF MONTH = 4 THEN; SET VAR MON = "  APRIL"; ENDIF
  57. IF MONTH = 5 THEN; SET VAR MON = "  MAY"; ENDIF
  58. IF MONTH = 6 THEN; SET VAR MON = "  JUNE"; ENDIF
  59. IF MONTH = 7 THEN; SET VAR MON = "  JULY"; ENDIF
  60. IF MONTH = 8 THEN; SET VAR MON = " AUGUST"; ENDIF
  61. IF MONTH = 9 THEN; SET VAR MON = "SEPTEMBER"; ENDIF
  62. IF MONTH = 10 THEN; SET VAR MON = "OCTOBER"; ENDIF
  63. IF MONTH = 11 THEN; SET VAR MON = "NOVEMBER"; ENDIF
  64. IF MONTH = 12 THEN; SET VAR MON = "DECEMBER"; ENDIF
  65. NEWPAGE
  66. DRAW CAL WITH ALL
  67. SET NULL -0-
  68. SET MESSAGES ON
  69. SET ERROR MESSAGES ON
  70. SET DATE FOR MM/DD/YY
  71. SET DATE SEQ MMDDYY
  72. SET BELL ON
  73. SET NULL -0-
  74. SET ESCAPE ON
  75. WRITE "PRESS ANY KEY TO RETURN TO APPLICATION MENU" AT 23 18
  76. PAUSE
  77. SET COLOR BACK CYAN
  78. SET COLOR FORE BLUE
  79. RETURN
  80.