PRSADP.m

PRSADP ; HISC/REL-Display Posting Date ;3/18/94  08:54

 ;;4.0;PAID;;Sep 21, 1995

TK ; Timekeeper - Display Single Day

 S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT

 S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT

 G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)

 I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX

 S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY)

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

 G:DFN<1 EX

 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^PRSADP",PRSALST="DFN^PPI^PPE^DAY^DTE" D QUE^PRSAUTL G NME

 U IO D Q1 D ^%ZISC K %ZIS,IOP G NME

Q1 D ^PRSADP1

 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1

 Q

EX G KILL^XUSCLEAN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRSADP   982     printed  Apr 09, 2024@21:29:24                                                                                                                                                                                                       Page 2

PRSADP    ; HISC/REL-Display Posting Date ;3/18/94  08:54

 +1       ;;4.0;PAID;;Sep 21, 1995

TK        ; Timekeeper - Display Single Day

 +1        SET PRSTLV=2

           DO ^PRSAUTL

           if TLI<1

               GOTO EX

           SET %DT="X"

           SET X="T+3"

           DO ^%DT

 +2        SET %DT="AEPX"

           SET %DT("A")="Posting Date: "

           SET %DT("B")="T-1"

           SET %DT(0)=-Y

           WRITE !

           DO ^%DT

 +3        if Y<1

               GOTO EX

           SET D1=Y

           SET Y=$GET(^PRST(458,"AD",D1))

           SET PPI=$PIECE(Y,"^",1)

           SET DAY=$PIECE(Y,"^",2)

 +4        IF PPI=""

               WRITE !!,*7,"Pay Period is Not Open Yet!"

               GOTO EX

 +5        SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)

           SET DTE=$PIECE($GET(^PRST(458,PPI,2)),"^",DAY)

NME        KILL DIC

           SET DIC("A")="Select EMPLOYEE: "

           SET DIC("S")="I $P(^(0),""^"",8)=TLE,$D(^PRST(458,PPI,""E"",+Y))"

           SET DIC(0)="AEQM"

           SET DIC="^PRSPC("

           SET D="ATL"_TLE

           WRITE !

           DO IX^DIC

           SET DFN=+Y

           KILL DIC

 +1        if DFN<1

               GOTO EX

 +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^PRSADP"

               SET PRSALST="DFN^PPI^PPE^DAY^DTE"

               DO QUE^PRSAUTL

               GOTO NME

 +4        USE IO

           DO Q1

           DO ^%ZISC

           KILL %ZIS,IOP

           GOTO NME

Q1         DO ^PRSADP1

 +1        IF $EXTRACT(IOST,1,2)="C-"

               READ !!,"Press RETURN to Continue.",X:DTIME

               if '$TEST!(X["^")

                   SET QT=1

 +2        QUIT 

EX         GOTO KILL^XUSCLEAN