PRS8MISC ;HISC/DAD,RM,RS-MISCELLANEOUS ADJUSTMENTS TO TIME CARD ;9/12/2006
;;4.0;PAID;**56,68,80,111,117**;Sep 21, 1995;Build 32
;;Per VHA Directive 2004-038, this routine should not be modified.
N ABUT,D,DY,M,NOTIME,PEROWK,WEEK
S (PEROWK,NOTIME,PEROT,NOOT)=0 F DY=0:1:15 D
.S WEEK=$S(DY>7:2,1:1)
.S X=$G(^TMP($J,"PRS8",DY,2)),Y=$G(^("W"))
.F M=1:1:96 S X=$E(Y,M) Q:'$L(X) D ; check for CB/FF OT and sleep time
..I "4EO"'[X!(X="O"&($E($G(^TMP($J,"PRS8",DY,"HOL")),M)=2)) S NOOT=0 ; set up periods of OT for PPD
..E D
...S:'NOOT PEROT=PEROT+1,PEROT(PEROT)=DY_"^"_M_"^",NOOT=1
...S PEROT(PEROT)=PEROT(PEROT)_X
...Q
..I (TYP'["Ff"),SST,$E(ENT,27) D ; set up per. of work for sleep time
...I "123OmosEeBbCctQ"'[X S NOTIME=0
...E D
....S:'NOTIME PEROWK=PEROWK+1,PEROWK(PEROWK)=DY_U_M_U_M_U,NOTIME=1
....S $P(PEROWK(PEROWK),U,3)=M+(96*(DY-PEROWK(PEROWK)))
....S PEROWK(PEROWK)=PEROWK(PEROWK)_X
....S:$L($P(PEROWK(PEROWK),"^",4))=96 NOTIME=0
....Q
...Q
..Q
.;holiday worked < 2 hrs
.I DY<15,$E(ENT,TOUR+21) S HW=$G(^TMP($J,"PRS8",DY,"HW")) I HW]"" D
..S W=$G(^TMP($J,"PRS8",DY,"W"))
..S W1=$G(^TMP($J,"PRS8",DY-1,"W"))
..S W2=$G(^TMP($J,"PRS8",DY+1,"W"))
..F X=1:2 S Y=$P(HW,"^",X,X+1) Q:Y'>0 D
...N X,START,STOP,T,TT,Z,DD
...S START=+Y,STOP=$P(Y,"^",2),T=START,TT=$S(T>96:T-96,1:T)
...; Look back to determine if the segment of time currently being
...; checked abuts another segment of a Tour of Duty. Ignore meals.
...S (ABUT,Z,X)=0
...I STOP-START+1<8 D
....F Z=1:1 D Q:X=0
.....S DD=Z I T>96 S X=0 Q
.....I TT-DD>0 S X=$E(W,TT-DD)
.....E S X=$E(W1,96+T-DD)
.....I "Cc123"[X,"01"[$E($G(^TMP($J,"PRS8",$S(TT-DD>0:DY,1:DY-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD)) S X=0 ; Abuts HX
.....I X="O",$E($G(^TMP($J,"PRS8",$S(TT-DD>0:DY,1:DY-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD))=2 S X=0,ABUT=1 ; Abuts another segment of work
....;
....; Look forward to determine if the segment of time currently being
....; checked abuts another segment of a Tour of Duty. Ignore meals.
....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 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 "Cc123"[X,"01"[$E($G(^TMP($J,"PRS8",$S(T+Z'>96:DY,1:DY+1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z)) S X=0 ; Abuts HX
.....I X="O",$E($G(^TMP($J,"PRS8",$S(T+Z'>96:DY,1:DY-1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z))=2 S X=0,ABUT=1 Q ; Abuts another segment of work
...;
...; Loops to determine how much time we might need to add.
...S START=+Y,STOP=$P(Y,"^",2),T=START,TT=$S(T>96:T-96,1:T)
...S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0
....S DD=Z I T>96 S X=0 Q
....I TT-DD>0 S X=$E(W,TT-DD)
....E S X=$E(W1,96+T-DD)
....I "Cc123m"[X,"01"[$E($G(^TMP($J,"PRS8",$S(TT-DD>0:DY,1:DY-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD)) S X=0 ; HX becomes time off
....I X="O",$E($G(^TMP($J,"PRS8",$S(TT-DD>0:DY,1:DY-1),"HOL")),$S(TT-DD>0:TT-DD,1:96+T-DD))'=2 Q ;S X=0,Z=8 ; non-holiday OT stops the check for <2hr HW
....I X="" S X=0
....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),PLUS=1
....I "Cc123m"[X,"01"[$E($G(^TMP($J,"PRS8",$S(T+Z'>96:DY,1:DY+1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z)) S X=0 ; HX becomes time off
....I X="O",$E($G(^TMP($J,"PRS8",$S(T+Z'>96:DY,1:DY-1),"HOL")),$S(T+Z'>96:T+Z,1:T-96+Z))'=2 Q ;S X=0,Z=8 ; non-holiday OT stops the check for <2hr HW
....Q
...S Z=ZZ+Z-(X=0&Z)
...I STOP-START+1+Z<8,'ABUT D
....S D=DY,P=TOUR+28,Y=8-(STOP-START+1+Z)
....S TL=$G(^TMP($J,"PRS8",D,0)),TL=4*($P(TL,"^",8)+$P(TL,"^",14))
....I Y+$P(WK($S(D>7:2,1:1)),"^",P)>TL S Y=TL-$P(WK($S(D>7:2,1:1)),"^",P)
....I $D(PLUS),T>96 S D=D+1
....D:Y SET
....Q
...Q
..Q
.Q
K PLUS G ^PRS8MSC0
;
SET ; Set sleep time into WK arrary
Q:D<1!(D>14)
S WEEK=$S(D>7:2,1:1)
S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8MISC 4023 printed Dec 13, 2024@02:22:51 Page 2
PRS8MISC ;HISC/DAD,RM,RS-MISCELLANEOUS ADJUSTMENTS TO TIME CARD ;9/12/2006
+1 ;;4.0;PAID;**56,68,80,111,117**;Sep 21, 1995;Build 32
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 NEW ABUT,D,DY,M,NOTIME,PEROWK,WEEK
+4 SET (PEROWK,NOTIME,PEROT,NOOT)=0
FOR DY=0:1:15
Begin DoDot:1
+5 SET WEEK=$SELECT(DY>7:2,1:1)
+6 SET X=$GET(^TMP($JOB,"PRS8",DY,2))
SET Y=$GET(^("W"))
+7 ; check for CB/FF OT and sleep time
FOR M=1:1:96
SET X=$EXTRACT(Y,M)
if '$LENGTH(X)
QUIT
Begin DoDot:2
+8 ; set up periods of OT for PPD
IF "4EO"'[X!(X="O"&($EXTRACT($GET(^TMP($JOB,"PRS8",DY,"HOL")),M)=2))
SET NOOT=0
+9 IF '$TEST
Begin DoDot:3
+10 if 'NOOT
SET PEROT=PEROT+1
SET PEROT(PEROT)=DY_"^"_M_"^"
SET NOOT=1
+11 SET PEROT(PEROT)=PEROT(PEROT)_X
+12 QUIT
End DoDot:3
+13 ; set up per. of work for sleep time
IF (TYP'["Ff")
IF SST
IF $EXTRACT(ENT,27)
Begin DoDot:3
+14 IF "123OmosEeBbCctQ"'[X
SET NOTIME=0
+15 IF '$TEST
Begin DoDot:4
+16 if 'NOTIME
SET PEROWK=PEROWK+1
SET PEROWK(PEROWK)=DY_U_M_U_M_U
SET NOTIME=1
+17 SET $PIECE(PEROWK(PEROWK),U,3)=M+(96*(DY-PEROWK(PEROWK)))
+18 SET PEROWK(PEROWK)=PEROWK(PEROWK)_X
+19 if $LENGTH($PIECE(PEROWK(PEROWK),"^",4))=96
SET NOTIME=0
+20 QUIT
End DoDot:4
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
+23 ;holiday worked < 2 hrs
+24 IF DY<15
IF $EXTRACT(ENT,TOUR+21)
SET HW=$GET(^TMP($JOB,"PRS8",DY,"HW"))
IF HW]""
Begin DoDot:2
+25 SET W=$GET(^TMP($JOB,"PRS8",DY,"W"))
+26 SET W1=$GET(^TMP($JOB,"PRS8",DY-1,"W"))
+27 SET W2=$GET(^TMP($JOB,"PRS8",DY+1,"W"))
+28 FOR X=1:2
SET Y=$PIECE(HW,"^",X,X+1)
if Y'>0
QUIT
Begin DoDot:3
+29 NEW X,START,STOP,T,TT,Z,DD
+30 SET START=+Y
SET STOP=$PIECE(Y,"^",2)
SET T=START
SET TT=$SELECT(T>96:T-96,1:T)
+31 ; Look back to determine if the segment of time currently being
+32 ; checked abuts another segment of a Tour of Duty. Ignore meals.
+33 SET (ABUT,Z,X)=0
+34 IF STOP-START+1<8
Begin DoDot:4
+35 FOR Z=1:1
Begin DoDot:5
+36 SET DD=Z
IF T>96
SET X=0
QUIT
+37 IF TT-DD>0
SET X=$EXTRACT(W,TT-DD)
+38 IF '$TEST
SET X=$EXTRACT(W1,96+T-DD)
+39 ; Abuts HX
IF "Cc123"[X
IF "01"[$EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(TT-DD>0:DY,1:DY-1),"HOL")),$SELECT(TT-DD>0:TT-DD,1:96+T-DD))
SET X=0
+40 ; Abuts another segment of work
IF X="O"
IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(TT-DD>0:DY,1:DY-1),"HOL")),$SELECT(TT-DD>0:TT-DD,1:96+T-DD))=2
SET X=0
SET ABUT=1
End DoDot:5
if X=0
QUIT
+41 ;
+42 ; Look forward to determine if the segment of time currently being
+43 ; checked abuts another segment of a Tour of Duty. Ignore meals.
+44 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)
+45 FOR Z=1:1
Begin DoDot:5
+46 SET DD=STOP-START+1+ZZ+Z
+47 IF T+Z'>96
SET X=$EXTRACT(W,T+Z)
+48 IF '$TEST
SET X=$EXTRACT(W2,T-96+Z)
+49 ; Abuts HX
IF "Cc123"[X
IF "01"[$EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(T+Z'>96:DY,1:DY+1),"HOL")),$SELECT(T+Z'>96:T+Z,1:T-96+Z))
SET X=0
+50 ; Abuts another segment of work
IF X="O"
IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(T+Z'>96:DY,1:DY-1),"HOL")),$SELECT(T+Z'>96:T+Z,1:T-96+Z))=2
SET X=0
SET ABUT=1
QUIT
End DoDot:5
if X=0
QUIT
End DoDot:4
+51 ;
+52 ; Loops to determine how much time we might need to add.
+53 SET START=+Y
SET STOP=$PIECE(Y,"^",2)
SET T=START
SET TT=$SELECT(T>96:T-96,1:T)
+54 SET (Z,X)=0
FOR Z=1:1:8-(STOP-START+1)
Begin DoDot:4
+55 SET DD=Z
IF T>96
SET X=0
QUIT
+56 IF TT-DD>0
SET X=$EXTRACT(W,TT-DD)
+57 IF '$TEST
SET X=$EXTRACT(W1,96+T-DD)
+58 ; HX becomes time off
IF "Cc123m"[X
IF "01"[$EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(TT-DD>0:DY,1:DY-1),"HOL")),$SELECT(TT-DD>0:TT-DD,1:96+T-DD))
SET X=0
+59 ;S X=0,Z=8 ; non-holiday OT stops the check for <2hr HW
IF X="O"
IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(TT-DD>0:DY,1:DY-1),"HOL")),$SELECT(TT-DD>0:TT-DD,1:96+T-DD))'=2
QUIT
+60 IF X=""
SET X=0
+61 QUIT
End DoDot:4
if X=0
QUIT
+62 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)
+63 FOR Z=1:1:8-(STOP-START+1+ZZ)
Begin DoDot:4
+64 SET DD=STOP-START+1+ZZ+Z
+65 IF T+Z'>96
SET X=$EXTRACT(W,T+Z)
+66 IF '$TEST
SET X=$EXTRACT(W2,T-96+Z)
SET PLUS=1
+67 ; HX becomes time off
IF "Cc123m"[X
IF "01"[$EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(T+Z'>96:DY,1:DY+1),"HOL")),$SELECT(T+Z'>96:T+Z,1:T-96+Z))
SET X=0
+68 ;S X=0,Z=8 ; non-holiday OT stops the check for <2hr HW
IF X="O"
IF $EXTRACT($GET(^TMP($JOB,"PRS8",$SELECT(T+Z'>96:DY,1:DY-1),"HOL")),$SELECT(T+Z'>96:T+Z,1:T-96+Z))'=2
QUIT
+69 QUIT
End DoDot:4
if X=0
QUIT
+70 SET Z=ZZ+Z-(X=0&Z)
+71 IF STOP-START+1+Z<8
IF 'ABUT
Begin DoDot:4
+72 SET D=DY
SET P=TOUR+28
SET Y=8-(STOP-START+1+Z)
+73 SET TL=$GET(^TMP($JOB,"PRS8",D,0))
SET TL=4*($PIECE(TL,"^",8)+$PIECE(TL,"^",14))
+74 IF Y+$PIECE(WK($SELECT(D>7:2,1:1)),"^",P)>TL
SET Y=TL-$PIECE(WK($SELECT(D>7:2,1:1)),"^",P)
+75 IF $DATA(PLUS)
IF T>96
SET D=D+1
+76 if Y
DO SET
+77 QUIT
End DoDot:4
+78 QUIT
End DoDot:3
+79 QUIT
End DoDot:2
+80 QUIT
End DoDot:1
+81 KILL PLUS
GOTO ^PRS8MSC0
+82 ;
SET ; Set sleep time into WK arrary
+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
