- 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 Feb 18, 2025@23:49:16 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