VistA-FOIAVistA/r/PAID-PRS/PRSAFEE.m

34 lines
1.7 KiB
Mathematica
Raw Permalink Normal View History

PRSAFEE ; HISC/REL-Fee Basis Appointees ;12/14/00
;;4.0;PAID;**6,64**;Sep 21, 1995
S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
D1 S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-DT W ! D ^%DT
G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX
N1 D NME G EX:DFN<0,N1:'DFN
I "T"'[STAT W *7,!,"This Employee has already been released to Payroll!" G N1
D POST G N1
NME K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y))",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
Q:DFN<1 D ^PRSAENT I PP'="F" W !!?5,"Employee is not a Fee Basis Appointee." S DFN=0 Q
S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) Q
POST ; Post Earnings for Pay Period
S DTE=$P($G(^PRST(458,PPI,2)),"^",1)_" to "_$P($G(^(2)),"^",14)
K AUR S AUR(1)=$G(^PRST(458,PPI,"E",DFN,2))
S DDSFILE=458,DDSFILE(1)=458.01,DA(1)=PPI,DA=DFN
S DR="[PRSA FEE POST]" D ^DDS K DS Q:$G(^PRST(458,PPI,"E",DFN,2))=AUR(1)
D NOW^%DTC S NOW=% S $P(^PRST(458,PPI,"E",DFN,2),"^",15,16)=DUZ_"^"_NOW Q
PRP ; Prior Pay Period Update
S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX D NOW^%DTC S DT=%\1,NOW=%
S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX
D NME G:DFN<1 EX
I "T"[STAT D POST G EX
I STAT'="X" W !!,*7,"Card in Payroll and not transmitted; request return of card." Q
S Z=$G(^PRST(458,PPI,"E",DFN,2))
D POST I $G(^PRST(458,PPI,"E",DFN,2))'=AUR(1) D
.S AUT="V",AUS="R" D ^PRSAUD ; Approve, Notify Payroll
.I $G(AUR(7))["^" K ^PRST(458,PPI,"E",DFN,2) I $D(AUR(1)) D
..S ^PRST(458,PPI,"E",DFN,2)=AUR(1)
G EX
EX G KILL^XUSCLEAN