source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8WE.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.8 KB
Line 
1PRS8WE ;HISC/MRL,WCIOFO/MGD-DECOMPOSITION, WEEKEND PREMIUM ;09/23/04
2 ;;4.0;PAID;**42,65,74,75,90,92,96**;Sep 21, 1995
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 N DAY,HYBRID,SAT2DT,SATNOSUN
10 S HYBRID=$S(+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 S SATNOSUN=$S($E(ENT,8,9)="10":1,1:0)
16 ;
17 ; Compute Sunday Premium Pay. Check SATNOSUN employees
18 I $E(ENT,9)!(TYP["B")!(HYBRID)!(SATNOSUN) F DAY=1,8,15 D WPD
19 ;
20 ; Compute Saturday Premium Pay
21 I $E(ENT,8)!(TYP["B")!(HYBRID) F DAY=7,14 D WPD
22 ;
23 Q
24 ;
25WPD ; Weekend Premium for Day
26 ; input
27 ; DAY - day in pay period (1,7,8,14, or 15)
28 ; SAT2DT(day) - if defined for day, it equals the time segment (1-96)
29 ; just before the start of a 2-day tour that begins on
30 ; a Saturday and has already received Sunday premium.
31 ; Defined during computation of Sunday premiums and
32 ; used during computation of Saturday premiums to
33 ; prevent payment of both premiums for same period.
34 ; TYP, ENT, etc...
35 ; output
36 ; WK()
37 ;
38 N AV,D,END,H,M,P,TP,TV
39 ;
40 ; determine type of weekend premium.
41 S TP=$S("^7^14^"[(U_DAY_U):"SAT","^1^8^15^"[(U_DAY_U):"SUN",1:"")
42 Q:TP="" ; invalid day (must be Sat. or Sun.)
43 ;
44 ; determine types of time in a 'tour'
45 S TV=$$TV
46 ;
47 ; determine types of time that might be eligible for premium
48 S AV=$$AV
49 ;
50 ; load info for day
51 S D(DAY)=$G(^TMP($J,"PRS8",DAY,"W"))
52 Q:D(DAY)?1"0"."0" ; no activity on day
53 S P(DAY)=$G(^TMP($J,"PRS8",DAY,"P"))
54 S H(DAY)=$G(^TMP($J,"PRS8",DAY,"HOL"))
55 ;
56 ; loop thru activity string to find start of 'tour'
57 S M=1
58 S END=$S($G(SAT2DT(DAY))>0:SAT2DT(DAY),1:96)
59 F D Q:M=END S M=M+1
60 . I TV'[$E(D(DAY),M),$E(H(DAY),M)'=2 Q
61 . ; found start of a 'tour'
62 . ; loop thru 'tour' activity and count the premium
63 . N CNT
64 . ;
65 . ; if the 'tour' starts at beginning of day then check if it is part
66 . ; of a 2-day 'tour' that actually started on the previous day
67 . I DAY>1,M=1 D
68 . . N CLASS,DYP,Z
69 . . S CLASS=$$CTS($E(D(DAY),M),$E(H(DAY),M))
70 . . S DYP=DAY-1
71 . . S D(DYP)=$G(^TMP($J,"PRS8",DYP,"W"))
72 . . S P(DYP)=$G(^TMP($J,"PRS8",DYP,"P"))
73 . . S H(DYP)=$G(^TMP($J,"PRS8",DYP,"HOL"))
74 . . Q:$$CTS($E(D(DYP),96),$E(H(DYP),96))'=CLASS ; not same 'tour'
75 . . ; Hybrids defined by Public Law P.L. 107-135 only get Saturday
76 . . ; or Sunday premium for CT/OT/UN worked on Saturday or Sunday
77 . . Q:HYBRID&(TP="SAT")&($$CTS($E(D(DYP),96),$E(H(DYP),96))="X")
78 . . I CLASS="R",'$$TDT(DYP) Q ; can't be same scheduled tour
79 . . ; If SATNOSUN and the day is a Sunday quit
80 . . Q:SATNOSUN&("^1^8^15^"[(U_DAY_U))
81 . . ; loop backward from midnight thru previous day's portion of tour
82 . . S Z=96
83 . . F D Q:Z=1 S Z=Z-1 Q:$$CTS($E(D(DYP),Z),$E(H(DYP),Z))'=CLASS
84 . . . I AV[$E(D(DYP),Z)!($E(D(DYP),Z)="O"&($E(H(DYP),Z)=2)) D COUNT^PRS8WE2(DYP,Z)
85 . . ; if Sun. premium then save Z to avoid recount of these Sat. hours
86 . . ; when/if Sat. premium is calculated
87 . . ;
88 . . I TP="SUN" S SAT2DT(DYP)=Z
89 . ;
90 . ; If SATNOSUN and tour crossed mid onto Sunday set TP=SAT
91 . I M=1&("^1^8^"[(U_DAY_U)),SATNOSUN D
92 . . I AV[$E($G(^TMP($J,"PRS8",DAY-1,"W")),96) S TP="SAT"
93 . ;
94 . ; loop forward thru current day's portion of tour
95 . I DAY<15 F D Q:M=END S M=M+1 Q:TV'[$E(D(DAY),M)&($E(H(DAY),M)'=2)
96 . . I AV[$E(D(DAY),M)!($E(D(DAY),M)="O"&($E(H(DAY),M)=2)) D COUNT^PRS8WE2(DAY,M)
97 . . ;
98 . . ; If checking for SATNOSUN quit when tour crossing midnight ends
99 . . I SATNOSUN&(TP="SAT")&("^1^8^15^"[(U_DAY_U))&(AV'[$E(D(DAY),M+1)) D SAVE^PRS8WE2 S M=END Q
100 . ;
101 . ; If counting Sat Prem for SATNOSUN and Day is a Sunday there is no
102 . ; need to check for the tour crossing midnight onto Monday
103 . Q:SATNOSUN&(TP="SAT")&("^1^8^15^"[(U_DAY_U))
104 . ;
105 . ; If SATNOSUN and DAY=14 and M<96 check remainder of tour for work
106 . I SATNOSUN&(DAY=14)&(M<96) D
107 . . F M=M:1:96 D
108 . . . I AV[$E(D(DAY),M)!($E(D(DAY),M)="O"&($E(H(DAY),M)=2)) D COUNT^PRS8WE2(DAY,M)
109 . ;
110 . ; If tour lasted until end of day then check if it is part of
111 . ; a 2-day tour that extends into next day
112 . I DAY<15,M=96,'SATNOSUN,(TV[$E(D(DAY),M))!($E(H(DAY),M)=2) D
113 . . N CLASS,DYN,Z
114 . . S CLASS=$$CTS($E(D(DAY),96),$E(H(DAY),96))
115 . . S DYN=DAY+1
116 . . S D(DYN)=$G(^TMP($J,"PRS8",DYN,"W"))
117 . . S P(DYN)=$G(^TMP($J,"PRS8",DYN,"P"))
118 . . S H(DYN)=$G(^TMP($J,"PRS8",DYN,"HOL"))
119 . . Q:$$CTS($E(D(DYN),1),$E(H(DYN),1))'=CLASS ; not same 'tour'
120 . . ; Hybrids defined by Public Law P.L. 107-135 only get Saturday
121 . . ; or Sunday premium for CT/OT/UN worked on Saturday or Sunday
122 . . Q:HYBRID&(TP="SUN")&($$CTS($E(D(DYN),1),$E(H(DYN),1))="X")
123 . . I CLASS="R",'$$TDT(DAY) Q ; can't be same scheduled tour
124 . . ; loop forward from midnight thru next day's portion of tour
125 . . S Z=1
126 . . F D Q:Z=96 S Z=Z+1 Q:$$CTS($E(D(DYN),Z),$E(H(DYN),Z))'=CLASS
127 . . . I AV[$E(D(DYN),Z)!($E(D(DYN),Z)="O"&($E(H(DYN),Z)=2)) D COUNT^PRS8WE2(DYN,Z)
128 . ;
129 . ; post premium time for tour to WK()
130 . D SAVE^PRS8WE2
131 Q
132 ;
133TV() ; List types of time in a 'tour'
134 N PRSX
135 ; for regular time
136 S PRSX="LRSFGDUAJMWNnVH1234XYm"
137 ; for OT/CT
138 S PRSX=PRSX_$S(TYP["B":"EeOs",TYP["N"!(TYP["H"):"EetOoscbT",1:"")
139 I HYBRID S PRSX=PRSX_"EetOoscbT"
140 ; for employees covered by PL 108-170
141 I PMP'=""&("^S^T^U^V^"[(U_PMP_U)) D
142 . I $E(ENT,28),PRSX'["Eet" S PRSX=PRSX_"Eet"
143 . I $E(ENT,12),PRSX'["Oos" S PRSX=PRSX_"Oos"
144 . I $E(ENT,17),PRSX'["c" S PRSX=PRSX_"c"
145 . I $E(ENT,29),PRSX'["b" S PRSX=PRSX_"b"
146 . I $E(ENT,18),PRSX'["T" S PRSX=PRSX_"T"
147 Q PRSX
148 ;
149AV() ; List types of time that might be eligible for premium pay
150 N PRSX
151 ; for regular time
152 S PRSX=$S(TYP["B":"",1:"1234XY")
153 ; for OT/CT
154 S PRSX=PRSX_$S(TYP["B":"EeOos",TYP["N"!(TYP["H"):"EeOosc",1:"")
155 I HYBRID S PRSX=PRSX_"EeOosc"
156 ; for employees covered by PL 108-170
157 I PMP'=""&("^S^T^U^V^"[(U_PMP_U)) D
158 . I $E(ENT,28),PRSX'["Ee" S PRSX=PRSX_"Ee"
159 . I $E(ENT,12),PRSX'["Oos" S PRSX=PRSX_"Oos"
160 . I $E(ENT,17),PRSX'["c" S PRSX=PRSX_"c"
161 Q PRSX
162 ;
163CTS(XW,XH) ; Return class of a time segment
164 ; input XW = type of time in activity ("W") string
165 ; XH = value in holiday ("H") string
166 ; returns class
167 ; "R" regular scheduled
168 ; "X" extra (ot/ct) or unscheduled reg.
169 ; "N" not worked (includes on-call, standby when not called back)
170 Q $S(("LRSFGDUAJMWNnVH123XYm"[XW)!((XW="O")&(XH=2)):"R",("EetscbT4"[XW)!((XW="O")&(XH'=2)):"X",1:"N")
171 ;
172TDT(DAYN) ; Two-Day Tour extrinsic variable
173 ; input
174 ; DAYN = day # (0-15) being checked for at least one sch. 2-day tour
175 ; returns 0 (false) or 1 (true)
176 N RET
177 S RET=0 ; assume no scheduled 2-day tour of duty
178 S X=$G(^TMP($J,"PRS8",DAYN,0))
179 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
180 Q RET
181 ;
182 ;PRS8WE
Note: See TracBrowser for help on using the repository browser.