home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
friday2.zip
/
RCALCUR.ASC
< prev
Wrap
Text File
|
1986-12-16
|
3KB
|
80 lines
*( RCALCUR Produces a calendar for the current year and month )
*( Created November 1985 by Richard T. Traband)
*( Modified December 1986 by Forrest L. Barbee )
NEWPAGE
SET ESCAPE OFF
SET COLOR FORE WHITE
SET COLOR BACK BLUE
SET MESSAGES OFF
SET ERROR MESSAGES OFF
SET DATE FOR MM/DD/YYYY
SET DATE SEQ MMDDYYYY
SET BELL OFF
SET NULL " "
SET VAR T6 INTEGER; SET VAR T6 = 0
SET VAR CURDATE DATE ; SET VAR CURDATE TO #DATE
SET VAR CDMON INTEGER ; SET VAR CDMON TO IMON(.CURDATE)
SER VAR CDYR INTEGER ; SET VAR CDYR TO IYR(.CURDATE)
OPEN FRIDAY
*( FILLIN YEAR USING "Enter the year (1900-2120) or [ENTER] to quit > " )
SET VAR YEAR TO .CDYR
IF YEAR FAILS THEN; QUIT; ENDIF
IF YEAR LT 1900 OR YEAR GT 2120 THEN
NEWPAGE;WRITE "OUTSIDE DATE RANGE....PRESS ANY KEY TO CONTINUE"
PAUSE; QUIT TO SHOWCAL
ENDIF
*( FILLIN MONTH USING "Enter the month (1-12) or [ENTER] to quit > " )
SET VAR MONTH TO .CDMON
IF MONTH FAILS THEN; QUIT; ENDIF
IF MONTH LT 1 OR MONTH GT 12 THEN
NEWPAGE; WRITE "OUTSIDE DATE RANGE...PRESS ANY KEY TO CONTINUE"
PAUSE; QUIT TO SHOWCAL
ENDIF
NEWPAGE
SET VAR DAYS TEX; SET V DAYS = "SUN MON TUE WED THU FRI SAT"
SET VAR TYPE INT; SET V TYPE = YEARTYPE IN YEARS WHE YEAR = .YEAR
SET POI #3 EOF FOR TYPES WHERE MONTH = .MONTH AND YEARTYPE = .TYPE
SET VAR T1 = LN1 IN #3
SET VAR T2 = LN2 IN #3
SET VAR T3 = LN3 IN #3
SET VAR T4 = LN4 IN #3
SET VAR T5 = LN5 IN #3
SET VAR T6 = LN6 IN #3
SET VAR L1 = CAL IN SINTAB WHERE LINETYPE = .T1
SET VAR L2 = CAL IN SINTAB WHERE LINETYPE = .T2
SET VAR L3 = CAL IN SINTAB WHERE LINETYPE = .T3
SET VAR L4 = CAL IN SINTAB WHERE LINETYPE = .T4
SET VAR L5 = CAL IN SINTAB WHERE LINETYPE = .T5
IF T6 GT 0 THEN
SET VAR L6 = CAL IN SINTAB WHERE LINETYPE = .T6
ELSE
CLEAR T6; SET VAR T6 INTEGER
ENDIF
IF MONTH = 1 THEN; SET VAR MON = "JANUARY"; ENDIF
IF MONTH = 2 THEN; SET VAR MON = "FEBRUARY"; ENDIF
IF MONTH = 3 THEN; SET VAR MON = " MARCH"; ENDIF
IF MONTH = 4 THEN; SET VAR MON = " APRIL"; ENDIF
IF MONTH = 5 THEN; SET VAR MON = " MAY"; ENDIF
IF MONTH = 6 THEN; SET VAR MON = " JUNE"; ENDIF
IF MONTH = 7 THEN; SET VAR MON = " JULY"; ENDIF
IF MONTH = 8 THEN; SET VAR MON = " AUGUST"; ENDIF
IF MONTH = 9 THEN; SET VAR MON = "SEPTEMBER"; ENDIF
IF MONTH = 10 THEN; SET VAR MON = "OCTOBER"; ENDIF
IF MONTH = 11 THEN; SET VAR MON = "NOVEMBER"; ENDIF
IF MONTH = 12 THEN; SET VAR MON = "DECEMBER"; ENDIF
NEWPAGE
DRAW CAL WITH ALL
SET NULL -0-
SET MESSAGES ON
SET ERROR MESSAGES ON
SET DATE FOR MM/DD/YY
SET DATE SEQ MMDDYY
SET BELL ON
SET NULL -0-
SET ESCAPE ON
WRITE "PRESS ANY KEY TO RETURN TO APPLICATION MENU" AT 23 18
PAUSE
SET COLOR BACK CYAN
SET COLOR FORE BLUE
RETURN