PRSATE6 ; WCIOFO/JAH-VALIDATE FIREFIGHTER TOURS OF DUTY (ToD);3/19/99
;;4.0;PAID;**45,132**;Sep 21, 1995;Build 13
Q
FFTOUR(PPI,DFN,WHICHPP,ERROR) ; Validate a Firefighter ToD
N WK1BTOT,WK2BTOT,BASEMAX,PMP
;
S PMP=$$GETPMP(DFN)
;
;Define maximum base hrs for 1 week of a firefighter ToD.
;
S BASEMAX=$$GETBSMAX(DFN,PPI,WHICHPP)
;
; Loop thru week 1,2 & get total base ToD hrs scheduled.
;
D GETTOTS(PPI,DFN,WHICHPP,.WK1BTOT,.WK2BTOT)
;
; convert minutes to 1/4 hour segments
;
S WK1BTOT=WK1BTOT/15,WK2BTOT=WK2BTOT/15
;
; Determine any error in ToD
;
D GETERROR(WK1BTOT,WK2BTOT,BASEMAX,PMP,.ERROR)
;
; display any errors
;
I $$ISERRORS(.ERROR) D
. D DISPERR(PPI,DFN,PMP,WHICHPP,.ERROR,BASEMAX)
Q
;=======================
;
GETBSMAX(DFN,PPI,WHICHPP) ; GET MAX BASE ToD HRS FOR FIREFIGHTER'S WEEK
;INPUT:
; Employee DFN or internal entry number in file 450
;OUTPUT:
; return total base hrs in .25 hr segments that
; this fire fighter is allowed in a week of thier ToD.
; If this isn't a firefighter (Premium pay indicator C)
; then return 0
;
S MAX=0
S TOURTYPE=$$FLEXIND(PPI,DFN,WHICHPP)
S MAX=$S(TOURTYPE="C":53,1:40)
Q MAX*4
;=======================
;
GETPMP(DFN) ; RETURN PREMIUM PAY INDICATOR CODE FROM FILE 450
;^DD(450,548,0) = PREMIUM PAY IND^F^^PREMIUM;6
Q $P($G(^PRSPC(DFN,"PREMIUM")),"^",6)
;=======================
;
GETTOTS(PPI,DFN,WHICHPP,WK1TOT,WK2TOT) ;
N TOURDAY,TOUR,SEGMNT,START,STOP,SPECIND
;
S (WK1TOT,WK2TOT)=0
F TOURDAY=1:1:14 D
. S TOUR=$$GETTOUR(PPI,DFN,WHICHPP,TOURDAY)
. S MEAL=$$MEALTM(PPI,DFN,TOURDAY,WHICHPP)
.;
.; Read each segment of ToD.
.;
. F SEGMNT=1:3 D Q:$P(TOUR,"^",SEGMNT)=""
.. S (STARTHR,START)=$P(TOUR,"^",SEGMNT)
.. S (STOPHR,STOP)=$P(TOUR,"^",SEGMNT+1)
.. S SPECIND=$P(TOUR,"^",SEGMNT+2)
..;
..; if this is base ToD hours then add the time to the approriate
..; week.
..;
.. I SPECIND="",$G(START)'="",$G(STOP)'="" D
... D MINUTES(.START,.STOP)
... S (WK1LEN,WK2LEN)=0
...;
...; when ToD crosses midnight check if it's Sat. or Sun
...; & adjust the stop time
...;
... I STOP<(START+1) D
.... I (TOURDAY#7)=0 D
..... D SPLIT(STARTHR,STOPHR,.WK1LEN,.WK2LEN)
..... I WK1LEN+1>WK2LEN S WK1LEN=WK1LEN-MEAL
..... I WK1LEN<WK2LEN S WK2LEN=WK2LEN-MEAL
..... D UPTOT(.WK1TOT,.WK2TOT,WK1LEN,WK2LEN)
.... E D
..... S STOP=1440+STOP
..... S LEN=STOP-START-MEAL
..... I TOURDAY<8 D UPTOT(.WK1TOT,.WK2TOT,LEN,0)
..... I TOURDAY>7 D UPTOT(.WK1TOT,.WK2TOT,0,LEN)
... E D
.... S LEN=STOP-START-MEAL
.... I TOURDAY<8 D UPTOT(.WK1TOT,.WK2TOT,LEN,0)
.... I TOURDAY>7 D UPTOT(.WK1TOT,.WK2TOT,0,LEN)
;
Q
;=======================
;
MEALTM(PPI,DFN,DAY,WHICHPP) ;
; RETURN LENGTH OF MEALTIME FOR THIS EMPs ToD ON THIS DAY.
N TOUR
S LEN=0
S TOUR=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0))
S TOUR=$P(TOUR,"^",2)
I $P(TOUR,"^",4),(WHICHPP="N") S TOUR=$P(TOUR,"^",4)
I TOUR S LEN=$P($G(^PRST(457.1,TOUR,0)),"^",3)
;
Q LEN
;=======================
;
MINUTES(T1,T2) ; CONVERT TIME 1 & TWO TO MINUTES FROM MIDNIGHT
; OF THE CURRENT DAY. IF T2 IS LESS THAN OR EQUAL TO T1 THEN
; IT IS ASSUMMED TO BE ON THE NEXT DAY.
;
N X,Y
;
;call to convert start & stop to minutes from midnight
;
S X=T1_"^"_T2
D CNV^PRSATIM
S T1=$P(Y,"^",1),T2=$P(Y,"^",2)
Q
;=======================
;
SPLIT(DAY,T1,T2,L1,L2) ; SPLIT two day ToD into 2 segments.
;INPUT:
; DAY = day of pay period that the ToD begins.
; T1 = start time of ToD in 08:00A format.
; T2 = stop time of ToD in 11:00P format.
;OUTPUT:
; L1 = Length of ToD (minutes) from start time to midnight.
; L2 = Length of ToD (min) from midnight to stop time in next day.
;
N X,Y
S X=T1_"^"_"MID"
D CNV^PRSATIM
S L1=$P(Y,"^",2)-$P(Y,"^",1)
S X="MID^"_T2
S L2=$P(Y,"^",2)-$P(Y,"^",1)
;
; If it's the 2nd Sat of the pay period then move the carry over
; to the first week of this pay period.
;
I DAY=14 S TEMP=L2,L2=L1,L1=TEMP
Q
;=======================
;
UPTOT(W1T,W2T,W1LN,W2LN) ;
S W1T=W1T+W1LN
S W2T=W2T+W2LN
Q
;=======================
;
GETERROR(W1TOT,W2TOT,BMAX,PMP,ERROR) ;
;
; 1. Code C firefighters on compressed ToDs may not have base
; ToD hours that exceed 53 for either week 1 or 2.
; 2. Code C firefighters without compressed ToDs may not have
; base hours that exceed 40 for either week 1 or 2.
; 3. Code C firefighters may not have base ToD hours that
; exceed 80.
;
I PMP="C" D
. I W1TOT>BMAX S ERROR(1)=1
. I W2TOT>BMAX S ERROR(2)=1
. I (W2TOT+W1TOT)>(80*4) S ERROR(3)=1
Q
;=======================
;
ISERRORS(ERROR) ; RETURN TRUE IF THERE ARE ERRORS IN THE ERROR ARRAY
S (ENUM,IS)=0
F S ENUM=$O(ERROR(ENUM)) Q:ENUM=""!IS I +$G(ERROR(ENUM)) S IS=1
;
Q IS
;=======================
;
DISPERR(PPI,DFN,PMP,WHICHPP,ERROR,BMAX) ;
;
; See GETERRORS for error descriptions.
;
N FLX,COUNT,WK
S FLX=$$FLEXIND(PPI,DFN,WHICHPP)
S FLX=$S(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None")
;
S WK="",COUNT=0
I $G(ERROR(1)) S WK="one"
I $G(ERROR(2)) S WK="two"
I WK="two",$G(ERROR(1)) S WK="one and two"
W @IOF,!!!,?5,"There are the following problems with the tour entered:"
I +$G(ERROR(1))!(+$G(ERROR(2))) D
. S COUNT=COUNT+1
. W !!,?7,COUNT,". Code ",PMP," firefighters with a compressed/flex "
. W !,?11,"indicator of ",FLX," may not have BASE tour hours that "
. W !,?11,"exceed ",BMAX/4," for week ",WK,"."
;
I +$G(ERROR(3)) D
. S COUNT=COUNT+1
. W !!,?7,COUNT,". Code ",PMP," firefighters may not have BASE tour "
. W !,?11,"hours that exceed 80 for the pay period."
;
Q
;=======================
;
ASKTOFIX() ;RETURN TK RESPONSE--DO YOU WANT TO FIX THE ToD?
N DIR,DIRUT,Y
W !!
S DIR("A",1)="This tour MUST BE CORRECTED or it will be removed."
S DIR("A")="Correct the tour"
S DIR(0)="Y"
S DIR("B")="Y"
S DIR("?",1)=" You must correct the tour. Answer Yes to re-edit the tour."
S DIR("?")=" If you answer No the entire tour will be removed. "
D ^DIR
Q Y
;=======================
;
GETTOUR(PPI,DFN,WHICHPP,PPDAY) ; This function returns the employees ToD
; based on the WHICHPP variable. WHICHPP can be set to N, for next
; pay period, or C for current pay period or 'L' for last. If set
; to 'N'ext, we have to look at the prior scheduled field in the
; current pay period to see if the ToD is changing next pp.
;
N TEMPTOUR,TOURNODE,TOUR
I PPI'>0!(DFN'>0)!(PPDAY'>0) Q 0
S TOURNODE=$G(^PRST(458,PPI,"E",DFN,"D",PPDAY,0))
S TOUR=$P(TOURNODE,U,2)
S TEMPTOUR=$P(TOURNODE,U,3)
I WHICHPP="N",+TEMPTOUR D
. S TOUR=$P(TOURNODE,"^",4)
I TOUR'>0 Q 0
Q $G(^PRST(457.1,TOUR,1))
;=======================
;
SAVETOUR(PPI,DFN) ;SAVE ToD in ^TMP global
;
S %X="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
S %Y="^TMP($J,""OLDTOUR""," D %XY^%RCR
Q
;=======================
;
RESTORE(PPI,DFN) ;restore a ToD
; use with EXTREME CAUTION. SAVETOUR should be called 1st.
; This utility first removes the entire "D" node from the
; input employee's pay period record. It depends on the fact that
; a backup of an earlier copy of the "D" node was saved in TMP.
N %X,%Y
K ^PRST(458,PPI,"E",DFN,"D")
S %X="^TMP($J,""OLDTOUR"","
S %Y="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
D %XY^%RCR
Q
;=======================
;
ASKTEMP() ; ASK USER-TEMP OR PERM ToD CHANGE
N DIR,DIRUT
S DIR("A")="Is this tour change Temporary or Permanent? "
S DIR("B")="P"
S DIR(0)="SAMO^P:Permanent;T:Temporary"
S DIR("?")="A Temporary change is for this Pay Period only."
S DIR("?",1)="A Permanent change is for this and future Pay Periods."
D ^DIR
I $D(DIRUT) S Y="^"
Q Y
;=======================
;
GETEMP(TLE) ; SELECT EMP FROM THE PASSED T&L UNIT
N DIC,X,Y,D
S DIC("A")="Select EMPLOYEE: "
S DIC("S")="I $P(^(0),""^"",8)=TLE"
S DIC(0)="AEQM"
S DIC="^PRSPC("
S D="ATL"_TLE
W ! D IX^DIC S DFN=+Y K DIC
Q DFN
;=======================
;
FLEXIND(PPI,DFN,WHICHPP) ;
;Return emp's flexitime code (compressed, flex or none)
; INPUT:
; PPI = pp internal #
; DFN = emps internal # from 450/458
; WHICHPP = N for next pp otherwise current
Q $P($G(^PRST(458,PPI,"E",DFN,0)),"^",$S(WHICHPP="N":7,1:6))
;=======================
;
ASKTLWRK(TLE) ; ASK TIMEKEEP WHICH TLU ToD WILL BE WORKED
N DIC,X,Y
S DIC="^PRST(455.5,"
S DIC(0)="AEQM"
S DIC("A")="T&L on which Tour will be worked: "
S DIC("B")=TLE
W ! D ^DIC
Q +Y
;
ASKTWMF() ;ask telework tour for fixed monday/friday tour
N DIR,DIRUT,X,Y
S DIR("A")="Do you wish to schedule any telework tours"
S DIR(0)="Y",DIR("?")="Answer NO if there is no telework day for the pay period."
D ^DIR
QUIT $S(Y=0:"N",Y=1:"Y",1:"^")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATE6 9015 printed Dec 13, 2024@02:24:32 Page 2
PRSATE6 ; WCIOFO/JAH-VALIDATE FIREFIGHTER TOURS OF DUTY (ToD);3/19/99
+1 ;;4.0;PAID;**45,132**;Sep 21, 1995;Build 13
+2 QUIT
FFTOUR(PPI,DFN,WHICHPP,ERROR) ; Validate a Firefighter ToD
+1 NEW WK1BTOT,WK2BTOT,BASEMAX,PMP
+2 ;
+3 SET PMP=$$GETPMP(DFN)
+4 ;
+5 ;Define maximum base hrs for 1 week of a firefighter ToD.
+6 ;
+7 SET BASEMAX=$$GETBSMAX(DFN,PPI,WHICHPP)
+8 ;
+9 ; Loop thru week 1,2 & get total base ToD hrs scheduled.
+10 ;
+11 DO GETTOTS(PPI,DFN,WHICHPP,.WK1BTOT,.WK2BTOT)
+12 ;
+13 ; convert minutes to 1/4 hour segments
+14 ;
+15 SET WK1BTOT=WK1BTOT/15
SET WK2BTOT=WK2BTOT/15
+16 ;
+17 ; Determine any error in ToD
+18 ;
+19 DO GETERROR(WK1BTOT,WK2BTOT,BASEMAX,PMP,.ERROR)
+20 ;
+21 ; display any errors
+22 ;
+23 IF $$ISERRORS(.ERROR)
Begin DoDot:1
+24 DO DISPERR(PPI,DFN,PMP,WHICHPP,.ERROR,BASEMAX)
End DoDot:1
+25 QUIT
+26 ;=======================
+27 ;
GETBSMAX(DFN,PPI,WHICHPP) ; GET MAX BASE ToD HRS FOR FIREFIGHTER'S WEEK
+1 ;INPUT:
+2 ; Employee DFN or internal entry number in file 450
+3 ;OUTPUT:
+4 ; return total base hrs in .25 hr segments that
+5 ; this fire fighter is allowed in a week of thier ToD.
+6 ; If this isn't a firefighter (Premium pay indicator C)
+7 ; then return 0
+8 ;
+9 SET MAX=0
+10 SET TOURTYPE=$$FLEXIND(PPI,DFN,WHICHPP)
+11 SET MAX=$SELECT(TOURTYPE="C":53,1:40)
+12 QUIT MAX*4
+13 ;=======================
+14 ;
GETPMP(DFN) ; RETURN PREMIUM PAY INDICATOR CODE FROM FILE 450
+1 ;^DD(450,548,0) = PREMIUM PAY IND^F^^PREMIUM;6
+2 QUIT $PIECE($GET(^PRSPC(DFN,"PREMIUM")),"^",6)
+3 ;=======================
+4 ;
GETTOTS(PPI,DFN,WHICHPP,WK1TOT,WK2TOT) ;
+1 NEW TOURDAY,TOUR,SEGMNT,START,STOP,SPECIND
+2 ;
+3 SET (WK1TOT,WK2TOT)=0
+4 FOR TOURDAY=1:1:14
Begin DoDot:1
+5 SET TOUR=$$GETTOUR(PPI,DFN,WHICHPP,TOURDAY)
+6 SET MEAL=$$MEALTM(PPI,DFN,TOURDAY,WHICHPP)
+7 ;
+8 ; Read each segment of ToD.
+9 ;
+10 FOR SEGMNT=1:3
Begin DoDot:2
+11 SET (STARTHR,START)=$PIECE(TOUR,"^",SEGMNT)
+12 SET (STOPHR,STOP)=$PIECE(TOUR,"^",SEGMNT+1)
+13 SET SPECIND=$PIECE(TOUR,"^",SEGMNT+2)
+14 ;
+15 ; if this is base ToD hours then add the time to the approriate
+16 ; week.
+17 ;
+18 IF SPECIND=""
IF $GET(START)'=""
IF $GET(STOP)'=""
Begin DoDot:3
+19 DO MINUTES(.START,.STOP)
+20 SET (WK1LEN,WK2LEN)=0
+21 ;
+22 ; when ToD crosses midnight check if it's Sat. or Sun
+23 ; & adjust the stop time
+24 ;
+25 IF STOP<(START+1)
Begin DoDot:4
+26 IF (TOURDAY#7)=0
Begin DoDot:5
+27 DO SPLIT(STARTHR,STOPHR,.WK1LEN,.WK2LEN)
+28 IF WK1LEN+1>WK2LEN
SET WK1LEN=WK1LEN-MEAL
+29 IF WK1LEN<WK2LEN
SET WK2LEN=WK2LEN-MEAL
+30 DO UPTOT(.WK1TOT,.WK2TOT,WK1LEN,WK2LEN)
End DoDot:5
+31 IF '$TEST
Begin DoDot:5
+32 SET STOP=1440+STOP
+33 SET LEN=STOP-START-MEAL
+34 IF TOURDAY<8
DO UPTOT(.WK1TOT,.WK2TOT,LEN,0)
+35 IF TOURDAY>7
DO UPTOT(.WK1TOT,.WK2TOT,0,LEN)
End DoDot:5
End DoDot:4
+36 IF '$TEST
Begin DoDot:4
+37 SET LEN=STOP-START-MEAL
+38 IF TOURDAY<8
DO UPTOT(.WK1TOT,.WK2TOT,LEN,0)
+39 IF TOURDAY>7
DO UPTOT(.WK1TOT,.WK2TOT,0,LEN)
End DoDot:4
End DoDot:3
End DoDot:2
if $PIECE(TOUR,"^",SEGMNT)=""
QUIT
End DoDot:1
+40 ;
+41 QUIT
+42 ;=======================
+43 ;
MEALTM(PPI,DFN,DAY,WHICHPP) ;
+1 ; RETURN LENGTH OF MEALTIME FOR THIS EMPs ToD ON THIS DAY.
+2 NEW TOUR
+3 SET LEN=0
+4 SET TOUR=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,0))
+5 SET TOUR=$PIECE(TOUR,"^",2)
+6 IF $PIECE(TOUR,"^",4)
IF (WHICHPP="N")
SET TOUR=$PIECE(TOUR,"^",4)
+7 IF TOUR
SET LEN=$PIECE($GET(^PRST(457.1,TOUR,0)),"^",3)
+8 ;
+9 QUIT LEN
+10 ;=======================
+11 ;
MINUTES(T1,T2) ; CONVERT TIME 1 & TWO TO MINUTES FROM MIDNIGHT
+1 ; OF THE CURRENT DAY. IF T2 IS LESS THAN OR EQUAL TO T1 THEN
+2 ; IT IS ASSUMMED TO BE ON THE NEXT DAY.
+3 ;
+4 NEW X,Y
+5 ;
+6 ;call to convert start & stop to minutes from midnight
+7 ;
+8 SET X=T1_"^"_T2
+9 DO CNV^PRSATIM
+10 SET T1=$PIECE(Y,"^",1)
SET T2=$PIECE(Y,"^",2)
+11 QUIT
+12 ;=======================
+13 ;
SPLIT(DAY,T1,T2,L1,L2) ; SPLIT two day ToD into 2 segments.
+1 ;INPUT:
+2 ; DAY = day of pay period that the ToD begins.
+3 ; T1 = start time of ToD in 08:00A format.
+4 ; T2 = stop time of ToD in 11:00P format.
+5 ;OUTPUT:
+6 ; L1 = Length of ToD (minutes) from start time to midnight.
+7 ; L2 = Length of ToD (min) from midnight to stop time in next day.
+8 ;
+9 NEW X,Y
+10 SET X=T1_"^"_"MID"
+11 DO CNV^PRSATIM
+12 SET L1=$PIECE(Y,"^",2)-$PIECE(Y,"^",1)
+13 SET X="MID^"_T2
+14 SET L2=$PIECE(Y,"^",2)-$PIECE(Y,"^",1)
+15 ;
+16 ; If it's the 2nd Sat of the pay period then move the carry over
+17 ; to the first week of this pay period.
+18 ;
+19 IF DAY=14
SET TEMP=L2
SET L2=L1
SET L1=TEMP
+20 QUIT
+21 ;=======================
+22 ;
UPTOT(W1T,W2T,W1LN,W2LN) ;
+1 SET W1T=W1T+W1LN
+2 SET W2T=W2T+W2LN
+3 QUIT
+4 ;=======================
+5 ;
GETERROR(W1TOT,W2TOT,BMAX,PMP,ERROR) ;
+1 ;
+2 ; 1. Code C firefighters on compressed ToDs may not have base
+3 ; ToD hours that exceed 53 for either week 1 or 2.
+4 ; 2. Code C firefighters without compressed ToDs may not have
+5 ; base hours that exceed 40 for either week 1 or 2.
+6 ; 3. Code C firefighters may not have base ToD hours that
+7 ; exceed 80.
+8 ;
+9 IF PMP="C"
Begin DoDot:1
+10 IF W1TOT>BMAX
SET ERROR(1)=1
+11 IF W2TOT>BMAX
SET ERROR(2)=1
+12 IF (W2TOT+W1TOT)>(80*4)
SET ERROR(3)=1
End DoDot:1
+13 QUIT
+14 ;=======================
+15 ;
ISERRORS(ERROR) ; RETURN TRUE IF THERE ARE ERRORS IN THE ERROR ARRAY
+1 SET (ENUM,IS)=0
+2 FOR
SET ENUM=$ORDER(ERROR(ENUM))
if ENUM=""!IS
QUIT
IF +$GET(ERROR(ENUM))
SET IS=1
+3 ;
+4 QUIT IS
+5 ;=======================
+6 ;
DISPERR(PPI,DFN,PMP,WHICHPP,ERROR,BMAX) ;
+1 ;
+2 ; See GETERRORS for error descriptions.
+3 ;
+4 NEW FLX,COUNT,WK
+5 SET FLX=$$FLEXIND(PPI,DFN,WHICHPP)
+6 SET FLX=$SELECT(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None")
+7 ;
+8 SET WK=""
SET COUNT=0
+9 IF $GET(ERROR(1))
SET WK="one"
+10 IF $GET(ERROR(2))
SET WK="two"
+11 IF WK="two"
IF $GET(ERROR(1))
SET WK="one and two"
+12 WRITE @IOF,!!!,?5,"There are the following problems with the tour entered:"
+13 IF +$GET(ERROR(1))!(+$GET(ERROR(2)))
Begin DoDot:1
+14 SET COUNT=COUNT+1
+15 WRITE !!,?7,COUNT,". Code ",PMP," firefighters with a compressed/flex "
+16 WRITE !,?11,"indicator of ",FLX," may not have BASE tour hours that "
+17 WRITE !,?11,"exceed ",BMAX/4," for week ",WK,"."
End DoDot:1
+18 ;
+19 IF +$GET(ERROR(3))
Begin DoDot:1
+20 SET COUNT=COUNT+1
+21 WRITE !!,?7,COUNT,". Code ",PMP," firefighters may not have BASE tour "
+22 WRITE !,?11,"hours that exceed 80 for the pay period."
End DoDot:1
+23 ;
+24 QUIT
+25 ;=======================
+26 ;
ASKTOFIX() ;RETURN TK RESPONSE--DO YOU WANT TO FIX THE ToD?
+1 NEW DIR,DIRUT,Y
+2 WRITE !!
+3 SET DIR("A",1)="This tour MUST BE CORRECTED or it will be removed."
+4 SET DIR("A")="Correct the tour"
+5 SET DIR(0)="Y"
+6 SET DIR("B")="Y"
+7 SET DIR("?",1)=" You must correct the tour. Answer Yes to re-edit the tour."
+8 SET DIR("?")=" If you answer No the entire tour will be removed. "
+9 DO ^DIR
+10 QUIT Y
+11 ;=======================
+12 ;
GETTOUR(PPI,DFN,WHICHPP,PPDAY) ; This function returns the employees ToD
+1 ; based on the WHICHPP variable. WHICHPP can be set to N, for next
+2 ; pay period, or C for current pay period or 'L' for last. If set
+3 ; to 'N'ext, we have to look at the prior scheduled field in the
+4 ; current pay period to see if the ToD is changing next pp.
+5 ;
+6 NEW TEMPTOUR,TOURNODE,TOUR
+7 IF PPI'>0!(DFN'>0)!(PPDAY'>0)
QUIT 0
+8 SET TOURNODE=$GET(^PRST(458,PPI,"E",DFN,"D",PPDAY,0))
+9 SET TOUR=$PIECE(TOURNODE,U,2)
+10 SET TEMPTOUR=$PIECE(TOURNODE,U,3)
+11 IF WHICHPP="N"
IF +TEMPTOUR
Begin DoDot:1
+12 SET TOUR=$PIECE(TOURNODE,"^",4)
End DoDot:1
+13 IF TOUR'>0
QUIT 0
+14 QUIT $GET(^PRST(457.1,TOUR,1))
+15 ;=======================
+16 ;
SAVETOUR(PPI,DFN) ;SAVE ToD in ^TMP global
+1 ;
+2 SET %X="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
+3 SET %Y="^TMP($J,""OLDTOUR"","
DO %XY^%RCR
+4 QUIT
+5 ;=======================
+6 ;
RESTORE(PPI,DFN) ;restore a ToD
+1 ; use with EXTREME CAUTION. SAVETOUR should be called 1st.
+2 ; This utility first removes the entire "D" node from the
+3 ; input employee's pay period record. It depends on the fact that
+4 ; a backup of an earlier copy of the "D" node was saved in TMP.
+5 NEW %X,%Y
+6 KILL ^PRST(458,PPI,"E",DFN,"D")
+7 SET %X="^TMP($J,""OLDTOUR"","
+8 SET %Y="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
+9 DO %XY^%RCR
+10 QUIT
+11 ;=======================
+12 ;
ASKTEMP() ; ASK USER-TEMP OR PERM ToD CHANGE
+1 NEW DIR,DIRUT
+2 SET DIR("A")="Is this tour change Temporary or Permanent? "
+3 SET DIR("B")="P"
+4 SET DIR(0)="SAMO^P:Permanent;T:Temporary"
+5 SET DIR("?")="A Temporary change is for this Pay Period only."
+6 SET DIR("?",1)="A Permanent change is for this and future Pay Periods."
+7 DO ^DIR
+8 IF $DATA(DIRUT)
SET Y="^"
+9 QUIT Y
+10 ;=======================
+11 ;
GETEMP(TLE) ; SELECT EMP FROM THE PASSED T&L UNIT
+1 NEW DIC,X,Y,D
+2 SET DIC("A")="Select EMPLOYEE: "
+3 SET DIC("S")="I $P(^(0),""^"",8)=TLE"
+4 SET DIC(0)="AEQM"
+5 SET DIC="^PRSPC("
+6 SET D="ATL"_TLE
+7 WRITE !
DO IX^DIC
SET DFN=+Y
KILL DIC
+8 QUIT DFN
+9 ;=======================
+10 ;
FLEXIND(PPI,DFN,WHICHPP) ;
+1 ;Return emp's flexitime code (compressed, flex or none)
+2 ; INPUT:
+3 ; PPI = pp internal #
+4 ; DFN = emps internal # from 450/458
+5 ; WHICHPP = N for next pp otherwise current
+6 QUIT $PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",$SELECT(WHICHPP="N":7,1:6))
+7 ;=======================
+8 ;
ASKTLWRK(TLE) ; ASK TIMEKEEP WHICH TLU ToD WILL BE WORKED
+1 NEW DIC,X,Y
+2 SET DIC="^PRST(455.5,"
+3 SET DIC(0)="AEQM"
+4 SET DIC("A")="T&L on which Tour will be worked: "
+5 SET DIC("B")=TLE
+6 WRITE !
DO ^DIC
+7 QUIT +Y
+8 ;
ASKTWMF() ;ask telework tour for fixed monday/friday tour
+1 NEW DIR,DIRUT,X,Y
+2 SET DIR("A")="Do you wish to schedule any telework tours"
+3 SET DIR(0)="Y"
SET DIR("?")="Answer NO if there is no telework day for the pay period."
+4 DO ^DIR
+5 QUIT $SELECT(Y=0:"N",Y=1:"Y",1:"^")
