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

PRSPLVA1.m

Go to the documentation of this file.
  1. PRSPLVA1 ;WOIFO/SAB - AUTOPOST LEAVE FOR PTP (CONT) ;03/30/2005
  1. ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. PDAY ; Process Day (within Pay Period loop)
  1. ; called from PRSPLVA
  1. ; input variables LVDTE,LVDTS,LVY0,PPDN,PPI,PRSIEN,PRSFDA(),
  1. ; TCST,TCUNPOST()
  1. ; output variable
  1. ; FATAL = 1^PPI, only defined if fatal exception occurred
  1. ; PRSFDA() may be updated with additional data to post to ESR
  1. ; TCUNPOST() may be updated with another day to unpost from timecard
  1. ;
  1. N ESR,ESRRG,ESRLVM,ESRST,FOUND,OVERLAP,PPDIENS,PRSDT,PRSX
  1. N PSTDTE,PSTDTS,PSTMEAL,PSTSEG,PSTTYP,SEGI,TC,TOD,TODD,TODL,TOURLV
  1. N TSE,TSID,TSS,TSY
  1. ;
  1. ; skip day if not a scheduled tour
  1. Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
  1. ;
  1. S PPDIENS=PPDN_","_PRSIEN_","_PPI_","
  1. ;
  1. S PRSDT=$P($G(^PRST(458,PPI,1)),U,PPDN) ; FileMan date of day number
  1. ;
  1. ; load tour segments from both tours into arrays TOD() and TODD()
  1. D LOADTOD^PRSPLVU(PPI,PRSIEN,PPDN,.TOD,.TODD)
  1. ;
  1. ; load ESR segments into array ESR()
  1. D LOADESR^PRSPLVU(PPI,PRSIEN,PPDN,.ESR)
  1. ;
  1. ; load time card segments into array TC()
  1. D LOADTC^PRSPLVU(PPI,PRSIEN,PPDN,.TC)
  1. ;
  1. ; determine leave postings
  1. ; loop thru tour segments
  1. S TSID="" F S TSID=$O(TOD(TSID)) Q:TSID="" D Q:$G(FATAL)
  1. . S TSY=TOD(TSID)
  1. . S TSS=$P(TSY,U)
  1. . S TSE=$P(TSY,U,2)
  1. . ; skip if tour seg. end < OR = to leave start
  1. . Q:TSE'>LVDTS
  1. . ; skip if tour seg. start > OR = to leave end
  1. . Q:TSS'<LVDTE
  1. . ;
  1. . ; leave overlaps tour segment
  1. . ;
  1. . ; determine posting times
  1. . ; posting start is greater of leave start and tour seg. start
  1. . S PSTDTS=$S(LVDTS>TSS:LVDTS,1:TSS)
  1. . ; posting end is lesser of leave end and tour seg. end
  1. . S PSTDTE=$S(LVDTE<TSE:LVDTE,1:TSE)
  1. . ;
  1. . ; determine type of time to post
  1. . S PSTTYP=$P(LVY0,U,7)
  1. . I $P(TSY,U,3)'="RG","TR TV"'[PSTTYP S PSTTYP="UN"
  1. . ;
  1. . S PSTMEAL=0 ; init meal time
  1. . ;
  1. . ; if leave is within or equal to the tour segment then calculate
  1. . ; a meal based on the user-specified leave request hours
  1. . I LVDTS'<TSS,LVDTE'>TSE D
  1. . . N CLM,FLD,TODI,TODN
  1. . . Q:$P(TSY,U,3)'="RG"
  1. . . S CLM=($$FMDIFF^XLFDT(LVDTE,LVDTS,2))/60 ; calc lv length min
  1. . . S PSTMEAL=CLM-($P(LVY0,U,15)*60)
  1. . . I PSTMEAL<0 S PSTMEAL=0 Q ; must be positive or zero
  1. . . I PSTMEAL#15 S PSTMEAL=0 Q ; must be multiple of 15
  1. . . ; must not exceed meal time for TOD
  1. . . S TODN=$P(TSID,"-",1) ; determine tour # (1 or 2) for segment
  1. . . I PSTMEAL>$P($G(TODD(TODN)),U,3) S PSTMEAL=$P($G(TODD(TODN)),U,3)
  1. . ;
  1. . ; if meal was not set based on leave request hours then check if it
  1. . ; can be set based on tour info
  1. . I PSTMEAL=0 D
  1. . . N TODN
  1. . . S TODN=$P(TSID,"-",1) ; tour # (1 or 2)
  1. . . ; quit if tour does not have a meal
  1. . . Q:$P($G(TODD(TODN)),U,3)'>0
  1. . . ; quit if segment # currently being processed is not the longest
  1. . . ; (better to place meal in the longest segment when more than one)
  1. . . Q:$P($G(TODD(TODN)),U,4)'=$P(TSID,"-",2)
  1. . . ; quit if leave started after tour began
  1. . . Q:LVDTS>$P($G(TODD(TODN)),U,1)
  1. . . ; quit if leave ended before tour ended
  1. . . Q:LVDTE<$P($G(TODD(TODN)),U,2)
  1. . . ; since leave covers the entire tour - set meal time based on tour
  1. . . S PSTMEAL=$P($G(TODD(TODN)),U,3)
  1. . ;
  1. . ; skip if proposed posting covered by holiday excused on ESR
  1. . S FOUND=0
  1. . ; loop thru ESR segments
  1. . S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D Q:FOUND
  1. . . N ESRY
  1. . . S ESRY=ESR(SEGI)
  1. . . Q:$P(ESRY,U,3)'="HX" ; quit if not holiday ex
  1. . . I PSTDTS'<$P(ESRY,U),PSTDTE'>$P(ESRY,U,2) S FOUND=1
  1. . Q:FOUND ; skip because posting is within HX (holiday excused)
  1. . ;
  1. . ; skip if proposed posting is already on the ESR
  1. . S FOUND=0
  1. . ; loop thru ESR segments
  1. . S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D Q:FOUND
  1. . . N ESRY
  1. . . S ESRY=ESR(SEGI)
  1. . . Q:$P(ESRY,U,3)'=PSTTYP ; quit if same type
  1. . . I PSTDTS'<$P(ESRY,U),PSTDTE'>$P(ESRY,U,2) S FOUND=1
  1. . Q:FOUND ; skip because posting is already covered on ESR
  1. . ;
  1. . ; if time card status = "P" and proposed posting in not on the
  1. . ; current time card then record a fatal exception and quit
  1. . ; loop thru time card exception segments
  1. . I TCST="P" D I 'FOUND S FATAL="1^"_PPI Q
  1. . . S FOUND=0
  1. . . S SEGI="" F S SEGI=$O(TC(SEGI)) Q:SEGI="" D Q:FOUND
  1. . . . N TCY
  1. . . . S TCY=TC(SEGI)
  1. . . . Q:$P(TCY,U,3)'=PSTTYP ; quit if not same type
  1. . . . I PSTDTS'<$P(TCY,U),PSTDTE'>$P(TCY,U,2) S FOUND=1
  1. . ;
  1. . ; OK to add posting to FDA array
  1. . ;
  1. . ; review ESR and FDA to determine next open segment
  1. . S PSTSEG=0 F SEGI=1:1:7 I '$D(ESR(SEGI)) S PSTSEG=SEGI Q
  1. . ;
  1. . ; if segment not available then report exception and skip?
  1. . Q:'PSTSEG
  1. . ;
  1. . ; add posting to FDA() array and ESR() array
  1. . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+110)=$$FMETA^PRSPLVU($P(PSTDTS,".",2)) ; start time
  1. . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+111)=$$FMETA^PRSPLVU($P(PSTDTE,".",2)) ; stop time
  1. . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+112)=PSTTYP ; type time
  1. . S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+114)=PSTMEAL ; meal
  1. . S ESR(PSTSEG)=PSTDTS_U_PSTDTE_U_PSTTYP_U_PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+110)_U_PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+111)_U_PSTMEAL
  1. ;
  1. ; quit if fatal exception
  1. Q:$G(FATAL)
  1. ;
  1. ; quit if nothing will be posted to ESR day
  1. Q:'$D(PRSFDA(458.02,PPDIENS))
  1. ;
  1. ; obtain current ESR daily status
  1. S ESRST=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)
  1. ;
  1. ; determine proposed new status of ESR day
  1. ;
  1. ; determine if any ESR time segments overlap
  1. ; (some types of time are excluded from check)
  1. S OVERLAP=0
  1. S SEGI=0 F S SEGI=$O(ESR(SEGI)) Q:'SEGI D
  1. . N SEGJ,SEGX,SEGY
  1. . S SEGX=ESR(SEGI)
  1. . Q:"ON SB UN"[$P(SEGX,U,3)
  1. . S SEGJ=SEGI F S SEGJ=$O(ESR(SEGJ)) Q:'SEGJ D
  1. . . S SEGY=ESR(SEGJ)
  1. . . Q:"ON SB UN"[$P(SEGY,U,3)
  1. . . Q:$P(SEGX,U,2)'>$P(SEGY,U,1)
  1. . . Q:$P(SEGX,U,1)'<$P(SEGY,U,2)
  1. . . S OVERLAP=1
  1. ;
  1. ; determine if entire tour covered by leave
  1. S PRSX=$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,0))
  1. S TODL=$P(PRSX,U,8)+$P(PRSX,U,14) ; tour of duty length in hours
  1. ; loop thru ESR segments to add up leave
  1. S ESRLVM=0 ; leave in minutes
  1. S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D
  1. . N ESRY,SEGLVM
  1. . S ESRY=ESR(SEGI)
  1. . Q:"AL SL WP CU AA ML RL NL CB AD DL"'[$P(ESRY,U,3)
  1. . S SEGLVM=($$FMDIFF^XLFDT($P(ESRY,U,2),$P(ESRY,U,1),2)/60)-$P(ESRY,U,6)
  1. . S ESRLVM=ESRLVM+SEGLVM
  1. S TOURLV=$S((ESRLVM/60)'<TODL:1,1:0) ; true if tour covered by leave
  1. ;
  1. ; determine if any RG time on ESR
  1. S ESRRG=$S($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG":1,1:0)
  1. ;
  1. ; if not started/pending/resubmit and no RG, no overlaps, and
  1. ; tour covered by leave then auto sign based on leave. Otherwise,
  1. ; if not started then change to pending
  1. I "^1^2^3^"[(U_ESRST_U) D
  1. . N SIGNED
  1. . S SIGNED=0
  1. . I 'ESRRG,'OVERLAP,TOURLV D
  1. . . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
  1. . . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
  1. . . S PRSFDA(458.02,PPDIENS,149)="3" ; signed method = leave request
  1. . . S SIGNED=1
  1. . I 'SIGNED,ESRST=1 S PRSFDA(458.02,PPDIENS,146)="2" ; status = pending
  1. ;
  1. ; if signed or approved and no overlap then re-sign. Otherwise
  1. ; change to pending.
  1. I "^4^5^"[(U_ESRST_U) D
  1. . ;
  1. . I 'OVERLAP D
  1. . . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
  1. . . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
  1. . . ; if tour covered by leave and method is extended absence then
  1. . . ; change signed method to leave
  1. . . I TOURLV,$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)=2 S PRSFDA(458.02,PPDIENS,149)="3"
  1. . ;
  1. . I OVERLAP D
  1. . . S PRSFDA(458.02,PPDIENS,146)="2" ; status = pending
  1. . . S PRSFDA(458.02,PPDIENS,147)="@" ; delete signed d/t
  1. . . S PRSFDA(458.02,PPDIENS,149)="@" ; delete signed method
  1. . ;
  1. . ; if day was approved and time card status = T then add to unpost list
  1. . I ESRST=5,TCST="T" S TCUNPOST(PPI,PPDN)=""
  1. ;
  1. Q
  1. ;
  1. ;PRSPLVA1