PRSAPEH.m

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 ---PRSAPEH   1279     printed  Apr 09, 2024@21:30:21                                                                                                                                                                                                     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