PRSALVE ;HISC/REL-Edit Leave Request ;12-SEP-00
;;4.0;PAID;**61,114**;Sep 21, 1995;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
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))
D ^PRSAENT S ZENT="",Z1="30 31 31 31 32 33 28 35 35 34 30",Z2="AL SL CB AD NL WP CU AA DL ML RL"
F K=1:1:11 I $E(ENT,$P(Z1," ",K)) S ZENT=ZENT_$P(Z2," ",K)_" "
I ZENT="" W !!?5,"You are not entitled to any type of Leave." G EX
W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?30,"EDIT LEAVE REQUESTS"
S X=$G(^PRSPC(DFN,0)) W !!,$P(X,"^",1) S X=$P(X,"^",9) I X W ?67,"XXX-XX-",$E(X,6,9)
S X1=DT,X2=-5 D C^%DTC S EDT=9999999-X
W ! D DISP
G:'CNT EX
X1 R !!,"Edit Which Request #? ",X:DTIME G:'$T!("^"[X) EX I X'?1N.N!(X<1)!(X>CNT) W *7," Enter # of Request to Edit" G X1
K DDS,DA,DR S X=+X,DA=R(X),ZOLD=$G(^PRST(458.1,DA,0)),Z1=$P(ZOLD,"^",3,6) D ED^PRSALVR G EX
DISP ; Display Leave Requests
S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3),CNT=0 K R
F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>EDT) F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,DTI,DA)) Q:DA="" D LST
W:'CNT !,"No Requests to Edit." Q
LST ; Display Request
S Z=$G(^PRST(458.1,DA,0)) Q:Z="" S SCOM=$P($G(^(1)),"^",1)
S Z1=$P(Z,"^",3)
S Y=$G(^PRST(458,"AD",Z1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
I PPI,DAY,$D(^PRST(458,PPI,"E",DFN,"D",DAY,10)) Q
S CNT=CNT+1 W !,$J(CNT,2)," " S R(CNT)=DA
W $P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP^PRSAPPU W Y," to ",$P(Z,"^",6)," "
S X=$P(Z,"^",5) D DTP^PRSAPPU W Y," "
S X=$P(Z,"^",15) I X W X," ",$S($P(Z,"^",16)="D":"days",1:"hrs")," "
S X=$P(Z,"^",7),%=$F(LVT,";"_X_":") I %>0 W $P($E(LVT,%,999),";",1)," "
S X=$P(Z,"^",9)
S %=$F(LVS,";"_X_":") I %>0 W $P($E(LVS,%,999),";",1)
S X=$P(Z,"^",8) W:X'="" !?5,X W:SCOM'="" !?5,"Supr: ",SCOM Q
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSALVE 2074 printed Oct 16, 2024@18:24:21 Page 2
PRSALVE ;HISC/REL-Edit Leave Request ;12-SEP-00
+1 ;;4.0;PAID;**61,114**;Sep 21, 1995;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET DFN=""
SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
IF SSN'=""
SET DFN=$ORDER(^PRSPC("SSN",SSN,0))
+4 IF 'DFN
WRITE !!,*7,"Your SSN was not found in both the New Person & Employee File!"
GOTO EX
+5 SET TLE=$PIECE($GET(^PRSPC(DFN,0)),"^",8)
if TLE=""
SET TLE=" "
SET TLI=+$ORDER(^PRST(455.5,"B",TLE,0))
+6 DO ^PRSAENT
SET ZENT=""
SET Z1="30 31 31 31 32 33 28 35 35 34 30"
SET Z2="AL SL CB AD NL WP CU AA DL ML RL"
+7 FOR K=1:1:11
IF $EXTRACT(ENT,$PIECE(Z1," ",K))
SET ZENT=ZENT_$PIECE(Z2," ",K)_" "
+8 IF ZENT=""
WRITE !!?5,"You are not entitled to any type of Leave."
GOTO EX
+9 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",!?30,"EDIT LEAVE REQUESTS"
+10 SET X=$GET(^PRSPC(DFN,0))
WRITE !!,$PIECE(X,"^",1)
SET X=$PIECE(X,"^",9)
IF X
WRITE ?67,"XXX-XX-",$EXTRACT(X,6,9)
+11 SET X1=DT
SET X2=-5
DO C^%DTC
SET EDT=9999999-X
+12 WRITE !
DO DISP
+13 if 'CNT
GOTO EX
X1 READ !!,"Edit Which Request #? ",X:DTIME
if '$TEST!("^"[X)
GOTO EX
IF X'?1N.N!(X<1)!(X>CNT)
WRITE *7," Enter # of Request to Edit"
GOTO X1
+1 KILL DDS,DA,DR
SET X=+X
SET DA=R(X)
SET ZOLD=$GET(^PRST(458.1,DA,0))
SET Z1=$PIECE(ZOLD,"^",3,6)
DO ED^PRSALVR
GOTO EX
DISP ; Display Leave Requests
+1 SET LVT=";"_$PIECE(^DD(458.1,6,0),"^",3)
SET LVS=";"_$PIECE(^DD(458.1,8,0),"^",3)
SET CNT=0
KILL R
+2 FOR DTI=0:0
SET DTI=$ORDER(^PRST(458.1,"AD",DFN,DTI))
if DTI=""!(DTI>EDT)
QUIT
FOR DA=0:0
SET DA=$ORDER(^PRST(458.1,"AD",DFN,DTI,DA))
if DA=""
QUIT
DO LST
+3 if 'CNT
WRITE !,"No Requests to Edit."
QUIT
LST ; Display Request
+1 SET Z=$GET(^PRST(458.1,DA,0))
if Z=""
QUIT
SET SCOM=$PIECE($GET(^(1)),"^",1)
+2 SET Z1=$PIECE(Z,"^",3)
+3 SET Y=$GET(^PRST(458,"AD",Z1))
SET PPI=$PIECE(Y,"^",1)
SET DAY=$PIECE(Y,"^",2)
+4 IF PPI
IF DAY
IF $DATA(^PRST(458,PPI,"E",DFN,"D",DAY,10))
QUIT
+5 SET CNT=CNT+1
WRITE !,$JUSTIFY(CNT,2)," "
SET R(CNT)=DA
+6 WRITE $PIECE(Z,"^",4)," "
SET X=$PIECE(Z,"^",3)
DO DTP^PRSAPPU
WRITE Y," to ",$PIECE(Z,"^",6)," "
+7 SET X=$PIECE(Z,"^",5)
DO DTP^PRSAPPU
WRITE Y," "
+8 SET X=$PIECE(Z,"^",15)
IF X
WRITE X," ",$SELECT($PIECE(Z,"^",16)="D":"days",1:"hrs")," "
+9 SET X=$PIECE(Z,"^",7)
SET %=$FIND(LVT,";"_X_":")
IF %>0
WRITE $PIECE($EXTRACT(LVT,%,999),";",1)," "
+10 SET X=$PIECE(Z,"^",9)
+11 SET %=$FIND(LVS,";"_X_":")
IF %>0
WRITE $PIECE($EXTRACT(LVS,%,999),";",1)
+12 SET X=$PIECE(Z,"^",8)
if X'=""
WRITE !?5,X
if SCOM'=""
WRITE !?5,"Supr: ",SCOM
QUIT
EX GOTO KILL^XUSCLEAN
