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

PRSARC07.m

Go to the documentation of this file.
  1. PRSARC07 ;WOIFO/JAH - Tour Hours Procedure ;01/07/08
  1. ;;4.0;PAID;**112,116**;Sep 21, 1995;Build 23
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. TOURHRS(THRARY,PPI,PRSIEN,TOURSTR) ; Return data for TOUR OF DUTY
  1. ;Input:
  1. ; PPI (optional) IEN of #458 otherwise curr PPI assumed.
  1. ; *If PPI and TOURSTR (or only PPI) defined then last pay period
  1. ; spill over from 2nd sat. is added to day 1.
  1. ; *If TOURSTR is defined but not PPI then tour hours
  1. ; from 2nd saturday of tour in TOURSTR are placed on 1st Sunday.
  1. ;
  1. ; PRSIEN (required) IEN-File (#450).
  1. ; TOURSTR (optional) if defined should contain 14 piece string
  1. ; delimited by "^" pieces 1-14 contain pointers
  1. ; to ToD file. Will be used instead of pp to determine
  1. ; tour hrs.
  1. ; Output
  1. ; THRARY (TOUR HRS ARRAY)-2 piece array subsc by day #.
  1. ; W1 & W2 node w/ wkly tour hrs.
  1. ; Piece one = Shift code:
  1. ; -Null when no tour hrs fall on that day.
  1. ; -Always 0 for Wage Grades
  1. ; -1, 2, or 3 corresponds to earliest shift on day being reported.
  1. ; Piece two = total hrs for tours that fall on each day.
  1. ; Tours crossing midnight--hrs placed in node on day the occur
  1. ; SPECIAL CASE: COMPRESSED TOURS: "CT" node is defined
  1. ; Piece one set to shift (earliest for pp or 0 for wage)
  1. ; Piece 2 = total pp hrs
  1. ;
  1. ; Error Codes = ARRAY VARIABLE contains a 1 for success or 0 for
  1. ; failure. If failed then error codes returned in Array 0 node
  1. ; 1 = pp undef
  1. ; 2 = emp undef
  1. ; 3 = no timecard for emp in pp
  1. ; Example
  1. ; >D TOURHRS^PRSARC04(.THRS,257,12711)
  1. ; >ZW THRS
  1. ; THRS=1
  1. ; THRS(1)=^0
  1. ; THRS(2)=1^3
  1. ; THRS(3)=1^6
  1. ; ...
  1. ; THRS(14)=^0
  1. N SHIFTCD,ISWAGE,ZNODE,PRSD,SAT,LASTPPI
  1. K THRARY
  1. I '$D(^PRSPC(+$G(PRSIEN),0)) S THRARY=0,THRARY(0)="2^undefined employee"
  1. I $G(TOURSTR)="" D
  1. . I $G(PPI)'>0 S PPI=$P(^PRST(458,0),"^",3)
  1. . I '$D(^PRST(458,+$G(PPI),0)) S THRARY=0,THRARY(0)="1^undefined pay period"
  1. . S LASTPPI=PPI-1
  1. . S ISWAGE=$$ISWAGE^PRSARC08(PRSIEN)
  1. . ;
  1. . ; Get ToD and Second ToD from last saturday of
  1. . ; prior PP to check for spill over hrs onto day 1 of this PP.
  1. . S SAT=$G(^PRST(458,LASTPPI,"E",PRSIEN,"D",14,0))
  1. . S PRSD=0,T1=$P(SAT,U,2),T2=$P(SAT,U,13)
  1. . D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,LASTPPI)
  1. . F PRSD=1:1:14 D
  1. .. S ZNODE=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0))
  1. .. S T1=$P(ZNODE,U,2),T2=$P(ZNODE,U,13)
  1. .. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
  1. .. D PLACESHF(.THRARY,PRSD,T1,T2,ISWAGE)
  1. .;
  1. .; add compressed tour node if necessary
  1. .I $$ISCMPTR^PRSARC08(PPI,PRSIEN) S THRARY("CT")=$$EARLYSH^PRSARC08(.THRARY,ISWAGE)_"^"_$$TOTAL^PRSARC08(.THRARY)
  1. E D
  1. .; use tourstring for tours
  1. .; add prior tour spillover from 2nd Sat to first Sun
  1. . I $G(PPI)>0 D
  1. .. S SAT=$G(^PRST(458,PPI-1,"E",PRSIEN,"D",14,0))
  1. .. S PRSD=0,T1=$P(SAT,U,2),T2=$P(SAT,U,13)
  1. .. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
  1. . F PRSD=1:1:14 D
  1. .. S T1=$P(TOURSTR,U,PRSD),T2=""
  1. .. D PLACEHRS(.THRARY,PRSIEN,PRSD,T1,T2,PPI)
  1. . ; wrap second saturday to first sunday (IF PPI NOT PASSED)
  1. . I $G(PPI)="" S $P(THRARY(1),U,2)=$P(THRARY(1),U,2)+$P($G(THRARY(15)),U,2)
  1. ; Prior Sat THRARY(0) only needed temp to get any part of a two day
  1. ; tour that spilled onto THRARY(1)-1st Sun. Next Sun THRARY(15) is
  1. ; only an artifact.
  1. S THRARY("W1")=$$TOTAL^PRSARC08(.THRARY,1)
  1. S THRARY("W2")=$$TOTAL^PRSARC08(.THRARY,2)
  1. K THRARY(0),THRARY(15)
  1. Q
  1. ;
  1. PLACEHRS(PRSTH,PRSIEN,PRSD,T1,T2,PPI) ; procedure puts hrs from tours on current
  1. ; day and next. called once for each day so a call for curr day
  1. ; may have hrs from prior two day tour
  1. ;
  1. N CURHRS,CURSHFT,TODAYND,TOMORND,TODHRS,TOMHRS,TOURHRS
  1. S TODAYND=$G(PRSTH(PRSD))
  1. S TOMORND=$G(PRSTH(PRSD+1))
  1. S TODHRS=$P(TODAYND,U,2)
  1. S TOMHRS=$P(TOMORND,U,2)
  1. ;
  1. ; get tour 1 hrs-add to today, tomorrow
  1. I T1>0 D
  1. . S TOURHRS=$$TRHRS(1,PRSD,PRSIEN,T1,PPI)
  1. . S TODHRS=TODHRS+$P(TOURHRS,U)
  1. . S TOMHRS=TOMHRS+$P(TOURHRS,U,2)
  1. ;
  1. ; get tour 2 hrs-add to today, tomorrow
  1. I T2>0 D
  1. . S TOURHRS=$$TRHRS(2,PRSD,PRSIEN,T2,PPI)
  1. . S TODHRS=TODHRS+$P(TOURHRS,U)
  1. . S TOMHRS=TOMHRS+$P(TOURHRS,U,2)
  1. ;
  1. ; add tour hrs to array
  1. S $P(PRSTH(PRSD),U,2)=TODHRS
  1. ;
  1. ; add hrs to day node of array
  1. ; (2 day tour hrs past midnight on last Sat. go in node 15)
  1. ;
  1. S $P(PRSTH(PRSD+1),U,2)=TOMHRS
  1. Q
  1. TRHRS(TNUM,PRSD,PRSIEN,TOURIEN,PPI) ; return string w/ todays hrs p1 ^ tomorrows hrs p2
  1. ;
  1. N TODHR,TOMHR,TOUR,TSEGS,TWODAYTR,REGHRS,DONE,CROSS,BEG,END,MEALTIME
  1. N BEG24,END24,SEGTIME,SEGTOD,SEGTOM,I,SPECIND
  1. ;
  1. S TODHR=0,TOMHR=0
  1. I $G(TOURIEN)'>0 Q TODHR_"^"_TOMHR
  1. S TOUR=$G(^PRST(457.1,TOURIEN,0))
  1. I TNUM=1 S TSEGS=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,1))
  1. I TNUM=2 S TSEGS=$G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,4))
  1. I TSEGS="" S TSEGS=$G(^PRST(457.1,TOURIEN,1))
  1. S TWODAYTR=$P(TOUR,U,5)="Y"
  1. S MEALTIME=$P(TOUR,U,3)
  1. I TNUM=1 S REGHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,8)
  1. I TNUM=2 S REGHRS=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PRSD,0)),U,14)
  1. I REGHRS'>0 S REGHRS=$P(TOUR,U,6)
  1. I TWODAYTR D
  1. . S (DONE,CROSS)=0
  1. . F I=1:3:19 D Q:DONE
  1. .. S BEG=$P(TSEGS,U,I)
  1. .. I BEG="" S DONE=1 Q
  1. .. S END=$P(TSEGS,U,I+1)
  1. .. S SPECIND=$P(TSEGS,U,I+2)
  1. ..; only count regular hours
  1. .. I SPECIND,"RG"'[$P($G(^PRST(457.2,+SPECIND,0)),"^",2) Q
  1. ..; convert beg & end to 24 hr to check if one < other (Xes midnight)
  1. ..; also crossed midnight if not first seg starts at midnight.
  1. ..; CROSS is true so remaining segments recorded to tomorrow.
  1. .. S BEG24=$$TWENTY4^PRSPESR2(BEG)
  1. .. S END24=$$TWENTY4^PRSPESR2(END)
  1. .. I 'CROSS&(((BEG24'<END24)&(BEG24'=2400))!((I>1)&(BEG24=2400))) D
  1. ... S CROSS=1
  1. ... S SEGTOD=$S(BEG24=2400:0,1:$$AMT^PRSPSAPU(BEG,"MID",0))
  1. ... S SEGTOM=$$AMT^PRSPSAPU("MID",END,0)
  1. ... S TODHR=TODHR+SEGTOD
  1. ... S TOMHR=TOMHR+SEGTOM
  1. .. E D
  1. ... S SEGTIME=$$AMT^PRSPSAPU(BEG,END,0)
  1. ... I CROSS D
  1. .... S TOMHR=TOMHR+SEGTIME
  1. ... E D
  1. .... S TODHR=TODHR+SEGTIME
  1. . ;Pull meal off hrs for today, tomorrow or both.
  1. . N HOURS S HOURS=$$PLACEML^PRSARC08(TODHR,TOMHR,MEALTIME)
  1. . S TODHR=$P(HOURS,U)
  1. . S TOMHR=$P(HOURS,U,2)
  1. E D
  1. . S TODHR=REGHRS
  1. Q TODHR_"^"_TOMHR
  1. ;
  1. PLACESHF(PRSTH,PRSD,T1,T2,WAGER) ;Place earliest shift from
  1. ; tour 1 and tour 2 in SDA Tour array (PRSTH)
  1. ;INPUT:
  1. ; PRSTH - array to store SDA tour info p1=shift, p2=tour hrs.
  1. ; PRSD - day number in pp 1-14
  1. ; T1, T2 - tour 1 and 2 (ien in ToD file)
  1. ; WAGER - 0 or 1 for whether this is a wage grade employee.
  1. ;OUTPUT:
  1. ; PRSTH by reference. Update "^" piece 1 with shift indicator
  1. ;
  1. N SHIFT,T1SHFTS,T2SHFTS,SHIFTINI,EARLIEST,SHIFT2
  1. ;
  1. ; Wage grade always have a 0 for shift
  1. I WAGER D
  1. . S $P(PRSTH(PRSD),U)=0
  1. E D
  1. . S T1SHFTS=$$TRSHFTS^PRSARC08(T1) ; get tour 1 shift for today and tomorrow
  1. . S T2SHFTS=$$TRSHFTS^PRSARC08(T2) ; and tour 2
  1. .; Get any shift placed by a two day tour from yesterday.
  1. .; Then find earliest shift from t1, t2 and two day carryover
  1. . S SHIFTINI=$P($G(PRSTH(PRSD)),U) I SHIFTINI="" S SHIFTINI=4
  1. . S SHIFT=$P(T1SHFTS,U) I SHIFT="" S SHIFT=4
  1. . S SHIFT2=$P(T2SHFTS,U) I SHIFT2="" S SHIFT2=4
  1. . S EARLIEST=SHIFTINI
  1. . I SHIFT<SHIFTINI S EARLIEST=SHIFT
  1. . I SHIFT2<EARLIEST S EARLIEST=SHIFT2
  1. . I EARLIEST=4 S EARLIEST=""
  1. . S $P(PRSTH(PRSD),U)=EARLIEST
  1. . ;
  1. . ; Now do anything for tomorrow
  1. . S SHIFTINI=$P($G(PRSTH(PRSD+1)),U,1) I SHIFTINI="" S SHIFTINI=4
  1. . S SHIFT=$P(T1SHFTS,U,2) I SHIFT="" S SHIFT=4
  1. . S SHIFT2=$P(T2SHFTS,U,2) I SHIFT2="" S SHIFT2=4
  1. . S EARLIEST=SHIFTINI
  1. . I SHIFT<SHIFTINI S EARLIEST=SHIFT
  1. . I SHIFT2<EARLIEST S EARLIEST=SHIFT2
  1. . I EARLIEST=4 S EARLIEST=""
  1. . S $P(PRSTH(PRSD+1),U)=EARLIEST
  1. Q
  1. ;