- 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 Feb 18, 2025@23:50:15 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
