| [613] | 1 | PRSAENE ; HISC/REL-Display Employee Entitlement ;3/21/94 13:44
|
|---|
| 2 | ;;4.0;PAID;;Sep 21, 1995
|
|---|
| 3 | S PRSTLV=7 D ^PRSAUTL G:TLI<1 EX
|
|---|
| 4 | E1 K DIC S DIC("A")="Select EMPLOYEE: ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC G:DFN<1 EX
|
|---|
| 5 | D ^PRSAENT I ENT="" W !!?5,"No Entitlement Table entry was found for this Employee." G E1
|
|---|
| 6 | W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
|
|---|
| 7 | I $D(IO("Q")) S PRSAPGM="Q1^PRSAENE",PRSALST="DFN^ENT" D QUE^PRSAUTL G EX
|
|---|
| 8 | U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
|
|---|
| 9 | Q1 ; List Entitlement for Employee
|
|---|
| 10 | W:$E(IOST,1,2)="C-" @IOF W !?28,"EMPLOYEE PAY ENTITLEMENTS"
|
|---|
| 11 | S X=$G(^PRSPC(DFN,0)) W !,$P(X,"^",1) S X=$P(X,"^",9) I X W ?67,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9)
|
|---|
| 12 | W ! D Q2^PRSAENX
|
|---|
| 13 | I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue. ",X:DTIME
|
|---|
| 14 | Q
|
|---|
| 15 | EX G KILL^XUSCLEAN
|
|---|
