PRSPLVA2 ;WOIFO/SAB - AUTOPOST LEAVE FOR PTP (CONT) ;3/30/2005
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
PDAY ; Process Day (within Pay Period loop of Unpost feature)
; called from PRSPLVA
; input variables LVDTE,LVDTS,LVY0,PPDN,PPI,PRSIEN,PRSFDA(),
; output variable
; PRSFDA() may be updated with additional data to post to ESR
;
N ESR,ESRHX,ESRRG,ESRLVM,ESRST,FOUND,OVERLAP,PPDIENS,PRSDT,PRSX
N PSTDTE,PSTDTS,PSTMEAL,PSTSEG,PSTTYP,SEGI,TOD,TODD,TODL,TOURLV
N TSE,TSID,TSS,TSY
;
; skip day if not a scheduled tour
Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
;
S PPDIENS=PPDN_","_PRSIEN_","_PPI_","
;
S PRSDT=$P($G(^PRST(458,PPI,1)),U,PPDN) ; FileMan date of day number
;
; load tour segments from both tours into arrays TOD() and TODD()
D LOADTOD^PRSPLVU(PPI,PRSIEN,PPDN,.TOD,.TODD)
;
; load ESR segments into array ESR()
D LOADESR^PRSPLVU(PPI,PRSIEN,PPDN,.ESR)
;
; determine leave postings
; loop thru tour segments
S TSID="" F S TSID=$O(TOD(TSID)) Q:TSID="" D
. S TSY=TOD(TSID)
. S TSS=$P(TSY,U)
. S TSE=$P(TSY,U,2)
. ; skip if tour seg. end < leave start
. Q:TSE<LVDTS
. ; skip if tour seg. start > leave end
. Q:TSS>LVDTE
. ;
. ; leave overlaps tour segment
. ;
. ; determine posting times
. ; posting start is greater of leave start and tour seg. start
. S PSTDTS=$S(LVDTS>TSS:LVDTS,1:TSS)
. ; posting end is lesser of leave end and tour seg. end
. S PSTDTE=$S(LVDTE<TSE:LVDTE,1:TSE)
. ;
. ; determine type of time to post
. S PSTTYP=$P(LVY0,U,7)
. I $P(TSY,U,3)'="RG","TR TV"'[PSTTYP S PSTTYP="UN"
. ;
. S PSTMEAL=0 ; init
. ;
. ; if leave is within or equal to the tour segment then calculate
. ; a meal based on the leave request hours
. I LVDTS'<TSS,LVDTE'>TSE D
. . N CLM,FLD,TODI,TODN
. . Q:$P(TSY,U,3)'="RG"
. . S CLM=($$FMDIFF^XLFDT(LVDTE,LVDTS,2))/60 ; calc lv length min
. . S PSTMEAL=CLM-($P(LVY0,U,15)*60)
. . I PSTMEAL<0 S PSTMEAL=0 Q ; must be positive or zero
. . I PSTMEAL#15 S PSTMEAL=0 Q ; must be multiple of 15
. . ; must not exceed meal time for TOD
. . S TODN=$P(TSID,"-",1) ; determine tour # (1 or 2) for segment
. . I PSTMEAL>$P($G(TODD(TODN)),U,3) S PSTMEAL=$P($G(TODD(TODN)),U,3)
. ;
. ; if meal was not set based on leave request hours then check if it
. ; can be set based on tour info
. I PSTMEAL=0 D
. . N TODN
. . S TODN=$P(TSID,"-",1) ; tour # (1 or 2)
. . ; quit if tour does not have a meal
. . Q:$P($G(TODD(TODN)),U,3)'>0
. . ; quit if segment # currently being processed is not the longest
. . ; (better to place meal in the longest segment when more than one)
. . Q:$P($G(TODD(TODN)),U,4)'=$P(TSID,"-",2)
. . ; quit if leave started after tour began
. . Q:LVDTS>$P($G(TODD(TODN)),U,1)
. . ; quit if leave ended before tour ended
. . Q:LVDTE<$P($G(TODD(TODN)),U,2)
. . ; since leave covers the entire tour - set meal time based on tour
. . S PSTMEAL=$P($G(TODD(TODN)),U,3)
. ;
. ; find current leave posting on the ESR
. S FOUND=0
. ; loop thru ESR segments
. S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D Q:FOUND
. . N ESRY
. . S ESRY=ESR(SEGI)
. . Q:$P(ESRY,U,3)'=PSTTYP ; quit if not same type
. . I PSTDTS=$P(ESRY,U),PSTDTE=$P(ESRY,U,2) S FOUND=1
. Q:'FOUND ; skip because posting is not on the ESR
. S PSTSEG=SEGI
. ;
. ; OK to add unposting to FDA array
. ;
. ; add unposting to FDA() array and ESR() array
. S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+110)="@" ; start time
. S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+111)="@" ; stop time
. S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+112)="@" ; type time
. S PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+114)="@" ; meal
. K ESR(PSTSEG)
;
; quit if nothing will be unposted from the ESR day
Q:'$D(PRSFDA(458.02,PPDIENS))
;
; obtain current ESR daily status
S ESRST=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)
;
; determine proposed new status of ESR day
;
; determine if any ESR time segments overlap
; (some types of time are excluded from check)
S OVERLAP=0
S SEGI=0 F S SEGI=$O(ESR(SEGI)) Q:'SEGI D
. N SEGJ,SEGX,SEGY
. S SEGX=ESR(SEGI)
. Q:"ON SB UN"[$P(SEGX,U,3)
. S SEGJ=SEGI F S SEGJ=$O(ESR(SEGJ)) Q:'SEGJ D
. . S SEGY=ESR(SEGJ)
. . Q:"ON SB UN"[$P(SEGY,U,3)
. . Q:$P(SEGX,U,2)'>$P(SEGY,U,1)
. . Q:$P(SEGX,U,1)'<$P(SEGY,U,2)
. . S OVERLAP=1
;
; determine if entire tour covered by leave
S PRSX=$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,0))
S TODL=$P(PRSX,U,8)+$P(PRSX,U,14) ; tour of duty length in hours
; loop thru ESR segments to add up leave
S ESRLVM=0 ; leave in minutes
S SEGI="" F S SEGI=$O(ESR(SEGI)) Q:SEGI="" D
. N ESRY,SEGLVM
. S ESRY=ESR(SEGI)
. Q:"AL SL WP CU AA ML RL NL CB AD DL"'[$P(ESRY,U,3)
. S SEGLVM=($$FMDIFF^XLFDT($P(ESRY,U,2),$P(ESRY,U,1),2)/60)-$P(ESRY,U,6)
. S ESRLVM=ESRLVM+SEGLVM
S TOURLV=$S((ESRLVM/60)'<TODL:1,1:0) ; true if tour covered by leave
;
; determine if any RG time on ESR
S ESRRG=$S($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG":1,1:0)
;
; determine if any HX time on ESR
S ESRHX=$S($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["HX":1,1:0)
;
; determine appropriate status for day
D
. ; if current status = signed and current method = manual then re-sign
. ; by manual and quit block
. I ESRST=4,$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)=1 D Q
. . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
. . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
. . S PRSFDA(458.02,PPDIENS,149)="1" ; signed method = manual
. ;
. ; if day covered by holiday, no RG, no overlap then re-sign by holiday
. ; and quit block
. I ESRHX,'ESRRG,'OVERLAP D Q
. . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
. . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
. . S PRSFDA(458.02,PPDIENS,149)="4" ; signed method = holiday
. ;
. ; if tour covered by leave, no RG, no overlap, then re-sign by leave
. ; and quit block
. I TOURLV,'ESRRG,'OVERLAP D Q
. . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
. . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
. . S PRSFDA(458.02,PPDIENS,149)="3" ; signed method = leave
. ;
. ; if day covered by extended absence, no RG, no overlap, then re-sign
. ; by EA and quit block
. I $$CONFLICT^PRSPEAU(PRSIEN,PRSDT),'ESRRG,'OVERLAP D Q
. . S PRSFDA(458.02,PPDIENS,146)="4" ; status = signed
. . S PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT() ; signed d/t
. . S PRSFDA(458.02,PPDIENS,149)="2" ; signed method = EA
. ;
. ; day will not be signed
. ;
. ; if day previously signed then clear out signed fields
. I ESRST="4" D
. . S PRSFDA(458.02,PPDIENS,147)="@" ; delete signed d/t
. . S PRSFDA(458.02,PPDIENS,149)="@" ; delete signed method
. ;
. ; set status = resubmit (if that was current) or pending (if segment)
. ; or not started
. S PRSFDA(458.02,PPDIENS,146)=$S(ESRST="3":"3",$O(ESR(0)):"2",1:"1")
Q
;
;PRSPLVA2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPLVA2 7069 printed Apr 09, 2024@21:29:18 Page 2
PRSPLVA2 ;WOIFO/SAB - AUTOPOST LEAVE FOR PTP (CONT) ;3/30/2005
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
PDAY ; Process Day (within Pay Period loop of Unpost feature)
+1 ; called from PRSPLVA
+2 ; input variables LVDTE,LVDTS,LVY0,PPDN,PPI,PRSIEN,PRSFDA(),
+3 ; output variable
+4 ; PRSFDA() may be updated with additional data to post to ESR
+5 ;
+6 NEW ESR,ESRHX,ESRRG,ESRLVM,ESRST,FOUND,OVERLAP,PPDIENS,PRSDT,PRSX
+7 NEW PSTDTE,PSTDTS,PSTMEAL,PSTSEG,PSTTYP,SEGI,TOD,TODD,TODL,TOURLV
+8 NEW TSE,TSID,TSS,TSY
+9 ;
+10 ; skip day if not a scheduled tour
+11 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
QUIT
+12 ;
+13 SET PPDIENS=PPDN_","_PRSIEN_","_PPI_","
+14 ;
+15 ; FileMan date of day number
SET PRSDT=$PIECE($GET(^PRST(458,PPI,1)),U,PPDN)
+16 ;
+17 ; load tour segments from both tours into arrays TOD() and TODD()
+18 DO LOADTOD^PRSPLVU(PPI,PRSIEN,PPDN,.TOD,.TODD)
+19 ;
+20 ; load ESR segments into array ESR()
+21 DO LOADESR^PRSPLVU(PPI,PRSIEN,PPDN,.ESR)
+22 ;
+23 ; determine leave postings
+24 ; loop thru tour segments
+25 SET TSID=""
FOR
SET TSID=$ORDER(TOD(TSID))
if TSID=""
QUIT
Begin DoDot:1
+26 SET TSY=TOD(TSID)
+27 SET TSS=$PIECE(TSY,U)
+28 SET TSE=$PIECE(TSY,U,2)
+29 ; skip if tour seg. end < leave start
+30 if TSE<LVDTS
QUIT
+31 ; skip if tour seg. start > leave end
+32 if TSS>LVDTE
QUIT
+33 ;
+34 ; leave overlaps tour segment
+35 ;
+36 ; determine posting times
+37 ; posting start is greater of leave start and tour seg. start
+38 SET PSTDTS=$SELECT(LVDTS>TSS:LVDTS,1:TSS)
+39 ; posting end is lesser of leave end and tour seg. end
+40 SET PSTDTE=$SELECT(LVDTE<TSE:LVDTE,1:TSE)
+41 ;
+42 ; determine type of time to post
+43 SET PSTTYP=$PIECE(LVY0,U,7)
+44 IF $PIECE(TSY,U,3)'="RG"
IF "TR TV"'[PSTTYP
SET PSTTYP="UN"
+45 ;
+46 ; init
SET PSTMEAL=0
+47 ;
+48 ; if leave is within or equal to the tour segment then calculate
+49 ; a meal based on the leave request hours
+50 IF LVDTS'<TSS
IF LVDTE'>TSE
Begin DoDot:2
+51 NEW CLM,FLD,TODI,TODN
+52 if $PIECE(TSY,U,3)'="RG"
QUIT
+53 ; calc lv length min
SET CLM=($$FMDIFF^XLFDT(LVDTE,LVDTS,2))/60
+54 SET PSTMEAL=CLM-($PIECE(LVY0,U,15)*60)
+55 ; must be positive or zero
IF PSTMEAL<0
SET PSTMEAL=0
QUIT
+56 ; must be multiple of 15
IF PSTMEAL#15
SET PSTMEAL=0
QUIT
+57 ; must not exceed meal time for TOD
+58 ; determine tour # (1 or 2) for segment
SET TODN=$PIECE(TSID,"-",1)
+59 IF PSTMEAL>$PIECE($GET(TODD(TODN)),U,3)
SET PSTMEAL=$PIECE($GET(TODD(TODN)),U,3)
End DoDot:2
+60 ;
+61 ; if meal was not set based on leave request hours then check if it
+62 ; can be set based on tour info
+63 IF PSTMEAL=0
Begin DoDot:2
+64 NEW TODN
+65 ; tour # (1 or 2)
SET TODN=$PIECE(TSID,"-",1)
+66 ; quit if tour does not have a meal
+67 if $PIECE($GET(TODD(TODN)),U,3)'>0
QUIT
+68 ; quit if segment # currently being processed is not the longest
+69 ; (better to place meal in the longest segment when more than one)
+70 if $PIECE($GET(TODD(TODN)),U,4)'=$PIECE(TSID,"-",2)
QUIT
+71 ; quit if leave started after tour began
+72 if LVDTS>$PIECE($GET(TODD(TODN)),U,1)
QUIT
+73 ; quit if leave ended before tour ended
+74 if LVDTE<$PIECE($GET(TODD(TODN)),U,2)
QUIT
+75 ; since leave covers the entire tour - set meal time based on tour
+76 SET PSTMEAL=$PIECE($GET(TODD(TODN)),U,3)
End DoDot:2
+77 ;
+78 ; find current leave posting on the ESR
+79 SET FOUND=0
+80 ; loop thru ESR segments
+81 SET SEGI=""
FOR
SET SEGI=$ORDER(ESR(SEGI))
if SEGI=""
QUIT
Begin DoDot:2
+82 NEW ESRY
+83 SET ESRY=ESR(SEGI)
+84 ; quit if not same type
if $PIECE(ESRY,U,3)'=PSTTYP
QUIT
+85 IF PSTDTS=$PIECE(ESRY,U)
IF PSTDTE=$PIECE(ESRY,U,2)
SET FOUND=1
End DoDot:2
if FOUND
QUIT
+86 ; skip because posting is not on the ESR
if 'FOUND
QUIT
+87 SET PSTSEG=SEGI
+88 ;
+89 ; OK to add unposting to FDA array
+90 ;
+91 ; add unposting to FDA() array and ESR() array
+92 ; start time
SET PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+110)="@"
+93 ; stop time
SET PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+111)="@"
+94 ; type time
SET PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+112)="@"
+95 ; meal
SET PRSFDA(458.02,PPDIENS,(PSTSEG-1)*5+114)="@"
+96 KILL ESR(PSTSEG)
End DoDot:1
+97 ;
+98 ; quit if nothing will be unposted from the ESR day
+99 if '$DATA(PRSFDA(458.02,PPDIENS))
QUIT
+100 ;
+101 ; obtain current ESR daily status
+102 SET ESRST=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)
+103 ;
+104 ; determine proposed new status of ESR day
+105 ;
+106 ; determine if any ESR time segments overlap
+107 ; (some types of time are excluded from check)
+108 SET OVERLAP=0
+109 SET SEGI=0
FOR
SET SEGI=$ORDER(ESR(SEGI))
if 'SEGI
QUIT
Begin DoDot:1
+110 NEW SEGJ,SEGX,SEGY
+111 SET SEGX=ESR(SEGI)
+112 if "ON SB UN"[$PIECE(SEGX,U,3)
QUIT
+113 SET SEGJ=SEGI
FOR
SET SEGJ=$ORDER(ESR(SEGJ))
if 'SEGJ
QUIT
Begin DoDot:2
+114 SET SEGY=ESR(SEGJ)
+115 if "ON SB UN"[$PIECE(SEGY,U,3)
QUIT
+116 if $PIECE(SEGX,U,2)'>$PIECE(SEGY,U,1)
QUIT
+117 if $PIECE(SEGX,U,1)'<$PIECE(SEGY,U,2)
QUIT
+118 SET OVERLAP=1
End DoDot:2
End DoDot:1
+119 ;
+120 ; determine if entire tour covered by leave
+121 SET PRSX=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,0))
+122 ; tour of duty length in hours
SET TODL=$PIECE(PRSX,U,8)+$PIECE(PRSX,U,14)
+123 ; loop thru ESR segments to add up leave
+124 ; leave in minutes
SET ESRLVM=0
+125 SET SEGI=""
FOR
SET SEGI=$ORDER(ESR(SEGI))
if SEGI=""
QUIT
Begin DoDot:1
+126 NEW ESRY,SEGLVM
+127 SET ESRY=ESR(SEGI)
+128 if "AL SL WP CU AA ML RL NL CB AD DL"'[$PIECE(ESRY,U,3)
QUIT
+129 SET SEGLVM=($$FMDIFF^XLFDT($PIECE(ESRY,U,2),$PIECE(ESRY,U,1),2)/60)-$PIECE(ESRY,U,6)
+130 SET ESRLVM=ESRLVM+SEGLVM
End DoDot:1
+131 ; true if tour covered by leave
SET TOURLV=$SELECT((ESRLVM/60)'<TODL:1,1:0)
+132 ;
+133 ; determine if any RG time on ESR
+134 SET ESRRG=$SELECT($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG":1,1:0)
+135 ;
+136 ; determine if any HX time on ESR
+137 SET ESRHX=$SELECT($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["HX":1,1:0)
+138 ;
+139 ; determine appropriate status for day
+140 Begin DoDot:1
+141 ; if current status = signed and current method = manual then re-sign
+142 ; by manual and quit block
+143 IF ESRST=4
IF $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)=1
Begin DoDot:2
+144 ; status = signed
SET PRSFDA(458.02,PPDIENS,146)="4"
+145 ; signed d/t
SET PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT()
+146 ; signed method = manual
SET PRSFDA(458.02,PPDIENS,149)="1"
End DoDot:2
QUIT
+147 ;
+148 ; if day covered by holiday, no RG, no overlap then re-sign by holiday
+149 ; and quit block
+150 IF ESRHX
IF 'ESRRG
IF 'OVERLAP
Begin DoDot:2
+151 ; status = signed
SET PRSFDA(458.02,PPDIENS,146)="4"
+152 ; signed d/t
SET PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT()
+153 ; signed method = holiday
SET PRSFDA(458.02,PPDIENS,149)="4"
End DoDot:2
QUIT
+154 ;
+155 ; if tour covered by leave, no RG, no overlap, then re-sign by leave
+156 ; and quit block
+157 IF TOURLV
IF 'ESRRG
IF 'OVERLAP
Begin DoDot:2
+158 ; status = signed
SET PRSFDA(458.02,PPDIENS,146)="4"
+159 ; signed d/t
SET PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT()
+160 ; signed method = leave
SET PRSFDA(458.02,PPDIENS,149)="3"
End DoDot:2
QUIT
+161 ;
+162 ; if day covered by extended absence, no RG, no overlap, then re-sign
+163 ; by EA and quit block
+164 IF $$CONFLICT^PRSPEAU(PRSIEN,PRSDT)
IF 'ESRRG
IF 'OVERLAP
Begin DoDot:2
+165 ; status = signed
SET PRSFDA(458.02,PPDIENS,146)="4"
+166 ; signed d/t
SET PRSFDA(458.02,PPDIENS,147)=$$NOW^XLFDT()
+167 ; signed method = EA
SET PRSFDA(458.02,PPDIENS,149)="2"
End DoDot:2
QUIT
+168 ;
+169 ; day will not be signed
+170 ;
+171 ; if day previously signed then clear out signed fields
+172 IF ESRST="4"
Begin DoDot:2
+173 ; delete signed d/t
SET PRSFDA(458.02,PPDIENS,147)="@"
+174 ; delete signed method
SET PRSFDA(458.02,PPDIENS,149)="@"
End DoDot:2
+175 ;
+176 ; set status = resubmit (if that was current) or pending (if segment)
+177 ; or not started
+178 SET PRSFDA(458.02,PPDIENS,146)=$SELECT(ESRST="3":"3",$ORDER(ESR(0)):"2",1:"1")
End DoDot:1
+179 QUIT
+180 ;
+181 ;PRSPLVA2
