PRSALVX ;HISC/REL - Cancel Leave Request ;12/15/04
;;4.0;PAID;**61,93,114**;Sep 21, 1995;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
N SKIP,ZOLD
S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0))
I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX
S TLE=$P($G(^PRSPC(DFN,0)),"^",8) S:TLE="" TLE=" " S TLI=+$O(^PRST(455.5,"B",TLE,0))
W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?29,"CANCEL LEAVE REQUESTS"
S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?50,"XXX-XX-",$E(X,6,9)
K %DT S %DT="AEFX",%DT("A")="Begin with Date: ",%DT("B")="T" W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=9999999-Y
W ! S NUM=1 D DISP^PRSALVS
G:'CNT EX
X1 R !!,"Cancel Which Request #? ",X:DTIME G:'$T!("^"[X) EX I X'?1N.N!(X<1)!(X>CNT) W *7," Enter # of Request to Cancel" G X1
S X=+X,DA=R(X)
;
; if request is approved and employee has any part-time physician memos
; then lock appropriate pay periods
K PPLCK,PPLCKE
S SKIP=0
S ZOLD=$G(^PRST(458.1,DA,0))
I $P(ZOLD,U,12),$$PTP^PRSPUT3($P(ZOLD,U,2)) D
. ; lock applicable time cards
. D LCK^PRSPAPU($P(ZOLD,U,2),$$FMADD^XLFDT($P(ZOLD,U,3),-1),$P(ZOLD,U,5),.PPLCK,.PPLCKE)
. ; if problem locking time cards
. I $D(PPLCKE) D
. . S SKIP=1 ; set flag to skip cancel of leave
. . D TCULCK^PRSPAPU($P(ZOLD,U,2),.PPLCK) ; unlock any locked PP
. . D RLCKE^PRSPAPU(.PPLCKE) ; report problems
. . K PPLCK,PPLCKE
Q:SKIP ; don't proceed with cancel
;
; cancel leave request
S $P(^PRST(458.1,DA,0),"^",9)="X" K ^PRST(458.1,"AR",DFN,DA)
;
; if timecards were locked (PTP), unpost the leave and remove the locks
I $D(PPLCK) D
. D ULR^PRSPLVA(ZOLD)
. D TCULCK^PRSPAPU($P(ZOLD,U,2),.PPLCK)
. K PPLCK
;
; update T&L action counts
D UPD^PRSASAL W " ... done"
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSALVX 1904 printed Oct 16, 2024@18:24:26 Page 2
PRSALVX ;HISC/REL - Cancel Leave Request ;12/15/04
+1 ;;4.0;PAID;**61,93,114**;Sep 21, 1995;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 NEW SKIP,ZOLD
+4 SET DFN=""
SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
IF SSN'=""
SET DFN=$ORDER(^PRSPC("SSN",SSN,0))
+5 IF 'DFN
WRITE !!,*7,"Your SSN was not found in both the New Person & Employee File!"
GOTO EX
+6 SET TLE=$PIECE($GET(^PRSPC(DFN,0)),"^",8)
if TLE=""
SET TLE=" "
SET TLI=+$ORDER(^PRST(455.5,"B",TLE,0))
+7 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",!?29,"CANCEL LEAVE REQUESTS"
+8 SET X=$GET(^PRSPC(DFN,0))
WRITE !!,$PIECE(X,"^",1)
SET X=$PIECE(X,"^",9)
IF X
WRITE ?50,"XXX-XX-",$EXTRACT(X,6,9)
+9 KILL %DT
SET %DT="AEFX"
SET %DT("A")="Begin with Date: "
SET %DT("B")="T"
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO EX
SET EDT=9999999-Y
+10 WRITE !
SET NUM=1
DO DISP^PRSALVS
+11 if 'CNT
GOTO EX
X1 READ !!,"Cancel Which Request #? ",X:DTIME
if '$TEST!("^"[X)
GOTO EX
IF X'?1N.N!(X<1)!(X>CNT)
WRITE *7," Enter # of Request to Cancel"
GOTO X1
+1 SET X=+X
SET DA=R(X)
+2 ;
+3 ; if request is approved and employee has any part-time physician memos
+4 ; then lock appropriate pay periods
+5 KILL PPLCK,PPLCKE
+6 SET SKIP=0
+7 SET ZOLD=$GET(^PRST(458.1,DA,0))
+8 IF $PIECE(ZOLD,U,12)
IF $$PTP^PRSPUT3($PIECE(ZOLD,U,2))
Begin DoDot:1
+9 ; lock applicable time cards
+10 DO LCK^PRSPAPU($PIECE(ZOLD,U,2),$$FMADD^XLFDT($PIECE(ZOLD,U,3),-1),$PIECE(ZOLD,U,5),.PPLCK,.PPLCKE)
+11 ; if problem locking time cards
+12 IF $DATA(PPLCKE)
Begin DoDot:2
+13 ; set flag to skip cancel of leave
SET SKIP=1
+14 ; unlock any locked PP
DO TCULCK^PRSPAPU($PIECE(ZOLD,U,2),.PPLCK)
+15 ; report problems
DO RLCKE^PRSPAPU(.PPLCKE)
+16 KILL PPLCK,PPLCKE
End DoDot:2
End DoDot:1
+17 ; don't proceed with cancel
if SKIP
QUIT
+18 ;
+19 ; cancel leave request
+20 SET $PIECE(^PRST(458.1,DA,0),"^",9)="X"
KILL ^PRST(458.1,"AR",DFN,DA)
+21 ;
+22 ; if timecards were locked (PTP), unpost the leave and remove the locks
+23 IF $DATA(PPLCK)
Begin DoDot:1
+24 DO ULR^PRSPLVA(ZOLD)
+25 DO TCULCK^PRSPAPU($PIECE(ZOLD,U,2),.PPLCK)
+26 KILL PPLCK
End DoDot:1
+27 ;
+28 ; update T&L action counts
+29 DO UPD^PRSASAL
WRITE " ... done"
EX GOTO KILL^XUSCLEAN
