- PRSASU ; HISC/REL-Supervisor Un-Certified List ;8/23/94 09:43
- ;;4.0;PAID;**114**;Sep 21, 1995;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- TK ; TimeKeeper Entry
- S PRSTLV=2 G S1
- SUP ; Supervisor Entry
- S PRSTLV=3 G S1
- PAY ; Payroll Entry
- S PRSTLV=7 G S1
- S1 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
- W !?29,"UN-CERTIFIED EMPLOYEES"
- D ^PRSAUTL G:TLI<1 EX
- D NOW^%DTC S DT=%\1,Y=$G(^PRST(458,"AD",DT)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
- I DAY<6 S X1=DT,X2=-7 D C^%DTC S PPI=$P($G(^PRST(458,"AD",X)),"^",1) G:'PPI EX
- 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^PRSASU",PRSALST="TLI^TLE^PPI" D QUE^PRSAUTL G EX
- U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
- Q1 S PDT=$G(^PRST(458,PPI,2)),PDTI=$G(^(1)),(QT,PG,CNT)=0 D HDR
- 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,PPI,"E",DFN,0)) D CHK I QT G T0
- D CK,H1
- T0 G EX
- CK W:'CNT !!,"No Un-Certified Employees found." Q
- CHK ; Check for needed approvals
- S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I STAT'="","PX"[STAT Q
- I $Y>(IOSL-5) D HDR Q:QT
- S X0=$G(^PRSPC(DFN,0)),SSN=$P(X0,"^",9),CNT=CNT+1
- I PRSTLV=2!(PRSTLV=3) W !,$E(SSN),"XX-XX-",$E(SSN,6,9)," ",$P(X0,"^",1)
- I PRSTLV=7 W !,$E(SSN,1,3),"-",$E(SSN,4,5),"-",$E(SSN,6,9)," ",$P(X0,"^",1)
- I SSN S EDUZ=+$O(^VA(200,"SSN",SSN,0)) I $D(^PRST(455.5,"AS",EDUZ,TLI)) S Z0=$P($G(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2) I Z0'="",Z0'=TLE W " Is Certified by T&L ",Z0
- Q
- HDR ; Display Header
- D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
- S PG=PG+1 W !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
- W !?29,"UN-CERTIFIED EMPLOYEES"
- 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 Z0=$P(PDT,"^",1)_" to "_$P(PDT,"^",14) W !!?(80-$L(Z0)\2),Z0,! 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[HPRSASU 2098 printed Jan 18, 2025@03:25:32 Page 2
- PRSASU ; HISC/REL-Supervisor Un-Certified List ;8/23/94 09:43
- +1 ;;4.0;PAID;**114**;Sep 21, 1995;Build 6
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- TK ; TimeKeeper Entry
- +1 SET PRSTLV=2
- GOTO S1
- SUP ; Supervisor Entry
- +1 SET PRSTLV=3
- GOTO S1
- PAY ; Payroll Entry
- +1 SET PRSTLV=7
- GOTO S1
- S1 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !?26,"VA TIME & ATTENDANCE SYSTEM"
- +1 WRITE !?29,"UN-CERTIFIED EMPLOYEES"
- +2 DO ^PRSAUTL
- if TLI<1
- GOTO EX
- +3 DO NOW^%DTC
- SET DT=%\1
- SET Y=$GET(^PRST(458,"AD",DT))
- SET PPI=$PIECE(Y,"^",1)
- SET DAY=$PIECE(Y,"^",2)
- +4 IF DAY<6
- SET X1=DT
- SET X2=-7
- DO C^%DTC
- SET PPI=$PIECE($GET(^PRST(458,"AD",X)),"^",1)
- if 'PPI
- GOTO EX
- +5 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select Device: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO EX
- +6 IF $DATA(IO("Q"))
- SET PRSAPGM="Q1^PRSASU"
- SET PRSALST="TLI^TLE^PPI"
- DO QUE^PRSAUTL
- GOTO EX
- +7 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO EX
- Q1 SET PDT=$GET(^PRST(458,PPI,2))
- SET PDTI=$GET(^(1))
- SET (QT,PG,CNT)=0
- DO HDR
- +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
- IF $DATA(^PRST(458,PPI,"E",DFN,0))
- DO CHK
- IF QT
- GOTO T0
- +2 DO CK
- DO H1
- T0 GOTO EX
- CK if 'CNT
- WRITE !!,"No Un-Certified Employees found."
- QUIT
- CHK ; Check for needed approvals
- +1 SET STAT=$PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)
- IF STAT'=""
- IF "PX"[STAT
- QUIT
- +2 IF $Y>(IOSL-5)
- DO HDR
- if QT
- QUIT
- +3 SET X0=$GET(^PRSPC(DFN,0))
- SET SSN=$PIECE(X0,"^",9)
- SET CNT=CNT+1
- +4 IF PRSTLV=2!(PRSTLV=3)
- WRITE !,$EXTRACT(SSN),"XX-XX-",$EXTRACT(SSN,6,9)," ",$PIECE(X0,"^",1)
- +5 IF PRSTLV=7
- WRITE !,$EXTRACT(SSN,1,3),"-",$EXTRACT(SSN,4,5),"-",$EXTRACT(SSN,6,9)," ",$PIECE(X0,"^",1)
- +6 IF SSN
- SET EDUZ=+$ORDER(^VA(200,"SSN",SSN,0))
- IF $DATA(^PRST(455.5,"AS",EDUZ,TLI))
- SET Z0=$PIECE($GET(^PRST(455.5,TLI,"S",EDUZ,0)),"^",2)
- IF Z0'=""
- IF Z0'=TLE
- WRITE " Is Certified by T&L ",Z0
- +7 QUIT
- HDR ; Display Header
- +1 DO H1
- if QT
- QUIT
- if '($EXTRACT(IOST,1,2)'="C-"&'PG)
- WRITE @IOF
- +2 SET PG=PG+1
- WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
- +3 WRITE !?29,"UN-CERTIFIED EMPLOYEES"
- +4 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)
- +5 SET Z1=$PIECE(Z0,"^",1)_" "_Z1
- WRITE !!?(80-$LENGTH(Z1)\2),Z1
- +6 SET Z0=$PIECE(PDT,"^",1)_" to "_$PIECE(PDT,"^",14)
- WRITE !!?(80-$LENGTH(Z0)\2),Z0,!
- 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