| [613] | 1 | PRSXP113 ;ALB/DWS-SET EXTRA HOLIDAY W/ PP OPEN ;12/28/2006
 | 
|---|
 | 2 |  ;;4.0;PAID;**113**;Sep 21, 1995;Build 3
 | 
|---|
 | 3 |  ;;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 |  Q
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 | START ; Declare 01/02/2007 as a memorial day for President Ford's Funeral
 | 
|---|
 | 8 |  ;
 | 
|---|
 | 9 |  W !!,"Checking PP 06-26",!
 | 
|---|
 | 10 |  N DFN,DUP,HOL,NOW,PPI,TT,%
 | 
|---|
 | 11 |  S PPI=$O(^PRST(458,"B","06-26",0))
 | 
|---|
 | 12 |  I 'PPI D  Q
 | 
|---|
 | 13 |  .  W !,"Pay Period 06-26 not found in File 458."
 | 
|---|
 | 14 |  S HOL(3070102)=10 ; Set 01/02 into HOL array
 | 
|---|
 | 15 |  D NOW^%DTC S NOW=%
 | 
|---|
 | 16 |  S DFN=0
 | 
|---|
 | 17 |  F  S DFN=$O(^PRST(458,PPI,"E",DFN)) Q:DFN'>0  D
 | 
|---|
 | 18 |  . S TT="HX",DUP=0
 | 
|---|
 | 19 |  . D E^PRSAPPH
 | 
|---|
 | 20 |  ;
 | 
|---|
 | 21 |  ; Quit if PP 07-01 is not opened.  The Open Next Pay Period option
 | 
|---|
 | 22 |  ; will automatically post their holiday.
 | 
|---|
 | 23 |  ; 
 | 
|---|
 | 24 | PP01 I '$D(^PRST(458,"B","07-01")) D  Q
 | 
|---|
 | 25 |  . W !,"PP 07-01 has not been opened yet.  Holiday In Lieu days will"
 | 
|---|
 | 26 |  . W !,"be posted to this Pay Period when it is opened.",!
 | 
|---|
 | 27 |  ;
 | 
|---|
 | 28 |  ; If the next pay period is already opened, loop through the 
 | 
|---|
 | 29 |  ; employees again with HOL(3070102)=-2.  This is the 2nd date
 | 
|---|
 | 30 |  ; in the PDH variable.
 | 
|---|
 | 31 |  ;
 | 
|---|
 | 32 |  W !,"PP 07-01 is already open.  Running checks to see if any"
 | 
|---|
 | 33 |  W !,"employees needed to have their extra holiday posted in this"
 | 
|---|
 | 34 |  W !,"Pay Period.",!
 | 
|---|
 | 35 |  ;
 | 
|---|
 | 36 |  S HOL(3070102)=-2 ; Set 01/02/2007 into HOL array
 | 
|---|
 | 37 |  S PPI=0,PPI=$O(^PRST(458,"B","07-01",PPI))
 | 
|---|
 | 38 |  I 'PPI D  Q
 | 
|---|
 | 39 |  . W !!,"The IEN for PP 07-01 was not found."
 | 
|---|
 | 40 |  . W !,"Contact EVS at 888-596-4357."
 | 
|---|
 | 41 |  ;
 | 
|---|
 | 42 |  S DFN=0
 | 
|---|
 | 43 |  F  S DFN=$O(^PRST(458,PPI,"E",DFN)) Q:DFN'>0  D
 | 
|---|
 | 44 |  . S TT="HX",DUP=0
 | 
|---|
 | 45 |  . D E^PRSAPPH
 | 
|---|
 | 46 |  Q
 | 
|---|