- 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 Feb 18, 2025@23:54:38 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