PRSPEAX ;WOIFO/SAB - CANCEL EXTENDED ABSENCE ;1/4/2005
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Cancel Existing Extended Absence
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,EAIEN,EALIST,EAY0,ESRU
N PERSTR,PEREND,PRSFDA,PRSIEN,PRSLCK,PRSLCKE,X,X1,Y
;
; determine Employee IEN
S PRSIEN=$$PRSIEN^PRSPUT2(1)
I 'PRSIEN G EXIT
;
; verify that user has electronic signature code
I '$$ESIGC^PRSPUT2(1) G EXIT
;
SEL ; select extended absence
W @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
W !?28,"CANCEL EXTENDED ABSENCE",!
;
; build list in EALIST( array
D BLDLST^PRSPEAU(PRSIEN,DT,"^A^")
;
; display list (exit if ^ or time-out during list display)
G:$$DISLST^PRSPEAU() EXIT
;
I EALIST(0)=0 G EXIT ; nothing to select
;
; select item from list
W !
S DIR(0)="NO^1:"_EALIST(0)
S DIR("A")="Cancel which extended absence #?"
D ^DIR K DIR G:Y'>0!$D(DIRUT) EXIT
S EAIEN=EALIST(+Y)
S EAY0=$G(^PRST(458.4,EAIEN,0))
;
; Lock EA
L +^PRST(458.4,EAIEN):2
I '$T D G AGAIN
. W $C(7),!,"Another user is editing this extended absence!"
;
; Display EA
W @IOF D DISEA^PRSPEAU(EAIEN) W !
;
; set ESRU to indicate any restruction for ESR updates upon EA cancel.
; if absence includes prior days then they will not be updated on ESR
; if absence includes Today and RG posted then Today can't be updated
; restruction: 0 = none, 1 = prior to Today, 2 = Today and prior
S ESRU=0 ; init with no restriction
; check if EA includes Today and if RG already posted to Today
I $P(EAY0,U)'>DT,$$CHKRG^PRSPEAU(PRSIEN) S ESRU=2
; if Today OK then check if EA includes any prior days
I 'ESRU,$P(EAY0,U)<DT S ESRU=1
;
; Determine ESR period to update
S PERSTR=$S(ESRU=2:$$FMADD^XLFDT(DT,1),ESRU=1:DT,1:$P(EAY0,U))
S PEREND=$P(EAY0,U,2)
;
; Warn User if any restrictions
I ESRU D
. W !!,"This extended absence includes some ESR days that can't be"
. W !,"automatically updated if the absence is cancelled. Note that"
. W !,"ESR days before "_$$FMTE^XLFDT(PERSTR)_" won't be automatically modified."
. W !,"If appropriate, please manually update those earlier ESR days.",!
;
; Confirm Cancel
S DIR(0)="Y",DIR("A")="Do you want to cancel this extended absence" D ^DIR K DIR I 'Y L -^PRST(458.4,EAIEN) G:$D(DIRUT) EXIT G:'Y SEL
;
; e-sig
D SIG^XUSESIG
I X1="" L -^PRST(458.4,EAIEN) G AGAIN
;
; lock timecards for applicable opened pay periods
D LCK^PRSPAPU(PRSIEN,PERSTR,PEREND,.PRSLCK,.PRSLCKE)
;
; if some time cards couldn't be locked then report error and quit
I $D(PRSLCKE) D G AGAIN
. D TCULCK^PRSPAPU(PRSIEN,.PRSLCK) ; remove any TC locks
. D RLCKE^PRSPAPU(.PRSLCKE,1) ; report failed locks
. K PRSLCKE
;
; Update EA
S PRSFDA(458.4,EAIEN_",",4)=$$NOW^XLFDT() ; d/t updated
S PRSFDA(458.4,EAIEN_",",5)="X" ; status = cancelled
D FILE^DIE("","PRSFDA") D MSG^DIALOG()
;
; Update ESRs
D UEA^PRSPEAA(PRSIEN,PERSTR,PEREND)
;
W !,"The extended absence has been cancelled."
;
; Unlock time cards
D TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
;
; unlock EA
L -^PRST(458.4,EAIEN)
;
; Pause and repeat
AGAIN S DIR(0)="E" D ^DIR K DIR G:$D(DIRUT) EXIT
G SEL
;
EXIT ; exit point
Q
;
;PRSPEAX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPEAX 3300 printed Nov 22, 2024@17:38:03 Page 2
PRSPEAX ;WOIFO/SAB - CANCEL EXTENDED ABSENCE ;1/4/2005
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Cancel Existing Extended Absence
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,EAIEN,EALIST,EAY0,ESRU
+7 NEW PERSTR,PEREND,PRSFDA,PRSIEN,PRSLCK,PRSLCKE,X,X1,Y
+8 ;
+9 ; determine Employee IEN
+10 SET PRSIEN=$$PRSIEN^PRSPUT2(1)
+11 IF 'PRSIEN
GOTO EXIT
+12 ;
+13 ; verify that user has electronic signature code
+14 IF '$$ESIGC^PRSPUT2(1)
GOTO EXIT
+15 ;
SEL ; select extended absence
+1 WRITE @IOF
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM"
+2 WRITE !?28,"CANCEL EXTENDED ABSENCE",!
+3 ;
+4 ; build list in EALIST( array
+5 DO BLDLST^PRSPEAU(PRSIEN,DT,"^A^")
+6 ;
+7 ; display list (exit if ^ or time-out during list display)
+8 if $$DISLST^PRSPEAU()
GOTO EXIT
+9 ;
+10 ; nothing to select
IF EALIST(0)=0
GOTO EXIT
+11 ;
+12 ; select item from list
+13 WRITE !
+14 SET DIR(0)="NO^1:"_EALIST(0)
+15 SET DIR("A")="Cancel which extended absence #?"
+16 DO ^DIR
KILL DIR
if Y'>0!$DATA(DIRUT)
GOTO EXIT
+17 SET EAIEN=EALIST(+Y)
+18 SET EAY0=$GET(^PRST(458.4,EAIEN,0))
+19 ;
+20 ; Lock EA
+21 LOCK +^PRST(458.4,EAIEN):2
+22 IF '$TEST
Begin DoDot:1
+23 WRITE $CHAR(7),!,"Another user is editing this extended absence!"
End DoDot:1
GOTO AGAIN
+24 ;
+25 ; Display EA
+26 WRITE @IOF
DO DISEA^PRSPEAU(EAIEN)
WRITE !
+27 ;
+28 ; set ESRU to indicate any restruction for ESR updates upon EA cancel.
+29 ; if absence includes prior days then they will not be updated on ESR
+30 ; if absence includes Today and RG posted then Today can't be updated
+31 ; restruction: 0 = none, 1 = prior to Today, 2 = Today and prior
+32 ; init with no restriction
SET ESRU=0
+33 ; check if EA includes Today and if RG already posted to Today
+34 IF $PIECE(EAY0,U)'>DT
IF $$CHKRG^PRSPEAU(PRSIEN)
SET ESRU=2
+35 ; if Today OK then check if EA includes any prior days
+36 IF 'ESRU
IF $PIECE(EAY0,U)<DT
SET ESRU=1
+37 ;
+38 ; Determine ESR period to update
+39 SET PERSTR=$SELECT(ESRU=2:$$FMADD^XLFDT(DT,1),ESRU=1:DT,1:$PIECE(EAY0,U))
+40 SET PEREND=$PIECE(EAY0,U,2)
+41 ;
+42 ; Warn User if any restrictions
+43 IF ESRU
Begin DoDot:1
+44 WRITE !!,"This extended absence includes some ESR days that can't be"
+45 WRITE !,"automatically updated if the absence is cancelled. Note that"
+46 WRITE !,"ESR days before "_$$FMTE^XLFDT(PERSTR)_" won't be automatically modified."
+47 WRITE !,"If appropriate, please manually update those earlier ESR days.",!
End DoDot:1
+48 ;
+49 ; Confirm Cancel
+50 SET DIR(0)="Y"
SET DIR("A")="Do you want to cancel this extended absence"
DO ^DIR
KILL DIR
IF 'Y
LOCK -^PRST(458.4,EAIEN)
if $DATA(DIRUT)
GOTO EXIT
if 'Y
GOTO SEL
+51 ;
+52 ; e-sig
+53 DO SIG^XUSESIG
+54 IF X1=""
LOCK -^PRST(458.4,EAIEN)
GOTO AGAIN
+55 ;
+56 ; lock timecards for applicable opened pay periods
+57 DO LCK^PRSPAPU(PRSIEN,PERSTR,PEREND,.PRSLCK,.PRSLCKE)
+58 ;
+59 ; if some time cards couldn't be locked then report error and quit
+60 IF $DATA(PRSLCKE)
Begin DoDot:1
+61 ; remove any TC locks
DO TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
+62 ; report failed locks
DO RLCKE^PRSPAPU(.PRSLCKE,1)
+63 KILL PRSLCKE
End DoDot:1
GOTO AGAIN
+64 ;
+65 ; Update EA
+66 ; d/t updated
SET PRSFDA(458.4,EAIEN_",",4)=$$NOW^XLFDT()
+67 ; status = cancelled
SET PRSFDA(458.4,EAIEN_",",5)="X"
+68 DO FILE^DIE("","PRSFDA")
DO MSG^DIALOG()
+69 ;
+70 ; Update ESRs
+71 DO UEA^PRSPEAA(PRSIEN,PERSTR,PEREND)
+72 ;
+73 WRITE !,"The extended absence has been cancelled."
+74 ;
+75 ; Unlock time cards
+76 DO TCULCK^PRSPAPU(PRSIEN,.PRSLCK)
+77 ;
+78 ; unlock EA
+79 LOCK -^PRST(458.4,EAIEN)
+80 ;
+81 ; Pause and repeat
AGAIN SET DIR(0)="E"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+1 GOTO SEL
+2 ;
EXIT ; exit point
+1 QUIT
+2 ;
+3 ;PRSPEAX
