| 1 | PRSATPE ;WOIFO/PLT - Find Exceptions ;12/3/07
|
|---|
| 2 | ;;4.0;PAID;**26,34,69,102,112,116**;Sep 21, 1995;Build 23
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | K ER S (ECNT,FATAL)=0,X0=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),STAT=$P($G(^(10)),"^",1)
|
|---|
| 5 | N MLTIME S MLTIME=0
|
|---|
| 6 | S TC=$P(X0,"^",2) I 'TC S ER(1)=$P($T(ERTX+1),";;",2),FATAL=1 G EX
|
|---|
| 7 | ;
|
|---|
| 8 | ;ensure Normal Hrs = tour hrs for hourly employees
|
|---|
| 9 | I DAY=14 I '$$HRSMATCH(PPI,DFN) S FATAL=1,ERR=21 D ERR3640 G EX
|
|---|
| 10 | ;
|
|---|
| 11 | I "1 3 4"'[TC,STAT="" S ER(1)=$P($T(ERTX+2),";;",2),FATAL=1 G EX
|
|---|
| 12 | ;
|
|---|
| 13 | ; Validate NAWS 36/40 nurse tours--can't certify if errors
|
|---|
| 14 | N NAWSERR S NAWSERR=0
|
|---|
| 15 | I DAY=7!(DAY=14),$$NAWS3640(DFN,PPI) D
|
|---|
| 16 | . I $$SAT2DAY(DAY/7,DFN,PPI) D
|
|---|
| 17 | .. S FATAL=1 S ERR=16 D ERR3640 S ERR=17 D ERR3640
|
|---|
| 18 | .. S NAWSERR=1
|
|---|
| 19 | . I $$THREE12(DAY/7,DFN,PPI) D
|
|---|
| 20 | .. S FATAL=1 I 'NAWSERR S ERR=16 D ERR3640
|
|---|
| 21 | .. S ERR=$S(DAY=7:19,1:20) D ERR3640
|
|---|
| 22 | I DAY=1,$$NAWS3640(DFN,PPI),$$CARRYOVR(DFN,PPI) D
|
|---|
| 23 | . S FATAL=1 S ERR=16 D ERR3640 S ERR=18 D ERR3640
|
|---|
| 24 | ;
|
|---|
| 25 | 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)
|
|---|
| 26 | ;check recess entire day having un-unavailable posted for all scheduled on-on call
|
|---|
| 27 | I $E($G(PRSENT),5),K=2,X2["^RS" D
|
|---|
| 28 | . 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
|
|---|
| 29 | . 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
|
|---|
| 30 | . QUIT
|
|---|
| 31 | ;
|
|---|
| 32 | K TM I X2["OT"!(X2["CT") D TM
|
|---|
| 33 | 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
|
|---|
| 34 | .S X=$P(X1,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
|
|---|
| 35 | .I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q
|
|---|
| 36 | .S T(Z1)="",T(Z2)="*" Q
|
|---|
| 37 | 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
|
|---|
| 38 | .S X=$P(X4,"^",K,K+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
|
|---|
| 39 | .I Z1'="",$G(T(Z1))="*" K T(Z1) S T(Z2)="*" Q
|
|---|
| 40 | .S T(Z1)="",T(Z2)="*" Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;find rs-type of time segments of trs array in x2 posted string
|
|---|
| 43 | 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
|
|---|
| 44 | . S TT=$P(X2,"^",K+2) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1
|
|---|
| 45 | . I Z1'="",$G(TRS(Z1))="*" K TRS(Z1) S TRS(Z2)="*" QUIT
|
|---|
| 46 | . S TRS(Z1)="",TRS(Z2)="*"
|
|---|
| 47 | . QUIT
|
|---|
| 48 | ; Checks for Daily employees
|
|---|
| 49 | I "^"[$P(X2,"^",1,2) S TT=$P(X2,"^",3),K=1,DN=0,Y0="" G L0
|
|---|
| 50 | F K=1:4:25 S X=$P(X2,"^",K,K+1) I "^"'[X D
|
|---|
| 51 | . N Z3,Z4
|
|---|
| 52 | . S TT=$P(X2,"^",K+2)
|
|---|
| 53 | . D CNV^PRSATIM S Y0=Y,Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V1 S TIM=Z2-Z1/60
|
|---|
| 54 | . S Z3=Z1,Z4=Z2
|
|---|
| 55 | . I TT="ML" S MLTIME=MLTIME+TIM
|
|---|
| 56 | . S Z1=$O(T(Z1)) S:Z1'="" Z1=T(Z1)
|
|---|
| 57 | . S Z2=$O(T(Z2-1)) S:Z2'="" Z2=T(Z2)
|
|---|
| 58 | . ;trs=1 if absolute outside rs, 2 if absolute inside rs, 3 if overlap (in/outside) rs and inside tour of duty
|
|---|
| 59 | . ;if exception segment start/ending time outside tour of duty, reset z3 and z4
|
|---|
| 60 | . 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)
|
|---|
| 61 | . I TT="UN" D UN^PRSATPH QUIT
|
|---|
| 62 | . I "CT OT ON SB RG"[TT D OT QUIT
|
|---|
| 63 | . D LV QUIT
|
|---|
| 64 | ;
|
|---|
| 65 | ; Check for a minimum of 1 hour ML
|
|---|
| 66 | ;
|
|---|
| 67 | I TT="ML",MLTIME<1 S ER(1)=$P($T(ERTX+14),";;",2),FATAL=1 G EX
|
|---|
| 68 | ;
|
|---|
| 69 | EX Q
|
|---|
| 70 | V0 I Z2>Z1 S:$O(T(""))'<Z2 Z1=Z1+1440,Z2=Z2+1440 Q
|
|---|
| 71 | S Z2=Z2+1440 Q
|
|---|
| 72 | 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
|
|---|
| 73 | S Z2=Z2+1440,DN=1 Q
|
|---|
| 74 | OT ; Check OT/CT Request
|
|---|
| 75 | I Z1'=""!(Z2'="") D O2 I $G(ERR)=6 S FATAL=1 D ERR
|
|---|
| 76 | I DN=1,$O(T(1440))="" D NX^PRSATPH
|
|---|
| 77 | I 'DN,$O(T(""))=""!($P(Y0,"^",1)'>$O(T(""))) D PR^PRSATPH
|
|---|
| 78 | I "ON SB RG"[TT Q
|
|---|
| 79 | ; check status of request(s)
|
|---|
| 80 | S DTI=$P($G(^PRST(458,PPI,1)),U,DAY) Q:'DTI
|
|---|
| 81 | S STAT="" ; init highest status var
|
|---|
| 82 | S DA=0 F S DA=$O(^PRST(458.2,"AD",DFN,DTI,DA)) Q:'DA D Q:STAT="A"
|
|---|
| 83 | . S Z=$G(^PRST(458.2,DA,0))
|
|---|
| 84 | . Q:$P(Z,"^",5)'=TT ; ignore different type
|
|---|
| 85 | . I $F("RSA",$P(Z,U,8))>$F("RSA",STAT) S STAT=$P(Z,U,8) ; higher status
|
|---|
| 86 | I STAT="" S ERR=3 D ERR Q ; none with requested or higher status
|
|---|
| 87 | I STAT'="A" D Q ; none approved
|
|---|
| 88 | . S ERR=$S(STAT="R":8,1:9) D ERR
|
|---|
| 89 | . ; check posted hours vs requested since no approved request
|
|---|
| 90 | . S TM(TT,"R")=$G(TM(TT,"R"))-TIM I TM(TT,"R")<0 S ERR=7 D ERR
|
|---|
| 91 | ; check posted hours vs approved since we have an approved request
|
|---|
| 92 | S TM(TT,"A")=$G(TM(TT,"A"))-TIM I TM(TT,"A")<0 S ERR=13 D ERR
|
|---|
| 93 | Q
|
|---|
| 94 | O2 ; Check for valid with-in tour or cross-tour situations
|
|---|
| 95 | I TT="ON"&(X2["HX") Q
|
|---|
| 96 | ;I "OT CT"[TT,TIM'>1 Q
|
|---|
| 97 | ;none-leave hours are inside tour hours, but quit if inside rs hours
|
|---|
| 98 | QUIT:$G(TRS)=2!(TT="HW"&(X2["^RS")) S ERR=6 QUIT
|
|---|
| 99 | TM ; Get OT,CT request,approve times
|
|---|
| 100 | S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY),DA=0 Q:'DTI
|
|---|
| 101 | T1 S DA=$O(^PRST(458.2,"AD",DFN,DTI,DA)) I 'DA Q
|
|---|
| 102 | S Z=$G(^PRST(458.2,DA,0)),STAT=$P(Z,"^",8) I STAT'="","XD"[STAT G T1
|
|---|
| 103 | S TT=$P(Z,"^",5) I TT'="OT",TT'="CT" G T1
|
|---|
| 104 | S TM(TT,"R")=$G(TM(TT,"R"))+$P(Z,"^",6) ; requested sum
|
|---|
| 105 | I STAT="A" S TM(TT,"A")=$G(TM(TT,"A"))+$P(Z,"^",6) ; approved sum
|
|---|
| 106 | G T1
|
|---|
| 107 | LV ; Check Leave Request
|
|---|
| 108 | I TC=3!(TC=4) Q
|
|---|
| 109 | I TC=1,TT="HW" Q
|
|---|
| 110 | ;leave hours are (overlap) outside tour hours or (overlap) inside recess hours
|
|---|
| 111 | I ($G(TRS)'=1&(TT="HW")&$G(TRS)) QUIT
|
|---|
| 112 | I Z1'="*"!(Z2'="*")!($G(TRS)'=1&(TT'="RS")&$G(TRS)) S ERR=5,FATAL=1 D ERR
|
|---|
| 113 | ;
|
|---|
| 114 | L0 N REMARK S REMARK=$P(X2,"^",K+3)
|
|---|
| 115 | Q:REMARK&(REMARK'=15&(REMARK'=16))
|
|---|
| 116 | I "HX"[TT D HENCAP
|
|---|
| 117 | ;no leave request for non-leave hour and rs types
|
|---|
| 118 | QUIT:"RG CP NP HX HW TR TV RS"[TT
|
|---|
| 119 | S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY) Q:'DTI S (DT1,DT2)=DTI
|
|---|
| 120 | I DN D D2 S:DN=2 DT1=DT2
|
|---|
| 121 | S DTIN=9999999-DT2,DA=0
|
|---|
| 122 | 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
|
|---|
| 123 | Q
|
|---|
| 124 | 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
|
|---|
| 125 | G:Y0="" L2 S Z1=$P(Y0,"^",1),Z2=$P(Y0,"^",2)
|
|---|
| 126 | S X=$P(Z,"^",4)_"^"_$P(Z,"^",6) D CNV^PRSATIM
|
|---|
| 127 | I $P(Z,"^",3)=DT1,$P(Y,"^",1)>Z1 Q
|
|---|
| 128 | I $P(Z,"^",5)=DT2,$P(Y,"^",2)<Z2 Q
|
|---|
| 129 | L2 I STAT'="A" S ERR=4 D ERR
|
|---|
| 130 | S LF=1 Q
|
|---|
| 131 | L3 S ERR=3 D ERR Q
|
|---|
| 132 | L4 Q
|
|---|
| 133 | D2 I DAY<14 S DT2=$P($G(^PRST(458,PPI,1)),"^",DAY+1) Q
|
|---|
| 134 | N X1,X2 S X1=DT1,X2=1 D C^%DTC S DT2=X Q
|
|---|
| 135 | ;
|
|---|
| 136 | HENCAP ; Check for Holiday encapsulated by non-pay
|
|---|
| 137 | N DAH,DBH,HOL,QUIT
|
|---|
| 138 | S (DAH,DBH,HOL,QUIT)=""
|
|---|
| 139 | D HENCAP^PRSATP4(PPI,DFN,DAY,.DBH,.HOL,.DAH,.QUIT)
|
|---|
| 140 | Q:QUIT
|
|---|
| 141 | Q:HOL=""
|
|---|
| 142 | S ERR=15 D ERR Q ; Holiday in current PP
|
|---|
| 143 | Q
|
|---|
| 144 | NAWS3640(PRSEMP,PPI) ; return true if NAWS 36/40 Nurse for this PPI
|
|---|
| 145 | N EMPNODE,PAYPLAN,DTYBASIS,NORMHRS,S8
|
|---|
| 146 | S S8=$G(^PRST(458,PPI,"E",PRSEMP,5))
|
|---|
| 147 | I S8'="",($E(S8,26,27)'=72!("KM"'[$E(S8,28))!($E(S8,29)'=1)) Q 0
|
|---|
| 148 | S EMPNODE=$G(^PRSPC(PRSEMP,0))
|
|---|
| 149 | S PAYPLAN=$P(EMPNODE,U,21)
|
|---|
| 150 | S DTYBASIS=$P(EMPNODE,U,10)
|
|---|
| 151 | S NORMHRS=$P(EMPNODE,U,16)
|
|---|
| 152 | Q "KM"[PAYPLAN&(DTYBASIS=1)&(NORMHRS=72)
|
|---|
| 153 | SAT2DAY(WK,PRSIEN,PPI) ;
|
|---|
| 154 | N HRS,SUNTRHRS,SAT2DAY,PRSD
|
|---|
| 155 | S SAT2DAY=0
|
|---|
| 156 | S PRSD=$S(WK=1:7,1:14)
|
|---|
| 157 | S SAT2DAY=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)
|
|---|
| 158 | I SAT2DAY>0 S SAT2DAY=$P($G(^PRST(457.1,SAT2DAY,0)),U,5)="Y"
|
|---|
| 159 | Q SAT2DAY
|
|---|
| 160 | CARRYOVR(PRSIEN,PPI) ; true if hours are coming in from last pp
|
|---|
| 161 | N PRIORSAT,SAT2DAY
|
|---|
| 162 | S SAT2DAY=0
|
|---|
| 163 | S PRIORSAT=$P($G(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0)),U,2)
|
|---|
| 164 | I PRIORSAT>0 S SAT2DAY=$P($G(^PRST(457.1,PRIORSAT,0)),U,5)="Y"
|
|---|
| 165 | Q SAT2DAY
|
|---|
| 166 | THREE12(WK,PRSIEN,PPI) ;
|
|---|
| 167 | N PRSD,TOURDTY,COUNT,ST,EN
|
|---|
| 168 | S COUNT=0
|
|---|
| 169 | S ST=$S(WK=1:1,1:8),EN=$S(WK=1:7,1:14)
|
|---|
| 170 | F PRSD=ST:1:EN D
|
|---|
| 171 | . S TOURDTY=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),"^",2)
|
|---|
| 172 | . I $P($G(^PRST(457.1,TOURDTY,0)),U,6)=12 S COUNT=COUNT+1
|
|---|
| 173 | I COUNT'=3 Q 1
|
|---|
| 174 | N HRS
|
|---|
| 175 | D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
|
|---|
| 176 | Q:(HRS($S(WK=1:"W1",1:"W2"))'=36) 1
|
|---|
| 177 | Q 0
|
|---|
| 178 | HRSMATCH(PPI,DFN) ; Return true if hourly employee tour hrs '= 8B normal hrs
|
|---|
| 179 | N MATCH,HRS,NH,ENT,ENTPTR
|
|---|
| 180 | I $G(PPI)'>0!($G(DFN)'>0) Q 1
|
|---|
| 181 | S MATCH=1
|
|---|
| 182 | S NH=-1
|
|---|
| 183 | S ENTPTR=$P($G(^PRST(458,PPI,"E",DFN,0)),U,5)
|
|---|
| 184 | I ENTPTR'="" D
|
|---|
| 185 | . S ENT=$P($G(^PRST(457.5,ENTPTR,1)),U)
|
|---|
| 186 | . S NH=$E($G(^PRST(458,PPI,"E",DFN,5)),26,27)
|
|---|
| 187 | . Q:NH="00"
|
|---|
| 188 | . I +NH'>0 S NH=$P($G(^PRSPC(DFN,0)),U,50)
|
|---|
| 189 | I $G(ENT)="" D ^PRSAENT
|
|---|
| 190 | I $G(ENT)'="",$E(ENT)'="D",($E(ENT,1,2)'="0D"),$G(NH)'=112 D
|
|---|
| 191 | . D TOURHRS^PRSARC07(.HRS,PPI,DFN)
|
|---|
| 192 | . I ($G(HRS("W1"))+$G(HRS("W2")))'=+$G(NH) S MATCH=0
|
|---|
| 193 | Q MATCH
|
|---|
| 194 | ;
|
|---|
| 195 | ERR ; Set Error
|
|---|
| 196 | S ECNT=ECNT+1,ER(ECNT)=TT_$P($T(ERTX+ERR),";;",2)_"^"_$P(X2,"^",K) Q
|
|---|
| 197 | ERR3640 ; Set NAWS (36/40) Errors and errors not related to a single segment
|
|---|
| 198 | S ECNT=ECNT+1,ER(ECNT)=$P($T(ERTX+ERR),";;",2) Q
|
|---|
| 199 | ERTX ;;
|
|---|
| 200 | 1 ;;No Tour Entered^
|
|---|
| 201 | 2 ;;No Time Posted^
|
|---|
| 202 | 3 ;; not Requested
|
|---|
| 203 | 4 ;; Requested but not Approved
|
|---|
| 204 | 5 ;; Posted outside of Tour Hours or within Recess Hours
|
|---|
| 205 | 6 ;; Posted within Tour Hours or outside of Recess Hours
|
|---|
| 206 | 7 ;; Posted exceeds Requested Hours
|
|---|
| 207 | 8 ;; Requested but pending Supervisor Approval
|
|---|
| 208 | 9 ;; Supervisor Approved but pending Director Approval
|
|---|
| 209 | 10 ;; Overlaps with the start of the next day's Tour
|
|---|
| 210 | 11 ;; Overlaps with the prior day's Tour
|
|---|
| 211 | 12 ;; can only be posted against OT, CT, ON, & SB in Tour
|
|---|
| 212 | 13 ;; Posted exceeds Approved Hours
|
|---|
| 213 | 14 ;; The minimum charge for Military Leave is one hour
|
|---|
| 214 | 15 ;; was encapsulated by non-pay
|
|---|
| 215 | 16 ;;36/40 AWS tours require
|
|---|
| 216 | 17 ;; -no 2 day tours on Sat
|
|---|
| 217 | 18 ;; -no prior pp carryover
|
|---|
| 218 | 19 ;; -3 12 hr tours/wk 1
|
|---|
| 219 | 20 ;; -3 12 hr tours/wk 2
|
|---|
| 220 | 21 ;;Normal/Tour hrs unequal
|
|---|
