PRSATPX ; HISC/REL-Time Exceptions ;8/23/94 11:12
;;4.0;PAID;;Sep 21, 1995
TK0 ; TimeKeeper Entry - Posting date
S PRSTLV=2,ALL=0 G TL
TK1 ; TimeKeeper Entry - Payperiod to date
S PRSTLV=2,ALL=1 G TL
SUP0 ; Supervisor Entry - Posting date
S PRSTLV=3,ALL=0 G TL
SUP1 ; Supervisor Entry - PayPeriod to date
S PRSTLV=3,ALL=1 G TL
TL D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT
S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT
G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX
I ALL,$P($G(^PRST(458,PPI,1)),"^",14)<DT S DAY=14
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^PRSATPX",PRSALST="PPI^DAY^ALL^TLE" D QUE^PRSAUTL G EX
U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
Q1 ; Process Exception List
S PPE=$P($G(^PRST(458,PPI,0)),"^",1),PDT=$G(^PRST(458,PPI,2)),DTE=$P(PDT,"^",DAY),QT=0
I ALL S DTE=$P(PDT,"^",1)_" to "_DTE
S (PG,CNT,HDR)=0 D HDR
S LP=1,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)) S HDR=0 F DAY=$S(ALL:1,1:DAY):1:DAY D FND I QT W ! G EX
W ! D CK,H1 G EX
CK W:'CNT !,"No Exceptions found.",! Q
FND D ^PRSATPE Q:'$D(ER) I 'HDR D:$Y>(IOSL-5) HDR Q:QT W !!,$P(^PRSPC(DFN,0),"^",1) S HDR=1
F K=0:0 S K=$O(ER(K)) Q:K<1 D:$Y>(IOSL-3) HDR Q:QT W !?5 W:ALL $P(PDT,"^",DAY)," " W:$P(ER(K),"^",2)'="" $P(ER(K),"^",2) W ?28,$P(ER(K),"^",1) S CNT=CNT+1
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 !?30,"T&L ",TLE," EXCEPTIONS"
W !!?(81-$L(DTE)\2),DTE W:HDR !!,$P(^PRSPC(DFN,0),"^",1) 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[HPRSATPX 1896 printed Oct 16, 2024@18:25:39 Page 2
PRSATPX ; HISC/REL-Time Exceptions ;8/23/94 11:12
+1 ;;4.0;PAID;;Sep 21, 1995
TK0 ; TimeKeeper Entry - Posting date
+1 SET PRSTLV=2
SET ALL=0
GOTO TL
TK1 ; TimeKeeper Entry - Payperiod to date
+1 SET PRSTLV=2
SET ALL=1
GOTO TL
SUP0 ; Supervisor Entry - Posting date
+1 SET PRSTLV=3
SET ALL=0
GOTO TL
SUP1 ; Supervisor Entry - PayPeriod to date
+1 SET PRSTLV=3
SET ALL=1
GOTO TL
TL DO ^PRSAUTL
if TLI<1
GOTO EX
SET %DT="X"
SET X="T+3"
DO ^%DT
+1 SET %DT="AEPX"
SET %DT("A")="Posting Date: "
SET %DT("B")="T-1"
SET %DT(0)=-Y
WRITE !
DO ^%DT
+2 if Y<1
GOTO EX
SET D1=Y
SET Y=$GET(^PRST(458,"AD",D1))
SET PPI=$PIECE(Y,"^",1)
SET DAY=$PIECE(Y,"^",2)
+3 IF PPI=""
WRITE !!,*7,"Pay Period is Not Open Yet!"
GOTO EX
+4 IF ALL
IF $PIECE($GET(^PRST(458,PPI,1)),"^",14)<DT
SET DAY=14
+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^PRSATPX"
SET PRSALST="PPI^DAY^ALL^TLE"
DO QUE^PRSAUTL
GOTO EX
+7 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO EX
Q1 ; Process Exception List
+1 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)
SET PDT=$GET(^PRST(458,PPI,2))
SET DTE=$PIECE(PDT,"^",DAY)
SET QT=0
+2 IF ALL
SET DTE=$PIECE(PDT,"^",1)_" to "_DTE
+3 SET (PG,CNT,HDR)=0
DO HDR
+4 SET LP=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))
SET HDR=0
FOR DAY=$SELECT(ALL:1,1:DAY):1:DAY
DO FND
IF QT
WRITE !
GOTO EX
+5 WRITE !
DO CK
DO H1
GOTO EX
CK if 'CNT
WRITE !,"No Exceptions found.",!
QUIT
FND DO ^PRSATPE
if '$DATA(ER)
QUIT
IF 'HDR
if $Y>(IOSL-5)
DO HDR
if QT
QUIT
WRITE !!,$PIECE(^PRSPC(DFN,0),"^",1)
SET HDR=1
+1 FOR K=0:0
SET K=$ORDER(ER(K))
if K<1
QUIT
if $Y>(IOSL-3)
DO HDR
if QT
QUIT
WRITE !?5
if ALL
WRITE $PIECE(PDT,"^",DAY)," "
if $PIECE(ER(K),"^",2)'=""
WRITE $PIECE(ER(K),"^",2)
WRITE ?28,$PIECE(ER(K),"^",1)
SET CNT=CNT+1
+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
WRITE !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
+3 WRITE !?30,"T&L ",TLE," EXCEPTIONS"
+4 WRITE !!?(81-$LENGTH(DTE)\2),DTE
if HDR
WRITE !!,$PIECE(^PRSPC(DFN,0),"^",1)
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
