| [613] | 1 | PRSATPP ; HISC/REL-Timekeeper Prior PP Post Time ;9/14/95 15:44
|
|---|
| 2 | ;;4.0;PAID;;Sep 21, 1995
|
|---|
| 3 | S PRSTLV=2 D ^PRSAUTL G:TLI<1 EX
|
|---|
| 4 | S X=$P(^PRST(455.5,TLI,0),"^",3) D NOW^%DTC S NOW=%,DT=%\1
|
|---|
| 5 | D1 S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT 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),DTI=$P($G(^(1)),"^",DAY)
|
|---|
| 9 | 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
|
|---|
| 10 | G:DFN<1 EX
|
|---|
| 11 | D ^PRSAENT I ENT="" W *7,!!,"Employee has no Pay Entitlement table entry." G EX
|
|---|
| 12 | S STAT=$P($G(^PRST(458,PPI,"E",DFN,0)),"^",2) I "T"[STAT W *7,!!,"Employee still open for regular posting." G NME
|
|---|
| 13 | I STAT'="X" W !!,*7,"Card in Payroll and not transmitted; request return of card." G NME
|
|---|
| 14 | K AUR S L2=0 F L1=0,1,2,10,3,4 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,L1)),L2=L2+1 S:Z'="" AUR(L2)=Z
|
|---|
| 15 | S STAT=$P($G(AUR(4)),"^",1) D POST
|
|---|
| 16 | S (Z,L2)=0 F L1=0,1,2,10,3,4 S L2=L2+1 I $G(^PRST(458,PPI,"E",DFN,"D",DAY,L1))'=$G(AUR(L2)) S Z=1
|
|---|
| 17 | I Z S AUT="T",AUS="R" D ^PRSAUD I $G(AUR(7))["^" S L2=0 F L1=0,1,2,10,3,4 S L2=L2+1 K ^PRST(458,PPI,"E",DFN,"D",DAY,L1) I $D(AUR(L2)) S ^(L1)=AUR(L2)
|
|---|
| 18 | G NME
|
|---|
| 19 | POST S TC=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),TC2=$P($G(^(0)),"^",13)
|
|---|
| 20 | D ^PRSADP1,LP,^PRSATP2 G:'TC T1
|
|---|
| 21 | T0 R !!,"Do you wish to change Scheduled Tour? N// ",X:DTIME Q:'$T!(X["^") S:X="" X="N" S X=$TR(X,"yesno","YESNO")
|
|---|
| 22 | I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G T0
|
|---|
| 23 | G:X?1"N".E T3
|
|---|
| 24 | T1 ; Get new tour
|
|---|
| 25 | S TYP=1,WTL=TLI
|
|---|
| 26 | S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="T&L on which Tour will be worked: ",DIC("B")=TLE W ! D ^DIC Q:Y<1 K DIC S WTL=+Y
|
|---|
| 27 | S DIC="^PRST(457.1,",DIC(0)="AEQMN"
|
|---|
| 28 | S DIC("S")="I "_$S($E(ENT,1)="D":"Y<3",1:"Y>5!(Y=1)")_",$P(^PRST(457.1,+Y,0),U,4)!($D(^PRST(457.1,+Y,""T"",""B"",WTL)))"
|
|---|
| 29 | S DIC("A")="Select TOUR OF DUTY: " W ! D ^DIC Q:Y'>0
|
|---|
| 30 | S TD=+Y,Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6) D SET^PRSATE,HOL^PRSATE S TC=TD
|
|---|
| 31 | T3 G P1^PRSATP:TC=1,P3^PRSATP:TC=4,P0^PRSATP
|
|---|
| 32 | LP W !!,"Enter '^' to bypass this employee." W ! Q
|
|---|
| 33 | EX G KILL^XUSCLEAN
|
|---|
