source: FOIAVistA/tag/r/PAID-PRS/PRSAFEE.m@ 1602

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