- 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 Mar 13, 2025@21:29:04 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
