PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ;4/04/2007
;;4.0;PAID;**22,35,40,56,111,112**;Sep 21, 1995;Build 54
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; for employee on daily tour check if no duty performed during week
I TYP["D" D NODUTY^PRS8MSC1
;
S B="",Z0="" S $P(B,"B",97)="",$P(Z0,"0",97)="",FLAG=0
F X=1:1:PEROWK S Y=$P(PEROWK(X),"^",4),DAT=$P(PEROWK(X),"^",1,3),DY=$P(DAT,"^",1),BEG=$P(DAT,"^",2),END=$P(DAT,"^",3) D
.I $L(Y)'<96,TYP'["Ff",$E(ENT,27) D ; slp for 24hr cvg
..S SLMAX=32,(SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3)=""
..I END=96 D
...S SLST=$P($G(PEROWK(X)),"^",4),SL2=$E(SLST,SST,$L(SLST)),SL1=$E(SLST,1,SLMAX-$L(SL2)),SL3=$L(SL2)
...S SLSTR=SL1_SL2
...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB
...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0)
...S SLY=$L($TR(SLSTR,"b0")),SLW=$L($TR(SLSTR,"B0"))
...I SLW>12 Q
...I DY=0 S FLAG=SL3
...S Y=$L(SLSTR)-SLW
...I FLAG>0&(DY=1) S Y=Y-FLAG,FLAG=0
...S D=DY,P=25 D SET Q
..E D
...S SLST=$G(^TMP($J,"PRS8",DY,"W"))_$G(^TMP($J,"PRS8",DY+1,"W"))
...S SLSTR=$E(SLST,1,SST+(SLMAX-1))
...I DOUB S SLSTR=$TR(SLSTR,"Cct","Bbb") ; if PPC = W then OC = SB
...S SLSTR=$TR(SLSTR,$TR(SLSTR,"Bb"),Z0)
...S SLY=$E(SLSTR,SST,96),SLY1=$E(SLSTR,97,$L(SLSTR))
...S SLSTR=SLY_SLY1,SLW=$L($TR(SLSTR,"B0"))
...I SLW>12 Q
...S D=DY,Y=$L($TR(SLY,"b0")),P=25 D SET
...Q:DY=0 S D=DY+1,Y=$L($TR(SLY1,"b0")) D SET
...Q
..K BEG,DAT,END,NL,SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3 Q
.Q
S D="",(H,ROSS)=1 K OT,UN,DA,CT
F H=H:ROSS:PEROT D ; calculate CB OT and FF OT/sleep time
.S Y=PEROT(H),Z=$P(Y,"^",3)
.I "Ff"[TYP D ;K OT,UN,DA D ; FF sleep time
..F M=1:1:$L(Z) D ; following FF OT per Mary Baker 4/1/93
...I D'=+Y+(($P(Y,"^",2)+M-2)\96) D
....S D=+Y+(($P(Y,"^",2)+M-2)\96),HT=0
....Q
...S HT=HT+1
...I $E(Z,H)="E" S CT(D)=$G(CT(D))+1 Q
...I M'>32 S:HT'>32 OT(D)=$G(OT(D))+1 S:HT>32 DA(D)=$G(DA(D))+1 ; FF OT
...I M>32,$L(Z)'<96&(M'>64)!($L(Z)<96) S DA(D)=$G(DA(D))+1 ; FF hrs>8
...I $L(Z)'<96,M>64 D ; FF 2/3 rule
....I M'>96 S UN(D)=$G(UN(D))+1 ; first 8 sleep time
....E S DA(D)=$G(DA(D))+1 ; rest hrs >8
....Q
...Q
..Q
.I $L(Z)<8 D ; call back OT at least 2 hrs
..S YY=Y,ZZ=Z N X,Y,START,STOP,T,TT,Z,DD,TL S Y=YY,Z=ZZ
..S CB=$G(^TMP($J,"PRS8",+Y,"CB"))
..;no call back OT today or send bulletin
..Q:(CB="")!($$OTNXTPP(+Y,CB,$P(C0,"^",1),PY,$P(C0,"^",8)))
..S Q=0 F ZZ=1:2 Q:'$P(CB,"^",ZZ) I $P(Y,"^",2)=$P(CB,"^",ZZ) S Q=1
..Q:'Q ; this OT episode not call back
..S OT=Y,START=$P(OT,"^",2),STOP=$P(OT,"^",2)+$L(Z)-1,T=START,TT=$S(T>96:T-96,1:T)
..S W=$G(^TMP($J,"PRS8",+OT,"W")),WEEK=$S(+OT>7:2,1:1)
..S W1=$G(^TMP($J,"PRS8",OT-1,"W"))
..S W2=$G(^TMP($J,"PRS8",OT+1,"W"))
..S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0
...S DD=Z
...I TT-DD>0 S X=$E(W,TT-DD)
...E S X=$E(W1,96+T-DD)
...I "123m"[X,$E($G(^TMP($J,"PRS8",$S(TT-DD>0:+OT,1:OT-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD))=1 S X=0 ; HX becomes time off
...Q
..S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T)
..F Z=1:1:8-(STOP-START+1+ZZ) D Q:X=0
...S DD=STOP-START+1+ZZ+Z
...I T+Z'>96 S X=$E(W,T+Z)
...E S X=$E(W2,T-96+Z)
...I "123m"[X,$E($G(^TMP($J,"PRS8",$S(T+Z'>96:+OT,1:OT+1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z))=1 S X=0 ; HX becomes time off
...Q
..S Z=ZZ+Z-(X=0&Z)
..I STOP-START+1+Z<8 D
...I TYP["W",$E($P(PEROT(H),"^",3))'="E"&($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF"))=0) S TOUR=$G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"TOUR"))
...S D=+OT,P=$S($E($P(PEROT(H),"^",3))'="E":TOUR+19,1:7),Y=8-(STOP-START+1+Z)
...;
...I TYP["P",TYP'["B",P'=7,'+NAWS D
....I $P($G(^TMP($J,"PRS8",$P(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160) S Y=0 Q
....I $P(C0,"^",12)="E" S P=$S($L($TR(W,"0O"))>31&(TH(WEEK)'>160):TOUR+25,1:P) D:Y SET S Y=$S(TH(WEEK)'>160:Y,1:0) S P=9 D:Y SET S Y=0
...I $P(C0,"^",12)="N",P'=7 S P=$S($L($TR(W,"0O"))>31:TOUR+15,1:P) D:Y SET S Y=0
...D:Y&('+NAWS) SET
...;
...I +NAWS D Q ; Checks for just the AWS nurses
....N CNT,HT,I
....S CNT=Y,Y=1,HT=$G(^TMP($J,"PRS8",D,"HT"))
....F I=1:1:CNT D
.....I HT'<32 S P=$S(P'=7:TOUR+15,1:P) D SET1 Q ; DA/DE or CE/CT
.....I TH($S(+OT>7:2,1:1))'<160 S P=$S(P'=7:TOUR+19,1:P) D SET1 Q ; OA/OE or CE/CT
.....I HT<32,TH($S(+OT>7:2,1:1))<160 S P=9 D SET1 Q ; UN/US
..Q
.Q
F X="OT","DA","UN","CT" D ; store FF OT into WK array
.N Y S P=$S(X="OT":TOUR+19,X="DA"&$E(ENT,TOUR+18):TOUR+15,X="DA":TOUR+19,X="CT":TOUR+6,1:9)
.F D=0:0 S D=$O(@(X_"("_D_")")) Q:D'>0 S Y=@(X_"("_D_")") D SET
.Q
;
; check/adjust night differential granted for leave
D LVND
Q
SET ; Set sleep time into WK array
Q:D<1!(D>14)
S WEEK=$S(D>7:2,1:1)
S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
Q
;
SET1 ; Set sleep time into WK array
Q:D<1!(D>14)
S WEEK=$S(D>7:2,1:1)
S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
Q:(HT>32)&(TH(WEEK)<160)&(NH<320)&($E(ENT,19)=1)
Q:(HT>32)&(TH(WEEK)<160)&(NH=320)&($E(ENT,19)=1)&($E(AC,2)=2) ; 9month AWS
S HT=HT+1,TH(WEEK)=TH(WEEK)+1
S ^TMP($J,"PRS8",D,"HT")=^TMP($J,"PRS8",D,"HT")+1
Q
;
OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ;
;OT or CT connects to a tour of duty in the next pay period.
;JAH-patch PRS*4*22
;If OT or CT are worked in last 2 hours of pay period & 1st day
;of next pay period is missing a tour beginning at midnight, send
;a bulletin warning that call back will be paid unless corrective
;action is taken.
;(i.e a nurse comes in before midnight on last saturday of
;pay period & works for a period less than 2 hrs. before her tour
;that begins at midnight on Sunday, first day of the next pp)
;
; CALLBK = start and stop position in 96 char BCD string.
; RECORD = pointer from employee's tour info to a record
; in tour of duty file.
; DAY = day of the pay period
; D1NXTPP = BOOLEAN; set to true if tour on day 1 of next pay period
; begins at midnight, otherwise false
; NEXTP = next pay period in 97-05 format.
; CURP = current pay period in 99-02 format.
; TLU = 3 digit time & leave unit of employee.
N D1NXTPP,RECORD,CURP,NEXTP,XMDUZ,XMB,XMY,XMDUZ
S (RTN,D1NXTPP)=0
S RECORD=$P($G(^TMP($J,"PRS8",15,0)),"^",2)
I RECORD'="" S D1NXTPP=($P($G(^PRST(457.1,RECORD,1)),"^")="MID")
I (DAY=14)&($P(CALLBK,"^",2)=96) D
. I (D1NXTPP) S RTN=1
. E D
.. S CURP=$P($G(^PRST(458,PPIEN,0)),"^",1)
.. S NXTP=$E($$NXTPP^PRSAPPU(CURP),3,7)
..; Send bulletin to G.PAD
.. S XMY("G.PAD@"_^XMB("NETNAME"))=""
.. S XMDUZ="DHCP PAID package"
.. S XMB="PRS LAST SAT OT/CT"
..;
..; employee name, pay period number, next pay period
.. S XMB(1)=EMPNM,XMB(2)=CURP,XMB(3)=NXTP,XMB(4)=TLU
.. D ^XMB
Q RTN
;
LVND ; Leave Night Differential
; back out ND granted for leave if employee took 8 or more hrs of leave
; a non-wage grade employee can receive night differential when
; on leave as long as the employee has taken less than 8 hours of
; leave during the pay period.
; input (note: units are count of 15min time segments):
; LU - leave taken during pay period (set in PRS8AC, PRS8MT)
; WK(#) - piece 10 contains total shift-2 ND for week #
; WKL(#) - ND granted for leave during week # (set in PRS8PP)
; output:
; WK(#) - piece 10 may be modified
; WKL(#) - may be modified
N W
Q:TYP["W" ; Doesn't apply to Wage Grade
Q:LU'>31 ; Didn't take 8hrs of leave
F W=1,2 D ; For each week subtract leave ND from total ND
. Q:'WKL(W) ; No leave ND to subtract
. I +NAWS'=36 S $P(WK(W),"^",10)=$P(WK(W),"^",10)-WKL(W) ; Subtract
. ; For 36/40 AWS subtract time from Night Differential-AWS (piece 51)
. I +NAWS=36 S $P(WK(W),"^",51)=$P(WK(W),"^",51)-WKL(W)
. S WKL(W)=0 ; Reset leave ND amount
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8MSC0 7994 printed Sep 23, 2025@19:59:16 Page 2
PRS8MSC0 ;HISC/DAD,WCIOFO/JAH,SAB - MISC TIME CARD ADJUST(contd) ;4/04/2007
+1 ;;4.0;PAID;**22,35,40,56,111,112**;Sep 21, 1995;Build 54
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; for employee on daily tour check if no duty performed during week
+5 IF TYP["D"
DO NODUTY^PRS8MSC1
+6 ;
+7 SET B=""
SET Z0=""
SET $PIECE(B,"B",97)=""
SET $PIECE(Z0,"0",97)=""
SET FLAG=0
+8 FOR X=1:1:PEROWK
SET Y=$PIECE(PEROWK(X),"^",4)
SET DAT=$PIECE(PEROWK(X),"^",1,3)
SET DY=$PIECE(DAT,"^",1)
SET BEG=$PIECE(DAT,"^",2)
SET END=$PIECE(DAT,"^",3)
Begin DoDot:1
+9 ; slp for 24hr cvg
IF $LENGTH(Y)'<96
IF TYP'["Ff"
IF $EXTRACT(ENT,27)
Begin DoDot:2
+10 SET SLMAX=32
SET (SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3)=""
+11 IF END=96
Begin DoDot:3
+12 SET SLST=$PIECE($GET(PEROWK(X)),"^",4)
SET SL2=$EXTRACT(SLST,SST,$LENGTH(SLST))
SET SL1=$EXTRACT(SLST,1,SLMAX-$LENGTH(SL2))
SET SL3=$LENGTH(SL2)
+13 SET SLSTR=SL1_SL2
+14 ; if PPC = W then OC = SB
IF DOUB
SET SLSTR=$TRANSLATE(SLSTR,"Cct","Bbb")
+15 SET SLSTR=$TRANSLATE(SLSTR,$TRANSLATE(SLSTR,"Bb"),Z0)
+16 SET SLY=$LENGTH($TRANSLATE(SLSTR,"b0"))
SET SLW=$LENGTH($TRANSLATE(SLSTR,"B0"))
+17 IF SLW>12
QUIT
+18 IF DY=0
SET FLAG=SL3
+19 SET Y=$LENGTH(SLSTR)-SLW
+20 IF FLAG>0&(DY=1)
SET Y=Y-FLAG
SET FLAG=0
+21 SET D=DY
SET P=25
DO SET
QUIT
End DoDot:3
+22 IF '$TEST
Begin DoDot:3
+23 SET SLST=$GET(^TMP($JOB,"PRS8",DY,"W"))_$GET(^TMP($JOB,"PRS8",DY+1,"W"))
+24 SET SLSTR=$EXTRACT(SLST,1,SST+(SLMAX-1))
+25 ; if PPC = W then OC = SB
IF DOUB
SET SLSTR=$TRANSLATE(SLSTR,"Cct","Bbb")
+26 SET SLSTR=$TRANSLATE(SLSTR,$TRANSLATE(SLSTR,"Bb"),Z0)
+27 SET SLY=$EXTRACT(SLSTR,SST,96)
SET SLY1=$EXTRACT(SLSTR,97,$LENGTH(SLSTR))
+28 SET SLSTR=SLY_SLY1
SET SLW=$LENGTH($TRANSLATE(SLSTR,"B0"))
+29 IF SLW>12
QUIT
+30 SET D=DY
SET Y=$LENGTH($TRANSLATE(SLY,"b0"))
SET P=25
DO SET
+31 if DY=0
QUIT
SET D=DY+1
SET Y=$LENGTH($TRANSLATE(SLY1,"b0"))
DO SET
+32 QUIT
End DoDot:3
+33 KILL BEG,DAT,END,NL,SLW,SLY,SLST,SLSTR,SLST1,SLY1,SL1,SL2,SL3
QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 SET D=""
SET (H,ROSS)=1
KILL OT,UN,DA,CT
+36 ; calculate CB OT and FF OT/sleep time
FOR H=H:ROSS:PEROT
Begin DoDot:1
+37 SET Y=PEROT(H)
SET Z=$PIECE(Y,"^",3)
+38 ;K OT,UN,DA D ; FF sleep time
IF "Ff"[TYP
Begin DoDot:2
+39 ; following FF OT per Mary Baker 4/1/93
FOR M=1:1:$LENGTH(Z)
Begin DoDot:3
+40 IF D'=+Y+(($PIECE(Y,"^",2)+M-2)\96)
Begin DoDot:4
+41 SET D=+Y+(($PIECE(Y,"^",2)+M-2)\96)
SET HT=0
+42 QUIT
End DoDot:4
+43 SET HT=HT+1
+44 IF $EXTRACT(Z,H)="E"
SET CT(D)=$GET(CT(D))+1
QUIT
+45 ; FF OT
IF M'>32
if HT'>32
SET OT(D)=$GET(OT(D))+1
if HT>32
SET DA(D)=$GET(DA(D))+1
+46 ; FF hrs>8
IF M>32
IF $LENGTH(Z)'<96&(M'>64)!($LENGTH(Z)<96)
SET DA(D)=$GET(DA(D))+1
+47 ; FF 2/3 rule
IF $LENGTH(Z)'<96
IF M>64
Begin DoDot:4
+48 ; first 8 sleep time
IF M'>96
SET UN(D)=$GET(UN(D))+1
+49 ; rest hrs >8
IF '$TEST
SET DA(D)=$GET(DA(D))+1
+50 QUIT
End DoDot:4
+51 QUIT
End DoDot:3
+52 QUIT
End DoDot:2
+53 ; call back OT at least 2 hrs
IF $LENGTH(Z)<8
Begin DoDot:2
+54 SET YY=Y
SET ZZ=Z
NEW X,Y,START,STOP,T,TT,Z,DD,TL
SET Y=YY
SET Z=ZZ
+55 SET CB=$GET(^TMP($JOB,"PRS8",+Y,"CB"))
+56 ;no call back OT today or send bulletin
+57 if (CB="")!($$OTNXTPP(+Y,CB,$PIECE(C0,"^",1),PY,$PIECE(C0,"^",8)))
QUIT
+58 SET Q=0
FOR ZZ=1:2
if '$PIECE(CB,"^",ZZ)
QUIT
IF $PIECE(Y,"^",2)=$PIECE(CB,"^",ZZ)
SET Q=1
+59 ; this OT episode not call back
if 'Q
QUIT
+60 SET OT=Y
SET START=$PIECE(OT,"^",2)
SET STOP=$PIECE(OT,"^",2)+$LENGTH(Z)-1
SET T=START
SET TT=$SELECT(T>96:T-96,1:T)
+61 SET W=$GET(^TMP($JOB,"PRS8",+OT,"W"))
SET WEEK=$SELECT(+OT>7:2,1:1)
+62 SET W1=$GET(^TMP($JOB,"PRS8",OT-1,"W"))
+63 SET W2=$GET(^TMP($JOB,"PRS8",OT+1,"W"))
+64 SET (Z,X)=0
FOR Z=1:1:8-(STOP-START+1)
Begin DoDot:3
+65 SET DD=Z
+66 IF TT-DD>0
SET X=$EXTRACT(W,TT-DD)
+67 IF '$TEST
SET X=$EXTRACT(W1,96+T-DD)
+68 ; HX becomes time off
IF "123m"[X
IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(TT-DD>0:+OT,1:OT-1),"HOL")),$SELECT(TT-DD>0:TT-DD,1:96+T-DD))=1
SET X=0
+69 QUIT
End DoDot:3
if X=0
QUIT
+70 SET ZZ=Z
if X=0&Z
SET ZZ=ZZ-1
SET X=0
SET T=STOP
SET TT=$SELECT(T>96:T-96,1:T)
+71 FOR Z=1:1:8-(STOP-START+1+ZZ)
Begin DoDot:3
+72 SET DD=STOP-START+1+ZZ+Z
+73 IF T+Z'>96
SET X=$EXTRACT(W,T+Z)
+74 IF '$TEST
SET X=$EXTRACT(W2,T-96+Z)
+75 ; HX becomes time off
IF "123m"[X
IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(T+Z'>96:+OT,1:OT+1),"HOL")),$SELECT(T+Z'>96:T+Z,1:T-96+Z))=1
SET X=0
+76 QUIT
End DoDot:3
if X=0
QUIT
+77 SET Z=ZZ+Z-(X=0&Z)
+78 IF STOP-START+1+Z<8
Begin DoDot:3
+79 IF TYP["W"
IF $EXTRACT($PIECE(PEROT(H),"^",3))'="E"&($GET(^TMP($JOB,"PRS8",$PIECE(PEROT(H),"^",1),"OFF"))=0)
SET TOUR=$GET(^TMP($JOB,"PRS8",$PIECE(PEROT(H),"^",1),"TOUR"))
+80 SET D=+OT
SET P=$SELECT($EXTRACT($PIECE(PEROT(H),"^",3))'="E":TOUR+19,1:7)
SET Y=8-(STOP-START+1+Z)
+81 ;
+82 IF TYP["P"
IF TYP'["B"
IF P'=7
IF '+NAWS
Begin DoDot:4
+83 IF $PIECE($GET(^TMP($JOB,"PRS8",$PIECE(PEROT(H),"^",1),"OFF")),"^",1)=1&(TH(WEEK)'>160)
SET Y=0
QUIT
+84 IF $PIECE(C0,"^",12)="E"
SET P=$SELECT($LENGTH($TRANSLATE(W,"0O"))>31&(TH(WEEK)'>160):TOUR+25,1:P)
if Y
DO SET
SET Y=$SELECT(TH(WEEK)'>160:Y,1:0)
SET P=9
if Y
DO SET
SET Y=0
End DoDot:4
+85 IF $PIECE(C0,"^",12)="N"
IF P'=7
SET P=$SELECT($LENGTH($TRANSLATE(W,"0O"))>31:TOUR+15,1:P)
if Y
DO SET
SET Y=0
+86 if Y&('+NAWS)
DO SET
+87 ;
+88 ; Checks for just the AWS nurses
IF +NAWS
Begin DoDot:4
+89 NEW CNT,HT,I
+90 SET CNT=Y
SET Y=1
SET HT=$GET(^TMP($JOB,"PRS8",D,"HT"))
+91 FOR I=1:1:CNT
Begin DoDot:5
+92 ; DA/DE or CE/CT
IF HT'<32
SET P=$SELECT(P'=7:TOUR+15,1:P)
DO SET1
QUIT
+93 ; OA/OE or CE/CT
IF TH($SELECT(+OT>7:2,1:1))'<160
SET P=$SELECT(P'=7:TOUR+19,1:P)
DO SET1
QUIT
+94 ; UN/US
IF HT<32
IF TH($SELECT(+OT>7:2,1:1))<160
SET P=9
DO SET1
QUIT
End DoDot:5
End DoDot:4
QUIT
End DoDot:3
+95 QUIT
End DoDot:2
+96 QUIT
End DoDot:1
+97 ; store FF OT into WK array
FOR X="OT","DA","UN","CT"
Begin DoDot:1
+98 NEW Y
SET P=$SELECT(X="OT":TOUR+19,X="DA"&$EXTRACT(ENT,TOUR+18):TOUR+15,X="DA":TOUR+19,X="CT":TOUR+6,1:9)
+99 FOR D=0:0
SET D=$ORDER(@(X_"("_D_")"))
if D'>0
QUIT
SET Y=@(X_"("_D_")")
DO SET
+100 QUIT
End DoDot:1
+101 ;
+102 ; check/adjust night differential granted for leave
+103 DO LVND
+104 QUIT
SET ; Set sleep time into WK array
+1 if D<1!(D>14)
QUIT
+2 SET WEEK=$SELECT(D>7:2,1:1)
+3 SET $PIECE(WK(WEEK),"^",P)=$PIECE(WK(WEEK),"^",P)+Y
+4 QUIT
+5 ;
SET1 ; Set sleep time into WK array
+1 if D<1!(D>14)
QUIT
+2 SET WEEK=$SELECT(D>7:2,1:1)
+3 SET $PIECE(WK(WEEK),"^",P)=$PIECE(WK(WEEK),"^",P)+Y
+4 if (HT>32)&(TH(WEEK)<160)&(NH<320)&($EXTRACT(ENT,19)=1)
QUIT
+5 ; 9month AWS
if (HT>32)&(TH(WEEK)<160)&(NH=320)&($EXTRACT(ENT,19)=1)&($EXTRACT(AC,2)=2)
QUIT
+6 SET HT=HT+1
SET TH(WEEK)=TH(WEEK)+1
+7 SET ^TMP($JOB,"PRS8",D,"HT")=^TMP($JOB,"PRS8",D,"HT")+1
+8 QUIT
+9 ;
OTNXTPP(DAY,CALLBK,EMPNM,PPIEN,TLU) ;
+1 ;OT or CT connects to a tour of duty in the next pay period.
+2 ;JAH-patch PRS*4*22
+3 ;If OT or CT are worked in last 2 hours of pay period & 1st day
+4 ;of next pay period is missing a tour beginning at midnight, send
+5 ;a bulletin warning that call back will be paid unless corrective
+6 ;action is taken.
+7 ;(i.e a nurse comes in before midnight on last saturday of
+8 ;pay period & works for a period less than 2 hrs. before her tour
+9 ;that begins at midnight on Sunday, first day of the next pp)
+10 ;
+11 ; CALLBK = start and stop position in 96 char BCD string.
+12 ; RECORD = pointer from employee's tour info to a record
+13 ; in tour of duty file.
+14 ; DAY = day of the pay period
+15 ; D1NXTPP = BOOLEAN; set to true if tour on day 1 of next pay period
+16 ; begins at midnight, otherwise false
+17 ; NEXTP = next pay period in 97-05 format.
+18 ; CURP = current pay period in 99-02 format.
+19 ; TLU = 3 digit time & leave unit of employee.
+20 NEW D1NXTPP,RECORD,CURP,NEXTP,XMDUZ,XMB,XMY,XMDUZ
+21 SET (RTN,D1NXTPP)=0
+22 SET RECORD=$PIECE($GET(^TMP($JOB,"PRS8",15,0)),"^",2)
+23 IF RECORD'=""
SET D1NXTPP=($PIECE($GET(^PRST(457.1,RECORD,1)),"^")="MID")
+24 IF (DAY=14)&($PIECE(CALLBK,"^",2)=96)
Begin DoDot:1
+25 IF (D1NXTPP)
SET RTN=1
+26 IF '$TEST
Begin DoDot:2
+27 SET CURP=$PIECE($GET(^PRST(458,PPIEN,0)),"^",1)
+28 SET NXTP=$EXTRACT($$NXTPP^PRSAPPU(CURP),3,7)
+29 ; Send bulletin to G.PAD
+30 SET XMY("G.PAD@"_^XMB("NETNAME"))=""
+31 SET XMDUZ="DHCP PAID package"
+32 SET XMB="PRS LAST SAT OT/CT"
+33 ;
+34 ; employee name, pay period number, next pay period
+35 SET XMB(1)=EMPNM
SET XMB(2)=CURP
SET XMB(3)=NXTP
SET XMB(4)=TLU
+36 DO ^XMB
End DoDot:2
End DoDot:1
+37 QUIT RTN
+38 ;
LVND ; Leave Night Differential
+1 ; back out ND granted for leave if employee took 8 or more hrs of leave
+2 ; a non-wage grade employee can receive night differential when
+3 ; on leave as long as the employee has taken less than 8 hours of
+4 ; leave during the pay period.
+5 ; input (note: units are count of 15min time segments):
+6 ; LU - leave taken during pay period (set in PRS8AC, PRS8MT)
+7 ; WK(#) - piece 10 contains total shift-2 ND for week #
+8 ; WKL(#) - ND granted for leave during week # (set in PRS8PP)
+9 ; output:
+10 ; WK(#) - piece 10 may be modified
+11 ; WKL(#) - may be modified
+12 NEW W
+13 ; Doesn't apply to Wage Grade
if TYP["W"
QUIT
+14 ; Didn't take 8hrs of leave
if LU'>31
QUIT
+15 ; For each week subtract leave ND from total ND
FOR W=1,2
Begin DoDot:1
+16 ; No leave ND to subtract
if 'WKL(W)
QUIT
+17 ; Subtract
IF +NAWS'=36
SET $PIECE(WK(W),"^",10)=$PIECE(WK(W),"^",10)-WKL(W)
+18 ; For 36/40 AWS subtract time from Night Differential-AWS (piece 51)
+19 IF +NAWS=36
SET $PIECE(WK(W),"^",51)=$PIECE(WK(W),"^",51)-WKL(W)
+20 ; Reset leave ND amount
SET WKL(W)=0
End DoDot:1
+21 QUIT
