Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSAENT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSAENT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSAENT.m
r613 r623 1 PRSAENT ;HISC/MGD-Entitlement String ;10/21/04 2 ;;4.0;PAID;**6,21,45,69,75,76,90,96,112**;Sep 21, 1995;Build 54 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;VARS: 6 ; C0=employees 0 node of master record in file 450 7 ; NH= employees 8B normal hours 8 ; FLX= compressed/flextime code (0=none,C=compressed,F=flextime) 9 ; PMP= premium pay indicator 10 ; ( D = entitled Sun., F = entitled Sat./Sun., 11 ; E = entitled variable Sat./Sun. premium pay, 12 ; G = entitled variable Sun. prem pay 13 ; X = title 5 employees 14 ; R, C, O = 3 types of firefighters ) 15 ; AC= 3 single char codes concat. w/o delims + a possible 4th char. 16 ; AC= PP_DutyBasis(full-1,part-2,intermit-3)_FLSA(E=Exempt,N=NonExempt) 17 ; _(*EWXY8BT02S9P) 18 ; PP= employees pay plan (possible chars 0AEFGJKLMNPQRSTUWXY) 19 ; PB= pay basis-code for time condition for computing pay. 20 ; TA= type of appointment (career, career conditional, etc.) 21 ; OCC= 4 digit cost center for fund appropriation accounting 22 ; LVG= one digit code for employees leave group. 23 ; ASS= specialty assignment of physicians,dentists, nurses, 24 ; summer employees,trainees and other special programs. 25 ; ENT= 39 character entitlement string 26 ; PMP = Premium Pay Code 27 ; 28 N PAYPDTMP,PPLOLD,DUTYTEMP,FLSATEMP 29 ; 30 S C0=^PRSPC(DFN,0) 31 ; 32 ; pay plan in master record. 33 S PP=$P(C0,"^",21) 34 ; 35 ;===================================================================== 36 ; duty basis from master record 37 S DUTYTEMP=$P(C0,"^",10) 38 ; 39 ; FLSA indicator from master record 40 S FLSATEMP=$P(C0,"^",12) 41 ; 42 ;Make sure we've called this routine from an entry point that uses 43 ;PY for pay period. A few reports, call PRSAENT from TYPSTF^PRSRUT0 44 ;and the reports aren't concerned about differing pay plans from 45 ;other pay periods. 46 ; 47 I +($G(PY))>0 D 48 .S PAYPDTMP=$P($G(^PRST(458,+PY,0)),"^") ;pay period we're working with. 49 .S PPLOLD=$$OLDPP^PRS8UT(PAYPDTMP,+DFN) ;pay plan from PAYPDTMP. 50 .;if we find an old pay plan and it's different than the master record 51 .;use the old pay plan to determine VCS or FEE. 52 .I PPLOLD'=0,(PP'=PPLOLD) D 53 .. S PP=PPLOLD 54 .. S DUTYTEMP=OLDPP("DUTYBS") 55 ;===================================================================== 56 ; 57 ; Numeric Pay plans are all Wage grade. Set them to 0. 58 S:PP?1N PP=0 59 ; 60 ; 61 S:"BC"[PP PP="A" 62 I "0AEFGJKLMNPQRSTUWXY"'[PP D NO Q 63 S NH=+$P(C0,"^",16) 64 S FLX=$P($G(^PRSPC(DFN,1)),"^",7) 65 S PMP=$P($G(^PRSPC(DFN,"PREMIUM")),"^",6) 66 S AC=PP_DUTYTEMP_FLSATEMP 67 I $L(AC)'=3 D NO Q 68 ; 69 ; 70 D @PP 71 D FND 72 Q 73 ;=========================================================== 74 ; 75 0 Q 76 ; 77 A ;patch 45: firefighters entitlements are based on PMP Codes. 78 ; Code O still uses nh>80 to determine entitlement. 79 I "RC"[PMP S AC=AC_PMP Q 80 ; 81 ;This check does not concern itself with whether or not a code 82 ; O is present. Simply if not a code R or C then an over 80 83 ; must be a code O firefighter under the rules implemented in 84 ; patch 45. 85 ; 86 I "CR"'[PMP,NH>80 S AC=AC_"*" Q 87 ; 88 Q:PMP="" 89 I $E(AC,2)'=3,"WXY"[PMP S AC=AC_PMP Q 90 S:"EF"[PMP AC=AC_"E" 91 ;The following check is for Public Law 108-170 92 S:"STUV"[PMP AC=AC_PMP 93 Q 94 E Q 95 F Q 96 G I $E(AC,2)<3 Q 97 S TA=$P(C0,"^",43) S:TA=8 AC=AC_"8" Q 98 J Q 99 K S:NH=48 AC=AC_"B" Q 100 L I $E(AC,2)=2 S PB=$P(C0,"^",20) S:PB=0 AC=AC_"*" Q 101 I $E(AC,2)=3 S OCC=$P(C0,"^",17),OCC=+$E(OCC,5,6) S:OCC>20&(OCC<38) AC=AC_"*" Q 102 S LVG=$P(C0,"^",15) S:LVG=5 AC=AC_"*" Q 103 M I $E(AC,2)=1,NH=48 S AC=AC_"B" Q 104 I $E(AC,2)=2,NH=80 S AC=AC_"R" Q 105 I $E(AC,2)=2 S PB=$P(C0,"^",20) I PB=0 S AC=AC_"0" Q 106 I $E(AC,2)=3 S PB=$P(C0,"^",20) I PB=2 S AC=AC_"2" Q 107 S OCC=$P(C0,"^",17) S:OCC="" OCC="*" 108 S:" 061056 061057 "[OCC AC=AC_"T" 109 S:" 061071 061072 061080 061083 061084 "[OCC AC=AC_"T" 110 S:" 060552 060556 "[OCC AC=AC_"T" Q 111 N S ASS=$P(C0,"^",4),PB=$P(C0,"^",20) 112 ;The following check is for Public Law 108-170 113 I "^S^T^U^V^"[("^"_PMP_"^") S AC=AC_PMP Q 114 I AC="N2E",PB=0 S AC=AC_"0" Q 115 I $E(AC,2)=3,PB="S" S AC=AC_"$" Q 116 S OCC=$P(C0,"^",17) S:OCC="" OCC="*" 117 I OCC="069961" S AC=AC_"T" Q ; Student Nurse Technician 118 I OCC="069964" S AC=AC_"T" Q ; Student Nurse Technician 119 S AC=AC_$S(ASS="TR":"T",ASS?1"T"1N:"T",ASS?1"A"1N:"T",1:"") Q 120 P Q 121 Q I $E(AC,2)'=2 Q 122 S PB=$P(C0,"^",20) S:PB=0 AC=AC_"0" Q 123 R Q 124 S Q 125 T I $E(AC,2)'=3 Q 126 S PB=$P(C0,"^",20) S:PB=9 AC=AC_"9" Q 127 U S PB=$P(C0,"^",20) I $E(AC,3)="N",PB="P" S AC=AC_"P" 128 Q 129 W Q 130 X S:'NH AC=AC_"0" Q 131 Y Q 132 ; 133 ;= = = = = = = = = = = = = = = = = = = = = = = = 134 FND ;Look up the 39 character entitlement string in the entitlement table 135 ;The lookup is based on the AC x-ref that matches the AC variable that 136 ;is built in this routine from the three 1 character codes from the 137 ;450 fields (pay plan, duty basis, FLSA). 138 ; 139 S A1=$O(^PRST(457.5,"AC",AC,0)) 140 D NO 141 I +A1 S ENT=^PRST(457.5,A1,1) 142 ; The following check was added to address the Hybrid employees 143 ; defined in Public Law 107-135. These Hybrids do not have a 144 ; Premium Pay Indicator but are entitled to Saturday and Sunday 145 ; Premium Pay. 146 I $$HYBRID^PRSAENT1(DFN) D 147 . S $E(ENT,8,9)="11" 148 ; 149 Q 150 ;= = = = = = = = = = = = = = = = = = = = = = = = 151 NO S ENT="" 152 Q 153 ; 154 MLINHRS(IEN) ; 155 ;---------------------------------------------------------------------- 156 ; Determine if the employee is entitled to Military Leave in hours. 157 ; 158 ; Input Vars: 159 ; IEN - the ien number of the employee in the PAID EMPLOYEE (#450) 160 ; file. 161 ; 162 ; Local Vars: 163 ; DATA - the 0 node of the employee from the PAID EMPLOYEE (#450) 164 ; file. 165 ; DB - Duty Basis field #9 from the #450 file. 166 ; NH - Normal Hours field # 15 from the #450 file. 167 ; PP - Pay Plan field # 20 from the #450 file. 168 ; 169 ; Output: 170 ; 1 : Entitled to ML in hours. 171 ; 0 : Entitled to ML in days. 172 ; X : Some of the required fields were not defined or the employee 173 ; is not entitled to Military Leave. 174 ;---------------------------------------------------------------------- 175 ; Quit if no IEN passed in 176 ; 177 Q:'+IEN "X" 178 ; 179 ; Verify that ENT is defined. If not call PRSAENT to define it. 180 ; 181 I '$D(ENT) D PRSAENT 182 ; 183 ; Quit if the Entitlement string is not defined for the employee 184 ; 185 Q:ENT="" "X" 186 ; 187 ; Quit if the employee is not entitled to Military Leave 188 ; 189 Q:'$E(ENT,34) "X" 190 ; 191 N DATA,PP,DB,NH 192 S DATA=$G(^PRSPC(IEN,0)) 193 Q:DATA="" "X" 194 S DB=$P(DATA,U,10),NH=$P(DATA,U,16),PP=$P(DATA,U,21) 195 Q:DB=""!(NH="")!(PP="") "X" ; Quit if DB or NH or PP is not defined. 196 ; 197 ; Check for ML in Days 198 ; 199 I DB=1,NH=0,"^J^L^P^Q^X^"[PP Q 0 200 ; 201 ; Otherwise the employee is entitled to ML in hours. 202 ; 203 Q 1 1 PRSAENT ;HISC/MGD-Entitlement String ;10/21/04 2 ;;4.0;PAID;**6,21,45,69,75,76,90,96**;Sep 21, 1995 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 N PAYPDTMP,PPLOLD,DUTYTEMP,FLSATEMP 28 ; 29 S C0=^PRSPC(DFN,0) 30 ; 31 ; pay plan in master record. 32 S PP=$P(C0,"^",21) 33 ; 34 ;===================================================================== 35 ; duty basis from master record 36 S DUTYTEMP=$P(C0,"^",10) 37 ; 38 ; FLSA indicator from master record 39 S FLSATEMP=$P(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 I +($G(PY))>0 D 47 .S PAYPDTMP=$P($G(^PRST(458,+PY,0)),"^") ;pay period we're working with. 48 .S PPLOLD=$$OLDPP^PRS8UT(PAYPDTMP,+DFN) ;pay plan from PAYPDTMP. 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 .I PPLOLD'=0,(PP'=PPLOLD) D 52 .. S PP=PPLOLD 53 .. S DUTYTEMP=OLDPP("DUTYBS") 54 ;===================================================================== 55 ; 56 ; Numeric Pay plans are all Wage grade. Set them to 0. 57 S:PP?1N PP=0 58 ; 59 ; 60 S:"BC"[PP PP="A" 61 I "0AEFGJKLMNPQRSTUWXY"'[PP D NO Q 62 S NH=+$P(C0,"^",16) 63 S FLX=$P($G(^PRSPC(DFN,1)),"^",7) 64 S PMP=$P($G(^PRSPC(DFN,"PREMIUM")),"^",6) 65 S AC=PP_DUTYTEMP_FLSATEMP 66 I $L(AC)'=3 D NO Q 67 ; 68 ; 69 D @PP 70 D FND 71 Q 72 ;=========================================================== 73 ; 74 0 Q 75 ; 76 A ;patch 45: firefighters entitlements are based on PMP Codes. 77 ; Code O still uses nh>80 to determine entitlement. 78 I "RC"[PMP S AC=AC_PMP Q 79 ; 80 ;This check does not concern itself with whether or not a code 81 ; O is present. Simply if not a code R or C then an over 80 82 ; must be a code O firefighter under the rules implemented in 83 ; patch 45. 84 ; 85 I "CR"'[PMP,NH>80 S AC=AC_"*" Q 86 ; 87 Q:PMP="" 88 I $E(AC,2)'=3,"WXY"[PMP S AC=AC_PMP Q 89 S:"EF"[PMP AC=AC_"E" 90 ;The following check is for Public Law 108-170 91 S:"STUV"[PMP AC=AC_PMP 92 Q 93 E Q 94 F Q 95 G I $E(AC,2)<3 Q 96 S TA=$P(C0,"^",43) S:TA=8 AC=AC_"8" Q 97 J Q 98 K S:NH=48 AC=AC_"B" Q 99 L I $E(AC,2)=2 S PB=$P(C0,"^",20) S:PB=0 AC=AC_"*" Q 100 I $E(AC,2)=3 S OCC=$P(C0,"^",17),OCC=+$E(OCC,5,6) S:OCC>20&(OCC<38) AC=AC_"*" Q 101 S LVG=$P(C0,"^",15) S:LVG=5 AC=AC_"*" Q 102 M I $E(AC,2)=1,NH=48 S AC=AC_"B" Q 103 I $E(AC,2)=2 S PB=$P(C0,"^",20) I PB=0 S AC=AC_"0" Q 104 I $E(AC,2)=3 S PB=$P(C0,"^",20) I PB=2 S AC=AC_"2" Q 105 S OCC=$P(C0,"^",17) S:OCC="" OCC="*" 106 S:" 061056 061057 "[OCC AC=AC_"T" 107 S:" 061071 061072 061080 061083 061084 "[OCC AC=AC_"T" 108 S:" 060552 060556 "[OCC AC=AC_"T" Q 109 N S ASS=$P(C0,"^",4),PB=$P(C0,"^",20) 110 ;The following check is for Public Law 108-170 111 I "^S^T^U^V^"[("^"_PMP_"^") S AC=AC_PMP Q 112 I AC="N2E",PB=0 S AC=AC_"0" Q 113 I $E(AC,2)=3,PB="S" S AC=AC_"$" Q 114 S OCC=$P(C0,"^",17) S:OCC="" OCC="*" 115 I OCC="069961" S AC=AC_"T" Q ; Student Nurse Technician 116 I OCC="069964" S AC=AC_"T" Q ; Student Nurse Technician 117 S AC=AC_$S(ASS="TR":"T",ASS?1"T"1N:"T",ASS?1"A"1N:"T",1:"") Q 118 P Q 119 Q I $E(AC,2)'=2 Q 120 S PB=$P(C0,"^",20) S:PB=0 AC=AC_"0" Q 121 R Q 122 S Q 123 T I $E(AC,2)'=3 Q 124 S PB=$P(C0,"^",20) S:PB=9 AC=AC_"9" Q 125 U S PB=$P(C0,"^",20) I $E(AC,3)="N",PB="P" S AC=AC_"P" 126 Q 127 W Q 128 X S:'NH AC=AC_"0" Q 129 Y Q 130 ; 131 ;= = = = = = = = = = = = = = = = = = = = = = = = 132 FND ;Look up the 39 character entitlement string in the entitlement table 133 ;The lookup is based on the AC x-ref that matches the AC variable that 134 ;is built in this routine from the three 1 character codes from the 135 ;450 fields (pay plan, duty basis, FLSA). 136 ; 137 S A1=$O(^PRST(457.5,"AC",AC,0)) 138 D NO 139 I +A1 S ENT=^PRST(457.5,A1,1) 140 ; The following check was added to address the Hybrid employees 141 ; defined in Public Law 107-135. These Hybrids do not have a 142 ; Premium Pay Indicator but are entitled to Saturday and Sunday 143 ; Premium Pay. 144 I $$HYBRID^PRSAENT1(DFN) D 145 . S $E(ENT,8,9)="11" 146 ; 147 Q 148 ;= = = = = = = = = = = = = = = = = = = = = = = = 149 NO S ENT="" 150 Q 151 ; 152 MLINHRS(IEN) ; 153 ;---------------------------------------------------------------------- 154 ; Determine if the employee is entitled to Military Leave in hours. 155 ; 156 ; Input Vars: 157 ; IEN - the ien number of the employee in the PAID EMPLOYEE (#450) 158 ; file. 159 ; 160 ; Local Vars: 161 ; DATA - the 0 node of the employee from the PAID EMPLOYEE (#450) 162 ; file. 163 ; DB - Duty Basis field #9 from the #450 file. 164 ; NH - Normal Hours field # 15 from the #450 file. 165 ; PP - Pay Plan field # 20 from the #450 file. 166 ; 167 ; Output: 168 ; 1 : Entitled to ML in hours. 169 ; 0 : Entitled to ML in days. 170 ; X : Some of the required fields were not defined or the employee 171 ; is not entitled to Military Leave. 172 ;---------------------------------------------------------------------- 173 ; Quit if no IEN passed in 174 ; 175 Q:'+IEN "X" 176 ; 177 ; Verify that ENT is defined. If not call PRSAENT to define it. 178 ; 179 I '$D(ENT) D PRSAENT 180 ; 181 ; Quit if the Entitlement string is not defined for the employee 182 ; 183 Q:ENT="" "X" 184 ; 185 ; Quit if the employee is not entitled to Military Leave 186 ; 187 Q:'$E(ENT,34) "X" 188 ; 189 N DATA,PP,DB,NH 190 S DATA=$G(^PRSPC(IEN,0)) 191 Q:DATA="" "X" 192 S DB=$P(DATA,U,10),NH=$P(DATA,U,16),PP=$P(DATA,U,21) 193 Q:DB=""!(NH="")!(PP="") "X" ; Quit if DB or NH or PP is not defined. 194 ; 195 ; Check for ML in Days 196 ; 197 I DB=1,NH=0,"^J^L^P^Q^X^"[PP Q 0 198 ; 199 ; Otherwise the employee is entitled to ML in hours. 200 ; 201 Q 1
Note:
See TracChangeset
for help on using the changeset viewer.
