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
Q
;
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
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8MT 6723 printed Dec 13, 2024@02:22:54 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
