- 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 Jan 18, 2025@03:24:38 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