- 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 Mar 13, 2025@21:28:56 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
