PRSLIB01 ;JAH/WCIOFO-PAID UTILITIES AND LIBRARY 01 ;Mar 25, 2005
;;4.0;PAID;**45,93,137,150**;Sep 21, 1995;Build 1
;;Per VA Directive 6402, this routine should not be modified
Q
MAIN ;DISPLAY MONTHLY CALENDAR FOR ANY DATE
N OUT
F D CALENDAR(.OUT) Q:OUT
Q
;= = = = = = = = = = = = = = = = = = = = = = = = = = =
CALENDAR(OUT) ;
; Ask user for a date and quit if not a valid date.
; Get # of days in the month the user has selected.
; Get the weekday for the 1st day of the selected month.
; If necessary get days elapsed from jan 1 to 1st day of selected mo.
; Display the month.
;
S OUT=1
N ZFMDATE,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,SHOWJULI,HIGHLITE
N COUNT,HDR
;
S %DT="AE" D ^%DT S ZFMDATE=Y ; Ask date.
Q:Y<1
; if picked month has today-highlight
S HIGHLITE=0
I $E(Y,1,5)=$E(DT,1,5) S HIGHLITE=+$E(DT,6,7)
;
; Ask if they want to see the elapsed days calendar.
S SHOWJULI=$$ASKJULIA()
Q:Y<0
;
; Days in the month.
S MONTH=$E(ZFMDATE,4,5),YEAR=$E(ZFMDATE,1,3)+1700
S DAYS=$$DAYSINMO(YEAR,MONTH)
;
S FIRSTDAY=$E(ZFMDATE,1,5)_"01",LASTDAY=$E(ZFMDATE,1,5)_DAYS
;
;Get the day #s of pay periods in this month
N PPS
I FIRSTDAY<3220000 D GETPPS(FIRSTDAY,LASTDAY)
;
S DAY1=$$WEEKDAY1(ZFMDATE) ; Weekday of the 1st.
;
;
S HDR=$$GETHEAD(Y)
W @IOF,!
W "---------------",HDR,"------------"
D DISPMO(DAY1,DAYS,HIGHLITE) ; Display month.
I SHOWJULI D
. N JULID1
. S JULID1=$$GETJULI(FIRSTDAY,YEAR)
. W !!,"-------Elapsed Days Calendar---------"
. D DISPJULI(DAY1,DAYS,JULID1)
W !,"---------------Holidays------------",!
;
;DISPLAY HOLIDAYS
;
N HO,HD,PRS8D,HOLIDAY
S PRS8D=$E(ZFMDATE,2,3) D EN^PRS8HD
S FIRSTDAY=$E(FIRSTDAY,1,5)_"00"
S HOLIDAY=FIRSTDAY
S COUNT=0
I FIRSTDAY<3230000 D
.F S HOLIDAY=$O(HD(HOLIDAY)) Q:HOLIDAY>LASTDAY!(HOLIDAY="") D
.. W !,?2,$P(HD(HOLIDAY),"^",2)," ",+$E(HOLIDAY,6,7),?15,$P(HD(HOLIDAY),"^")
.. S COUNT=COUNT+1
E W " Sorry, Can't find holidays past 2022." S COUNT=COUNT+1
I COUNT<1 W !," No Holidays this month."
W !,"-----------------------------------",!
S OUT=0
Q
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
SILMO(PRSDT) ;SILENT CALL TO DISPLAY MONTH
; INPUT: PRSDT - must be fileman date
;
N X,Y,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,HIGHLITE,COUNT,HDR
S X=PRSDT D ^%DT Q:Y<0
; if month has today-highlight
S HIGHLITE=0
I $E(Y,1,5)=$E(DT,1,5) S HIGHLITE=+$E(DT,6,7)
S MONTH=$E(PRSDT,4,5),YEAR=$E(PRSDT,1,3)+1700
S DAYS=$$DAYSINMO(YEAR,MONTH)
S FIRSTDAY=$E(PRSDT,1,5)_"01",LASTDAY=$E(PRSDT,1,5)_DAYS
;
;Get day #s of pps in month
N PPS
I FIRSTDAY<3220000 D GETPPS(FIRSTDAY,LASTDAY)
S DAY1=$$WEEKDAY1(PRSDT)
S HDR=$$GETHEAD(Y)
W @IOF,!,"---------------",HDR,"------------"
D DISPMO(DAY1,DAYS,HIGHLITE)
W !,"---------------Holidays------------",!
;
;holidays
N HO,HD,PRS8D,HOLIDAY
S PRS8D=$E(PRSDT,2,3) D EN^PRS8HD
S FIRSTDAY=$E(FIRSTDAY,1,5)_"00"
S HOLIDAY=FIRSTDAY
S COUNT=0
I FIRSTDAY<3230000 D
.F S HOLIDAY=$O(HD(HOLIDAY)) Q:HOLIDAY>LASTDAY!(HOLIDAY="") D
.. W !,?2,$P(HD(HOLIDAY),"^",2)," ",+$E(HOLIDAY,6,7),?15,$P(HD(HOLIDAY),"^")
.. S COUNT=COUNT+1
E W " Sorry, Can't find holidays past 2022." S COUNT=COUNT+1
I COUNT<1 W !," No Holidays this month."
W !,"-----------------------------------",!
Q
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
GETPPS(FIRSTDAY,LASTDAY) ;
N D1,PPE,PPDAY,PPI,PP4Y
S D1=FIRSTDAY D PP^PRSAPPU
D NX^PRSAPPU
I D1<FIRSTDAY S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU
S PPDAY=+$E(D1,6,7)
S PPS(PPDAY)=PPE
F D Q:D1>LASTDAY
. S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU
. Q:D1>LASTDAY
. S PPDAY=+$E(D1,6,7)
. S PPS(PPDAY)=PPE
Q
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
GETHEAD(Y) ;
N YEAR,MONTH,HDR,LENOFDT
S HDR=$$FMTE^XLFDT(Y,"1D")
S MONTH=$P(HDR," ")
S LENOFDT=$L(HDR," ")
S YEAR=$P(HDR," ",LENOFDT)
Q MONTH_" "_YEAR
;
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
WEEKDAY1(ZDATE) ;get the weekday of the 1st day of the month
; INPUT: ZDATE - FileMan date, used as the month to display
; OUTPUT: return - Integer corresponding to day of week
; (i.e. Sunday[1], Monday[2]) for the 1st day of
; the month
S ZDATE=$E(ZDATE,1,5)_"01"
Q $$DOW^XLFDT(ZDATE,1)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
DISPMO(DAYNO,NODAYS,HL) ;DISPLAY ENTIRE MONTH
;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
; beginning on Wednesday.
;
;Set up reverse video ON & OFF for today highlight
I $G(HL)>0 N IORVOFF,IORVON S X="IORVOFF;IORVON" D ENDR^%ZISS
;
N DAYS,DAYPOS,I,PPOFFSET,CNTDWN,BLDTAB
S PPOFFSET=6,(BLDTAB,CNTDWN)=0
S DAYS="SUN MON TUE WED THU FRI SAT"
W !,?PPOFFSET," ",DAYS,!
F I=1:1:NODAYS D
. S DAYPOS=(DAYNO+I-1)#7
. I DAYPOS=0 W ! I $G(PPS(I))'="" W PPS(I)
. I ($G(HL)=I)!($G(CNTDWN)>0) D
.. I $G(HL)=I D
... S BLDTAB=(PPOFFSET+((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0)))
... W ?BLDTAB,IORVON,I,IORVOFF
... S BLDTAB=($X-BLDTAB)-$L(I)
...; S BLDTAB=($X-BLDTAB)-1
... S CNTDWN=6-DAYPOS
.. E D
... W ?(BLDTAB+(PPOFFSET+((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0)))),I
... S CNTDWN=CNTDWN-1
. E D
.. W ?(PPOFFSET+((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0))),I
Q
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;=======================
;
ASKJULIA() ;RETURN RESPONSE--DO YOU WANT A CALENDAR A with dates
; expressed as the number of days elapsed since January 1?
N DIR,DIRUT,Y
W !!
S DIR("A")="Include Calendar with elapsed days since Jan 1."
S DIR(0)="Y"
S DIR("B")="Y"
S DIR("?",1)="Hit return to display a calendar with dates expressed as"
S DIR("?",2)="the number of days elapsed since January 1."
S DIR("?",3)="Days are numbered sequentially from 1 to 365 or 366 in a"
S DIR("?",4)="leap year. January 1st is day number 1 and December 31st"
S DIR("?",5)="is day 365 in a non leap year. This calendar is often"
S DIR("?",6)="(but incorrectly), called a Julian Calendar."
S DIR("?",7)="------------------------------------------------------"
S DIR("?",8)="Julian Calendar"
S DIR("?",9)="==============="
S DIR("?",10)=" The solar calendar introduced by Julius Caesar in Rome "
S DIR("?",11)=" in 46 B.C., having a year of 12 months and 365 days and"
S DIR("?",12)=" a leap year of 366 days every fourth year. It was"
S DIR("?",13)=" eventually replaced by the Gregorian calendar."
S DIR("?",14)="------------------------------------------------------"
S DIR("?")=" Hit return to include the elapsed days calendar."
D ^DIR
Q Y
;=======================
DISPJULI(DAYNO,NODAYS,JULIAND1) ;
; DISPLAY GREGORIAN AND JULIAN CALENDAR SIDE BY SIDE
;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
; beginning on Wednesday.
;
N DAYS,DAYPOS,I,PPOFFSET
S PPOFFSET=6
W !
F I=1:1:NODAYS D
. S DAYPOS=(DAYNO+I-1)#7
. I DAYPOS=0 W ! I $G(PPS(I))'="" W PPS(I)
. W ?(PPOFFSET+((DAYPOS+1)*4-($L(I+JULIAND1)-1))),I+JULIAND1
Q
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
;
PAYROLMO(DAYNO,NODAYS) ;PAYROLL STYLE DISPLAY OF ENTIRE MONTH
;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
; beginning on Wednessday.
;
N DAYS,DAYPOS,I
S DAYS="SUN MON TUE WED THU FRI SAT"
W !," ",DAYS,!
F I=1:1:NODAYS D
. S DAYPOS=(DAYNO+I-1)#7
. I DAYPOS=0 W !
. W ?((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0)),I
Q
DAYSINMO(Y,M) ; Return number of days in month based on year and month
; Input: Y = year in 4 digit format between 1700 and 3000
; M = month expressed as an integer from 1 to 12 (Jan - Dec)
;
N GOODY,GOODM S (GOODY,GOODM)=0
I Y<2700,Y>1700 S GOODY=1
I M>0,M<13 S GOODM=1
Q:'(GOODM&GOODY) 0
Q $P("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
GETJULI(ZFMDATE,YEAR) ;
N X1,X2
S X2=YEAR-1700_"0101"
S X1=ZFMDATE
D ^%DTC
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSLIB01 8363 printed Nov 22, 2024@17:37:02 Page 2
PRSLIB01 ;JAH/WCIOFO-PAID UTILITIES AND LIBRARY 01 ;Mar 25, 2005
+1 ;;4.0;PAID;**45,93,137,150**;Sep 21, 1995;Build 1
+2 ;;Per VA Directive 6402, this routine should not be modified
+3 QUIT
MAIN ;DISPLAY MONTHLY CALENDAR FOR ANY DATE
+1 NEW OUT
+2 FOR
DO CALENDAR(.OUT)
if OUT
QUIT
+3 QUIT
+4 ;= = = = = = = = = = = = = = = = = = = = = = = = = = =
CALENDAR(OUT) ;
+1 ; Ask user for a date and quit if not a valid date.
+2 ; Get # of days in the month the user has selected.
+3 ; Get the weekday for the 1st day of the selected month.
+4 ; If necessary get days elapsed from jan 1 to 1st day of selected mo.
+5 ; Display the month.
+6 ;
+7 SET OUT=1
+8 NEW ZFMDATE,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,SHOWJULI,HIGHLITE
+9 NEW COUNT,HDR
+10 ;
+11 ; Ask date.
SET %DT="AE"
DO ^%DT
SET ZFMDATE=Y
+12 if Y<1
QUIT
+13 ; if picked month has today-highlight
+14 SET HIGHLITE=0
+15 IF $EXTRACT(Y,1,5)=$EXTRACT(DT,1,5)
SET HIGHLITE=+$EXTRACT(DT,6,7)
+16 ;
+17 ; Ask if they want to see the elapsed days calendar.
+18 SET SHOWJULI=$$ASKJULIA()
+19 if Y<0
QUIT
+20 ;
+21 ; Days in the month.
+22 SET MONTH=$EXTRACT(ZFMDATE,4,5)
SET YEAR=$EXTRACT(ZFMDATE,1,3)+1700
+23 SET DAYS=$$DAYSINMO(YEAR,MONTH)
+24 ;
+25 SET FIRSTDAY=$EXTRACT(ZFMDATE,1,5)_"01"
SET LASTDAY=$EXTRACT(ZFMDATE,1,5)_DAYS
+26 ;
+27 ;Get the day #s of pay periods in this month
+28 NEW PPS
+29 IF FIRSTDAY<3220000
DO GETPPS(FIRSTDAY,LASTDAY)
+30 ;
+31 ; Weekday of the 1st.
SET DAY1=$$WEEKDAY1(ZFMDATE)
+32 ;
+33 ;
+34 SET HDR=$$GETHEAD(Y)
+35 WRITE @IOF,!
+36 WRITE "---------------",HDR,"------------"
+37 ; Display month.
DO DISPMO(DAY1,DAYS,HIGHLITE)
+38 IF SHOWJULI
Begin DoDot:1
+39 NEW JULID1
+40 SET JULID1=$$GETJULI(FIRSTDAY,YEAR)
+41 WRITE !!,"-------Elapsed Days Calendar---------"
+42 DO DISPJULI(DAY1,DAYS,JULID1)
End DoDot:1
+43 WRITE !,"---------------Holidays------------",!
+44 ;
+45 ;DISPLAY HOLIDAYS
+46 ;
+47 NEW HO,HD,PRS8D,HOLIDAY
+48 SET PRS8D=$EXTRACT(ZFMDATE,2,3)
DO EN^PRS8HD
+49 SET FIRSTDAY=$EXTRACT(FIRSTDAY,1,5)_"00"
+50 SET HOLIDAY=FIRSTDAY
+51 SET COUNT=0
+52 IF FIRSTDAY<3230000
Begin DoDot:1
+53 FOR
SET HOLIDAY=$ORDER(HD(HOLIDAY))
if HOLIDAY>LASTDAY!(HOLIDAY="")
QUIT
Begin DoDot:2
+54 WRITE !,?2,$PIECE(HD(HOLIDAY),"^",2)," ",+$EXTRACT(HOLIDAY,6,7),?15,$PIECE(HD(HOLIDAY),"^")
+55 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+56 IF '$TEST
WRITE " Sorry, Can't find holidays past 2022."
SET COUNT=COUNT+1
+57 IF COUNT<1
WRITE !," No Holidays this month."
+58 WRITE !,"-----------------------------------",!
+59 SET OUT=0
+60 QUIT
+61 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+62 ;
SILMO(PRSDT) ;SILENT CALL TO DISPLAY MONTH
+1 ; INPUT: PRSDT - must be fileman date
+2 ;
+3 NEW X,Y,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,HIGHLITE,COUNT,HDR
+4 SET X=PRSDT
DO ^%DT
if Y<0
QUIT
+5 ; if month has today-highlight
+6 SET HIGHLITE=0
+7 IF $EXTRACT(Y,1,5)=$EXTRACT(DT,1,5)
SET HIGHLITE=+$EXTRACT(DT,6,7)
+8 SET MONTH=$EXTRACT(PRSDT,4,5)
SET YEAR=$EXTRACT(PRSDT,1,3)+1700
+9 SET DAYS=$$DAYSINMO(YEAR,MONTH)
+10 SET FIRSTDAY=$EXTRACT(PRSDT,1,5)_"01"
SET LASTDAY=$EXTRACT(PRSDT,1,5)_DAYS
+11 ;
+12 ;Get day #s of pps in month
+13 NEW PPS
+14 IF FIRSTDAY<3220000
DO GETPPS(FIRSTDAY,LASTDAY)
+15 SET DAY1=$$WEEKDAY1(PRSDT)
+16 SET HDR=$$GETHEAD(Y)
+17 WRITE @IOF,!,"---------------",HDR,"------------"
+18 DO DISPMO(DAY1,DAYS,HIGHLITE)
+19 WRITE !,"---------------Holidays------------",!
+20 ;
+21 ;holidays
+22 NEW HO,HD,PRS8D,HOLIDAY
+23 SET PRS8D=$EXTRACT(PRSDT,2,3)
DO EN^PRS8HD
+24 SET FIRSTDAY=$EXTRACT(FIRSTDAY,1,5)_"00"
+25 SET HOLIDAY=FIRSTDAY
+26 SET COUNT=0
+27 IF FIRSTDAY<3230000
Begin DoDot:1
+28 FOR
SET HOLIDAY=$ORDER(HD(HOLIDAY))
if HOLIDAY>LASTDAY!(HOLIDAY="")
QUIT
Begin DoDot:2
+29 WRITE !,?2,$PIECE(HD(HOLIDAY),"^",2)," ",+$EXTRACT(HOLIDAY,6,7),?15,$PIECE(HD(HOLIDAY),"^")
+30 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+31 IF '$TEST
WRITE " Sorry, Can't find holidays past 2022."
SET COUNT=COUNT+1
+32 IF COUNT<1
WRITE !," No Holidays this month."
+33 WRITE !,"-----------------------------------",!
+34 QUIT
+35 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+36 ;
GETPPS(FIRSTDAY,LASTDAY) ;
+1 NEW D1,PPE,PPDAY,PPI,PP4Y
+2 SET D1=FIRSTDAY
DO PP^PRSAPPU
+3 DO NX^PRSAPPU
+4 IF D1<FIRSTDAY
SET PPE=$EXTRACT($$NXTPP^PRSAPPU(PPE),3,7)
DO NX^PRSAPPU
+5 SET PPDAY=+$EXTRACT(D1,6,7)
+6 SET PPS(PPDAY)=PPE
+7 FOR
Begin DoDot:1
+8 SET PPE=$EXTRACT($$NXTPP^PRSAPPU(PPE),3,7)
DO NX^PRSAPPU
+9 if D1>LASTDAY
QUIT
+10 SET PPDAY=+$EXTRACT(D1,6,7)
+11 SET PPS(PPDAY)=PPE
End DoDot:1
if D1>LASTDAY
QUIT
+12 QUIT
+13 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+14 ;
GETHEAD(Y) ;
+1 NEW YEAR,MONTH,HDR,LENOFDT
+2 SET HDR=$$FMTE^XLFDT(Y,"1D")
+3 SET MONTH=$PIECE(HDR," ")
+4 SET LENOFDT=$LENGTH(HDR," ")
+5 SET YEAR=$PIECE(HDR," ",LENOFDT)
+6 QUIT MONTH_" "_YEAR
+7 ;
+8 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+9 ;
WEEKDAY1(ZDATE) ;get the weekday of the 1st day of the month
+1 ; INPUT: ZDATE - FileMan date, used as the month to display
+2 ; OUTPUT: return - Integer corresponding to day of week
+3 ; (i.e. Sunday[1], Monday[2]) for the 1st day of
+4 ; the month
+5 SET ZDATE=$EXTRACT(ZDATE,1,5)_"01"
+6 QUIT $$DOW^XLFDT(ZDATE,1)
+7 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+8 ;
DISPMO(DAYNO,NODAYS,HL) ;DISPLAY ENTIRE MONTH
+1 ;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
+2 ; beginning on Wednesday.
+3 ;
+4 ;Set up reverse video ON & OFF for today highlight
+5 IF $GET(HL)>0
NEW IORVOFF,IORVON
SET X="IORVOFF;IORVON"
DO ENDR^%ZISS
+6 ;
+7 NEW DAYS,DAYPOS,I,PPOFFSET,CNTDWN,BLDTAB
+8 SET PPOFFSET=6
SET (BLDTAB,CNTDWN)=0
+9 SET DAYS="SUN MON TUE WED THU FRI SAT"
+10 WRITE !,?PPOFFSET," ",DAYS,!
+11 FOR I=1:1:NODAYS
Begin DoDot:1
+12 SET DAYPOS=(DAYNO+I-1)#7
+13 IF DAYPOS=0
WRITE !
IF $GET(PPS(I))'=""
WRITE PPS(I)
+14 IF ($GET(HL)=I)!($GET(CNTDWN)>0)
Begin DoDot:2
+15 IF $GET(HL)=I
Begin DoDot:3
+16 SET BLDTAB=(PPOFFSET+((DAYPOS+1)*(4)-$SELECT($LENGTH(I)=2:1,1:0)))
+17 WRITE ?BLDTAB,IORVON,I,IORVOFF
+18 SET BLDTAB=($X-BLDTAB)-$LENGTH(I)
+19 ; S BLDTAB=($X-BLDTAB)-1
+20 SET CNTDWN=6-DAYPOS
End DoDot:3
+21 IF '$TEST
Begin DoDot:3
+22 WRITE ?(BLDTAB+(PPOFFSET+((DAYPOS+1)*(4)-$SELECT($LENGTH(I)=2:1,1:0)))),I
+23 SET CNTDWN=CNTDWN-1
End DoDot:3
End DoDot:2
+24 IF '$TEST
Begin DoDot:2
+25 WRITE ?(PPOFFSET+((DAYPOS+1)*(4)-$SELECT($LENGTH(I)=2:1,1:0))),I
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+28 ;=======================
+29 ;
ASKJULIA() ;RETURN RESPONSE--DO YOU WANT A CALENDAR A with dates
+1 ; expressed as the number of days elapsed since January 1?
+2 NEW DIR,DIRUT,Y
+3 WRITE !!
+4 SET DIR("A")="Include Calendar with elapsed days since Jan 1."
+5 SET DIR(0)="Y"
+6 SET DIR("B")="Y"
+7 SET DIR("?",1)="Hit return to display a calendar with dates expressed as"
+8 SET DIR("?",2)="the number of days elapsed since January 1."
+9 SET DIR("?",3)="Days are numbered sequentially from 1 to 365 or 366 in a"
+10 SET DIR("?",4)="leap year. January 1st is day number 1 and December 31st"
+11 SET DIR("?",5)="is day 365 in a non leap year. This calendar is often"
+12 SET DIR("?",6)="(but incorrectly), called a Julian Calendar."
+13 SET DIR("?",7)="------------------------------------------------------"
+14 SET DIR("?",8)="Julian Calendar"
+15 SET DIR("?",9)="==============="
+16 SET DIR("?",10)=" The solar calendar introduced by Julius Caesar in Rome "
+17 SET DIR("?",11)=" in 46 B.C., having a year of 12 months and 365 days and"
+18 SET DIR("?",12)=" a leap year of 366 days every fourth year. It was"
+19 SET DIR("?",13)=" eventually replaced by the Gregorian calendar."
+20 SET DIR("?",14)="------------------------------------------------------"
+21 SET DIR("?")=" Hit return to include the elapsed days calendar."
+22 DO ^DIR
+23 QUIT Y
+24 ;=======================
DISPJULI(DAYNO,NODAYS,JULIAND1) ;
+1 ; DISPLAY GREGORIAN AND JULIAN CALENDAR SIDE BY SIDE
+2 ;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
+3 ; beginning on Wednesday.
+4 ;
+5 NEW DAYS,DAYPOS,I,PPOFFSET
+6 SET PPOFFSET=6
+7 WRITE !
+8 FOR I=1:1:NODAYS
Begin DoDot:1
+9 SET DAYPOS=(DAYNO+I-1)#7
+10 IF DAYPOS=0
WRITE !
IF $GET(PPS(I))'=""
WRITE PPS(I)
+11 WRITE ?(PPOFFSET+((DAYPOS+1)*4-($LENGTH(I+JULIAND1)-1))),I+JULIAND1
End DoDot:1
+12 QUIT
+13 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
+14 ;
PAYROLMO(DAYNO,NODAYS) ;PAYROLL STYLE DISPLAY OF ENTIRE MONTH
+1 ;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
+2 ; beginning on Wednessday.
+3 ;
+4 NEW DAYS,DAYPOS,I
+5 SET DAYS="SUN MON TUE WED THU FRI SAT"
+6 WRITE !," ",DAYS,!
+7 FOR I=1:1:NODAYS
Begin DoDot:1
+8 SET DAYPOS=(DAYNO+I-1)#7
+9 IF DAYPOS=0
WRITE !
+10 WRITE ?((DAYPOS+1)*(4)-$SELECT($LENGTH(I)=2:1,1:0)),I
End DoDot:1
+11 QUIT
DAYSINMO(Y,M) ; Return number of days in month based on year and month
+1 ; Input: Y = year in 4 digit format between 1700 and 3000
+2 ; M = month expressed as an integer from 1 to 12 (Jan - Dec)
+3 ;
+4 NEW GOODY,GOODM
SET (GOODY,GOODM)=0
+5 IF Y<2700
IF Y>1700
SET GOODY=1
+6 IF M>0
IF M<13
SET GOODM=1
+7 if '(GOODM&GOODY)
QUIT 0
+8 QUIT $PIECE("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
+9 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
GETJULI(ZFMDATE,YEAR) ;
+1 NEW X1,X2
+2 SET X2=YEAR-1700_"0101"
+3 SET X1=ZFMDATE
+4 DO ^%DTC
+5 QUIT X
