37 lines
1.8 KiB
Text
37 lines
1.8 KiB
Text
FIVE
|
|
;List and count the months between 1/1900 and 12/2100 that have 5 full weekends
|
|
;Extra credit - list and count years with no months with five full weekends
|
|
;Using the test that the 31st of a month is on a Sunday
|
|
;Uses the VA's public domain routine %DTC (Part of the Kernel) named here DIDTC
|
|
NEW YEAR,MONTH,X,Y,CNTMON,NOT,NOTLIST
|
|
; YEAR is the year we're testing
|
|
; MONTH is the month we're testing
|
|
; X is the date in "internal" format, as an input to DOW^DIDTC
|
|
; Y is the day of the week (0=Sunday, 1=Monday...) output from DOW^DIDTC
|
|
; CNTMON is a count of the months that have 5 full weekends
|
|
; NOT is a flag if there were no months with 5 full weekends yet that year
|
|
; NOTLIST is a list of years that do not have any months with 5 full weekends
|
|
SET CNTMON=0,NOTLIST=""
|
|
WRITE !!,"The following months have five full weekends:"
|
|
FOR YEAR=200:1:400 DO ;years since 12/31/1700 epoch
|
|
. SET NOT=0
|
|
. FOR MONTH="01","03","05","07","08","10","12" DO
|
|
. . SET X=YEAR_MONTH_"31"
|
|
. . DO DOW^DIDTC
|
|
. . IF (Y=0) DO
|
|
. . . SET NOT=NOT+1,CNTMON=CNTMON+1
|
|
. . . WRITE !,MONTH_"-"_(YEAR+1700)
|
|
. SET:(NOT=0) NOTLIST=NOTLIST_$SELECT($LENGTH(NOTLIST)>1:",",1:"")_(YEAR+1700)
|
|
WRITE !,"For a total of "_CNTMON_" months."
|
|
WRITE !!,"There are "_$LENGTH(NOTLIST,",")_" years with no five full weekends in any month."
|
|
WRITE !,"They are: "_NOTLIST
|
|
KILL YEAR,MONTH,X,Y,CNTMON,NOT,NOTLIST
|
|
QUIT
|
|
F ;Same logic as the main entry point, shortened format
|
|
N R,M,X,Y,C,N,L S C=0,L=""
|
|
W !!,"The following months have five full weekends:"
|
|
F R=200:1:400 D
|
|
. S N=0 F M="01","03","05","07","08","10","12" S X=R_M_"31" D DOW^DIDTC I 'Y S N=N+1,C=C+1 W !,M_"-"_(R+1700)
|
|
. S:'N L=L_$S($L(L):",",1:"")_(R+1700)
|
|
W !,"For a total of "_C_" months.",!!,"There are "_$L(L,",")_" years with no five full weekends in any month.",!,"They are: "_L
|
|
Q
|