PRSAOTX ; HISC/REL-OT/CT Approvals ;5/23/95 12:55
;;4.0;PAID;**34,114,110**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
S (QT,NF)=0,PRSTLV=3 K ^TMP($J)
S TLE="" F S TLE=$O(^PRST(455.5,"B",TLE)) Q:TLE="" S TLH=0 F TLI=0:0 S TLI=$O(^PRST(455.5,"B",TLE,TLI)) Q:TLI<1 I $D(^PRST(455.5,TLI,"A",DUZ)) D TLC I QT G ES
ES I '$D(^TMP($J)) W !!,$S('NF:"No Overtime or Comp/Credit actions to certify.",1:"No Overtime or Comp/Credit certification actions taken.") G EX
D ^PRSAES G:'ESOK EX D NOW^%DTC S NOW=%
F TLI=0:0 S TLI=$O(^TMP($J,TLI)) Q:TLI<1 S ACT=$G(^(TLI)) I ACT'="" F DA=0:0 S DA=$O(^TMP($J,TLI,DA)) Q:DA<1 S DFN=$G(^(DA)) D OT
G EX
TLC ; Check T&L
S (ECST,NUM)=0 K R
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 I $D(^PRST(458.2,"AS",DFN)) D CHK I QT G T1
Q:'$D(^TMP($J,TLI)) I ECST W !!,"Estimated Cost of Overtime: $",$J(ECST,0,2)
OK R !!,"Disposition (A=Approve, D=Disapprove, X=Dis. Line Item, RETURN to bypass): ",ACT:DTIME S:'$T!(ACT["^") QT=1 G:QT!(ACT="") T1 S ACT=$TR(ACT,"adx","ADX") I ACT'?1U!("ADX"'[ACT) W *7,!,"Enter A, D or X or Press RETURN to bypass" G OK
I ACT="X" D CAN G:Y["^" T1 S ACT="A"
S ^TMP($J,TLI)=ACT Q
T1 K ^TMP($J,TLI) Q
CHK ; Check for needed approvals
F DA=0:0 S DA=$O(^PRST(458.2,"AS",DFN,DA)) Q:DA<1 D LST Q:QT S ^TMP($J,TLI,DA)=DFN
Q
OT ; Process action
S X=ESNAM,X1=DUZ,X2=DA D EN^XUSHSHP
S $P(^PRST(458.2,DA,0),"^",8)=$S($P(DFN,"^",2)="D":"D",1:ACT) K ^PRST(458.2,"AS",+DFN,DA)
S $P(^PRST(458.2,DA,0),"^",16,18)=DUZ_"^"_NOW_"^"_X Q
LST ; Display Request
S Z=$G(^PRST(458.2,DA,0)) Q:Z="" D:'TLH HDR D:$Y>(IOSL-4) HDR Q:QT
S NUM=NUM+1,X=$P(Z,"^",3) D DTP^PRSAPPU S R(NUM)=DA
W !,$J(NUM,2)," ",Y," ",$P($G(^PRSPC(DFN,0)),"^",1),?42,$P(Z,"^",6)," Hrs. ",$S($P(Z,"^",5)="CT":"COMP TIME/CREDIT HRS",1:"OVERTIME")
I $P(Z,"^",5)="OT",$P(Z,"^",10) S ECST=ECST+$P(Z,"^",10)
S X=$P(Z,"^",9) I X'="" W " on T&L ",X
S Y=$P(Z,"^",7) W:Y'="" !?10,Y S NF=NF+1 Q
HDR ; Display Header
I TLH R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1 Q:QT
W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM",!?21,"OVERTIME & COMP TIME/CREDIT HRS APPROVAL"
S Z0=$G(^PRST(455.5,TLI,0)),Z1=$P(Z0,"^",5),Z1=$P($G(^DIC(49,+Z1,0)),"^",1) I $P(Z0,"^",6)'="" S Z1=Z1_", "_$P(Z0,"^",6)
S Z1=$P(Z0,"^",1)_" "_Z1 W !!?(80-$L(Z1)\2),Z1,! S TLH=1 Q
CAN ; Process selective disapproval
R !,"Disapprove which Items: ",Y:DTIME I '$T!(Y["^") S K1=0 Q
F K=1:1 S K1=$P(Y,",",K) Q:K1="" S K2=$S(K1["-":$P(K1,"-",2),1:+K1),K1=+K1 D G:'K1 CAN F K3=K1:1:K2 S DA=$G(R(K3)) I DA S $P(^TMP($J,TLI,DA),"^",2)="D"
.I K1'<1,K1'>NUM,K1?1N.N Q
.I K2'<1,K2'>NUM,K2?1N.N Q
.W *7,!," Enter Numbers, or Range of Items (e.g., 1,3-5,7)"
.S K1=0 Q
Q
EX F TLI=0:0 S TLI=$O(^TMP($J,TLI)) Q:TLI<1 S TLE=$P($G(^PRST(455.5,TLI,0)),"^",1) D APP^PRSASAL
G ^PRSAPPX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAOTX 2947 printed Dec 13, 2024@02:23:50 Page 2
PRSAOTX ; HISC/REL-OT/CT Approvals ;5/23/95 12:55
+1 ;;4.0;PAID;**34,114,110**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET (QT,NF)=0
SET PRSTLV=3
KILL ^TMP($JOB)
+4 SET TLE=""
FOR
SET TLE=$ORDER(^PRST(455.5,"B",TLE))
if TLE=""
QUIT
SET TLH=0
FOR TLI=0:0
SET TLI=$ORDER(^PRST(455.5,"B",TLE,TLI))
if TLI<1
QUIT
IF $DATA(^PRST(455.5,TLI,"A",DUZ))
DO TLC
IF QT
GOTO ES
ES IF '$DATA(^TMP($JOB))
WRITE !!,$SELECT('NF:"No Overtime or Comp/Credit actions to certify.",1:"No Overtime or Comp/Credit certification actions taken.")
GOTO EX
+1 DO ^PRSAES
if 'ESOK
GOTO EX
DO NOW^%DTC
SET NOW=%
+2 FOR TLI=0:0
SET TLI=$ORDER(^TMP($JOB,TLI))
if TLI<1
QUIT
SET ACT=$GET(^(TLI))
IF ACT'=""
FOR DA=0:0
SET DA=$ORDER(^TMP($JOB,TLI,DA))
if DA<1
QUIT
SET DFN=$GET(^(DA))
DO OT
+3 GOTO EX
TLC ; Check T&L
+1 SET (ECST,NUM)=0
KILL R
+2 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
IF $DATA(^PRST(458.2,"AS",DFN))
DO CHK
IF QT
GOTO T1
+3 if '$DATA(^TMP($JOB,TLI))
QUIT
IF ECST
WRITE !!,"Estimated Cost of Overtime: $",$JUSTIFY(ECST,0,2)
OK READ !!,"Disposition (A=Approve, D=Disapprove, X=Dis. Line Item, RETURN to bypass): ",ACT:DTIME
if '$TEST!(ACT["^")
SET QT=1
if QT!(ACT="")
GOTO T1
SET ACT=$TRANSLATE(ACT,"adx","ADX")
IF ACT'?1U!("ADX"'[ACT)
WRITE *7,!,"Enter A, D or X or Press RETURN to bypass"
GOTO OK
+1 IF ACT="X"
DO CAN
if Y["^"
GOTO T1
SET ACT="A"
+2 SET ^TMP($JOB,TLI)=ACT
QUIT
T1 KILL ^TMP($JOB,TLI)
QUIT
CHK ; Check for needed approvals
+1 FOR DA=0:0
SET DA=$ORDER(^PRST(458.2,"AS",DFN,DA))
if DA<1
QUIT
DO LST
if QT
QUIT
SET ^TMP($JOB,TLI,DA)=DFN
+2 QUIT
OT ; Process action
+1 SET X=ESNAM
SET X1=DUZ
SET X2=DA
DO EN^XUSHSHP
+2 SET $PIECE(^PRST(458.2,DA,0),"^",8)=$SELECT($PIECE(DFN,"^",2)="D":"D",1:ACT)
KILL ^PRST(458.2,"AS",+DFN,DA)
+3 SET $PIECE(^PRST(458.2,DA,0),"^",16,18)=DUZ_"^"_NOW_"^"_X
QUIT
LST ; Display Request
+1 SET Z=$GET(^PRST(458.2,DA,0))
if Z=""
QUIT
if 'TLH
DO HDR
if $Y>(IOSL-4)
DO HDR
if QT
QUIT
+2 SET NUM=NUM+1
SET X=$PIECE(Z,"^",3)
DO DTP^PRSAPPU
SET R(NUM)=DA
+3 WRITE !,$JUSTIFY(NUM,2)," ",Y," ",$PIECE($GET(^PRSPC(DFN,0)),"^",1),?42,$PIECE(Z,"^",6)," Hrs. ",$SELECT($PIECE(Z,"^",5)="CT":"COMP TIME/CREDIT HRS",1:"OVERTIME")
+4 IF $PIECE(Z,"^",5)="OT"
IF $PIECE(Z,"^",10)
SET ECST=ECST+$PIECE(Z,"^",10)
+5 SET X=$PIECE(Z,"^",9)
IF X'=""
WRITE " on T&L ",X
+6 SET Y=$PIECE(Z,"^",7)
if Y'=""
WRITE !?10,Y
SET NF=NF+1
QUIT
HDR ; Display Header
+1 IF TLH
READ !!,"Press RETURN to Continue.",X:DTIME
if '$TEST!(X["^")
SET QT=1
if QT
QUIT
+2 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",!?21,"OVERTIME & COMP TIME/CREDIT HRS APPROVAL"
+3 SET Z0=$GET(^PRST(455.5,TLI,0))
SET Z1=$PIECE(Z0,"^",5)
SET Z1=$PIECE($GET(^DIC(49,+Z1,0)),"^",1)
IF $PIECE(Z0,"^",6)'=""
SET Z1=Z1_", "_$PIECE(Z0,"^",6)
+4 SET Z1=$PIECE(Z0,"^",1)_" "_Z1
WRITE !!?(80-$LENGTH(Z1)\2),Z1,!
SET TLH=1
QUIT
CAN ; Process selective disapproval
+1 READ !,"Disapprove which Items: ",Y:DTIME
IF '$TEST!(Y["^")
SET K1=0
QUIT
+2 FOR K=1:1
SET K1=$PIECE(Y,",",K)
if K1=""
QUIT
SET K2=$SELECT(K1["-":$PIECE(K1,"-",2),1:+K1)
SET K1=+K1
Begin DoDot:1
+3 IF K1'<1
IF K1'>NUM
IF K1?1N.N
QUIT
+4 IF K2'<1
IF K2'>NUM
IF K2?1N.N
QUIT
+5 WRITE *7,!," Enter Numbers, or Range of Items (e.g., 1,3-5,7)"
+6 SET K1=0
QUIT
End DoDot:1
if 'K1
GOTO CAN
FOR K3=K1:1:K2
SET DA=$GET(R(K3))
IF DA
SET $PIECE(^TMP($JOB,TLI,DA),"^",2)="D"
+7 QUIT
EX FOR TLI=0:0
SET TLI=$ORDER(^TMP($JOB,TLI))
if TLI<1
QUIT
SET TLE=$PIECE($GET(^PRST(455.5,TLI,0)),"^",1)
DO APP^PRSASAL
+1 GOTO ^PRSAPPX
