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 ---[H[J[2J[HPRSADP 982 printed Dec 13, 2024@02:23:20 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
