PRSAPRE ; HISC/MGD-Add Employee to Pay Period ;03/03/05
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
S DIC="^PRST(458,",DIC(0)="AEQM",DIC("A")="Select PAY PERIOD: " W ! D ^DIC K DIC G:Y<1 EX S PPI=+Y
S D1=$P($G(^PRST(458,PPI,1)),"^",14),X1=D1,X2=5 D C^%DTC I DT>X W *7,!!,"This Pay Period ended more than 5 days ago!" G EX
D ^PRSAPPH
N MIEN
P0 K DIC S DIC("A")="Select EMPLOYEE: ",DIC(0)="AEQM",DIC="^PRSPC(" W ! D ^DIC S DFN=+Y K DIC
G:DFN<1 EX
I $D(^PRST(458,PPI,"E",DFN)) W *7,!!,"Pay Period Already Open for this Employee." G P0
I $P($G(^PRSPC(DFN,"LWOP")),"^",1)="Y" W !!,"Warning: 30-day LWOP Indicator is set."
I $P($G(^PRSPC(DFN,1)),"^",20)="Y" W !!,"Warning: No-Pay Indicator is set."
I $P($G(^PRSPC(DFN,1)),"^",33)'="N" W !!,"Warning: Separation Indicator is not N."
S TLE=$P($G(^PRSPC(DFN,0)),"^",8) I TLE="" W !!,"Warning: No T&L Unit has been specified."
OK R !!,"OK to Create Record for this Employee? ",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 *7," Answer YES or NO" G OK
G P0:X?1"N".E,P2:TLE'=""
P1 K DIC S DIC="^PRST(455.5,",DIC(0)="AEQM" W ! D ^DIC K DIC G EX:$D(DTOUT),EX:$D(DUOUT),P1:Y<1
S TLE=$P(Y,"^",2)
S DA=DFN,DIE="^PRSPC(",DR="7////^S X=TLE" D ^DIE
P2 S PPIP=PPI-1
S MIEN=$$MIEN^PRSPUT1(DFN,+$G(^PRST(458,PPI,1)))
D MOV^PRSAPPO I $D(HOL) D NOW^%DTC S NOW=%,TT="HX",DUP=0 D E^PRSAPPH
W !!?5,"Pay Period opened for this Employee." G P0
EX G KILL^XUSCLEAN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAPRE 1547 printed Apr 09, 2024@21:28:06 Page 2
PRSAPRE ; HISC/MGD-Add Employee to Pay Period ;03/03/05
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET DIC="^PRST(458,"
SET DIC(0)="AEQM"
SET DIC("A")="Select PAY PERIOD: "
WRITE !
DO ^DIC
KILL DIC
if Y<1
GOTO EX
SET PPI=+Y
+4 SET D1=$PIECE($GET(^PRST(458,PPI,1)),"^",14)
SET X1=D1
SET X2=5
DO C^%DTC
IF DT>X
WRITE *7,!!,"This Pay Period ended more than 5 days ago!"
GOTO EX
+5 DO ^PRSAPPH
+6 NEW MIEN
P0 KILL DIC
SET DIC("A")="Select EMPLOYEE: "
SET DIC(0)="AEQM"
SET DIC="^PRSPC("
WRITE !
DO ^DIC
SET DFN=+Y
KILL DIC
+1 if DFN<1
GOTO EX
+2 IF $DATA(^PRST(458,PPI,"E",DFN))
WRITE *7,!!,"Pay Period Already Open for this Employee."
GOTO P0
+3 IF $PIECE($GET(^PRSPC(DFN,"LWOP")),"^",1)="Y"
WRITE !!,"Warning: 30-day LWOP Indicator is set."
+4 IF $PIECE($GET(^PRSPC(DFN,1)),"^",20)="Y"
WRITE !!,"Warning: No-Pay Indicator is set."
+5 IF $PIECE($GET(^PRSPC(DFN,1)),"^",33)'="N"
WRITE !!,"Warning: Separation Indicator is not N."
+6 SET TLE=$PIECE($GET(^PRSPC(DFN,0)),"^",8)
IF TLE=""
WRITE !!,"Warning: No T&L Unit has been specified."
OK READ !!,"OK to Create Record for this Employee? ",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 *7," Answer YES or NO"
GOTO OK
+2 if X?1"N".E
GOTO P0
if TLE'=""
GOTO P2
P1 KILL DIC
SET DIC="^PRST(455.5,"
SET DIC(0)="AEQM"
WRITE !
DO ^DIC
KILL DIC
if $DATA(DTOUT)
GOTO EX
if $DATA(DUOUT)
GOTO EX
if Y<1
GOTO P1
+1 SET TLE=$PIECE(Y,"^",2)
+2 SET DA=DFN
SET DIE="^PRSPC("
SET DR="7////^S X=TLE"
DO ^DIE
P2 SET PPIP=PPI-1
+1 SET MIEN=$$MIEN^PRSPUT1(DFN,+$GET(^PRST(458,PPI,1)))
+2 DO MOV^PRSAPPO
IF $DATA(HOL)
DO NOW^%DTC
SET NOW=%
SET TT="HX"
SET DUP=0
DO E^PRSAPPH
+3 WRITE !!?5,"Pay Period opened for this Employee."
GOTO P0
EX GOTO KILL^XUSCLEAN
