PRSALVB ;WOIFO/JAH/PLT - Leave Balances ;02/01/08
;;4.0;PAID;**22,35,34,69,114,133**;Sep 21, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
EMP ; Employee Entry Point
S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9) I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0))
I 'DFN W !!,$C(7),"Your SSN was not found in both the New Person & Employee File!" G EX
G D
TK ; Timekeeper Entry Point
S PRSTLV=2 G S0
SUP ; Supervisor Entry Point
S PRSTLV=3 G S0
S0 D ^PRSAUTL G:TLI<1 EX
S1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC G:DFN<1 EX
D N HOLD
W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
I $D(IO("Q")) S PRSAPGM="Q1^PRSALVB",PRSALST="DFN" D QUE^PRSAUTL G EX
U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
Q1 ; Show Balances
N PGQUIT,LST,D1,YR,PPE,PYR,PPP,PPI,CTN,PPVN,PPVO,PPG,PPF
S PGQUIT=""
W:$E(IOST,1,2)="C-" @IOF W !?29,"EMPLOYEE LEAVE BALANCES"
S C0=^PRSPC(DFN,0),DB=$P(C0,"^",10),LVG=$P(C0,"^",15),NH=+$P(C0,"^",16)
D PGHD G Q2
;
; Display employee name and ssn
; SSN defaults to display of last four digits
; employee displays last four
; timekeeper and supervisor display first digit+last four
;
PGHD S X=$G(^PRSPC(DFN,0))
W !!,$P(X,"^",1),?48,"Leave Group: ",LVG
S X=$P(X,"^",9)
I X,'$G(PRSTLV)!($G(PRSTLV)=1) W ?67,"XXX-XX-",$E(X,6,9)
I X,$G(PRSTLV)=2!($G(PRSTLV)=3) W ?67,$E(X),"XX-XX-",$E(X,6,9)
QUIT
;
; compare last pp processed to current pp
;
Q2 S LST=+$P($G(^PRSPC(DFN,"MISC4")),"^",16)
;get most recent year-pp in file
S PPE=$P($G(^PRST(458,$O(^PRST(458,":"),-1),0)),U)
S YR=$P(PPE,"-",1)
S D1=+$P(PPE,"-",2)
S YR=$S(D1'<LST:YR,1:$E(199+YR,2,3))
S PPE=YR_"-"_$S(LST>9:LST,1:"0"_LST),PYR=YR,PPP=$P(PPE,"-",2)
S PPI=$O(^PRST(458,"B",PPE,0))
I PPI S D1=$P($G(^PRST(458,PPI,2)),"^",14)
W !!,"Balances are as of Pay Period ",PPE," (",D1,")"
;
S ALN=$G(^PRSPC(DFN,"ANNUAL")),SLN=$G(^("SICK")),CTN=$G(^("COMP")),MLN=$G(^("MILITARY"))
;
I NH=48,DB=1 D
. S BAY=$G(^PRSPC(DFN,"BAYLOR"))
. S $P(ALN,"^",3)=$P(BAY,"^",1)
. S $P(SLN,"^",3)=$P(BAY,"^",13)
. F KK=9:1:12 S $P(ALN,"^",KK+1)=$P(BAY,"^",KK)
;
S Y=$P(ALN,"^",3)
W !,"Annual Leave Balance:",?30,$S(Y="":"",1:$J(Y,8,3))
S Y=$P(SLN,"^",3)
W !,"Sick Leave Balance:",?30,$S(Y="":"",1:$J(Y,8,3))
;
;print comptime downloaded with pp without year but padding with year based on the balance as of date's year
I CTN]"",$P(CTN,U,1,8)'?1."^" D G:PGQUIT EX
. N PA,PB,PC,PD,PE,PDAYS
. S PC="",PDAYS=377 ;from 26*14+13
. W !!?10,"Comp Time/Credit Hours (CT/CH) Pay Period Balances",!?10,"Pay Period Earned",?30,"# of Hours",?45,"Must be used by"
. F PA=1:1:8 I $P(CTN,U,PA),$P(CTN,U,PA+9) S PC=PC+$P(CTN,U,PA),PB=$$C1($P(CTN,U,PA+9),PDAYS) W !?10,$P(PB,U),?30,$J($P(CTN,U,PA),8,3),?45,$$FMTE^XLFDT($P(PB,U,2)) I IOSL-2<$Y S PGQUIT=$$PGBRK QUIT:PGQUIT W !
. S PD=$P($G(PB),U)
. I $P(CTN,U,9)-PC,PD'=PPE S:PD]"" PD=$$PPDT^PRSU1B2(PD,14),PD=$$DTPP^PRSU1B2($P(PD,U,4)+15,"H") D
.. S PE=$S($P(PD,U,2)=PPE:" "_PPE,1:"*"_$P(PD,U,2)_" thru "_PPE) W !?9,PE,?30,$J($P(CTN,U,9)-PC,8,3)
.. W ?45,$S($P(PD,U,2)=PPE:$$FMTE^XLFDT($P($$C1(PPE,PDAYS),U,2)),1:$$FMTE^XLFDT($P($$C1($P(PD,U,2),PDAYS),U,2))_" thru "_$$FMTE^XLFDT($P($$C1(PPE,PDAYS),U,2)))
.. QUIT
. I IOSL-3<$Y S PGQUIT=$$PGBRK QUIT:PGQUIT W !
. W !?10,"-----------------------------------------------------------------"
. W !,"Total CT/CH Hours Balance: ",?30,$J($P(CTN,U,9),8,3),!
. I IOSL-3<$Y S PGQUIT=$$PGBRK QUIT:PGQUIT W !
. I $G(PE)["*" W !,"*The CT/CH balance of ",$J($P(CTN,U,9)-PC,1,3)," hours earned between ",$P($P(PE,"*",2)," ")," and ",$P(PE," ",3)," will be",!,"itemized in the report at least 8 pay periods in advance."
. QUIT
;
;If employee has restored leave then interpret 1 digit year
;on file from AAC and display.
;
S Y=$P(ALN,"^",10) I Y D
.N YRDIGIT
.W !!," Restored Leave:",?30,$J(Y,8,3)
.S YRDIGIT=$P(ALN,"^",12)
.I YRDIGIT>-1 W !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit."
S Y=$P(ALN,"^",11) I Y D
.N YRDIGIT
.W !!," Restored Leave:",?30,$J(Y,8,3)
.S YRDIGIT=$P(ALN,"^",13)
.I YRDIGIT>-1 W !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit."
;
;Display other types of leave, if any.
;
S Y=$P(MLN,"^",1) I Y D
. W !!,"Military Leave in "
. W $S($$MLINHRS^PRSAENT(DFN):"hours:",1:"days:")
. W ?30,$J(Y,8,2)
S Y=$P(ALN,"^",9) I Y W !!,"Non-Pay Leave Taken:",?30,$J(Y,8,3)
W !,"END OF REPORT"
I $E(IOST,1,2)="C-" S HOLD=$$ASK^PRSLIB00(1)
QUIT
;
;a=yy-pp or pp and pp is 1 to 26, b=# of days for used by
C1(A,B) ;ef - ^1=pp in format yy-pp or pp, ^2=expiration date
N C,D,E
;get pp year based on the last pp download in the employee file
QUIT:A="" ""
S D=A S:A?1.2N D=$S(A'>PPP:PYR,1:$E(199+PYR,2,3))_"-"_$E(100+A,2,3)
S C=$P($$PPDT^PRSU1B2(D,1),U,2),E=$$FMADD^XLFDT(C,B)
QUIT D_"^"_E
;
PGBRK() ;ev - 1 if quit, "" if continue
N DIR,DIRUT
I IOST?1"C-".E S DIR(0)="E" D ^DIR
I '$G(DIRUT) W @IOF D PGHD
QUIT $G(DIRUT)
;
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSALVB 5182 printed Oct 16, 2024@18:24:20 Page 2
PRSALVB ;WOIFO/JAH/PLT - Leave Balances ;02/01/08
+1 ;;4.0;PAID;**22,35,34,69,114,133**;Sep 21, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
EMP ; Employee Entry Point
+1 SET DFN=""
SET SSN=$PIECE($GET(^VA(200,DUZ,1)),"^",9)
IF SSN'=""
SET DFN=$ORDER(^PRSPC("SSN",SSN,0))
+2 IF 'DFN
WRITE !!,$CHAR(7),"Your SSN was not found in both the New Person & Employee File!"
GOTO EX
+3 GOTO D
TK ; Timekeeper Entry Point
+1 SET PRSTLV=2
GOTO S0
SUP ; Supervisor Entry Point
+1 SET PRSTLV=3
GOTO S0
S0 DO ^PRSAUTL
if TLI<1
GOTO EX
S1 KILL DIC
SET DIC("A")="Select EMPLOYEE: "
SET DIC("S")="I $P(^(0),""^"",8)=TLE"
SET DIC(0)="AEQM"
SET DIC="^PRSPC("
SET D="ATL"_TLE
WRITE !
DO IX^DIC
SET DFN=+Y
KILL DIC
if DFN<1
GOTO EX
D NEW HOLD
+1 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select Device: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO EX
+2 IF $DATA(IO("Q"))
SET PRSAPGM="Q1^PRSALVB"
SET PRSALST="DFN"
DO QUE^PRSAUTL
GOTO EX
+3 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO EX
Q1 ; Show Balances
+1 NEW PGQUIT,LST,D1,YR,PPE,PYR,PPP,PPI,CTN,PPVN,PPVO,PPG,PPF
+2 SET PGQUIT=""
+3 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?29,"EMPLOYEE LEAVE BALANCES"
+4 SET C0=^PRSPC(DFN,0)
SET DB=$PIECE(C0,"^",10)
SET LVG=$PIECE(C0,"^",15)
SET NH=+$PIECE(C0,"^",16)
+5 DO PGHD
GOTO Q2
+6 ;
+7 ; Display employee name and ssn
+8 ; SSN defaults to display of last four digits
+9 ; employee displays last four
+10 ; timekeeper and supervisor display first digit+last four
+11 ;
PGHD SET X=$GET(^PRSPC(DFN,0))
+1 WRITE !!,$PIECE(X,"^",1),?48,"Leave Group: ",LVG
+2 SET X=$PIECE(X,"^",9)
+3 IF X
IF '$GET(PRSTLV)!($GET(PRSTLV)=1)
WRITE ?67,"XXX-XX-",$EXTRACT(X,6,9)
+4 IF X
IF $GET(PRSTLV)=2!($GET(PRSTLV)=3)
WRITE ?67,$EXTRACT(X),"XX-XX-",$EXTRACT(X,6,9)
+5 QUIT
+6 ;
+7 ; compare last pp processed to current pp
+8 ;
Q2 SET LST=+$PIECE($GET(^PRSPC(DFN,"MISC4")),"^",16)
+1 ;get most recent year-pp in file
+2 SET PPE=$PIECE($GET(^PRST(458,$ORDER(^PRST(458,":"),-1),0)),U)
+3 SET YR=$PIECE(PPE,"-",1)
+4 SET D1=+$PIECE(PPE,"-",2)
+5 SET YR=$SELECT(D1'<LST:YR,1:$EXTRACT(199+YR,2,3))
+6 SET PPE=YR_"-"_$SELECT(LST>9:LST,1:"0"_LST)
SET PYR=YR
SET PPP=$PIECE(PPE,"-",2)
+7 SET PPI=$ORDER(^PRST(458,"B",PPE,0))
+8 IF PPI
SET D1=$PIECE($GET(^PRST(458,PPI,2)),"^",14)
+9 WRITE !!,"Balances are as of Pay Period ",PPE," (",D1,")"
+10 ;
+11 SET ALN=$GET(^PRSPC(DFN,"ANNUAL"))
SET SLN=$GET(^("SICK"))
SET CTN=$GET(^("COMP"))
SET MLN=$GET(^("MILITARY"))
+12 ;
+13 IF NH=48
IF DB=1
Begin DoDot:1
+14 SET BAY=$GET(^PRSPC(DFN,"BAYLOR"))
+15 SET $PIECE(ALN,"^",3)=$PIECE(BAY,"^",1)
+16 SET $PIECE(SLN,"^",3)=$PIECE(BAY,"^",13)
+17 FOR KK=9:1:12
SET $PIECE(ALN,"^",KK+1)=$PIECE(BAY,"^",KK)
End DoDot:1
+18 ;
+19 SET Y=$PIECE(ALN,"^",3)
+20 WRITE !,"Annual Leave Balance:",?30,$SELECT(Y="":"",1:$JUSTIFY(Y,8,3))
+21 SET Y=$PIECE(SLN,"^",3)
+22 WRITE !,"Sick Leave Balance:",?30,$SELECT(Y="":"",1:$JUSTIFY(Y,8,3))
+23 ;
+24 ;print comptime downloaded with pp without year but padding with year based on the balance as of date's year
+25 IF CTN]""
IF $PIECE(CTN,U,1,8)'?1."^"
Begin DoDot:1
+26 NEW PA,PB,PC,PD,PE,PDAYS
+27 ;from 26*14+13
SET PC=""
SET PDAYS=377
+28 WRITE !!?10,"Comp Time/Credit Hours (CT/CH) Pay Period Balances",!?10,"Pay Period Earned",?30,"# of Hours",?45,"Must be used by"
+29 FOR PA=1:1:8
IF $PIECE(CTN,U,PA)
IF $PIECE(CTN,U,PA+9)
SET PC=PC+$PIECE(CTN,U,PA)
SET PB=$$C1($PIECE(CTN,U,PA+9),PDAYS)
WRITE !?10,$PIECE(PB,U),?30,$JUSTIFY($PIECE(CTN,U,PA),8,3),?45,$$FMTE^XLFDT($PIECE(PB,U,2))
IF IOSL-2<$Y
SET PGQUIT=$$PGBRK
if PGQUIT
QUIT
WRITE !
+30 SET PD=$PIECE($GET(PB),U)
+31 IF $PIECE(CTN,U,9)-PC
IF PD'=PPE
if PD]""
SET PD=$$PPDT^PRSU1B2(PD,14)
SET PD=$$DTPP^PRSU1B2($PIECE(PD,U,4)+15,"H")
Begin DoDot:2
+32 SET PE=$SELECT($PIECE(PD,U,2)=PPE:" "_PPE,1:"*"_$PIECE(PD,U,2)_" thru "_PPE)
WRITE !?9,PE,?30,$JUSTIFY($PIECE(CTN,U,9)-PC,8,3)
+33 WRITE ?45,$SELECT($PIECE(PD,U,2)=PPE:$$FMTE^XLFDT($PIECE($$C1(PPE,PDAYS),U,2)),1:$$FMTE^XLFDT($PIECE($$C1($PIECE(PD,U,2),PDAYS),U,2))_" thru "_$$FMTE^XLFDT($PIECE($$C1(PPE,PDAYS),U,2)))
+34 QUIT
End DoDot:2
+35 IF IOSL-3<$Y
SET PGQUIT=$$PGBRK
if PGQUIT
QUIT
WRITE !
+36 WRITE !?10,"-----------------------------------------------------------------"
+37 WRITE !,"Total CT/CH Hours Balance: ",?30,$JUSTIFY($PIECE(CTN,U,9),8,3),!
+38 IF IOSL-3<$Y
SET PGQUIT=$$PGBRK
if PGQUIT
QUIT
WRITE !
+39 IF $GET(PE)["*"
WRITE !,"*The CT/CH balance of ",$JUSTIFY($PIECE(CTN,U,9)-PC,1,3)," hours earned between ",$PIECE($PIECE(PE,"*",2)," ")," and ",$PIECE(PE," ",3)," will be",!,"itemized in the report at least 8 pay periods in advance."
+40 QUIT
End DoDot:1
if PGQUIT
GOTO EX
+41 ;
+42 ;If employee has restored leave then interpret 1 digit year
+43 ;on file from AAC and display.
+44 ;
+45 SET Y=$PIECE(ALN,"^",10)
IF Y
Begin DoDot:1
+46 NEW YRDIGIT
+47 WRITE !!," Restored Leave:",?30,$JUSTIFY(Y,8,3)
+48 SET YRDIGIT=$PIECE(ALN,"^",12)
+49 IF YRDIGIT>-1
WRITE !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit."
End DoDot:1
+50 SET Y=$PIECE(ALN,"^",11)
IF Y
Begin DoDot:1
+51 NEW YRDIGIT
+52 WRITE !!," Restored Leave:",?30,$JUSTIFY(Y,8,3)
+53 SET YRDIGIT=$PIECE(ALN,"^",13)
+54 IF YRDIGIT>-1
WRITE !,"Use by end of leave year ",$$BLDYR^PRSLIB00(YRDIGIT)," or forfeit."
End DoDot:1
+55 ;
+56 ;Display other types of leave, if any.
+57 ;
+58 SET Y=$PIECE(MLN,"^",1)
IF Y
Begin DoDot:1
+59 WRITE !!,"Military Leave in "
+60 WRITE $SELECT($$MLINHRS^PRSAENT(DFN):"hours:",1:"days:")
+61 WRITE ?30,$JUSTIFY(Y,8,2)
End DoDot:1
+62 SET Y=$PIECE(ALN,"^",9)
IF Y
WRITE !!,"Non-Pay Leave Taken:",?30,$JUSTIFY(Y,8,3)
+63 WRITE !,"END OF REPORT"
+64 IF $EXTRACT(IOST,1,2)="C-"
SET HOLD=$$ASK^PRSLIB00(1)
+65 QUIT
+66 ;
+67 ;a=yy-pp or pp and pp is 1 to 26, b=# of days for used by
C1(A,B) ;ef - ^1=pp in format yy-pp or pp, ^2=expiration date
+1 NEW C,D,E
+2 ;get pp year based on the last pp download in the employee file
+3 if A=""
QUIT ""
+4 SET D=A
if A?1.2N
SET D=$SELECT(A'>PPP:PYR,1:$EXTRACT(199+PYR,2,3))_"-"_$EXTRACT(100+A,2,3)
+5 SET C=$PIECE($$PPDT^PRSU1B2(D,1),U,2)
SET E=$$FMADD^XLFDT(C,B)
+6 QUIT D_"^"_E
+7 ;
PGBRK() ;ev - 1 if quit, "" if continue
+1 NEW DIR,DIRUT
+2 IF IOST?1"C-".E
SET DIR(0)="E"
DO ^DIR
+3 IF '$GET(DIRUT)
WRITE @IOF
DO PGHD
+4 QUIT $GET(DIRUT)
+5 ;
EX GOTO KILL^XUSCLEAN
