PRSARC05 ;DWS/ALB-RECESS UTILITY ;DEC 05, 2006 09:58
;;4.0;PAID;**112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
RSPP(WK,IEN,PP) ;SAME RESULTS AS RES USING DIFFERENT PARAMETERS
;IEN THE EMPLOYEE IEN FROM FILE 450
;PP Pay period to return results for in YYYY-NN format i.e. 2006-01 for example
;WK Set to -1 if pay period is not found. Otherwise results for RES are passed through.
N I,SFY,EFY,SDT,EDT S I=$O(^PRST(458,"AB",PP,0)) I 'I S WK=-1 Q
S I=^PRST(458,I,1),SDT=$P(I,U),EDT=$P(I,U,14)
S (SFY,EFY)=$S($E(SDT,4,7)>930:PP+1,1:+PP)
D RES(.WK,IEN,SFY,EFY,SDT,EDT) Q
RES(WK,IEN,SFY,EFY,SDT,EDT) ;RETURN NUMBER OF HOURS OF RECESS IN WK ARRAY
;IEN THE EMPLOYEE IEN FROM FILE 450
;SFY THE FISCAL YEAR OF THE START OF THE TIME PERIOD
;EFY THE FISCAL YEAR OF THE END OF THE TIME PERIOD
;SDT THE DATE OF THE START OF THE TIME PERIOD
;EDT THE DATE OF THE END OF THE TIME PERIOD
;WK(X) THE NUMBER OF HOURS OF RECESS SCHEDULED IN THE WEEK BEGANNING
; ON DAY X. X IS A FILEMAN DATE FOR THE FIRST DAY OF THE WEEK.
N DA,FY,H,HRS,I,J,K,L,PPI S PPI=$P($G(^PRST(458,"AD",SDT)),U) S:'PPI PPI=$P(^PRST(458,0),U,3)
D TOURHRS^PRSARC07(.HRS,PPI,IEN)
S DA=$O(^PRST(458.8,"AC",IEN,SFY,0)),I=SDT-7,K=1,FY=SFY Q:'DA
D I SFY'=EFY S DA=$O(^PRST(458.8,"AC",IEN,EFY,0)) D:DA
.F S I=$O(^PRST(458.8,DA,1,"AC",I)) Q:I=""!(I>EDT) D
..S J=$O(^(I,0)),L=^PRST(458.8,DA,1,J,0),H=$P(L,U,2)
..I H="" S H=HRS("W"_$$WK($P(L,U,3)))
..S WK($P(L,U,3))=H
Q
WK(X) ;RETURN 1 FOR THE FIRST WEEK OF THE PAY PERIOD AND 2 FOR THE SECOND
;WEEK
N %H D H^%DTC Q %H\7#2+1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARC05 1654 printed Dec 13, 2024@02:24:08 Page 2
PRSARC05 ;DWS/ALB-RECESS UTILITY ;DEC 05, 2006 09:58
+1 ;;4.0;PAID;**112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
RSPP(WK,IEN,PP) ;SAME RESULTS AS RES USING DIFFERENT PARAMETERS
+1 ;IEN THE EMPLOYEE IEN FROM FILE 450
+2 ;PP Pay period to return results for in YYYY-NN format i.e. 2006-01 for example
+3 ;WK Set to -1 if pay period is not found. Otherwise results for RES are passed through.
+4 NEW I,SFY,EFY,SDT,EDT
SET I=$ORDER(^PRST(458,"AB",PP,0))
IF 'I
SET WK=-1
QUIT
+5 SET I=^PRST(458,I,1)
SET SDT=$PIECE(I,U)
SET EDT=$PIECE(I,U,14)
+6 SET (SFY,EFY)=$SELECT($EXTRACT(SDT,4,7)>930:PP+1,1:+PP)
+7 DO RES(.WK,IEN,SFY,EFY,SDT,EDT)
QUIT
RES(WK,IEN,SFY,EFY,SDT,EDT) ;RETURN NUMBER OF HOURS OF RECESS IN WK ARRAY
+1 ;IEN THE EMPLOYEE IEN FROM FILE 450
+2 ;SFY THE FISCAL YEAR OF THE START OF THE TIME PERIOD
+3 ;EFY THE FISCAL YEAR OF THE END OF THE TIME PERIOD
+4 ;SDT THE DATE OF THE START OF THE TIME PERIOD
+5 ;EDT THE DATE OF THE END OF THE TIME PERIOD
+6 ;WK(X) THE NUMBER OF HOURS OF RECESS SCHEDULED IN THE WEEK BEGANNING
+7 ; ON DAY X. X IS A FILEMAN DATE FOR THE FIRST DAY OF THE WEEK.
+8 NEW DA,FY,H,HRS,I,J,K,L,PPI
SET PPI=$PIECE($GET(^PRST(458,"AD",SDT)),U)
if 'PPI
SET PPI=$PIECE(^PRST(458,0),U,3)
+9 DO TOURHRS^PRSARC07(.HRS,PPI,IEN)
+10 SET DA=$ORDER(^PRST(458.8,"AC",IEN,SFY,0))
SET I=SDT-7
SET K=1
SET FY=SFY
if 'DA
QUIT
+11 Begin DoDot:1
+12 FOR
SET I=$ORDER(^PRST(458.8,DA,1,"AC",I))
if I=""!(I>EDT)
QUIT
Begin DoDot:2
+13 SET J=$ORDER(^(I,0))
SET L=^PRST(458.8,DA,1,J,0)
SET H=$PIECE(L,U,2)
+14 IF H=""
SET H=HRS("W"_$$WK($PIECE(L,U,3)))
+15 SET WK($PIECE(L,U,3))=H
End DoDot:2
End DoDot:1
IF SFY'=EFY
SET DA=$ORDER(^PRST(458.8,"AC",IEN,EFY,0))
if DA
Begin DoDot:1
End DoDot:1
+16 QUIT
WK(X) ;RETURN 1 FOR THE FIRST WEEK OF THE PAY PERIOD AND 2 FOR THE SECOND
+1 ;WEEK
+2 NEW %H
DO H^%DTC
QUIT %H\7#2+1
