source: FOIAVistA/tag/r/PAID-PRS/PRSAPEX.m@ 1700

Last change on this file since 1700 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1PRSAPEX ; HISC/REL-Pay Period Exceptions ; 3-27-1998
2 ;;4.0;PAID;**37,43**;Sep 21, 1995
3 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
4T0 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
5 K DIC S DIC="^PRST(455.5,",DIC(0)="EMQ" D ^DIC G EX:$D(DTOUT),T0:Y<1
6 S TLE=$P(Y,"^",2)
7L1 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
8 I $D(IO("Q")) S PRSAPGM="Q1^PRSAPEX",PRSALST="PPI^TLE" D QUE^PRSAUTL G EX
9 U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
10Q1 ; Process Exception List
11 S PPE=$P($G(^PRST(458,PPI,0)),"^",1),PDT=$G(^PRST(458,PPI,2)),QT=0
12 S DTE=$P(PDT,"^",1)_" to "_$P(PDT,"^",14),PG=0,HDR=0 D HDR
13 I TLE'="" S ATL="ATL"_TLE,TL=TLE D Q10 D:'QT H1 Q
14 S ATL="ATL00"
15 F S ATL=$O(^PRSPC(ATL)) Q:ATL'?1"ATL".E S TLE=$E(ATL,4,6) D Q10 Q:QT
16 D:'QT H1 Q
17Q10 S NN=""
18 F S NN=$O(^PRSPC(ATL,NN)) Q:NN="" D Q:QT
19 . S HDR=0
20 . F DFN=0:0 S DFN=$O(^PRSPC(ATL,NN,DFN)) Q:DFN<1 D Q:QT
21 .. Q:'$D(^PRST(458,PPI,"E",DFN,"D",0))
22 .. F DAY=1:1:14 D FND Q:QT
23 ..;
24 ..; If timecard status is other than Timekeeper & a TT8b is on file
25 ..; then compare calculated OT in TT8B to approved OT in request file.
26 ..; Display & file OT warning if existing warning is not cleared.
27 ..;
28 .. N TT8B,STATUS,WEEK,OT8B,OTAPP
29 .. S TT8B=$G(^PRST(458,PPI,"E",DFN,5)),STATUS=$P($G(^(0)),"^",2)
30 .. Q:(STATUS="T")!(TT8B="")
31 .. F WEEK=1:1:2 D
32 ... I $$CHECKOT(PPI,WEEK,DFN) D
33 .... D GETOTS^PRSAOTT(PPE,DFN,TT8B,WEEK,.OT8B,.OTAPP)
34 .... I OTAPP<OT8B D
35 ..... D OTDISP(DFN,OT8B,OTAPP,WEEK)
36 ..... D FILEOTW^PRSAOTTF(PPI,DFN,WEEK,OT8B,OTAPP)
37 Q
38 ;
39CHECKOT(P,W,E) ;DETERMINE WHETHER TO DO THE OT CHECK
40 ;
41 ;input: P--pay period ien, W--week 1 or 2 of pp, E--emp 450 ien
42 ;return: true or false as described below.
43 S CHECK=1
44 ;
45 ;If no warning on file do OT warnings check (return true).
46 ;
47 ;If warning on file for this pay per, week, employee (P,W,E)
48 ;and status of warning is cleared then don't recheck or display
49 ;any warning (return false). A status of cleared indicates
50 ;payroll has cleared the warning to remove it from display.
51 ;
52 S WRNIEN=$$WRNEXIST^PRSAOTTF(P,E,W)
53 Q:'WRNIEN CHECK
54 ;
55 Q:$P($G(^PRST(458.6,WRNIEN,0)),"^",5)'="C" CHECK
56 Q 0
57 ;
58FND D ^PRSATPE Q:'$D(ER)
59 I 'HDR D:$Y>(IOSL-5) HDR Q:QT W !!,$P(^PRSPC(DFN,0),"^",1)," (",TLE,")" S HDR=1
60 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)
61 Q
62OTDISP(DFN,OT8B,OTAPP,WEEK) ;
63 I 'HDR D:$Y>(IOSL-5) HDR Q:QT W !!,$P(^PRSPC(DFN,0),"^",1)," (",TLE,")" S HDR=1
64 D:$Y>(IOSL-3) HDR Q:QT D DISPLAY^PRSAOTT(DFN,OT8B,OTAPP,WEEK)
65 Q
66HDR ; Display Header
67 D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
68 S PG=PG+1 W !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
69 W !!?(81-$L(DTE)\2),DTE W:HDR !!,$P(^PRSPC(DFN,0),"^",1)," (",TLE,")" Q
70H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
71 Q
72EX G KILL^XUSCLEAN
73 Q
Note: See TracBrowser for help on using the repository browser.