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 Apr 09, 2024@21:29:48 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
