/***************************  REXX  *******************************/
/*     (c)  Copyright   Roger Lacroix   1994                      */
/*                                                                */
/* Designed, developed and programmed by Roger Lacroix            */
/******************************************************************/
/*                                                                */
/* A rexx program to build a calendar.                            */
/*                                                                */
/* Requires my sample ISR@PRIM panel.                             */
/*                                                                */
/******************************************************************/

year  = SUBSTR(DATE('S'),1,4)        /* current year  */
month = SUBSTR(DATE('S'),5,2)        /* current month */
day   = SUBSTR(DATE('S'),7,2)        /* current day   */

/* header1 ="="CENTRE(DATE('M')" "year,20)    */
/* header2 ="ŠSu Mo Tu We Th Fr Sa"           */

IF (year // 4)=0 & ( (year // 100)<>0 | (year // 400)=0 ) THEN
   Leap=29
ELSE
   Leap=28

daysinmonth="31 "leap" 31 30 31 30 31 31 30 31 30 31"

A1 =(year-1) % 4    /* quotient only - # of leap years           */
A2 =(year-1) % 100  /* quotient only - # of centuries years      */
A3 =(year-1) % 400  /* quotient only - # of leap centuries years */

TotalDays = year+1+A1-A2+A3          /* number of days up to this year */

DO cnt = 1 to month-1        /* include days of months in current year */
   TotalDays = TotalDays + WORD(daysinmonth,cnt)
END

StartingPos=(TotalDays+6) // 7
newmonth = COPIES("~  ",StartingPos)
days = WORD(daysinmonth,month)   /* # of days in current month */

DO i=1 to Days
   IF i = day THEN
      newmonth=newmonth'{'RIGHT(i,2,0)   /* highlight today */
   ELSE
      newmonth=newmonth'~'RIGHT(i,2,0)
END

outmonth = newmonth"~"COPIES(" ",50)
outmonth = SUBSTR(outmonth,1,126)           /* reduce to max length */

outdate = date('O')
address ispexec 'vput (outmonth outdate year month) profile'

EXIT