PRS8EX ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;6/11/2008
;;4.0;PAID;**2,40,56,69,111,112,117**;Sep 21, 1995;Build 32
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine is used to process most exceptions to the normal
;tod. It is used, for example, to determine whether or not the
;employee is entitled to such exceptions as Leave, OT, etc.,
;and then calls ^PRS8AC to process them.
;
;Called by Routines: PRS8ST
;
S TT=$P(V,"^",3) ;type of time
I TT="OT",+$P(V,"^",4)=8,$E(ENT,18) S TT="TT" ;ot in travel status
I TT="CT",$P(V,"^",4)=16 S TT="CQ" ;credit hours earned
I TT="CU",$P(V,"^",4)=16 S TT="CS" ;credit hours used
I TT="HW",$E(ENT,1,2)="0D" S TT="RG"
I TT="OT",TYP["P",TYP'["B" S TT="RG" ;To convert Pt ot to RG
I TT="HW",TYP'["D",+V,+$P(V,"^",2) D
.I $P(V,"^",2)-V-1<8 D ; <2 hrs HW
..S ^TMP($J,"PRS8",DY,"HW")=$G(^TMP($J,"PRS8",DY,"HW"))_$P(V,U,1,2)_U
..Q
.I TYP["P",$P(V,"^",2)>96 S LEN=$P(V,"^",2)-96 D ;two day tour of HW for part timers
..S ^TMP($J,"PRS8",DY+1,"HWK")=$G(^TMP($J,"PRS8",DY+1,"HWK"))_1_U_LEN_U
..K LEN
..Q
.I TYP["P",TYP["N"!(TYP["H"),'$E(DAY(DY,"W"),+V) D ; part time nurses, uscheduled HW.
..S ^TMP($J,"PRS8",DY,"HWK")=$G(^TMP($J,"PRS8",DY,"HWK"))_$P(V,U,1,2)_U
..Q
.Q
S X="^AL^SL^WP^NP^AA^RL^CU^CT^CP^HX^ML^TR^TV^OT^RG^TT^SB^ON^NL^HW^CB^AD^DL^RS^CH^CQ^CS" ;code
S X=($F(X,"^"_TT)\3)+4,(X,TT(1))=$P($T(ACT+X),";;",2) ;parameters
S GO=0 I '+X!($E(ENT,+X)) S GO=1 ;entitlement exists-continue
I TT="RG",$E(ENT,2)'=0 S GO=1 ;intermittent
I TT="RG"!(TT="CP"),$E(ENT,2)="D" S DAY(DY,"DWK")=1 ;intrmtnt-count days worked (for RG or CP)
I TT="OT",'GO,$E(ENT,13)!$E(ENT,14) S GO=1 ;entitled to ot
I TT="UN" S GO=1,VAR="-" ;unavailable
I TYP["W",TT="RG",$P(V,"^",4)=7 D
.;wage grade employee working regular unscheduled hours for
.;shift coverage (7) can get shift differential based on the higher
.;of the unscheduled tour's shift or their normal shift.
.;The unscheduled tour and corresponding differential will be saved
.;in the "SD" node and used by PRS8PP when differentials are
.;computed.
.N ST,EN,SD,MID
.S ST=$P(V,"^"),EN=$P(V,"^",2) Q:'ST!'EN
.S MID=ST+EN/2
.; check for 2day tour and if found use combined tour (recompute MID)
.; to determine appropriate shift differential.
.; if start is 1 (midnight) then check previous day for a similar tour
.; that ended at 96 (midnight).
. I ST=1 D
.. N PRSI,PRSX
.. S PRSX=$G(^TMP($J,"PRS8",DY-1,2))
.. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)="" D
... I $P(PRSX,U,(PRSI-1)*4+2)=96,$P(PRSX,U,(PRSI-1)*4+3)="RG",$P(PRSX,U,(PRSI-1)*4+4)=7 S MID=($P(PRSX,U,(PRSI-1)*4+1)+EN+96)/2
.; if end is 96 (midnight) then check next day for a similar tour that
.; starts at 1 (midnight).
. I EN=96 D
.. N PRSI,PRSX
.. S PRSX=$G(^TMP($J,"PRS8",DY+1,2))
.. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)="" D
... I $P(PRSX,U,(PRSI-1)*4+1)=1,$P(PRSX,U,(PRSI-1)*4+3)="RG",$P(PRSX,U,(PRSI-1)*4+4)=7 S MID=(ST+$P(PRSX,U,(PRSI-1)*4+2)+96)/2
.; determine shift differential (if any) based on unscheduled tour hours
.S SD=0
.I MID<32.5 S SD=3 ; majority of tour before 8a
.I MID>60.5,MID'>94.5 S SD=2 ; majority of tour after 3p, upto 11:30p
.I MID>94.5,MID<128.5 S SD=3 ; majority of tour after 11:30p, before 8a
.; use employee's normal shift if higher than shift based on hours
.I TOUR>1,TOUR>SD S SD=TOUR
.S:SD ^TMP($J,"PRS8",DY,"SD")=$G(^TMP($J,"PRS8",DY,"SD"))_ST_U_EN_U_SD_U
.Q
I (TT="OT"!(TT="RG")!(TT="CT")),"^13^14^"[("^"_$P(V,"^",4)_"^")!($P(V,"^",4)=12&(TYP["N"!(TYP["H"))) D
.S ^TMP($J,"PRS8",DY,"CB")=$G(^TMP($J,"PRS8",DY,"CB"))_$P(V,"^",1,2)_"^"
.Q
I TYP'["D",TT="HX"!(TT="HW") S GO=1 ;process holiday excused/worked
G END:'GO ;nothing to process
I TT'="UN" S VAR=$P(X,"^",3) ;increment time code
I '$S(VAR'="W":1,'CYA:1,DY<CYA:1,1:0) D
.S WPCY=1 ;flag to save WOP in hours from 1/1 for calendar year adjustment
I TYP'["D" D G END ;process hourly people and quit
.; The following 2 lines commented out because for Employees that are
.; non-daily tour (TYP'["D"), policy is has been described that all
.; ML/COP has to be posted by time-keeper.
.; If this changes, then uncomment these lines, remove the line adding
.; military leave and COP that follows, and refer to routine PRS8UP.
.; I VAR="M" S ^TMP($J,"PRS8",DY,"ML")=1,MILV=1 ;military leave taken
.; I VAR="V" S ^TMP($J,"PRS8",DY,"CP")=1,WCMP=1 ;cont of pay indicator
.I DY>0,DY<15 D
..; Post ML for employees who are charged in days.
..I VAR="M",$$MLINHRS^PRSAENT(DFN)=0 D
...S X=$P(TT(1),"^",4) D SET ; military leave & auth. absence
..I VAR="V",'$G(^TMP($J,"PRS8",DY,"CP")) S X="M",^TMP($J,"PRS8",DY,"CP")=1 D SET ; COP
..Q
.D ^PRS8AC ;update activity string
.Q
; Employees with daily tours (TYP["D")
I DY>0,DY<15,VAR="M" S X=$P(TT(1),"^",4) D SET S X=5 D SET G END ;military leave & auth. absence
I DY>0,DY<15,$$HOLIDAY^PRS8UT(PY,DFN,DY) D G END ;holiday-no charge
.I TT="RG" S DAY(DY,"W")=VAR,X=$S('$E(ENT,TOUR+21):9,1:TOUR+28) D SET ; If worked on holiday count it.
.Q
S D=DY
I TT="NP"!($P(DAY(D,0),"^",2)'=1) S DAY(D,"W")=VAR,X=$P(TT(1),"^",4) I X'="",DY>0,DY<15 D SET I VAR="V" S X="M" D SET I VAR="V",TYP["DI",$E(ENT,2)="D" S X=9 D SET ; IF INT RESDNT PAID IN DAYS HAS COP POSTED PAY UN/US ALSO
D ENCAP^PRS8EX0
;
END ; --- all done here
K A,D,DD,GO,TT,X,Z
Q
;
SET ; --- enter here to set without VAL defined
; Quit if this day has already been counted through the encapsulation
; check that is performed in ENCAP^PRS8EX0.
Q:$D(^TMP($J,"PRS8",DY,2,0))
;
Q:X="K"&($P(V,"^",1)>96)!((X="K")&($D(^TMP($J,"PRS8",DY,"ML")))) S ^TMP($J,"PRS8",DY,"ML")=1 ;stop counting ML twice for two day tours & split tours, but allow PC
I +X S $P(WK(WK),"^",+X)=$P(WK(WK),"^",+X)+1
E S X=$A(X)-64,$P(WK(3),"^",+X)=$P(WK(3),"^",+X)+1
Q
;
ACT ; --- define variable X for action
; - piece 1 = entitlement (ENT) string $Extract to check
; - 2 = Literal name of exception
; - 3 = Time String code (DAY(X,"W"))
;;
;;30^Annual Leave^L^1
;;31^Sick Leave^S^2
;;33^Without Pay^W^3
;;36^Non-Pay Status^n^4
;;35^Authorized Absence^A^5
;;30^Restored Leave^R^6
;;28^Comp Used^U^8
;;28^Comp Earned^E^7
;;37^Continuation of Pay^V^33
;;38^Holiday Excused^H
;;34^Military Leave^M^K
;;0^Training^X^43
;;0^Travel^Y^42
;;12^Overtime^O
;;2^Unscheduled^4^9
;;18^OT in Travel Status^T
;;29^Standby^B
;;26^On-Call^C
;;36^Nonpay A/L^N^A
;;38^Holiday Worked^h
;;31^Care and Bereavement^F^44
;;31^Adoption^G^45
;;35^Donor Leave^D^46
;;5^Recess^r^48
;;4^Comp Time for Travel Used^Z^53
;;28^Credit Hours Earned^Q^54
;;28^Credit Hours Used^q^55
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8EX 6792 printed Apr 09, 2024@21:31:29 Page 2
PRS8EX ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;6/11/2008
+1 ;;4.0;PAID;**2,40,56,69,111,112,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 process most exceptions to the normal
+5 ;tod. It is used, for example, to determine whether or not the
+6 ;employee is entitled to such exceptions as Leave, OT, etc.,
+7 ;and then calls ^PRS8AC to process them.
+8 ;
+9 ;Called by Routines: PRS8ST
+10 ;
+11 ;type of time
SET TT=$PIECE(V,"^",3)
+12 ;ot in travel status
IF TT="OT"
IF +$PIECE(V,"^",4)=8
IF $EXTRACT(ENT,18)
SET TT="TT"
+13 ;credit hours earned
IF TT="CT"
IF $PIECE(V,"^",4)=16
SET TT="CQ"
+14 ;credit hours used
IF TT="CU"
IF $PIECE(V,"^",4)=16
SET TT="CS"
+15 IF TT="HW"
IF $EXTRACT(ENT,1,2)="0D"
SET TT="RG"
+16 ;To convert Pt ot to RG
IF TT="OT"
IF TYP["P"
IF TYP'["B"
SET TT="RG"
+17 IF TT="HW"
IF TYP'["D"
IF +V
IF +$PIECE(V,"^",2)
Begin DoDot:1
+18 ; <2 hrs HW
IF $PIECE(V,"^",2)-V-1<8
Begin DoDot:2
+19 SET ^TMP($JOB,"PRS8",DY,"HW")=$GET(^TMP($JOB,"PRS8",DY,"HW"))_$PIECE(V,U,1,2)_U
+20 QUIT
End DoDot:2
+21 ;two day tour of HW for part timers
IF TYP["P"
IF $PIECE(V,"^",2)>96
SET LEN=$PIECE(V,"^",2)-96
Begin DoDot:2
+22 SET ^TMP($JOB,"PRS8",DY+1,"HWK")=$GET(^TMP($JOB,"PRS8",DY+1,"HWK"))_1_U_LEN_U
+23 KILL LEN
+24 QUIT
End DoDot:2
+25 ; part time nurses, uscheduled HW.
IF TYP["P"
IF TYP["N"!(TYP["H")
IF '$EXTRACT(DAY(DY,"W"),+V)
Begin DoDot:2
+26 SET ^TMP($JOB,"PRS8",DY,"HWK")=$GET(^TMP($JOB,"PRS8",DY,"HWK"))_$PIECE(V,U,1,2)_U
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;code
SET X="^AL^SL^WP^NP^AA^RL^CU^CT^CP^HX^ML^TR^TV^OT^RG^TT^SB^ON^NL^HW^CB^AD^DL^RS^CH^CQ^CS"
+30 ;parameters
SET X=($FIND(X,"^"_TT)\3)+4
SET (X,TT(1))=$PIECE($TEXT(ACT+X),";;",2)
+31 ;entitlement exists-continue
SET GO=0
IF '+X!($EXTRACT(ENT,+X))
SET GO=1
+32 ;intermittent
IF TT="RG"
IF $EXTRACT(ENT,2)'=0
SET GO=1
+33 ;intrmtnt-count days worked (for RG or CP)
IF TT="RG"!(TT="CP")
IF $EXTRACT(ENT,2)="D"
SET DAY(DY,"DWK")=1
+34 ;entitled to ot
IF TT="OT"
IF 'GO
IF $EXTRACT(ENT,13)!$EXTRACT(ENT,14)
SET GO=1
+35 ;unavailable
IF TT="UN"
SET GO=1
SET VAR="-"
+36 IF TYP["W"
IF TT="RG"
IF $PIECE(V,"^",4)=7
Begin DoDot:1
+37 ;wage grade employee working regular unscheduled hours for
+38 ;shift coverage (7) can get shift differential based on the higher
+39 ;of the unscheduled tour's shift or their normal shift.
+40 ;The unscheduled tour and corresponding differential will be saved
+41 ;in the "SD" node and used by PRS8PP when differentials are
+42 ;computed.
+43 NEW ST,EN,SD,MID
+44 SET ST=$PIECE(V,"^")
SET EN=$PIECE(V,"^",2)
if 'ST!'EN
QUIT
+45 SET MID=ST+EN/2
+46 ; check for 2day tour and if found use combined tour (recompute MID)
+47 ; to determine appropriate shift differential.
+48 ; if start is 1 (midnight) then check previous day for a similar tour
+49 ; that ended at 96 (midnight).
+50 IF ST=1
Begin DoDot:2
+51 NEW PRSI,PRSX
+52 SET PRSX=$GET(^TMP($JOB,"PRS8",DY-1,2))
+53 FOR PRSI=1:1:7
if $PIECE(PRSX,U,(PRSI-1)*4+1)=""
QUIT
Begin DoDot:3
+54 IF $PIECE(PRSX,U,(PRSI-1)*4+2)=96
IF $PIECE(PRSX,U,(PRSI-1)*4+3)="RG"
IF $PIECE(PRSX,U,(PRSI-1)*4+4)=7
SET MID=($PIECE(PRSX,U,(PRSI-1)*4+1)+EN+96)/2
End DoDot:3
End DoDot:2
+55 ; if end is 96 (midnight) then check next day for a similar tour that
+56 ; starts at 1 (midnight).
+57 IF EN=96
Begin DoDot:2
+58 NEW PRSI,PRSX
+59 SET PRSX=$GET(^TMP($JOB,"PRS8",DY+1,2))
+60 FOR PRSI=1:1:7
if $PIECE(PRSX,U,(PRSI-1)*4+1)=""
QUIT
Begin DoDot:3
+61 IF $PIECE(PRSX,U,(PRSI-1)*4+1)=1
IF $PIECE(PRSX,U,(PRSI-1)*4+3)="RG"
IF $PIECE(PRSX,U,(PRSI-1)*4+4)=7
SET MID=(ST+$PIECE(PRSX,U,(PRSI-1)*4+2)+96)/2
End DoDot:3
End DoDot:2
+62 ; determine shift differential (if any) based on unscheduled tour hours
+63 SET SD=0
+64 ; majority of tour before 8a
IF MID<32.5
SET SD=3
+65 ; majority of tour after 3p, upto 11:30p
IF MID>60.5
IF MID'>94.5
SET SD=2
+66 ; majority of tour after 11:30p, before 8a
IF MID>94.5
IF MID<128.5
SET SD=3
+67 ; use employee's normal shift if higher than shift based on hours
+68 IF TOUR>1
IF TOUR>SD
SET SD=TOUR
+69 if SD
SET ^TMP($JOB,"PRS8",DY,"SD")=$GET(^TMP($JOB,"PRS8",DY,"SD"))_ST_U_EN_U_SD_U
+70 QUIT
End DoDot:1
+71 IF (TT="OT"!(TT="RG")!(TT="CT"))
IF "^13^14^"[("^"_$PIECE(V,"^",4)_"^")!($PIECE(V,"^",4)=12&(TYP["N"!(TYP["H")))
Begin DoDot:1
+72 SET ^TMP($JOB,"PRS8",DY,"CB")=$GET(^TMP($JOB,"PRS8",DY,"CB"))_$PIECE(V,"^",1,2)_"^"
+73 QUIT
End DoDot:1
+74 ;process holiday excused/worked
IF TYP'["D"
IF TT="HX"!(TT="HW")
SET GO=1
+75 ;nothing to process
if 'GO
GOTO END
+76 ;increment time code
IF TT'="UN"
SET VAR=$PIECE(X,"^",3)
+77 IF '$SELECT(VAR'="W":1,'CYA:1,DY<CYA:1,1:0)
Begin DoDot:1
+78 ;flag to save WOP in hours from 1/1 for calendar year adjustment
SET WPCY=1
End DoDot:1
+79 ;process hourly people and quit
IF TYP'["D"
Begin DoDot:1
+80 ; The following 2 lines commented out because for Employees that are
+81 ; non-daily tour (TYP'["D"), policy is has been described that all
+82 ; ML/COP has to be posted by time-keeper.
+83 ; If this changes, then uncomment these lines, remove the line adding
+84 ; military leave and COP that follows, and refer to routine PRS8UP.
+85 ; I VAR="M" S ^TMP($J,"PRS8",DY,"ML")=1,MILV=1 ;military leave taken
+86 ; I VAR="V" S ^TMP($J,"PRS8",DY,"CP")=1,WCMP=1 ;cont of pay indicator
+87 IF DY>0
IF DY<15
Begin DoDot:2
+88 ; Post ML for employees who are charged in days.
+89 IF VAR="M"
IF $$MLINHRS^PRSAENT(DFN)=0
Begin DoDot:3
+90 ; military leave & auth. absence
SET X=$PIECE(TT(1),"^",4)
DO SET
End DoDot:3
+91 ; COP
IF VAR="V"
IF '$GET(^TMP($JOB,"PRS8",DY,"CP"))
SET X="M"
SET ^TMP($JOB,"PRS8",DY,"CP")=1
DO SET
+92 QUIT
End DoDot:2
+93 ;update activity string
DO ^PRS8AC
+94 QUIT
End DoDot:1
GOTO END
+95 ; Employees with daily tours (TYP["D")
+96 ;military leave & auth. absence
IF DY>0
IF DY<15
IF VAR="M"
SET X=$PIECE(TT(1),"^",4)
DO SET
SET X=5
DO SET
GOTO END
+97 ;holiday-no charge
IF DY>0
IF DY<15
IF $$HOLIDAY^PRS8UT(PY,DFN,DY)
Begin DoDot:1
+98 ; If worked on holiday count it.
IF TT="RG"
SET DAY(DY,"W")=VAR
SET X=$SELECT('$EXTRACT(ENT,TOUR+21):9,1:TOUR+28)
DO SET
+99 QUIT
End DoDot:1
GOTO END
+100 SET D=DY
+101 ; IF INT RESDNT PAID IN DAYS HAS COP POSTED PAY UN/US ALSO
IF TT="NP"!($PIECE(DAY(D,0),"^",2)'=1)
SET DAY(D,"W")=VAR
SET X=$PIECE(TT(1),"^",4)
IF X'=""
IF DY>0
IF DY<15
DO SET
IF VAR="V"
SET X="M"
DO SET
IF VAR="V"
IF TYP["DI"
IF $EXTRACT(ENT,2)="D"
SET X=9
DO SET
+102 DO ENCAP^PRS8EX0
+103 ;
END ; --- all done here
+1 KILL A,D,DD,GO,TT,X,Z
+2 QUIT
+3 ;
SET ; --- enter here to set without VAL defined
+1 ; Quit if this day has already been counted through the encapsulation
+2 ; check that is performed in ENCAP^PRS8EX0.
+3 if $DATA(^TMP($JOB,"PRS8",DY,2,0))
QUIT
+4 ;
+5 ;stop counting ML twice for two day tours & split tours, but allow PC
if X="K"&($PIECE(V,"^",1)>96)!((X="K")&($DATA(^TMP($JOB,"PRS8",DY,"ML"))))
QUIT
SET ^TMP($JOB,"PRS8",DY,"ML")=1
+6 IF +X
SET $PIECE(WK(WK),"^",+X)=$PIECE(WK(WK),"^",+X)+1
+7 IF '$TEST
SET X=$ASCII(X)-64
SET $PIECE(WK(3),"^",+X)=$PIECE(WK(3),"^",+X)+1
+8 QUIT
+9 ;
ACT ; --- define variable X for action
+1 ; - piece 1 = entitlement (ENT) string $Extract to check
+2 ; - 2 = Literal name of exception
+3 ; - 3 = Time String code (DAY(X,"W"))
+4 ;;
+5 ;;30^Annual Leave^L^1
+6 ;;31^Sick Leave^S^2
+7 ;;33^Without Pay^W^3
+8 ;;36^Non-Pay Status^n^4
+9 ;;35^Authorized Absence^A^5
+10 ;;30^Restored Leave^R^6
+11 ;;28^Comp Used^U^8
+12 ;;28^Comp Earned^E^7
+13 ;;37^Continuation of Pay^V^33
+14 ;;38^Holiday Excused^H
+15 ;;34^Military Leave^M^K
+16 ;;0^Training^X^43
+17 ;;0^Travel^Y^42
+18 ;;12^Overtime^O
+19 ;;2^Unscheduled^4^9
+20 ;;18^OT in Travel Status^T
+21 ;;29^Standby^B
+22 ;;26^On-Call^C
+23 ;;36^Nonpay A/L^N^A
+24 ;;38^Holiday Worked^h
+25 ;;31^Care and Bereavement^F^44
+26 ;;31^Adoption^G^45
+27 ;;35^Donor Leave^D^46
+28 ;;5^Recess^r^48
+29 ;;4^Comp Time for Travel Used^Z^53
+30 ;;28^Credit Hours Earned^Q^54
+31 ;;28^Credit Hours Used^q^55
