Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSAPPH.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSAPPH.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSAPPH.m
r613 r623 1 PRSAPPH ; WOIFO/JAH - Holiday Utilities ;12/07/072 ;;4.0;PAID;**33,66,113,112,116**;Sep 21, 1995;Build 233 4 5 6 7 8 9 E 10 11 12 13 14 E0 15 16 Q:DB'=1 Q:NH=48!(NH=72)G P1:DAY<0,P3:DAY>1417 P0 18 19 20 21 22 23 G U1:DB=2!(NH=72)I FLX'="C" G EF:(DAY#7=1),EB:(DAY#7=0)24 25 26 27 28 29 30 31 32 EF 33 34 35 FUTRHOL() 36 37 PREVSET() 38 39 40 41 EB 42 43 44 P1 45 46 47 48 49 50 P3 51 52 53 54 55 56 57 PN 58 59 60 61 62 63 64 65 PF 66 67 68 69 70 S0 71 72 73 74 75 76 77 78 79 80 81 82 83 UPD 84 85 U1 86 87 REM 88 89 90 91 92 93 FND 94 95 96 1 PRSAPPH ; HISC/REL-Holiday Utilities ;01/03/07 2 ;;4.0;PAID;**33,66,113**;Sep 21, 1995;Build 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 K HOL S PDT=$G(^PRST(458,PPI,1)) Q:PDT="" S X1=$P(PDT,"^",1),X2=-6 D C^%DTC 5 S PRS8D=X D EN^PRS8HD 6 S PDH=PRS8D F DAY=1:1:25 S X1=PRS8D,X2=DAY D C^%DTC S PDH=PDH_"^"_X 7 F DAY=1:1:26 S Z=$P(PDH,"^",DAY) I $D(HD(Z)) S HOL(Z)=$S(DAY<7:-DAY,1:DAY-6) 8 K HO,HD,PRS8D,PDH Q 9 E ; Set Holidays for Employees 10 S FLX=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",6),DB=$P($G(^PRSPC(DFN,0)),"^",10) 11 S NH=$P($G(^PRSPC(DFN,0)),"^",16) Q:NH>80 12 F LLL=0:0 S LLL=$O(HOL(LLL)) Q:LLL<1 S DAY=HOL(LLL) D E0 13 Q 14 E0 ; Find Benefit Day 15 Q:DAY=15 I DAY>0,DAY<15 G P0 16 Q:DB'=1 Q:NH=48 G P1:DAY<0,P3:DAY>14 17 P0 S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2) Q:'TC 18 I (TC=3)!(TC=4) G U1 19 I DB=1,NH=48 G U1 20 S C=0 21 I TC=2!$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",8)!$P($G(^(0)),"^",14),'$P($G(^(0)),"^",12) G S0 22 Q:$P($G(^(0)),"^",12)=LLL&(TT="HX") 23 G:DB=2 U1 I FLX'="C" G EF:(DAY#7=1),EB:(DAY#7=0) 24 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 25 I FLX'="C" G EF:C<2,EB 26 I C'=2 G EF:C<3,EB 27 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 28 G EB:C=2,EF 29 ; 30 ;if looking forward, don't set off for another holiday 31 ; 32 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 33 Q 34 ; 35 FUTRHOL() ;Check to see if day is another future holiday. 36 Q $G(HOL($P($G(^PRST(458,PPI,1)),"^",DAY)))>0 37 PREVSET() ; Day NOT Already Set as holiday 38 Q ('($P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)>0)!($P($G(^(0)),"^",12)=LLL)) 39 ; 40 ;back up to find an available day to set the Holiday. 41 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 42 Q 43 ; 44 P1 I FLX'="C" Q:DAY'=-5 S C=13 D PF Q:'Z S DAY=0 G EF 45 S C=8-DAY D PF Q:'Z 46 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 47 Q:C>2 I C<2 S DAY=0 G EF 48 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 49 Q:C=2 S DAY=0 G EF 50 P3 I FLX'="C" Q:DAY'=16 S C=2 D PN Q:'Z S DAY=15 G EB 51 Q:DAY=15 S C=DAY-14 D PN Q:'Z I DAY>16 S DAY=15 G EB 52 S C=2 F L1=3:1:7 D 53 .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 54 .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) 55 .S:'$P($G(^PRST(457.1,+X1,0)),"^",6) C=C+1 Q 56 Q:C>2 S DAY=15 G EB 57 PN ; Determine TC for next Pay Period; if Z=1 then all TC=1 for days 1 to C 58 S Z=1 F C=C:-1:1 D Q:'Z 59 .S X1=$P($G(^PRST(458,PPI+1,"E",DFN,"D",C,0)),"^",2) I X1=2 S Z=0 Q 60 .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 61 .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) 62 .S X1=+X1 I X1=0!(X1=2) S Z=0 Q 63 .S:$P($G(^PRST(457.1,X1,0)),"^",6) Z=0 Q 64 Q 65 PF ; Determine TC for prior PP 66 S Z=1 F C=C:1:14 D Q:'Z 67 .S X1=$P($G(^PRST(458,PPI-1,"E",DFN,"D",C,0)),"^",2) I X1=""!(X1=2) S Z=0 Q 68 .S X1=$P($G(^PRST(458,PPI-1,"E",DFN,"D",C,0)),"^",8)+$P($G(^(0)),"^",14) S:X1 Z=0 Q 69 Q 70 S0 ; Set Holiday (Excused or Worked) 71 I TT="HX",$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)=LLL Q 72 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,1)) I Z="" S $P(^(2),"^",3)=TT Q:TT="HW" G UPD 73 S ZS=$G(^PRST(458,PPI,"E",DFN,"D",DAY,4)) I ZS'="" D FND 74 S ZS="",L1=1 F K=1:3:19 Q:$P(Z,"^",K)="" D 75 .I $P(Z,"^",K+2),"RG"'[$P($G(^PRST(457.2,+$P(Z,"^",K+2),0)),"^",2) Q 76 .S $P(ZS,"^",L1)=$P(Z,"^",K),$P(ZS,"^",L1+1)=$P(Z,"^",K+1) 77 .S $P(ZS,"^",L1+2)=TT S L1=L1+4 Q 78 S:ZS'="" ^PRST(458,PPI,"E",DFN,"D",DAY,2)=ZS Q:TT="HW" G:'DUP UPD 79 ; Remove holiday on another day 80 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 81 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 82 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 83 UPD ; Update status 84 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,10),"^",1,4)="T^"_DUZ_"^"_NOW_"^2" 85 U1 ; Mark as Holiday 86 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,0),"^",12)=LLL Q 87 REM ; Remove posting for moved holiday 88 I $P($G(^PRST(458,K,"E",DFN,0)),"^",2)'="T" Q 89 S $P(^PRST(458,K,"E",DFN,"D",L1,0),"^",12)="" 90 S ZS=$G(^PRST(458,K,"E",DFN,"D",L1,2)) Q:ZS="" 91 I ZS["HX"!(ZS["HW") K ^PRST(458,K,"E",DFN,"D",L1,2),^(3),^(10) 92 Q 93 FND ; Determine which tour is first 94 N X,Y S X=$P(Z,"^",1),Y=0 D MIL^PRSATIM S K=Y 95 S X=$P(ZS,"^",1),Y=0 D MIL^PRSATIM S:Y<K Z=ZS Q 96 Q
Note:
See TracChangeset
for help on using the changeset viewer.
