PRSARC07 ;WOIFO/JAH - Tour Hours Procedure ;01/07/08
;;4.0;PAID;**112,116**;Sep 21, 1995;Build 23
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
TOURHRS(THRARY,PPI,PRSIEN,TOURSTR) ; Return data for TOUR OF DUTY
;Input:
; PPI (optional) IEN of #458 otherwise curr PPI assumed.
; *If PPI and TOURSTR (or only PPI) defined then last pay period
; spill over from 2nd sat. is added to day 1.
; *If TOURSTR is defined but not PPI then tour hours
; from 2nd saturday of tour in TOURSTR are placed on 1st Sunday.
;
; PRSIEN (required) IEN-File (#450).
; TOURSTR (optional) if defined should contain 14 piece string
; delimited by "^" pieces 1-14 contain pointers
; to ToD file. Will be used instead of pp to determine
; tour hrs.
; Output
; THRARY (TOUR HRS ARRAY)-2 piece array subsc by day #.
; W1 & W2 node w/ wkly tour hrs.
; Piece one = Shift code:
; -Null when no tour hrs fall on that day.
; -Always 0 for Wage Grades
; -1, 2, or 3 corresponds to earliest shift on day being reported.
; Piece two = total hrs for tours that fall on each day.
; Tours crossing midnight--hrs placed in node on day the occur
; SPECIAL CASE: COMPRESSED TOURS: "CT" node is defined
; Piece one set to shift (earliest for pp or 0 for wage)
; Piece 2 = total pp hrs
;
; Error Codes = ARRAY VARIABLE contains a 1 for success or 0 for
; failure. If failed then error codes returned in Array 0 node
; 1 = pp undef
; 2 = emp undef
; 3 = no timecard for emp in pp
; Example
; >D TOURHRS^PRSARC04(.THRS,257,12711)
; >ZW THRS
; THRS=1
; THRS(1)=^0
; THRS(2)=1^3
; THRS(3)=1^6
; ...
; THRS(14)=^0
N SHIFTCD,ISWAGE,ZNODE,PRSD,SAT,LASTPPI
K THRARY
I '$D(^PRSPC(+$G(PRSIEN),0)) S THRARY=0,THRARY(0)="2^undefined employee"
I $G(TOURSTR)="" D
. I $G(PPI)'>0 S PPI=$P(^PRST(458,0),"^",3)
. I '$D(^PRST(458,+$G(PPI),0)) S THRARY=0,THRARY(0)="1^undefined pay period"
. S LASTPPI=PPI-1
. S ISWAGE=$$ISWAGE^PRSARC08(PRSIEN)
. ;
. ; Get ToD and Second ToD from last saturday of
. ; prior PP to check for spill over hrs onto day 1 of this PP.
. S SAT=$G(^PRST(458,LASTPPI,"E",PRSIEN,"D",14,0))
. S PRSD=0,T1=$P(SAT,U,2),T2=$P(SAT,U,13)
. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,LASTPPI)
. F PRSD=1:1:14 D
.. S ZNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
.. S T1=$P(ZNODE,U,2),T2=$P(ZNODE,U,13)
.. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
.. D PLACESHF(.THRARY,PRSD,T1,T2,ISWAGE)
.;
.; add compressed tour node if necessary
.I $$ISCMPTR^PRSARC08(PPI,PRSIEN) S THRARY("CT")=$$EARLYSH^PRSARC08(.THRARY,ISWAGE)_"^"_$$TOTAL^PRSARC08(.THRARY)
E D
.; use tourstring for tours
.; add prior tour spillover from 2nd Sat to first Sun
. I $G(PPI)>0 D
.. S SAT=$G(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0))
.. S PRSD=0,T1=$P(SAT,U,2),T2=$P(SAT,U,13)
.. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
. F PRSD=1:1:14 D
.. S T1=$P(TOURSTR,U,PRSD),T2=""
.. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
. ; wrap second saturday to first sunday (IF PPI NOT PASSED)
. I $G(PPI)="" S $P(THRARY(1),U,2)=$P(THRARY(1),U,2)+$P($G(THRARY(15)),U,2)
; Prior Sat THRARY(0) only needed temp to get any part of a two day
; tour that spilled onto THRARY(1)-1st Sun. Next Sun THRARY(15) is
; only an artifact.
S THRARY("W1")=$$TOTAL^PRSARC08(.THRARY,1)
S THRARY("W2")=$$TOTAL^PRSARC08(.THRARY,2)
K THRARY(0),THRARY(15)
Q
;
PLACEHRS(PRSTH,PRSIEN,PRSD,T1,T2,PPI) ; procedure puts hrs from tours on current
; day and next. called once for each day so a call for curr day
; may have hrs from prior two day tour
;
N CURHRS,CURSHFT,TODAYND,TOMORND,TODHRS,TOMHRS,TOURHRS
S TODAYND=$G(PRSTH(PRSD))
S TOMORND=$G(PRSTH(PRSD+1))
S TODHRS=$P(TODAYND,U,2)
S TOMHRS=$P(TOMORND,U,2)
;
; get tour 1 hrs-add to today, tomorrow
I T1>0 D
. S TOURHRS=$$TRHRS(1,PRSD,PRSIEN,T1,PPI)
. S TODHRS=TODHRS+$P(TOURHRS,U)
. S TOMHRS=TOMHRS+$P(TOURHRS,U,2)
;
; get tour 2 hrs-add to today, tomorrow
I T2>0 D
. S TOURHRS=$$TRHRS(2,PRSD,PRSIEN,T2,PPI)
. S TODHRS=TODHRS+$P(TOURHRS,U)
. S TOMHRS=TOMHRS+$P(TOURHRS,U,2)
;
; add tour hrs to array
S $P(PRSTH(PRSD),U,2)=TODHRS
;
; add hrs to day node of array
; (2 day tour hrs past midnight on last Sat. go in node 15)
;
S $P(PRSTH(PRSD+1),U,2)=TOMHRS
Q
TRHRS(TNUM,PRSD,PRSIEN,TOURIEN,PPI) ; return string w/ todays hrs p1 ^ tomorrows hrs p2
;
N TODHR,TOMHR,TOUR,TSEGS,TWODAYTR,REGHRS,DONE,CROSS,BEG,END,MEALTIME
N BEG24,END24,SEGTIME,SEGTOD,SEGTOM,I,SPECIND
;
S TODHR=0,TOMHR=0
I $G(TOURIEN)'>0 Q TODHR_"^"_TOMHR
S TOUR=$G(^PRST(457.1,TOURIEN,0))
I TNUM=1 S TSEGS=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
I TNUM=2 S TSEGS=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4))
I TSEGS="" S TSEGS=$G(^PRST(457.1,TOURIEN,1))
S TWODAYTR=$P(TOUR,U,5)="Y"
S MEALTIME=$P(TOUR,U,3)
I TNUM=1 S REGHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,8)
I TNUM=2 S REGHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,14)
I REGHRS'>0 S REGHRS=$P(TOUR,U,6)
I TWODAYTR D
. S (DONE,CROSS)=0
. F I=1:3:19 D Q:DONE
.. S BEG=$P(TSEGS,U,I)
.. I BEG="" S DONE=1 Q
.. S END=$P(TSEGS,U,I+1)
.. S SPECIND=$P(TSEGS,U,I+2)
..; only count regular hours
.. I SPECIND,"RG"'[$P($G(^PRST(457.2,+SPECIND,0)),"^",2) Q
..; convert beg & end to 24 hr to check if one < other (Xes midnight)
..; also crossed midnight if not first seg starts at midnight.
..; CROSS is true so remaining segments recorded to tomorrow.
.. S BEG24=$$TWENTY4^PRSPESR2(BEG)
.. S END24=$$TWENTY4^PRSPESR2(END)
.. I 'CROSS&(((BEG24'<END24)&(BEG24'=2400))!((I>1)&(BEG24=2400))) D
... S CROSS=1
... S SEGTOD=$S(BEG24=2400:0,1:$$AMT^PRSPSAPU(BEG,"MID",0))
... S SEGTOM=$$AMT^PRSPSAPU("MID",END,0)
... S TODHR=TODHR+SEGTOD
... S TOMHR=TOMHR+SEGTOM
.. E D
... S SEGTIME=$$AMT^PRSPSAPU(BEG,END,0)
... I CROSS D
.... S TOMHR=TOMHR+SEGTIME
... E D
.... S TODHR=TODHR+SEGTIME
. ;Pull meal off hrs for today, tomorrow or both.
. N HOURS S HOURS=$$PLACEML^PRSARC08(TODHR,TOMHR,MEALTIME)
. S TODHR=$P(HOURS,U)
. S TOMHR=$P(HOURS,U,2)
E D
. S TODHR=REGHRS
Q TODHR_"^"_TOMHR
;
PLACESHF(PRSTH,PRSD,T1,T2,WAGER) ;Place earliest shift from
; tour 1 and tour 2 in SDA Tour array (PRSTH)
;INPUT:
; PRSTH - array to store SDA tour info p1=shift, p2=tour hrs.
; PRSD - day number in pp 1-14
; T1, T2 - tour 1 and 2 (ien in ToD file)
; WAGER - 0 or 1 for whether this is a wage grade employee.
;OUTPUT:
; PRSTH by reference. Update "^" piece 1 with shift indicator
;
N SHIFT,T1SHFTS,T2SHFTS,SHIFTINI,EARLIEST,SHIFT2
;
; Wage grade always have a 0 for shift
I WAGER D
. S $P(PRSTH(PRSD),U)=0
E D
. S T1SHFTS=$$TRSHFTS^PRSARC08(T1) ; get tour 1 shift for today and tomorrow
. S T2SHFTS=$$TRSHFTS^PRSARC08(T2) ; and tour 2
.; Get any shift placed by a two day tour from yesterday.
.; Then find earliest shift from t1, t2 and two day carryover
. S SHIFTINI=$P($G(PRSTH(PRSD)),U) I SHIFTINI="" S SHIFTINI=4
. S SHIFT=$P(T1SHFTS,U) I SHIFT="" S SHIFT=4
. S SHIFT2=$P(T2SHFTS,U) I SHIFT2="" S SHIFT2=4
. S EARLIEST=SHIFTINI
. I SHIFT<SHIFTINI S EARLIEST=SHIFT
. I SHIFT2<EARLIEST S EARLIEST=SHIFT2
. I EARLIEST=4 S EARLIEST=""
. S $P(PRSTH(PRSD),U)=EARLIEST
. ;
. ; Now do anything for tomorrow
. S SHIFTINI=$P($G(PRSTH(PRSD+1)),U,1) I SHIFTINI="" S SHIFTINI=4
. S SHIFT=$P(T1SHFTS,U,2) I SHIFT="" S SHIFT=4
. S SHIFT2=$P(T2SHFTS,U,2) I SHIFT2="" S SHIFT2=4
. S EARLIEST=SHIFTINI
. I SHIFT<SHIFTINI S EARLIEST=SHIFT
. I SHIFT2<EARLIEST S EARLIEST=SHIFT2
. I EARLIEST=4 S EARLIEST=""
. S $P(PRSTH(PRSD+1),U)=EARLIEST
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSARC07 7950 printed Nov 22, 2024@17:34:13 Page 2
PRSARC07 ;WOIFO/JAH - Tour Hours Procedure ;01/07/08
+1 ;;4.0;PAID;**112,116**;Sep 21, 1995;Build 23
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
TOURHRS(THRARY,PPI,PRSIEN,TOURSTR) ; Return data for TOUR OF DUTY
+1 ;Input:
+2 ; PPI (optional) IEN of #458 otherwise curr PPI assumed.
+3 ; *If PPI and TOURSTR (or only PPI) defined then last pay period
+4 ; spill over from 2nd sat. is added to day 1.
+5 ; *If TOURSTR is defined but not PPI then tour hours
+6 ; from 2nd saturday of tour in TOURSTR are placed on 1st Sunday.
+7 ;
+8 ; PRSIEN (required) IEN-File (#450).
+9 ; TOURSTR (optional) if defined should contain 14 piece string
+10 ; delimited by "^" pieces 1-14 contain pointers
+11 ; to ToD file. Will be used instead of pp to determine
+12 ; tour hrs.
+13 ; Output
+14 ; THRARY (TOUR HRS ARRAY)-2 piece array subsc by day #.
+15 ; W1 & W2 node w/ wkly tour hrs.
+16 ; Piece one = Shift code:
+17 ; -Null when no tour hrs fall on that day.
+18 ; -Always 0 for Wage Grades
+19 ; -1, 2, or 3 corresponds to earliest shift on day being reported.
+20 ; Piece two = total hrs for tours that fall on each day.
+21 ; Tours crossing midnight--hrs placed in node on day the occur
+22 ; SPECIAL CASE: COMPRESSED TOURS: "CT" node is defined
+23 ; Piece one set to shift (earliest for pp or 0 for wage)
+24 ; Piece 2 = total pp hrs
+25 ;
+26 ; Error Codes = ARRAY VARIABLE contains a 1 for success or 0 for
+27 ; failure. If failed then error codes returned in Array 0 node
+28 ; 1 = pp undef
+29 ; 2 = emp undef
+30 ; 3 = no timecard for emp in pp
+31 ; Example
+32 ; >D TOURHRS^PRSARC04(.THRS,257,12711)
+33 ; >ZW THRS
+34 ; THRS=1
+35 ; THRS(1)=^0
+36 ; THRS(2)=1^3
+37 ; THRS(3)=1^6
+38 ; ...
+39 ; THRS(14)=^0
+40 NEW SHIFTCD,ISWAGE,ZNODE,PRSD,SAT,LASTPPI
+41 KILL THRARY
+42 IF '$DATA(^PRSPC(+$GET(PRSIEN),0))
SET THRARY=0
SET THRARY(0)="2^undefined employee"
+43 IF $GET(TOURSTR)=""
Begin DoDot:1
+44 IF $GET(PPI)'>0
SET PPI=$PIECE(^PRST(458,0),"^",3)
+45 IF '$DATA(^PRST(458,+$GET(PPI),0))
SET THRARY=0
SET THRARY(0)="1^undefined pay period"
+46 SET LASTPPI=PPI-1
+47 SET ISWAGE=$$ISWAGE^PRSARC08(PRSIEN)
+48 ;
+49 ; Get ToD and Second ToD from last saturday of
+50 ; prior PP to check for spill over hrs onto day 1 of this PP.
+51 SET SAT=$GET(^PRST(458,LASTPPI,"E",PRSIEN,"D",14,0))
+52 SET PRSD=0
SET T1=$PIECE(SAT,U,2)
SET T2=$PIECE(SAT,U,13)
+53 DO PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,LASTPPI)
+54 FOR PRSD=1:1:14
Begin DoDot:2
+55 SET ZNODE=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
+56 SET T1=$PIECE(ZNODE,U,2)
SET T2=$PIECE(ZNODE,U,13)
+57 DO PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
+58 DO PLACESHF(.THRARY,PRSD,T1,T2,ISWAGE)
End DoDot:2
+59 ;
+60 ; add compressed tour node if necessary
+61 IF $$ISCMPTR^PRSARC08(PPI,PRSIEN)
SET THRARY("CT")=$$EARLYSH^PRSARC08(.THRARY,ISWAGE)_"^"_$$TOTAL^PRSARC08(.THRARY)
End DoDot:1
+62 IF '$TEST
Begin DoDot:1
+63 ; use tourstring for tours
+64 ; add prior tour spillover from 2nd Sat to first Sun
+65 IF $GET(PPI)>0
Begin DoDot:2
+66 SET SAT=$GET(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0))
+67 SET PRSD=0
SET T1=$PIECE(SAT,U,2)
SET T2=$PIECE(SAT,U,13)
+68 DO PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
End DoDot:2
+69 FOR PRSD=1:1:14
Begin DoDot:2
+70 SET T1=$PIECE(TOURSTR,U,PRSD)
SET T2=""
+71 DO PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
End DoDot:2
+72 ; wrap second saturday to first sunday (IF PPI NOT PASSED)
+73 IF $GET(PPI)=""
SET $PIECE(THRARY(1),U,2)=$PIECE(THRARY(1),U,2)+$PIECE($GET(THRARY(15)),U,2)
End DoDot:1
+74 ; Prior Sat THRARY(0) only needed temp to get any part of a two day
+75 ; tour that spilled onto THRARY(1)-1st Sun. Next Sun THRARY(15) is
+76 ; only an artifact.
+77 SET THRARY("W1")=$$TOTAL^PRSARC08(.THRARY,1)
+78 SET THRARY("W2")=$$TOTAL^PRSARC08(.THRARY,2)
+79 KILL THRARY(0),THRARY(15)
+80 QUIT
+81 ;
PLACEHRS(PRSTH,PRSIEN,PRSD,T1,T2,PPI) ; procedure puts hrs from tours on current
+1 ; day and next. called once for each day so a call for curr day
+2 ; may have hrs from prior two day tour
+3 ;
+4 NEW CURHRS,CURSHFT,TODAYND,TOMORND,TODHRS,TOMHRS,TOURHRS
+5 SET TODAYND=$GET(PRSTH(PRSD))
+6 SET TOMORND=$GET(PRSTH(PRSD+1))
+7 SET TODHRS=$PIECE(TODAYND,U,2)
+8 SET TOMHRS=$PIECE(TOMORND,U,2)
+9 ;
+10 ; get tour 1 hrs-add to today, tomorrow
+11 IF T1>0
Begin DoDot:1
+12 SET TOURHRS=$$TRHRS(1,PRSD,PRSIEN,T1,PPI)
+13 SET TODHRS=TODHRS+$PIECE(TOURHRS,U)
+14 SET TOMHRS=TOMHRS+$PIECE(TOURHRS,U,2)
End DoDot:1
+15 ;
+16 ; get tour 2 hrs-add to today, tomorrow
+17 IF T2>0
Begin DoDot:1
+18 SET TOURHRS=$$TRHRS(2,PRSD,PRSIEN,T2,PPI)
+19 SET TODHRS=TODHRS+$PIECE(TOURHRS,U)
+20 SET TOMHRS=TOMHRS+$PIECE(TOURHRS,U,2)
End DoDot:1
+21 ;
+22 ; add tour hrs to array
+23 SET $PIECE(PRSTH(PRSD),U,2)=TODHRS
+24 ;
+25 ; add hrs to day node of array
+26 ; (2 day tour hrs past midnight on last Sat. go in node 15)
+27 ;
+28 SET $PIECE(PRSTH(PRSD+1),U,2)=TOMHRS
+29 QUIT
TRHRS(TNUM,PRSD,PRSIEN,TOURIEN,PPI) ; return string w/ todays hrs p1 ^ tomorrows hrs p2
+1 ;
+2 NEW TODHR,TOMHR,TOUR,TSEGS,TWODAYTR,REGHRS,DONE,CROSS,BEG,END,MEALTIME
+3 NEW BEG24,END24,SEGTIME,SEGTOD,SEGTOM,I,SPECIND
+4 ;
+5 SET TODHR=0
SET TOMHR=0
+6 IF $GET(TOURIEN)'>0
QUIT TODHR_"^"_TOMHR
+7 SET TOUR=$GET(^PRST(457.1,TOURIEN,0))
+8 IF TNUM=1
SET TSEGS=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
+9 IF TNUM=2
SET TSEGS=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4))
+10 IF TSEGS=""
SET TSEGS=$GET(^PRST(457.1,TOURIEN,1))
+11 SET TWODAYTR=$PIECE(TOUR,U,5)="Y"
+12 SET MEALTIME=$PIECE(TOUR,U,3)
+13 IF TNUM=1
SET REGHRS=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,8)
+14 IF TNUM=2
SET REGHRS=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,14)
+15 IF REGHRS'>0
SET REGHRS=$PIECE(TOUR,U,6)
+16 IF TWODAYTR
Begin DoDot:1
+17 SET (DONE,CROSS)=0
+18 FOR I=1:3:19
Begin DoDot:2
+19 SET BEG=$PIECE(TSEGS,U,I)
+20 IF BEG=""
SET DONE=1
QUIT
+21 SET END=$PIECE(TSEGS,U,I+1)
+22 SET SPECIND=$PIECE(TSEGS,U,I+2)
+23 ; only count regular hours
+24 IF SPECIND
IF "RG"'[$PIECE($GET(^PRST(457.2,+SPECIND,0)),"^",2)
QUIT
+25 ; convert beg & end to 24 hr to check if one < other (Xes midnight)
+26 ; also crossed midnight if not first seg starts at midnight.
+27 ; CROSS is true so remaining segments recorded to tomorrow.
+28 SET BEG24=$$TWENTY4^PRSPESR2(BEG)
+29 SET END24=$$TWENTY4^PRSPESR2(END)
+30 IF 'CROSS&(((BEG24'<END24)&(BEG24'=2400))!((I>1)&(BEG24=2400)))
Begin DoDot:3
+31 SET CROSS=1
+32 SET SEGTOD=$SELECT(BEG24=2400:0,1:$$AMT^PRSPSAPU(BEG,"MID",0))
+33 SET SEGTOM=$$AMT^PRSPSAPU("MID",END,0)
+34 SET TODHR=TODHR+SEGTOD
+35 SET TOMHR=TOMHR+SEGTOM
End DoDot:3
+36 IF '$TEST
Begin DoDot:3
+37 SET SEGTIME=$$AMT^PRSPSAPU(BEG,END,0)
+38 IF CROSS
Begin DoDot:4
+39 SET TOMHR=TOMHR+SEGTIME
End DoDot:4
+40 IF '$TEST
Begin DoDot:4
+41 SET TODHR=TODHR+SEGTIME
End DoDot:4
End DoDot:3
End DoDot:2
if DONE
QUIT
+42 ;Pull meal off hrs for today, tomorrow or both.
+43 NEW HOURS
SET HOURS=$$PLACEML^PRSARC08(TODHR,TOMHR,MEALTIME)
+44 SET TODHR=$PIECE(HOURS,U)
+45 SET TOMHR=$PIECE(HOURS,U,2)
End DoDot:1
+46 IF '$TEST
Begin DoDot:1
+47 SET TODHR=REGHRS
End DoDot:1
+48 QUIT TODHR_"^"_TOMHR
+49 ;
PLACESHF(PRSTH,PRSD,T1,T2,WAGER) ;Place earliest shift from
+1 ; tour 1 and tour 2 in SDA Tour array (PRSTH)
+2 ;INPUT:
+3 ; PRSTH - array to store SDA tour info p1=shift, p2=tour hrs.
+4 ; PRSD - day number in pp 1-14
+5 ; T1, T2 - tour 1 and 2 (ien in ToD file)
+6 ; WAGER - 0 or 1 for whether this is a wage grade employee.
+7 ;OUTPUT:
+8 ; PRSTH by reference. Update "^" piece 1 with shift indicator
+9 ;
+10 NEW SHIFT,T1SHFTS,T2SHFTS,SHIFTINI,EARLIEST,SHIFT2
+11 ;
+12 ; Wage grade always have a 0 for shift
+13 IF WAGER
Begin DoDot:1
+14 SET $PIECE(PRSTH(PRSD),U)=0
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 ; get tour 1 shift for today and tomorrow
SET T1SHFTS=$$TRSHFTS^PRSARC08(T1)
+17 ; and tour 2
SET T2SHFTS=$$TRSHFTS^PRSARC08(T2)
+18 ; Get any shift placed by a two day tour from yesterday.
+19 ; Then find earliest shift from t1, t2 and two day carryover
+20 SET SHIFTINI=$PIECE($GET(PRSTH(PRSD)),U)
IF SHIFTINI=""
SET SHIFTINI=4
+21 SET SHIFT=$PIECE(T1SHFTS,U)
IF SHIFT=""
SET SHIFT=4
+22 SET SHIFT2=$PIECE(T2SHFTS,U)
IF SHIFT2=""
SET SHIFT2=4
+23 SET EARLIEST=SHIFTINI
+24 IF SHIFT<SHIFTINI
SET EARLIEST=SHIFT
+25 IF SHIFT2<EARLIEST
SET EARLIEST=SHIFT2
+26 IF EARLIEST=4
SET EARLIEST=""
+27 SET $PIECE(PRSTH(PRSD),U)=EARLIEST
+28 ;
+29 ; Now do anything for tomorrow
+30 SET SHIFTINI=$PIECE($GET(PRSTH(PRSD+1)),U,1)
IF SHIFTINI=""
SET SHIFTINI=4
+31 SET SHIFT=$PIECE(T1SHFTS,U,2)
IF SHIFT=""
SET SHIFT=4
+32 SET SHIFT2=$PIECE(T2SHFTS,U,2)
IF SHIFT2=""
SET SHIFT2=4
+33 SET EARLIEST=SHIFTINI
+34 IF SHIFT<SHIFTINI
SET EARLIEST=SHIFT
+35 IF SHIFT2<EARLIEST
SET EARLIEST=SHIFT2
+36 IF EARLIEST=4
SET EARLIEST=""
+37 SET $PIECE(PRSTH(PRSD+1),U)=EARLIEST
End DoDot:1
+38 QUIT
+39 ;
