PRSPLVA ;WOIFO/SAB - AUTOPOST LEAVE FOR PART-TIME PHY. WITH MEMO ;4/6/2005
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
PLPP(PRSIEN,PPI,DAYN) ; Post Leave for a Pay Period (or day)
; Called by the open next PP option to post leave to one new pay period
; for one part-time physician.
; Called by the enter/edit tour option to re-post leave to one
; pay period when a tour is changed.
; Input
; PRSIEN - Employee IEN (file 450), should be PTP with active memo
; PPI - Pay Period IEN (file 458)
; DAYN - (optional) day # within pay period to only post that day
;
N LVIEN,LVY0,PPD1,PPD15,PRSX,RPPD1,RTDT,Y
S DAYN=$G(DAYN)
;
; Determine pay period dates
S Y=$G(^PRST(458,PPI,1))
S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day # instead of 1st PP day
S PPD1=$P(Y,U,PRSX) ; 1st day of PP
S RPPD1=9999999-PPD1 ; reverse 1st day of PP
S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day # instead of last PP day
S PPD15=$$FMADD^XLFDT($P(Y,U,PRSX),1) ; Last day of PP+1
; (use day 15 to include leave that starts on 2nd day of 2-day tour and
; would be posted on the prior day)
K PRSX
Q:PPD1=""
;
; loop thru leave requests for employee by reverse to date until
; to date is before the pay period or no more to dates
S RTDT=""
F S RTDT=$O(^PRST(458.1,"AD",PRSIEN,RTDT)) Q:'RTDT!(RTDT>RPPD1) D
. ; loop thru requests
. S LVIEN=0
. S LVIEN=$O(^PRST(458.1,"AD",PRSIEN,RTDT,LVIEN)) Q:'LVIEN D
. . S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
. . Q:$P(LVY0,U,3)>PPD15 ; skip if from date after pay period+1
. . Q:$P(LVY0,U,9)'="A" ; skip if status not approved
. . ;
. . ; approved request may overlap PP so post the leave request
. . D PLR(LVIEN,PPI,DAYN)
Q
;
PLR(LVIEN,SPPI,DAYN,PRSEX) ; Post Leave Request
; Called during open next pay period process (by PLPP above) to post
; one leave request to a single pay period.
; Called during Supervisory Approvals process to post one leave request
; to all opened pay periods.
; Input
; LVIEN - Leave Request IEN (file 458.1)
; SPPI - Pay Period IEN (file 458) or Null Value if for all.
; DAYN - (optional) day # within SPPI or null value
; PRSEX - Passed by reference, will be initialized (killed)
; Output
; PRSEX - passed by reference, only defined if the leave was not
; posted to the ESR and should not be approved because the
; leave is not currently on the time card and it has a status
; of Payroll. This exception should only be applicable when
; auto post is called by the supervisory approval of leave.
;
;
; Note: All applicable time cards are assumed to be locked prior to
; calling this API.
;
Q:'$G(LVIEN) ; required input
S SPPI=$G(SPPI)
;
N D1,DAY,EDN,EPP4Y,FATAL,LVDTE,LVDTS,LVY0,PP4Y,PPDN,PPDNB
N PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,PRSX,SDN,SPP4Y,TCST,TCUNPOST,Y
;
K PRSEX
;
S DAYN=$G(DAYN)
S LVY0=$G(^PRST(458.1,LVIEN,0)) ; leave request 0 node
S PRSIEN=$P(LVY0,U,2) ; employee IEN
D
. N CNX,PRSM,X,Y
. S X=$P(LVY0,U,4)_U_$P(LVY0,U,6)
. D CNV^PRSATIM
. S PRSM=Y
. S LVDTS=$$FMADD^XLFDT($P(LVY0,U,3),,,$P(PRSM,U,1)) ; leave d/t start
. S LVDTE=$$FMADD^XLFDT($P(LVY0,U,5),,,$P(PRSM,U,2)) ; leave d/t end
;
; determine starting and ending pay periods
; if single pay period specified
I $G(SPPI) D
. S D1=$P(^PRST(458,SPPI,1),U) D PP^PRSAPPU S (SPP4Y,EPP4Y)=PP4Y
; if no pay period specified
I '$G(SPPI) D
. S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
. S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
;
; loop thru pay periods
S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
. S PPI=$O(^PRST(458,"AB",PP4Y,0))
. ;
. ; check status of memo
. S D1=$P($G(^PRST(458,PPI,1)),U)
. S PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
. Q:PRSX'>0 ; skip if pay period is not covered by memo
. Q:$P(PRSX,U,2)=4 ; skip if memo is reconciled
. K PRSX
. ;
. ; obtain time card status
. S TCST=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
. ;
. ; determine begin and end day numbers within pay period
. S PPY1=$G(^PRST(458,PPI,1))
. ; begin day is greater of leave from date-1 and 1st PP day
. S PRSX=$S(DAYN:DAYN,1:1) ; if passed use day # instead of 1st PP day
. S SDT=$S($P(PPY1,U,PRSX)>$$FMADD^XLFDT($P(LVY0,U,3),-1):$P(PPY1,U,PRSX),1:$$FMADD^XLFDT($P(LVY0,U,3),-1))
. S SDN=$P($G(^PRST(458,"AD",SDT)),U,2) ; start day number
. ; end day is lesser of leave request to date and last PP day
. S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day # instead of last PP day
. S EDT=$S($P(LVY0,U,5)>$P(PPY1,U,PRSX):$P(PPY1,U,PRSX),1:$P(LVY0,U,5))
. S EDN=$P($G(^PRST(458,"AD",EDT)),U,2) ; end day number
. K PPY1,PRSX,SDT,EDT
. ;
. ; loop thru applicable days in PP
. S PPDN=SDN-1 ; initial PP day number for loop
. F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>EDN) D PDAY^PRSPLVA1
;
; handle fatal exception and quit without updating file 458
I $G(FATAL) S PRSEX=$P(FATAL,U,2) Q
;
; clear appropriate time card days
S PPI="" F S PPI=$O(TCUNPOST(PPI)) Q:'PPI D
. S PPDN="" F S PPDN=$O(TCUNPOST(PPI,PPDN)) Q:'PPDN D
. . N X
. . S X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN)
;
; update the ESR
I $D(PRSFDA) D FILE^DIE("","PRSFDA") D MSG^DIALOG()
;
Q
;
ULR(LVY0) ; Unpost Leave Request
; Called by the Edit Leave Request and Cancel Leave Request options
; to unpost one leave request from all opened pay periods.
; Input
; LVIEN - Leave Request 0 Node (before edit) (see file 458.1)
;
; Note: All applicable time cards are assumed to be locked prior to
; calling this API.
;
Q:$G(LVY0)="" ; required input
;
N D1,DAY,EDN,EPP4Y,LVDTE,LVDTS,PP4Y,PPDN,PPDNB
N PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,SDN,SPP4Y,Y
;
S PRSIEN=$P(LVY0,U,2) ; employee IEN
D
. N CNX,PRSM,X,Y
. S X=$P(LVY0,U,4)_U_$P(LVY0,U,6)
. D CNV^PRSATIM
. S PRSM=Y
. S LVDTS=$$FMADD^XLFDT($P(LVY0,U,3),,,$P(PRSM,U,1)) ; leave d/t start
. S LVDTE=$$FMADD^XLFDT($P(LVY0,U,5),,,$P(PRSM,U,2)) ; leave d/t end
;
; determine starting and ending pay periods
S D1=$$FMADD^XLFDT($P(LVY0,U,3),-1) D PP^PRSAPPU S SPP4Y=PP4Y ; based on leave from -1 (use -1 in case of 2-day tour)
S D1=$P(LVY0,U,5) D PP^PRSAPPU S EPP4Y=PP4Y ; based on leave to
;
; loop thru pay periods
S PP4Y=$O(^PRST(458,"AB",SPP4Y),-1) ; set initial value to previous PP
F S PP4Y=$O(^PRST(458,"AB",PP4Y)) Q:PP4Y=""!(PP4Y]EPP4Y) D
. S PPI=$O(^PRST(458,"AB",PP4Y,0))
. ;
. ; check status of memo
. S D1=$P($G(^PRST(458,PPI,1)),U)
. S PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
. Q:PRSX'>0 ; skip if pay period is not covered by memo
. Q:$P(PRSX,U,2)=4 ; skip if memo is reconciled
. K PRSX
. ;
. ; determine begin and end day numbers within pay period
. S PPY1=$G(^PRST(458,PPI,1))
. ; begin day is greater of leave from date-1 and 1st PP day
. S SDT=$S($P(PPY1,U,1)>$$FMADD^XLFDT($P(LVY0,U,3),-1):$P(PPY1,U,1),1:$$FMADD^XLFDT($P(LVY0,U,3),-1))
. S SDN=$P($G(^PRST(458,"AD",SDT)),U,2) ; start day number
. ; end day is lesser of leave request to date and last PP day
. S EDT=$S($P(LVY0,U,5)>$P(PPY1,U,14):$P(PPY1,U,14),1:$P(LVY0,U,5))
. S EDN=$P($G(^PRST(458,"AD",EDT)),U,2) ; end day number
. K PPY1,SDT,EDT
. ;
. ; loop thru applicable days in PP
. S PPDN=SDN-1 ; initial PP day number for loop
. F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>EDN) D PDAY^PRSPLVA2
;
; update the ESR
I $D(PRSFDA) D FILE^DIE("S","PRSFDA") D MSG^DIALOG()
;
; Call API BURP^PRSPESR2 to 'burp' the ESR for any unposted days.
; loop thru iens in PRSFDA(), get node 5, use burp, if result different
; then save result back in node 5
I $D(PRSFDA) D
. N PPDIENS,PPDN,PPI,PRSIEN,PRSX,PRSY
. ; loop thru iens (days)
. S PPDIENS="" F S PPDIENS=$O(PRSFDA(458.02,PPDIENS)) Q:PPDIENS="" D
. . S PPDN=$P(PPDIENS,",",1)
. . S PRSIEN=$P(PPDIENS,",",2)
. . S PPI=$P(PPDIENS,",",3)
. . S PRSX=$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))
. . S PRSY=$$BURP^PRSPESR2(PRSX)
. . I PRSX'=PRSY S ^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)=PRSY
;
Q
;
;PRSPLVA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPLVA 8427 printed Apr 09, 2024@21:29:39 Page 2
PRSPLVA ;WOIFO/SAB - AUTOPOST LEAVE FOR PART-TIME PHY. WITH MEMO ;4/6/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 ;
PLPP(PRSIEN,PPI,DAYN) ; Post Leave for a Pay Period (or day)
+1 ; Called by the open next PP option to post leave to one new pay period
+2 ; for one part-time physician.
+3 ; Called by the enter/edit tour option to re-post leave to one
+4 ; pay period when a tour is changed.
+5 ; Input
+6 ; PRSIEN - Employee IEN (file 450), should be PTP with active memo
+7 ; PPI - Pay Period IEN (file 458)
+8 ; DAYN - (optional) day # within pay period to only post that day
+9 ;
+10 NEW LVIEN,LVY0,PPD1,PPD15,PRSX,RPPD1,RTDT,Y
+11 SET DAYN=$GET(DAYN)
+12 ;
+13 ; Determine pay period dates
+14 SET Y=$GET(^PRST(458,PPI,1))
+15 ; if passed use day # instead of 1st PP day
SET PRSX=$SELECT(DAYN:DAYN,1:1)
+16 ; 1st day of PP
SET PPD1=$PIECE(Y,U,PRSX)
+17 ; reverse 1st day of PP
SET RPPD1=9999999-PPD1
+18 ; if passed use day # instead of last PP day
SET PRSX=$SELECT(DAYN:DAYN,1:14)
+19 ; Last day of PP+1
SET PPD15=$$FMADD^XLFDT($PIECE(Y,U,PRSX),1)
+20 ; (use day 15 to include leave that starts on 2nd day of 2-day tour and
+21 ; would be posted on the prior day)
+22 KILL PRSX
+23 if PPD1=""
QUIT
+24 ;
+25 ; loop thru leave requests for employee by reverse to date until
+26 ; to date is before the pay period or no more to dates
+27 SET RTDT=""
+28 FOR
SET RTDT=$ORDER(^PRST(458.1,"AD",PRSIEN,RTDT))
if 'RTDT!(RTDT>RPPD1)
QUIT
Begin DoDot:1
+29 ; loop thru requests
+30 SET LVIEN=0
+31 SET LVIEN=$ORDER(^PRST(458.1,"AD",PRSIEN,RTDT,LVIEN))
if 'LVIEN
QUIT
Begin DoDot:2
+32 ; leave request 0 node
SET LVY0=$GET(^PRST(458.1,LVIEN,0))
+33 ; skip if from date after pay period+1
if $PIECE(LVY0,U,3)>PPD15
QUIT
+34 ; skip if status not approved
if $PIECE(LVY0,U,9)'="A"
QUIT
+35 ;
+36 ; approved request may overlap PP so post the leave request
+37 DO PLR(LVIEN,PPI,DAYN)
End DoDot:2
End DoDot:1
+38 QUIT
+39 ;
PLR(LVIEN,SPPI,DAYN,PRSEX) ; Post Leave Request
+1 ; Called during open next pay period process (by PLPP above) to post
+2 ; one leave request to a single pay period.
+3 ; Called during Supervisory Approvals process to post one leave request
+4 ; to all opened pay periods.
+5 ; Input
+6 ; LVIEN - Leave Request IEN (file 458.1)
+7 ; SPPI - Pay Period IEN (file 458) or Null Value if for all.
+8 ; DAYN - (optional) day # within SPPI or null value
+9 ; PRSEX - Passed by reference, will be initialized (killed)
+10 ; Output
+11 ; PRSEX - passed by reference, only defined if the leave was not
+12 ; posted to the ESR and should not be approved because the
+13 ; leave is not currently on the time card and it has a status
+14 ; of Payroll. This exception should only be applicable when
+15 ; auto post is called by the supervisory approval of leave.
+16 ;
+17 ;
+18 ; Note: All applicable time cards are assumed to be locked prior to
+19 ; calling this API.
+20 ;
+21 ; required input
if '$GET(LVIEN)
QUIT
+22 SET SPPI=$GET(SPPI)
+23 ;
+24 NEW D1,DAY,EDN,EPP4Y,FATAL,LVDTE,LVDTS,LVY0,PP4Y,PPDN,PPDNB
+25 NEW PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,PRSX,SDN,SPP4Y,TCST,TCUNPOST,Y
+26 ;
+27 KILL PRSEX
+28 ;
+29 SET DAYN=$GET(DAYN)
+30 ; leave request 0 node
SET LVY0=$GET(^PRST(458.1,LVIEN,0))
+31 ; employee IEN
SET PRSIEN=$PIECE(LVY0,U,2)
+32 Begin DoDot:1
+33 NEW CNX,PRSM,X,Y
+34 SET X=$PIECE(LVY0,U,4)_U_$PIECE(LVY0,U,6)
+35 DO CNV^PRSATIM
+36 SET PRSM=Y
+37 ; leave d/t start
SET LVDTS=$$FMADD^XLFDT($PIECE(LVY0,U,3),,,$PIECE(PRSM,U,1))
+38 ; leave d/t end
SET LVDTE=$$FMADD^XLFDT($PIECE(LVY0,U,5),,,$PIECE(PRSM,U,2))
End DoDot:1
+39 ;
+40 ; determine starting and ending pay periods
+41 ; if single pay period specified
+42 IF $GET(SPPI)
Begin DoDot:1
+43 SET D1=$PIECE(^PRST(458,SPPI,1),U)
DO PP^PRSAPPU
SET (SPP4Y,EPP4Y)=PP4Y
End DoDot:1
+44 ; if no pay period specified
+45 IF '$GET(SPPI)
Begin DoDot:1
+46 ; based on leave from -1 (use -1 in case of 2-day tour)
SET D1=$$FMADD^XLFDT($PIECE(LVY0,U,3),-1)
DO PP^PRSAPPU
SET SPP4Y=PP4Y
+47 ; based on leave to
SET D1=$PIECE(LVY0,U,5)
DO PP^PRSAPPU
SET EPP4Y=PP4Y
End DoDot:1
+48 ;
+49 ; loop thru pay periods
+50 ; set initial value to previous PP
SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
+51 FOR
SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
if PP4Y=""!(PP4Y]EPP4Y)
QUIT
Begin DoDot:1
+52 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
+53 ;
+54 ; check status of memo
+55 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
+56 SET PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
+57 ; skip if pay period is not covered by memo
if PRSX'>0
QUIT
+58 ; skip if memo is reconciled
if $PIECE(PRSX,U,2)=4
QUIT
+59 KILL PRSX
+60 ;
+61 ; obtain time card status
+62 SET TCST=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
+63 ;
+64 ; determine begin and end day numbers within pay period
+65 SET PPY1=$GET(^PRST(458,PPI,1))
+66 ; begin day is greater of leave from date-1 and 1st PP day
+67 ; if passed use day # instead of 1st PP day
SET PRSX=$SELECT(DAYN:DAYN,1:1)
+68 SET SDT=$SELECT($PIECE(PPY1,U,PRSX)>$$FMADD^XLFDT($PIECE(LVY0,U,3),-1):$PIECE(PPY1,U,PRSX),1:$$FMADD^XLFDT($PIECE(LVY0,U,3),-1))
+69 ; start day number
SET SDN=$PIECE($GET(^PRST(458,"AD",SDT)),U,2)
+70 ; end day is lesser of leave request to date and last PP day
+71 ; if passed use day # instead of last PP day
SET PRSX=$SELECT(DAYN:DAYN,1:14)
+72 SET EDT=$SELECT($PIECE(LVY0,U,5)>$PIECE(PPY1,U,PRSX):$PIECE(PPY1,U,PRSX),1:$PIECE(LVY0,U,5))
+73 ; end day number
SET EDN=$PIECE($GET(^PRST(458,"AD",EDT)),U,2)
+74 KILL PPY1,PRSX,SDT,EDT
+75 ;
+76 ; loop thru applicable days in PP
+77 ; initial PP day number for loop
SET PPDN=SDN-1
+78 FOR
SET PPDN=$ORDER(^PRST(458,PPI,"E",PRSIEN,"D",PPDN))
if 'PPDN!(PPDN>EDN)
QUIT
DO PDAY^PRSPLVA1
End DoDot:1
+79 ;
+80 ; handle fatal exception and quit without updating file 458
+81 IF $GET(FATAL)
SET PRSEX=$PIECE(FATAL,U,2)
QUIT
+82 ;
+83 ; clear appropriate time card days
+84 SET PPI=""
FOR
SET PPI=$ORDER(TCUNPOST(PPI))
if 'PPI
QUIT
Begin DoDot:1
+85 SET PPDN=""
FOR
SET PPDN=$ORDER(TCUNPOST(PPI,PPDN))
if 'PPDN
QUIT
Begin DoDot:2
+86 NEW X
+87 SET X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN)
End DoDot:2
End DoDot:1
+88 ;
+89 ; update the ESR
+90 IF $DATA(PRSFDA)
DO FILE^DIE("","PRSFDA")
DO MSG^DIALOG()
+91 ;
+92 QUIT
+93 ;
ULR(LVY0) ; Unpost Leave Request
+1 ; Called by the Edit Leave Request and Cancel Leave Request options
+2 ; to unpost one leave request from all opened pay periods.
+3 ; Input
+4 ; LVIEN - Leave Request 0 Node (before edit) (see file 458.1)
+5 ;
+6 ; Note: All applicable time cards are assumed to be locked prior to
+7 ; calling this API.
+8 ;
+9 ; required input
if $GET(LVY0)=""
QUIT
+10 ;
+11 NEW D1,DAY,EDN,EPP4Y,LVDTE,LVDTS,PP4Y,PPDN,PPDNB
+12 NEW PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,PRSIEN,SDN,SPP4Y,Y
+13 ;
+14 ; employee IEN
SET PRSIEN=$PIECE(LVY0,U,2)
+15 Begin DoDot:1
+16 NEW CNX,PRSM,X,Y
+17 SET X=$PIECE(LVY0,U,4)_U_$PIECE(LVY0,U,6)
+18 DO CNV^PRSATIM
+19 SET PRSM=Y
+20 ; leave d/t start
SET LVDTS=$$FMADD^XLFDT($PIECE(LVY0,U,3),,,$PIECE(PRSM,U,1))
+21 ; leave d/t end
SET LVDTE=$$FMADD^XLFDT($PIECE(LVY0,U,5),,,$PIECE(PRSM,U,2))
End DoDot:1
+22 ;
+23 ; determine starting and ending pay periods
+24 ; based on leave from -1 (use -1 in case of 2-day tour)
SET D1=$$FMADD^XLFDT($PIECE(LVY0,U,3),-1)
DO PP^PRSAPPU
SET SPP4Y=PP4Y
+25 ; based on leave to
SET D1=$PIECE(LVY0,U,5)
DO PP^PRSAPPU
SET EPP4Y=PP4Y
+26 ;
+27 ; loop thru pay periods
+28 ; set initial value to previous PP
SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
+29 FOR
SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
if PP4Y=""!(PP4Y]EPP4Y)
QUIT
Begin DoDot:1
+30 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
+31 ;
+32 ; check status of memo
+33 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
+34 SET PRSX=$$MIEN^PRSPUT1(PRSIEN,D1)
+35 ; skip if pay period is not covered by memo
if PRSX'>0
QUIT
+36 ; skip if memo is reconciled
if $PIECE(PRSX,U,2)=4
QUIT
+37 KILL PRSX
+38 ;
+39 ; determine begin and end day numbers within pay period
+40 SET PPY1=$GET(^PRST(458,PPI,1))
+41 ; begin day is greater of leave from date-1 and 1st PP day
+42 SET SDT=$SELECT($PIECE(PPY1,U,1)>$$FMADD^XLFDT($PIECE(LVY0,U,3),-1):$PIECE(PPY1,U,1),1:$$FMADD^XLFDT($PIECE(LVY0,U,3),-1))
+43 ; start day number
SET SDN=$PIECE($GET(^PRST(458,"AD",SDT)),U,2)
+44 ; end day is lesser of leave request to date and last PP day
+45 SET EDT=$SELECT($PIECE(LVY0,U,5)>$PIECE(PPY1,U,14):$PIECE(PPY1,U,14),1:$PIECE(LVY0,U,5))
+46 ; end day number
SET EDN=$PIECE($GET(^PRST(458,"AD",EDT)),U,2)
+47 KILL PPY1,SDT,EDT
+48 ;
+49 ; loop thru applicable days in PP
+50 ; initial PP day number for loop
SET PPDN=SDN-1
+51 FOR
SET PPDN=$ORDER(^PRST(458,PPI,"E",PRSIEN,"D",PPDN))
if 'PPDN!(PPDN>EDN)
QUIT
DO PDAY^PRSPLVA2
End DoDot:1
+52 ;
+53 ; update the ESR
+54 IF $DATA(PRSFDA)
DO FILE^DIE("S","PRSFDA")
DO MSG^DIALOG()
+55 ;
+56 ; Call API BURP^PRSPESR2 to 'burp' the ESR for any unposted days.
+57 ; loop thru iens in PRSFDA(), get node 5, use burp, if result different
+58 ; then save result back in node 5
+59 IF $DATA(PRSFDA)
Begin DoDot:1
+60 NEW PPDIENS,PPDN,PPI,PRSIEN,PRSX,PRSY
+61 ; loop thru iens (days)
+62 SET PPDIENS=""
FOR
SET PPDIENS=$ORDER(PRSFDA(458.02,PPDIENS))
if PPDIENS=""
QUIT
Begin DoDot:2
+63 SET PPDN=$PIECE(PPDIENS,",",1)
+64 SET PRSIEN=$PIECE(PPDIENS,",",2)
+65 SET PPI=$PIECE(PPDIENS,",",3)
+66 SET PRSX=$GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))
+67 SET PRSY=$$BURP^PRSPESR2(PRSX)
+68 IF PRSX'=PRSY
SET ^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)=PRSY
End DoDot:2
End DoDot:1
+69 ;
+70 QUIT
+71 ;
+72 ;PRSPLVA
