Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRS8OC.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8OC.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRS8OC.m
r613 r623 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 1 PRS8OC ;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 ; 33 OCS ; --- 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 ; 132 CHOL ; --- 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 ; 141 SET ; --- 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 TracChangeset
for help on using the changeset viewer.
