Index: FOIAVistA/tag/r/PAID-PRS/PRS8MT.m
===================================================================
--- FOIAVistA/trunk/r/PAID-PRS/PRS8MT.m	(revision 631)
+++ FOIAVistA/tag/r/PAID-PRS/PRS8MT.m	(revision 636)
@@ -1,4 +1,4 @@
-PRS8MT ;HISC/MRL-DECOMPOSITION, MEALTIME ;02/21/08
- ;;4.0;PAID;**2,40,69,102,109,112,116**;Sep 21, 1995;Build 23
+PRS8MT ;HISC/MRL-DECOMPOSITION, MEALTIME ;11/22/06
+ ;;4.0;PAID;**2,40,69,102,109**;Sep 21, 1995;Build 5
  ;;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -32,8 +32,4 @@
 GETY ; --- this is where Y (placement of mealtime) is defined
  S X=$E(D,V(1),V(2)),D1=$E(D1,V(1),V(2))
- N ORIGX,RECESS
- S ORIGX=X ; Original copy of codes in X and
- S RECESS=DAY(MDY,"r")_$G(DAY(MDY,"rN"))
- S RECESS=$E(RECESS,V(1),V(2)) ; load any Recess
  I X["5" D
  . N DAYP
@@ -48,17 +44,13 @@
  .S Y=$E(X,M)
  .I "1235C"[Y,"1235C"[X1 Q  ; scheduled work time
- .I "4OC"[Y,$E(RECESS,M)="r" S Q=0 Q  ; Work performed while on Recess (9mo AWS)
  .I Y'="O",Y'=X1 S Q=0 Q  ; not same type of time, and non-OT
- .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))'=2) S Q=0 Q  ; OT indicating non-holiday worked gets no meal
- .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))=2),"123C"[X1 S Q=0 Q  ; OT indicating holiday worked and Excused.
+ .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))'=2) S Q=0 Q  ; OT indicatin' non-holiday worked gets no meal
+ .I Y="O",($E(DAY($S(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$S(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))=2),"123C"[X1 S Q=0 Q  ; OT indicatin holiday worked and Excused.
  .Q
  I X["0" D
- .I RECESS'["r" S SPL=$TR(X,"1235"),SPLX=$TR(X,SPL,$TR($J("",$L(SPL))," "))
- .I RECESS["r" S SPL=$TR(X,"01235"),SPLX=$TR(X,SPL,$TR($J("",$L(SPL))," "))
+ .S SPL=$TR(X,"1235"),SPLX=$TR(X,SPL,$TR($J("",$L(SPL))," "))
  .I SPLX="" S Q=1
- ;
- K M
- ;--- one activity for entire tour
- I Q S Q=0 D  F M=1:1:MT S M(M)=Y+M-1
+ ; --- one activity for entire tour
+ K M I Q S Q=0 D  F M=1:1:MT S M(M)=Y+M-1
  .I V(1)>24,V(2)<73 S Y=MID Q  ;no premium time involved/ meal in middle
  .S Q=0 D  ;check for all premium
@@ -78,65 +70,34 @@
  ; --- multiple activities per tour
  E  D
- .S Z=$TR(X,"1235"),X=$TR(X,Z,$TR($J("",$L(Z))," ","0"))
- .;
- .; if leave posted > or = to tour length + mt (ie didn't post around 
- .; lunch) it was resulting in OT (ZRIK strips HOL, OC, & no tour time)
- .;
- .S ZRIK=$TR(Z,"HC0")
- .I MT>0,$L(ZRIK)'<(($P(DAY(DAY,0),"^",8)*4)+MT) S X="",$P(X,"1",$L(ZRIK)+1)=""
- .Q:X?1"0"."0"&(RECESS'["r")
- .S M=0 F A=1,2 Q:M=MT  F B=MID,MID+1,MID-1:-1:V(1),MID+2:1:V(2) D  Q:M=MT
- ..Q:'$E(X,B-V(1)+1)
- ..I A=1,PM,B<25!(B>72&(B<121)) S M=M+1,M(M)=B
- ..I A=1,'PM,B>24&(B<73)!(B>120) S M=M+1,M(M)=B
- ..I A=2 S M=M+1,M(M)=B
- ..Q
- .Q
+ .  S Z=$TR(X,"1235"),X=$TR(X,Z,$TR($J("",$L(Z))," ","0"))
+ .  S ZRIK=$TR(Z,"HC") I MT>0,$L(ZRIK)'<(($P(DAY(DAY,0),"^",8)*4)+MT) S X="",$P(X,"1",$L(ZRIK)+1)="" ;if leave posted > or = to tour length + mt (ie didn't post around lunch) it was resulting in OT (ZRIK strips HOL & OC)
+ .  Q:X?1"0"."0"
+ .  S M=0 F A=1,2 Q:M=MT  F B=MID,MID+1,MID-1:-1:V(1),MID+2:1:V(2) D  Q:M=MT
+ .  .  Q:'$E(X,B-V(1)+1)
+ .  .  I A=1,PM,B<25!(B>72&(B<121)) S M=M+1,M(M)=B
+ .  .  I A=1,'PM,B>24&(B<73)!(B>120) S M=M+1,M(M)=B
+ .  .  I A=2 S M=M+1,M(M)=B
+ .  .  Q
+ .  Q
  Q:'$O(M(0))
 Y ; --- this is where meals get placed in string
  F Y=0:0 S Y=$O(M(Y)) Q:Y'>0  D
  . N ORIGAC ; original activity code
- . S M=M(Y),(X,ORIGAC)=$E(D,M),X=$S(X="J":"A",X=5:$E(DAY(MDY,"P"),M),1:X)
- . ; If a 9mo AWS works during Recess don't place meal over that type of time
- . I +NAWS=9 D  ; 9mo AWS nurses
- . . ; If extra work (UN,OT,CT) was posted over the entire tour including the meal time
- . . ; don't include meal time in the W node or you will reduce the extra work count.
- . . ; Set X=0 to reduce the Recess count below.
- . . I "4OEC"[ORIGAC&($L(ORIGX)=$L($TR(ORIGX,"1235"))) S X=0 Q
- . . ;
- . . ; If extra work posted over tour time that wasn't covered by Recess it will
- . . ; be stored in the r node.  If this time exists, add that time back into the 
- . . ; W node instead of the meal time.
- . . I "1235"[ORIGAC,"4OEC"[$E(RECESS,M-V(1)+1) D  Q
- . . . S D=$E(D,0,M-1)_$E(RECESS,M-V(1)+1)_$E(D,M+1,999)
- . . . S ORIGX=$E(ORIGX,1,M-V(1)-1)_$E(RECESS,M-V(1)+1)_$E(ORIGX,M-V(1)+2,999)
- . . ;
- . . ; For everything else, update D and ORIGX
- . . S D=$E(D,0,M-1)_"m"_$E(D,M+1,999)
- . . S ORIGX=$E(ORIGX,M-V(1)-1)_"m"_$E(ORIGX,M-V(1)+2,999)
- . ;
- . ; All employees other than 9mo AWS
- . I +NAWS'=9 S D=$E(D,0,M-1)_"m"_$E(D,M+1,999)
- . ;
- . ; The following line has been updated to include a check for Recess as the 48th piece.
- . ; Recess will be designated as a zero (0). 
- . S X=$S(X'="M":$F("LSWnAR*U************************V********YXFGD*0",X)-1,1:5)
- . ;
- . ; Firefighter checks
- . I "Ff"[TYP,NH'=480!(NH(1)'=NH(2)) S X=32
- . ;I X'=4,CYA2806>0 S CYA2806=CYA2806-1 ; << ADDED-> DROP LUNCH FROM CY ALSO>>
- . Q:X'>0
- . Q:MDY=0&(M(Y)<96)!(MDY=14&(M(Y)>97))
- . S W=$S(MDY<8:1,1:2) I MDY=7&(M(Y)>96) S W=2
- . I $P(WK(W),"^",+X)>0 S $P(WK(W),"^",+X)=$P(WK(W),"^",+X)-1 ;subtract
- . ;
- . ; If Military Leave subtract the mealtime out of the WK(3) array.
- . I ORIGAC="M",$P(WK(3),U,11)>0 S $P(WK(3),U,11)=$P(WK(3),U,11)-1
- . ;I WPCYA>0 S WPCYA=WPCYA-1 ;lunch from total << AND FROM CA TOTAL >>
+ .  S M=M(Y),(X,ORIGAC)=$E(D,M),X=$S(X="J":"A",X=5:$E(DAY(MDY,"P"),M),1:X),D=$E(D,0,M-1)_"m"_$E(D,M+1,999)
+ .  S X=$S(X'="M":$F("LSWnAR*U************************V********YXFGD",X)-1,1:5)
+ .  I "Ff"[TYP,NH'=480!(NH(1)'=NH(2)) S X=32
+ .  ;I X'=4,CYA2806>0 S CYA2806=CYA2806-1 ; << ADDED-> DROP LUNCH FROM CY ALSO>>
+ .  Q:X'>0
+ .  Q:MDY=0&(M(Y)<96)!(MDY=14&(M(Y)>97))
+ .  S W=$S(MDY<8:1,1:2) I MDY=7&(M(Y)>96) S W=2
+ .  I $P(WK(W),"^",+X)>0 S $P(WK(W),"^",+X)=$P(WK(W),"^",+X)-1 ;subtract
+ .  ; If Military Leave subtract the mealtime out of the WK(3) array.
+ .  I ORIGAC="M",$P(WK(3),U,11)>0 S $P(WK(3),U,11)=$P(WK(3),U,11)-1
+ .  ;I WPCYA>0 S WPCYA=WPCYA-1 ;lunch from total << AND FROM CA TOTAL >>
  . ; PRS*4*40 added 8 (U), 44 (F), 45 (G), 46 (D) to following line
  . ; because PRS8AC also increments LU for those types of time
- . I +X,"^1^2^6^8^44^45^46^"[("^"_+X_"^") S LU=LU-1 ;reduce leave used
- . I +X,"^3^"[("^"_+X_"^"),"P"[TYP S TH=TH+1,TH(W)=TH(W)+1
- . Q
+ .  I +X,"^1^2^6^8^44^45^46^"[("^"_+X_"^") S LU=LU-1 ;reduce leave used
+ .  I +X,"^3^"[("^"_+X_"^"),"P"[TYP S TH=TH+1,TH(W)=TH(W)+1
+ .   Q
  S DAY(MDY,"W")=$E(D,1,96)
  S X=$E(D,97,999) I $L(X) D
