[628] | 1 | PRS8OC ;HISC/MGD-DECOMPOSITION, ON-CALL ;02/27/07
|
---|
| 2 | ;;4.0;PAID;**63,92,112**;Sep 21, 1995;Build 54
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | ;The following MUMPS code is used to credit the appropriate
|
---|
| 6 | ;categories on the timecard for work performed while On-Call.
|
---|
| 7 | ;All hours during which an individual is identified as being
|
---|
| 8 | ;On-Call are credited to blocks YD and YH (On Call Hrs) on
|
---|
| 9 | ;the timecard. Hours during an On-Call episode where an
|
---|
| 10 | ;individual is actually called in to perform work are credited
|
---|
| 11 | ;to blocks YA and YE (Sch CB OT) as appropriate. This credit
|
---|
| 12 | ;is given under the 2-hour minimum rule. When OT work is
|
---|
| 13 | ;performed during On-Call the actual On-Call Hours reported
|
---|
| 14 | ;are reduced by the ACTUAL number of hours worked (not by the
|
---|
| 15 | ;2-hour minimum).
|
---|
| 16 | ;
|
---|
| 17 | ;Called by Routines: PRS8ST
|
---|
| 18 | ;
|
---|
| 19 | ;C = On-Call
|
---|
| 20 | ;c = OT during OC
|
---|
| 21 | ;t = CT during OC
|
---|
| 22 | ;
|
---|
| 23 | S (I,D)=$S(T'>96:DAY,1:(DAY+1))
|
---|
| 24 | S OC=$G(OC),OC(DAY)=$G(OC(DAY)),OC(DAY+1)=$G(OC(DAY+1)) ;oc variables
|
---|
| 25 | S CC=$G(CC),CC(DAY)=$G(CC(DAY)),CC(DAY+1)=$G(CC(DAY+1)) ;CT on OC count
|
---|
| 26 | S Y=35,Y(1)=1 D SET
|
---|
| 27 | I VAR1="C" D:OC!(CC) OCS ;on-call episode (ot OR ct)
|
---|
| 28 | S:"ct"[VAR1 OC=OC+1,OC(D)=OC(D)+1 S:VAR1="t" CC=CC+1,CC(D)=CC(D)+1
|
---|
| 29 | I "ct"[VAR1,DAY>0,DAY<15 S CBCK(WK)=CBCK(WK)+1 ;count actual CB hrs
|
---|
| 30 | Q:'OK!('$D(OC))
|
---|
| 31 | I OC S Y=23 D OCS ;get rest of them
|
---|
| 32 | K OC,CC,Y,D Q
|
---|
| 33 | ;
|
---|
| 34 | OCS ; --- set On-Call minimum hours
|
---|
| 35 | ;set YA/YE for PPI="W" or "V" else set OT
|
---|
| 36 | I +NAWS=0 S Y=$S(CC:7,'DOUB:TOUR+19,1:23)
|
---|
| 37 | I +NAWS S Y=$S(CC:7,1:TOUR+19)
|
---|
| 38 | ;
|
---|
| 39 | N X,Z,DD,TT,CCCNT,NEXTT,OCCNT,TIMECNT
|
---|
| 40 | S TT=$S(T>96:T-96,1:T),TIMECNT=0
|
---|
| 41 | S X=$E(DAY($S(T>96:DAY+1,1:DAY),"W"),TT)
|
---|
| 42 | ;
|
---|
| 43 | ; If the current segment is the last of the On-Call OR the last of
|
---|
| 44 | ; the On-Call Callback and the next time segment is Unavailable ("-")
|
---|
| 45 | ; or not a type of work ("0") check to see if OT/reg sched is prior
|
---|
| 46 | ; to on call worked.
|
---|
| 47 | ;
|
---|
| 48 | S NEXTT=$S(T+1>96:T-95,1:TT+1) ; Next time segment
|
---|
| 49 | I "C"[X!(("ct"[X)&("-0"[$E($S(T+1>96:DAY(DAY+1,"W"),1:DAY(DAY,"W")),NEXTT))) D
|
---|
| 50 | .K XH S X=0 F Z=1:1:8-(OC(DAY)+$G(OC(DAY+1))) D Q:"01"[X
|
---|
| 51 | ..S DD=OC(DAY)+OC(DAY+1)+Z
|
---|
| 52 | ..I TT-DD>0 S X=$E(DAY(DAY,"W"),TT-DD) S:X="O"&($E(DAY(DAY,"HOL"),TT-DD)=2) X="h"
|
---|
| 53 | ..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"
|
---|
| 54 | ..I "123nHMLSWNARXYFGD"[X S X=1 Q ; on call abuts a reg sched TOD.
|
---|
| 55 | ..E I "EOhoscte"[X D ; on call abuts time worked outside posted TOD.
|
---|
| 56 | ...I "ct"'[X S TIMECNT=TIMECNT+1 ; Time already counted in WK().
|
---|
| 57 | ...S XH=$S(X'="h":0,1:1),X=2
|
---|
| 58 | ..E S X=0
|
---|
| 59 | ..Q
|
---|
| 60 | .Q
|
---|
| 61 | E D ; Check to see if OT/reg sched is after on call worked
|
---|
| 62 | .K XH S X=0 F Z=1:1:8-(OC(DAY)+$G(OC(DAY+1))) D Q:"01"[X
|
---|
| 63 | ..S DD=OC(DAY)+OC(DAY+1)+Z
|
---|
| 64 | ..I T+Z'>96 S X=$E(DAY(DAY,"W"),T+Z) S:X="O"&($E(DAY(DAY,"HOL"),T+Z)=2) X="h"
|
---|
| 65 | ..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"
|
---|
| 66 | ..I "123nHMLSWNARXYFGD"[X S X=1 Q ; on call abuts a reg sched TOD.
|
---|
| 67 | ..E I "EOhoscte"[X D
|
---|
| 68 | ...I "ct"'[X S TIMECNT=TIMECNT+1 ; Time already counted in WK().
|
---|
| 69 | ...S XH=$S(X'="h":0,1:1),X=2
|
---|
| 70 | ..E S X=0
|
---|
| 71 | ..Q
|
---|
| 72 | .Q
|
---|
| 73 | I $G(XH)'="" S:XH=1!'X Z=Z-1,X=2
|
---|
| 74 | ;
|
---|
| 75 | ; Check if Scheduled Call-Back OT crosses Midnight
|
---|
| 76 | ;
|
---|
| 77 | I '$D(CRSMID(D)),$E(DAY(DAY,"W"),1)="c",$E(DAY(DAY-1,"W"),96)="c" S FG=0 D Q:FG=1
|
---|
| 78 | .S CRSMID(D)=1
|
---|
| 79 | .I OC<7 D Q:FG=1
|
---|
| 80 | ..; crosses midnight, check if its <2 hours, CRSMID variable set to
|
---|
| 81 | ..; only do on segment that cross mid, not others
|
---|
| 82 | ..S CNTR=0 F CX=1:1:8-OC S:$E(DAY(DAY-1,"W"),97-CX)="c" CNTR=CNTR+1
|
---|
| 83 | ..I OC+CNTR'>8 D
|
---|
| 84 | ...S Y(1)=$S(X=1:OC,1:8-CNTR)
|
---|
| 85 | ...I +NAWS=0 D CHOL ; Process everyone but AWS nurses
|
---|
| 86 | ...I +NAWS D CHOL1 ; Process AWS nurses
|
---|
| 87 | ...S (OC,OC(D),CC,CC(D))=0,FG=1
|
---|
| 88 | ..Q
|
---|
| 89 | ;
|
---|
| 90 | ; Check if Comp Time crosses Midnight
|
---|
| 91 | ;
|
---|
| 92 | I '$D(CRSMID(D)),$E(DAY(DAY,"W"),1)="t",$E(DAY(DAY-1,"W"),96)="t" S FG=0 D Q:FG=1
|
---|
| 93 | .S CRSMID(D)=1
|
---|
| 94 | .I OC<7 D Q:FG=1
|
---|
| 95 | ..; crosses midnight, check if its <2 hours, CRSMID variable set to
|
---|
| 96 | ..; only do on segment that cross mid, not others
|
---|
| 97 | ..S CNTR=0 F CX=1:1:8-OC S:$E(DAY(DAY-1,"W"),97-CX)="t" CNTR=CNTR+1
|
---|
| 98 | ..I OC+CNTR'>8 D
|
---|
| 99 | ...S Y(1)=$S(X=1:OC,1:8-CNTR)
|
---|
| 100 | ...I +NAWS=0 D CHOL ; Process everyone but AWS nurses
|
---|
| 101 | ...I +NAWS D CHOL1 ; Process AWS nurses
|
---|
| 102 | ...S (OC,OC(D),CC,CC(D))=0,FG=1
|
---|
| 103 | ..Q
|
---|
| 104 | ;
|
---|
| 105 | I CC>0,CC<OC D ;SPLIT SEGMENT, MUST DO TWICE (FOR CT THEN FOR OT)
|
---|
| 106 | .F I=DAY:1:(DAY+1) I OC(I) D
|
---|
| 107 | ..S (OCCNT,CCCNT)=0
|
---|
| 108 | ..I X=2,OC(I)+TIMECNT<8 D ; Add time if 2 hour minimum was not met.
|
---|
| 109 | ...S TIMECNT=8-OC(I)-TIMECNT ; Amount of time short of the 2 hour min.
|
---|
| 110 | ...;
|
---|
| 111 | ...; If TIMECNT is an even number divide needed time equally among the
|
---|
| 112 | ...; CT and OT.
|
---|
| 113 | ...I TIMECNT#2=0 S CCCNT=TIMECNT/2,OCCNT=TIMECNT/2
|
---|
| 114 | ...;
|
---|
| 115 | ...; If TIMECNT is not an even number divide the time needed as equally
|
---|
| 116 | ...; as possible among the CT and OT w/ remaining 15 minutes going to OC.
|
---|
| 117 | ...I TIMECNT#2=1 S CCCNT=TIMECNT\2,OCCNT=(TIMECNT\2)+1
|
---|
| 118 | ...;
|
---|
| 119 | ..S Y(1)=$S(X=2:CC(I)+CCCNT,X:CC(I),OC(I)>7:CC(I),1:4),Y=7
|
---|
| 120 | ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses
|
---|
| 121 | ..I +NAWS D CHOL1 ; Process AWS nurses
|
---|
| 122 | ..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)
|
---|
| 123 | ..S Y=$S('DOUB:TOUR+19,1:23)
|
---|
| 124 | ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses
|
---|
| 125 | ..I +NAWS D CHOL1 ; Process AWS nurses
|
---|
| 126 | ..Q
|
---|
| 127 | .Q
|
---|
| 128 | E D ;NOT SPLIT SEGMENT
|
---|
| 129 | .F I=DAY:1:(DAY+1) I OC(I) D
|
---|
| 130 | ..I OC(I)<8,X=2 D
|
---|
| 131 | ...I T'=96 S OC(I)=8-TIMECNT
|
---|
| 132 | ...I T=96,"ct"'[$E(DAY(DAY+1,"W"),1) S OC(I)=8-TIMECNT
|
---|
| 133 | ..S Y(1)=$S(X:OC(I),OC(I)>7:OC(I),1:8)
|
---|
| 134 | ..I +NAWS=0 D CHOL ; Process everyone but AWS nurses
|
---|
| 135 | ..I +NAWS D CHOL1 ; Process AWS nurses
|
---|
| 136 | ..Q
|
---|
| 137 | .Q
|
---|
| 138 | K OC,CC Q
|
---|
| 139 | ;
|
---|
| 140 | CHOL ; --- Check for Holiday Callback
|
---|
| 141 | S TMP=Y,Y=0
|
---|
| 142 | ; Don't convert Overtime to Comptime
|
---|
| 143 | I TMP'=7,$E(ENT,25),$$HOLIDAY^PRS8UT(PY,DFN,+D) S Y=24 ;ot on actual hol
|
---|
| 144 | I 'Y,$E($G(DAY(I,"HOL")),$S(T>96:(T-96),1:T)) S Y=TOUR+28 ;holiday callback
|
---|
| 145 | I 'Y S Y=TMP
|
---|
| 146 | D SET S Y=$S(CC:7,'DOUB:TOUR+19,1:23)
|
---|
| 147 | Q
|
---|
| 148 | ;
|
---|
| 149 | SET ; --- set WK array
|
---|
| 150 | S W=$S(I<8:1,1:2)
|
---|
| 151 | I I<1!(I>14) Q
|
---|
| 152 | I Y(1)>32,'DOUB,$P(C0,"^",12)="N",Y'=7 D
|
---|
| 153 | .S $P(WK(W),"^",TOUR+15)=$P(WK(W),"^",TOUR+15)+(Y(1)-32)
|
---|
| 154 | .S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+32 ;if FLSA=N set >8 = DA
|
---|
| 155 | E S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+Y(1)
|
---|
| 156 | Q
|
---|
| 157 | ;
|
---|
| 158 | CHOL1 ; Checks for AWS nurses
|
---|
| 159 | N HT,J,K,T2ADD
|
---|
| 160 | S K=0,TMP=Y,Y=0
|
---|
| 161 | S T2ADD=$S(CC:Y(1)-CC,1:Y(1)-OC-CC)
|
---|
| 162 | ; Apply normal checks for OT on Hol and Hol Callback
|
---|
| 163 | I TMP'=7,$E(ENT,25),$$HOLIDAY^PRS8UT(PY,DFN,+D) S Y=24 ;ot on actual hol
|
---|
| 164 | I 'Y,$E($G(DAY(I,"HOL")),$S(T>96:(T-96),1:T)) S Y=TOUR+28 ;holiday callback
|
---|
| 165 | I 'Y S Y=TMP
|
---|
| 166 | I Y=24!(Y=(TOUR+28)) D SET Q
|
---|
| 167 | ; If not OT on Hol or Hol Callback Determine if we are setting OT or CT
|
---|
| 168 | S K=$S(Y=7:CC,1:OC)
|
---|
| 169 | F J=1:1:K D AWSWK ; Update actual time worked
|
---|
| 170 | F J=1:1:T2ADD D AWSWK ; Update time added to reach 2 hour min
|
---|
| 171 | Q
|
---|
| 172 | ;
|
---|
| 173 | AWSWK ; Determine what type of time to add based on 8/day and 40/wk
|
---|
| 174 | S HT=+$G(^TMP($J,"PRS8",D,"HT"))
|
---|
| 175 | I HT'<32 S Y=$S(Y'=7:TOUR+15,1:Y) D SET1 Q
|
---|
| 176 | I TH(W)'<160 S Y=$S(Y'=7:TOUR+19,1:Y) D SET1 Q
|
---|
| 177 | I HT<32,TH(W)<160 S Y=9 D SET1
|
---|
| 178 | Q
|
---|
| 179 | ;
|
---|
| 180 | SET1 ; Set WK array for AWS nurses
|
---|
| 181 | S $P(WK(W),"^",Y)=$P(WK(W),"^",Y)+1
|
---|
| 182 | Q:HT'<32
|
---|
| 183 | S TH=TH+1,TH(WK)=TH(WK)+1
|
---|
| 184 | S ^TMP($J,"PRS8",DAY,"HT")=HT+1
|
---|
| 185 | Q
|
---|