source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8OC.m@ 1789

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

revised back to 6/30/08 version

File size: 5.4 KB
Line 
1PRS8OC ;HISC/MGD-DECOMPOSITION, ON-CALL ;02/17/04
2 ;;4.0;PAID;**63,92**;Sep 21, 1995
3 ;
4 ;The following MUMPS code is used to credit the appropriate
5 ;categories on the timecard for work performed while On-Call.
6 ;All hours during which an individual is identified as being
7 ;On-Call are credited to blocks YD and YH (On Call Hrs) on
8 ;the timecard. Hours during an On-Call episode where an
9 ;individual is actually called in to perform work are credited
10 ;to blocks YA and YE (Sch CB OT) as appropriate. This credit
11 ;is given under the 2-hour minimum rule. When OT work is
12 ;performed during On-Call the actual On-Call Hours reported
13 ;are reduced by the ACTUAL number of hours worked (not by the
14 ;2-hour minimum).
15 ;
16 ;Called by Routines: PRS8ST
17 ;
18 ;C = On-Call
19 ;c = OT during OC
20 ;t = CT during OC
21 ;
22 S (I,D)=$S(T'>96:DAY,1:(DAY+1))
23 S OC=$G(OC),OC(DAY)=$G(OC(DAY)),OC(DAY+1)=$G(OC(DAY+1)) ;oc variables
24 S CC=$G(CC),CC(DAY)=$G(CC(DAY)),CC(DAY+1)=$G(CC(DAY+1)) ;CT on OC count
25 S Y=35,Y(1)=1 D SET
26 I VAR1="C" D:OC!(CC) OCS ;on-call episode (ot OR ct)
27 S:"ct"[VAR1 OC=OC+1,OC(D)=OC(D)+1 S:VAR1="t" CC=CC+1,CC(D)=CC(D)+1
28 I "ct"[VAR1,DAY>0,DAY<15 S CBCK(WK)=CBCK(WK)+1 ;count actual CB hrs
29 Q:'OK!('$D(OC))
30 I OC S Y=23 D OCS ;get rest of them
31 K OC,CC,Y,D Q
32 ;
33OCS ; --- set On-Call minimum hours
34 ;set YA/YE for PPI="W" or "V" else set OT
35 S Y=$S(CC:7,'DOUB:TOUR+19,1:23)
36 N X,Z,DD,TT,CCCNT,NEXTT,OCCNT,TIMECNT
37 S TT=$S(T>96:T-96,1:T),TIMECNT=0
38 S X=$E(DAY($S(T>96:DAY+1,1:DAY),"W"),TT)
39 ;
40 ; If the current segment is the last of the On-Call OR the last of
41 ; the On-Call Callback and the next time segment is Unavailable ("-")
42 ; or not a type of work ("0") check to see if OT/reg sched is prior
43 ; to on call worked.
44 ;
45 S NEXTT=$S(T+1>96:T-95,1:TT+1) ; Next time segment
46 I "C"[X!(("ct"[X)&("-0"[$E($S(T+1>96:DAY(DAY+1,"W"),1:DAY(DAY,"W")),NEXTT))) D
47 .K XH S X=0 F Z=1:1:8-(OC(DAY)+$G(OC(DAY+1))) D Q:"01"[X
48 ..S DD=OC(DAY)+OC(DAY+1)+Z
49 ..I TT-DD>0 S X=$E(DAY(DAY,"W"),TT-DD) S:X="O"&($E(DAY(DAY,"HOL"),TT-DD)=2) X="h"
50 ..E S X=$E(DAY(DAY-1,"W"),96+T-DD) S:X="O"&($E(DAY(DAY-1,"HOL"),96+T-DD)=2) X="h"
51 ..I "123nHMLSWNARXYFGD"[X S X=1 Q ; on call abuts a reg sched TOD.
52 ..E I "EOhoscte"[X D ; on call abuts time worked outside posted TOD.
53 ...I "ct"'[X S TIMECNT=TIMECNT+1 ; Time already counted in WK().
54 ...S XH=$S(X'="h":0,1:1),X=2
55 ..E S X=0
56 ..Q
57 .Q
58 E D ; Check to see if OT/reg sched is after on call worked
59 .K XH S X=0 F Z=1:1:8-(OC(DAY)+$G(OC(DAY+1))) D Q:"01"[X
60 ..S DD=OC(DAY)+OC(DAY+1)+Z
61 ..I T+Z'>96 S X=$E(DAY(DAY,"W"),T+Z) S:X="O"&($E(DAY(DAY,"HOL"),T+Z)=2) X="h"
62 ..E S X=$E(DAY(DAY+1,"W"),T-96+Z) S:X="O"&($E(DAY(DAY+1,"HOL"),T-96+Z)=2) X="h"
63 ..I "123nHMLSWNARXYFGD"[X S X=1 Q ; on call abuts a reg sched TOD.
64 ..E I "EOhoscte"[X D
65 ...I "ct"'[X S TIMECNT=TIMECNT+1 ; Time already counted in WK().
66 ...S XH=$S(X'="h":0,1:1),X=2
67 ..E S X=0
68 ..Q
69 .Q
70 I $G(XH)'="" S:XH=1!'X Z=Z-1,X=2
71 ;
72 ; Check if Scheduled Call-Back OT crosses Midnight
73 ;
74 I '$D(CRSMID(D)),$E(DAY(DAY,"W"),1)="c",$E(DAY(DAY-1,"W"),96)="c" S FG=0 D Q:FG=1
75 .S CRSMID(D)=1
76 .I OC<7 D Q:FG=1
77 ..; crosses midnight, check if its <2 hours, CRSMID variable set to
78 ..; only do on segment that cross mid, not others
79 ..S CNTR=0 F CX=1:1:8-OC S:$E(DAY(DAY-1,"W"),97-CX)="c" CNTR=CNTR+1
80 ..I OC+CNTR'>8 D
81 ...S Y(1)=$S(X=1:OC,1:8-CNTR)
82 ...D CHOL
83 ...S (OC,OC(D),CC,CC(D))=0,FG=1
84 ..Q
85 ;
86 ; Check if Comp Time crosses Midnight
87 ;
88 I '$D(CRSMID(D)),$E(DAY(DAY,"W"),1)="t",$E(DAY(DAY-1,"W"),96)="t" S FG=0 D Q:FG=1
89 .S CRSMID(D)=1
90 .I OC<7 D Q:FG=1
91 ..; crosses midnight, check if its <2 hours, CRSMID variable set to
92 ..; only do on segment that cross mid, not others
93 ..S CNTR=0 F CX=1:1:8-OC S:$E(DAY(DAY-1,"W"),97-CX)="t" CNTR=CNTR+1
94 ..I OC+CNTR'>8 D
95 ...S Y(1)=$S(X=1:OC,1:8-CNTR)
96 ...D CHOL
97 ...S (OC,OC(D),CC,CC(D))=0,FG=1
98 ..Q
99 ;
100 I CC>0,CC<OC D ;SPLIT SEGMENT, MUST DO TWICE (FOR CT THEN FOR OT)
101 .F I=DAY:1:(DAY+1) I OC(I) D
102 ..S (OCCNT,CCCNT)=0
103 ..I X=2,OC(I)+TIMECNT<8 D ; Add time if 2 hour minimum was not met.
104 ...S TIMECNT=8-OC(I)-TIMECNT ; Amount of time short of the 2 hour min.
105 ...;
106 ...; If TIMECNT is an even number divide needed time equally among the
107 ...; CT and OT.
108 ...I TIMECNT#2=0 S CCCNT=TIMECNT/2,OCCNT=TIMECNT/2
109 ...;
110 ...; If TIMECNT is not an even number divide the time needed as equally
111 ...; as possible among the CT and OT w/ remaining 15 minutes going to OC.
112 ...I TIMECNT#2=1 S CCCNT=TIMECNT\2,OCCNT=(TIMECNT\2)+1
113 ...;
114 ..S Y(1)=$S(X=2:CC(I)+CCCNT,X:CC(I),OC(I)>7:CC(I),1:4),Y=7
115 ..D CHOL
116 ..S Y(1)=$S(X=2:OC(I)-CC(I)+OCCNT,X:OC(I)-CC(I),OC(I)>7:OC(I)-CC(I),1:4)
117 ..S Y=$S('DOUB:TOUR+19,1:23)
118 ..D CHOL
119 ..Q
120 .Q
121 E D ;NOT SPLIT SEGMENT
122 .F I=DAY:1:(DAY+1) I OC(I) D
123 ..I OC(I)<8,X=2 D
124 ...I T'=96 S OC(I)=8-TIMECNT
125 ...I T=96,"ct"'[$E(DAY(DAY+1,"W"),1) S OC(I)=8-TIMECNT
126 ..S Y(1)=$S(X:OC(I),OC(I)>7:OC(I),1:8)
127 ..D CHOL
128 ..Q
129 .Q
130 K OC,CC Q
131 ;
132CHOL ; --- Check for Holiday Callback
133 S TMP=Y,Y=0
134 ; Don't convert Overtime to Comptime
135 I TMP'=7,$E(ENT,25),$$HOLIDAY^PRS8UT(PY,DFN,+D) S Y=24 ;ot on actual hol
136 I 'Y,$E($G(DAY(I,"HOL")),$S(T>96:(T-96),1:T)) S Y=TOUR+28 ;holiday callback
137 I 'Y S Y=TMP
138 D SET S Y=$S(CC:7,'DOUB:TOUR+19,1:23)
139 Q
140 ;
141SET ; --- set WK array
142 S W=$S(I<8:1,1:2)
143 I I<1!(I>14) Q
144 I Y(1)>32,'DOUB,$P(C0,"^",12)="N",Y'=7 D
145 .S $P(WK(W),"^",TOUR+15)=$P(WK(W),"^",TOUR+15)+(Y(1)-32)
146 .S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+32 ;if FLSA=N set >8 = DA
147 E S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+Y(1)
148 Q
Note: See TracBrowser for help on using the repository browser.