/* Calendar - This EXEC create a Calendar for any date.
              The default is the current month. Optionaly the user
              may enter a month and year.

   By : Bill Blasingim
   On : 03/31/94
*/
ARG MM YY
'VMFCLEAR'

EOF_READ=0
YYYYMMDD=DATE(S)  /* GET CURRENT DATE (DEFAULT) */
DD = 1
CURRENT = 0
IF MM = '' THEN
  DO
    MM=SUBSTR(YYYYMMDD,5,2)
    DD=SUBSTR(YYYYMMDD,7,2)
    CURRENT=1
  END
ELSE
  IF LENGTH(MM)<2 THEN MM='0'MM
IF YY = '' THEN
  DO
    YY=LEFT(YYYYMMDD,4)
  END
'VMFCLEAR'
CAL_FILE='CAL 'YY'_'MM' A'
/*
SET CMSTYPE HT
'ERASE 'CAL_FILE
SET CMSTYPE RT
*/
IF LEFT(DD,1)='0' THEN
  FIND=' 'SUBSTR(DD,2,1)']'
ELSE
  FIND=DD']'
DD = 1

SET CMSTYPE HT
'STATE 'CAL_FILE
RC_SAVE=RC
SET CMSTYPE RT

/* If Calendar Exists then don't recreate it */
IF RC_SAVE = 0 THEN
  DO
    CALL PRINT_CAL
    EXIT
  END

MM=MM+0
MONTH.1=31         /* JANUARY   */
MONTH.2=28         /* FEBRUARY  */
IF YY//100 = 0 THEN
  DO
    IF YY//400 = 0 THEN
      MONTH.2=29
  END
ELSE
  IF YY//4 = 0 THEN
    MONTH.2=29
MONTH.3=31         /* MARCH     */
MONTH.4=30         /* APRIL     */
MONTH.5=31         /* MAY       */
MONTH.6=30         /* JUNE      */
MONTH.7=31         /* JULY      */
MONTH.8=31         /* AUGUST    */
MONTH.9=30         /* SEPTEMBER */
MONTH.10=31        /* OCTOBER   */
MONTH.11=30        /* NOVEMBER  */
MONTH.12=31        /* DECEMBER  */

MNAME.1='January'
MNAME.2='February'
MNAME.3='March'
MNAME.4='April'
MNAME.5='May'
MNAME.6='June'
MNAME.7='July'
MNAME.8='August'
MNAME.9='September'
MNAME.10='October'
MNAME.11='November'
MNAME.12='December'

DAY.0='SUN'
DAY.1='MON'
DAY.2='TUE'
DAY.3='WED'
DAY.4='THU'
DAY.5='FRI'
DAY.6='SAT'

MONTH_YEAR=MNAME.MM' 'YY
LAST_DAY=MONTH.MM

/* Calculate the subscript of the day that the 1st falls on
   0-Sun...6-Sat
*/
DAYS = 0
DO I=1 TO MM-1
  DAYS = DAYS + MONTH.I
END
DAYS = DAYS + DD

YY        = YY - 1
/* CALCULATE # OF DAYS SINCE 1/1/0001  */
EXCLUDE   = TRUNC(YY/100) - TRUNC(YY/400)
LEAPS     = TRUNC(YY/4) - EXCLUDE
DAYS      = DAYS + (YY * 365) + LEAPS
FIRST_SUB = DAYS//7

TOP=''
DO I=0 TO 6
  TOP=TOP'===='DAY.I'===='
END
TOP=TOP'='

/*
LINE=']'COPIES('_',76)']'
*/

PART=']'COPIES('-',10)
LINE=COPIES(PART,7)']'

PART=']'COPIES(' ',10)
BODY=COPIES(PART,7)']'

DO I=1 TO 6
  DAY_LINE.I=''
END

/* This section puts the days in the right slot on the calendar */
DAYS=0
DO I=1 TO 6
  DO J=0 TO 6
    IF (DAYS = 0) & (J = FIRST_SUB) THEN
      DAYS=1
    IF (DAYS > 0) & (DAYS <= LAST_DAY) THEN
      DO
        PART=']'COPIES(' ',10-LENGTH(DAYS))]]DAYS
        DAYS=DAYS+1
      END
    ELSE
      PART=']'COPIES(' ',10)
    DAY_LINE.I=DAY_LINE.I]]PART
  END
  DAY_LINE.I=DAY_LINE.I]]']'
END

/* Print the Month and Year at the top  */
OUT_REC=COPIES(' ',39-TRUNC(LENGTH(MONTH_YEAR)/2))]]MONTH_YEAR
CALL WRITE_IT

OUT_REC=''
CALL WRITE_IT

OUT_REC=TOP
CALL WRITE_IT

/* Write out the Body of the calendar  */
DO I=1 TO 6
  OUT_REC=DAY_LINE.I
  CALL WRITE_IT
    OUT_REC=BODY
    CALL WRITE_IT
  OUT_REC=LINE
  CALL WRITE_IT
END

'FINIS 'OUT_FILE

CALL PRINT_CAL

EXIT

/* This routine reads/prints the calendar file and flags todays day
   with an '*'
*/
PRINT_CAL:
  CALL READ_IT
  DO UNTIL EOF_READ
    POS=INDEX(IN_REC,FIND)
    IF CURRENT THEN
      IF POS>0 THEN
        IN_REC=OVERLAY('*',IN_REC,POS-1)   /* FLAG TODAY WITH AN '*' */
    SAY IN_REC
    CALL READ_IT
  END

READ_IT:
 'EXECIO 1 DISKR 'CAL_FILE' (VAR IN_REC'
 RC_SAVE=RC
 IF RC_SAVE = 2 THEN
   DO
     EOF_READ = 1
     RETURN
   END
 IF RC_SAVE > 0 THEN
   DO
     SAY 'READ ERROR, CODE: 'RC_SAVE
     EXIT
   END
RETURN

WRITE_IT:
 'EXECIO 1 DISKW 'CAL_FILE' 0 F 80 (VAR OUT_REC'
 RC_SAVE=RC
 IF RC_SAVE > 0 THEN
   DO
     SAY 'WRITE ERROR, CODE: 'RC_SAVE
     EXIT
   END
RETURN

EXIT