1 | PRSAPRT ; HISC/REL,WIRMFO/JAH-Return Record to TimeKeeper ;1/31/2007
|
---|
2 | ;;4.0;PAID;**7,8,21,111**;Sep 21, 1995;Build 2
|
---|
3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; Comments & Modifications by JAH Washington IRMFO.
|
---|
6 | ; Timecards are returned to Time Keeper 4 correction &
|
---|
7 | ; re-certification, only 4 pay period being processed & they
|
---|
8 | ; must be returned be4 timecards have been transmitted to
|
---|
9 | ; Austin. Time cards 4 pay period just closed are to be
|
---|
10 | ; transmitted to Austin by 10 am on Wednesday of first week
|
---|
11 | ; of current pay period. There may be a period in begining
|
---|
12 | ; of a new pay period in which an employee has been set up
|
---|
13 | ; with a new pay plan & their time card has not been
|
---|
14 | ; decomposed & transmitted. If this is case Austin will reject
|
---|
15 | ; card due to conflicting pay plans.
|
---|
16 | ;
|
---|
17 | N PPERIOD,OLDPP,PAYP
|
---|
18 | ;
|
---|
19 | ;Ask User for pay period
|
---|
20 | S DIC="^PRST(458,",DIC(0)="AEQM"
|
---|
21 | S DIC("A")="Select PAY PERIOD: "
|
---|
22 | W !
|
---|
23 | D ^DIC K DIC
|
---|
24 | ;
|
---|
25 | ;Quit if invalid pay period
|
---|
26 | G:Y<1 EX
|
---|
27 | S PPI=+Y,PPERIOD=$P(Y,"^",2)
|
---|
28 | ;
|
---|
29 | NME ;ask for name of employee who's timecard is to be returned.
|
---|
30 | K DIC
|
---|
31 | S DIC("A")="Select EMPLOYEE: "
|
---|
32 | S DIC(0)="AEQM"
|
---|
33 | S DIC="^PRSPC("
|
---|
34 | W !
|
---|
35 | D ^DIC S DFN=+Y K DIC
|
---|
36 | ;Quit if employees name not found in file 450 (PAID employee).
|
---|
37 | G:DFN<1 EX
|
---|
38 | ;
|
---|
39 | I '$D(^PRST(458,PPI,"E",DFN,0)) W $C(7),!!,"No Record exists to return!" G EX
|
---|
40 | ;
|
---|
41 | ;Display message to payroll if employee has changed pay plans.
|
---|
42 | ;Austin will reject a timecard if pay plan is different.
|
---|
43 | S GO=1
|
---|
44 | S OLDPP=$$OLDPP^PRS8UT(PPERIOD,DFN)
|
---|
45 | S PAYP=$P($G(^PRSPC(DFN,0)),"^",21)
|
---|
46 | I OLDPP'=0,(OLDPP'=PAYP) D
|
---|
47 | . W !,"PLEASE NOTE: Employee has changed pay plans. "
|
---|
48 | . W !,"Current Pay Plan: ",PAYP
|
---|
49 | . W !,"Pay Plan during Pay Period ",PPERIOD," ",OLDPP
|
---|
50 | . S GO=$$CONTINUE^PRSAUTL
|
---|
51 | I 'GO G EX
|
---|
52 | ;
|
---|
53 | S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)
|
---|
54 | I "T"[STAT W $C(7),!!,"TimeKeeper still has this Employee." G EX
|
---|
55 | I STAT="P" D B W !!," . . . Returned to Timekeeper." G EX
|
---|
56 | W $C(7),!!,"Warning! This Employee has already been Transmitted."
|
---|
57 | A R !!,"Return to Timekeeper Anyway? ",X:DTIME G:'$T!(X["^") EX S:X="" X="*" S X=$TR(X,"yesno","YESNO")
|
---|
58 | I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G A
|
---|
59 | I X?1"Y".E D B W !!," . . . Returned to Timekeeper." G EX
|
---|
60 | G EX
|
---|
61 | B S $P(^PRST(458,PPI,"E",DFN,0),"^",2)="T" K ^(5)
|
---|
62 | D AUTOPINI^PRS8(PPI,DFN)
|
---|
63 | Q
|
---|
64 | EX G KILL^XUSCLEAN
|
---|