PRS8WE ;WCIOFO/MGD-DECOMPOSITION, WEEKEND PREMIUM ;01/31/08
;;4.0;PAID;**42,65,74,75,90,92,96,117**;Sep 21, 1995;Build 32
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine is used to determine the payment of Saturday and
;Sunday Premium pays to entitled employees.
;
;Called by Routine PRS8ST
;
N DAY,HYBRID,SAT2DT,SATNOSUN
S HYBRID=$S(+DFN'="":$$HYBRID^PRSAENT1(DFN),1:0)
;
; The variable SATNOSUN has been added for employees who are now
; eligible to receive Saturday Premium but not Sunday Premium under
; Public Law 108-170.
S SATNOSUN=$S($E(ENT,8,9)="10":1,1:0)
;
; Compute Sunday Premium Pay. Check SATNOSUN employees
I $E(ENT,9)!(TYP["B")!(HYBRID)!(SATNOSUN) F DAY=1,8,15 D WPD
;
; Compute Saturday Premium Pay
I $E(ENT,8)!(TYP["B")!(HYBRID) F DAY=7,14 D WPD
;
Q
;
WPD ; Weekend Premium for Day
; input
; DAY - day in pay period (1,7,8,14, or 15)
; SAT2DT(day) - if defined for day, it equals the time segment (1-96)
; just before the start of a 2-day tour that begins on
; a Saturday and has already received Sunday premium.
; Defined during computation of Sunday premiums and
; used during computation of Saturday premiums to
; prevent payment of both premiums for same period.
; TYP, ENT, etc...
; output
; WK()
;
N AV,D,END,H,M,P,TP,TV
;
; determine type of weekend premium.
S TP=$S("^7^14^"[(U_DAY_U):"SAT","^1^8^15^"[(U_DAY_U):"SUN",1:"")
Q:TP="" ; invalid day (must be Sat. or Sun.)
;
; determine types of time in a 'tour'
S TV=$$TV
;
; determine types of time that might be eligible for premium
S AV=$$AV
;
; load info for day
S D(DAY)=$G(^TMP($J,"PRS8",DAY,"W"))
Q:D(DAY)?1"0"."0" ; no activity on day
S P(DAY)=$G(^TMP($J,"PRS8",DAY,"P"))
S H(DAY)=$G(^TMP($J,"PRS8",DAY,"HOL"))
;
; loop thru activity string to find start of 'tour'
S M=1
S END=$S($G(SAT2DT(DAY))>0:SAT2DT(DAY),1:96)
F D Q:M=END S M=M+1
. I TV'[$E(D(DAY),M),$E(H(DAY),M)'=2 Q
. ; found start of a 'tour'
. ; loop thru 'tour' activity and count the premium
. N CNT
. ;
. ; if the 'tour' starts at beginning of day then check if it is part
. ; of a 2-day 'tour' that actually started on the previous day
. I DAY>1,M=1 D
. . N CLASS,DYP,Z
. . S CLASS=$$CTS($E(D(DAY),M),$E(H(DAY),M))
. . S DYP=DAY-1
. . S D(DYP)=$G(^TMP($J,"PRS8",DYP,"W"))
. . S P(DYP)=$G(^TMP($J,"PRS8",DYP,"P"))
. . S H(DYP)=$G(^TMP($J,"PRS8",DYP,"HOL"))
. . Q:$$CTS($E(D(DYP),96),$E(H(DYP),96))'=CLASS ; not same 'tour'
. . ; Hybrids defined by Public Law P.L. 107-135 only get Saturday
. . ; or Sunday premium for CT/OT/UN worked on Saturday or Sunday
. . Q:HYBRID&(TP="SAT")&($$CTS($E(D(DYP),96),$E(H(DYP),96))="X")
. . I CLASS="R",'$$TDT(DYP) Q ; can't be same scheduled tour
. . ; If SATNOSUN and the day is a Sunday quit
. . Q:SATNOSUN&("^1^8^15^"[(U_DAY_U))
. . ; loop backward from midnight thru previous day's portion of tour
. . S Z=96
. . F D Q:Z=1 S Z=Z-1 Q:$$CTS($E(D(DYP),Z),$E(H(DYP),Z))'=CLASS
. . . I AV[$E(D(DYP),Z)!($E(D(DYP),Z)="O"&($E(H(DYP),Z)=2)) D COUNT^PRS8WE2(DYP,Z)
. . ; if Sun. premium then save Z to avoid recount of these Sat. hours
. . ; when/if Sat. premium is calculated
. . ;
. . I TP="SUN" S SAT2DT(DYP)=Z
. ;
. ; If SATNOSUN and tour crossed mid onto Sunday set TP=SAT
. I M=1&("^1^8^"[(U_DAY_U)),SATNOSUN D
. . I AV[$E($G(^TMP($J,"PRS8",DAY-1,"W")),96) S TP="SAT"
. ;
. ; loop forward thru current day's portion of tour
. I DAY<15 F D Q:M=END S M=M+1 Q:TV'[$E(D(DAY),M)&($E(H(DAY),M)'=2)
. . I AV[$E(D(DAY),M)!($E(D(DAY),M)="O"&($E(H(DAY),M)=2)) D COUNT^PRS8WE2(DAY,M)
. . ;
. . ; If checking for SATNOSUN quit when tour crossing midnight ends
. . I SATNOSUN&(TP="SAT")&("^1^8^15^"[(U_DAY_U))&(AV'[$E(D(DAY),M+1)) D SAVE^PRS8WE2 S M=END Q
. ;
. ; If counting Sat Prem for SATNOSUN and Day is a Sunday there is no
. ; need to check for the tour crossing midnight onto Monday
. Q:SATNOSUN&(TP="SAT")&("^1^8^15^"[(U_DAY_U))
. ;
. ; If SATNOSUN and DAY=14 and M<96 check remainder of tour for work
. I SATNOSUN&(DAY=14)&(M<96) D
. . F M=M:1:96 D
. . . I AV[$E(D(DAY),M)!($E(D(DAY),M)="O"&($E(H(DAY),M)=2)) D COUNT^PRS8WE2(DAY,M)
. ;
. ; If tour lasted until end of day then check if it is part of
. ; a 2-day tour that extends into next day
. I DAY<15,M=96,'SATNOSUN,(TV[$E(D(DAY),M))!($E(H(DAY),M)=2) D
. . N CLASS,DYN,Z
. . S CLASS=$$CTS($E(D(DAY),96),$E(H(DAY),96))
. . S DYN=DAY+1
. . S D(DYN)=$G(^TMP($J,"PRS8",DYN,"W"))
. . S P(DYN)=$G(^TMP($J,"PRS8",DYN,"P"))
. . S H(DYN)=$G(^TMP($J,"PRS8",DYN,"HOL"))
. . Q:$$CTS($E(D(DYN),1),$E(H(DYN),1))'=CLASS ; not same 'tour'
. . ; Hybrids defined by Public Law P.L. 107-135 only get Saturday
. . ; or Sunday premium for CT/OT/UN worked on Saturday or Sunday
. . Q:HYBRID&(TP="SUN")&($$CTS($E(D(DYN),1),$E(H(DYN),1))="X")
. . I CLASS="R",'$$TDT(DAY) Q ; can't be same scheduled tour
. . ; loop forward from midnight thru next day's portion of tour
. . S Z=1
. . F D Q:Z=96 S Z=Z+1 Q:$$CTS($E(D(DYN),Z),$E(H(DYN),Z))'=CLASS
. . . I AV[$E(D(DYN),Z)!($E(D(DYN),Z)="O"&($E(H(DYN),Z)=2)) D COUNT^PRS8WE2(DYN,Z)
. ;
. ; post premium time for tour to WK()
. D SAVE^PRS8WE2
Q
;
TV() ; List types of time in a 'tour'
N PRSX
; for regular time
S PRSX="LRSFGDUAJMWNnVH1234XYmZq"
; for OT/CT
S PRSX=PRSX_$S(TYP["B":"EeOs",TYP["N"!(TYP["H"):"EetOoscbT",1:"")
I HYBRID S PRSX=PRSX_"EetOoscbT"
; for employees covered by PL 108-170
I PMP'=""&("^S^T^U^V^"[(U_PMP_U)) D
. I $E(ENT,28),PRSX'["Eet" S PRSX=PRSX_"Eet"
. I $E(ENT,12),PRSX'["Oos" S PRSX=PRSX_"Oos"
. I $E(ENT,17),PRSX'["c" S PRSX=PRSX_"c"
. I $E(ENT,29),PRSX'["b" S PRSX=PRSX_"b"
. I $E(ENT,18),PRSX'["T" S PRSX=PRSX_"T"
Q PRSX
;
AV() ; List types of time that might be eligible for premium pay
N PRSX
; for regular time
S PRSX=$S(TYP["B":"",1:"1234XY")
; for OT/CT
S PRSX=PRSX_$S(TYP["B":"EeOos",TYP["N"!(TYP["H"):"EeOosc",1:"")
I HYBRID S PRSX=PRSX_"EeOosc"
; for employees covered by PL 108-170
I PMP'=""&("^S^T^U^V^"[(U_PMP_U)) D
. I $E(ENT,28),PRSX'["Ee" S PRSX=PRSX_"Ee"
. I $E(ENT,12),PRSX'["Oos" S PRSX=PRSX_"Oos"
. I $E(ENT,17),PRSX'["c" S PRSX=PRSX_"c"
Q PRSX
;
CTS(XW,XH) ; Return class of a time segment
; input XW = type of time in activity ("W") string
; XH = value in holiday ("H") string
; returns class
; "R" regular scheduled
; "X" extra (ot/ct) or unscheduled reg.
; "N" not worked (includes on-call, standby when not called back)
Q $S(("LRSFGDUAJMWNnVH123XYmZq"[XW)!((XW="O")&(XH=2)):"R",("EetscbT4"[XW)!((XW="O")&(XH'=2)):"X",1:"N")
;
TDT(DAYN) ; Two-Day Tour extrinsic variable
; input
; DAYN = day # (0-15) being checked for at least one sch. 2-day tour
; returns 0 (false) or 1 (true)
N RET
S RET=0 ; assume no scheduled 2-day tour of duty
S X=$G(^TMP($J,"PRS8",DAYN,0))
F I=2,13 I $P(X,U,I),$P($G(^PRST(457.1,$P(X,U,I),0)),U,5)="Y" S RET=1
Q RET
;
;PRS8WE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8WE 7181 printed Nov 22, 2024@17:33:12 Page 2
PRS8WE ;WCIOFO/MGD-DECOMPOSITION, WEEKEND PREMIUM ;01/31/08
+1 ;;4.0;PAID;**42,65,74,75,90,92,96,117**;Sep 21, 1995;Build 32
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine is used to determine the payment of Saturday and
+5 ;Sunday Premium pays to entitled employees.
+6 ;
+7 ;Called by Routine PRS8ST
+8 ;
+9 NEW DAY,HYBRID,SAT2DT,SATNOSUN
+10 SET HYBRID=$SELECT(+DFN'="":$$HYBRID^PRSAENT1(DFN),1:0)
+11 ;
+12 ; The variable SATNOSUN has been added for employees who are now
+13 ; eligible to receive Saturday Premium but not Sunday Premium under
+14 ; Public Law 108-170.
+15 SET SATNOSUN=$SELECT($EXTRACT(ENT,8,9)="10":1,1:0)
+16 ;
+17 ; Compute Sunday Premium Pay. Check SATNOSUN employees
+18 IF $EXTRACT(ENT,9)!(TYP["B")!(HYBRID)!(SATNOSUN)
FOR DAY=1,8,15
DO WPD
+19 ;
+20 ; Compute Saturday Premium Pay
+21 IF $EXTRACT(ENT,8)!(TYP["B")!(HYBRID)
FOR DAY=7,14
DO WPD
+22 ;
+23 QUIT
+24 ;
WPD ; Weekend Premium for Day
+1 ; input
+2 ; DAY - day in pay period (1,7,8,14, or 15)
+3 ; SAT2DT(day) - if defined for day, it equals the time segment (1-96)
+4 ; just before the start of a 2-day tour that begins on
+5 ; a Saturday and has already received Sunday premium.
+6 ; Defined during computation of Sunday premiums and
+7 ; used during computation of Saturday premiums to
+8 ; prevent payment of both premiums for same period.
+9 ; TYP, ENT, etc...
+10 ; output
+11 ; WK()
+12 ;
+13 NEW AV,D,END,H,M,P,TP,TV
+14 ;
+15 ; determine type of weekend premium.
+16 SET TP=$SELECT("^7^14^"[(U_DAY_U):"SAT","^1^8^15^"[(U_DAY_U):"SUN",1:"")
+17 ; invalid day (must be Sat. or Sun.)
if TP=""
QUIT
+18 ;
+19 ; determine types of time in a 'tour'
+20 SET TV=$$TV
+21 ;
+22 ; determine types of time that might be eligible for premium
+23 SET AV=$$AV
+24 ;
+25 ; load info for day
+26 SET D(DAY)=$GET(^TMP($JOB,"PRS8",DAY,"W"))
+27 ; no activity on day
if D(DAY)?1"0"."0"
QUIT
+28 SET P(DAY)=$GET(^TMP($JOB,"PRS8",DAY,"P"))
+29 SET H(DAY)=$GET(^TMP($JOB,"PRS8",DAY,"HOL"))
+30 ;
+31 ; loop thru activity string to find start of 'tour'
+32 SET M=1
+33 SET END=$SELECT($GET(SAT2DT(DAY))>0:SAT2DT(DAY),1:96)
+34 FOR
Begin DoDot:1
+35 IF TV'[$EXTRACT(D(DAY),M)
IF $EXTRACT(H(DAY),M)'=2
QUIT
+36 ; found start of a 'tour'
+37 ; loop thru 'tour' activity and count the premium
+38 NEW CNT
+39 ;
+40 ; if the 'tour' starts at beginning of day then check if it is part
+41 ; of a 2-day 'tour' that actually started on the previous day
+42 IF DAY>1
IF M=1
Begin DoDot:2
+43 NEW CLASS,DYP,Z
+44 SET CLASS=$$CTS($EXTRACT(D(DAY),M),$EXTRACT(H(DAY),M))
+45 SET DYP=DAY-1
+46 SET D(DYP)=$GET(^TMP($JOB,"PRS8",DYP,"W"))
+47 SET P(DYP)=$GET(^TMP($JOB,"PRS8",DYP,"P"))
+48 SET H(DYP)=$GET(^TMP($JOB,"PRS8",DYP,"HOL"))
+49 ; not same 'tour'
if $$CTS($EXTRACT(D(DYP),96),$EXTRACT(H(DYP),96))'=CLASS
QUIT
+50 ; Hybrids defined by Public Law P.L. 107-135 only get Saturday
+51 ; or Sunday premium for CT/OT/UN worked on Saturday or Sunday
+52 if HYBRID&(TP="SAT")&($$CTS($EXTRACT(D(DYP),96),$EXTRACT(H(DYP),96))="X")
QUIT
+53 ; can't be same scheduled tour
IF CLASS="R"
IF '$$TDT(DYP)
QUIT
+54 ; If SATNOSUN and the day is a Sunday quit
+55 if SATNOSUN&("^1^8^15^"[(U_DAY_U))
QUIT
+56 ; loop backward from midnight thru previous day's portion of tour
+57 SET Z=96
+58 FOR
Begin DoDot:3
+59 IF AV[$EXTRACT(D(DYP),Z)!($EXTRACT(D(DYP),Z)="O"&($EXTRACT(H(DYP),Z)=2))
DO COUNT^PRS8WE2(DYP,Z)
End DoDot:3
if Z=1
QUIT
SET Z=Z-1
if $$CTS($EXTRACT(D(DYP),Z),$EXTRACT(H(DYP),Z))'=CLASS
QUIT
+60 ; if Sun. premium then save Z to avoid recount of these Sat. hours
+61 ; when/if Sat. premium is calculated
+62 ;
+63 IF TP="SUN"
SET SAT2DT(DYP)=Z
End DoDot:2
+64 ;
+65 ; If SATNOSUN and tour crossed mid onto Sunday set TP=SAT
+66 IF M=1&("^1^8^"[(U_DAY_U))
IF SATNOSUN
Begin DoDot:2
+67 IF AV[$EXTRACT($GET(^TMP($JOB,"PRS8",DAY-1,"W")),96)
SET TP="SAT"
End DoDot:2
+68 ;
+69 ; loop forward thru current day's portion of tour
+70 IF DAY<15
FOR
Begin DoDot:2
+71 IF AV[$EXTRACT(D(DAY),M)!($EXTRACT(D(DAY),M)="O"&($EXTRACT(H(DAY),M)=2))
DO COUNT^PRS8WE2(DAY,M)
+72 ;
+73 ; If checking for SATNOSUN quit when tour crossing midnight ends
+74 IF SATNOSUN&(TP="SAT")&("^1^8^15^"[(U_DAY_U))&(AV'[$EXTRACT(D(DAY),M+1))
DO SAVE^PRS8WE2
SET M=END
QUIT
End DoDot:2
if M=END
QUIT
SET M=M+1
if TV'[$EXTRACT(D(DAY),M)&($EXTRACT(H(DAY),M)'=2)
QUIT
+75 ;
+76 ; If counting Sat Prem for SATNOSUN and Day is a Sunday there is no
+77 ; need to check for the tour crossing midnight onto Monday
+78 if SATNOSUN&(TP="SAT")&("^1^8^15^"[(U_DAY_U))
QUIT
+79 ;
+80 ; If SATNOSUN and DAY=14 and M<96 check remainder of tour for work
+81 IF SATNOSUN&(DAY=14)&(M<96)
Begin DoDot:2
+82 FOR M=M:1:96
Begin DoDot:3
+83 IF AV[$EXTRACT(D(DAY),M)!($EXTRACT(D(DAY),M)="O"&($EXTRACT(H(DAY),M)=2))
DO COUNT^PRS8WE2(DAY,M)
End DoDot:3
End DoDot:2
+84 ;
+85 ; If tour lasted until end of day then check if it is part of
+86 ; a 2-day tour that extends into next day
+87 IF DAY<15
IF M=96
IF 'SATNOSUN
IF (TV[$EXTRACT(D(DAY),M))!($EXTRACT(H(DAY),M)=2)
Begin DoDot:2
+88 NEW CLASS,DYN,Z
+89 SET CLASS=$$CTS($EXTRACT(D(DAY),96),$EXTRACT(H(DAY),96))
+90 SET DYN=DAY+1
+91 SET D(DYN)=$GET(^TMP($JOB,"PRS8",DYN,"W"))
+92 SET P(DYN)=$GET(^TMP($JOB,"PRS8",DYN,"P"))
+93 SET H(DYN)=$GET(^TMP($JOB,"PRS8",DYN,"HOL"))
+94 ; not same 'tour'
if $$CTS($EXTRACT(D(DYN),1),$EXTRACT(H(DYN),1))'=CLASS
QUIT
+95 ; Hybrids defined by Public Law P.L. 107-135 only get Saturday
+96 ; or Sunday premium for CT/OT/UN worked on Saturday or Sunday
+97 if HYBRID&(TP="SUN")&($$CTS($EXTRACT(D(DYN),1),$EXTRACT(H(DYN),1))="X")
QUIT
+98 ; can't be same scheduled tour
IF CLASS="R"
IF '$$TDT(DAY)
QUIT
+99 ; loop forward from midnight thru next day's portion of tour
+100 SET Z=1
+101 FOR
Begin DoDot:3
+102 IF AV[$EXTRACT(D(DYN),Z)!($EXTRACT(D(DYN),Z)="O"&($EXTRACT(H(DYN),Z)=2))
DO COUNT^PRS8WE2(DYN,Z)
End DoDot:3
if Z=96
QUIT
SET Z=Z+1
if $$CTS($EXTRACT(D(DYN),Z),$EXTRACT(H(DYN),Z))'=CLASS
QUIT
End DoDot:2
+103 ;
+104 ; post premium time for tour to WK()
+105 DO SAVE^PRS8WE2
End DoDot:1
if M=END
QUIT
SET M=M+1
+106 QUIT
+107 ;
TV() ; List types of time in a 'tour'
+1 NEW PRSX
+2 ; for regular time
+3 SET PRSX="LRSFGDUAJMWNnVH1234XYmZq"
+4 ; for OT/CT
+5 SET PRSX=PRSX_$SELECT(TYP["B":"EeOs",TYP["N"!(TYP["H"):"EetOoscbT",1:"")
+6 IF HYBRID
SET PRSX=PRSX_"EetOoscbT"
+7 ; for employees covered by PL 108-170
+8 IF PMP'=""&("^S^T^U^V^"[(U_PMP_U))
Begin DoDot:1
+9 IF $EXTRACT(ENT,28)
IF PRSX'["Eet"
SET PRSX=PRSX_"Eet"
+10 IF $EXTRACT(ENT,12)
IF PRSX'["Oos"
SET PRSX=PRSX_"Oos"
+11 IF $EXTRACT(ENT,17)
IF PRSX'["c"
SET PRSX=PRSX_"c"
+12 IF $EXTRACT(ENT,29)
IF PRSX'["b"
SET PRSX=PRSX_"b"
+13 IF $EXTRACT(ENT,18)
IF PRSX'["T"
SET PRSX=PRSX_"T"
End DoDot:1
+14 QUIT PRSX
+15 ;
AV() ; List types of time that might be eligible for premium pay
+1 NEW PRSX
+2 ; for regular time
+3 SET PRSX=$SELECT(TYP["B":"",1:"1234XY")
+4 ; for OT/CT
+5 SET PRSX=PRSX_$SELECT(TYP["B":"EeOos",TYP["N"!(TYP["H"):"EeOosc",1:"")
+6 IF HYBRID
SET PRSX=PRSX_"EeOosc"
+7 ; for employees covered by PL 108-170
+8 IF PMP'=""&("^S^T^U^V^"[(U_PMP_U))
Begin DoDot:1
+9 IF $EXTRACT(ENT,28)
IF PRSX'["Ee"
SET PRSX=PRSX_"Ee"
+10 IF $EXTRACT(ENT,12)
IF PRSX'["Oos"
SET PRSX=PRSX_"Oos"
+11 IF $EXTRACT(ENT,17)
IF PRSX'["c"
SET PRSX=PRSX_"c"
End DoDot:1
+12 QUIT PRSX
+13 ;
CTS(XW,XH) ; Return class of a time segment
+1 ; input XW = type of time in activity ("W") string
+2 ; XH = value in holiday ("H") string
+3 ; returns class
+4 ; "R" regular scheduled
+5 ; "X" extra (ot/ct) or unscheduled reg.
+6 ; "N" not worked (includes on-call, standby when not called back)
+7 QUIT $SELECT(("LRSFGDUAJMWNnVH123XYmZq"[XW)!((XW="O")&(XH=2)):"R",("EetscbT4"[XW)!((XW="O")&(XH'=2)):"X",1:"N")
+8 ;
TDT(DAYN) ; Two-Day Tour extrinsic variable
+1 ; input
+2 ; DAYN = day # (0-15) being checked for at least one sch. 2-day tour
+3 ; returns 0 (false) or 1 (true)
+4 NEW RET
+5 ; assume no scheduled 2-day tour of duty
SET RET=0
+6 SET X=$GET(^TMP($JOB,"PRS8",DAYN,0))
+7 FOR I=2,13
IF $PIECE(X,U,I)
IF $PIECE($GET(^PRST(457.1,$PIECE(X,U,I),0)),U,5)="Y"
SET RET=1
+8 QUIT RET
+9 ;
+10 ;PRS8WE
