PRSARC05.m

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 ---PRSARC05   1654     printed  Apr 09, 2024@21:29:36                                                                                                                                                                                                    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