- PRSAPEH ;HISC/REL-Set Employee Holiday ;08/01/00
- ;;4.0;PAID;**4,58**;Sep 21, 1995
- W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
- W !?29,"SET EMPLOYEE HOLIDAY"
- S PRSTLV=7 D ^PRSAUTL G:TLI<1 EX
- D NOW^%DTC S NOW=%
- S %DT="X",X="T+5" D ^%DT
- S %DT="AEPX",%DT("A")="Benefit Date: ",%DT(0)=-Y W ! D ^%DT G:Y<1 EX
- S Y=$G(^PRST(458,"AD",Y)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
- I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX
- NME K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y))",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
- G:DFN<1 EX
- I '$D(^PRST(458,PPI,"E",DFN,"D",DAY,0)) W *7,!!,"No Time record exists for that date." G NME
- I $P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12) W !!,"This date already flagged as a Holiday Benefit Day." G NME
- I "T"'[$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) G P1
- K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10)
- S TT="HX",LLL=DT,DUP=1 D S0^PRSAPPH
- P1 W " ... done" G NME
- THANK ; Thanksgiving Correction
- S PPI=$O(^PRST(458,"B","95-23",0)) I 'PPI W !,"PayPeriod 95-23 not found in File 458." G EX
- S HOL(2951123)=12 D NOW^%DTC S NOW=%
- F DFN=0:0 S DFN=$O(^PRST(458,PPI,"E",DFN)) Q:DFN'>0 S TT="HX",DUP=0 D E^PRSAPPH
- EX G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAPEH 1279 printed Mar 13, 2025@21:28:54 Page 2
- PRSAPEH ;HISC/REL-Set Employee Holiday ;08/01/00
- +1 ;;4.0;PAID;**4,58**;Sep 21, 1995
- +2 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !?26,"VA TIME & ATTENDANCE SYSTEM"
- +3 WRITE !?29,"SET EMPLOYEE HOLIDAY"
- +4 SET PRSTLV=7
- DO ^PRSAUTL
- if TLI<1
- GOTO EX
- +5 DO NOW^%DTC
- SET NOW=%
- +6 SET %DT="X"
- SET X="T+5"
- DO ^%DT
- +7 SET %DT="AEPX"
- SET %DT("A")="Benefit Date: "
- SET %DT(0)=-Y
- WRITE !
- DO ^%DT
- if Y<1
- GOTO EX
- +8 SET Y=$GET(^PRST(458,"AD",Y))
- SET PPI=$PIECE(Y,"^",1)
- SET DAY=$PIECE(Y,"^",2)
- +9 IF PPI=""
- WRITE !!,*7,"Pay Period is Not Open Yet!"
- GOTO EX
- NME KILL DIC
- SET DIC("A")="Select EMPLOYEE: "
- SET DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y))"
- SET DIC(0)="AEQM"
- SET DIC="^PRSPC("
- SET D="ATL"_TLE
- WRITE !
- DO IX^DIC
- SET DFN=+Y
- KILL DIC
- +1 if DFN<1
- GOTO EX
- +2 IF '$DATA(^PRST(458,PPI,"E",DFN,"D",DAY,0))
- WRITE *7,!!,"No Time record exists for that date."
- GOTO NME
- +3 IF $PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",12)
- WRITE !!,"This date already flagged as a Holiday Benefit Day."
- GOTO NME
- +4 IF "T"'[$PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)
- GOTO P1
- +5 KILL ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(10)
- +6 SET TT="HX"
- SET LLL=DT
- SET DUP=1
- DO S0^PRSAPPH
- P1 WRITE " ... done"
- GOTO NME
- THANK ; Thanksgiving Correction
- +1 SET PPI=$ORDER(^PRST(458,"B","95-23",0))
- IF 'PPI
- WRITE !,"PayPeriod 95-23 not found in File 458."
- GOTO EX
- +2 SET HOL(2951123)=12
- DO NOW^%DTC
- SET NOW=%
- +3 FOR DFN=0:0
- SET DFN=$ORDER(^PRST(458,PPI,"E",DFN))
- if DFN'>0
- QUIT
- SET TT="HX"
- SET DUP=0
- DO E^PRSAPPH
- EX GOTO KILL^XUSCLEAN
