PRSPEAA ;WOIFO/SAB - Ext. Absence Autopost for PT Physician ;4/6/2005
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
PEAPP(PRSIEN,PPI,DAYN) ; Post Extended Absences for a Pay Period (or day)
; This API auto posts all extended absences for a specific employee
; and pay period. It is called during the creation of an employee time
; card when a new pay period is opened or when an employee timecard is
; added to an existing pay period.
;
; Input
; PRSIEN - Employee IEN (file 450), should be PTP with active memo
; PPI - Pay Period IEN (file 458)
; DAYN - (optional) Day # within PPI to only post that day
;
; Note: Timecard is assumed to be locked prior to calling this API.
;
N EAIEN,EAY0,PEREND,PERSTR,PPD1,PPD14,PRSX,TDT,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 day in PP
S PPD1=$P(Y,U,PRSX) ; 1st day of PP
S PRSX=$S(DAYN:DAYN,1:14) ; if passed use day# instead of last day in PP
S PPD14=$P(Y,U,PRSX) ; Last day of PP
K PRSX
Q:PPD1=""
;Q:PPD14<DT ; EA only autoposted from curent date and forward
;
; loop thru extended absences for employee by reverse end date until
; end date is before the pay period or no more end dates
S TDT=9999999 ; initial to date for loop
F S TDT=$O(^PRST(458.4,"AEE",PRSIEN,TDT),-1) Q:'TDT!(TDT<PPD1) D
. ; loop thru extended absences
. S EAIEN=0
. S EAIEN=$O(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN)) Q:'EAIEN D
. . S EAY0=$G(^PRST(458.4,EAIEN,0)) ; extended absense 0 node
. . Q:$P(EAY0,U)>PPD14 ; skip if start date after pay period
. . Q:$P(EAY0,U,6)'="A" ; skip if status not active
. . ;
. . ; extended absence overlaps the pay period
. . ; determine start and end dates to post as absence
. . ; period end is lesser of absence to date and PP end
. . S PEREND=$S($P(EAY0,U,2)<PPD14:$P(EAY0,U,2),1:PPD14)
. . ;Q:PEREND<DT ; period ended before current day so can't auto post
. . ; period start is greater of absence from date and PP start
. . S PERSTR=$S($P(EAY0,U)>PPD1:$P(EAY0,U),1:PPD1)
. . ;I PERSTR<DT S PERSTR=DT ; don't auto post EA to days before current
. . ;
. . ; call API to post absence to appropriate ESR days
. . D PEA(PRSIEN,PERSTR,PEREND)
Q
;
CEA(PRSIEN,S1,E1,S2,E2) ; Update ESR when Extended Absence is changed
; This API updates the ESRs when the date range of an extended
; absence is changed.
;
; input
; PRSIEN - Employee IEN (file 450)
; S1 - old Start Date (FileMan internal)
; E1 - old End Date (FileMan internal)
; S2 - new Start Date (FileMan internal)
; E2 - new End Date (FileMan internal)
;
Q:'$G(PRSIEN)
Q:'$G(S1)
Q:'$G(E1)
Q:'$G(S2)
Q:'$G(E2)
;
N X1,X2
;
; post/unpost impacted ranges
;
; if new start is less than old start then days from new start to
; lesser of new end and old start-1 were changed from not covered to
; covered.
I S2<S1 D
. S X1=S2
. S X2=$S(E2<(S1-1):E2,1:S1-1)
. D PEA(PRSIEN,X1,X2)
;
; if new start is greater than old start then days from old start to
; lesser of old end and new start-1 were changed from covered to not
; covered.
I S2>S1 D
. S X1=S1
. S X2=$S(E1<(S2-1):E1,1:S2-1)
. D UEA(PRSIEN,X1,X2)
;
; if new end is greater than old end then days from greater of old
; end+1 and new start to new end were changed from not covered to
; covered.
I E2>E1 D
. S X1=$S(E1+1>S2:E1+1,1:S2)
. S X2=E2
. D PEA(PRSIEN,X1,X2)
;
; if new end is less than old end then days from greater of new end+1
; and old start to old end were changed from covered to not covered.
I E2<E1 D
. S X1=$S(E2+1>S1:E2+1,1:S1)
. S X2=E1
. D UEA(PRSIEN,X1,X2)
;
Q
;
PEA(PRSIEN,PERSTR,PEREND) ; Post Extended Absence
; Called during open next pay period process (by PEAPP above) to post
; one extended absence to a single pay period.
; Called by Enter option to post one new extended absence to all
; opened pay periods.
; Called by Edit option (by CEA above) to post one extended
; absence to all opened pay periods when an extended absence is
; edited such that some days originally not covered by the absence
; are now covered.
; Input
; PRSIEN - Employee IEN (file 450)
; PERSTR - Start of absence period to post (FileMan date)
; PEREND - End of absence period to post (FileMan date)
; Output
; None
;
; Note: All applicable timecards are assumed to be locked prior to
; calling this API.
;
Q:('$G(PRSIEN))!($G(PERSTR)'?7N)!($G(PEREND)'?7N) ; required inputs
N D1,DAY,EPP4Y,PP4Y,PPDN,PPDNB,PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,SPP4Y,Y
;
; determine starting and ending pay periods
S D1=PERSTR D PP^PRSAPPU S SPP4Y=PP4Y
S D1=PEREND D PP^PRSAPPU S EPP4Y=PP4Y
Q:SPP4Y=""
Q:EPP4Y=""
;
; 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))
. ; quit if pay period not covered by memo
. S D1=$P($G(^PRST(458,PPI,1)),U)
. Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0
. ;
. ; determine begin and end day numbers within pay period
. S Y=$G(^PRST(458,PPI,1))
. ; begin day is greater of period start date and 1st PP day
. S PPDTB=$S($P(Y,U,1)>PERSTR:$P(Y,U,1),1:PERSTR)
. S PPDNB=$P($G(^PRST(458,"AD",PPDTB)),U,2) ; begin day number in PP
. ; end day is lesser of period end date and last PP day
. S PPDTE=$S(PEREND>$P(Y,U,14):$P(Y,U,14),1:PEREND)
. S PPDNE=$P($G(^PRST(458,"AD",PPDTE)),U,2) ; end day number in PP
. ;
. ; loop thru applicable days in PP
. S PPDN=PPDNB-1 ; initial PP day number for loop
. F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>PPDNE) D
. . ; skip day if not a scheduled tour
. . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
. . ; skip day if regular time already posted to ESR
. . Q:$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG"
. . ; skip day if ESR already signed or approved
. . Q:"^4^5^"[(U_$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)_U)
. . ;
. . ; mark ESR day as signed
. . K PRSFDA
. . S IENS=PPDN_","_PRSIEN_","_PPI_","
. . S PRSFDA(458.02,IENS,146)="4" ; status = signed
. . S PRSFDA(458.02,IENS,147)=$$NOW^XLFDT() ; signed d/t
. . S PRSFDA(458.02,IENS,149)="2" ; signed method = extended absence
. . D FILE^DIE("","PRSFDA") D MSG^DIALOG()
;
Q
;
UEA(PRSIEN,PERSTR,PEREND) ; Unpost Extended Absence
; Called by Cancel option to unpost one new extended absence from
; opened pay periods.
; Called by Edit option (by CEA above) to unpost one extended
; absence to all opened pay periods when an extended absence is
; edited such that some days originally covered by the absence
; are now not covered.
; Input
; PRSIEN - Employee IEN (file 450)
; PERSTR - Start of absence period (FileMan date)
; PEREND - End of absence period (FileMan date)
; Output
;
; Note: All applicable timecards are assumed to be locked prior to
; calling this API.
;
Q:('$G(PRSIEN))!($G(PERSTR)'?7N)!($G(PEREND)'?7N) ; required inputs
N D1,DAY,EPP4Y,PP4Y,PPDN,PPDNB,PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,SPP4Y,Y
;
; determine starting and ending pay periods
S D1=PERSTR D PP^PRSAPPU S SPP4Y=PP4Y
S D1=PEREND D PP^PRSAPPU S EPP4Y=PP4Y
Q:SPP4Y=""
Q:EPP4Y=""
;
; 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))
. ; quit if pay period not covered by memo
. S D1=$P($G(^PRST(458,PPI,1)),U)
. Q:$$MIEN^PRSPUT1(PRSIEN,D1)'>0
. ;
. ; determine begin and end day numbers within pay period
. S Y=$G(^PRST(458,PPI,1))
. ; begin day is greater of period start date and 1st PP day
. S PPDTB=$S($P(Y,U,1)>PERSTR:$P(Y,U,1),1:PERSTR)
. S PPDNB=$P($G(^PRST(458,"AD",PPDTB)),U,2) ; begin day number in PP
. ; end day is lesser of period end date and last PP day
. S PPDTE=$S(PEREND>$P(Y,U,14):$P(Y,U,14),1:PEREND)
. S PPDNE=$P($G(^PRST(458,"AD",PPDTE)),U,2) ; end day number in PP
. ;
. ; loop thru applicable days in PP
. S PPDN=PPDNB-1 ; initial PP day number for loop
. F S PPDN=$O(^PRST(458,PPI,"E",PRSIEN,"D",PPDN)) Q:'PPDN!(PPDN>PPDNE) D
. . ; skip day if not a scheduled tour
. . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
. . ; skip day if regular time already posted to ESR
. . Q:$G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG"
. . ; skip day if ESR not signed or approved
. . Q:"^4^5^"'[(U_$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)_U)
. . ; skip day if ESR was not auto signed by extended absence
. . Q:$P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)'=2
. . ;
. . ; if ESR status was approved then remove the time card day posting
. . I $P($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)=5 S X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN) K X
. . ;
. . ; update ESR day
. . K PRSFDA
. . S IENS=PPDN_","_PRSIEN_","_PPI_","
. . S PRSFDA(458.02,IENS,146)=$S($TR($G(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)),"^")'="":2,1:1) ; status = pending (if time posted) or not started
. . S PRSFDA(458.02,IENS,147)="@" ; remove signed d/t stamp
. . S PRSFDA(458.02,IENS,149)="@" ; remove last signed method
. . D FILE^DIE("","PRSFDA") D MSG^DIALOG()
;
Q
;
;PRSPEAA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPEAA 9522 printed Nov 22, 2024@17:37:57 Page 2
PRSPEAA ;WOIFO/SAB - Ext. Absence Autopost for PT Physician ;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 ;
PEAPP(PRSIEN,PPI,DAYN) ; Post Extended Absences for a Pay Period (or day)
+1 ; This API auto posts all extended absences for a specific employee
+2 ; and pay period. It is called during the creation of an employee time
+3 ; card when a new pay period is opened or when an employee timecard is
+4 ; added to an existing pay period.
+5 ;
+6 ; Input
+7 ; PRSIEN - Employee IEN (file 450), should be PTP with active memo
+8 ; PPI - Pay Period IEN (file 458)
+9 ; DAYN - (optional) Day # within PPI to only post that day
+10 ;
+11 ; Note: Timecard is assumed to be locked prior to calling this API.
+12 ;
+13 NEW EAIEN,EAY0,PEREND,PERSTR,PPD1,PPD14,PRSX,TDT,Y
+14 SET DAYN=$GET(DAYN)
+15 ;
+16 ; Determine pay period dates
+17 SET Y=$GET(^PRST(458,PPI,1))
+18 ; if passed use day# instead of 1st day in PP
SET PRSX=$SELECT(DAYN:DAYN,1:1)
+19 ; 1st day of PP
SET PPD1=$PIECE(Y,U,PRSX)
+20 ; if passed use day# instead of last day in PP
SET PRSX=$SELECT(DAYN:DAYN,1:14)
+21 ; Last day of PP
SET PPD14=$PIECE(Y,U,PRSX)
+22 KILL PRSX
+23 if PPD1=""
QUIT
+24 ;Q:PPD14<DT ; EA only autoposted from curent date and forward
+25 ;
+26 ; loop thru extended absences for employee by reverse end date until
+27 ; end date is before the pay period or no more end dates
+28 ; initial to date for loop
SET TDT=9999999
+29 FOR
SET TDT=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT),-1)
if 'TDT!(TDT<PPD1)
QUIT
Begin DoDot:1
+30 ; loop thru extended absences
+31 SET EAIEN=0
+32 SET EAIEN=$ORDER(^PRST(458.4,"AEE",PRSIEN,TDT,EAIEN))
if 'EAIEN
QUIT
Begin DoDot:2
+33 ; extended absense 0 node
SET EAY0=$GET(^PRST(458.4,EAIEN,0))
+34 ; skip if start date after pay period
if $PIECE(EAY0,U)>PPD14
QUIT
+35 ; skip if status not active
if $PIECE(EAY0,U,6)'="A"
QUIT
+36 ;
+37 ; extended absence overlaps the pay period
+38 ; determine start and end dates to post as absence
+39 ; period end is lesser of absence to date and PP end
+40 SET PEREND=$SELECT($PIECE(EAY0,U,2)<PPD14:$PIECE(EAY0,U,2),1:PPD14)
+41 ;Q:PEREND<DT ; period ended before current day so can't auto post
+42 ; period start is greater of absence from date and PP start
+43 SET PERSTR=$SELECT($PIECE(EAY0,U)>PPD1:$PIECE(EAY0,U),1:PPD1)
+44 ;I PERSTR<DT S PERSTR=DT ; don't auto post EA to days before current
+45 ;
+46 ; call API to post absence to appropriate ESR days
+47 DO PEA(PRSIEN,PERSTR,PEREND)
End DoDot:2
End DoDot:1
+48 QUIT
+49 ;
CEA(PRSIEN,S1,E1,S2,E2) ; Update ESR when Extended Absence is changed
+1 ; This API updates the ESRs when the date range of an extended
+2 ; absence is changed.
+3 ;
+4 ; input
+5 ; PRSIEN - Employee IEN (file 450)
+6 ; S1 - old Start Date (FileMan internal)
+7 ; E1 - old End Date (FileMan internal)
+8 ; S2 - new Start Date (FileMan internal)
+9 ; E2 - new End Date (FileMan internal)
+10 ;
+11 if '$GET(PRSIEN)
QUIT
+12 if '$GET(S1)
QUIT
+13 if '$GET(E1)
QUIT
+14 if '$GET(S2)
QUIT
+15 if '$GET(E2)
QUIT
+16 ;
+17 NEW X1,X2
+18 ;
+19 ; post/unpost impacted ranges
+20 ;
+21 ; if new start is less than old start then days from new start to
+22 ; lesser of new end and old start-1 were changed from not covered to
+23 ; covered.
+24 IF S2<S1
Begin DoDot:1
+25 SET X1=S2
+26 SET X2=$SELECT(E2<(S1-1):E2,1:S1-1)
+27 DO PEA(PRSIEN,X1,X2)
End DoDot:1
+28 ;
+29 ; if new start is greater than old start then days from old start to
+30 ; lesser of old end and new start-1 were changed from covered to not
+31 ; covered.
+32 IF S2>S1
Begin DoDot:1
+33 SET X1=S1
+34 SET X2=$SELECT(E1<(S2-1):E1,1:S2-1)
+35 DO UEA(PRSIEN,X1,X2)
End DoDot:1
+36 ;
+37 ; if new end is greater than old end then days from greater of old
+38 ; end+1 and new start to new end were changed from not covered to
+39 ; covered.
+40 IF E2>E1
Begin DoDot:1
+41 SET X1=$SELECT(E1+1>S2:E1+1,1:S2)
+42 SET X2=E2
+43 DO PEA(PRSIEN,X1,X2)
End DoDot:1
+44 ;
+45 ; if new end is less than old end then days from greater of new end+1
+46 ; and old start to old end were changed from covered to not covered.
+47 IF E2<E1
Begin DoDot:1
+48 SET X1=$SELECT(E2+1>S1:E2+1,1:S1)
+49 SET X2=E1
+50 DO UEA(PRSIEN,X1,X2)
End DoDot:1
+51 ;
+52 QUIT
+53 ;
PEA(PRSIEN,PERSTR,PEREND) ; Post Extended Absence
+1 ; Called during open next pay period process (by PEAPP above) to post
+2 ; one extended absence to a single pay period.
+3 ; Called by Enter option to post one new extended absence to all
+4 ; opened pay periods.
+5 ; Called by Edit option (by CEA above) to post one extended
+6 ; absence to all opened pay periods when an extended absence is
+7 ; edited such that some days originally not covered by the absence
+8 ; are now covered.
+9 ; Input
+10 ; PRSIEN - Employee IEN (file 450)
+11 ; PERSTR - Start of absence period to post (FileMan date)
+12 ; PEREND - End of absence period to post (FileMan date)
+13 ; Output
+14 ; None
+15 ;
+16 ; Note: All applicable timecards are assumed to be locked prior to
+17 ; calling this API.
+18 ;
+19 ; required inputs
if ('$GET(PRSIEN))!($GET(PERSTR)'?7N)!($GET(PEREND)'?7N)
QUIT
+20 NEW D1,DAY,EPP4Y,PP4Y,PPDN,PPDNB,PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,SPP4Y,Y
+21 ;
+22 ; determine starting and ending pay periods
+23 SET D1=PERSTR
DO PP^PRSAPPU
SET SPP4Y=PP4Y
+24 SET D1=PEREND
DO PP^PRSAPPU
SET EPP4Y=PP4Y
+25 if SPP4Y=""
QUIT
+26 if EPP4Y=""
QUIT
+27 ;
+28 ; loop thru pay periods
+29 ; set initial value to previous PP
SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
+30 FOR
SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
if PP4Y=""!(PP4Y]EPP4Y)
QUIT
Begin DoDot:1
+31 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
+32 ; quit if pay period not covered by memo
+33 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
+34 if $$MIEN^PRSPUT1(PRSIEN,D1)'>0
QUIT
+35 ;
+36 ; determine begin and end day numbers within pay period
+37 SET Y=$GET(^PRST(458,PPI,1))
+38 ; begin day is greater of period start date and 1st PP day
+39 SET PPDTB=$SELECT($PIECE(Y,U,1)>PERSTR:$PIECE(Y,U,1),1:PERSTR)
+40 ; begin day number in PP
SET PPDNB=$PIECE($GET(^PRST(458,"AD",PPDTB)),U,2)
+41 ; end day is lesser of period end date and last PP day
+42 SET PPDTE=$SELECT(PEREND>$PIECE(Y,U,14):$PIECE(Y,U,14),1:PEREND)
+43 ; end day number in PP
SET PPDNE=$PIECE($GET(^PRST(458,"AD",PPDTE)),U,2)
+44 ;
+45 ; loop thru applicable days in PP
+46 ; initial PP day number for loop
SET PPDN=PPDNB-1
+47 FOR
SET PPDN=$ORDER(^PRST(458,PPI,"E",PRSIEN,"D",PPDN))
if 'PPDN!(PPDN>PPDNE)
QUIT
Begin DoDot:2
+48 ; skip day if not a scheduled tour
+49 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
QUIT
+50 ; skip day if regular time already posted to ESR
+51 if $GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG"
QUIT
+52 ; skip day if ESR already signed or approved
+53 if "^4^5^"[(U_$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)_U)
QUIT
+54 ;
+55 ; mark ESR day as signed
+56 KILL PRSFDA
+57 SET IENS=PPDN_","_PRSIEN_","_PPI_","
+58 ; status = signed
SET PRSFDA(458.02,IENS,146)="4"
+59 ; signed d/t
SET PRSFDA(458.02,IENS,147)=$$NOW^XLFDT()
+60 ; signed method = extended absence
SET PRSFDA(458.02,IENS,149)="2"
+61 DO FILE^DIE("","PRSFDA")
DO MSG^DIALOG()
End DoDot:2
End DoDot:1
+62 ;
+63 QUIT
+64 ;
UEA(PRSIEN,PERSTR,PEREND) ; Unpost Extended Absence
+1 ; Called by Cancel option to unpost one new extended absence from
+2 ; opened pay periods.
+3 ; Called by Edit option (by CEA above) to unpost one extended
+4 ; absence to all opened pay periods when an extended absence is
+5 ; edited such that some days originally covered by the absence
+6 ; are now not covered.
+7 ; Input
+8 ; PRSIEN - Employee IEN (file 450)
+9 ; PERSTR - Start of absence period (FileMan date)
+10 ; PEREND - End of absence period (FileMan date)
+11 ; Output
+12 ;
+13 ; Note: All applicable timecards are assumed to be locked prior to
+14 ; calling this API.
+15 ;
+16 ; required inputs
if ('$GET(PRSIEN))!($GET(PERSTR)'?7N)!($GET(PEREND)'?7N)
QUIT
+17 NEW D1,DAY,EPP4Y,PP4Y,PPDN,PPDNB,PPDTB,PPDNE,PPDTE,PPE,PPI,PRSFDA,SPP4Y,Y
+18 ;
+19 ; determine starting and ending pay periods
+20 SET D1=PERSTR
DO PP^PRSAPPU
SET SPP4Y=PP4Y
+21 SET D1=PEREND
DO PP^PRSAPPU
SET EPP4Y=PP4Y
+22 if SPP4Y=""
QUIT
+23 if EPP4Y=""
QUIT
+24 ;
+25 ; loop thru pay periods
+26 ; set initial value to previous PP
SET PP4Y=$ORDER(^PRST(458,"AB",SPP4Y),-1)
+27 FOR
SET PP4Y=$ORDER(^PRST(458,"AB",PP4Y))
if PP4Y=""!(PP4Y]EPP4Y)
QUIT
Begin DoDot:1
+28 SET PPI=$ORDER(^PRST(458,"AB",PP4Y,0))
+29 ; quit if pay period not covered by memo
+30 SET D1=$PIECE($GET(^PRST(458,PPI,1)),U)
+31 if $$MIEN^PRSPUT1(PRSIEN,D1)'>0
QUIT
+32 ;
+33 ; determine begin and end day numbers within pay period
+34 SET Y=$GET(^PRST(458,PPI,1))
+35 ; begin day is greater of period start date and 1st PP day
+36 SET PPDTB=$SELECT($PIECE(Y,U,1)>PERSTR:$PIECE(Y,U,1),1:PERSTR)
+37 ; begin day number in PP
SET PPDNB=$PIECE($GET(^PRST(458,"AD",PPDTB)),U,2)
+38 ; end day is lesser of period end date and last PP day
+39 SET PPDTE=$SELECT(PEREND>$PIECE(Y,U,14):$PIECE(Y,U,14),1:PEREND)
+40 ; end day number in PP
SET PPDNE=$PIECE($GET(^PRST(458,"AD",PPDTE)),U,2)
+41 ;
+42 ; loop thru applicable days in PP
+43 ; initial PP day number for loop
SET PPDN=PPDNB-1
+44 FOR
SET PPDN=$ORDER(^PRST(458,PPI,"E",PRSIEN,"D",PPDN))
if 'PPDN!(PPDN>PPDNE)
QUIT
Begin DoDot:2
+45 ; skip day if not a scheduled tour
+46 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,1)),U)=""
QUIT
+47 ; skip day if regular time already posted to ESR
+48 if $GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5))["RG"
QUIT
+49 ; skip day if ESR not signed or approved
+50 if "^4^5^"'[(U_$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)_U)
QUIT
+51 ; skip day if ESR was not auto signed by extended absence
+52 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U,3)'=2
QUIT
+53 ;
+54 ; if ESR status was approved then remove the time card day posting
+55 IF $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,7)),U)=5
SET X=$$CLRTCDY^PRSPSAPU(PPI,PRSIEN,PPDN)
KILL X
+56 ;
+57 ; update ESR day
+58 KILL PRSFDA
+59 SET IENS=PPDN_","_PRSIEN_","_PPI_","
+60 ; status = pending (if time posted) or not started
SET PRSFDA(458.02,IENS,146)=$SELECT($TRANSLATE($GET(^PRST(458,PPI,"E",PRSIEN,"D",PPDN,5)),"^")'="":2,1:1)
+61 ; remove signed d/t stamp
SET PRSFDA(458.02,IENS,147)="@"
+62 ; remove last signed method
SET PRSFDA(458.02,IENS,149)="@"
+63 DO FILE^DIE("","PRSFDA")
DO MSG^DIALOG()
End DoDot:2
End DoDot:1
+64 ;
+65 QUIT
+66 ;
+67 ;PRSPEAA
