Released PRS*4*123 SEQ #109 Extracted from mail message **KIDS**:PRS*4.0*123^ **INSTALL NAME** PRS*4.0*123 "BLD",7942,0) PRS*4.0*123^PAID^0^3081217^y "BLD",7942,1,0) ^^2^2^3081217^ "BLD",7942,1,1,0) This patch will set Inauguration Day, Tuesday January 20, 2009 as a "BLD",7942,1,2,0) holiday for stations 101 and 688. "BLD",7942,4,0) ^9.64PA^^ "BLD",7942,6.3) 1 "BLD",7942,"ABPKG") n "BLD",7942,"KRN",0) ^9.67PA^779.2^20 "BLD",7942,"KRN",.4,0) .4 "BLD",7942,"KRN",.401,0) .401 "BLD",7942,"KRN",.402,0) .402 "BLD",7942,"KRN",.403,0) .403 "BLD",7942,"KRN",.5,0) .5 "BLD",7942,"KRN",.84,0) .84 "BLD",7942,"KRN",3.6,0) 3.6 "BLD",7942,"KRN",3.8,0) 3.8 "BLD",7942,"KRN",9.2,0) 9.2 "BLD",7942,"KRN",9.8,0) 9.8 "BLD",7942,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",7942,"KRN",9.8,"NM",1,0) PRS8HD^^0^B30494561 "BLD",7942,"KRN",9.8,"NM",2,0) PRSAPPH^^0^B21569382 "BLD",7942,"KRN",9.8,"NM","B","PRS8HD",1) "BLD",7942,"KRN",9.8,"NM","B","PRSAPPH",2) "BLD",7942,"KRN",19,0) 19 "BLD",7942,"KRN",19.1,0) 19.1 "BLD",7942,"KRN",101,0) 101 "BLD",7942,"KRN",409.61,0) 409.61 "BLD",7942,"KRN",771,0) 771 "BLD",7942,"KRN",779.2,0) 779.2 "BLD",7942,"KRN",870,0) 870 "BLD",7942,"KRN",8989.51,0) 8989.51 "BLD",7942,"KRN",8989.52,0) 8989.52 "BLD",7942,"KRN",8994,0) 8994 "BLD",7942,"KRN","B",.4,.4) "BLD",7942,"KRN","B",.401,.401) "BLD",7942,"KRN","B",.402,.402) "BLD",7942,"KRN","B",.403,.403) "BLD",7942,"KRN","B",.5,.5) "BLD",7942,"KRN","B",.84,.84) "BLD",7942,"KRN","B",3.6,3.6) "BLD",7942,"KRN","B",3.8,3.8) "BLD",7942,"KRN","B",9.2,9.2) "BLD",7942,"KRN","B",9.8,9.8) "BLD",7942,"KRN","B",19,19) "BLD",7942,"KRN","B",19.1,19.1) "BLD",7942,"KRN","B",101,101) "BLD",7942,"KRN","B",409.61,409.61) "BLD",7942,"KRN","B",771,771) "BLD",7942,"KRN","B",779.2,779.2) "BLD",7942,"KRN","B",870,870) "BLD",7942,"KRN","B",8989.51,8989.51) "BLD",7942,"KRN","B",8989.52,8989.52) "BLD",7942,"KRN","B",8994,8994) "BLD",7942,"QUES",0) ^9.62^^ "BLD",7942,"REQB",0) ^9.611^2^2 "BLD",7942,"REQB",1,0) PRS*4.0*122^1 "BLD",7942,"REQB",2,0) PRS*4.0*116^1 "BLD",7942,"REQB","B","PRS*4.0*116",2) "BLD",7942,"REQB","B","PRS*4.0*122",1) "MBREQ") 0 "PKG",408,-1) 1^1 "PKG",408,0) PAID^PRS^PAID "PKG",408,20,0) ^9.402P^^ "PKG",408,22,0) ^9.49I^1^1 "PKG",408,22,1,0) 4.0^2950912^2960130 "PKG",408,22,1,"PAH",1,0) 123^3081217 "PKG",408,22,1,"PAH",1,1,0) ^^2^2^3081217 "PKG",408,22,1,"PAH",1,1,1,0) This patch will set Inauguration Day, Tuesday January 20, 2009 as a "PKG",408,22,1,"PAH",1,1,2,0) holiday for stations 101 and 688. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","PRS8HD") 0^1^B30494561^B29518331 "RTN","PRS8HD",1,0) PRS8HD ;HISC/MGD-DECOMPOSITION, DETERMINE HOLIDAYS ;12/17/2008 "RTN","PRS8HD",2,0) ;;4.0;PAID;**4,33,72,88,94,98,113,118,122,123**;Sep 21, 1995;Build 1 "RTN","PRS8HD",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRS8HD",4,0) ; "RTN","PRS8HD",5,0) ;This routine is used to determine legal holidays. One calls "RTN","PRS8HD",6,0) ;^PRS8HD with nothing defined if one wants all holidays in the "RTN","PRS8HD",7,0) ;next year. Tag EN can be called with PRS8D defined as a VA "RTN","PRS8HD",8,0) ;FileManager format date from which to calculate holidays. See "RTN","PRS8HD",9,0) ;later documentation in this routine regarding further processing "RTN","PRS8HD",10,0) ;instructions. "RTN","PRS8HD",11,0) ; "RTN","PRS8HD",12,0) K PRS8D "RTN","PRS8HD",13,0) ; "RTN","PRS8HD",14,0) EN ;--- entry point "RTN","PRS8HD",15,0) ; pass PRS8D as date you want in VA FileMan format "RTN","PRS8HD",16,0) ; - where only year, i.e., 92 is passed, the first day is presumed "RTN","PRS8HD",17,0) ; pass PRS8D(0) containing a holiday code if specific one wanted "RTN","PRS8HD",18,0) ; if neither PRS8D or PRS8D(0) passed DT is assumed and all "RTN","PRS8HD",19,0) ; holidays for next year are returned "RTN","PRS8HD",20,0) ; "RTN","PRS8HD",21,0) N CT,D,DD,DDQ,DN,DX,NY,%Y,PRSDT1 ;new variables used "RTN","PRS8HD",22,0) K HD,HO,PRS8D(1) ;remove existing array if there "RTN","PRS8HD",23,0) I '($D(DT)#2) D DT^DICRW ;get DT if none "RTN","PRS8HD",24,0) S X=$G(PRS8D) I X']"" S X=DT ;use DT if no X "RTN","PRS8HD",25,0) K %DT D ^%DT S X=Y I Y'>0 S PRS8D(1)=-1 G END ;bad date "RTN","PRS8HD",26,0) I '+$E(X,4,5) S X=$E(X,1,3)_"01"_$S(+$E(X,6,7):$E(X,6,7),1:"01") "RTN","PRS8HD",27,0) S PRSDT1=X "RTN","PRS8HD",28,0) ; "RTN","PRS8HD",29,0) ; Build sorted list (by month) of recurring holidays in array H() "RTN","PRS8HD",30,0) ; If specific holiday code passed just get it, else get all. "RTN","PRS8HD",31,0) ; Note that holiday code "E" is not a recurring holiday so it is "RTN","PRS8HD",32,0) ; handled in another section after the recurring holidays are done. "RTN","PRS8HD",33,0) S (CT,NY)=0,X1=$G(PRS8D(0)),X2="^K^P^M^I^L^C^V^T^X^N^" "RTN","PRS8HD",34,0) 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) "RTN","PRS8HD",35,0) 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 "RTN","PRS8HD",36,0) ; "RTN","PRS8HD",37,0) ; build output arrays for the recurring holidays "RTN","PRS8HD",38,0) PASS ;--- come back here for a second pass if necessary "RTN","PRS8HD",39,0) 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 "RTN","PRS8HD",40,0) .S DD=H(D(2),D(3)) "RTN","PRS8HD",41,0) .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) "RTN","PRS8HD",42,0) .I '$P(DD,"^",2) D "RTN","PRS8HD",43,0) ..S (DX,X)=$E(D,1,5)_$E("00",0,2-$L(+$P(DD,"^",1)))_+$P(DD,"^",1) "RTN","PRS8HD",44,0) ..D DW^%DTC S Y=%Y,X=DX "RTN","PRS8HD",45,0) ..Q ;I Y,Y'=6 Q "RTN","PRS8HD",46,0) ..S X2=$S('Y:"",1:"-")_1,X1=X D C^%DTC "RTN","PRS8HD",47,0) .E D "RTN","PRS8HD",48,0) ..S (DX,X)=$E(D,1,5)_"01" "RTN","PRS8HD",49,0) ..D DW^%DTC S Y=%Y,X=DX "RTN","PRS8HD",50,0) ..I Y'=+DD D "RTN","PRS8HD",51,0) ...I +Y<+DD S X2=DD-Y "RTN","PRS8HD",52,0) ...E S X2=7-(+Y)+DD "RTN","PRS8HD",53,0) ...S X1=X D C^%DTC "RTN","PRS8HD",54,0) ..I +$P(DD,"^",2)=1 S DX=X Q "RTN","PRS8HD",55,0) ..S DD(1)=X,(DD(2),DD(3),DDQ)=0 F Q:DD(2)&(DDQ) D "RTN","PRS8HD",56,0) ...S X2=7,X1=DD(1) D C^%DTC "RTN","PRS8HD",57,0) ...S DD(2)=X,DDQ=1 "RTN","PRS8HD",58,0) ...I $E(DD(1),1,5)=$E(X,1,5) S DD(1)=X,DDQ=0 "RTN","PRS8HD",59,0) ...S DD(3)=DD(3)+1 I DD(3)=2,+$P(DD,"^",2)=3 S DDQ=1 "RTN","PRS8HD",60,0) ...I DD(3)=1,+$P(DD,"^",2)=4 S DDQ=1 "RTN","PRS8HD",61,0) ...I DD(3)=3,+$P(DD,"^",2)=5 S DDQ=1 "RTN","PRS8HD",62,0) ..S (DX,X)=DD(1) "RTN","PRS8HD",63,0) .D DW^%DTC S Y=%Y,X=DX "RTN","PRS8HD",64,0) .Q:X1 "RTN","PRS8HD",68,0) ..S X=$E(DN,1,3)+1,(DX,X)=X_"0101" "RTN","PRS8HD",69,0) ..D DW^%DTC S Y=%Y,X=DX "RTN","PRS8HD",70,0) ..Q ;Q:Y'=6 "RTN","PRS8HD",71,0) ..S X2=-1,X1=X D C^%DTC S DX=X "RTN","PRS8HD",72,0) ..D DW^%DTC S Y=%Y,X=DX "RTN","PRS8HD",73,0) ..D SET "RTN","PRS8HD",74,0) .K H(D(2),D(3)) "RTN","PRS8HD",75,0) I $O(H(0))>0 D "RTN","PRS8HD",76,0) .S X=+$E(DN,4,5) "RTN","PRS8HD",77,0) .S X=$S(X=12:1,1:(X+1)) "RTN","PRS8HD",78,0) .S X1=$E(DN,1,3)+$S(X=1:1,1:0),X=X1_$E("00",0,2-$L(X))_X_"01" "RTN","PRS8HD",79,0) .D PASS "RTN","PRS8HD",80,0) ; "RTN","PRS8HD",81,0) ;new section to add applicable extra (non-recurring) holidays "RTN","PRS8HD",82,0) I $G(PRS8D(0))=""!($G(PRS8D(0))="E") D "RTN","PRS8HD",83,0) . N PRSDT2,PRSI,PRSX "RTN","PRS8HD",84,0) . S PRSDT2=$$FMADD^XLFDT(PRSDT1,364) "RTN","PRS8HD",85,0) . ; "RTN","PRS8HD",86,0) . ; loop thru the extra holiday list "RTN","PRS8HD",87,0) . F PRSI=1:1 S PRSX=$P($T(EHOL+PRSI),";;",2) Q:PRSX="" D "RTN","PRS8HD",88,0) . . Q:$P(PRSX,U)PRSDT2 ; skip if not within the next year "RTN","PRS8HD",90,0) . . ; need to add this extra holiday to list "RTN","PRS8HD",91,0) . . S HD($P(PRSX,U))=$P(PRSX,U,2,3) "RTN","PRS8HD",92,0) . . S HO("E",$P(PRSX,U))="" "RTN","PRS8HD",93,0) . . S CT=CT+1 "RTN","PRS8HD",94,0) . ; "RTN","PRS8HD",95,0) . ; quit if site is not in the Washington DC area "RTN","PRS8HD",96,0) . Q:"^101^688^"'[(U_$E($$STA^XUAF4(+$$KSP^XUPARAM("INST")),1,3)_U) "RTN","PRS8HD",97,0) . ; "RTN","PRS8HD",98,0) . ; loop thru additional DC location extra holiday list "RTN","PRS8HD",99,0) . F PRSI=1:1 S PRSX=$P($T(EHOLDC+PRSI),";;",2) Q:PRSX="" D "RTN","PRS8HD",100,0) . . Q:$P(PRSX,U)PRSDT2 ; skip if not within the next year "RTN","PRS8HD",102,0) . . ; need to add this extra holiday to list "RTN","PRS8HD",103,0) . . S HD($P(PRSX,U))=$P(PRSX,U,2,3) "RTN","PRS8HD",104,0) . . S HO("E",$P(PRSX,U))="" "RTN","PRS8HD",105,0) . . S CT=CT+1 "RTN","PRS8HD",106,0) ; "RTN","PRS8HD",107,0) S PRS8D(1)=$S(CT:+CT,1:-1) "RTN","PRS8HD",108,0) ; "RTN","PRS8HD",109,0) END ;--- That's all folks "RTN","PRS8HD",110,0) K %DT,H,I,J,X,X1,X2,Y Q "RTN","PRS8HD",111,0) ; "RTN","PRS8HD",112,0) SET ;--- set nodes "RTN","PRS8HD",113,0) 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 "RTN","PRS8HD",114,0) ; "RTN","PRS8HD",115,0) H ;--- Actual Holidays "RTN","PRS8HD",116,0) ; PIECE1 PIECE2 PIECE3 PIECE4 PIECE5 PIECE6 "RTN","PRS8HD",117,0) ; actual month exact day 0=exact holiday how "RTN","PRS8HD",118,0) ; holiday day-of-week 1=1st wk code deter- "RTN","PRS8HD",119,0) ; 2=last wk mined "RTN","PRS8HD",120,0) ; - pc3 and 4 are used in concert 3=3rd wk "RTN","PRS8HD",121,0) ; 4=2nd wk,5=4th wk "RTN","PRS8HD",122,0) ; "RTN","PRS8HD",123,0) ;;M.L. King's Birthday^1^1^3^K^3rd Monday in January "RTN","PRS8HD",124,0) ;;President's Day^2^1^3^P^3rd Monday in February "RTN","PRS8HD",125,0) ;;Memorial Day^5^1^2^M^Last Monday in May "RTN","PRS8HD",126,0) ;;Independence Day^7^4^0^I^July 4 "RTN","PRS8HD",127,0) ;;Labor Day^9^1^1^L^First Monday in September "RTN","PRS8HD",128,0) ;;Columbus Day^10^1^4^C^Second Monday in October "RTN","PRS8HD",129,0) ;;Veterans Day^11^11^0^V^November 11 "RTN","PRS8HD",130,0) ;;Thanksgiving Day^11^4^5^T^Fourth Thursday in November "RTN","PRS8HD",131,0) ;;Christmas Day^12^25^0^X^December 25 "RTN","PRS8HD",132,0) ;;New Year's Day^1^1^0^N^January 1 "RTN","PRS8HD",133,0) ; "RTN","PRS8HD",134,0) ;-Holiday Codes "RTN","PRS8HD",135,0) ; - K = M.L. King P = President's Day M = Memorial Day "RTN","PRS8HD",136,0) ; - I = Independence L = Labor Day C = Columbus Day "RTN","PRS8HD",137,0) ; - V = Veterans Day T = Thanksgiving X = Christmas "RTN","PRS8HD",138,0) ; - E = Extra Holiday (non-recurring) N = New Year's "RTN","PRS8HD",139,0) ; "RTN","PRS8HD",140,0) ;HD(HOLIDAY) is returned by routine equal to "literal^Dow" "RTN","PRS8HD",141,0) ;HO("HOLIDAY CODE",HOLIDAY) is returned equal to null "RTN","PRS8HD",142,0) ;PRS8D* is returned in value passed "RTN","PRS8HD",143,0) ;PRS8D(1) is returned equal to # holidays found or -1 if none "RTN","PRS8HD",144,0) ; "RTN","PRS8HD",145,0) ;--------------------------------------------------------------------- "RTN","PRS8HD",146,0) ;New Section Added for Extra Non-Recurring Holidays (holiday code E) "RTN","PRS8HD",147,0) ; "RTN","PRS8HD",148,0) ; format is "RTN","PRS8HD",149,0) ; FM date of the declared holiday^text^day of week^patch number "RTN","PRS8HD",150,0) ; "RTN","PRS8HD",151,0) ; The following list will need to be updated for years that have an "RTN","PRS8HD",152,0) ; extra Christmas Holiday declared or and declared memorial day for "RTN","PRS8HD",153,0) ; past presidents. "RTN","PRS8HD",154,0) ; "RTN","PRS8HD",155,0) EHOL ; "RTN","PRS8HD",156,0) ;;2940427^President Nixon Funeral^WEDNESDAY^PRS*3.1*2 "RTN","PRS8HD",157,0) ;;2971226^Extra Christmas Day^FRIDAY^PRS*4*33 "RTN","PRS8HD",158,0) ;;3011224^Extra Christmas Day^MONDAY^PRS*4*72 "RTN","PRS8HD",159,0) ;;3031226^Extra Christmas Day^FRIDAY^PRS*4*88 "RTN","PRS8HD",160,0) ;;3040611^President Reagan Funeral^FRIDAY^PRS*4*94 "RTN","PRS8HD",161,0) ;;3070102^President Ford Funeral^TUESDAY^PRS*4*113 "RTN","PRS8HD",162,0) ;;3071224^Extra Christmas Day^MONDAY^PRS*4*118 "RTN","PRS8HD",163,0) ;;3081226^Extra Christmas Day^FRIDAY^PRS*4*122 "RTN","PRS8HD",164,0) ; "RTN","PRS8HD",165,0) ;--------------------------------------------------------------------- "RTN","PRS8HD",166,0) ;New Section Added for Extra Non-Recurring Holidays (holiday code E) "RTN","PRS8HD",167,0) ;that are location specifc to the DC area "RTN","PRS8HD",168,0) ; "RTN","PRS8HD",169,0) ; format is "RTN","PRS8HD",170,0) ; FM date of the declared holiday^text^day of week^patch number "RTN","PRS8HD",171,0) ; "RTN","PRS8HD",172,0) ; The following list will need to be updated when additional specific "RTN","PRS8HD",173,0) ; holidays are declared that only apply to the DC area "RTN","PRS8HD",174,0) ; "RTN","PRS8HD",175,0) EHOLDC ; "RTN","PRS8HD",176,0) ;;3050120^Presidential Inauguration Day^THURSDAY^PRS*4*98 "RTN","PRS8HD",177,0) ;;3090120^Presidential Inauguration Day^TUESDAY^PRS*4*123 "RTN","PRS8HD",178,0) ; "RTN","PRS8HD",179,0) ;PRS8HD "RTN","PRSAPPH") 0^2^B21569382^B20434653 "RTN","PRSAPPH",1,0) PRSAPPH ; WOIFO/JAH - Holiday Utilities ;12/17/08 "RTN","PRSAPPH",2,0) ;;4.0;PAID;**33,66,113,112,116,123**;Sep 21, 1995;Build 1 "RTN","PRSAPPH",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PRSAPPH",4,0) K HOL S PDT=$G(^PRST(458,PPI,1)) Q:PDT="" S X1=$P(PDT,"^",1),X2=-6 D C^%DTC "RTN","PRSAPPH",5,0) S PRS8D=X D EN^PRS8HD "RTN","PRSAPPH",6,0) S PDH=PRS8D F DAY=1:1:25 S X1=PRS8D,X2=DAY D C^%DTC S PDH=PDH_"^"_X "RTN","PRSAPPH",7,0) F DAY=1:1:26 S Z=$P(PDH,"^",DAY) I $D(HD(Z)) S HOL(Z)=$S(DAY<7:-DAY,1:DAY-6) I $G(HD(Z))["Inauguration" S HOL(Z,"SC")="W" "RTN","PRSAPPH",8,0) K HO,HD,PRS8D,PDH Q "RTN","PRSAPPH",9,0) E ; Set Holidays for Employees "RTN","PRSAPPH",10,0) S FLX=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",6),DB=$P($G(^PRSPC(DFN,0)),"^",10) "RTN","PRSAPPH",11,0) S NH=$P($G(^PRSPC(DFN,0)),"^",16) Q:NH>80 "RTN","PRSAPPH",12,0) F LLL=0:0 S LLL=$O(HOL(LLL)) Q:LLL<1 S DAY=HOL(LLL) D E0 "RTN","PRSAPPH",13,0) Q "RTN","PRSAPPH",14,0) E0 ; Find Benefit Day "RTN","PRSAPPH",15,0) Q:DAY=15 I DAY>0,DAY<15 G P0 "RTN","PRSAPPH",16,0) Q:$D(HOL(LLL,"SC")) "RTN","PRSAPPH",17,0) Q:DB'=1 Q:NH=48!(NH=72) G P1:DAY<0,P3:DAY>14 "RTN","PRSAPPH",18,0) P0 S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2) Q:'TC "RTN","PRSAPPH",19,0) I (TC=3)!(TC=4) G U1 "RTN","PRSAPPH",20,0) I DB=1,NH=48 G U1 "RTN","PRSAPPH",21,0) S C=0 "RTN","PRSAPPH",22,0) I TC=2!$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",8)!$P($G(^(0)),"^",14),'$P($G(^(0)),"^",12) G S0 "RTN","PRSAPPH",23,0) Q:$P($G(^(0)),"^",12)=LLL&(TT="HX") "RTN","PRSAPPH",24,0) G U1:DB=2!(NH=72) "RTN","PRSAPPH",25,0) I $G(HOL(LLL,"SC"))="W" G U1 "RTN","PRSAPPH",26,0) ; From this point on the code is trying to find an In Lieu of Day "RTN","PRSAPPH",27,0) I FLX'="C" G EF:(DAY#7=1),EB:(DAY#7=0) "RTN","PRSAPPH",28,0) S C=0 F X1=$S(DAY<8:1,1:8):1:DAY I '$P($G(^PRST(458,PPI,"E",DFN,"D",X1,0)),"^",8),'$P($G(^(0)),"^",14) S C=C+1 "RTN","PRSAPPH",29,0) I FLX'="C" G EF:C<2,EB "RTN","PRSAPPH",30,0) I C'=2 G EF:C<3,EB "RTN","PRSAPPH",31,0) I DAY#7 F X1=DAY+1:1:$S(DAY<8:7,1:14) I '$P($G(^PRST(458,PPI,"E",DFN,"D",X1,0)),"^",8),'$P($G(^(0)),"^",14) S C=C+1 "RTN","PRSAPPH",32,0) G EB:C=2,EF "RTN","PRSAPPH",33,0) ; "RTN","PRSAPPH",34,0) ;if looking forward, don't set off for another holiday "RTN","PRSAPPH",35,0) ; "RTN","PRSAPPH",36,0) EF F DAY=DAY+1:1:14 S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2) Q:TC="" I TC=2!$P($G(^(0)),"^",8)!$P($G(^(0)),"^",14),'$$FUTRHOL(),$$PREVSET() G S0 "RTN","PRSAPPH",37,0) Q "RTN","PRSAPPH",38,0) ; "RTN","PRSAPPH",39,0) FUTRHOL() ;Check to see if day is another future holiday. "RTN","PRSAPPH",40,0) Q $G(HOL($P($G(^PRST(458,PPI,1)),"^",DAY)))>0 "RTN","PRSAPPH",41,0) PREVSET() ; Day NOT Already Set as holiday "RTN","PRSAPPH",42,0) Q ('($P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)>0)!($P($G(^(0)),"^",12)=LLL)) "RTN","PRSAPPH",43,0) ; "RTN","PRSAPPH",44,0) ;back up to find an available day to set the Holiday. "RTN","PRSAPPH",45,0) EB F DAY=DAY-1:-1:1 S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2) Q:TC="" I $$PREVSET(),TC=2!$P($G(^(0)),"^",8)!$P($G(^(0)),"^",14) G S0 "RTN","PRSAPPH",46,0) Q "RTN","PRSAPPH",47,0) ; "RTN","PRSAPPH",48,0) P1 I FLX'="C" Q:DAY'=-5 S C=13 D PF Q:'Z S DAY=0 G EF "RTN","PRSAPPH",49,0) S C=8-DAY D PF Q:'Z "RTN","PRSAPPH",50,0) S DAY=8-DAY,C=0 F X1=8:1:DAY I '$P($G(^PRST(458,PPI-1,"E",DFN,"D",X1,0)),"^",8),'$P($G(^(0)),"^",14) S C=C+1 "RTN","PRSAPPH",51,0) Q:C>2 I C<2 S DAY=0 G EF "RTN","PRSAPPH",52,0) I DAY<14 F X1=DAY+1:1:14 I '$P($G(^PRST(458,PPI-1,"E",DFN,"D",X1,0)),"^",8),'$P($G(^(0)),"^",14) S C=C+1 "RTN","PRSAPPH",53,0) Q:C=2 S DAY=0 G EF "RTN","PRSAPPH",54,0) P3 I FLX'="C" Q:DAY'=16 S C=2 D PN Q:'Z S DAY=15 G EB "RTN","PRSAPPH",55,0) Q:DAY=15 S C=DAY-14 D PN Q:'Z I DAY>16 S DAY=15 G EB "RTN","PRSAPPH",56,0) S C=2 F L1=3:1:7 D "RTN","PRSAPPH",57,0) .S X1=$G(^PRST(458,PPI+1,"E",DFN,"D",L1,0)) I X1'="" S:$P(X1,"^",8)+$P(X1,"^",14)=0 C=C+1 Q "RTN","PRSAPPH",58,0) .S X1=$P($G(^PRST(458,PPI,"E",DFN,"D",L1,0)),"^",2,4) I $P(X1,"^",3),$P(X1,"^",4) S X1=$P(X1,"^",4) "RTN","PRSAPPH",59,0) .S:'$P($G(^PRST(457.1,+X1,0)),"^",6) C=C+1 Q "RTN","PRSAPPH",60,0) Q:C>2 S DAY=15 G EB "RTN","PRSAPPH",61,0) PN ; Determine TC for next Pay Period; if Z=1 then all TC=1 for days 1 to C "RTN","PRSAPPH",62,0) S Z=1 F C=C:-1:1 D Q:'Z "RTN","PRSAPPH",63,0) .S X1=$P($G(^PRST(458,PPI+1,"E",DFN,"D",C,0)),"^",2) I X1=2 S Z=0 Q "RTN","PRSAPPH",64,0) .I X1'="" S X1=$P($G(^PRST(458,PPI+1,"E",DFN,"D",C,0)),"^",8)+$P($G(^(0)),"^",14) S:X1 Z=0 Q "RTN","PRSAPPH",65,0) .S X1=$P($G(^PRST(458,PPI,"E",DFN,"D",C,0)),"^",2,4) I $P(X1,"^",2),$P(X1,"^",3) S X1=$P(X1,"^",3) "RTN","PRSAPPH",66,0) .S X1=+X1 I X1=0!(X1=2) S Z=0 Q "RTN","PRSAPPH",67,0) .S:$P($G(^PRST(457.1,X1,0)),"^",6) Z=0 Q "RTN","PRSAPPH",68,0) Q "RTN","PRSAPPH",69,0) PF ; Determine TC for prior PP "RTN","PRSAPPH",70,0) S Z=1 F C=C:1:14 D Q:'Z "RTN","PRSAPPH",71,0) .S X1=$P($G(^PRST(458,PPI-1,"E",DFN,"D",C,0)),"^",2) I X1=""!(X1=2) S Z=0 Q "RTN","PRSAPPH",72,0) .S X1=$P($G(^PRST(458,PPI-1,"E",DFN,"D",C,0)),"^",8)+$P($G(^(0)),"^",14) S:X1 Z=0 Q "RTN","PRSAPPH",73,0) Q "RTN","PRSAPPH",74,0) S0 ; Set Holiday (Excused or Worked) "RTN","PRSAPPH",75,0) I TT="HX",$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)=LLL Q "RTN","PRSAPPH",76,0) S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,1)) I Z="" S $P(^(2),"^",3)=TT Q:TT="HW" G UPD "RTN","PRSAPPH",77,0) S ZS=$G(^PRST(458,PPI,"E",DFN,"D",DAY,4)) I ZS'="" D FND "RTN","PRSAPPH",78,0) S ZS="",L1=1 F K=1:3:19 Q:$P(Z,"^",K)="" D "RTN","PRSAPPH",79,0) .I $P(Z,"^",K+2),"RG"'[$P($G(^PRST(457.2,+$P(Z,"^",K+2),0)),"^",2) Q "RTN","PRSAPPH",80,0) .S $P(ZS,"^",L1)=$P(Z,"^",K),$P(ZS,"^",L1+1)=$P(Z,"^",K+1) "RTN","PRSAPPH",81,0) .S $P(ZS,"^",L1+2)=TT S L1=L1+4 Q "RTN","PRSAPPH",82,0) S:ZS'="" ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS Q:TT="HW" G:'DUP UPD "RTN","PRSAPPH",83,0) ; Remove holiday on another day "RTN","PRSAPPH",84,0) S K=PPI F L1=$S(DAY-8>0:DAY-8,1:1):1:$S(DAY+8<15:DAY+8,1:14) I $P($G(^PRST(458,K,"E",DFN,"D",L1,0)),"^",12)=LLL D REM "RTN","PRSAPPH",85,0) I DAY<9 S K=PPI-1 F L1=(DAY+6):1:14 I $P($G(^PRST(458,K,"E",DFN,"D",L1,0)),"^",12)=LLL D REM "RTN","PRSAPPH",86,0) I DAY>6 S K=PPI+1 F L1=1:1:(DAY-6) I $P($G(^PRST(458,K,"E",DFN,"D",L1,0)),"^",12)=LLL D REM "RTN","PRSAPPH",87,0) UPD ; Update status "RTN","PRSAPPH",88,0) S $P(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_NOW_"^2" "RTN","PRSAPPH",89,0) U1 ; Mark as Holiday "RTN","PRSAPPH",90,0) S $P(^PRST(458,PPI,"E",DFN,"D",DAY,0),"^",12)=LLL Q "RTN","PRSAPPH",91,0) REM ; Remove posting for moved holiday "RTN","PRSAPPH",92,0) I $P($G(^PRST(458,K,"E",DFN,0)),"^",2)'="T" Q "RTN","PRSAPPH",93,0) S $P(^PRST(458,K,"E",DFN,"D",L1,0),"^",12)="" "RTN","PRSAPPH",94,0) S ZS=$G(^PRST(458,K,"E",DFN,"D",L1,2)) Q:ZS="" "RTN","PRSAPPH",95,0) I ZS["HX"!(ZS["HW") K ^PRST(458,K,"E",DFN,"D",L1,2),^(3),^(10) "RTN","PRSAPPH",96,0) Q "RTN","PRSAPPH",97,0) FND ; Determine which tour is first "RTN","PRSAPPH",98,0) N X,Y S X=$P(Z,"^",1),Y=0 D MIL^PRSATIM S K=Y "RTN","PRSAPPH",99,0) S X=$P(ZS,"^",1),Y=0 D MIL^PRSATIM S:Y