source: WorldVistAEHR/trunk/r/PAID-PRS/PRS8MISC.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRS8MISC ;HISC/DAD,RM,RS-MISCELLANEOUS ADJUSTMENTS TO TIME CARD ;9/12/2006
2 ;;4.0;PAID;**56,68,80,111**;Sep 21, 1995;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 N ABUT,D,DY,M,NOTIME,PEROWK,WEEK
5 S (PEROWK,NOTIME,PEROT,NOOT)=0 F DY=0:1:15 D
6 .S WEEK=$S(DY>7:2,1:1)
7 .S X=$G(^TMP($J,"PRS8",DY,2)),Y=$G(^("W"))
8 .F M=1:1:96 S X=$E(Y,M) Q:'$L(X) D ; check for CB/FF OT and sleep time
9 ..I "4EO"'[X!(X="O"&($E($G(^TMP($J,"PRS8",DY,"HOL")),M)=2)) S NOOT=0 ; set up periods of OT for PPD
10 ..E D
11 ...S:'NOOT PEROT=PEROT+1,PEROT(PEROT)=DY_"^"_M_"^",NOOT=1
12 ...S PEROT(PEROT)=PEROT(PEROT)_X
13 ...Q
14 ..I (TYP'["Ff"),SST,$E(ENT,27) D ; set up per. of work for sleep time
15 ...I "123OmosEeBbCct"'[X S NOTIME=0
16 ...E D
17 ....S:'NOTIME PEROWK=PEROWK+1,PEROWK(PEROWK)=DY_U_M_U_M_U,NOTIME=1
18 ....S $P(PEROWK(PEROWK),U,3)=M+(96*(DY-PEROWK(PEROWK)))
19 ....S PEROWK(PEROWK)=PEROWK(PEROWK)_X
20 ....S:$L($P(PEROWK(PEROWK),"^",4))=96 NOTIME=0
21 ....Q
22 ...Q
23 ..Q
24 .;holiday worked < 2 hrs
25 .I DY<15,$E(ENT,TOUR+21) S HW=$G(^TMP($J,"PRS8",DY,"HW")) I HW]"" D
26 ..S W=$G(^TMP($J,"PRS8",DY,"W"))
27 ..S W1=$G(^TMP($J,"PRS8",DY-1,"W"))
28 ..S W2=$G(^TMP($J,"PRS8",DY+1,"W"))
29 ..F X=1:2 S Y=$P(HW,"^",X,X+1) Q:Y'>0 D
30 ...N X,START,STOP,T,TT,Z,DD
31 ...S START=+Y,STOP=$P(Y,"^",2),T=START,TT=$S(T>96:T-96,1:T)
32 ...; Look back to determine if the segment of time currently being
33 ...; checked abuts another segment of a Tour of Duty. Ignore meals.
34 ...S (ABUT,Z,X)=0
35 ...I STOP-START+1<8 D
36 ....F Z=1:1 D Q:X=0
37 .....S DD=Z I T>96 S X=0 Q
38 .....I TT-DD>0 S X=$E(W,TT-DD)
39 .....E S X=$E(W1,96+T-DD)
40 .....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
41 .....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
42 ....;
43 ....; Look forward to determine if the segment of time currently being
44 ....; checked abuts another segment of a Tour of Duty. Ignore meals.
45 ....S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T)
46 ....F Z=1:1 D Q:X=0
47 .....S DD=STOP-START+1+ZZ+Z
48 .....I T+Z'>96 S X=$E(W,T+Z)
49 .....E S X=$E(W2,T-96+Z)
50 .....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
51 .....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
52 ...;
53 ...; Loops to determine how much time we might need to add.
54 ...S START=+Y,STOP=$P(Y,"^",2),T=START,TT=$S(T>96:T-96,1:T)
55 ...S (Z,X)=0 F Z=1:1:8-(STOP-START+1) D Q:X=0
56 ....S DD=Z I T>96 S X=0 Q
57 ....I TT-DD>0 S X=$E(W,TT-DD)
58 ....E S X=$E(W1,96+T-DD)
59 ....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
60 ....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
61 ....I X="" S X=0
62 ....Q
63 ...S ZZ=Z S:X=0&Z ZZ=ZZ-1 S X=0,T=STOP,TT=$S(T>96:T-96,1:T)
64 ...F Z=1:1:8-(STOP-START+1+ZZ) D Q:X=0
65 ....S DD=STOP-START+1+ZZ+Z
66 ....I T+Z'>96 S X=$E(W,T+Z)
67 ....E S X=$E(W2,T-96+Z),PLUS=1
68 ....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
69 ....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
70 ....Q
71 ...S Z=ZZ+Z-(X=0&Z)
72 ...I STOP-START+1+Z<8,'ABUT D
73 ....S D=DY,P=TOUR+28,Y=8-(STOP-START+1+Z)
74 ....S TL=$G(^TMP($J,"PRS8",D,0)),TL=4*($P(TL,"^",8)+$P(TL,"^",14))
75 ....I Y+$P(WK($S(D>7:2,1:1)),"^",P)>TL S Y=TL-$P(WK($S(D>7:2,1:1)),"^",P)
76 ....I $D(PLUS),T>96 S D=D+1
77 ....D:Y SET
78 ....Q
79 ...Q
80 ..Q
81 .Q
82 K PLUS G ^PRS8MSC0
83 ;
84SET ; Set sleep time into WK arrary
85 Q:D<1!(D>14)
86 S WEEK=$S(D>7:2,1:1)
87 S $P(WK(WEEK),"^",P)=$P(WK(WEEK),"^",P)+Y
88 Q
Note: See TracBrowser for help on using the repository browser.