- PRSAENE ; HISC/REL-Display Employee Entitlement ;3/21/94 13:44
- ;;4.0;PAID;;Sep 21, 1995
- S PRSTLV=7 D ^PRSAUTL G:TLI<1 EX
- 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
- D ^PRSAENT I ENT="" W !!?5,"No Entitlement Table entry was found for this Employee." G E1
- W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
- I $D(IO("Q")) S PRSAPGM="Q1^PRSAENE",PRSALST="DFN^ENT" D QUE^PRSAUTL G EX
- U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
- Q1 ; List Entitlement for Employee
- W:$E(IOST,1,2)="C-" @IOF W !?28,"EMPLOYEE PAY ENTITLEMENTS"
- 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)
- W ! D Q2^PRSAENX
- I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue. ",X:DTIME
- Q
- EX G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAENE 880 printed Mar 13, 2025@21:28:29 Page 2
- PRSAENE ; HISC/REL-Display Employee Entitlement ;3/21/94 13:44
- +1 ;;4.0;PAID;;Sep 21, 1995
- +2 SET PRSTLV=7
- DO ^PRSAUTL
- if TLI<1
- GOTO EX
- E1 KILL DIC
- SET DIC("A")="Select EMPLOYEE: "
- SET DIC("S")="I $P(^(0),""^"",8)=TLE"
- SET DIC(0)="AEQM"
- SET DIC="^PRSPC("
- SET D="ATL"_TLE
- WRITE !
- DO IX^DIC
- SET DFN=+Y
- KILL DIC
- if DFN<1
- GOTO EX
- +1 DO ^PRSAENT
- IF ENT=""
- WRITE !!?5,"No Entitlement Table entry was found for this Employee."
- GOTO E1
- +2 WRITE !
- KILL IOP,%ZIS
- SET %ZIS("A")="Select Device: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO EX
- +3 IF $DATA(IO("Q"))
- SET PRSAPGM="Q1^PRSAENE"
- SET PRSALST="DFN^ENT"
- DO QUE^PRSAUTL
- GOTO EX
- +4 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO EX
- Q1 ; List Entitlement for Employee
- +1 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !?28,"EMPLOYEE PAY ENTITLEMENTS"
- +2 SET X=$GET(^PRSPC(DFN,0))
- WRITE !,$PIECE(X,"^",1)
- SET X=$PIECE(X,"^",9)
- IF X
- WRITE ?67,$EXTRACT(X,1,3),"-",$EXTRACT(X,4,5),"-",$EXTRACT(X,6,9)
- +3 WRITE !
- DO Q2^PRSAENX
- +4 IF $EXTRACT(IOST,1,2)="C-"
- READ !!,"Press RETURN to Continue. ",X:DTIME
- +5 QUIT
- EX GOTO KILL^XUSCLEAN
