PRSATPG ; HISC/REL-List Prior Exceptions ;8/22/95 13:42
;;4.0;PAID;;Sep 21, 1995
PAY ; Payroll Entry Point - All Exceptions
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),PAY:Y<1
S TLE=$P(Y,"^",2),PRSTLV=3 G L1
SUP ; Supervisor Entry Point
S PRSTLV=3 D ^PRSAUTL G EX:TLI<1,L1
TK ; TimeKeeper Entry Point
S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
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^PRSATPG",PRSALST="TLE" D QUE^PRSAUTL G EX
U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
Q1 ; Process List
D NOW^%DTC S DT=%\1,(PG,QT)=0 D HDR I TLE'="" D Q2 G:QT EX D:$Y>3 H1 G EX
S ATL="ATL00" F S ATL=$O(^PRSPC(ATL)) Q:ATL="" S TLE=$E(ATL,4,6) D Q2 G:QT EX
D:$Y>3 H1 G EX
Q2 S NX="" F S NX=$O(^PRSPC("ATL"_TLE,NX)) Q:NX="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NX,DFN)) Q:DFN<1 I $D(^PRST(458.5,"C",DFN)) D G:QT Q3
.F PDA=0:0 S PDA=$O(^PRST(458.5,"C",DFN,PDA)) Q:PDA<1 D CHK
.Q:'$D(^PRST(458.5,"C",DFN))
.S Y0=$G(^PRSPC(DFN,0)),EHDR=1
.F PDA=0:0 S PDA=$O(^PRST(458.5,"C",DFN,PDA)) Q:PDA<1 D PRT Q:QT
.Q
Q3 Q
CHK ; Check Exception
S X=$G(^PRST(458.5,PDA,0)),PDTI=$P(X,"^",3) Q:'PDTI Q:$P(X,"^",6)
S Y=$G(^PRST(458,"AD",PDTI)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2) Q:'PPI
S ESTR=$P(X,"^",5)_"^"_$P(X,"^",4)
D ^PRSATPE I '$D(ER) S DA=PDA D REM^PRSATPF Q
F K=0:0 S K=$O(ER(K)) Q:K<1 I ER(K)=ESTR K ER(K) G C1
S DA=PDA D REM^PRSATPF
C1 F K=0:0 S K=$O(ER(K)) Q:K<1 S X1=PDTI,X2=ER(K) D ^PRSATPF
Q
PRT ; List entries
S X=$G(^PRST(458.5,PDA,0)),PDTI=$P(X,"^",3),TIM=$P(X,"^",4),TXT=$P(X,"^",5) Q:'PDTI Q:$P(X,"^",6)
I EHDR D EHDR S EHDR=0
I $Y>(IOSL-6) D HDR Q:QT D EHDR
S X=PDTI D DTP^PRSAPPU W !?5,Y W:TIM'="" ?16,TIM W ?24,TXT Q
EHDR ; Employee Header
W !!,$P(Y0,"^",1) W:$P(Y0,"^",8)'="" " (",$P(Y0,"^",8),")" 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 !?26,"PRIOR PAY PERIOD EXCEPTIONS"
S X=DT D DTP^PRSAPPU W !?35,Y 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[HPRSATPG 2258 printed Nov 22, 2024@17:34:52 Page 2
PRSATPG ; HISC/REL-List Prior Exceptions ;8/22/95 13:42
+1 ;;4.0;PAID;;Sep 21, 1995
PAY ; Payroll Entry Point - All Exceptions
+1 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
+2 KILL DIC
SET DIC="^PRST(455.5,"
SET DIC(0)="EMQ"
DO ^DIC
if $DATA(DTOUT)
GOTO EX
if Y<1
GOTO PAY
+3 SET TLE=$PIECE(Y,"^",2)
SET PRSTLV=3
GOTO L1
SUP ; Supervisor Entry Point
+1 SET PRSTLV=3
DO ^PRSAUTL
if TLI<1
GOTO EX
GOTO L1
TK ; TimeKeeper Entry Point
+1 SET PRSTLV=2
DO ^PRSAUTL
if TLI<1
GOTO EX
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^PRSATPG"
SET PRSALST="TLE"
DO QUE^PRSAUTL
GOTO EX
+2 USE IO
DO Q1
DO ^%ZISC
KILL %ZIS,IOP
GOTO EX
Q1 ; Process List
+1 DO NOW^%DTC
SET DT=%\1
SET (PG,QT)=0
DO HDR
IF TLE'=""
DO Q2
if QT
GOTO EX
if $Y>3
DO H1
GOTO EX
+2 SET ATL="ATL00"
FOR
SET ATL=$ORDER(^PRSPC(ATL))
if ATL=""
QUIT
SET TLE=$EXTRACT(ATL,4,6)
DO Q2
if QT
GOTO EX
+3 if $Y>3
DO H1
GOTO EX
Q2 SET NX=""
FOR
SET NX=$ORDER(^PRSPC("ATL"_TLE,NX))
if NX=""
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^PRSPC("ATL"_TLE,NX,DFN))
if DFN<1
QUIT
IF $DATA(^PRST(458.5,"C",DFN))
Begin DoDot:1
+1 FOR PDA=0:0
SET PDA=$ORDER(^PRST(458.5,"C",DFN,PDA))
if PDA<1
QUIT
DO CHK
+2 if '$DATA(^PRST(458.5,"C",DFN))
QUIT
+3 SET Y0=$GET(^PRSPC(DFN,0))
SET EHDR=1
+4 FOR PDA=0:0
SET PDA=$ORDER(^PRST(458.5,"C",DFN,PDA))
if PDA<1
QUIT
DO PRT
if QT
QUIT
+5 QUIT
End DoDot:1
if QT
GOTO Q3
Q3 QUIT
CHK ; Check Exception
+1 SET X=$GET(^PRST(458.5,PDA,0))
SET PDTI=$PIECE(X,"^",3)
if 'PDTI
QUIT
if $PIECE(X,"^",6)
QUIT
+2 SET Y=$GET(^PRST(458,"AD",PDTI))
SET PPI=$PIECE(Y,"^",1)
SET DAY=$PIECE(Y,"^",2)
if 'PPI
QUIT
+3 SET ESTR=$PIECE(X,"^",5)_"^"_$PIECE(X,"^",4)
+4 DO ^PRSATPE
IF '$DATA(ER)
SET DA=PDA
DO REM^PRSATPF
QUIT
+5 FOR K=0:0
SET K=$ORDER(ER(K))
if K<1
QUIT
IF ER(K)=ESTR
KILL ER(K)
GOTO C1
+6 SET DA=PDA
DO REM^PRSATPF
C1 FOR K=0:0
SET K=$ORDER(ER(K))
if K<1
QUIT
SET X1=PDTI
SET X2=ER(K)
DO ^PRSATPF
+1 QUIT
PRT ; List entries
+1 SET X=$GET(^PRST(458.5,PDA,0))
SET PDTI=$PIECE(X,"^",3)
SET TIM=$PIECE(X,"^",4)
SET TXT=$PIECE(X,"^",5)
if 'PDTI
QUIT
if $PIECE(X,"^",6)
QUIT
+2 IF EHDR
DO EHDR
SET EHDR=0
+3 IF $Y>(IOSL-6)
DO HDR
if QT
QUIT
DO EHDR
+4 SET X=PDTI
DO DTP^PRSAPPU
WRITE !?5,Y
if TIM'=""
WRITE ?16,TIM
WRITE ?24,TXT
QUIT
EHDR ; Employee Header
+1 WRITE !!,$PIECE(Y0,"^",1)
if $PIECE(Y0,"^",8)'=""
WRITE " (",$PIECE(Y0,"^",8),")"
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 !?26,"PRIOR PAY PERIOD EXCEPTIONS"
+4 SET X=DT
DO DTP^PRSAPPU
WRITE !?35,Y
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
