Routine: PRS8MT

PRS8MT ;HISC/MRL-DECOMPOSITION, MEALTIME ;03/10/08

 ;;4.0;PAID;**2,40,69,102,109,112,116,117**;Sep 21, 1995;Build 32

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;This routine is used to determine placement of mealtime where

 ;necessary.

 ;Called by Routines:  PRS8ST

MULT ; --- checking 1 node

 I $$HOLIDAY^PRS8UT(PY,DFN,MDY),$G(^PRST(458,PY,"E",DFN,"D",MDY,2))["MID^MID^ON" Q  ;don't add meal if mid-mid on-call on a holiday, quit routine

 S TWO=DAY(MDY,"TWO")

 S S=1 D SET D:'Q  I TWO S S=2 D SET D:'Q

 .S D1="",$P(D1,"0",193)="",V(1)=97,V(2)=0

 .F I=1:3:28 S V=$P(N,"^",I,I+2) Q:$P(V,"^",1)=""  D

 ..S X=$P(V,"^",3) I "^^6^7^3^8^"'[("^"_X_"^") Q  ;quit if not NH

 ..F M=$P(V,"^"):1:$P(V,"^",2) D  ; build up tour

 ...S D1=$E(D1,1,M-1)_$S(X=""!(X=3):1,X=6:2,1:3)_$E(D1,M+1,192)

 ...I V(1)>M S V(1)=M

 ...I V(2)<M S V(2)=M

..Q

 .D:V(2) GETY

 .F I="N","W" F J=MDY,MDY+1 S X=$G(DAY(J,I)) D

 ..I X'="" S ^TMP($J,"PRS8",J,I)=X

..Q

.Q

END ; --- all done here

 K A,B,C,D,DIF,DIF1,J,L,M,M1,MID,MT,N,PM,T,SPL,SPLX,USE,V(1),V(2),VT,X,X1,X2,Y

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

 . ; loop thru string X and replace 5s by a leave code if one exists

 . S DAYP=$E(DAY(MDY,"P"),V(1),V(2)) ; leave may be hidden here

 . F M=1:1:$L(X) D

 . . I $E(X,M)=5,$E(DAYP,M)'=0 S $E(X,M)=$E(DAYP,M)

 S MID=V(2)-V(1)+1-MT\2,MID=MID+V(1) ;middle of tour

 S PM=+$P($G(^PRST(457.1,+$P(DAY(MDY,0),"^",$S(S=1:2,1:13)),0)),"^",7) ;0=non=prem meal/1=prem. meal

 S X1=$E(X),Q=1

 F M=1:1:$L(X) D  Q:'Q

 .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.

.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))," "))

 .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

 .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

 ..I V(1)<25,V(2)<25 S Q=1 Q  ;all hours before 6am

 ..I V(1)>72,V(2)>72,V(2)'>120 S Q=1 Q  ;all hours after 6pm

 .I Q S Y=MID Q  ; all time premium time/ meal in middle

 .I PM S Y=0 D

 ..I V(2)>72 S Y=73-$S(V(2)-73>MT&(V(1)'>73):0,V(1)<25!(V(2)'<121):73,1:MT-(V(2)-73))

 ..I 'Y,V(1)<25 S Y=$S(25-V(1)>MT:25-MT,1:V(1))

 ..I 'Y S Y=$S(121-V(1)>MT:121-MT,1:V(1))

 .E  S Y=0 D

 ..I V(2)>72 S Y=$S(73-MT>V(1):73-MT,V(1)<25!(V(2)'<121):0,1:V(1))

 ..I 'Y,V(1)<25 S Y=$S(V(2)-MT>24:25,1:V(2)-MT+1)

 ..I 'Y S Y=$S(V(2)-MT>120:121,1:V(2)-MT+1)

 .I 'Y S Y=MID

.Q

 ; --- 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)

.;

 .N ZRIK

 .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)="" ;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"&(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

 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 "4OECQ"[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****Z*q",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 >>

 . ; 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^53^55^"[("^"_+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

 .I $D(DAY(MDY+1,"W")) S DAY(MDY+1,"W")=X_$E(DAY(MDY+1,"W"),$L(X)+1,999)

 .S DAY(MDY,"N")=X

SET ; --- set up for processing

 K A,B S (A,B,Q,Y)=0

 S MT=$G(DAY(MDY,"MT"_S)) I MT'>0 S Q=1 Q  ; mealtime for tour?

 S D=DAY(MDY,"W")_$G(DAY(MDY,"N")) ; get daily activity

 S N=DAY(MDY,S*S) ; get tour

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8MT   6723     printed  Mar 13, 2025@21:27:57                                                                                                                                                                                                      Page 2

PRS8MT    ;HISC/MRL-DECOMPOSITION, MEALTIME ;03/10/08

 +1       ;;4.0;PAID;**2,40,69,102,109,112,116,117**;Sep 21, 1995;Build 32

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ;This routine is used to determine placement of mealtime where

 +5       ;necessary.

 +6       ;

 +7       ;Called by Routines:  PRS8ST

 +8       ;

MULT      ; --- checking 1 node

 +1       ;don't add meal if mid-mid on-call on a holiday, quit routine

           IF $$HOLIDAY^PRS8UT(PY,DFN,MDY)

               IF $GET(^PRST(458,PY,"E",DFN,"D",MDY,2))["MID^MID^ON"

                   QUIT

 +2        SET TWO=DAY(MDY,"TWO")

 +3        SET S=1

           DO SET

           if 'Q

               Begin DoDot:1

 +4                SET D1=""

                   SET $PIECE(D1,"0",193)=""

                   SET V(1)=97

                   SET V(2)=0

 +5                FOR I=1:3:28

                       SET V=$PIECE(N,"^",I,I+2)

                       if $PIECE(V,"^",1)=""

                           QUIT

                       Begin DoDot:2

 +6       ;quit if not NH

                           SET X=$PIECE(V,"^",3)

                           IF "^^6^7^3^8^"'[("^"_X_"^")

                               QUIT

 +7       ; build up tour

                           FOR M=$PIECE(V,"^"):1:$PIECE(V,"^",2)

                               Begin DoDot:3

 +8                                SET D1=$EXTRACT(D1,1,M-1)_$SELECT(X=""!(X=3):1,X=6:2,1:3)_$EXTRACT(D1,M+1,192)

 +9                                IF V(1)>M

                                       SET V(1)=M

 +10                               IF V(2)<M

                                       SET V(2)=M

                               End DoDot:3

 +11                       QUIT

                       End DoDot:2

 +12               if V(2)

                       DO GETY

 +13               FOR I="N","W"

                       FOR J=MDY,MDY+1

                           SET X=$GET(DAY(J,I))

                           Begin DoDot:2

 +14                           IF X'=""

                                   SET ^TMP($JOB,"PRS8",J,I)=X

 +15                           QUIT

                           End DoDot:2

 +16               QUIT

               End DoDot:1

           IF TWO

               SET S=2

               DO SET

               if 'Q

                   Begin DoDot:1

                   End DoDot:1

 +17      ;

END       ; --- all done here

 +1        KILL A,B,C,D,DIF,DIF1,J,L,M,M1,MID,MT,N,PM,T,SPL,SPLX,USE,V(1),V(2),VT,X,X1,X2,Y

 +2        QUIT

 +3       ;

GETY      ; --- this is where Y (placement of mealtime) is defined

 +1        SET X=$EXTRACT(D,V(1),V(2))

           SET D1=$EXTRACT(D1,V(1),V(2))

 +2        NEW ORIGX,RECESS

 +3       ; Original copy of codes in X and

           SET ORIGX=X

 +4        SET RECESS=DAY(MDY,"r")_$GET(DAY(MDY,"rN"))

 +5       ; load any Recess

           SET RECESS=$EXTRACT(RECESS,V(1),V(2))

 +6        IF X["5"

               Begin DoDot:1

 +7                NEW DAYP

 +8       ; loop thru string X and replace 5s by a leave code if one exists

 +9       ; leave may be hidden here

                   SET DAYP=$EXTRACT(DAY(MDY,"P"),V(1),V(2))

 +10               FOR M=1:1:$LENGTH(X)

                       Begin DoDot:2

 +11                       IF $EXTRACT(X,M)=5

                               IF $EXTRACT(DAYP,M)'=0

                                   SET $EXTRACT(X,M)=$EXTRACT(DAYP,M)

                       End DoDot:2

               End DoDot:1

 +12      ;middle of tour

           SET MID=V(2)-V(1)+1-MT\2

           SET MID=MID+V(1)

 +13      ;0=non=prem meal/1=prem. meal

           SET PM=+$PIECE($GET(^PRST(457.1,+$PIECE(DAY(MDY,0),"^",$SELECT(S=1:2,1:13)),0)),"^",7)

 +14       SET X1=$EXTRACT(X)

           SET Q=1

 +15       FOR M=1:1:$LENGTH(X)

               Begin DoDot:1

 +16               SET Y=$EXTRACT(X,M)

 +17      ; scheduled work time

                   IF "1235C"[Y

                       IF "1235C"[X1

                           QUIT

 +18      ; Work performed while on Recess (9mo AWS)

                   IF "4OC"[Y

                       IF $EXTRACT(RECESS,M)="r"

                           SET Q=0

                           QUIT

 +19      ; not same type of time, and non-OT

                   IF Y'="O"

                       IF Y'=X1

                           SET Q=0

                           QUIT

 +20      ; OT indicating non-holiday worked gets no meal

                   IF Y="O"

                       IF ($EXTRACT(DAY($SELECT(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$SELECT(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))'=2)

                           SET Q=0

                           QUIT

 +21      ; OT indicating holiday worked and Excused.

                   IF Y="O"

                       IF ($EXTRACT(DAY($SELECT(V(1)+M-1<97:MDY,1:MDY+1),"HOL"),$SELECT(V(1)+M-1<97:V(1)+M-1,1:V(1)+M-1-96))=2)

                           IF "123C"[X1

                               SET Q=0

                               QUIT

 +22               QUIT

               End DoDot:1

               if 'Q

                   QUIT

 +23       IF X["0"

               Begin DoDot:1

 +24               IF RECESS'["r"

                       SET SPL=$TRANSLATE(X,"1235")

                       SET SPLX=$TRANSLATE(X,SPL,$TRANSLATE($JUSTIFY("",$LENGTH(SPL))," "))

 +25               IF RECESS["r"

                       SET SPL=$TRANSLATE(X,"01235")

                       SET SPLX=$TRANSLATE(X,SPL,$TRANSLATE($JUSTIFY("",$LENGTH(SPL))," "))

 +26               IF SPLX=""

                       SET Q=1

               End DoDot:1

 +27      ;

 +28       KILL M

 +29      ;--- one activity for entire tour

 +30       IF Q

               SET Q=0

               Begin DoDot:1

 +31      ;no premium time involved/ meal in middle

                   IF V(1)>24

                       IF V(2)<73

                           SET Y=MID

                           QUIT

 +32      ;check for all premium

                   SET Q=0

                   Begin DoDot:2

 +33      ;all hours before 6am

                       IF V(1)<25

                           IF V(2)<25

                               SET Q=1

                               QUIT

 +34      ;all hours after 6pm

                       IF V(1)>72

                           IF V(2)>72

                               IF V(2)'>120

                                   SET Q=1

                                   QUIT

                   End DoDot:2

 +35      ; all time premium time/ meal in middle

                   IF Q

                       SET Y=MID

                       QUIT

 +36               IF PM

                       SET Y=0

                       Begin DoDot:2

 +37                       IF V(2)>72

                               SET Y=73-$SELECT(V(2)-73>MT&(V(1)'>73):0,V(1)<25!(V(2)'<121):73,1:MT-(V(2)-73))

 +38                       IF 'Y

                               IF V(1)<25

                                   SET Y=$SELECT(25-V(1)>MT:25-MT,1:V(1))

 +39                       IF 'Y

                               SET Y=$SELECT(121-V(1)>MT:121-MT,1:V(1))

                       End DoDot:2

 +40              IF '$TEST

                       SET Y=0

                       Begin DoDot:2

 +41                       IF V(2)>72

                               SET Y=$SELECT(73-MT>V(1):73-MT,V(1)<25!(V(2)'<121):0,1:V(1))

 +42                       IF 'Y

                               IF V(1)<25

                                   SET Y=$SELECT(V(2)-MT>24:25,1:V(2)-MT+1)

 +43                       IF 'Y

                               SET Y=$SELECT(V(2)-MT>120:121,1:V(2)-MT+1)

                       End DoDot:2

 +44               IF 'Y

                       SET Y=MID

 +45               QUIT

               End DoDot:1

               FOR M=1:1:MT

                   SET M(M)=Y+M-1

 +46      ; --- multiple activities per tour

 +47      IF '$TEST

               Begin DoDot:1

 +48               SET Z=$TRANSLATE(X,"1235")

                   SET X=$TRANSLATE(X,Z,$TRANSLATE($JUSTIFY("",$LENGTH(Z))," ","0"))

 +49      ;

 +50      ; if leave posted > or = to tour length + mt (ie didn't post around

 +51      ; lunch) it was resulting in OT (ZRIK strips HOL, OC, & no tour time)

 +52      ;

 +53               NEW ZRIK

 +54      ;if leave posted > or = to tour length + mt (ie didn't post around lunch) it was resulting in OT (ZRIK strips HOL & OC)

                   SET ZRIK=$TRANSLATE(Z,"HC0")

                   IF MT>0

                       IF $LENGTH(ZRIK)'<(($PIECE(DAY(DAY,0),"^",8)*4)+MT)

                           SET X=""

                           SET $PIECE(X,"1",$LENGTH(ZRIK)+1)=""

 +55               if X?1"0"."0"&(RECESS'["r")

                       QUIT

 +56               SET M=0

                   FOR A=1,2

                       if M=MT

                           QUIT

                       FOR B=MID,MID+1,MID-1:-1:V(1),MID+2:1:V(2)

                           Begin DoDot:2

 +57                           if '$EXTRACT(X,B-V(1)+1)

                                   QUIT

 +58                           IF A=1

                                   IF PM

                                       IF B<25!(B>72&(B<121))

                                           SET M=M+1

                                           SET M(M)=B

 +59                           IF A=1

                                   IF 'PM

                                       IF B>24&(B<73)!(B>120)

                                           SET M=M+1

                                           SET M(M)=B

 +60                           IF A=2

                                   SET M=M+1

                                   SET M(M)=B

 +61                           QUIT

                           End DoDot:2

                           if M=MT

                               QUIT

 +62               QUIT

               End DoDot:1

 +63       if '$ORDER(M(0))

               QUIT

Y         ; --- this is where meals get placed in string

 +1        FOR Y=0:0

               SET Y=$ORDER(M(Y))

               if Y'>0

                   QUIT

               Begin DoDot:1

 +2       ; original activity code

                   NEW ORIGAC

 +3                SET M=M(Y)

                   SET (X,ORIGAC)=$EXTRACT(D,M)

                   SET X=$SELECT(X="J":"A",X=5:$EXTRACT(DAY(MDY,"P"),M),1:X)

 +4       ; If a 9mo AWS works during Recess don't place meal over that type of time

 +5       ; 9mo AWS nurses

                   IF +NAWS=9

                       Begin DoDot:2

 +6       ; If extra work (UN,OT,CT) was posted over the entire tour including the meal time

 +7       ; don't include meal time in the W node or you will reduce the extra work count.

 +8       ; Set X=0 to reduce the Recess count below.

 +9                        IF "4OECQ"[ORIGAC&($LENGTH(ORIGX)=$LENGTH($TRANSLATE(ORIGX,"1235")))

                               SET X=0

                               QUIT

 +10      ;

 +11      ; If extra work posted over tour time that wasn't covered by Recess it will

 +12      ; be stored in the r node.  If this time exists, add that time back into the

 +13      ; W node instead of the meal time.

 +14                       IF "1235"[ORIGAC

                               IF "4OEC"[$EXTRACT(RECESS,M-V(1)+1)

                                   Begin DoDot:3

 +15                                   SET D=$EXTRACT(D,0,M-1)_$EXTRACT(RECESS,M-V(1)+1)_$EXTRACT(D,M+1,999)

 +16                                   SET ORIGX=$EXTRACT(ORIGX,1,M-V(1)-1)_$EXTRACT(RECESS,M-V(1)+1)_$EXTRACT(ORIGX,M-V(1)+2,999)

                                   End DoDot:3

                                   QUIT

 +17      ;

 +18      ; For everything else, update D and ORIGX

 +19                       SET D=$EXTRACT(D,0,M-1)_"m"_$EXTRACT(D,M+1,999)

 +20                       SET ORIGX=$EXTRACT(ORIGX,M-V(1)-1)_"m"_$EXTRACT(ORIGX,M-V(1)+2,999)

                       End DoDot:2

 +21      ;

 +22      ; All employees other than 9mo AWS

 +23               IF +NAWS'=9

                       SET D=$EXTRACT(D,0,M-1)_"m"_$EXTRACT(D,M+1,999)

 +24      ;

 +25      ; The following line has been updated to include a check for Recess as the 48th piece.

 +26      ; Recess will be designated as a zero (0).

 +27               SET X=$SELECT(X'="M":$FIND("LSWnAR*U************************V********YXFGD*0****Z*q",X)-1,1:5)

 +28      ;

 +29      ; Firefighter checks

 +30               IF "Ff"[TYP

                       IF NH'=480!(NH(1)'=NH(2))

                           SET X=32

 +31      ;I X'=4,CYA2806>0 S CYA2806=CYA2806-1 ; << ADDED-> DROP LUNCH FROM CY ALSO>>

 +32               if X'>0

                       QUIT

 +33               if MDY=0&(M(Y)<96)!(MDY=14&(M(Y)>97))

                       QUIT

 +34               SET W=$SELECT(MDY<8:1,1:2)

                   IF MDY=7&(M(Y)>96)

                       SET W=2

 +35      ;subtract

                   IF $PIECE(WK(W),"^",+X)>0

                       SET $PIECE(WK(W),"^",+X)=$PIECE(WK(W),"^",+X)-1

 +36      ;

 +37      ; If Military Leave subtract the mealtime out of the WK(3) array.

 +38               IF ORIGAC="M"

                       IF $PIECE(WK(3),U,11)>0

                           SET $PIECE(WK(3),U,11)=$PIECE(WK(3),U,11)-1

 +39      ;I WPCYA>0 S WPCYA=WPCYA-1 ;lunch from total << AND FROM CA TOTAL >>

 +40      ; PRS*4*40 added 8 (U), 44 (F), 45 (G), 46 (D) to following line

 +41      ; because PRS8AC also increments LU for those types of time

 +42      ;reduce leave used

                   IF +X

                       IF "^1^2^6^8^44^45^46^53^55^"[("^"_+X_"^")

                           SET LU=LU-1

 +43               IF +X

                       IF "^3^"[("^"_+X_"^")

                           IF "P"[TYP

                               SET TH=TH+1

                               SET TH(W)=TH(W)+1

 +44               QUIT

               End DoDot:1

 +45       SET DAY(MDY,"W")=$EXTRACT(D,1,96)

 +46       SET X=$EXTRACT(D,97,999)

           IF $LENGTH(X)

               Begin DoDot:1

 +47               IF $DATA(DAY(MDY+1,"W"))

                       SET DAY(MDY+1,"W")=X_$EXTRACT(DAY(MDY+1,"W"),$LENGTH(X)+1,999)

 +48               SET DAY(MDY,"N")=X

               End DoDot:1

 +49       QUIT

 +50      ;

SET       ; --- set up for processing

 +1        KILL A,B

           SET (A,B,Q,Y)=0

 +2       ; mealtime for tour?

           SET MT=$GET(DAY(MDY,"MT"_S))

           IF MT'>0

               SET Q=1

               QUIT

 +3       ; get daily activity

           SET D=DAY(MDY,"W")_$GET(DAY(MDY,"N"))

 +4       ; get tour

           SET N=DAY(MDY,S*S)

 +5        QUIT

PRS8MT.m