Changeset 636 for FOIAVistA/tag/r/PAID-PRS/PRSATPE.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• PAID-PRS/PRSATPE.m (modified) (7 diffs)

FOIAVistA/tag/r/PAID-PRS/PRSATPE.m

@@ -1 @@
-PRSATPE ;WOIFO/PLT - Find Exceptions ;12/3/07
- ;;4.0;PAID;**26,34,69,102,112,116**;Sep 21, 1995;Build 23
- ;;Per VHA Directive 2004-038, this routine should not be modified.
+PRSATPE ;HISC/REL-Find Exceptions ;12/08/05
+ ;;4.0;PAID;**26,34,69,102**;Sep 21, 1995
  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=21 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
- N NAWSERR S NAWSERR=0
- I DAY=7!(DAY=14),$$NAWS3640(DFN,PPI) D
- .  I $$SAT2DAY(DAY/7,DFN,PPI) D
- ..    S FATAL=1 S ERR=16 D ERR3640 S ERR=17 D ERR3640
- ..    S NAWSERR=1
- .  I $$THREE12(DAY/7,DFN,PPI) D
- ..    S FATAL=1 I 'NAWSERR S ERR=16 D ERR3640
- ..    S ERR=$S(DAY=7:19,1:20) D ERR3640
- I DAY=1,$$NAWS3640(DFN,PPI),$$CARRYOVR(DFN,PPI) D
- .    S FATAL=1 S ERR=16 D ERR3640 S ERR=18 D ERR3640
- ;
- 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
- ;
+ S X2=$G(^PRST(458,PPI,"E",DFN,"D",DAY,2)) G:X2="" EX S X1=$G(^(1)),X4=$G(^(4))
  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
+ K T 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
@@ -40 +16 @@
  .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
+ .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
+ .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)
+ .I TT="UN" D UN^PRSATPH Q
+ .I "CT OT ON SB RG"[TT D OT Q
+ .D LV Q
  ;
  ; Check for a minimum of 1 hour ML
@@ -95 +60 @@
  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
+ S ERR=6 Q
 TM ; Get OT,CT request,approve times
  S DTI=$P($G(^PRST(458,PPI,1)),"^",DAY),DA=0 Q:'DTI
@@ -108 +72 @@
  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
+ I Z1'="*"!(Z2'="*") 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
+ Q:"RG CP NP HX HW TR TV"[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
@@ -142 +103 @@
  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^
@@ -202 +111 @@
 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
+5 ;; Posted outside of Tour Hours
+6 ;; Posted within Tour Hours
 7 ;; Posted exceeds Requested Hours
 8 ;; Requested but pending Supervisor Approval
@@ -213 +122 @@
 14 ;; The minimum charge for Military Leave is one hour
 15 ;; was encapsulated by non-pay
-16 ;;36/40 AWS tours require
-17 ;; -no 2 day tours on Sat
-18 ;; -no prior pp carryover
-19 ;; -3 12 hr tours/wk 1
-20 ;; -3 12 hr tours/wk 2
-21 ;;Normal/Tour hrs unequal