Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRS8MISC

PRS8MISC.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. N ABUT,D,DY,M,NOTIME,PEROWK,WEEK
  1. S (PEROWK,NOTIME,PEROT,NOOT)=0 F DY=0:1:15 D
  1. .S WEEK=$S(DY>7:2,1:1)
  1. .S X=$G(^TMP($J,"PRS8",DY,2)),Y=$G(^("W"))
  1. .F M=1:1:96 S X=$E(Y,M) Q:'$L(X) D ; check for CB/FF OT and sleep time
  1. ..I "4EO"'[X!(X="O"&($E($G(^TMP($J,"PRS8",DY,"HOL")),M)=2)) S NOOT=0 ; set up periods of OT for PPD
  1. ..E D
  1. ...S:'NOOT PEROT=PEROT+1,PEROT(PEROT)=DY_"^"_M_"^",NOOT=1
  1. ...S PEROT(PEROT)=PEROT(PEROT)_X
  1. ...Q
  1. ..I (TYP'["Ff"),SST,$E(ENT,27) D ; set up per. of work for sleep time
  1. ...I "123OmosEeBbCctQ"'[X S NOTIME=0
  1. ...E D
  1. ....S:'NOTIME PEROWK=PEROWK+1,PEROWK(PEROWK)=DY_U_M_U_M_U,NOTIME=1
  1. ....S $P(PEROWK(PEROWK),U,3)=M+(96*(DY-PEROWK(PEROWK)))
  1. ....S PEROWK(PEROWK)=PEROWK(PEROWK)_X
  1. ....S:$L($P(PEROWK(PEROWK),"^",4))=96 NOTIME=0
  1. ....Q
  1. ...Q
  1. ..Q
  1. .;holiday worked < 2 hrs
  1. .I DY<15,$E(ENT,TOUR+21) S HW=$G(^TMP($J,"PRS8",DY,"HW")) I HW]"" D
  1. ..S W=$G(^TMP($J,"PRS8",DY,"W"))
  1. ..S W1=$G(^TMP($J,"PRS8",DY-1,"W"))
  1. ..S W2=$G(^TMP($J,"PRS8",DY+1,"W"))
  1. ..F X=1:2 S Y=$P(HW,"^",X,X+1) Q:Y'>0 D
  1. ...N X,START,STOP,T,TT,Z,DD
  1. ...S START=+Y,STOP=$P(Y,"^",2),T=START,TT=$S(T>96:T-96,1:T)
  1. ...; Look back to determine if the segment of time currently being
  1. ...; checked abuts another segment of a Tour of Duty. Ignore meals.
  1. ...S (ABUT,Z,X)=0
  1. ...I STOP-START+1<8 D
  1. ....F Z=1:1 D Q:X=0
  1. .....S DD=Z I T>96 S X=0 Q
  1. .....I TT-DD>0 S X=$E(W,TT-DD)
  1. .....E S X=$E(W1,96+T-DD)
  1. .....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
  1. .....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
  1. ....;
  1. ....; Look forward to determine if the segment of time currently being
  1. ....; checked abuts another segment of a Tour of Duty. Ignore meals.
  1. ....S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T)
  1. ....F Z=1:1 D Q:X=0
  1. .....S DD=STOP-START+1+ZZ+Z
  1. .....I T+Z'>96 S X=$E(W,T+Z)
  1. .....E S X=$E(W2,T-96+Z)
  1. .....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
  1. .....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
  1. ...;
  1. ...; Loops to determine how much time we might need to add.
  1. ...S START=+Y,STOP=$P(Y,"^",2),T=START,TT=$S(T>96:T-96,1:T)
  1. ...S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0
  1. ....S DD=Z I T>96 S X=0 Q
  1. ....I TT-DD>0 S X=$E(W,TT-DD)
  1. ....E S X=$E(W1,96+T-DD)
  1. ....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
  1. ....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
  1. ....I X="" S X=0
  1. ....Q
  1. ...S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T)
  1. ...F Z=1:1:8-(STOP-START+1+ZZ) D Q:X=0
  1. ....S DD=STOP-START+1+ZZ+Z
  1. ....I T+Z'>96 S X=$E(W,T+Z)
  1. ....E S X=$E(W2,T-96+Z),PLUS=1
  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
  1. ....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
  1. ....Q
  1. ...S Z=ZZ+Z-(X=0&Z)
  1. ...I STOP-START+1+Z<8,'ABUT D
  1. ....S D=DY,P=TOUR+28,Y=8-(STOP-START+1+Z)
  1. ....S TL=$G(^TMP($J,"PRS8",D,0)),TL=4*($P(TL,"^",8)+$P(TL,"^",14))
  1. ....I Y+$P(WK($S(D>7:2,1:1)),"^",P)>TL S Y=TL-$P(WK($S(D>7:2,1:1)),"^",P)
  1. ....I $D(PLUS),T>96 S D=D+1
  1. ....D:Y SET
  1. ....Q
  1. ...Q
  1. ..Q
  1. .Q
  1. K PLUS G ^PRS8MSC0
  1. ;
  1. SET ; Set sleep time into WK arrary
  1. Q:D<1!(D>14)
  1. S WEEK=$S(D>7:2,1:1)
  1. S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
  1. Q