PRS8AC ;HISC/MRL-DECOMPOSITION, ACTIVITY STRING ;03/26/08
;;4.0;PAID;**40,45,54,52,69,75,90,96,112,117,125**;Sep 21, 1995;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;The primary purpose of this routine is to create the activity
;string [the "W" node] for each day of activity. While creating
;this string certain counts will also be tallied. These include
;Standby, On-Call and the various absence categories. Actual
;Call Back hrs are also counted in this routine for the purpose
;of reducing the OC later on in the process.
;
;Called by Routines: PRS8EX, PRS8ST.
;
Q:VAR=""
I $S($P(V,"^",1)="":1,$P(V,"^",2)="":1,1:0) Q ;no times
S Q=0
I DY>0,DY<15 D G END:Q
.I DAY(DY,"OFF"),"LSWARUHFGDrZq"[VAR S Q=1 ;exc invalid day off VAR
K OC,FLAG
;
S DAYZ=DAY(DY,"W")_$G(DAY(DY,"N")),MTM=0
S DAYH=$G(DAY(DY,"HOL"))_$G(DAY(DY+1,"HOL")) ;holiday node
N DAYR
S DAYR=DAY(DY,"r")_$G(DAY(DY,"rN")) ; Recess
;
;P 45 FIREFIGHTERS F NODE TO TRACK ADDITIONAL FF HRS
S DAYF=$G(DAY(DY,"F"))
;
F T=+V:1:+$P(V,"^",2) D
.I +VAR,$E(DAYH,T),$E(DAYZ,T)?1A Q ;no override holiday
.; Don't override Recess but allow Unscheduled Regular (VAR=4)
.I +VAR,VAR'=4,$E(DAYR,T)="r" Q ; don't override Recess
.I VAR="A"&(JURY=1) S VAR="J"
.S VAR1=VAR Q:VAR1="" S DAYZ(1)=$E(DAYZ,T)
.I "HhJLSARWMNUnVXYTFGDZq"[VAR1,$E(DAYZ,T)="m" Q
.I T=+V,"12345E"[VAR1 S DAY(DY,"DWK")=1 ;count days worked
.I T=+V,"Vh"[VAR1,TYP["I" S DAY(DY,"DWK")=1 ;count days worked for cop
.I "JLSWNnARUXYFGDZq"[VAR1,T'>96,'$E(DAYZ,T) Q ;invalid outside tour
.; Regular employees can't earn ct/use ot during work
.I +NAWS'=9,"EOPQT4"[VAR1,T'>96,$E(DAYZ,T) Q
.; 9mo AWS checks
.I +NAWS=9,"PQT"[VAR1,T'>96,$E(DAYZ,T) Q ;can't earn ct/use ot during work
.; Allow CT/OT/UN/ON if posted over Recess otherwise don't allow
.I +NAWS=9,"4OECQ"[VAR1,T'>96,$E(DAYZ,T),$E(DAYR,T)'="r" S $E(DAYR,T)=VAR1 Q
.I "OE"[VAR1,"BC"[DAYZ(1),$L(DAYZ(1)) D ; Change OT or CT to CB/SB OT
..S VAR1=$C($A($E(DAYZ,T))+32)
..I $E(DAYZ,T)="C",VAR="E" S VAR1="t" ; Comp time on on-call = "t"
.I "BC"[VAR1,DAYZ(1)="O",$L(DAYZ(1)) D ; Change CB/SB to CB/SB OT
..S VAR1=$C($A($E(VAR1))+32)
.I "Hh"[VAR1 D Q:VAR1="H"
..S DAYH=$E(DAYH,0,T-1)_$S(VAR1="H":1,$E(DAYZ,T)&($E(DAYZ,T)'=4)!(TYP["I")!(TYP["P"&(TYP["N"!(TYP["H")))!(VAR1="h"):2,1:0)_$E(DAYH,T+1,999) ;holiday node
..I VAR1="h" S VAR1="O" ;convert HW to OT
..I VAR="h",$E(DAYZ,T)=5 S FLAG=5
.I $E(DAYZ,T)=5,"ALSRUFGDZq"[VAR1 S VAR1=$E(DAYZ,T)
.I $E(DAYZ,T)="-","BbCctes"[VAR1 Q ;unavail for oc/sb or sch ot/ct
.;
.I VAR'="r" D
..S DAYZ=$E(DAYZ,0,T-1)_VAR1_$E(DAYZ,T+1,999)
..I $E($G(DAY(DY-1,"N")),T)'="",VAR1'=$E($G(DAY(DY-1,"N")),T) D
...S DAY(DY-1,"N")=$E(DAY(DY-1,"N"),0,T-1)_VAR1_$E(DAY(DY-1,"N"),T+1,999) ;save VAR
..; When processing tour time also copy tour into DAYR
..I "1235"[VAR1 D
...S DAYR=$E(DAYZ,0,T-1)_VAR1_$E(DAYZ,T+1,999)
...I $E($G(DAY(DY-1,"N")),T)'="",VAR1'=$E($G(DAY(DY-1,"N")),T) D
....S DAY(DY-1,"rN")=$E(DAY(DY-1,"rN"),0,T-1)_VAR1_$E(DAY(DY-1,"rN"),T+1,999)
.;
.; The following check will record Recess and will then update VAR1 to 0 which
.; will result in the normally scheduled tour being marked as being no tour.
.; This will allow Unscheduled Regular, OT and CT to be posted over the tour.
.I VAR="r" D
..S DAYR=$E(DAYR,0,T-1)_VAR1_$E(DAYR,T+1,999)
..S DAYZ=$E(DAYZ,0,T-1)_0_$E(DAYZ,T+1,999) ; Overwrite tour
..I $E($G(DAY(DY-1,"rN")),T)'="",VAR1'=$E($G(DAY(DY-1,"rN")),T) D
...S DAY(DY-1,"rN")=$E(DAY(DY-1,"rN"),0,T-1)_VAR1_$E(DAY(DY-1,"rN"),T+1,999)
...S DAY(DY-1,"N")=$E(DAY(DY-1,"N"),0,T-1)_0_$E(DAY(DY-1,"N"),T+1,999)
..S Y=48 D SET ; Count Recess
.;
.I VAR1="J" S Y=5 D SET ;set authorized absence for jury duty
.I VAR1="M" S Y=5 D SET ; authorized absence for ML
.;ot on non-premium T&L
.I ("Eocb"[VAR1!(VAR1="O"&'$E(DAYH,T)))&("^^10^11^12^13^15^16^17^"[("^"_$P(V,"^",4)_"^"))!(VAR1=5&("ALSRUFGDZq"[VAR))!(VAR1=4&(TYP["P"!(TYP["I"&(TYP["N"!(TYP["H"!($$HYBRID^PRSAENT1($G(DFN)))))))&("^7^9^11^12^14^17^"[("^"_$P(V,"^",4)_"^"))) D
..Q:$E(DAY(DY,"P"),T)=5&("ALSRUFGDZq"'[VAR)
..I $D(FLAG) S FLAG=VAR1,VAR1=5
..N CODE D
...I "^7^8^12^"[("^"_$P(V,"^",4)_"^")&(TYP["N"!(TYP["H")!($$HYBRID^PRSAENT1($G(DFN)))) S CODE="N" Q
...I "^7^8^12^"[("^"_$P(V,"^",4)_"^")&(PMP'="")&("^S^T^U^V^"[(U_PMP_U)) S CODE="N" Q
...I $P(V,"^",4)=11,($$HYBRID^PRSAENT1($G(DFN))) S CODE="N" Q
...I $P(V,"^",4)=11&(PMP'="")&("^S^T^U^V^"[(U_PMP_U)) S CODE="N" Q
...I "^7^8^9^11^"[("^"_$P(V,"^",4)_"^")&(TYP'["N")&(TYP'["H")&('$$HYBRID^PRSAENT1($G(DFN))) S CODE="n" Q
...I "^7^8^9^11^"[("^"_$P(V,"^",4)_"^")&("^S^T^U^V^"'[(U_PMP_U)) S CODE="n" Q
...I $P(V,"^",4)=17 S CODE="N" Q ; Code 17 - OT/CT with premiums
...I VAR1=5 S CODE=VAR Q
...S CODE=1
..S DAY(DY,"P")=$E(DAY(DY,"P"),0,T-1)_CODE_$E(DAY(DY,"P"),T+1,999)
.I "ALSRUFGDZq"[VAR,VAR1=5 S VAR1=VAR
.I $D(FLAG) S VAR1=FLAG K FLAG
.;
FOPTHR .; part time hrs (PT/PH 8b codes) for CODE O firefighters
.I +VAR1,"Ff"[TYP,PMP="O",(NH=448!(NH>320&(NH(1)'=NH(2)))) S Y=32 D SET
.;
FRCPTHR .; part time hrs (PT/PH 8b codes) for code R & C firefighters
.; don't include UNSCHEDULED REGULAR (var1=4)
.I +VAR1,VAR1'=4,"Ff"[TYP,"RC"[PMP S Y=32 D SET
.;
.;patch 45 & 54
.; Set non pay hrs in the basic tour for firefighters with premium
.;pay indicator of C.
.I "nW"[VAR1,"Ff"[TYP,"C"=PMP D
..;
..; Y designates location in WK array where NT/NH will be stored.
..; F node was set to 1 for periods of addtl ff hrs during 1st pass
..; thru scheduled ToD. Count NT/NH if this is not addtl ff hrs.
..;
..I '$E(DAY(DY,"F"),T) S Y=47 D SET
.S S="LSWnAREUP HYXOVQTFGDZq" I S[VAR1&(DY>0&(DY<15)!(DY=0&(T>96))) D ;save in WK array
..S S(1)=$F(S,VAR1)-1
..S S=$P("1^2^3^4^5^6^0^8^0^9^24^42^43^0^33^54^19^44^45^46^53^55","^",S(1)) ;WK location
..Q:S=0
..; Patch *40 removed A (authorized absence) from leave counted in LU.
..; Patch *125 added LWOP as valid leave counted in LU
..; LU is only used to determine if night differential granted for
..; leave should be backed out.
..I TYP'["D","LSWRUFGDZq"[VAR1 S LU=LU+1 ;increment leave counter
..; p117 decrement total leave count for leave outside of pp
..I TYP'["D","LSWRUFGDZq"[VAR1,((DY=0)&(T<97))!((DY=14)&(T>96)),LU>0 S LU=LU-1
..S Y=S D SET S:TYP["D" Q=1
..K S,VAR1
;
S DAY(DY,"W")=$E(DAYZ,1,96) ;todays activity
S DAY(DY,"N")=$E(DAYZ,97,999) ;tomorrows activity from today/if any
S DAY(DY,"r")=$E(DAYR,1,96) ; Today's Recess
S DAY(DY,"rN")=$E(DAYR,97,999) ; Tomorrow's Recess/if any
S:$E(DAY(DY,"P"),97,999)'="" DAY(DY,"P1")=$E(DAY(DY,"P"),97,999) ;non-prem ot for next day
S DAY(DY,"P")=$E(DAY(DY,"P"),1,96) ;non-prem ot for today
I DAY(DY,"N")?1"0"."0",DAY(DY,"rN")'["r" S DAY(DY,"N")=""
S DAY(DY,"HOL")=$E(DAYH,1,96)
;
;P 45 FIREFIGHTER ADDITIONAL FIREFIGHTER HRS NODE FOR THIS DAY
I $G(PRS8AFFH) D
. N PRSFFHR,PRSF1,PRSF2,PRSF3,SEG1,SEG2
.;
.;GET THE POSITIONAL START AND STOPS FOR THIS SEGMENT
. S SEG1=$P(V,U,1),SEG2=$P(V,U,2)
.;EXISTING PORTION OF F NODE UP TO CURRENT SEGMENT
. S PRSF1=$E(DAYF,1,SEG1-1)
.;CURRENT SEGMENT UP TO END OF DAY
. S PRSF2=$E(DAYZ,SEG1,SEG2)
.;CURRENT F NODE PAST CURRENT SEGMENT TO END OF THE TOUR WHICH
.;MAY FALL IN TODAY OR NEXT DAY.
.S PRSF3=$E(DAYF,SEG2+1,999)
.;
.;UPDATE THE DAY ARRAY AND THE TMP GLOBAL WITH WORK STRING.
.;EACH CHAR THAT IS SET TO 1 REPRESENTS A 15 MIN SEGMENT THAT
.;THE FIREFIGHTER WAS SCHEDULED FOR ADDITIONAL FF HRS.
.;FOR TOURS CROSSING MIDNIGHT THIS STRING WILL BE LONGER THAN 96
.;CHARACTERS. CHARACTERS IN POSITIONS PAST 96 REPRESENT TIMES PAST
.;MIDNIGHT OF THE CURRENT DAY (TOMORROW).
.S PRSFFHR=PRSF1_PRSF2_PRSF3
.S DAY(DY,"F")=PRSFFHR
.S ^TMP($J,"PRS8",DY,"F")=PRSFFHR
;
I DY<15 S X=$E(DAYH,97,999) I X'?."0" S ^TMP($J,"PRS8",DY+1,"HOL")=X_$E($G(^TMP($J,"PRS8",DY+1,"HOL")),$L(X)+1,999),DAY(DY+1,"HOL")=X
;
MOVE ; --- entry point for just moving previous days hrs to today
I $D(DAY(DY-1,"N")),$L(DAY(DY-1,"N")) D
.S X=DAY(DY-1,"N")_$E(DAY(DY,"W"),$L(DAY(DY-1,"N"))+1,96)
.S DAY(DY,"W")=X
I $D(DAY(DY-1,"P1")),$L(DAY(DY-1,"P1")) D
.S X=DAY(DY-1,"P1")_$E(DAY(DY,"P"),$L(DAY(DY-1,"P1"))+1,96)
.S DAY(DY,"P")=X
I $D(DAY(DY-1,"rN")),$L(DAY(DY-1,"rN")) D
.S X=DAY(DY-1,"rN")_$E(DAY(DY,"r"),$L(DAY(DY-1,"rN"))+1,96)
.S DAY(DY,"r")=X
;
END ; --- all done here
K CNT,OC,Q,S,SB,SL,SLP,T,VAR1,X,Y Q
;
SET ; --- set WK variable
I (DY=0&(T<97))!(DY=14&(T>96))!(DY>14) Q
S ZZ=WK,WK=$S(DY>7:2,1:1)
I TYP'["D",DY=7,T>96 S WK=2
S $P(WK(WK),"^",Y)=$P(WK(WK),"^",Y)+1
;
; The passing of Public Law 106-554 allows taking ML in hours.
; ML will now be recorded in 15 minute segments in the WK(3) array
; for employees entitled to take ML in hours. PRS*4.0*69
;
I VAR1="M",$$MLINHRS^PRSAENT(DFN) D
. S WK=3,Y=11
. S $P(WK(WK),"^",Y)=$P(WK(WK),"^",Y)+1
;
; IF a part-time employee and they have either LWOP or Non-Pay
; THEN decrement total hours for the week and the pay period.
; PRS*4.0*52.
;
I "Wn"[VAR1,TYP["P" S TH=TH-1,TH(WK)=TH(WK)-1
S WK=ZZ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8AC 9197 printed Apr 09, 2024@21:31:49 Page 2
PRS8AC ;HISC/MRL-DECOMPOSITION, ACTIVITY STRING ;03/26/08
+1 ;;4.0;PAID;**40,45,54,52,69,75,90,96,112,117,125**;Sep 21, 1995;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;The primary purpose of this routine is to create the activity
+5 ;string [the "W" node] for each day of activity. While creating
+6 ;this string certain counts will also be tallied. These include
+7 ;Standby, On-Call and the various absence categories. Actual
+8 ;Call Back hrs are also counted in this routine for the purpose
+9 ;of reducing the OC later on in the process.
+10 ;
+11 ;Called by Routines: PRS8EX, PRS8ST.
+12 ;
+13 if VAR=""
QUIT
+14 ;no times
IF $SELECT($PIECE(V,"^",1)="":1,$PIECE(V,"^",2)="":1,1:0)
QUIT
+15 SET Q=0
+16 IF DY>0
IF DY<15
Begin DoDot:1
+17 ;exc invalid day off VAR
IF DAY(DY,"OFF")
IF "LSWARUHFGDrZq"[VAR
SET Q=1
End DoDot:1
if Q
GOTO END
+18 KILL OC,FLAG
+19 ;
+20 SET DAYZ=DAY(DY,"W")_$GET(DAY(DY,"N"))
SET MTM=0
+21 ;holiday node
SET DAYH=$GET(DAY(DY,"HOL"))_$GET(DAY(DY+1,"HOL"))
+22 NEW DAYR
+23 ; Recess
SET DAYR=DAY(DY,"r")_$GET(DAY(DY,"rN"))
+24 ;
+25 ;P 45 FIREFIGHTERS F NODE TO TRACK ADDITIONAL FF HRS
+26 SET DAYF=$GET(DAY(DY,"F"))
+27 ;
+28 FOR T=+V:1:+$PIECE(V,"^",2)
Begin DoDot:1
+29 ;no override holiday
IF +VAR
IF $EXTRACT(DAYH,T)
IF $EXTRACT(DAYZ,T)?1A
QUIT
+30 ; Don't override Recess but allow Unscheduled Regular (VAR=4)
+31 ; don't override Recess
IF +VAR
IF VAR'=4
IF $EXTRACT(DAYR,T)="r"
QUIT
+32 IF VAR="A"&(JURY=1)
SET VAR="J"
+33 SET VAR1=VAR
if VAR1=""
QUIT
SET DAYZ(1)=$EXTRACT(DAYZ,T)
+34 IF "HhJLSARWMNUnVXYTFGDZq"[VAR1
IF $EXTRACT(DAYZ,T)="m"
QUIT
+35 ;count days worked
IF T=+V
IF "12345E"[VAR1
SET DAY(DY,"DWK")=1
+36 ;count days worked for cop
IF T=+V
IF "Vh"[VAR1
IF TYP["I"
SET DAY(DY,"DWK")=1
+37 ;invalid outside tour
IF "JLSWNnARUXYFGDZq"[VAR1
IF T'>96
IF '$EXTRACT(DAYZ,T)
QUIT
+38 ; Regular employees can't earn ct/use ot during work
+39 IF +NAWS'=9
IF "EOPQT4"[VAR1
IF T'>96
IF $EXTRACT(DAYZ,T)
QUIT
+40 ; 9mo AWS checks
+41 ;can't earn ct/use ot during work
IF +NAWS=9
IF "PQT"[VAR1
IF T'>96
IF $EXTRACT(DAYZ,T)
QUIT
+42 ; Allow CT/OT/UN/ON if posted over Recess otherwise don't allow
+43 IF +NAWS=9
IF "4OECQ"[VAR1
IF T'>96
IF $EXTRACT(DAYZ,T)
IF $EXTRACT(DAYR,T)'="r"
SET $EXTRACT(DAYR,T)=VAR1
QUIT
+44 ; Change OT or CT to CB/SB OT
IF "OE"[VAR1
IF "BC"[DAYZ(1)
IF $LENGTH(DAYZ(1))
Begin DoDot:2
+45 SET VAR1=$CHAR($ASCII($EXTRACT(DAYZ,T))+32)
+46 ; Comp time on on-call = "t"
IF $EXTRACT(DAYZ,T)="C"
IF VAR="E"
SET VAR1="t"
End DoDot:2
+47 ; Change CB/SB to CB/SB OT
IF "BC"[VAR1
IF DAYZ(1)="O"
IF $LENGTH(DAYZ(1))
Begin DoDot:2
+48 SET VAR1=$CHAR($ASCII($EXTRACT(VAR1))+32)
End DoDot:2
+49 IF "Hh"[VAR1
Begin DoDot:2
+50 ;holiday node
SET DAYH=$EXTRACT(DAYH,0,T-1)_$SELECT(VAR1="H":1,$EXTRACT(DAYZ,T)&($EXTRACT(DAYZ,T)'=4)!(TYP["I")!(TYP["P"&(TYP["N"!(TYP["H")))!(VAR1="h"):2,1:0)_$EXTRACT(DAYH,T+1,999)
+51 ;convert HW to OT
IF VAR1="h"
SET VAR1="O"
+52 IF VAR="h"
IF $EXTRACT(DAYZ,T)=5
SET FLAG=5
End DoDot:2
if VAR1="H"
QUIT
+53 IF $EXTRACT(DAYZ,T)=5
IF "ALSRUFGDZq"[VAR1
SET VAR1=$EXTRACT(DAYZ,T)
+54 ;unavail for oc/sb or sch ot/ct
IF $EXTRACT(DAYZ,T)="-"
IF "BbCctes"[VAR1
QUIT
+55 ;
+56 IF VAR'="r"
Begin DoDot:2
+57 SET DAYZ=$EXTRACT(DAYZ,0,T-1)_VAR1_$EXTRACT(DAYZ,T+1,999)
+58 IF $EXTRACT($GET(DAY(DY-1,"N")),T)'=""
IF VAR1'=$EXTRACT($GET(DAY(DY-1,"N")),T)
Begin DoDot:3
+59 ;save VAR
SET DAY(DY-1,"N")=$EXTRACT(DAY(DY-1,"N"),0,T-1)_VAR1_$EXTRACT(DAY(DY-1,"N"),T+1,999)
End DoDot:3
+60 ; When processing tour time also copy tour into DAYR
+61 IF "1235"[VAR1
Begin DoDot:3
+62 SET DAYR=$EXTRACT(DAYZ,0,T-1)_VAR1_$EXTRACT(DAYZ,T+1,999)
+63 IF $EXTRACT($GET(DAY(DY-1,"N")),T)'=""
IF VAR1'=$EXTRACT($GET(DAY(DY-1,"N")),T)
Begin DoDot:4
+64 SET DAY(DY-1,"rN")=$EXTRACT(DAY(DY-1,"rN"),0,T-1)_VAR1_$EXTRACT(DAY(DY-1,"rN"),T+1,999)
End DoDot:4
End DoDot:3
End DoDot:2
+65 ;
+66 ; The following check will record Recess and will then update VAR1 to 0 which
+67 ; will result in the normally scheduled tour being marked as being no tour.
+68 ; This will allow Unscheduled Regular, OT and CT to be posted over the tour.
+69 IF VAR="r"
Begin DoDot:2
+70 SET DAYR=$EXTRACT(DAYR,0,T-1)_VAR1_$EXTRACT(DAYR,T+1,999)
+71 ; Overwrite tour
SET DAYZ=$EXTRACT(DAYZ,0,T-1)_0_$EXTRACT(DAYZ,T+1,999)
+72 IF $EXTRACT($GET(DAY(DY-1,"rN")),T)'=""
IF VAR1'=$EXTRACT($GET(DAY(DY-1,"rN")),T)
Begin DoDot:3
+73 SET DAY(DY-1,"rN")=$EXTRACT(DAY(DY-1,"rN"),0,T-1)_VAR1_$EXTRACT(DAY(DY-1,"rN"),T+1,999)
+74 SET DAY(DY-1,"N")=$EXTRACT(DAY(DY-1,"N"),0,T-1)_0_$EXTRACT(DAY(DY-1,"N"),T+1,999)
End DoDot:3
+75 ; Count Recess
SET Y=48
DO SET
End DoDot:2
+76 ;
+77 ;set authorized absence for jury duty
IF VAR1="J"
SET Y=5
DO SET
+78 ; authorized absence for ML
IF VAR1="M"
SET Y=5
DO SET
+79 ;ot on non-premium T&L
+80 IF ("Eocb"[VAR1!(VAR1="O"&'$EXTRACT(DAYH,T)))&("^^10^11^12^13^15^16^17^"[("^"_$PIECE(V,"^",4)_"^"))!(VAR1=5&("ALSRUFGDZq"[VAR))!(VAR1=4&(TYP["P"!(TYP["I"&(TYP["N"!(TYP["H"!($$HYBRID^PRSAENT1(...
... $GET(DFN)))))))&("^7^9^11^12^14^17^"[("^"_$PIECE(V,"^",4)_"^")))
Begin DoDot:2
+81 if $EXTRACT(DAY(DY,"P"),T)=5&("ALSRUFGDZq"'[VAR)
QUIT
+82 IF $DATA(FLAG)
SET FLAG=VAR1
SET VAR1=5
+83 NEW CODE
Begin DoDot:3
+84 IF "^7^8^12^"[("^"_$PIECE(V,"^",4)_"^")&(TYP["N"!(TYP["H")!($$HYBRID^PRSAENT1($GET(DFN))))
SET CODE="N"
QUIT
+85 IF "^7^8^12^"[("^"_$PIECE(V,"^",4)_"^")&(PMP'="")&("^S^T^U^V^"[(U_PMP_U))
SET CODE="N"
QUIT
+86 IF $PIECE(V,"^",4)=11
IF ($$HYBRID^PRSAENT1($GET(DFN)))
SET CODE="N"
QUIT
+87 IF $PIECE(V,"^",4)=11&(PMP'="")&("^S^T^U^V^"[(U_PMP_U))
SET CODE="N"
QUIT
+88 IF "^7^8^9^11^"[("^"_$PIECE(V,"^",4)_"^")&(TYP'["N")&(TYP'["H")&('$$HYBRID^PRSAENT1($GET(DFN)))
SET CODE="n"
QUIT
+89 IF "^7^8^9^11^"[("^"_$PIECE(V,"^",4)_"^")&("^S^T^U^V^"'[(U_PMP_U))
SET CODE="n"
QUIT
+90 ; Code 17 - OT/CT with premiums
IF $PIECE(V,"^",4)=17
SET CODE="N"
QUIT
+91 IF VAR1=5
SET CODE=VAR
QUIT
+92 SET CODE=1
End DoDot:3
+93 SET DAY(DY,"P")=$EXTRACT(DAY(DY,"P"),0,T-1)_CODE_$EXTRACT(DAY(DY,"P"),T+1,999)
End DoDot:2
+94 IF "ALSRUFGDZq"[VAR
IF VAR1=5
SET VAR1=VAR
+95 IF $DATA(FLAG)
SET VAR1=FLAG
KILL FLAG
+96 ;
FOPTHR ; part time hrs (PT/PH 8b codes) for CODE O firefighters
+1 IF +VAR1
IF "Ff"[TYP
IF PMP="O"
IF (NH=448!(NH>320&(NH(1)'=NH(2))))
SET Y=32
DO SET
+2 ;
FRCPTHR ; part time hrs (PT/PH 8b codes) for code R & C firefighters
+1 ; don't include UNSCHEDULED REGULAR (var1=4)
+2 IF +VAR1
IF VAR1'=4
IF "Ff"[TYP
IF "RC"[PMP
SET Y=32
DO SET
+3 ;
+4 ;patch 45 & 54
+5 ; Set non pay hrs in the basic tour for firefighters with premium
+6 ;pay indicator of C.
+7 IF "nW"[VAR1
IF "Ff"[TYP
IF "C"=PMP
Begin DoDot:2
+8 ;
+9 ; Y designates location in WK array where NT/NH will be stored.
+10 ; F node was set to 1 for periods of addtl ff hrs during 1st pass
+11 ; thru scheduled ToD. Count NT/NH if this is not addtl ff hrs.
+12 ;
+13 IF '$EXTRACT(DAY(DY,"F"),T)
SET Y=47
DO SET
End DoDot:2
+14 ;save in WK array
SET S="LSWnAREUP HYXOVQTFGDZq"
IF S[VAR1&(DY>0&(DY<15)!(DY=0&(T>96)))
Begin DoDot:2
+15 SET S(1)=$FIND(S,VAR1)-1
+16 ;WK location
SET S=$PIECE("1^2^3^4^5^6^0^8^0^9^24^42^43^0^33^54^19^44^45^46^53^55","^",S(1))
+17 if S=0
QUIT
+18 ; Patch *40 removed A (authorized absence) from leave counted in LU.
+19 ; Patch *125 added LWOP as valid leave counted in LU
+20 ; LU is only used to determine if night differential granted for
+21 ; leave should be backed out.
+22 ;increment leave counter
IF TYP'["D"
IF "LSWRUFGDZq"[VAR1
SET LU=LU+1
+23 ; p117 decrement total leave count for leave outside of pp
+24 IF TYP'["D"
IF "LSWRUFGDZq"[VAR1
IF ((DY=0)&(T<97))!((DY=14)&(T>96))
IF LU>0
SET LU=LU-1
+25 SET Y=S
DO SET
if TYP["D"
SET Q=1
+26 KILL S,VAR1
End DoDot:2
End DoDot:1
+27 ;
+28 ;todays activity
SET DAY(DY,"W")=$EXTRACT(DAYZ,1,96)
+29 ;tomorrows activity from today/if any
SET DAY(DY,"N")=$EXTRACT(DAYZ,97,999)
+30 ; Today's Recess
SET DAY(DY,"r")=$EXTRACT(DAYR,1,96)
+31 ; Tomorrow's Recess/if any
SET DAY(DY,"rN")=$EXTRACT(DAYR,97,999)
+32 ;non-prem ot for next day
if $EXTRACT(DAY(DY,"P"),97,999)'=""
SET DAY(DY,"P1")=$EXTRACT(DAY(DY,"P"),97,999)
+33 ;non-prem ot for today
SET DAY(DY,"P")=$EXTRACT(DAY(DY,"P"),1,96)
+34 IF DAY(DY,"N")?1"0"."0"
IF DAY(DY,"rN")'["r"
SET DAY(DY,"N")=""
+35 SET DAY(DY,"HOL")=$EXTRACT(DAYH,1,96)
+36 ;
+37 ;P 45 FIREFIGHTER ADDITIONAL FIREFIGHTER HRS NODE FOR THIS DAY
+38 IF $GET(PRS8AFFH)
Begin DoDot:1
+39 NEW PRSFFHR,PRSF1,PRSF2,PRSF3,SEG1,SEG2
+40 ;
+41 ;GET THE POSITIONAL START AND STOPS FOR THIS SEGMENT
+42 SET SEG1=$PIECE(V,U,1)
SET SEG2=$PIECE(V,U,2)
+43 ;EXISTING PORTION OF F NODE UP TO CURRENT SEGMENT
+44 SET PRSF1=$EXTRACT(DAYF,1,SEG1-1)
+45 ;CURRENT SEGMENT UP TO END OF DAY
+46 SET PRSF2=$EXTRACT(DAYZ,SEG1,SEG2)
+47 ;CURRENT F NODE PAST CURRENT SEGMENT TO END OF THE TOUR WHICH
+48 ;MAY FALL IN TODAY OR NEXT DAY.
+49 SET PRSF3=$EXTRACT(DAYF,SEG2+1,999)
+50 ;
+51 ;UPDATE THE DAY ARRAY AND THE TMP GLOBAL WITH WORK STRING.
+52 ;EACH CHAR THAT IS SET TO 1 REPRESENTS A 15 MIN SEGMENT THAT
+53 ;THE FIREFIGHTER WAS SCHEDULED FOR ADDITIONAL FF HRS.
+54 ;FOR TOURS CROSSING MIDNIGHT THIS STRING WILL BE LONGER THAN 96
+55 ;CHARACTERS. CHARACTERS IN POSITIONS PAST 96 REPRESENT TIMES PAST
+56 ;MIDNIGHT OF THE CURRENT DAY (TOMORROW).
+57 SET PRSFFHR=PRSF1_PRSF2_PRSF3
+58 SET DAY(DY,"F")=PRSFFHR
+59 SET ^TMP($JOB,"PRS8",DY,"F")=PRSFFHR
End DoDot:1
+60 ;
+61 IF DY<15
SET X=$EXTRACT(DAYH,97,999)
IF X'?."0"
SET ^TMP($JOB,"PRS8",DY+1,"HOL")=X_$EXTRACT($GET(^TMP($JOB,"PRS8",DY+1,"HOL")),$LENGTH(X)+1,999)
SET DAY(DY+1,"HOL")=X
+62 ;
MOVE ; --- entry point for just moving previous days hrs to today
+1 IF $DATA(DAY(DY-1,"N"))
IF $LENGTH(DAY(DY-1,"N"))
Begin DoDot:1
+2 SET X=DAY(DY-1,"N")_$EXTRACT(DAY(DY,"W"),$LENGTH(DAY(DY-1,"N"))+1,96)
+3 SET DAY(DY,"W")=X
End DoDot:1
+4 IF $DATA(DAY(DY-1,"P1"))
IF $LENGTH(DAY(DY-1,"P1"))
Begin DoDot:1
+5 SET X=DAY(DY-1,"P1")_$EXTRACT(DAY(DY,"P"),$LENGTH(DAY(DY-1,"P1"))+1,96)
+6 SET DAY(DY,"P")=X
End DoDot:1
+7 IF $DATA(DAY(DY-1,"rN"))
IF $LENGTH(DAY(DY-1,"rN"))
Begin DoDot:1
+8 SET X=DAY(DY-1,"rN")_$EXTRACT(DAY(DY,"r"),$LENGTH(DAY(DY-1,"rN"))+1,96)
+9 SET DAY(DY,"r")=X
End DoDot:1
+10 ;
END ; --- all done here
+1 KILL CNT,OC,Q,S,SB,SL,SLP,T,VAR1,X,Y
QUIT
+2 ;
SET ; --- set WK variable
+1 IF (DY=0&(T<97))!(DY=14&(T>96))!(DY>14)
QUIT
+2 SET ZZ=WK
SET WK=$SELECT(DY>7:2,1:1)
+3 IF TYP'["D"
IF DY=7
IF T>96
SET WK=2
+4 SET $PIECE(WK(WK),"^",Y)=$PIECE(WK(WK),"^",Y)+1
+5 ;
+6 ; The passing of Public Law 106-554 allows taking ML in hours.
+7 ; ML will now be recorded in 15 minute segments in the WK(3) array
+8 ; for employees entitled to take ML in hours. PRS*4.0*69
+9 ;
+10 IF VAR1="M"
IF $$MLINHRS^PRSAENT(DFN)
Begin DoDot:1
+11 SET WK=3
SET Y=11
+12 SET $PIECE(WK(WK),"^",Y)=$PIECE(WK(WK),"^",Y)+1
End DoDot:1
+13 ;
+14 ; IF a part-time employee and they have either LWOP or Non-Pay
+15 ; THEN decrement total hours for the week and the pay period.
+16 ; PRS*4.0*52.
+17 ;
+18 IF "Wn"[VAR1
IF TYP["P"
SET TH=TH-1
SET TH(WK)=TH(WK)-1
+19 SET WK=ZZ
QUIT
