Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRS8WE2

PRS8WE2.m

Go to the documentation of this file. 
  1. PRS8WE2 ;WCIOFO/MGD-DECOMPOSITION, WEEKEND PREMIUM PART 2 ;3/23/07
  1.  ;;4.0;PAID;**90,92,96,112,119**;Sep 21, 1995;Build 4
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. COUNT(DAYN,SEG) ; Increase count of premium for tour
  1.  ; input
  1.  ;   DAYN = day # (0-15) being counted
  1.  ;   SEG  = segment # (1-96) in DAYN being counted
  1.  ;   D(DAYN)
  1.  ;   P(DAYN)
  1.  ;   H(DAYN)
  1.  ;   CNT(DAYN,shift) - optional
  1.  ; output
  1.  ;   CNT(DAYN,shift) = current count for tour being processed
  1.  ;
  1.  N DAT,FND,M1,NODE,NOTELG,POST,PREVDAY,RC,SC,SHIFT,TDAY,TOUR,TOURS,TS
  1.  ; perform final checks
  1.  I ("EetOscbT"[$E(D(DAYN),SEG)),$E(H(DAYN),SEG)'=2,$E(P(DAYN),SEG) Q
  1.  I TYP["P","4"[$E(D(DAYN),SEG),$E(H(DAYN),SEG)'=2,$E(P(DAYN),SEG)=0 Q
  1.  ;
  1.  ; If Hybrid employee as defined by Public Law P.L. 107-135, check
  1.  ; to see if the time was on a tour of duty or an exception.  Tours
  1.  ; worked on Sat or Sun qualify for Premium time.  If the time was
  1.  ; an exception, check the Remarks Code to see if the segment can be
  1.  ; counted as Premium time.
  1.  ;
  1.  S (FND,NOTELG)=0
  1.  ; Quit if Sunday and employee is not entitled to Sun Prem Pay
  1.  Q:SATNOSUN&("^1^8^15^"[(U_DAY_U))&(TP="SUN")
  1.  I HYBRID!(PMP'=""&("^S^T^U^V^"[(U_PMP_U))) D  Q:NOTELG
  1.  . ; Check to see if the time was on a tour or an exception
  1.  . N INC,END
  1.  . F TOURS=1,4,2 D  Q:NOTELG!(FND)
  1.  . . S TOUR=$G(^TMP($J,"PRS8",DAYN,TOURS))
  1.  . . Q:TOUR=""
  1.  . . S INC=$S(TOURS=2:4,1:3)
  1.  . . S END=$S(TOURS=2:25,1:19)
  1.  . . F POST=1:INC:END I $P(TOUR,"^",POST)'="" D  Q:NOTELG!(FND)
  1.  . . . ; Quit if SEG is not within the start/stop time
  1.  . . . Q:SEG<$P(TOUR,"^",POST)!(SEG>$P(TOUR,"^",POST+1))
  1.  . . . S FND=1
  1.  . . . Q:TOURS=1!(TOURS=4)  ; If on a Tour it counts as Premium
  1.  . . . S RC=$P(TOUR,"^",POST+3)
  1.  . . . ; Remarks Code must be OT/CT on Premium (#9), Tour Coverage (#12),
  1.  . . . ; CB - Premium T&L (#14) or OT/CT With Premiums (#17) to qualify for Premium pay.
  1.  . . . I "^9^12^14^17^"'[("^"_RC_"^") S NOTELG=1
  1.  . Q:FND
  1.  . ;
  1.  . ; If we didn't find SEG in either of the two tours or the
  1.  . ; exceptions then check to see if it crossed over into this day.
  1.  . S PREVDAY=DAYN-1
  1.  . N INC,END
  1.  . F TOURS=1,4,2 D  Q:NOTELG!(FND)
  1.  . . S TOUR=$G(^TMP($J,"PRS8",PREVDAY,TOURS))
  1.  . . Q:TOUR=""
  1.  . . S INC=$S(TOURS=2:4,1:3)
  1.  . . S END=$S(TOURS=2:25,1:19)
  1.  . . F POST=1:4:25 I $P(TOUR,"^",POST)'="" D  Q:NOTELG!(FND)
  1.  . . . ; Quit if SEG is not within the start/stop time
  1.  . . . Q:(SEG+96)<$P(TOUR,"^",POST)!((SEG+96)>$P(TOUR,"^",POST+1))
  1.  . . . S FND=1
  1.  . . . Q:TOURS=1!(TOURS=4)  ; If on a Tour it counts as Premium
  1.  . . . S RC=$P(TOUR,"^",POST+3)
  1.  . . . ; Remarks Code must be OT/CT on Premium (#9), Tour Coverage (#12),
  1.  . . . ; CB - Premium T&L (#14) or OT/CT With Premiums to qualify for premium pay.
  1.  . . . I "^9^12^14^17^"'[("^"_RC_"^") S NOTELG=1
  1.  ;
  1.  I $E(H(DAYN),SEG)=1!($E(P(DAYN),SEG)=5) Q
  1.  ; determine special code
  1.  S SHIFT=1
  1.  I TP="SUN",TYP["W" D
  1.  . ; Check to see if shift 2 or 3 is recorded for the segment worked
  1.  . I "^2^3^"[(U_$E(D(DAYN),SEG)_U) S SHIFT=$E(D(DAYN),SEG) Q
  1.  . S FND=0,SC=""
  1.  . ; Check for Holiday Worked on a Holiday
  1.  . I $E(D(DAYN),SEG)="O",$E(H(DAYN),SEG)=2 D
  1.  . . F TDAY=DAYN,DAYN-1 D  Q:FND
  1.  . . . S M1=$S(TDAY=DAYN:SEG,1:SEG+96)
  1.  . . . ; loop through both tours in day
  1.  . . . F NODE=1,4 S DAT=$G(^TMP($J,"PRS8",TDAY,NODE)) Q:DAT=""  D  Q:FND
  1.  . . . . ; loop through tour segments in tour
  1.  . . . . F TS=1:1:7 Q:$P(DAT,U,(TS-1)*3+1)=""  D  Q:FND
  1.  . . . . . ; check if time is contained in tour segment
  1.  . . . . . I M1'<$P(DAT,U,(TS-1)*3+1),M1'>$P(DAT,U,(TS-1)*3+2) D
  1.  . . . . . . S SC=$P(DAT,U,(TS-1)*3+3),SHIFT=$S(SC=6:2,SC=7:3,1:1)
  1.  . . . . . . I "^2^3^"[(U_SHIFT_U) S FND=1
  1.  ;
  1.  ;Set shift 2 for 36/40 AWS nurses with premium time outside tour
  1.  ;for this time segment  i.e. overtime(O), comp time(C) or called in from
  1.  ;on-call(c)
  1.  I +NAWS=36,"cOE"[$E(D(DAYN),SEG) S SHIFT=2
  1.  ; add to count
  1.  S CNT(DAYN,SHIFT)=$G(CNT(DAYN,SHIFT))+1
  1.  Q
  1.  ;
  1. SAVE ; Update WK array with final count for tour
  1.  ; input
  1.  ;   TP  - type of premium (SAT or SUN)
  1.  ;   CNT(day,shift)=amount
  1.  ;
  1.  N AMT,DAYN,PC,SHIFT,WEEK
  1.  S DAYN=0 F  S DAYN=$O(CNT(DAYN)) Q:DAYN=""  D
  1.  . Q:DAYN<1!(DAYN>14)
  1.  . S WEEK=$S(DAYN<8:1,1:2)
  1.  . S SHIFT="" F  S SHIFT=$O(CNT(DAYN,SHIFT)) Q:SHIFT=""  D
  1.  . . S AMT=CNT(DAYN,SHIFT)
  1.  . . S PC=$S(TP="SAT":0,1:SHIFT)+12
  1.  . . ;Shift 2 used for 36/40 nurses premium time within tour using the 2080 divisor (40*52).
  1.  . . ;Saturday Premium-AWS (SR/SS) and Sunday Premium-AWS (SD/SH)
  1.  . . ;Paid at the AAC with the 1872 divisor for the hourly rate (36*52)
  1.  . . ;for time outside the tour.
  1.  . . S:+NAWS=36 PC=$S(SHIFT=2:$S(TP="SAT":12,1:13),TP="SAT":49,1:50)
  1.  . . S $P(WK(WEEK),U,PC)=$P(WK(WEEK),U,PC)+AMT
  1.  Q
  1.  ;
  1.  ;PRS8WE