[623] | 1 | PRS8HD ;HISC/MGD-DECOMPOSITION, DETERMINE HOLIDAYS ;01/3/2007
|
---|
| 2 | ;;4.0;PAID;**4,33,72,88,94,98,113**;Sep 21, 1995;Build 3
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ;This routine is used to determine legal holidays. One calls
|
---|
| 6 | ;^PRS8HD with nothing defined if one wants all holidays in the
|
---|
| 7 | ;next year. Tag EN can be called with PRS8D defined as a VA
|
---|
| 8 | ;FileManager format date from which to calculate holidays. See
|
---|
| 9 | ;later documentation in this routine regarding further processing
|
---|
| 10 | ;instructions.
|
---|
| 11 | ;
|
---|
| 12 | K PRS8D
|
---|
| 13 | ;
|
---|
| 14 | EN ;--- entry point
|
---|
| 15 | ; pass PRS8D as date you want in VA FileMan format
|
---|
| 16 | ; - where only year, i.e., 92 is passed, the first day is presumed
|
---|
| 17 | ; pass PRS8D(0) containing a holiday code if specific one wanted
|
---|
| 18 | ; if neither PRS8D or PRS8D(0) passed DT is assumed and all
|
---|
| 19 | ; holidays for next year are returned
|
---|
| 20 | ;
|
---|
| 21 | N CT,D,DD,DDQ,DN,DX,NY,%Y,PRSDT1 ;new variables used
|
---|
| 22 | K HD,HO,PRS8D(1) ;remove existing array if there
|
---|
| 23 | I '($D(DT)#2) D DT^DICRW ;get DT if none
|
---|
| 24 | S X=$G(PRS8D) I X']"" S X=DT ;use DT if no X
|
---|
| 25 | K %DT D ^%DT S X=Y I Y'>0 S PRS8D(1)=-1 G END ;bad date
|
---|
| 26 | I '+$E(X,4,5) S X=$E(X,1,3)_"01"_$S(+$E(X,6,7):$E(X,6,7),1:"01")
|
---|
| 27 | S PRSDT1=X
|
---|
| 28 | ;
|
---|
| 29 | ; Build sorted list (by month) of recurring holidays in array H()
|
---|
| 30 | ; If specific holiday code passed just get it, else get all.
|
---|
| 31 | ; Note that holiday code "E" is not a recurring holiday so it is
|
---|
| 32 | ; handled in another section after the recurring holidays are done.
|
---|
| 33 | S (CT,NY)=0,X1=$G(PRS8D(0)),X2="^K^P^M^I^L^C^V^T^X^N^"
|
---|
| 34 | I X1]"",X2[("^"_X1_"^") S X1=$F(X2,X1)-1\2+1,J=$P($T(H+(X1+6)),";;",2),H($P(J,"^",2),$P(J,"^",1))=$P(J,"^",3,5)
|
---|
| 35 | E I X1'="E" F I=1:1 S J=$P($T(H+(I+7)),";;",2) Q:J="" S H($P(J,"^",2),$P(J,"^",1))=$P(J,"^",3,5) ;get dates by month
|
---|
| 36 | ;
|
---|
| 37 | ; build output arrays for the recurring holidays
|
---|
| 38 | PASS ;--- come back here for a second pass if necessary
|
---|
| 39 | S DN=X,D(1)=+$E(X,1,3),D(2)=0 F S D(2)=$O(H(D(2))),D(3)="" Q:'D(2) F S D(3)=$O(H(D(2),D(3))) Q:D(3)="" D
|
---|
| 40 | .S DD=H(D(2),D(3))
|
---|
| 41 | .S D=D(1)+($S(D(2)<(+$E(DN,4,5)):1,1:0))_$E("00",0,2-$L(D(2)))_D(2)_$E(DN,6,7)
|
---|
| 42 | .I '$P(DD,"^",2) D
|
---|
| 43 | ..S (DX,X)=$E(D,1,5)_$E("00",0,2-$L(+$P(DD,"^",1)))_+$P(DD,"^",1)
|
---|
| 44 | ..D DW^%DTC S Y=%Y,X=DX
|
---|
| 45 | ..Q ;I Y,Y'=6 Q
|
---|
| 46 | ..S X2=$S('Y:"",1:"-")_1,X1=X D C^%DTC
|
---|
| 47 | .E D
|
---|
| 48 | ..S (DX,X)=$E(D,1,5)_"01"
|
---|
| 49 | ..D DW^%DTC S Y=%Y,X=DX
|
---|
| 50 | ..I Y'=+DD D
|
---|
| 51 | ...I +Y<+DD S X2=DD-Y
|
---|
| 52 | ...E S X2=7-(+Y)+DD
|
---|
| 53 | ...S X1=X D C^%DTC
|
---|
| 54 | ..I +$P(DD,"^",2)=1 S DX=X Q
|
---|
| 55 | ..S DD(1)=X,(DD(2),DD(3),DDQ)=0 F Q:DD(2)&(DDQ) D
|
---|
| 56 | ...S X2=7,X1=DD(1) D C^%DTC
|
---|
| 57 | ...S DD(2)=X,DDQ=1
|
---|
| 58 | ...I $E(DD(1),1,5)=$E(X,1,5) S DD(1)=X,DDQ=0
|
---|
| 59 | ...S DD(3)=DD(3)+1 I DD(3)=2,+$P(DD,"^",2)=3 S DDQ=1
|
---|
| 60 | ...I DD(3)=1,+$P(DD,"^",2)=4 S DDQ=1
|
---|
| 61 | ...I DD(3)=3,+$P(DD,"^",2)=5 S DDQ=1
|
---|
| 62 | ..S (DX,X)=DD(1)
|
---|
| 63 | .D DW^%DTC S Y=%Y,X=DX
|
---|
| 64 | .Q:X<DN
|
---|
| 65 | .D SET
|
---|
| 66 | .I +DD=+D(2)=+$E(DN,4,5),$P(DD,"^",3)="N" D
|
---|
| 67 | ..S NY=NY+1 Q:NY>1
|
---|
| 68 | ..S X=$E(DN,1,3)+1,(DX,X)=X_"0101"
|
---|
| 69 | ..D DW^%DTC S Y=%Y,X=DX
|
---|
| 70 | ..Q ;Q:Y'=6
|
---|
| 71 | ..S X2=-1,X1=X D C^%DTC S DX=X
|
---|
| 72 | ..D DW^%DTC S Y=%Y,X=DX
|
---|
| 73 | ..D SET
|
---|
| 74 | .K H(D(2),D(3))
|
---|
| 75 | I $O(H(0))>0 D
|
---|
| 76 | .S X=+$E(DN,4,5)
|
---|
| 77 | .S X=$S(X=12:1,1:(X+1))
|
---|
| 78 | .S X1=$E(DN,1,3)+$S(X=1:1,1:0),X=X1_$E("00",0,2-$L(X))_X_"01"
|
---|
| 79 | .D PASS
|
---|
| 80 | ;
|
---|
| 81 | ;new section to add applicable extra (non-recurring) holidays
|
---|
| 82 | I $G(PRS8D(0))=""!($G(PRS8D(0))="E") D
|
---|
| 83 | . N PRSDT2,PRSI,PRSX
|
---|
| 84 | . S PRSDT2=$$FMADD^XLFDT(PRSDT1,364)
|
---|
| 85 | . ;
|
---|
| 86 | . ; loop thru the extra holiday list
|
---|
| 87 | . F PRSI=1:1 S PRSX=$P($T(EHOL+PRSI),";;",2) Q:PRSX="" D
|
---|
| 88 | . . Q:$P(PRSX,U)<PRSDT1 ; skip if before input date
|
---|
| 89 | . . Q:$P(PRSX,U)>PRSDT2 ; skip if not within the next year
|
---|
| 90 | . . ; need to add this extra holiday to list
|
---|
| 91 | . . S HD($P(PRSX,U))=$P(PRSX,U,2,3)
|
---|
| 92 | . . S HO("E",$P(PRSX,U))=""
|
---|
| 93 | . . S CT=CT+1
|
---|
| 94 | . ;
|
---|
| 95 | . ; quit if site is not in the Washington DC area
|
---|
| 96 | . Q:"^101^688^"'[(U_$E($$STA^XUAF4(+$$KSP^XUPARAM("INST")),1,3)_U)
|
---|
| 97 | . ;
|
---|
| 98 | . ; loop thru additional DC location extra holiday list
|
---|
| 99 | . F PRSI=1:1 S PRSX=$P($T(EHOLDC+PRSI),";;",2) Q:PRSX="" D
|
---|
| 100 | . . Q:$P(PRSX,U)<PRSDT1 ; skip if before input date
|
---|
| 101 | . . Q:$P(PRSX,U)>PRSDT2 ; skip if not within the next year
|
---|
| 102 | . . ; need to add this extra holiday to list
|
---|
| 103 | . . S HD($P(PRSX,U))=$P(PRSX,U,2,3)
|
---|
| 104 | . . S HO("E",$P(PRSX,U))=""
|
---|
| 105 | . . S CT=CT+1
|
---|
| 106 | ;
|
---|
| 107 | S PRS8D(1)=$S(CT:+CT,1:-1)
|
---|
| 108 | ;
|
---|
| 109 | END ;--- That's all folks
|
---|
| 110 | K %DT,H,I,J,X,X1,X2,Y Q
|
---|
| 111 | ;
|
---|
| 112 | SET ;--- set nodes
|
---|
| 113 | S HD(X)=D(3)_"^"_$P("SUN^MON^TUES^WEDNES^THURS^FRI^SATUR","^",Y+1)_"DAY",HO($P(DD,"^",3),X)="",CT=CT+1 Q
|
---|
| 114 | ;
|
---|
| 115 | H ;--- Actual Holidays
|
---|
| 116 | ; PIECE1 PIECE2 PIECE3 PIECE4 PIECE5 PIECE6
|
---|
| 117 | ; actual month exact day 0=exact holiday how
|
---|
| 118 | ; holiday day-of-week 1=1st wk code deter-
|
---|
| 119 | ; 2=last wk mined
|
---|
| 120 | ; - pc3 and 4 are used in concert 3=3rd wk
|
---|
| 121 | ; 4=2nd wk,5=4th wk
|
---|
| 122 | ;
|
---|
| 123 | ;;M.L. King's Birthday^1^1^3^K^3rd Monday in January
|
---|
| 124 | ;;President's Day^2^1^3^P^3rd Monday in February
|
---|
| 125 | ;;Memorial Day^5^1^2^M^Last Monday in May
|
---|
| 126 | ;;Independence Day^7^4^0^I^July 4
|
---|
| 127 | ;;Labor Day^9^1^1^L^First Monday in September
|
---|
| 128 | ;;Columbus Day^10^1^4^C^Second Monday in October
|
---|
| 129 | ;;Veterans Day^11^11^0^V^November 11
|
---|
| 130 | ;;Thanksgiving Day^11^4^5^T^Fourth Thursday in November
|
---|
| 131 | ;;Christmas Day^12^25^0^X^December 25
|
---|
| 132 | ;;New Year's Day^1^1^0^N^January 1
|
---|
| 133 | ;
|
---|
| 134 | ;-Holiday Codes
|
---|
| 135 | ; - K = M.L. King P = President's Day M = Memorial Day
|
---|
| 136 | ; - I = Independence L = Labor Day C = Columbus Day
|
---|
| 137 | ; - V = Veterans Day T = Thanksgiving X = Christmas
|
---|
| 138 | ; - E = Extra Holiday (non-recurring) N = New Year's
|
---|
| 139 | ;
|
---|
| 140 | ;HD(HOLIDAY) is returned by routine equal to "literal^Dow"
|
---|
| 141 | ;HO("HOLIDAY CODE",HOLIDAY) is returned equal to null
|
---|
| 142 | ;PRS8D* is returned in value passed
|
---|
| 143 | ;PRS8D(1) is returned equal to # holidays found or -1 if none
|
---|
| 144 | ;
|
---|
| 145 | ;---------------------------------------------------------------------
|
---|
| 146 | ;New Section Added for Extra Non-Recurring Holidays (holiday code E)
|
---|
| 147 | ;
|
---|
| 148 | ; format is
|
---|
| 149 | ; FM date of the declared holiday^text^day of week^patch number
|
---|
| 150 | ;
|
---|
| 151 | ; The following list will need to be updated for years that have an
|
---|
| 152 | ; extra Christmas Holiday declared or and declared memorial day for
|
---|
| 153 | ; past presidents.
|
---|
| 154 | ;
|
---|
| 155 | EHOL ;
|
---|
| 156 | ;;2940427^President Nixon Funeral^WEDNESDAY^PRS*3.1*2
|
---|
| 157 | ;;2971226^Extra Christmas Day^FRIDAY^PRS*4*33
|
---|
| 158 | ;;3011224^Extra Christmas Day^MONDAY^PRS*4*72
|
---|
| 159 | ;;3031226^Extra Christmas Day^FRIDAY^PRS*4*88
|
---|
| 160 | ;;3040611^President Reagan Funeral^FRIDAY^PRS*4*94
|
---|
| 161 | ;;3070102^President Ford Funeral^TUESDAY^PRS*4*113
|
---|
| 162 | ;
|
---|
| 163 | ;---------------------------------------------------------------------
|
---|
| 164 | ;New Section Added for Extra Non-Recurring Holidays (holiday code E)
|
---|
| 165 | ;that are location specifc to the DC area
|
---|
| 166 | ;
|
---|
| 167 | ; format is
|
---|
| 168 | ; FM date of the declared holiday^text^day of week^patch number
|
---|
| 169 | ;
|
---|
| 170 | ; The following list will need to be updated when additional specific
|
---|
| 171 | ; holidays are declared that only apply to the DC area
|
---|
| 172 | ;
|
---|
| 173 | EHOLDC ;
|
---|
| 174 | ;;3050120^Presidential Inauguration Day^THURSDAY^PRS*4*98
|
---|
| 175 | ;
|
---|
| 176 | ;PRS8HD
|
---|