PRSAPEX ; HISC/REL-Pay Period Exceptions ; 3-27-1998
;;4.0;PAID;**37,43**;Sep 21, 1995
K DIC S DIC="^PRST(458,",DIC(0)="AEQM",DIC("A")="Select PAY PERIOD: " W ! D ^DIC K DIC G:Y<1 EX S PPI=+Y
T0 R !!,"Select T&L Unit (or ALL): ",X:DTIME G:'$T!("^"[X) EX S X=$TR(X,"al","AL") I X="ALL" S TLE="" G L1
K DIC S DIC="^PRST(455.5,",DIC(0)="EMQ" D ^DIC G EX:$D(DTOUT),T0:Y<1
S TLE=$P(Y,"^",2)
L1 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^PRSAPEX",PRSALST="PPI^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)),QT=0
S DTE=$P(PDT,"^",1)_" to "_$P(PDT,"^",14),PG=0,HDR=0 D HDR
I TLE'="" S ATL="ATL"_TLE,TL=TLE D Q10 D:'QT H1 Q
S ATL="ATL00"
F S ATL=$O(^PRSPC(ATL)) Q:ATL'?1"ATL".E S TLE=$E(ATL,4,6) D Q10 Q:QT
D:'QT H1 Q
Q10 S NN=""
F S NN=$O(^PRSPC(ATL,NN)) Q:NN="" D Q:QT
. S HDR=0
. F DFN=0:0 S DFN=$O(^PRSPC(ATL,NN,DFN)) Q:DFN<1 D Q:QT
.. Q:'$D(^PRST(458,PPI,"E",DFN,"D",0))
.. F DAY=1:1:14 D FND Q:QT
..;
..; If timecard status is other than Timekeeper & a TT8b is on file
..; then compare calculated OT in TT8B to approved OT in request file.
..; Display & file OT warning if existing warning is not cleared.
..;
.. N TT8B,STATUS,WEEK,OT8B,OTAPP
.. S TT8B=$G(^PRST(458,PPI,"E",DFN,5)),STATUS=$P($G(^(0)),"^",2)
.. Q:(STATUS="T")!(TT8B="")
.. F WEEK=1:1:2 D
... I $$CHECKOT(PPI,WEEK,DFN) D
.... D GETOTS^PRSAOTT(PPE,DFN,TT8B,WEEK,.OT8B,.OTAPP)
.... I OTAPP<OT8B D
..... D OTDISP(DFN,OT8B,OTAPP,WEEK)
..... D FILEOTW^PRSAOTTF(PPI,DFN,WEEK,OT8B,OTAPP)
Q
;
CHECKOT(P,W,E) ;DETERMINE WHETHER TO DO THE OT CHECK
;
;input: P--pay period ien, W--week 1 or 2 of pp, E--emp 450 ien
;return: true or false as described below.
S CHECK=1
;
;If no warning on file do OT warnings check (return true).
;
;If warning on file for this pay per, week, employee (P,W,E)
;and status of warning is cleared then don't recheck or display
;any warning (return false). A status of cleared indicates
;payroll has cleared the warning to remove it from display.
;
S WRNIEN=$$WRNEXIST^PRSAOTTF(P,E,W)
Q:'WRNIEN CHECK
;
Q:$P($G(^PRST(458.6,WRNIEN,0)),"^",5)'="C" CHECK
Q 0
;
FND D ^PRSATPE Q:'$D(ER)
I 'HDR D:$Y>(IOSL-5) HDR Q:QT W !!,$P(^PRSPC(DFN,0),"^",1)," (",TLE,")" S HDR=1
F K=0:0 S K=$O(ER(K)) Q:K<1 D:$Y>(IOSL-3) HDR Q:QT W !?5,$P(PDT,"^",DAY)," " W:$P(ER(K),"^",2)'="" $P(ER(K),"^",2) W ?28,$P(ER(K),"^",1)
Q
OTDISP(DFN,OT8B,OTAPP,WEEK) ;
I 'HDR D:$Y>(IOSL-5) HDR Q:QT W !!,$P(^PRSPC(DFN,0),"^",1)," (",TLE,")" S HDR=1
D:$Y>(IOSL-3) HDR Q:QT D DISPLAY^PRSAOTT(DFN,OT8B,OTAPP,WEEK)
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 !!?(81-$L(DTE)\2),DTE W:HDR !!,$P(^PRSPC(DFN,0),"^",1)," (",TLE,")" 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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAPEX 3147 printed Oct 16, 2024@18:24:38 Page 2
PRSAPEX ; HISC/REL-Pay Period Exceptions ; 3-27-1998
+1 ;;4.0;PAID;**37,43**;Sep 21, 1995
+2 KILL DIC
SET DIC="^PRST(458,"
SET DIC(0)="AEQM"
SET DIC("A")="Select PAY PERIOD: "
WRITE !
DO ^DIC
KILL DIC
if Y<1
GOTO EX
SET PPI=+Y
T0 READ !!,"Select T&L Unit (or ALL): ",X:DTIME
if '$TEST!("^"[X)
GOTO EX
SET X=$TRANSLATE(X,"al","AL")
IF X="ALL"
SET TLE=""
GOTO L1
+1 KILL DIC
SET DIC="^PRST(455.5,"
SET DIC(0)="EMQ"
DO ^DIC
if $DATA(DTOUT)
GOTO EX
if Y<1
GOTO T0
+2 SET TLE=$PIECE(Y,"^",2)
L1 WRITE !
KILL IOP,%ZIS
SET %ZIS("A")="Select Device: "
SET %ZIS="MQ"
DO ^%ZIS
KILL %ZIS,IOP
if POP
GOTO EX
+1 IF $DATA(IO("Q"))
SET PRSAPGM="Q1^PRSAPEX"
SET PRSALST="PPI^TLE"
DO QUE^PRSAUTL
GOTO EX
+2 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 QT=0
+2 SET DTE=$PIECE(PDT,"^",1)_" to "_$PIECE(PDT,"^",14)
SET PG=0
SET HDR=0
DO HDR
+3 IF TLE'=""
SET ATL="ATL"_TLE
SET TL=TLE
DO Q10
if 'QT
DO H1
QUIT
+4 SET ATL="ATL00"
+5 FOR
SET ATL=$ORDER(^PRSPC(ATL))
if ATL'?1"ATL".E
QUIT
SET TLE=$EXTRACT(ATL,4,6)
DO Q10
if QT
QUIT
+6 if 'QT
DO H1
QUIT
Q10 SET NN=""
+1 FOR
SET NN=$ORDER(^PRSPC(ATL,NN))
if NN=""
QUIT
Begin DoDot:1
+2 SET HDR=0
+3 FOR DFN=0:0
SET DFN=$ORDER(^PRSPC(ATL,NN,DFN))
if DFN<1
QUIT
Begin DoDot:2
+4 if '$DATA(^PRST(458,PPI,"E",DFN,"D",0))
QUIT
+5 FOR DAY=1:1:14
DO FND
if QT
QUIT
+6 ;
+7 ; If timecard status is other than Timekeeper & a TT8b is on file
+8 ; then compare calculated OT in TT8B to approved OT in request file.
+9 ; Display & file OT warning if existing warning is not cleared.
+10 ;
+11 NEW TT8B,STATUS,WEEK,OT8B,OTAPP
+12 SET TT8B=$GET(^PRST(458,PPI,"E",DFN,5))
SET STATUS=$PIECE($GET(^(0)),"^",2)
+13 if (STATUS="T")!(TT8B="")
QUIT
+14 FOR WEEK=1:1:2
Begin DoDot:3
+15 IF $$CHECKOT(PPI,WEEK,DFN)
Begin DoDot:4
+16 DO GETOTS^PRSAOTT(PPE,DFN,TT8B,WEEK,.OT8B,.OTAPP)
+17 IF OTAPP<OT8B
Begin DoDot:5
+18 DO OTDISP(DFN,OT8B,OTAPP,WEEK)
+19 DO FILEOTW^PRSAOTTF(PPI,DFN,WEEK,OT8B,OTAPP)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
if QT
QUIT
End DoDot:1
if QT
QUIT
+20 QUIT
+21 ;
CHECKOT(P,W,E) ;DETERMINE WHETHER TO DO THE OT CHECK
+1 ;
+2 ;input: P--pay period ien, W--week 1 or 2 of pp, E--emp 450 ien
+3 ;return: true or false as described below.
+4 SET CHECK=1
+5 ;
+6 ;If no warning on file do OT warnings check (return true).
+7 ;
+8 ;If warning on file for this pay per, week, employee (P,W,E)
+9 ;and status of warning is cleared then don't recheck or display
+10 ;any warning (return false). A status of cleared indicates
+11 ;payroll has cleared the warning to remove it from display.
+12 ;
+13 SET WRNIEN=$$WRNEXIST^PRSAOTTF(P,E,W)
+14 if 'WRNIEN
QUIT CHECK
+15 ;
+16 if $PIECE($GET(^PRST(458.6,WRNIEN,0)),"^",5)'="C"
QUIT CHECK
+17 QUIT 0
+18 ;
FND DO ^PRSATPE
if '$DATA(ER)
QUIT
+1 IF 'HDR
if $Y>(IOSL-5)
DO HDR
if QT
QUIT
WRITE !!,$PIECE(^PRSPC(DFN,0),"^",1)," (",TLE,")"
SET HDR=1
+2 FOR K=0:0
SET K=$ORDER(ER(K))
if K<1
QUIT
if $Y>(IOSL-3)
DO HDR
if QT
QUIT
WRITE !?5,$PIECE(PDT,"^",DAY)," "
if $PIECE(ER(K),"^",2)'=""
WRITE $PIECE(ER(K),"^",2)
WRITE ?28,$PIECE(ER(K),"^",1)
+3 QUIT
OTDISP(DFN,OT8B,OTAPP,WEEK) ;
+1 IF 'HDR
if $Y>(IOSL-5)
DO HDR
if QT
QUIT
WRITE !!,$PIECE(^PRSPC(DFN,0),"^",1)," (",TLE,")"
SET HDR=1
+2 if $Y>(IOSL-3)
DO HDR
if QT
QUIT
DO DISPLAY^PRSAOTT(DFN,OT8B,OTAPP,WEEK)
+3 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 !!?(81-$LENGTH(DTE)\2),DTE
if HDR
WRITE !!,$PIECE(^PRSPC(DFN,0),"^",1)," (",TLE,")"
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
+1 QUIT
