source: WorldVistAEHR/trunk/r/PAID-PRS/PRSADP2.m@ 1261

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1PRSADP2 ; HISC/REL-Display Employee Pay Period ;7/22/97
2 ;;4.0;PAID;**21,28,46,114**;Sep 21, 1995;Build 6
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4PAY ; Payroll Entry
5 N PPERIOD
6 S PRSTLV=7
7 D TOP ; print header
8P1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
9 W ! D ^DIC S DFN=+Y K DIC G:DFN<1 EX
10 S TLE=$P($G(^PRSPC(DFN,0)),"^",8)
11 S DIC="^PRST(458,",DIC(0)="AEQM",DIC("A")="Select PAY PERIOD: "
12 W ! D ^DIC K DIC G:Y<1 EX
13 S PPI=+Y
14 ; 1st put pay period in YY-PP format 4 call 2 lookup old T&L.
15 S PPERIOD=$S(Y["-":$P(Y,"^",2),1:$P(^PRST(458,$P(Y,"^"),0),"^"))
16 D CHECKTLE(PPERIOD,DFN,.TLE) ;verify that T&L unit hasn't changed
17 D L1 ;ask device
18 G P1 ;ask for employee again
19 ;====================================================================
20TK ; TimeKeeper Entry
21 S PRSTLV=2 G T0
22 ;====================================================================
23SUP ; Supervisor Entry
24 S PRSTLV=3
25T0 D TOP ; print header
26 D ^PRSAUTL G:TLI<1 EX
27 N PPERIOD
28T1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC("
29 S DIC("S")="I $P(^(0),""^"",8)=TLE" S D="ATL"_TLE W ! D IX^DIC
30 S DFN=+Y K DIC G:DFN<1 EX
31 S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
32 G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1) G EX:PPI<1
33 ; 1st put pay period in YY-PP format 4 call 2 lookup old T&L.
34 S PPERIOD=$S(Y["-":$P(Y,"^",2),1:$P(^PRST(458,$P(Y,"^"),0),"^"))
35 ;
36 ; Save T&L unit 4 use in DIC("S"), cause we might change TLE
37 ; for display if this employee was in a different T&L during
38 ; the selected pay period.
39 S TLSCREEN=TLE
40 ;
41 D CHECKTLE(PPERIOD,DFN,.TLE) ;verify that T&L unit hasn't changed
42 D L1 ;ask device
43 ;restore TLE variable to the one originally selected.
44 S TLE=TLSCREEN
45 ;
46 G T1 ;ask for employee again
47 ;====================================================================
48EMP ; Employee Entry
49 N PPERIOD,OLDTLE
50 S PRSTLV=1 D TOP S DFN="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
51 I SSN'="" S DFN=$O(^PRSPC("SSN",SSN,0))
52 I 'DFN W !!,*7,"Your SSN was not found in both the New Person & Employee File!" G EX
53 S TLE=$P($G(^PRSPC(DFN,0)),"^",8)
54 S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
55 G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1) G EX:PPI<1
56 ; 1st put pay period in YY-PP format 4 call 2 lookup old T&L.
57 S PPERIOD=$S(Y["-":$P(Y,"^",2),1:$P(^PRST(458,$P(Y,"^"),0),"^"))
58 D CHECKTLE(PPERIOD,DFN,.TLE) ;verify that T&L unit hasn't changed
59 D L1 G EX
60 ;====================================================================
61TOP W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
62 W !?27,"EMPLOYEE PAY PERIOD DATA" Q
63L1 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP Q:POP
64 I $D(IO("Q")) S PRSAPGM="DIS^PRSADP2",PRSALST="DFN^TLE^PPI" D QUE^PRSAUTL Q
65 U IO D DIS
66 ; pause screen when employee to prevent scroll (other users prompted)
67 I $E(IOST,1,2)="C-",'QT,PRSTLV=1 S PG=PG+1 D H1
68 D ^%ZISC K %ZIS,IOP Q
69 ;====================================================================
70DIS ; Display 14 days
71 S PDT=$G(^PRST(458,PPI,2)),STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)
72 S (PG,QT)=0 D HDR
73 W !!,?7,"Date",?21,"Scheduled Tour",?46,"Tour Exceptions"
74 W !?3,"------------------------------------------------------------------------"
75 F DAY=1:1:14 S DTE=$P(PDT,"^",DAY) D:$Y>(IOSL-5) HDR G:QT D1 D F0^PRSADP1
76 S Z=$G(^PRST(458,PPI,"E",DFN,2)) I Z'="" D:$Y>(IOSL-10) HDR Q:QT D VCS^PRSASR1
77 S Z=$G(^PRST(458,PPI,"E",DFN,4)) I Z'="" D:$Y>(IOSL-8) HDR Q:QT D ED^PRSASR1
78 S (X9,XF)=0 F DAY=1:1:14 D ^PRSATPE I $D(ER) S:FATAL XF=1 F K=0:0 S K=$O(ER(K)) Q:K<1 D:$Y>(IOSL-4) HDR G:QT D1 W:X9 ! W !?5,$P(PDT,"^",DAY)," " W:$P(ER(K),"^",2)'="" $P(ER(K),"^",2) W ?28,$P(ER(K),"^",1) S X9=0
79D1 I PRSTLV>5 S Z=$G(^PRST(458,PPI,"E",DFN,5)) W:Z'="" !!,"8B Codes: ",Z
80 Q:QT W ! I $D(^PRST(458,PPI,"E",DFN,"X",0)) D ^PRSAUDP
81 Q
82 ;====================================================================
83HDR ; Display Header
84 D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
85 S PG=PG+1
86 S X=$G(^PRSPC(DFN,0)) ;employees (partial) master record.
87 W ! W:$E(IOST,1,2)="C-" @IOF
88 W ?3,$P(X,"^",1),?36,"T&L ",$S($G(TLE):TLE,1:$P(X,"^",8))
89 S X=$P(X,"^",9)
90 I '$G(PRSTLV)!($G(PRSTLV)=1) W ?68,"XXX-XX-",$E(X,6,9) W:PG>1 ! Q
91 I PRSTLV=2!(PRSTLV=3) W ?68,$E(X),"XX-XX-",$E(X,6,9) W:PG>1 ! Q
92 I PRSTLV=7 W ?68,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9) W:PG>1 ! Q
93H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
94 Q
95EX G KILL^XUSCLEAN
96 Q
97 ;=============J.Heiges===============================================
98CHECKTLE(PAYPRD,EMPLOYEE,TLE) ;
99 ; In cases where Time keepers, Payroll or employees are viewing
100 ;an old pay period, make sure employee being viewed was not in
101 ;a different T&L unit.
102 ; This routine calls function that checks an old pay plan and
103 ;populates OLDPP() array with T&L Unit.
104 ; To handle cases when we're dealing with the current pay period,
105 ;ignore cases when the lookup fails, since the current pay period
106 ;will not be in the Pay Run download file. If old T&L unit not found,
107 ;display current.
108 ;
109 ;VARS:
110 ; PAYPRD= Pay period in file 458, .01 field, in the
111 ; form YY-PP (year-pay period). i.e 96-02
112 ; EMPLOYEE= employees internal entry number in file 450.
113 ;
114 N PPLOLD,PPL,OLDPP
115 ; call old pay plan lookup to also return old T&L unit.
116 S PPLOLD=$$OLDPP^PRS8UT(PAYPRD,+EMPLOYEE) ;pay plan from PAYPDTMP.
117 ;
118 ; Did lookup find legitimate T&L unit ? If so, is it different
119 ; than the employees current T&L? If so, return old value.
120 I $L($G(OLDPP("TLUNIT")))>2 D
121 . I OLDPP("TLUNIT")'=TLE S TLE=OLDPP("TLUNIT")
122 ;
123 Q
124 ;===================================================================
Note: See TracBrowser for help on using the repository browser.