PRSAENT ;HISC/MGD-Entitlement String ;10/21/04
;;4.0;PAID;**6,21,45,69,75,76,90,96,112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;VARS:
; C0=employees 0 node of master record in file 450
; NH= employees 8B normal hours
; FLX= compressed/flextime code (0=none,C=compressed,F=flextime)
; PMP= premium pay indicator
; ( D = entitled Sun., F = entitled Sat./Sun.,
; E = entitled variable Sat./Sun. premium pay,
; G = entitled variable Sun. prem pay
; X = title 5 employees
; R, C, O = 3 types of firefighters )
; AC= 3 single char codes concat. w/o delims + a possible 4th char.
; AC= PP_DutyBasis(full-1,part-2,intermit-3)_FLSA(E=Exempt,N=NonExempt)
; _(*EWXY8BT02S9P)
; PP= employees pay plan (possible chars 0AEFGJKLMNPQRSTUWXY)
; PB= pay basis-code for time condition for computing pay.
; TA= type of appointment (career, career conditional, etc.)
; OCC= 4 digit cost center for fund appropriation accounting
; LVG= one digit code for employees leave group.
; ASS= specialty assignment of physicians,dentists, nurses,
; summer employees,trainees and other special programs.
; ENT= 39 character entitlement string
; PMP = Premium Pay Code
;
N PAYPDTMP,PPLOLD,DUTYTEMP,FLSATEMP
;
S C0=^PRSPC(DFN,0)
;
; pay plan in master record.
S PP=$P(C0,"^",21)
;
;=====================================================================
; duty basis from master record
S DUTYTEMP=$P(C0,"^",10)
;
; FLSA indicator from master record
S FLSATEMP=$P(C0,"^",12)
;
;Make sure we've called this routine from an entry point that uses
;PY for pay period. A few reports, call PRSAENT from TYPSTF^PRSRUT0
;and the reports aren't concerned about differing pay plans from
;other pay periods.
;
I +($G(PY))>0 D
.S PAYPDTMP=$P($G(^PRST(458,+PY,0)),"^") ;pay period we're working with.
.S PPLOLD=$$OLDPP^PRS8UT(PAYPDTMP,+DFN) ;pay plan from PAYPDTMP.
.;if we find an old pay plan and it's different than the master record
.;use the old pay plan to determine VCS or FEE.
.I PPLOLD'=0,(PP'=PPLOLD) D
.. S PP=PPLOLD
.. S DUTYTEMP=OLDPP("DUTYBS")
;=====================================================================
;
; Numeric Pay plans are all Wage grade. Set them to 0.
S:PP?1N PP=0
;
;
S:"BC"[PP PP="A"
I "0AEFGJKLMNPQRSTUWXY"'[PP D NO Q
S NH=+$P(C0,"^",16)
S FLX=$P($G(^PRSPC(DFN,1)),"^",7)
S PMP=$P($G(^PRSPC(DFN,"PREMIUM")),"^",6)
S AC=PP_DUTYTEMP_FLSATEMP
I $L(AC)'=3 D NO Q
;
;
D @PP
D FND
Q
;===========================================================
;
0 Q
;
A ;patch 45: firefighters entitlements are based on PMP Codes.
; Code O still uses nh>80 to determine entitlement.
I "RC"[PMP S AC=AC_PMP Q
;
;This check does not concern itself with whether or not a code
; O is present. Simply if not a code R or C then an over 80
; must be a code O firefighter under the rules implemented in
; patch 45.
;
I "CR"'[PMP,NH>80 S AC=AC_"*" Q
;
Q:PMP=""
I $E(AC,2)'=3,"WXY"[PMP S AC=AC_PMP Q
S:"EF"[PMP AC=AC_"E"
;The following check is for Public Law 108-170
S:"STUV"[PMP AC=AC_PMP
Q
E Q
F Q
G I $E(AC,2)<3 Q
S TA=$P(C0,"^",43) S:TA=8 AC=AC_"8" Q
J Q
K S:NH=48 AC=AC_"B" Q
L I $E(AC,2)=2 S PB=$P(C0,"^",20) S:PB=0 AC=AC_"*" Q
I $E(AC,2)=3 S OCC=$P(C0,"^",17),OCC=+$E(OCC,5,6) S:OCC>20&(OCC<38) AC=AC_"*" Q
S LVG=$P(C0,"^",15) S:LVG=5 AC=AC_"*" Q
M I $E(AC,2)=1,NH=48 S AC=AC_"B" Q
I $E(AC,2)=2,NH=80 S AC=AC_"R" Q
I $E(AC,2)=2 S PB=$P(C0,"^",20) I PB=0 S AC=AC_"0" Q
I $E(AC,2)=3 S PB=$P(C0,"^",20) I PB=2 S AC=AC_"2" Q
S OCC=$P(C0,"^",17) S:OCC="" OCC="*"
S:" 061056 061057 "[OCC AC=AC_"T"
S:" 061071 061072 061080 061083 061084 "[OCC AC=AC_"T"
S:" 060552 060556 "[OCC AC=AC_"T" Q
N S ASS=$P(C0,"^",4),PB=$P(C0,"^",20)
;The following check is for Public Law 108-170
I "^S^T^U^V^"[("^"_PMP_"^") S AC=AC_PMP Q
I AC="N2E",PB=0 S AC=AC_"0" Q
I $E(AC,2)=3,PB="S" S AC=AC_"$" Q
S OCC=$P(C0,"^",17) S:OCC="" OCC="*"
I OCC="069961" S AC=AC_"T" Q ; Student Nurse Technician
I OCC="069964" S AC=AC_"T" Q ; Student Nurse Technician
S AC=AC_$S(ASS="TR":"T",ASS?1"T"1N:"T",ASS?1"A"1N:"T",1:"") Q
P Q
Q I $E(AC,2)'=2 Q
S PB=$P(C0,"^",20) S:PB=0 AC=AC_"0" Q
R Q
S Q
T I $E(AC,2)'=3 Q
S PB=$P(C0,"^",20) S:PB=9 AC=AC_"9" Q
U S PB=$P(C0,"^",20) I $E(AC,3)="N",PB="P" S AC=AC_"P"
Q
W Q
X S:'NH AC=AC_"0" Q
Y Q
;
;= = = = = = = = = = = = = = = = = = = = = = = =
FND ;Look up the 39 character entitlement string in the entitlement table
;The lookup is based on the AC x-ref that matches the AC variable that
;is built in this routine from the three 1 character codes from the
;450 fields (pay plan, duty basis, FLSA).
;
S A1=$O(^PRST(457.5,"AC",AC,0))
D NO
I +A1 S ENT=^PRST(457.5,A1,1)
; The following check was added to address the Hybrid employees
; defined in Public Law 107-135. These Hybrids do not have a
; Premium Pay Indicator but are entitled to Saturday and Sunday
; Premium Pay.
I $$HYBRID^PRSAENT1(DFN) D
. S $E(ENT,8,9)="11"
;
Q
;= = = = = = = = = = = = = = = = = = = = = = = =
NO S ENT=""
Q
;
MLINHRS(IEN) ;
;----------------------------------------------------------------------
; Determine if the employee is entitled to Military Leave in hours.
;
; Input Vars:
; IEN - the ien number of the employee in the PAID EMPLOYEE (#450)
; file.
;
; Local Vars:
; DATA - the 0 node of the employee from the PAID EMPLOYEE (#450)
; file.
; DB - Duty Basis field #9 from the #450 file.
; NH - Normal Hours field # 15 from the #450 file.
; PP - Pay Plan field # 20 from the #450 file.
;
; Output:
; 1 : Entitled to ML in hours.
; 0 : Entitled to ML in days.
; X : Some of the required fields were not defined or the employee
; is not entitled to Military Leave.
;----------------------------------------------------------------------
; Quit if no IEN passed in
;
Q:'+IEN "X"
;
; Verify that ENT is defined. If not call PRSAENT to define it.
;
I '$D(ENT) D PRSAENT
;
; Quit if the Entitlement string is not defined for the employee
;
Q:ENT="" "X"
;
; Quit if the employee is not entitled to Military Leave
;
Q:'$E(ENT,34) "X"
;
N DATA,PP,DB,NH
S DATA=$G(^PRSPC(IEN,0))
Q:DATA="" "X"
S DB=$P(DATA,U,10),NH=$P(DATA,U,16),PP=$P(DATA,U,21)
Q:DB=""!(NH="")!(PP="") "X" ; Quit if DB or NH or PP is not defined.
;
; Check for ML in Days
;
I DB=1,NH=0,"^J^L^P^Q^X^"[PP Q 0
;
; Otherwise the employee is entitled to ML in hours.
;
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAENT 6718 printed Dec 13, 2024@02:23:27 Page 2
PRSAENT ;HISC/MGD-Entitlement String ;10/21/04
+1 ;;4.0;PAID;**6,21,45,69,75,76,90,96,112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;VARS:
+5 ; C0=employees 0 node of master record in file 450
+6 ; NH= employees 8B normal hours
+7 ; FLX= compressed/flextime code (0=none,C=compressed,F=flextime)
+8 ; PMP= premium pay indicator
+9 ; ( D = entitled Sun., F = entitled Sat./Sun.,
+10 ; E = entitled variable Sat./Sun. premium pay,
+11 ; G = entitled variable Sun. prem pay
+12 ; X = title 5 employees
+13 ; R, C, O = 3 types of firefighters )
+14 ; AC= 3 single char codes concat. w/o delims + a possible 4th char.
+15 ; AC= PP_DutyBasis(full-1,part-2,intermit-3)_FLSA(E=Exempt,N=NonExempt)
+16 ; _(*EWXY8BT02S9P)
+17 ; PP= employees pay plan (possible chars 0AEFGJKLMNPQRSTUWXY)
+18 ; PB= pay basis-code for time condition for computing pay.
+19 ; TA= type of appointment (career, career conditional, etc.)
+20 ; OCC= 4 digit cost center for fund appropriation accounting
+21 ; LVG= one digit code for employees leave group.
+22 ; ASS= specialty assignment of physicians,dentists, nurses,
+23 ; summer employees,trainees and other special programs.
+24 ; ENT= 39 character entitlement string
+25 ; PMP = Premium Pay Code
+26 ;
+27 NEW PAYPDTMP,PPLOLD,DUTYTEMP,FLSATEMP
+28 ;
+29 SET C0=^PRSPC(DFN,0)
+30 ;
+31 ; pay plan in master record.
+32 SET PP=$PIECE(C0,"^",21)
+33 ;
+34 ;=====================================================================
+35 ; duty basis from master record
+36 SET DUTYTEMP=$PIECE(C0,"^",10)
+37 ;
+38 ; FLSA indicator from master record
+39 SET FLSATEMP=$PIECE(C0,"^",12)
+40 ;
+41 ;Make sure we've called this routine from an entry point that uses
+42 ;PY for pay period. A few reports, call PRSAENT from TYPSTF^PRSRUT0
+43 ;and the reports aren't concerned about differing pay plans from
+44 ;other pay periods.
+45 ;
+46 IF +($GET(PY))>0
Begin DoDot:1
+47 ;pay period we're working with.
SET PAYPDTMP=$PIECE($GET(^PRST(458,+PY,0)),"^")
+48 ;pay plan from PAYPDTMP.
SET PPLOLD=$$OLDPP^PRS8UT(PAYPDTMP,+DFN)
+49 ;if we find an old pay plan and it's different than the master record
+50 ;use the old pay plan to determine VCS or FEE.
+51 IF PPLOLD'=0
IF (PP'=PPLOLD)
Begin DoDot:2
+52 SET PP=PPLOLD
+53 SET DUTYTEMP=OLDPP("DUTYBS")
End DoDot:2
End DoDot:1
+54 ;=====================================================================
+55 ;
+56 ; Numeric Pay plans are all Wage grade. Set them to 0.
+57 if PP?1N
SET PP=0
+58 ;
+59 ;
+60 if "BC"[PP
SET PP="A"
+61 IF "0AEFGJKLMNPQRSTUWXY"'[PP
DO NO
QUIT
+62 SET NH=+$PIECE(C0,"^",16)
+63 SET FLX=$PIECE($GET(^PRSPC(DFN,1)),"^",7)
+64 SET PMP=$PIECE($GET(^PRSPC(DFN,"PREMIUM")),"^",6)
+65 SET AC=PP_DUTYTEMP_FLSATEMP
+66 IF $LENGTH(AC)'=3
DO NO
QUIT
+67 ;
+68 ;
+69 DO @PP
+70 DO FND
+71 QUIT
+72 ;===========================================================
+73 ;
0 QUIT
+1 ;
A ;patch 45: firefighters entitlements are based on PMP Codes.
+1 ; Code O still uses nh>80 to determine entitlement.
+2 IF "RC"[PMP
SET AC=AC_PMP
QUIT
+3 ;
+4 ;This check does not concern itself with whether or not a code
+5 ; O is present. Simply if not a code R or C then an over 80
+6 ; must be a code O firefighter under the rules implemented in
+7 ; patch 45.
+8 ;
+9 IF "CR"'[PMP
IF NH>80
SET AC=AC_"*"
QUIT
+10 ;
+11 if PMP=""
QUIT
+12 IF $EXTRACT(AC,2)'=3
IF "WXY"[PMP
SET AC=AC_PMP
QUIT
+13 if "EF"[PMP
SET AC=AC_"E"
+14 ;The following check is for Public Law 108-170
+15 if "STUV"[PMP
SET AC=AC_PMP
+16 QUIT
E QUIT
F QUIT
G IF $EXTRACT(AC,2)<3
QUIT
+1 SET TA=$PIECE(C0,"^",43)
if TA=8
SET AC=AC_"8"
QUIT
J QUIT
K if NH=48
SET AC=AC_"B"
QUIT
L IF $EXTRACT(AC,2)=2
SET PB=$PIECE(C0,"^",20)
if PB=0
SET AC=AC_"*"
QUIT
+1 IF $EXTRACT(AC,2)=3
SET OCC=$PIECE(C0,"^",17)
SET OCC=+$EXTRACT(OCC,5,6)
if OCC>20&(OCC<38)
SET AC=AC_"*"
QUIT
+2 SET LVG=$PIECE(C0,"^",15)
if LVG=5
SET AC=AC_"*"
QUIT
M IF $EXTRACT(AC,2)=1
IF NH=48
SET AC=AC_"B"
QUIT
+1 IF $EXTRACT(AC,2)=2
IF NH=80
SET AC=AC_"R"
QUIT
+2 IF $EXTRACT(AC,2)=2
SET PB=$PIECE(C0,"^",20)
IF PB=0
SET AC=AC_"0"
QUIT
+3 IF $EXTRACT(AC,2)=3
SET PB=$PIECE(C0,"^",20)
IF PB=2
SET AC=AC_"2"
QUIT
+4 SET OCC=$PIECE(C0,"^",17)
if OCC=""
SET OCC="*"
+5 if " 061056 061057 "[OCC
SET AC=AC_"T"
+6 if " 061071 061072 061080 061083 061084 "[OCC
SET AC=AC_"T"
+7 if " 060552 060556 "[OCC
SET AC=AC_"T"
QUIT
N SET ASS=$PIECE(C0,"^",4)
SET PB=$PIECE(C0,"^",20)
+1 ;The following check is for Public Law 108-170
+2 IF "^S^T^U^V^"[("^"_PMP_"^")
SET AC=AC_PMP
QUIT
+3 IF AC="N2E"
IF PB=0
SET AC=AC_"0"
QUIT
+4 IF $EXTRACT(AC,2)=3
IF PB="S"
SET AC=AC_"$"
QUIT
+5 SET OCC=$PIECE(C0,"^",17)
if OCC=""
SET OCC="*"
+6 ; Student Nurse Technician
IF OCC="069961"
SET AC=AC_"T"
QUIT
+7 ; Student Nurse Technician
IF OCC="069964"
SET AC=AC_"T"
QUIT
+8 SET AC=AC_$SELECT(ASS="TR":"T",ASS?1"T"1N:"T",ASS?1"A"1N:"T",1:"")
QUIT
P QUIT
Q IF $EXTRACT(AC,2)'=2
QUIT
+1 SET PB=$PIECE(C0,"^",20)
if PB=0
SET AC=AC_"0"
QUIT
R QUIT
S QUIT
T IF $EXTRACT(AC,2)'=3
QUIT
+1 SET PB=$PIECE(C0,"^",20)
if PB=9
SET AC=AC_"9"
QUIT
U SET PB=$PIECE(C0,"^",20)
IF $EXTRACT(AC,3)="N"
IF PB="P"
SET AC=AC_"P"
+1 QUIT
W QUIT
X if 'NH
SET AC=AC_"0"
QUIT
Y QUIT
+1 ;
+2 ;= = = = = = = = = = = = = = = = = = = = = = = =
FND ;Look up the 39 character entitlement string in the entitlement table
+1 ;The lookup is based on the AC x-ref that matches the AC variable that
+2 ;is built in this routine from the three 1 character codes from the
+3 ;450 fields (pay plan, duty basis, FLSA).
+4 ;
+5 SET A1=$ORDER(^PRST(457.5,"AC",AC,0))
+6 DO NO
+7 IF +A1
SET ENT=^PRST(457.5,A1,1)
+8 ; The following check was added to address the Hybrid employees
+9 ; defined in Public Law 107-135. These Hybrids do not have a
+10 ; Premium Pay Indicator but are entitled to Saturday and Sunday
+11 ; Premium Pay.
+12 IF $$HYBRID^PRSAENT1(DFN)
Begin DoDot:1
+13 SET $EXTRACT(ENT,8,9)="11"
End DoDot:1
+14 ;
+15 QUIT
+16 ;= = = = = = = = = = = = = = = = = = = = = = = =
NO SET ENT=""
+1 QUIT
+2 ;
MLINHRS(IEN) ;
+1 ;----------------------------------------------------------------------
+2 ; Determine if the employee is entitled to Military Leave in hours.
+3 ;
+4 ; Input Vars:
+5 ; IEN - the ien number of the employee in the PAID EMPLOYEE (#450)
+6 ; file.
+7 ;
+8 ; Local Vars:
+9 ; DATA - the 0 node of the employee from the PAID EMPLOYEE (#450)
+10 ; file.
+11 ; DB - Duty Basis field #9 from the #450 file.
+12 ; NH - Normal Hours field # 15 from the #450 file.
+13 ; PP - Pay Plan field # 20 from the #450 file.
+14 ;
+15 ; Output:
+16 ; 1 : Entitled to ML in hours.
+17 ; 0 : Entitled to ML in days.
+18 ; X : Some of the required fields were not defined or the employee
+19 ; is not entitled to Military Leave.
+20 ;----------------------------------------------------------------------
+21 ; Quit if no IEN passed in
+22 ;
+23 if '+IEN
QUIT "X"
+24 ;
+25 ; Verify that ENT is defined. If not call PRSAENT to define it.
+26 ;
+27 IF '$DATA(ENT)
DO PRSAENT
+28 ;
+29 ; Quit if the Entitlement string is not defined for the employee
+30 ;
+31 if ENT=""
QUIT "X"
+32 ;
+33 ; Quit if the employee is not entitled to Military Leave
+34 ;
+35 if '$EXTRACT(ENT,34)
QUIT "X"
+36 ;
+37 NEW DATA,PP,DB,NH
+38 SET DATA=$GET(^PRSPC(IEN,0))
+39 if DATA=""
QUIT "X"
+40 SET DB=$PIECE(DATA,U,10)
SET NH=$PIECE(DATA,U,16)
SET PP=$PIECE(DATA,U,21)
+41 ; Quit if DB or NH or PP is not defined.
if DB=""!(NH="")!(PP="")
QUIT "X"
+42 ;
+43 ; Check for ML in Days
+44 ;
+45 IF DB=1
IF NH=0
IF "^J^L^P^Q^X^"[PP
QUIT 0
+46 ;
+47 ; Otherwise the employee is entitled to ML in hours.
+48 ;
+49 QUIT 1
