source: WorldVistAEHR/trunk/r/PAID-PRS/PRSADP.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 965 bytes
RevLine 
[613]1PRSADP ; HISC/REL-Display Posting Date ;3/18/94 08:54
2 ;;4.0;PAID;;Sep 21, 1995
3TK ; Timekeeper - Display Single Day
4 S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX S %DT="X",X="T+3" D ^%DT
5 S %DT="AEPX",%DT("A")="Posting Date: ",%DT("B")="T-1",%DT(0)=-Y W ! D ^%DT
6 G:Y<1 EX S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1),DAY=$P(Y,"^",2)
7 I PPI="" W !!,*7,"Pay Period is Not Open Yet!" G EX
8 S PPE=$P($G(^PRST(458,PPI,0)),"^",1),DTE=$P($G(^PRST(458,PPI,2)),"^",DAY)
9NME 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
10 G:DFN<1 EX
11 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
12 I $D(IO("Q")) S PRSAPGM="Q1^PRSADP",PRSALST="DFN^PPI^PPE^DAY^DTE" D QUE^PRSAUTL G NME
13 U IO D Q1 D ^%ZISC K %ZIS,IOP G NME
14Q1 D ^PRSADP1
15 I $E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
16 Q
17EX G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.