PRSAPRT ; HISC/REL,WIRMFO/JAH-Return Record to TimeKeeper ;1/31/2007
;;4.0;PAID;**7,8,21,111,132**;Sep 21, 1995;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Comments & Modifications by JAH Washington IRMFO.
; Timecards are returned to Time Keeper 4 correction &
; re-certification, only 4 pay period being processed & they
; must be returned be4 timecards have been transmitted to
; Austin. Time cards 4 pay period just closed are to be
; transmitted to Austin by 10 am on Wednesday of first week
; of current pay period. There may be a period in begining
; of a new pay period in which an employee has been set up
; with a new pay plan & their time card has not been
; decomposed & transmitted. If this is case Austin will reject
; card due to conflicting pay plans.
;
N PPERIOD,OLDPP,PAYP
;
;Ask User for pay period
S DIC="^PRST(458,",DIC(0)="AEQM"
S DIC("A")="Select PAY PERIOD: "
W !
D ^DIC K DIC
;
;Quit if invalid pay period
G:Y<1 EX
S PPI=+Y,PPERIOD=$P(Y,"^",2)
;
NME ;ask for name of employee who's timecard is to be returned.
K DIC
S DIC("A")="Select EMPLOYEE: "
S DIC(0)="AEQM"
S DIC="^PRSPC("
W !
D ^DIC S DFN=+Y K DIC
;Quit if employees name not found in file 450 (PAID employee).
G:DFN<1 EX
;
I '$D(^PRST(458,PPI,"E",DFN,0)) W $C(7),!!,"No Record exists to return!" G EX
;
;Display message to payroll if employee has changed pay plans.
;Austin will reject a timecard if pay plan is different.
S GO=1
S OLDPP=$$OLDPP^PRS8UT(PPERIOD,DFN)
S PAYP=$P($G(^PRSPC(DFN,0)),"^",21)
I OLDPP'=0,(OLDPP'=PAYP) D
. W !,"PLEASE NOTE: Employee has changed pay plans. "
. W !,"Current Pay Plan: ",PAYP
. W !,"Pay Plan during Pay Period ",PPERIOD," ",OLDPP
. S GO=$$CONTINUE^PRSAUTL
I 'GO G EX
;
S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2)
I "T"[STAT W $C(7),!!,"TimeKeeper still has this Employee." G EX
I STAT="P" D B W !!," . . . Returned to Timekeeper." G EX
W $C(7),!!,"Warning! This Employee has already been Transmitted."
A R !!,"Return to Timekeeper Anyway? ",X:DTIME G:'$T!(X["^") EX S:X="" X="*" S X=$TR(X,"yesno","YESNO")
I $P("YES",X,1)'="",$P("NO",X,1)'="" W $C(7)," Answer YES or NO" G A
I X?1"Y".E D B W !!," . . . Returned to Timekeeper." G EX
G EX
;reset status and telework indicator
B S $P(^PRST(458,PPI,"E",DFN,0),"^",2)="T",$P(^(0),"^",8)="" K ^(5)
D AUTOPINI^PRS8(PPI,DFN)
Q
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAPRT 2489 printed Dec 13, 2024@02:24:01 Page 2
PRSAPRT ; HISC/REL,WIRMFO/JAH-Return Record to TimeKeeper ;1/31/2007
+1 ;;4.0;PAID;**7,8,21,111,132**;Sep 21, 1995;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Comments & Modifications by JAH Washington IRMFO.
+5 ; Timecards are returned to Time Keeper 4 correction &
+6 ; re-certification, only 4 pay period being processed & they
+7 ; must be returned be4 timecards have been transmitted to
+8 ; Austin. Time cards 4 pay period just closed are to be
+9 ; transmitted to Austin by 10 am on Wednesday of first week
+10 ; of current pay period. There may be a period in begining
+11 ; of a new pay period in which an employee has been set up
+12 ; with a new pay plan & their time card has not been
+13 ; decomposed & transmitted. If this is case Austin will reject
+14 ; card due to conflicting pay plans.
+15 ;
+16 NEW PPERIOD,OLDPP,PAYP
+17 ;
+18 ;Ask User for pay period
+19 SET DIC="^PRST(458,"
SET DIC(0)="AEQM"
+20 SET DIC("A")="Select PAY PERIOD: "
+21 WRITE !
+22 DO ^DIC
KILL DIC
+23 ;
+24 ;Quit if invalid pay period
+25 if Y<1
GOTO EX
+26 SET PPI=+Y
SET PPERIOD=$PIECE(Y,"^",2)
+27 ;
NME ;ask for name of employee who's timecard is to be returned.
+1 KILL DIC
+2 SET DIC("A")="Select EMPLOYEE: "
+3 SET DIC(0)="AEQM"
+4 SET DIC="^PRSPC("
+5 WRITE !
+6 DO ^DIC
SET DFN=+Y
KILL DIC
+7 ;Quit if employees name not found in file 450 (PAID employee).
+8 if DFN<1
GOTO EX
+9 ;
+10 IF '$DATA(^PRST(458,PPI,"E",DFN,0))
WRITE $CHAR(7),!!,"No Record exists to return!"
GOTO EX
+11 ;
+12 ;Display message to payroll if employee has changed pay plans.
+13 ;Austin will reject a timecard if pay plan is different.
+14 SET GO=1
+15 SET OLDPP=$$OLDPP^PRS8UT(PPERIOD,DFN)
+16 SET PAYP=$PIECE($GET(^PRSPC(DFN,0)),"^",21)
+17 IF OLDPP'=0
IF (OLDPP'=PAYP)
Begin DoDot:1
+18 WRITE !,"PLEASE NOTE: Employee has changed pay plans. "
+19 WRITE !,"Current Pay Plan: ",PAYP
+20 WRITE !,"Pay Plan during Pay Period ",PPERIOD," ",OLDPP
+21 SET GO=$$CONTINUE^PRSAUTL
End DoDot:1
+22 IF 'GO
GOTO EX
+23 ;
+24 SET STAT=$PIECE($GET(^PRST(458,PPI,"E",DFN,0)),"^",2)
+25 IF "T"[STAT
WRITE $CHAR(7),!!,"TimeKeeper still has this Employee."
GOTO EX
+26 IF STAT="P"
DO B
WRITE !!," . . . Returned to Timekeeper."
GOTO EX
+27 WRITE $CHAR(7),!!,"Warning! This Employee has already been Transmitted."
A READ !!,"Return to Timekeeper Anyway? ",X:DTIME
if '$TEST!(X["^")
GOTO EX
if X=""
SET X="*"
SET X=$TRANSLATE(X,"yesno","YESNO")
+1 IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE $CHAR(7)," Answer YES or NO"
GOTO A
+2 IF X?1"Y".E
DO B
WRITE !!," . . . Returned to Timekeeper."
GOTO EX
+3 GOTO EX
+4 ;reset status and telework indicator
B SET $PIECE(^PRST(458,PPI,"E",DFN,0),"^",2)="T"
SET $PIECE(^(0),"^",8)=""
KILL ^(5)
+1 DO AUTOPINI^PRS8(PPI,DFN)
+2 QUIT
EX GOTO KILL^XUSCLEAN
