source: WorldVistAEHR/trunk/r/PAID-PRS/PRSALVL.m@ 1450

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1PRSALVL ; HISC/REL-Display Leave Requests ;1/24/96 13:56
2 ;;4.0;PAID;**9,114**;Sep 21, 1995;Build 6
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4TK ; TimeKeeper Entry
5 S PRSTLV=2 G TL
6SUP ; Supervisor Entry
7 S PRSTLV=3 G TL
8PAY ; Payroll Entry
9 S PRSTLV=7 G TL
10TL D ^PRSAUTL G:TLI<1 EX
11 K DIC S DIC("A")="Select EMPLOYEE (or RETURN for all): ",DIC("S")="I $P(^(0),""^"",8)=TLE",DIC(0)="AEQM",DIC="^PRSPC(",D="ATL"_TLE W ! D IX^DIC S DFN=+Y K DIC
12 G:$D(DTOUT) EX I DFN<1,X'="" G EX
13D1 K %DT S %DT="AEX",%DT("A")="Begin with Date: " W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S SDT=Y
14 K %DT S %DT="AEX",%DT("A")="End with Date: " W ! D ^%DT K %DT S:$D(DTOUT) Y=0 G:Y<1 EX S EDT=Y
15 I SDT>EDT W *7,!?5,"Starting Date cannot be later than Ending Date!" G D1
16D2 S SRT="E" I DFN<1 R !!,"Sort by: (E=Employee D=Date) E// ",SRT:DTIME G:'$T!(SRT["^") EX S:SRT="" SRT="E" S SRT=$TR(SRT,"de","DE") I SRT'?1U!("DE"'[SRT) W *7," Enter E or D" G D2
17 W ! K IOP,%ZIS S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
18 I $D(IO("Q")) S PRSAPGM="Q1^PRSALVL",PRSALST="DFN^TLE^SDT^EDT^SRT" D QUE^PRSAUTL G EX
19 U IO D Q1 D ^%ZISC K %ZIS,IOP G EX
20Q1 K ^TMP($J) I DFN>0 S NN=$P($G(^PRSPC(DFN,0)),"^",1) D Q2 G P1
21 S NN="" F S NN=$O(^PRSPC("ATL"_TLE,NN)) Q:NN="" F DFN=0:0 S DFN=$O(^PRSPC("ATL"_TLE,NN,DFN)) Q:DFN<1 D Q2
22 G P1
23Q2 S LST=9999999-SDT
24 F DTI=0:0 S DTI=$O(^PRST(458.1,"AD",DFN,DTI)) Q:DTI=""!(DTI>LST) F DA=0:0 S DA=$O(^PRST(458.1,"AD",DFN,DTI,DA)) Q:DA="" I $G(^(DA))'>EDT D Q3
25 Q
26Q3 I $P($G(^PRST(458.1,DA,0)),"^",9)="X" Q
27 S Z=$P($G(^PRST(458.1,DA,0)),"^",3) I SRT="E" S ^TMP($J,NN_"~"_DFN,+Z,DA)="" Q
28 S ^TMP($J,+Z,NN_"~"_DFN,DA)="" Q
29P1 S (PG,QT)=0 D HDR S LVT=";"_$P(^DD(458.1,6,0),"^",3),LVS=";"_$P(^DD(458.1,8,0),"^",3)
30 S N1="" F S N1=$O(^TMP($J,N1)) Q:N1="" S HDR=0,N2="" F S N2=$O(^TMP($J,N1,N2)) Q:N2="" F DA=0:0 S DA=$O(^TMP($J,N1,N2,DA)) Q:DA="" D LST G:QT EX
31 D H1 G EX
32LST ; Display Request
33 S DFN=$P($S(SRT="E":N1,1:N2),"~",2),Y0=$G(^PRSPC(DFN,0)) I HDR G:$Y'>(IOSL-3) L1 D HDR Q:QT
34 D:$Y>(IOSL-6) HDR Q:QT S HDR=1
35 I SRT="E" W !!,$P(Y0,"^",1) S X=$P(Y0,"^",9) D G L1
36 . I PRSTLV=2!(PRSTLV=3) W ?50,$E(X),"XX-XX-",$E(X,6,9)
37 . I PRSTLV=7 W ?50,$E(X,1,3),"-",$E(X,4,5),"-",$E(X,6,9)
38 S X=N1 D DTP W !!,Y
39L1 ; List item
40 S Z=$G(^PRST(458.1,DA,0)) Q:Z="" S SCOM=$P($G(^(1)),"^",1)
41 I SRT="D" W !?3,$P(Y0,"^",1)," ",$P(Z,"^",4)
42 E W !?3,$P(Z,"^",4)," " S X=$P(Z,"^",3) D DTP W Y
43 W " to ",$P(Z,"^",6)," " S X=$P(Z,"^",5) D DTP W Y," "
44 I SRT="E" S X=$P(Z,"^",15) I X W X," ",$S($P(Z,"^",16)="D":"days",1:"hrs")," "
45 S X=$P(Z,"^",7),%=$F(LVT,";"_X_":") I %>0 W $P($E(LVT,%,999),";",1)," "
46 S X=$P(Z,"^",9)
47 S %=$F(LVS,";"_X_":") I %>0 W $P($E(LVS,%,999),";",1)
48 S X=$P(Z,"^",8) W:X'="" !?5,X S Y=$P(Z,"^",11) D DTP^PRSAUDP W !?5,"Requested: ",Y
49 W:SCOM'="" !?5,"Supr: ",SCOM Q
50DTP ; Printable Date
51 S Y=$J(+$E(X,6,7),2)_"-"_$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$E(X,4,5))_"-"_$E(X,2,3)
52 Q
53HDR ; Display Header
54 D H1 Q:QT W:'($E(IOST,1,2)'="C-"&'PG) @IOF
55 S PG=PG+1,HDR=0 W !?26,"VA TIME & ATTENDANCE SYSTEM",?72,"Page ",PG
56 W !?28,"T&L ",TLE," LEAVE REQUESTS"
57 S X=SDT D DTP W !!?27,"From ",Y S X=EDT D DTP W " to ",Y Q
58H1 I PG,$E(IOST,1,2)="C-" R !!,"Press RETURN to Continue.",X:DTIME S:'$T!(X["^") QT=1
59 Q
60EX G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.