PRSALVL ; HISC/REL-Display Leave Requests ;1/24/96 13:56
;;4.0;PAID;**9,114,127**;Sep 21, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
TK ; TimeKeeper Entry
S PRSTLV=2 G TL
SUP ; Supervisor Entry
S PRSTLV=3 G TL
PAY ; Payroll Entry
S PRSTLV=7 G TL
TL D ^PRSAUTL G:TLI<1 EX
K DIC S DIC("A")="Select EMPLOYEE (or RETURN for all): ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC("W")="",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC ;PRS*4*127
G:$D(DTOUT) EX I DFN<1,X'="" G EX
D1 K %DT S %DT="AEX",%DT("A")="Begin with Date: " W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S SDT=Y
K %DT S %DT="AEX",%DT("A")="End with Date: " W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=Y
I SDT>EDT W *7,!?5,"Starting Date cannot be later than Ending Date!" G D1
D2 S SRT="E" I DFN<1 R !!,"Sort by: (E=Employee D=Date) E// ",SRT:DTIME G:'$T!(SRT["^") EX S:SRT="" SRT="E" S SRT=$TR(SRT,"de","DE") I SRT'?1U!("DE"'[SRT) W *7," Enter E or D" G D2
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^PRSALVL",PRSALST="DFN^TLE^SDT^EDT^SRT" D QUE^PRSAUTL G EX
U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
Q1 K ^TMP($J) I DFN>0 S NN=$P($G(^PRSPC(DFN,0)),"^",1) D Q2 G P1
S NN="" F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 D Q2
G P1
Q2 S LST=9999999-SDT
F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>LST) F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,DTI,DA)) Q:DA="" I $G(^(DA))'>EDT D Q3
Q
Q3 I $P($G(^PRST(458.1,DA,0)),"^",9)="X" Q
S Z=$P($G(^PRST(458.1,DA,0)),"^",3) I SRT="E" S ^TMP($J,NN_"~"_DFN,+Z,DA)="" Q
S ^TMP($J,+Z,NN_"~"_DFN,DA)="" Q
P1 S (PG,QT)=0 D HDR S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3)
S N1="" F S N1=$O(^TMP($J,N1)) Q:N1="" S HDR=0,N2="" F S N2=$O(^TMP($J,N1,N2)) Q:N2="" F DA=0:0 S DA=$O(^TMP($J,N1,N2,DA)) Q:DA="" D LST G:QT EX
D H1 G EX
LST ; Display Request
S DFN=$P($S(SRT="E":N1,1:N2),"~",2),Y0=$G(^PRSPC(DFN,0)) I HDR G:$Y'>(IOSL-3) L1 D HDR Q:QT
D:$Y>(IOSL-6) HDR Q:QT S HDR=1
I SRT="E" W !!,$P(Y0,"^",1) S X=$P(Y0,"^",9) D G L1
. I PRSTLV=2!(PRSTLV=3) W ?50,$E(X),"XX-XX-",$E(X,6,9)
. I PRSTLV=7 W ?50,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9)
S X=N1 D DTP W !!,Y
L1 ; List item
S Z=$G(^PRST(458.1,DA,0)) Q:Z="" S SCOM=$P($G(^(1)),"^",1)
I SRT="D" W !?3,$P(Y0,"^",1)," ",$P(Z,"^",4)
E W !?3,$P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP W Y
W " to ",$P(Z,"^",6)," " S X=$P(Z,"^",5) D DTP W Y," "
I SRT="E" 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 S Y=$P(Z,"^",11) D DTP^PRSAUDP W !?5,"Requested: ",Y
W:SCOM'="" !?5,"Supr: ",SCOM Q
DTP ; Printable Date
S Y=$J(+$E(X,6,7),2)_"-"_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$E(X,4,5))_"-"_$E(X,2,3)
Q
HDR ; Display Header
D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
S PG=PG+1,HDR=0 W !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
W !?28,"T&L ",TLE," LEAVE REQUESTS"
S X=SDT D DTP W !!?27,"From ",Y S X=EDT D DTP W " to ",Y Q
H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
Q
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSALVL 3392 printed Nov 22, 2024@17:33:40 Page 2
PRSALVL ; HISC/REL-Display Leave Requests ;1/24/96 13:56
+1 ;;4.0;PAID;**9,114,127**;Sep 21, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
TK ; TimeKeeper Entry
+1 SET PRSTLV=2
GOTO TL
SUP ; Supervisor Entry
+1 SET PRSTLV=3
GOTO TL
PAY ; Payroll Entry
+1 SET PRSTLV=7
GOTO TL
TL DO ^PRSAUTL
if TLI<1
GOTO EX
+1 ;PRS*4*127
KILL DIC
SET DIC("A")="Select EMPLOYEE (or RETURN for all): "
SET DIC("S")="I $P(^(0),""^"",8)=TLE"
SET DIC("W")=""
SET DIC(0)="AEQM"
SET DIC="^PRSPC("
SET D="ATL"_TLE
WRITE !
DO IX^DIC
SET DFN=+Y
KILL DIC
+2 if $DATA(DTOUT)
GOTO EX
IF DFN<1
IF X'=""
GOTO EX
D1 KILL %DT
SET %DT="AEX"
SET %DT("A")="Begin with Date: "
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO EX
SET SDT=Y
+1 KILL %DT
SET %DT="AEX"
SET %DT("A")="End with Date: "
WRITE !
DO ^%DT
KILL %DT
if $DATA(DTOUT)
SET Y=0
if Y<1
GOTO EX
SET EDT=Y
+2 IF SDT>EDT
WRITE *7,!?5,"Starting Date cannot be later than Ending Date!"
GOTO D1
D2 SET SRT="E"
IF DFN<1
READ !!,"Sort by: (E=Employee D=Date) E// ",SRT:DTIME
if '$TEST!(SRT["^")
GOTO EX
if SRT=""
SET SRT="E"
SET SRT=$TRANSLATE(SRT,"de","DE")
IF SRT'?1U!("DE"'[SRT)
WRITE *7," Enter E or D"
GOTO D2
+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^PRSALVL"
SET PRSALST="DFN^TLE^SDT^EDT^SRT"
DO QUE^PRSAUTL
GOTO EX
+3 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO EX
Q1 KILL ^TMP($JOB)
IF DFN>0
SET NN=$PIECE($GET(^PRSPC(DFN,0)),"^",1)
DO Q2
GOTO P1
+1 SET NN=""
FOR
SET NN=$ORDER(^PRSPC("ATL"_TLE,NN))
if NN=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PRSPC("ATL"_TLE,NN,DFN))
if DFN<1
QUIT
DO Q2
+2 GOTO P1
Q2 SET LST=9999999-SDT
+1 FOR DTI=0:0
SET DTI=$ORDER(^PRST(458.1,"AD",DFN,DTI))
if DTI=""!(DTI>LST)
QUIT
FOR DA=0:0
SET DA=$ORDER(^PRST(458.1,"AD",DFN,DTI,DA))
if DA=""
QUIT
IF $GET(^(DA))'>EDT
DO Q3
+2 QUIT
Q3 IF $PIECE($GET(^PRST(458.1,DA,0)),"^",9)="X"
QUIT
+1 SET Z=$PIECE($GET(^PRST(458.1,DA,0)),"^",3)
IF SRT="E"
SET ^TMP($JOB,NN_"~"_DFN,+Z,DA)=""
QUIT
+2 SET ^TMP($JOB,+Z,NN_"~"_DFN,DA)=""
QUIT
P1 SET (PG,QT)=0
DO HDR
SET LVT=";"_$PIECE(^DD(458.1,6,0),"^",3)
SET LVS=";"_$PIECE(^DD(458.1,8,0),"^",3)
+1 SET N1=""
FOR
SET N1=$ORDER(^TMP($JOB,N1))
if N1=""
QUIT
SET HDR=0
SET N2=""
FOR
SET N2=$ORDER(^TMP($JOB,N1,N2))
if N2=""
QUIT
FOR DA=0:0
SET DA=$ORDER(^TMP($JOB,N1,N2,DA))
if DA=""
QUIT
DO LST
if QT
GOTO EX
+2 DO H1
GOTO EX
LST ; Display Request
+1 SET DFN=$PIECE($SELECT(SRT="E":N1,1:N2),"~",2)
SET Y0=$GET(^PRSPC(DFN,0))
IF HDR
if $Y'>(IOSL-3)
GOTO L1
DO HDR
if QT
QUIT
+2 if $Y>(IOSL-6)
DO HDR
if QT
QUIT
SET HDR=1
+3 IF SRT="E"
WRITE !!,$PIECE(Y0,"^",1)
SET X=$PIECE(Y0,"^",9)
Begin DoDot:1
+4 IF PRSTLV=2!(PRSTLV=3)
WRITE ?50,$EXTRACT(X),"XX-XX-",$EXTRACT(X,6,9)
+5 IF PRSTLV=7
WRITE ?50,$EXTRACT(X,1,3),"-",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,9)
End DoDot:1
GOTO L1
+6 SET X=N1
DO DTP
WRITE !!,Y
L1 ; List item
+1 SET Z=$GET(^PRST(458.1,DA,0))
if Z=""
QUIT
SET SCOM=$PIECE($GET(^(1)),"^",1)
+2 IF SRT="D"
WRITE !?3,$PIECE(Y0,"^",1)," ",$PIECE(Z,"^",4)
+3 IF '$TEST
WRITE !?3,$PIECE(Z,"^",4)," "
SET X=$PIECE(Z,"^",3)
DO DTP
WRITE Y
+4 WRITE " to ",$PIECE(Z,"^",6)," "
SET X=$PIECE(Z,"^",5)
DO DTP
WRITE Y," "
+5 IF SRT="E"
SET X=$PIECE(Z,"^",15)
IF X
WRITE X," ",$SELECT($PIECE(Z,"^",16)="D":"days",1:"hrs")," "
+6 SET X=$PIECE(Z,"^",7)
SET %=$FIND(LVT,";"_X_":")
IF %>0
WRITE $PIECE($EXTRACT(LVT,%,999),";",1)," "
+7 SET X=$PIECE(Z,"^",9)
+8 SET %=$FIND(LVS,";"_X_":")
IF %>0
WRITE $PIECE($EXTRACT(LVS,%,999),";",1)
+9 SET X=$PIECE(Z,"^",8)
if X'=""
WRITE !?5,X
SET Y=$PIECE(Z,"^",11)
DO DTP^PRSAUDP
WRITE !?5,"Requested: ",Y
+10 if SCOM'=""
WRITE !?5,"Supr: ",SCOM
QUIT
DTP ; Printable Date
+1 SET Y=$JUSTIFY(+$EXTRACT(X,6,7),2)_"-"_$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$EXTRACT(X,4,5))_"-"_$EXTRACT(X,2,3)
+2 QUIT
HDR ; Display Header
+1 DO H1
if QT
QUIT
if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
+2 SET PG=PG+1
SET HDR=0
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
+3 WRITE !?28,"T&L ",TLE," LEAVE REQUESTS"
+4 SET X=SDT
DO DTP
WRITE !!?27,"From ",Y
SET X=EDT
DO DTP
WRITE " to ",Y
QUIT
H1 IF PG
IF $EXTRACT(IOST,1,2)="C-"
READ !!,"Press RETURN to Continue.",X:DTIME
if '$TEST!(X["^")
SET QT=1
+1 QUIT
EX GOTO KILL^XUSCLEAN
