PRSAENE.m

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 ---PRSAENE   880     printed  Apr 09, 2024@21:25:57                                                                                                                                                                                                      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