source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8EX.m@ 836

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

revised back to 6/30/08 version

File size: 6.3 KB
Line 
1PRS8EX ;HISC/MRL,WCIOFO/SAB-DECOMPOSITION, EXCEPTIONS ;1/25/2007
2 ;;4.0;PAID;**2,40,56,69,111**;Sep 21, 1995;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;This routine is used to process most exceptions to the normal
6 ;tod. It is used, for example, to determine whether or not the
7 ;employee is entitled to such exceptions as Leave, OT, etc.,
8 ;and then calls ^PRS8AC to process them.
9 ;
10 ;Called by Routines: PRS8ST
11 ;
12 S TT=$P(V,"^",3) ;type of time
13 I TT="OT",+$P(V,"^",4)=8,$E(ENT,18) S TT="TT" ;ot in travel status
14 I TT="CU",$P(V,"^",4)=6 Q ;comp for religious purposes/don't code
15 I TT="HW",$E(ENT,1,2)="0D" S TT="RG"
16 I TT="OT",TYP["P",TYP'["B" S TT="RG" ;To convert Pt ot to RG
17 I TT="HW",TYP'["D",+V,+$P(V,"^",2) D
18 .I $P(V,"^",2)-V-1<8 D ; <2 hrs HW
19 ..S ^TMP($J,"PRS8",DY,"HW")=$G(^TMP($J,"PRS8",DY,"HW"))_$P(V,U,1,2)_U
20 ..Q
21 .I TYP["P",$P(V,"^",2)>96 S LEN=$P(V,"^",2)-96 D ;two day tour of HW for part timers
22 ..S ^TMP($J,"PRS8",DY+1,"HWK")=$G(^TMP($J,"PRS8",DY+1,"HWK"))_1_U_LEN_U
23 ..K LEN
24 ..Q
25 .I TYP["P",TYP["N"!(TYP["H"),'$E(DAY(DY,"W"),+V) D ; part time nurses, uscheduled HW.
26 ..S ^TMP($J,"PRS8",DY,"HWK")=$G(^TMP($J,"PRS8",DY,"HWK"))_$P(V,U,1,2)_U
27 ..Q
28 .Q
29 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" ;code
30 S X=($F(X,"^"_TT)\3)+4,(X,TT(1))=$P($T(ACT+X),";;",2) ;parameters
31 S GO=0 I '+X!($E(ENT,+X)) S GO=1 ;entitlement exists-continue
32 I TT="RG",$E(ENT,2)'=0 S GO=1 ;intermittent
33 I TT="RG"!(TT="CP"),$E(ENT,2)="D" S DAY(DY,"DWK")=1 ;intrmtnt-count days worked (for RG or CP)
34 I TT="OT",'GO,$E(ENT,13)!$E(ENT,14) S GO=1 ;entitled to ot
35 I TT="UN" S GO=1,VAR="-" ;unavailable
36 I TYP["W",TT="RG",$P(V,"^",4)=7 D
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 .N ST,EN,SD,MID
44 .S ST=$P(V,"^"),EN=$P(V,"^",2) Q:'ST!'EN
45 .S 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 . I ST=1 D
51 .. N PRSI,PRSX
52 .. S PRSX=$G(^TMP($J,"PRS8",DY-1,2))
53 .. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)="" D
54 ... 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
55 .; if end is 96 (midnight) then check next day for a similar tour that
56 .; starts at 1 (midnight).
57 . I EN=96 D
58 .. N PRSI,PRSX
59 .. S PRSX=$G(^TMP($J,"PRS8",DY+1,2))
60 .. F PRSI=1:1:7 Q:$P(PRSX,U,(PRSI-1)*4+1)="" D
61 ... 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
62 .; determine shift differential (if any) based on unscheduled tour hours
63 .S SD=0
64 .I MID<32.5 S SD=3 ; majority of tour before 8a
65 .I MID>60.5,MID'>94.5 S SD=2 ; majority of tour after 3p, upto 11:30p
66 .I MID>94.5,MID<128.5 S SD=3 ; majority of tour after 11:30p, before 8a
67 .; use employee's normal shift if higher than shift based on hours
68 .I TOUR>1,TOUR>SD S SD=TOUR
69 .S:SD ^TMP($J,"PRS8",DY,"SD")=$G(^TMP($J,"PRS8",DY,"SD"))_ST_U_EN_U_SD_U
70 .Q
71 I (TT="OT"!(TT="RG")!(TT="CT")),"^13^14^"[("^"_$P(V,"^",4)_"^")!($P(V,"^",4)=12&(TYP["N"!(TYP["H"))) D
72 .S ^TMP($J,"PRS8",DY,"CB")=$G(^TMP($J,"PRS8",DY,"CB"))_$P(V,"^",1,2)_"^"
73 .Q
74 I TYP'["D",TT="HX"!(TT="HW") S GO=1 ;process holiday excused/worked
75 G END:'GO ;nothing to process
76 I TT'="UN" S VAR=$P(X,"^",3) ;increment time code
77 I '$S(VAR'="W":1,'CYA:1,DY<CYA:1,1:0) D
78 .S WPCY=1 ;flag to save WOP in hours from 1/1 for calander year adjustment
79 I TYP'["D" D G END ;process hourly people and quit
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 .I DY>0,DY<15 D
88 ..; Post ML for employees who are charged in days.
89 ..I VAR="M",$$MLINHRS^PRSAENT(DFN)=0 D
90 ...S X=$P(TT(1),"^",4) D SET ; military leave & auth. absence
91 ..I VAR="V",'$G(^TMP($J,"PRS8",DY,"CP")) S X="M",^TMP($J,"PRS8",DY,"CP")=1 D SET ; COP
92 ..Q
93 .D ^PRS8AC ;update activity string
94 .Q
95 ; Employees with daily tours (TYP["D")
96 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
97 I DY>0,DY<15,$$HOLIDAY^PRS8UT(PY,DFN,DY) D G END ;holiday-no charge
98 .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.
99 .Q
100 S D=DY
101 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
102 D ENCAP^PRS8EX0
103 ;
104END ; --- all done here
105 K A,D,DD,GO,TT,X,Z
106 Q
107 ;
108SET ; --- enter here to set without VAL defined
109 ; Quit if this day has already been counted through the encapsulation
110 ; check that is performed in ENCAP^PRS8EX0.
111 Q:$D(^TMP($J,"PRS8",DY,2,0))
112 ;
113 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
114 I +X S $P(WK(WK),"^",+X)=$P(WK(WK),"^",+X)+1
115 E S X=$A(X)-64,$P(WK(3),"^",+X)=$P(WK(3),"^",+X)+1
116 Q
117 ;
118ACT ; --- define variable X for action
119 ; - piece 1 = entitlement (ENT) string $Extract to check
120 ; - 2 = Literal name of exception
121 ; - 3 = Time String code (DAY(X,"W"))
122 ;;
123 ;;30^Annual Leave^L^1
124 ;;31^Sick Leave^S^2
125 ;;33^Without Pay^W^3
126 ;;36^Non-Pay Status^n^4
127 ;;35^Authorized Absence^A^5
128 ;;30^Restored Leave^R^6
129 ;;28^Comp Used^U^8
130 ;;28^Comp Earned^E^7
131 ;;37^Continuation of Pay^V^33
132 ;;38^Holiday Excused^H
133 ;;34^Military Leave^M^K
134 ;;0^Training^X^43
135 ;;0^Travel^Y^42
136 ;;12^Overtime^O
137 ;;2^Unscheduled^4^9
138 ;;18^OT in Travel Status^T
139 ;;29^Standby^B
140 ;;26^On-Call^C
141 ;;36^Nonpay A/L^N^A
142 ;;38^Holiday Worked^h
143 ;;31^Care and Bereavement^F^44
144 ;;31^Adoption^G^45
145 ;;35^Donor Leave^D^46
Note: See TracBrowser for help on using the repository browser.