PRS8ST ;HISC/MGD-DECOMPOSITION, START-UP ;05/09/07
;;4.0;PAID;**45,92,102,112,117**;Sep 21, 1995;Build 32
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;This routine is the one which actually gets everything moving.
;It moves the information from the ^TMP global into a local array
;[DAY(DAY)] for the three day period it's working with. It then
;processes that information internally and, where necessary, by
;calling certain external processes.
;
;Called by Routines: PRS8SU
;
K SBY F DAY=1:1:14 D
.K DAY(DAY-2)
.S LP=$S(DAY=1:"0,1,2",1:(DAY+1)),JURY=0
.F II=1:1 S DY=$P(LP,",",II) Q:DY="" D
..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","r" D
...S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J))
...;
...;P 45 INITIALIZE THE "F" NODE HERE BY SIMPLY COPYING THE
...;THE "W" NODE FROM TEMP--FOR TESTING PURPOSES.
...;THE NODE SHOULD BE INITIALIZED BY COPYING THE "F" NODE
...;FROM THE TEMP GLOBAL.
...S DAY(DY,"F")=$G(^TMP($J,"PRS8",DY,"W"))
.F II=1:1 S DY=$P(LP,",",II) Q:DY="" D
..S WK=$S(DY<8:1,1:2)
..S TOUR=$S(TYP'["W":1,+DAY(DY,"TOUR"):+DAY(DY,"TOUR"),1:+TOUR(WK))
..D MOVE^PRS8AC
..S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week
..I N["UN" S X1="UN" D 2 ;unavailable
..I N["HX" S X1="HX" D 2 ;holiday excused
..I N["ON" S X1="ON" D 2 ;on-call
..I N["SB" S X1="SB" D 2 ;standby
..; Process the scheduled tours
..S N=DAY(DY,1),DH=DAY(DY,"DH1"),NN=1 D I DAY(DY,"TWO") S N=DAY(DY,4),DH=DAY(DY,"DH2"),NN=4 D
...S QT=0 F PRS8=1:3 S V=$P(N,"^",PRS8,PRS8+2) Q:QT D
....N PRS8AFFH S PRS8AFFH=0 ;fire fighter additional hours flag
....S X=$P(DAY(DY,NN),"^",PRS8,999)
....I X="" S QT=1 Q ;nothing left to check
....I X?1"^"."^" S QT=1 Q ;only ^ left
....;
....; X = 9 is special tour CODE FOR FF ADDTL HRS.
....; It gets converted to 'f'
....S X=$P(V,"^",3),VAR=1 I X S VAR=$E("se1BC235f",+X) I '+VAR D ENT Q:Q
....;if this segment is addt ff hrs then save a variable to signify
....;that, but convert the time back to a 1 to use in the W node.
....I "Ff"[TYP,VAR="f" S (PRS8AFFH,VAR)=1
....;
....I VAR,TYP'["W" S VAR=$S(VAR=5:5,1:1) ;only wg need shifts
....S JURY=$G(^TMP($J,"PRS8",DY,2)) I JURY'="" D
.....F J=4,8,12,16,20,24,28 S:$P(JURY,"^",J)=6 JURY=1 Q
....D ^PRS8AC ;build "W" node
..; Process the exceptions
..S N=DAY(DY,2),WK=$S(DY<8:1,1:2) ;exception node/week
..S QT=0
..; If there are Recess exceptions, process them first
..I N["RS" D
...; Since Recess will reduce hours worked in the week add P to TYP
...I TYP'["P" S TYP=TYP_"P"
...F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT D
....Q:$P(V,"^",3)'="RS"
....I TYP["D",$P(V,"^",3)="" S QT=1 Q ;doctor
....I TYP'["D",'+V,$P(V,"^",3)="" S QT=1 Q ;all others
....S X=$P(V,"^",3)
....I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX
...;
...; Process all other types of exceptions
..S QT=0
..F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+3) Q:QT D
...Q:$P(V,"^",3)="RS"
...I TYP["D",$P(V,"^",3)="" S QT=1 Q ;doctor
...I TYP'["D",'+V,$P(V,"^",3)="" S QT=1 Q ;all others
...S X=$P(V,"^",3)
...I "^UN^ON^SB^HX^"'[("^"_X_"^") D ^PRS8EX
..;
..S ^TMP($J,"PRS8",DY,"W")=DAY(DY,"W") ;save in ^TMP
..S ^TMP($J,"PRS8",DY,"P")=DAY(DY,"P") ;save non-prem ot in ^TMP
..S ^TMP($J,"PRS8",DY,"HOL")=DAY(DY,"HOL") ;holiday
..S ^TMP($J,"PRS8",DY,"r")=DAY(DY,"r") ; Recess for 9mo AWS nurse
.S WK=$S(DAY<8:1,1:2),OFF=+DAY(DAY,"OFF") ;week/day off
.S TOUR=$S(TYP'["W":1,+DAY(DAY,"TOUR"):+DAY(DAY,"TOUR"),1:+TOUR(WK))
.I TYP["I",DAY>0,DAY<15,$G(DAY(DAY,"DWK")) D ;days worked
..S DWK=DWK+1 ;count days worked
..I CYA,DAY'<CYA S CAMISC=CAMISC+1 ;calendar year adjustment (CA)
.S MDY=+DAY D ^PRS8MT I +DAY=1 S MDY=0 D ^PRS8MT
.Q
;
;make DAY array available for prior, current, and next day
F DAY=1:1:14 D
.; I AWS Nurse check to see if hour counts need to be adjusted
.S WK=$S(DAY<8:1,1:2)
.; For each week, TYP should not contain "P" unless:
.; 36/40 AWS has NP or WP
.; 9mo AWS has Recess
.I +NAWS,(DAY=1!(DAY=8)) S TYP=$TR(TYP,"P","") D NAWS
.;
.K DAY(DAY-2)
.S LP=$S(DAY=1:"0,1,2",1:(DAY+1))
.F II=1:1 S DY=$P(LP,",",II) Q:DY="" D
..F J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","F","r" S DAY(DY,J)=$G(^TMP($J,"PRS8",DY,J))
.;
.S WK=$S(DAY<8:1,1:2),OFF=+DAY(DAY,"OFF") ;week/day off
.S TOUR=$S(TYP'["W":1,+DAY(DAY,"TOUR"):+DAY(DAY,"TOUR"),1:+TOUR(WK))
.;
.I ((TYP["I")!(TYP["P")),DAY>0,DAY<15 D ;FOR CY
..I $S('CYA:1,DAY<CYA:1,1:0) Q ;quit if no calendar year adjustment
..S IIX=0 I $E(ENT,2)'="D" F II=1:1:$L(DAY(DAY,"W")) D
...I "4E"[$E(DAY(DAY,"W"),II) S IIX=IIX+1
...S CYA2806=CYA2806+("ALSUMRVW1235OscXYFGDZq"[$E(DAY(DAY,"W"),II))
...S:(IIX<33)&(FLX'="C"&(TH(WK)+IIX<163))!(FLX="C"&(TH+IIX<323)) CYA2806=CYA2806+("4E"[$E(DAY(DAY,"W"),II))
...;SF2806 adjustment (CY) (163 & 323 because mt subtracted)
.;
.I CYA,DAY'<CYA,DAY(DAY,"W")["W" D ;count wop in hours for CA
..F II=1:1:$L(DAY(DAY,"W")) S WPCYA=WPCYA+("W"=$E(DAY(DAY,"W"),II))
.;
.I TYP'["D",DAY(DAY,"W")'?1"0"."0" D ^PRS8PP ;nightdiff/shift premiums
.;
.F T=1:1:96 S VAR1=$E(DAY(DAY,"W"),T) S OK=0 D
..I "BbCct"[VAR1 D ; process on-call/standby
...I T=96!("BbCct"'[$E(DAY(DAY,"W"),T+1)) S OK=T
...I DOUB D ^PRS8OC,^PRS8SB Q ;Prem. Pay of "W" or "V"
...I VAR1'=""&("Cct"[VAR1) D ^PRS8OC Q ;compute on-call/2hr minimum
...I "Bb"[VAR1 D ^PRS8SB ;standby
.I $G(SBY) D UP^PRS8SB
.;
.Q
;
;P 45 CODE O firefighters use PRS8MISC to calculated overtime
;but code R and C firefighters use routine PRS8OTFF.
;
I "Ff"[TYP&("RC"[PMP) D
. D ^PRS8OTFF
E D
. D ^PRS8MISC
K DH,DY,I,J,JURY,K,K1,LP,N,NN,OFF,PRS8L,TOUR,V,VAR,WG,X,Y,Y1
D ^PRS8WE ;Weekend premiums
D ^PRS8UP ;finish up Misc and non-time related activities
Q
;
ENT ; --- check entitlement to activity for 1 node non-norm hrs
S Q=0
I '$E(ENT,$P("12^28^^29^26^^^29","^",+X)) S Q=1 ;entitlement string
;PATCH 45: ADD CHECK FOR FIRE FIGHTER ADDITIONAL HOURS
;SINCE THIS TYPE OF TIME IS NOT IN THE ENTITLEMENT TABLE
;IT IS SET UP WITH TOUR IND. WITH CODE 9
I "Ff"[TYP,X=9 S Q=0
Q:X'=12 I TYP["W",TOUR>1,$E(ENT,11+TOUR) S Q=0
Q
;
2 ; --- get 2 node unavailable/oncall and standby
F PRS8=1:4:25 S V=$P(N,"^",PRS8,PRS8+2) Q:$P(V,"^",1)="" D
.S X=$P(V,"^",3) I X=X1 D ^PRS8EX
K PRS8,X,V
Q
;
NAWS ; NAWS Nurse Alternate Work Schedules
; If any NP or WP has been incurred for a nurse on the 36/40 AWS,
; adjust their hours worked counts. 40 hrs/wk will now be used to
; determine their qualification for OT and CT. Check piece 16 of
; 0 node as NH will have been updated to 320 in PRS8SU.
;
I +NAWS=36 D
.Q:$P(WK(WK),U,3)=""&($P(WK(WK),U,4)="")
.S TH(WK)=144-($P(WK(WK),U,3)+$P(WK(WK),U,4)) ; Adjust Total Hours per week
.S TH=TH(1)+TH(2) ; Adjust Total Hours per pay period
.S NH(WK)=144,NH=288 ; Adjust Normal Hours
.I TYP'["P" S TYP=TYP_"P" ; Make them into a PT employee
.S $E(ENT,2)=1 ; Make employee eligible for UN/US
;
; If any Recess has occurred for a nurse on the 9month AWS, adjust
; their hours worked counts. These employees will be treated as PT
; in determining the eligibility for OT/CT.
;
I +NAWS=9 D
.Q:$P(WK(WK),U,48)=""
.S TH(WK)=TH(WK)-$P(WK(WK),U,48) ; Adjust total hours per week
.S TH=TH(1)+TH(2) ; Adjust Total Hours
.I TYP'["P" S TYP=TYP_"P" ; Adjust TYP to represent a PT employee
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRS8ST 7507 printed Dec 13, 2024@02:23 Page 2
PRS8ST ;HISC/MGD-DECOMPOSITION, START-UP ;05/09/07
+1 ;;4.0;PAID;**45,92,102,112,117**;Sep 21, 1995;Build 32
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;This routine is the one which actually gets everything moving.
+5 ;It moves the information from the ^TMP global into a local array
+6 ;[DAY(DAY)] for the three day period it's working with. It then
+7 ;processes that information internally and, where necessary, by
+8 ;calling certain external processes.
+9 ;
+10 ;Called by Routines: PRS8SU
+11 ;
+12 KILL SBY
FOR DAY=1:1:14
Begin DoDot:1
+13 KILL DAY(DAY-2)
+14 SET LP=$SELECT(DAY=1:"0,1,2",1:(DAY+1))
SET JURY=0
+15 FOR II=1:1
SET DY=$PIECE(LP,",",II)
if DY=""
QUIT
Begin DoDot:2
+16 FOR J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","r"
Begin DoDot:3
+17 SET DAY(DY,J)=$GET(^TMP($JOB,"PRS8",DY,J))
+18 ;
+19 ;P 45 INITIALIZE THE "F" NODE HERE BY SIMPLY COPYING THE
+20 ;THE "W" NODE FROM TEMP--FOR TESTING PURPOSES.
+21 ;THE NODE SHOULD BE INITIALIZED BY COPYING THE "F" NODE
+22 ;FROM THE TEMP GLOBAL.
+23 SET DAY(DY,"F")=$GET(^TMP($JOB,"PRS8",DY,"W"))
End DoDot:3
End DoDot:2
+24 FOR II=1:1
SET DY=$PIECE(LP,",",II)
if DY=""
QUIT
Begin DoDot:2
+25 SET WK=$SELECT(DY<8:1,1:2)
+26 SET TOUR=$SELECT(TYP'["W":1,+DAY(DY,"TOUR"):+DAY(DY,"TOUR"),1:+TOUR(WK))
+27 DO MOVE^PRS8AC
+28 ;exception node/week
SET N=DAY(DY,2)
SET WK=$SELECT(DY<8:1,1:2)
+29 ;unavailable
IF N["UN"
SET X1="UN"
DO 2
+30 ;holiday excused
IF N["HX"
SET X1="HX"
DO 2
+31 ;on-call
IF N["ON"
SET X1="ON"
DO 2
+32 ;standby
IF N["SB"
SET X1="SB"
DO 2
+33 ; Process the scheduled tours
+34 SET N=DAY(DY,1)
SET DH=DAY(DY,"DH1")
SET NN=1
Begin DoDot:3
+35 SET QT=0
FOR PRS8=1:3
SET V=$PIECE(N,"^",PRS8,PRS8+2)
if QT
QUIT
Begin DoDot:4
+36 ;fire fighter additional hours flag
NEW PRS8AFFH
SET PRS8AFFH=0
+37 SET X=$PIECE(DAY(DY,NN),"^",PRS8,999)
+38 ;nothing left to check
IF X=""
SET QT=1
QUIT
+39 ;only ^ left
IF X?1"^"."^"
SET QT=1
QUIT
+40 ;
+41 ; X = 9 is special tour CODE FOR FF ADDTL HRS.
+42 ; It gets converted to 'f'
+43 SET X=$PIECE(V,"^",3)
SET VAR=1
IF X
SET VAR=$EXTRACT("se1BC235f",+X)
IF '+VAR
DO ENT
if Q
QUIT
+44 ;if this segment is addt ff hrs then save a variable to signify
+45 ;that, but convert the time back to a 1 to use in the W node.
+46 IF "Ff"[TYP
IF VAR="f"
SET (PRS8AFFH,VAR)=1
+47 ;
+48 ;only wg need shifts
IF VAR
IF TYP'["W"
SET VAR=$SELECT(VAR=5:5,1:1)
+49 SET JURY=$GET(^TMP($JOB,"PRS8",DY,2))
IF JURY'=""
Begin DoDot:5
+50 FOR J=4,8,12,16,20,24,28
if $PIECE(JURY,"^",J)=6
SET JURY=1
QUIT
End DoDot:5
+51 ;build "W" node
DO ^PRS8AC
End DoDot:4
End DoDot:3
IF DAY(DY,"TWO")
SET N=DAY(DY,4)
SET DH=DAY(DY,"DH2")
SET NN=4
Begin DoDot:3
End DoDot:3
+52 ; Process the exceptions
+53 ;exception node/week
SET N=DAY(DY,2)
SET WK=$SELECT(DY<8:1,1:2)
+54 SET QT=0
+55 ; If there are Recess exceptions, process them first
+56 IF N["RS"
Begin DoDot:3
+57 ; Since Recess will reduce hours worked in the week add P to TYP
+58 IF TYP'["P"
SET TYP=TYP_"P"
+59 FOR PRS8=1:4:25
SET V=$PIECE(N,"^",PRS8,PRS8+3)
if QT
QUIT
Begin DoDot:4
+60 if $PIECE(V,"^",3)'="RS"
QUIT
+61 ;doctor
IF TYP["D"
IF $PIECE(V,"^",3)=""
SET QT=1
QUIT
+62 ;all others
IF TYP'["D"
IF '+V
IF $PIECE(V,"^",3)=""
SET QT=1
QUIT
+63 SET X=$PIECE(V,"^",3)
+64 IF "^UN^ON^SB^HX^"'[("^"_X_"^")
DO ^PRS8EX
End DoDot:4
+65 ;
+66 ; Process all other types of exceptions
End DoDot:3
+67 SET QT=0
+68 FOR PRS8=1:4:25
SET V=$PIECE(N,"^",PRS8,PRS8+3)
if QT
QUIT
Begin DoDot:3
+69 if $PIECE(V,"^",3)="RS"
QUIT
+70 ;doctor
IF TYP["D"
IF $PIECE(V,"^",3)=""
SET QT=1
QUIT
+71 ;all others
IF TYP'["D"
IF '+V
IF $PIECE(V,"^",3)=""
SET QT=1
QUIT
+72 SET X=$PIECE(V,"^",3)
+73 IF "^UN^ON^SB^HX^"'[("^"_X_"^")
DO ^PRS8EX
End DoDot:3
+74 ;
+75 ;save in ^TMP
SET ^TMP($JOB,"PRS8",DY,"W")=DAY(DY,"W")
+76 ;save non-prem ot in ^TMP
SET ^TMP($JOB,"PRS8",DY,"P")=DAY(DY,"P")
+77 ;holiday
SET ^TMP($JOB,"PRS8",DY,"HOL")=DAY(DY,"HOL")
+78 ; Recess for 9mo AWS nurse
SET ^TMP($JOB,"PRS8",DY,"r")=DAY(DY,"r")
End DoDot:2
+79 ;week/day off
SET WK=$SELECT(DAY<8:1,1:2)
SET OFF=+DAY(DAY,"OFF")
+80 SET TOUR=$SELECT(TYP'["W":1,+DAY(DAY,"TOUR"):+DAY(DAY,"TOUR"),1:+TOUR(WK))
+81 ;days worked
IF TYP["I"
IF DAY>0
IF DAY<15
IF $GET(DAY(DAY,"DWK"))
Begin DoDot:2
+82 ;count days worked
SET DWK=DWK+1
+83 ;calendar year adjustment (CA)
IF CYA
IF DAY'<CYA
SET CAMISC=CAMISC+1
End DoDot:2
+84 SET MDY=+DAY
DO ^PRS8MT
IF +DAY=1
SET MDY=0
DO ^PRS8MT
+85 QUIT
End DoDot:1
+86 ;
+87 ;make DAY array available for prior, current, and next day
+88 FOR DAY=1:1:14
Begin DoDot:1
+89 ; I AWS Nurse check to see if hour counts need to be adjusted
+90 SET WK=$SELECT(DAY<8:1,1:2)
+91 ; For each week, TYP should not contain "P" unless:
+92 ; 36/40 AWS has NP or WP
+93 ; 9mo AWS has Recess
+94 IF +NAWS
IF (DAY=1!(DAY=8))
SET TYP=$TRANSLATE(TYP,"P","")
DO NAWS
+95 ;
+96 KILL DAY(DAY-2)
+97 SET LP=$SELECT(DAY=1:"0,1,2",1:(DAY+1))
+98 FOR II=1:1
SET DY=$PIECE(LP,",",II)
if DY=""
QUIT
Begin DoDot:2
+99 FOR J=0,1,2,4,10,"CP","DH1","DH2","HOL","ML","MT1","MT2","OFF","P","TOUR","TWO","W","F","r"
SET DAY(DY,J)=$GET(^TMP($JOB,"PRS8",DY,J))
End DoDot:2
+100 ;
+101 ;week/day off
SET WK=$SELECT(DAY<8:1,1:2)
SET OFF=+DAY(DAY,"OFF")
+102 SET TOUR=$SELECT(TYP'["W":1,+DAY(DAY,"TOUR"):+DAY(DAY,"TOUR"),1:+TOUR(WK))
+103 ;
+104 ;FOR CY
IF ((TYP["I")!(TYP["P"))
IF DAY>0
IF DAY<15
Begin DoDot:2
+105 ;quit if no calendar year adjustment
IF $SELECT('CYA:1,DAY<CYA:1,1:0)
QUIT
+106 SET IIX=0
IF $EXTRACT(ENT,2)'="D"
FOR II=1:1:$LENGTH(DAY(DAY,"W"))
Begin DoDot:3
+107 IF "4E"[$EXTRACT(DAY(DAY,"W"),II)
SET IIX=IIX+1
+108 SET CYA2806=CYA2806+("ALSUMRVW1235OscXYFGDZq"[$EXTRACT(DAY(DAY,"W"),II))
+109 if (IIX<33)&(FLX'="C"&(TH(WK)+IIX<163))!(FLX="C"&(TH+IIX<323))
SET CYA2806=CYA2806+("4E"[$EXTRACT(DAY(DAY,"W"),II))
+110 ;SF2806 adjustment (CY) (163 & 323 because mt subtracted)
End DoDot:3
End DoDot:2
+111 ;
+112 ;count wop in hours for CA
IF CYA
IF DAY'<CYA
IF DAY(DAY,"W")["W"
Begin DoDot:2
+113 FOR II=1:1:$LENGTH(DAY(DAY,"W"))
SET WPCYA=WPCYA+("W"=$EXTRACT(DAY(DAY,"W"),II))
End DoDot:2
+114 ;
+115 ;nightdiff/shift premiums
IF TYP'["D"
IF DAY(DAY,"W")'?1"0"."0"
DO ^PRS8PP
+116 ;
+117 FOR T=1:1:96
SET VAR1=$EXTRACT(DAY(DAY,"W"),T)
SET OK=0
Begin DoDot:2
+118 ; process on-call/standby
IF "BbCct"[VAR1
Begin DoDot:3
+119 IF T=96!("BbCct"'[$EXTRACT(DAY(DAY,"W"),T+1))
SET OK=T
+120 ;Prem. Pay of "W" or "V"
IF DOUB
DO ^PRS8OC
DO ^PRS8SB
QUIT
+121 ;compute on-call/2hr minimum
IF VAR1'=""&("Cct"[VAR1)
DO ^PRS8OC
QUIT
+122 ;standby
IF "Bb"[VAR1
DO ^PRS8SB
End DoDot:3
End DoDot:2
+123 IF $GET(SBY)
DO UP^PRS8SB
+124 ;
+125 QUIT
End DoDot:1
+126 ;
+127 ;P 45 CODE O firefighters use PRS8MISC to calculated overtime
+128 ;but code R and C firefighters use routine PRS8OTFF.
+129 ;
+130 IF "Ff"[TYP&("RC"[PMP)
Begin DoDot:1
+131 DO ^PRS8OTFF
End DoDot:1
+132 IF '$TEST
Begin DoDot:1
+133 DO ^PRS8MISC
End DoDot:1
+134 KILL DH,DY,I,J,JURY,K,K1,LP,N,NN,OFF,PRS8L,TOUR,V,VAR,WG,X,Y,Y1
+135 ;Weekend premiums
DO ^PRS8WE
+136 ;finish up Misc and non-time related activities
DO ^PRS8UP
+137 QUIT
+138 ;
ENT ; --- check entitlement to activity for 1 node non-norm hrs
+1 SET Q=0
+2 ;entitlement string
IF '$EXTRACT(ENT,$PIECE("12^28^^29^26^^^29","^",+X))
SET Q=1
+3 ;PATCH 45: ADD CHECK FOR FIRE FIGHTER ADDITIONAL HOURS
+4 ;SINCE THIS TYPE OF TIME IS NOT IN THE ENTITLEMENT TABLE
+5 ;IT IS SET UP WITH TOUR IND. WITH CODE 9
+6 IF "Ff"[TYP
IF X=9
SET Q=0
+7 if X'=12
QUIT
IF TYP["W"
IF TOUR>1
IF $EXTRACT(ENT,11+TOUR)
SET Q=0
+8 QUIT
+9 ;
2 ; --- get 2 node unavailable/oncall and standby
+1 FOR PRS8=1:4:25
SET V=$PIECE(N,"^",PRS8,PRS8+2)
if $PIECE(V,"^",1)=""
QUIT
Begin DoDot:1
+2 SET X=$PIECE(V,"^",3)
IF X=X1
DO ^PRS8EX
End DoDot:1
+3 KILL PRS8,X,V
+4 QUIT
+5 ;
NAWS ; NAWS Nurse Alternate Work Schedules
+1 ; If any NP or WP has been incurred for a nurse on the 36/40 AWS,
+2 ; adjust their hours worked counts. 40 hrs/wk will now be used to
+3 ; determine their qualification for OT and CT. Check piece 16 of
+4 ; 0 node as NH will have been updated to 320 in PRS8SU.
+5 ;
+6 IF +NAWS=36
Begin DoDot:1
+7 if $PIECE(WK(WK),U,3)=""&($PIECE(WK(WK),U,4)="")
QUIT
+8 ; Adjust Total Hours per week
SET TH(WK)=144-($PIECE(WK(WK),U,3)+$PIECE(WK(WK),U,4))
+9 ; Adjust Total Hours per pay period
SET TH=TH(1)+TH(2)
+10 ; Adjust Normal Hours
SET NH(WK)=144
SET NH=288
+11 ; Make them into a PT employee
IF TYP'["P"
SET TYP=TYP_"P"
+12 ; Make employee eligible for UN/US
SET $EXTRACT(ENT,2)=1
End DoDot:1
+13 ;
+14 ; If any Recess has occurred for a nurse on the 9month AWS, adjust
+15 ; their hours worked counts. These employees will be treated as PT
+16 ; in determining the eligibility for OT/CT.
+17 ;
+18 IF +NAWS=9
Begin DoDot:1
+19 if $PIECE(WK(WK),U,48)=""
QUIT
+20 ; Adjust total hours per week
SET TH(WK)=TH(WK)-$PIECE(WK(WK),U,48)
+21 ; Adjust Total Hours
SET TH=TH(1)+TH(2)
+22 ; Adjust TYP to represent a PT employee
IF TYP'["P"
SET TYP=TYP_"P"
End DoDot:1
+23 QUIT
