PRSATPE ;WOIFO/PLT - Find Exceptions ;12/3/07
;;4.0;PAID;**26,34,69,102,112,116,117**;Sep 21, 1995;Build 32
;;Per VHA Directive 2004-038, this routine should not be modified.
K ER S (ECNT,FATAL)=0,X0=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),STAT=$P($G(^(10)),"^",1)
N MLTIME S MLTIME=0
S TC=$P(X0,"^",2) I 'TC S ER(1)=$P($T(ERTX+1),";;",2),FATAL=1 G EX
;
;ensure Normal Hrs = tour hrs for hourly employees
I DAY=14 I '$$HRSMATCH(PPI,DFN) S FATAL=1,ERR=20 D ERR3640 G EX
;
I "1 3 4"'[TC,STAT="" S ER(1)=$P($T(ERTX+2),";;",2),FATAL=1 G EX
;
; Validate NAWS 36/40 nurse tours--can't certify if errors
I DAY=7!(DAY=14),$$NAWS3640(DFN,PPI) D
. I $$SAT2DAY(DAY/7,DFN,PPI) S FATAL=1,ERR=16 D ERR3640
. I $$THREE12(DAY/7,DFN,PPI) S FATAL=1,ERR=$S(DAY=7:18,1:19) D ERR3640
I DAY=1,$$NAWS3640(DFN,PPI) D
. I $$CARRYOVR(DFN,PPI) S FATAL=1,ERR=17 D ERR3640
I FATAL G EX
;
S X2=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) G:X2="" EX S X1=$G(^(1)),X4=$G(^(4)),K=$P($G(^(10)),U,4)
;check recess entire day having un-unavailable posted for all scheduled on-on call
I $E($G(PRSENT),5),K=2,X2["^RS" D
. F K=1:3 QUIT:$P(X1,U,K,999)="" S Z=$P(X1,U,K+2) I Z,$P($G(^PRST(457.2,Z,0)),"^",2)="ON",X2'[($P(X1,U,K,K+1)_"^UN") S PRSWOC=$G(PRSWOC)_DAY_"," QUIT
. I $G(PRSWOC)'[(DAY_",") F K=1:3 QUIT:$P(X4,U,K,999)="" S Z=$P(X4,U,K+2) I Z,$P($G(^PRST(457.2,Z,0)),"^",2)="ON",X2'[($P(X4,U,K,K+1)_"^UN") S PRSWOC=$G(PRSWOC)_DAY_"," QUIT
. QUIT
;
K TM I X2["OT"!(X2["CT") D TM
K T,TRS F K=1:3 Q:$P(X1,"^",K)="" S Z=$P(X1,"^",K+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") D
.S X=$P(X1,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
.I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q
.S T(Z1)="",T(Z2)="*" Q
I X4'="" F K=1:3 Q:$P(X4,"^",K)="" S Z=$P(X4,"^",K+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") D
.S X=$P(X4,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
.I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q
.S T(Z1)="",T(Z2)="*" Q
;
;find rs-type of time segments of trs array in x2 posted string
I X2["^RS" F K=1:4:25 QUIT:$P(X2,U,K,999)="" S X=$P(X2,"^",K,K+1) I "^"'[X,$P(X2,"^",K+2)="RS" D
. S TT=$P(X2,"^",K+2) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1
. I Z1'="",$G(TRS(Z1))="*" K TRS(Z1) S TRS(Z2)="*" QUIT
. S TRS(Z1)="",TRS(Z2)="*"
. QUIT
; Checks for Daily employees
I "^"[$P(X2,"^",1,2) S TT=$P(X2,"^",3),K=1,DN=0,Y0="" G L0
F K=1:4:25 S X=$P(X2,"^",K,K+1) I "^"'[X D
. N Z3,Z4
. S TT=$P(X2,"^",K+2)
. D CNV^PRSATIM S Y0=Y,Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1 S TIM=Z2-Z1/60
. S Z3=Z1,Z4=Z2
. I TT="ML" S MLTIME=MLTIME+TIM
. S Z1=$O(T(Z1)) S:Z1'="" Z1=T(Z1)
. S Z2=$O(T(Z2-1)) S:Z2'="" Z2=T(Z2)
. ;trs=1 if absolute outside rs, 2 if absolute inside rs, 3 if overlap (in/outside) rs and inside tour of duty
. ;if exception segment start/ending time outside tour of duty, reset z3 and z4
. I Z1]""!(Z2]""),X2["^RS" S:Z1=""&(Z2="*") Z3=$O(T(Z3)) S:Z1="*"&(Z2="") Z4=$O(T(Z3)) S Z3=$O(TRS(Z3)) S:Z3]"" Z3=TRS(Z3) S Z4=$O(TRS(Z4-1)) S:Z4]"" Z4=TRS(Z4) S TRS=$S(Z3=""&(Z4=""):1,Z3="*"&(Z4="*"):2,1:3)
. I TT="UN" D UN^PRSATPH QUIT
. I "CT OT ON SB RG"[TT D OT QUIT
. D LV QUIT
;
; Check for a minimum of 1 hour ML
;
I TT="ML",MLTIME<1 S ER(1)=$P($T(ERTX+14),";;",2),FATAL=1 G EX
;
EX Q
V0 I Z2>Z1 S:$O(T(""))'<Z2 Z1=Z1+1440,Z2=Z2+1440 Q
S Z2=Z2+1440 Q
V1 S DN=0 I Z2>Z1 Q:"CT OT ON SB UN RG"[TT S:$O(T(""))'<Z2 Z1=Z1+1440,Z2=Z2+1440,DN=2 Q
S Z2=Z2+1440,DN=1 Q
OT ; Check OT/CT Request
I Z1'=""!(Z2'="") D O2 I $G(ERR)=6 S FATAL=1 D ERR
I DN=1,$O(T(1440))="" D NX^PRSATPH
I 'DN,$O(T(""))=""!($P(Y0,"^",1)'>$O(T(""))) D PR^PRSATPH
I "ON SB RG"[TT Q
; check status of request(s)
S DTI=$P($G(^PRST(458,PPI,1)),U,DAY) Q:'DTI
S STAT="" ; init highest status var
S DA=0 F S DA=$O(^PRST(458.2,"AD",DFN,DTI,DA)) Q:'DA D Q:STAT="A"
. S Z=$G(^PRST(458.2,DA,0))
. Q:$P(Z,"^",5)'=TT ; ignore different type
. I $F("RSA",$P(Z,U,8))>$F("RSA",STAT) S STAT=$P(Z,U,8) ; higher status
I STAT="" S ERR=3 D ERR Q ; none with requested or higher status
I STAT'="A" D Q ; none approved
. S ERR=$S(STAT="R":8,1:9) D ERR
. ; check posted hours vs requested since no approved request
. S TM(TT,"R")=$G(TM(TT,"R"))-TIM I TM(TT,"R")<0 S ERR=7 D ERR
; check posted hours vs approved since we have an approved request
S TM(TT,"A")=$G(TM(TT,"A"))-TIM I TM(TT,"A")<0 S ERR=13 D ERR
Q
O2 ; Check for valid with-in tour or cross-tour situations
I TT="ON"&(X2["HX") Q
;I "OT CT"[TT,TIM'>1 Q
;none-leave hours are inside tour hours, but quit if inside rs hours
QUIT:$G(TRS)=2!(TT="HW"&(X2["^RS")) S ERR=6 QUIT
TM ; Get OT,CT request,approve times
S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY),DA=0 Q:'DTI
T1 S DA=$O(^PRST(458.2,"AD",DFN,DTI,DA)) I 'DA Q
S Z=$G(^PRST(458.2,DA,0)),STAT=$P(Z,"^",8) I STAT'="","XD"[STAT G T1
S TT=$P(Z,"^",5) I TT'="OT",TT'="CT" G T1
S TM(TT,"R")=$G(TM(TT,"R"))+$P(Z,"^",6) ; requested sum
I STAT="A" S TM(TT,"A")=$G(TM(TT,"A"))+$P(Z,"^",6) ; approved sum
G T1
LV ; Check Leave Request
I TC=3!(TC=4) Q
I TC=1,TT="HW" Q
;leave hours are (overlap) outside tour hours or (overlap) inside recess hours
I ($G(TRS)'=1&(TT="HW")&$G(TRS)) QUIT
I Z1'="*"!(Z2'="*")!($G(TRS)'=1&(TT'="RS")&$G(TRS)) S ERR=5,FATAL=1 D ERR
;
L0 N REMARK S REMARK=$P(X2,"^",K+3)
Q:REMARK&(REMARK'=15&(REMARK'=16))
I "HX"[TT D HENCAP
;no leave request for non-leave hour and rs types
QUIT:"RG CP NP HX HW TR TV RS"[TT
S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY) Q:'DTI S (DT1,DT2)=DTI
I DN D D2 S:DN=2 DT1=DT2
S DTIN=9999999-DT2,DA=0
F KK=0:0 S KK=$O(^PRST(458.1,"AD",DFN,KK)) G:KK=""!(KK>DTIN) L3 F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,KK,DA)) Q:DA="" I ^(DA)'>DT1 D L1 G:LF L4
Q
L1 S Z=$G(^PRST(458.1,DA,0)),LF=0 Q:$P(Z,"^",7)'=TT S STAT=$P(Z,"^",9) I "XD"[STAT Q
G:Y0="" L2 S Z1=$P(Y0,"^",1),Z2=$P(Y0,"^",2)
S X=$P(Z,"^",4)_"^"_$P(Z,"^",6) D CNV^PRSATIM
I $P(Z,"^",3)=DT1,$P(Y,"^",1)>Z1 Q
I $P(Z,"^",5)=DT2,$P(Y,"^",2)<Z2 Q
L2 I STAT'="A" S ERR=4 D ERR
S LF=1 Q
L3 S ERR=3 D ERR Q
L4 Q
D2 I DAY<14 S DT2=$P($G(^PRST(458,PPI,1)),"^",DAY+1) Q
N X1,X2 S X1=DT1,X2=1 D C^%DTC S DT2=X Q
;
HENCAP ; Check for Holiday encapsulated by non-pay
N DAH,DBH,HOL,QUIT
S (DAH,DBH,HOL,QUIT)=""
D HENCAP^PRSATP4(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
Q:QUIT
Q:HOL=""
S ERR=15 D ERR Q ; Holiday in current PP
Q
NAWS3640(PRSEMP,PPI) ; return true if NAWS 36/40 Nurse for this PPI
N EMPNODE,PAYPLAN,DTYBASIS,NORMHRS,S8
S S8=$G(^PRST(458,PPI,"E",PRSEMP,5))
I S8'="",($E(S8,26,27)'=72!("KM"'[$E(S8,28))!($E(S8,29)'=1)) Q 0
S EMPNODE=$G(^PRSPC(PRSEMP,0))
S PAYPLAN=$P(EMPNODE,U,21)
S DTYBASIS=$P(EMPNODE,U,10)
S NORMHRS=$P(EMPNODE,U,16)
Q "KM"[PAYPLAN&(DTYBASIS=1)&(NORMHRS=72)
SAT2DAY(WK,PRSIEN,PPI) ;
N HRS,SUNTRHRS,SAT2DAY,PRSD
S SAT2DAY=0
S PRSD=$S(WK=1:7,1:14)
S SAT2DAY=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)
I SAT2DAY>0 S SAT2DAY=$P($G(^PRST(457.1,SAT2DAY,0)),U,5)="Y"
Q SAT2DAY
CARRYOVR(PRSIEN,PPI) ; true if hours are coming in from last pp
N PRIORSAT,SAT2DAY
S SAT2DAY=0
S PRIORSAT=$P($G(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0)),U,2)
I PRIORSAT>0 S SAT2DAY=$P($G(^PRST(457.1,PRIORSAT,0)),U,5)="Y"
Q SAT2DAY
THREE12(WK,PRSIEN,PPI) ;
N PRSD,TOURDTY,COUNT,ST,EN
S COUNT=0
S ST=$S(WK=1:1,1:8),EN=$S(WK=1:7,1:14)
F PRSD=ST:1:EN D
. S TOURDTY=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)
. I $P($G(^PRST(457.1,TOURDTY,0)),U,6)=12 S COUNT=COUNT+1
I COUNT'=3 Q 1
N HRS
D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
Q:(HRS($S(WK=1:"W1",1:"W2"))'=36) 1
Q 0
HRSMATCH(PPI,DFN) ; Return true if hourly employee tour hrs '= 8B normal hrs
N MATCH,HRS,NH,ENT,ENTPTR
I $G(PPI)'>0!($G(DFN)'>0) Q 1
S MATCH=1
S NH=-1
S ENTPTR=$P($G(^PRST(458,PPI,"E",DFN,0)),U,5)
I ENTPTR'="" D
. S ENT=$P($G(^PRST(457.5,ENTPTR,1)),U)
. S NH=$E($G(^PRST(458,PPI,"E",DFN,5)),26,27)
. Q:NH="00"
. I +NH'>0 S NH=$P($G(^PRSPC(DFN,0)),U,50)
I $G(ENT)="" D ^PRSAENT
I $G(ENT)'="",$E(ENT)'="D",($E(ENT,1,2)'="0D"),$G(NH)'=112 D
. D TOURHRS^PRSARC07(.HRS,PPI,DFN)
. I ($G(HRS("W1"))+$G(HRS("W2")))'=+$G(NH) S MATCH=0
Q MATCH
;
ERR ; Set Error
S ECNT=ECNT+1,ER(ECNT)=TT_$P($T(ERTX+ERR),";;",2)_"^"_$P(X2,"^",K) Q
ERR3640 ; Set NAWS (36/40) Errors and errors not related to a single segment
S ECNT=ECNT+1,ER(ECNT)=$P($T(ERTX+ERR),";;",2) Q
ERTX ;;
1 ;;No Tour Entered^
2 ;;No Time Posted^
3 ;; not Requested
4 ;; Requested but not Approved
5 ;; Posted outside of Tour Hours or within Recess Hours
6 ;; Posted within Tour Hours or outside of Recess Hours
7 ;; Posted exceeds Requested Hours
8 ;; Requested but pending Supervisor Approval
9 ;; Supervisor Approved but pending Director Approval
10 ;; Overlaps with the start of the next day's Tour
11 ;; Overlaps with the prior day's Tour
12 ;; can only be posted against OT, CT, ON, & SB in Tour
13 ;; Posted exceeds Approved Hours
14 ;; The minimum charge for Military Leave is one hour
15 ;; was encapsulated by non-pay
16 ;;36/40 AWS nurse has a 2 day tour on Saturday^
17 ;;36/40 AWS nurse has tour carryover from prior pp^
18 ;;36/40 AWS nurse must have 3 12 hr tours in week 1^
19 ;;36/40 AWS nurse must have 3 12 hr tours in week 2^
20 ;;Normal/Tour hrs unequal^
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATPE 9337 printed Sep 11, 2024@02:44:45 Page 2
PRSATPE ;WOIFO/PLT - Find Exceptions ;12/3/07
+1 ;;4.0;PAID;**26,34,69,102,112,116,117**;Sep 21, 1995;Build 32
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 KILL ER
SET (ECNT,FATAL)=0
SET X0=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,0))
SET STAT=$PIECE($GET(^(10)),"^",1)
+4 NEW MLTIME
SET MLTIME=0
+5 SET TC=$PIECE(X0,"^",2)
IF 'TC
SET ER(1)=$PIECE($TEXT(ERTX+1),";;",2)
SET FATAL=1
GOTO EX
+6 ;
+7 ;ensure Normal Hrs = tour hrs for hourly employees
+8 IF DAY=14
IF '$$HRSMATCH(PPI,DFN)
SET FATAL=1
SET ERR=20
DO ERR3640
GOTO EX
+9 ;
+10 IF "1 3 4"'[TC
IF STAT=""
SET ER(1)=$PIECE($TEXT(ERTX+2),";;",2)
SET FATAL=1
GOTO EX
+11 ;
+12 ; Validate NAWS 36/40 nurse tours--can't certify if errors
+13 IF DAY=7!(DAY=14)
IF $$NAWS3640(DFN,PPI)
Begin DoDot:1
+14 IF $$SAT2DAY(DAY/7,DFN,PPI)
SET FATAL=1
SET ERR=16
DO ERR3640
+15 IF $$THREE12(DAY/7,DFN,PPI)
SET FATAL=1
SET ERR=$SELECT(DAY=7:18,1:19)
DO ERR3640
End DoDot:1
+16 IF DAY=1
IF $$NAWS3640(DFN,PPI)
Begin DoDot:1
+17 IF $$CARRYOVR(DFN,PPI)
SET FATAL=1
SET ERR=17
DO ERR3640
End DoDot:1
+18 IF FATAL
GOTO EX
+19 ;
+20 SET X2=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,2))
if X2=""
GOTO EX
SET X1=$GET(^(1))
SET X4=$GET(^(4))
SET K=$PIECE($GET(^(10)),U,4)
+21 ;check recess entire day having un-unavailable posted for all scheduled on-on call
+22 IF $EXTRACT($GET(PRSENT),5)
IF K=2
IF X2["^RS"
Begin DoDot:1
+23 FOR K=1:3
if $PIECE(X1,U,K,999)=""
QUIT
SET Z=$PIECE(X1,U,K+2)
IF Z
IF $PIECE($GET(^PRST(457.2,Z,0)),"^",2)="ON"
IF X2'[($PIECE(X1,U,K,K+1)_"^UN")
SET PRSWOC=$GET(PRSWOC)_DAY_","
QUIT
+24 IF $GET(PRSWOC)'[(DAY_",")
FOR K=1:3
if $PIECE(X4,U,K,999)=""
QUIT
SET Z=$PIECE(X4,U,K+2)
IF Z
IF $PIECE($GET(^PRST(457.2,Z,0)),"^",2)="ON"
IF X2'[($PIECE(X4,U,K,K+1)_"^UN")
SET PRSWOC=$GET(PRSWOC)_DAY_","
QUIT
+25 QUIT
End DoDot:1
+26 ;
+27 KILL TM
IF X2["OT"!(X2["CT")
DO TM
+28 KILL T,TRS
FOR K=1:3
if $PIECE(X1,"^",K)=""
QUIT
SET Z=$PIECE(X1,"^",K+2)
IF $SELECT('Z:1,1:$PIECE($GET(^PRST(457.2,Z,0)),"^",2)="RG")
Begin DoDot:1
+29 SET X=$PIECE(X1,"^",K,K+1)
DO CNV^PRSATIM
SET Z1=$PIECE(Y,"^",1)
SET Z2=$PIECE(Y,"^",2)
DO V0
+30 IF Z1'=""
IF $GET(T(Z1))="*"
KILL T(Z1)
SET T(Z2)="*"
QUIT
+31 SET T(Z1)=""
SET T(Z2)="*"
QUIT
End DoDot:1
+32 IF X4'=""
FOR K=1:3
if $PIECE(X4,"^",K)=""
QUIT
SET Z=$PIECE(X4,"^",K+2)
IF $SELECT('Z:1,1:$PIECE($GET(^PRST(457.2,Z,0)),"^",2)="RG")
Begin DoDot:1
+33 SET X=$PIECE(X4,"^",K,K+1)
DO CNV^PRSATIM
SET Z1=$PIECE(Y,"^",1)
SET Z2=$PIECE(Y,"^",2)
DO V0
+34 IF Z1'=""
IF $GET(T(Z1))="*"
KILL T(Z1)
SET T(Z2)="*"
QUIT
+35 SET T(Z1)=""
SET T(Z2)="*"
QUIT
End DoDot:1
+36 ;
+37 ;find rs-type of time segments of trs array in x2 posted string
+38 IF X2["^RS"
FOR K=1:4:25
if $PIECE(X2,U,K,999)=""
QUIT
SET X=$PIECE(X2,"^",K,K+1)
IF "^"'[X
IF $PIECE(X2,"^",K+2)="RS"
Begin DoDot:1
+39 SET TT=$PIECE(X2,"^",K+2)
DO CNV^PRSATIM
SET Z1=$PIECE(Y,"^",1)
SET Z2=$PIECE(Y,"^",2)
DO V1
+40 IF Z1'=""
IF $GET(TRS(Z1))="*"
KILL TRS(Z1)
SET TRS(Z2)="*"
QUIT
+41 SET TRS(Z1)=""
SET TRS(Z2)="*"
+42 QUIT
End DoDot:1
+43 ; Checks for Daily employees
+44 IF "^"[$PIECE(X2,"^",1,2)
SET TT=$PIECE(X2,"^",3)
SET K=1
SET DN=0
SET Y0=""
GOTO L0
+45 FOR K=1:4:25
SET X=$PIECE(X2,"^",K,K+1)
IF "^"'[X
Begin DoDot:1
+46 NEW Z3,Z4
+47 SET TT=$PIECE(X2,"^",K+2)
+48 DO CNV^PRSATIM
SET Y0=Y
SET Z1=$PIECE(Y,"^",1)
SET Z2=$PIECE(Y,"^",2)
DO V1
SET TIM=Z2-Z1/60
+49 SET Z3=Z1
SET Z4=Z2
+50 IF TT="ML"
SET MLTIME=MLTIME+TIM
+51 SET Z1=$ORDER(T(Z1))
if Z1'=""
SET Z1=T(Z1)
+52 SET Z2=$ORDER(T(Z2-1))
if Z2'=""
SET Z2=T(Z2)
+53 ;trs=1 if absolute outside rs, 2 if absolute inside rs, 3 if overlap (in/outside) rs and inside tour of duty
+54 ;if exception segment start/ending time outside tour of duty, reset z3 and z4
+55 IF Z1]""!(Z2]"")
IF X2["^RS"
if Z1=""&(Z2="*")
SET Z3=$ORDER(T(Z3))
if Z1="*"&(Z2="")
SET Z4=$ORDER(T(Z3))
SET Z3=$ORDER(TRS(Z3))
if Z3]""
SET Z3=TRS(Z3)
SET Z4=$ORDER(TRS(Z4-1))
if Z4]""
SET Z4=TRS(Z4)
SET TRS=$SELECT(Z3=""&(Z4=""):1,Z3="*"&(Z4="*"):2,1:3)
+56 IF TT="UN"
DO UN^PRSATPH
QUIT
+57 IF "CT OT ON SB RG"[TT
DO OT
QUIT
+58 DO LV
QUIT
End DoDot:1
+59 ;
+60 ; Check for a minimum of 1 hour ML
+61 ;
+62 IF TT="ML"
IF MLTIME<1
SET ER(1)=$PIECE($TEXT(ERTX+14),";;",2)
SET FATAL=1
GOTO EX
+63 ;
EX QUIT
V0 IF Z2>Z1
if $ORDER(T(""))'<Z2
SET Z1=Z1+1440
SET Z2=Z2+1440
QUIT
+1 SET Z2=Z2+1440
QUIT
V1 SET DN=0
IF Z2>Z1
if "CT OT ON SB UN RG"[TT
QUIT
if $ORDER(T(""))'<Z2
SET Z1=Z1+1440
SET Z2=Z2+1440
SET DN=2
QUIT
+1 SET Z2=Z2+1440
SET DN=1
QUIT
OT ; Check OT/CT Request
+1 IF Z1'=""!(Z2'="")
DO O2
IF $GET(ERR)=6
SET FATAL=1
DO ERR
+2 IF DN=1
IF $ORDER(T(1440))=""
DO NX^PRSATPH
+3 IF 'DN
IF $ORDER(T(""))=""!($PIECE(Y0,"^",1)'>$ORDER(T("")))
DO PR^PRSATPH
+4 IF "ON SB RG"[TT
QUIT
+5 ; check status of request(s)
+6 SET DTI=$PIECE($GET(^PRST(458,PPI,1)),U,DAY)
if 'DTI
QUIT
+7 ; init highest status var
SET STAT=""
+8 SET DA=0
FOR
SET DA=$ORDER(^PRST(458.2,"AD",DFN,DTI,DA))
if 'DA
QUIT
Begin DoDot:1
+9 SET Z=$GET(^PRST(458.2,DA,0))
+10 ; ignore different type
if $PIECE(Z,"^",5)'=TT
QUIT
+11 ; higher status
IF $FIND("RSA",$PIECE(Z,U,8))>$FIND("RSA",STAT)
SET STAT=$PIECE(Z,U,8)
End DoDot:1
if STAT="A"
QUIT
+12 ; none with requested or higher status
IF STAT=""
SET ERR=3
DO ERR
QUIT
+13 ; none approved
IF STAT'="A"
Begin DoDot:1
+14 SET ERR=$SELECT(STAT="R":8,1:9)
DO ERR
+15 ; check posted hours vs requested since no approved request
+16 SET TM(TT,"R")=$GET(TM(TT,"R"))-TIM
IF TM(TT,"R")<0
SET ERR=7
DO ERR
End DoDot:1
QUIT
+17 ; check posted hours vs approved since we have an approved request
+18 SET TM(TT,"A")=$GET(TM(TT,"A"))-TIM
IF TM(TT,"A")<0
SET ERR=13
DO ERR
+19 QUIT
O2 ; Check for valid with-in tour or cross-tour situations
+1 IF TT="ON"&(X2["HX")
QUIT
+2 ;I "OT CT"[TT,TIM'>1 Q
+3 ;none-leave hours are inside tour hours, but quit if inside rs hours
+4 if $GET(TRS)=2!(TT="HW"&(X2["^RS"))
QUIT
SET ERR=6
QUIT
TM ; Get OT,CT request,approve times
+1 SET DTI=$PIECE($GET(^PRST(458,PPI,1)),"^",DAY)
SET DA=0
if 'DTI
QUIT
T1 SET DA=$ORDER(^PRST(458.2,"AD",DFN,DTI,DA))
IF 'DA
QUIT
+1 SET Z=$GET(^PRST(458.2,DA,0))
SET STAT=$PIECE(Z,"^",8)
IF STAT'=""
IF "XD"[STAT
GOTO T1
+2 SET TT=$PIECE(Z,"^",5)
IF TT'="OT"
IF TT'="CT"
GOTO T1
+3 ; requested sum
SET TM(TT,"R")=$GET(TM(TT,"R"))+$PIECE(Z,"^",6)
+4 ; approved sum
IF STAT="A"
SET TM(TT,"A")=$GET(TM(TT,"A"))+$PIECE(Z,"^",6)
+5 GOTO T1
LV ; Check Leave Request
+1 IF TC=3!(TC=4)
QUIT
+2 IF TC=1
IF TT="HW"
QUIT
+3 ;leave hours are (overlap) outside tour hours or (overlap) inside recess hours
+4 IF ($GET(TRS)'=1&(TT="HW")&$GET(TRS))
QUIT
+5 IF Z1'="*"!(Z2'="*")!($GET(TRS)'=1&(TT'="RS")&$GET(TRS))
SET ERR=5
SET FATAL=1
DO ERR
+6 ;
L0 NEW REMARK
SET REMARK=$PIECE(X2,"^",K+3)
+1 if REMARK&(REMARK'=15&(REMARK'=16))
QUIT
+2 IF "HX"[TT
DO HENCAP
+3 ;no leave request for non-leave hour and rs types
+4 if "RG CP NP HX HW TR TV RS"[TT
QUIT
+5 SET DTI=$PIECE($GET(^PRST(458,PPI,1)),"^",DAY)
if 'DTI
QUIT
SET (DT1,DT2)=DTI
+6 IF DN
DO D2
if DN=2
SET DT1=DT2
+7 SET DTIN=9999999-DT2
SET DA=0
+8 FOR KK=0:0
SET KK=$ORDER(^PRST(458.1,"AD",DFN,KK))
if KK=""!(KK>DTIN)
GOTO L3
FOR DA=0:0
SET DA=$ORDER(^PRST(458.1,"AD",DFN,KK,DA))
if DA=""
QUIT
IF ^(DA)'>DT1
DO L1
if LF
GOTO L4
+9 QUIT
L1 SET Z=$GET(^PRST(458.1,DA,0))
SET LF=0
if $PIECE(Z,"^",7)'=TT
QUIT
SET STAT=$PIECE(Z,"^",9)
IF "XD"[STAT
QUIT
+1 if Y0=""
GOTO L2
SET Z1=$PIECE(Y0,"^",1)
SET Z2=$PIECE(Y0,"^",2)
+2 SET X=$PIECE(Z,"^",4)_"^"_$PIECE(Z,"^",6)
DO CNV^PRSATIM
+3 IF $PIECE(Z,"^",3)=DT1
IF $PIECE(Y,"^",1)>Z1
QUIT
+4 IF $PIECE(Z,"^",5)=DT2
IF $PIECE(Y,"^",2)<Z2
QUIT
L2 IF STAT'="A"
SET ERR=4
DO ERR
+1 SET LF=1
QUIT
L3 SET ERR=3
DO ERR
QUIT
L4 QUIT
D2 IF DAY<14
SET DT2=$PIECE($GET(^PRST(458,PPI,1)),"^",DAY+1)
QUIT
+1 NEW X1,X2
SET X1=DT1
SET X2=1
DO C^%DTC
SET DT2=X
QUIT
+2 ;
HENCAP ; Check for Holiday encapsulated by non-pay
+1 NEW DAH,DBH,HOL,QUIT
+2 SET (DAH,DBH,HOL,QUIT)=""
+3 DO HENCAP^PRSATP4(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
+4 if QUIT
QUIT
+5 if HOL=""
QUIT
+6 ; Holiday in current PP
SET ERR=15
DO ERR
QUIT
+7 QUIT
NAWS3640(PRSEMP,PPI) ; return true if NAWS 36/40 Nurse for this PPI
+1 NEW EMPNODE,PAYPLAN,DTYBASIS,NORMHRS,S8
+2 SET S8=$GET(^PRST(458,PPI,"E",PRSEMP,5))
+3 IF S8'=""
IF ($EXTRACT(S8,26,27)'=72!("KM"'[$EXTRACT(S8,28))!($EXTRACT(S8,29)'=1))
QUIT 0
+4 SET EMPNODE=$GET(^PRSPC(PRSEMP,0))
+5 SET PAYPLAN=$PIECE(EMPNODE,U,21)
+6 SET DTYBASIS=$PIECE(EMPNODE,U,10)
+7 SET NORMHRS=$PIECE(EMPNODE,U,16)
+8 QUIT "KM"[PAYPLAN&(DTYBASIS=1)&(NORMHRS=72)
SAT2DAY(WK,PRSIEN,PPI) ;
+1 NEW HRS,SUNTRHRS,SAT2DAY,PRSD
+2 SET SAT2DAY=0
+3 SET PRSD=$SELECT(WK=1:7,1:14)
+4 SET SAT2DAY=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)
+5 IF SAT2DAY>0
SET SAT2DAY=$PIECE($GET(^PRST(457.1,SAT2DAY,0)),U,5)="Y"
+6 QUIT SAT2DAY
CARRYOVR(PRSIEN,PPI) ; true if hours are coming in from last pp
+1 NEW PRIORSAT,SAT2DAY
+2 SET SAT2DAY=0
+3 SET PRIORSAT=$PIECE($GET(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0)),U,2)
+4 IF PRIORSAT>0
SET SAT2DAY=$PIECE($GET(^PRST(457.1,PRIORSAT,0)),U,5)="Y"
+5 QUIT SAT2DAY
THREE12(WK,PRSIEN,PPI) ;
+1 NEW PRSD,TOURDTY,COUNT,ST,EN
+2 SET COUNT=0
+3 SET ST=$SELECT(WK=1:1,1:8)
SET EN=$SELECT(WK=1:7,1:14)
+4 FOR PRSD=ST:1:EN
Begin DoDot:1
+5 SET TOURDTY=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)
+6 IF $PIECE($GET(^PRST(457.1,TOURDTY,0)),U,6)=12
SET COUNT=COUNT+1
End DoDot:1
+7 IF COUNT'=3
QUIT 1
+8 NEW HRS
+9 DO TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
+10 if (HRS($SELECT(WK=1
QUIT 1
+11 QUIT 0
HRSMATCH(PPI,DFN) ; Return true if hourly employee tour hrs '= 8B normal hrs
+1 NEW MATCH,HRS,NH,ENT,ENTPTR
+2 IF $GET(PPI)'>0!($GET(DFN)'>0)
QUIT 1
+3 SET MATCH=1
+4 SET NH=-1
+5 SET ENTPTR=$PIECE($GET(^PRST(458,PPI,"E",DFN,0)),U,5)
+6 IF ENTPTR'=""
Begin DoDot:1
+7 SET ENT=$PIECE($GET(^PRST(457.5,ENTPTR,1)),U)
+8 SET NH=$EXTRACT($GET(^PRST(458,PPI,"E",DFN,5)),26,27)
+9 if NH="00"
QUIT
+10 IF +NH'>0
SET NH=$PIECE($GET(^PRSPC(DFN,0)),U,50)
End DoDot:1
+11 IF $GET(ENT)=""
DO ^PRSAENT
+12 IF $GET(ENT)'=""
IF $EXTRACT(ENT)'="D"
IF ($EXTRACT(ENT,1,2)'="0D")
IF $GET(NH)'=112
Begin DoDot:1
+13 DO TOURHRS^PRSARC07(.HRS,PPI,DFN)
+14 IF ($GET(HRS("W1"))+$GET(HRS("W2")))'=+$GET(NH)
SET MATCH=0
End DoDot:1
+15 QUIT MATCH
+16 ;
ERR ; Set Error
+1 SET ECNT=ECNT+1
SET ER(ECNT)=TT_$PIECE($TEXT(ERTX+ERR),";;",2)_"^"_$PIECE(X2,"^",K)
QUIT
ERR3640 ; Set NAWS (36/40) Errors and errors not related to a single segment
+1 SET ECNT=ECNT+1
SET ER(ECNT)=$PIECE($TEXT(ERTX+ERR),";;",2)
QUIT
ERTX ;;
1 ;;No Tour Entered^
2 ;;No Time Posted^
3 ;; not Requested
4 ;; Requested but not Approved
5 ;; Posted outside of Tour Hours or within Recess Hours
6 ;; Posted within Tour Hours or outside of Recess Hours
7 ;; Posted exceeds Requested Hours
8 ;; Requested but pending Supervisor Approval
9 ;; Supervisor Approved but pending Director Approval
10 ;; Overlaps with the start of the next day's Tour
11 ;; Overlaps with the prior day's Tour
12 ;; can only be posted against OT, CT, ON, & SB in Tour
13 ;; Posted exceeds Approved Hours
14 ;; The minimum charge for Military Leave is one hour
15 ;; was encapsulated by non-pay
16 ;;36/40 AWS nurse has a 2 day tour on Saturday^
17 ;;36/40 AWS nurse has tour carryover from prior pp^
18 ;;36/40 AWS nurse must have 3 12 hr tours in week 1^
19 ;;36/40 AWS nurse must have 3 12 hr tours in week 2^
20 ;;Normal/Tour hrs unequal^
