- 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 Mar 13, 2025@21:28:38 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
