source: FOIAVistA/trunk/r/PAID-PRS/PRSLIB01.m@ 1166

Last change on this file since 1166 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1PRSLIB01 ;JAH/WCIOFO-PAID UTILITIES AND LIBRARY 01 ;Mar 25, 2005
2 ;;4.0;PAID;**45,93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5MAIN ;DISPLAY MONTHLY CALENDAR FOR ANY DATE
6 N OUT
7 F D CALENDAR(.OUT) Q:OUT
8 Q
9 ;= = = = = = = = = = = = = = = = = = = = = = = = = = =
10CALENDAR(OUT) ;
11 ; Ask user for a date and quit if not a valid date.
12 ; Get # of days in the month the user has selected.
13 ; Get the weekday for the 1st day of the selected month.
14 ; If necessary get days elapsed from jan 1 to 1st day of selected mo.
15 ; Display the month.
16 ;
17 S OUT=1
18 N ZFMDATE,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,SHOWJULI,HIGHLITE
19 N COUNT,HDR
20 ;
21 S %DT="AE" D ^%DT S ZFMDATE=Y ; Ask date.
22 Q:Y<1
23 ; if picked month has today-highlight
24 S HIGHLITE=0
25 I $E(Y,1,5)=$E(DT,1,5) S HIGHLITE=+$E(DT,6,7)
26 ;
27 ; Ask if they want to see the elapsed days calendar.
28 S SHOWJULI=$$ASKJULIA()
29 Q:Y<0
30 ;
31 ; Days in the month.
32 S MONTH=$E(ZFMDATE,4,5),YEAR=$E(ZFMDATE,1,3)+1700
33 S DAYS=$$DAYSINMO(YEAR,MONTH)
34 ;
35 S FIRSTDAY=$E(ZFMDATE,1,5)_"01",LASTDAY=$E(ZFMDATE,1,5)_DAYS
36 ;
37 ;Get the day #s of pay periods in this month
38 N PPS
39 I FIRSTDAY<3130000 D GETPPS(FIRSTDAY,LASTDAY)
40 ;
41 S DAY1=$$WEEKDAY1(ZFMDATE) ; Weekday of the 1st.
42 ;
43 ;
44 S HDR=$$GETHEAD(Y)
45 W @IOF,!
46 W "---------------",HDR,"------------"
47 D DISPMO(DAY1,DAYS,HIGHLITE) ; Display month.
48 I SHOWJULI D
49 . N JULID1
50 . S JULID1=$$GETJULI(FIRSTDAY,YEAR)
51 . W !!,"-------Elapsed Days Calendar---------"
52 . D DISPJULI(DAY1,DAYS,JULID1)
53 W !,"---------------Holidays------------",!
54 ;
55 ;DISPLAY HOLIDAYS
56 ;
57 N HO,HD,PRS8D,HOLIDAY
58 S PRS8D=$E(ZFMDATE,2,3) D EN^PRS8HD
59 S FIRSTDAY=$E(FIRSTDAY,1,5)_"00"
60 S HOLIDAY=FIRSTDAY
61 S COUNT=0
62 I FIRSTDAY<3140000 D
63 .F S HOLIDAY=$O(HD(HOLIDAY)) Q:HOLIDAY>LASTDAY!(HOLIDAY="") D
64 .. W !,?2,$P(HD(HOLIDAY),"^",2)," ",+$E(HOLIDAY,6,7),?15,$P(HD(HOLIDAY),"^")
65 .. S COUNT=COUNT+1
66 E W " Sorry, Can't find holidays past 2013." S COUNT=COUNT+1
67 I COUNT<1 W !," No Holidays this month."
68 W !,"-----------------------------------",!
69 S OUT=0
70 Q
71 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
72 ;
73SILMO(PRSDT) ;SILENT CALL TO DISPLAY MONTH
74 ; INPUT: PRSDT - must be fileman date
75 ;
76 N X,Y,%DT,DAY1,Y,MONTH,DAYS,YEAR,FIRSTDAY,LASTDAY,HIGHLITE,COUNT,HDR
77 S X=PRSDT D ^%DT Q:Y<0
78 ; if month has today-highlight
79 S HIGHLITE=0
80 I $E(Y,1,5)=$E(DT,1,5) S HIGHLITE=+$E(DT,6,7)
81 S MONTH=$E(PRSDT,4,5),YEAR=$E(PRSDT,1,3)+1700
82 S DAYS=$$DAYSINMO(YEAR,MONTH)
83 S FIRSTDAY=$E(PRSDT,1,5)_"01",LASTDAY=$E(PRSDT,1,5)_DAYS
84 ;
85 ;Get day #s of pps in month
86 N PPS
87 I FIRSTDAY<3130000 D GETPPS(FIRSTDAY,LASTDAY)
88 S DAY1=$$WEEKDAY1(PRSDT)
89 S HDR=$$GETHEAD(Y)
90 W @IOF,!,"---------------",HDR,"------------"
91 D DISPMO(DAY1,DAYS,HIGHLITE)
92 W !,"---------------Holidays------------",!
93 ;
94 ;holidays
95 N HO,HD,PRS8D,HOLIDAY
96 S PRS8D=$E(PRSDT,2,3) D EN^PRS8HD
97 S FIRSTDAY=$E(FIRSTDAY,1,5)_"00"
98 S HOLIDAY=FIRSTDAY
99 S COUNT=0
100 I FIRSTDAY<3140000 D
101 .F S HOLIDAY=$O(HD(HOLIDAY)) Q:HOLIDAY>LASTDAY!(HOLIDAY="") D
102 .. W !,?2,$P(HD(HOLIDAY),"^",2)," ",+$E(HOLIDAY,6,7),?15,$P(HD(HOLIDAY),"^")
103 .. S COUNT=COUNT+1
104 E W " Sorry, Can't find holidays past 2013." S COUNT=COUNT+1
105 I COUNT<1 W !," No Holidays this month."
106 W !,"-----------------------------------",!
107 Q
108 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
109 ;
110GETPPS(FIRSTDAY,LASTDAY) ;
111 N D1,PPE,PPDAY,PPI,PP4Y
112 S D1=FIRSTDAY D PP^PRSAPPU
113 D NX^PRSAPPU
114 I D1<FIRSTDAY S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU
115 S PPDAY=+$E(D1,6,7)
116 S PPS(PPDAY)=PPE
117 F D Q:D1>LASTDAY
118 . S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7) D NX^PRSAPPU
119 . Q:D1>LASTDAY
120 . S PPDAY=+$E(D1,6,7)
121 . S PPS(PPDAY)=PPE
122 Q
123 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
124 ;
125GETHEAD(Y) ;
126 N YEAR,MONTH,HDR,LENOFDT
127 S HDR=$$FMTE^XLFDT(Y,"1D")
128 S MONTH=$P(HDR," ")
129 S LENOFDT=$L(HDR," ")
130 S YEAR=$P(HDR," ",LENOFDT)
131 Q MONTH_" "_YEAR
132 ;
133 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
134 ;
135WEEKDAY1(ZDATE) ;get the weekday of the 1st day of the month
136 ; INPUT: ZDATE - FileMan date, used as the month to display
137 ; OUTPUT: return - Integer corresponding to day of week
138 ; (i.e. Sunday[1], Monday[2]) for the 1st day of
139 ; the month
140 S ZDATE=$E(ZDATE,1,5)_"01"
141 Q $$DOW^XLFDT(ZDATE,1)
142 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
143 ;
144DISPMO(DAYNO,NODAYS,HL) ;DISPLAY ENTIRE MONTH
145 ;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
146 ; beginning on Wednesday.
147 ;
148 ;Set up reverse video ON & OFF for today highlight
149 I $G(HL)>0 N IORVOFF,IORVON S X="IORVOFF;IORVON" D ENDR^%ZISS
150 ;
151 N DAYS,DAYPOS,I,PPOFFSET,CNTDWN,BLDTAB
152 S PPOFFSET=6,(BLDTAB,CNTDWN)=0
153 S DAYS="SUN MON TUE WED THU FRI SAT"
154 W !,?PPOFFSET," ",DAYS,!
155 F I=1:1:NODAYS D
156 . S DAYPOS=(DAYNO+I-1)#7
157 . I DAYPOS=0 W ! I $G(PPS(I))'="" W PPS(I)
158 . I ($G(HL)=I)!($G(CNTDWN)>0) D
159 .. I $G(HL)=I D
160 ... S BLDTAB=(PPOFFSET+((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0)))
161 ... W ?BLDTAB,IORVON,I,IORVOFF
162 ... S BLDTAB=($X-BLDTAB)-$L(I)
163 ...; S BLDTAB=($X-BLDTAB)-1
164 ... S CNTDWN=6-DAYPOS
165 .. E D
166 ... W ?(BLDTAB+(PPOFFSET+((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0)))),I
167 ... S CNTDWN=CNTDWN-1
168 . E D
169 .. W ?(PPOFFSET+((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0))),I
170 Q
171 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
172 ;=======================
173 ;
174ASKJULIA() ;RETURN RESPONSE--DO YOU WANT A CALENDAR A with dates
175 ; expressed as the number of days elapsed since January 1?
176 N DIR,DIRUT,Y
177 W !!
178 S DIR("A")="Include Calendar with elapsed days since Jan 1."
179 S DIR(0)="Y"
180 S DIR("B")="Y"
181 S DIR("?",1)="Hit return to display a calendar with dates expressed as"
182 S DIR("?",2)="the number of days elapsed since January 1."
183 S DIR("?",3)="Days are numbered sequentially from 1 to 365 or 366 in a"
184 S DIR("?",4)="leap year. January 1st is day number 1 and December 31st"
185 S DIR("?",5)="is day 365 in a non leap year. This calendar is often"
186 S DIR("?",6)="(but incorrectly), called a Julian Calendar."
187 S DIR("?",7)="------------------------------------------------------"
188 S DIR("?",8)="Julian Calendar"
189 S DIR("?",9)="==============="
190 S DIR("?",10)=" The solar calendar introduced by Julius Caesar in Rome "
191 S DIR("?",11)=" in 46 B.C., having a year of 12 months and 365 days and"
192 S DIR("?",12)=" a leap year of 366 days every fourth year. It was"
193 S DIR("?",13)=" eventually replaced by the Gregorian calendar."
194 S DIR("?",14)="------------------------------------------------------"
195 S DIR("?")=" Hit return to include the elapsed days calendar."
196 D ^DIR
197 Q Y
198 ;=======================
199DISPJULI(DAYNO,NODAYS,JULIAND1) ;
200 ; DISPLAY GREGORIAN AND JULIAN CALENDAR SIDE BY SIDE
201 ;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
202 ; beginning on Wednesday.
203 ;
204 N DAYS,DAYPOS,I,PPOFFSET
205 S PPOFFSET=6
206 W !
207 F I=1:1:NODAYS D
208 . S DAYPOS=(DAYNO+I-1)#7
209 . I DAYPOS=0 W ! I $G(PPS(I))'="" W PPS(I)
210 . W ?(PPOFFSET+((DAYPOS+1)*4-($L(I+JULIAND1)-1))),I+JULIAND1
211 Q
212 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
213 ;
214PAYROLMO(DAYNO,NODAYS) ;PAYROLL STYLE DISPLAY OF ENTIRE MONTH
215 ;SAMPLE CALL: D DISPMO(4,30) Produces a 30 month with day 1
216 ; beginning on Wednessday.
217 ;
218 N DAYS,DAYPOS,I
219 S DAYS="SUN MON TUE WED THU FRI SAT"
220 W !," ",DAYS,!
221 F I=1:1:NODAYS D
222 . S DAYPOS=(DAYNO+I-1)#7
223 . I DAYPOS=0 W !
224 . W ?((DAYPOS+1)*(4)-$S($L(I)=2:1,1:0)),I
225 Q
226DAYSINMO(Y,M) ; Return number of days in month based on year and month
227 ; Input: Y = year in 4 digit format between 1700 and 3000
228 ; M = month expressed as an integer from 1 to 12 (Jan - Dec)
229 ;
230 N GOODY,GOODM S (GOODY,GOODM)=0
231 I Y<2700,Y>1700 S GOODY=1
232 I M>0,M<13 S GOODM=1
233 Q:'(GOODM&GOODY) 0
234 Q $P("31^"_(28+$$LEAPYR^PRSLIB00(YEAR))_"^31^30^31^30^31^31^30^31^30^31",U,MONTH)
235 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
236GETJULI(ZFMDATE,YEAR) ;
237 N X1,X2
238 S X2=YEAR-1700_"0101"
239 S X1=ZFMDATE
240 D ^%DTC
241 Q X
Note: See TracBrowser for help on using the repository browser.