source: FOIAVistA/trunk/r/PAID-PRS/PRSPCPPE.m@ 811

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1PRSPCPPE ; HISC/MGD - DISPLAY PP ESR EXCEPTIONS ;05/18/05
2 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6TK ; TimeKeeper Entry
7 S PRSTLV=2 D T0 Q
8SUP ; Supervisor Entry
9 S PRSTLV=3
10T0 D TOP ; print header
11 S USR="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
12 I SSN="" D D EXIT Q
13 . W !!,*7,"Your SSN was not found in the New Person File!"
14 . S TLI=""
15 S USR=$O(^PRSPC("SSN",SSN,0))
16 D TLL ; Loop to prompt for T&Ls
17 K DIC
18 I '$D(PRSTL) D EXIT Q
19 ; Prompt for Pay Period Date
20 S PPI=""
21 D DATE
22 I Y<1!(PPI<1) D EXIT Q
23 D DEVICE I POP D EXIT Q
24 I $D(IO("Q")) D D EXIT Q
25 . S PRSAPGM="QEN^PRSPCPPE"
26 . S PRSALST="MDAT^PPE^PPI^PRSIEN^PRSTL("
27 . D QUE^PRSAUTL
28 ;
29QEN ; queued entry point
30 ;
31 ; Loop through T&Ls identifying PTP's w/ exceptions
32 D LOOP
33 ; Display Exceptions
34 D DISPLAY
35 D EXIT
36 Q
37 ;
38TLL ; Loop to allow enting more than one T&L unit
39 ; Select T&L from among those allowed
40 K DIC,PRSTL
41 S Z1=$S(PRSTLV="2":"T",PRSTLV="3":"S",1:"*")
42 S TLI=$O(^PRST(455.5,"A"_Z1,DUZ,0))
43 I TLI<1 D Q
44 . W !!,*7,"No T&L Units have been assigned to you!"
45 . S TLI="^"
46 I $O(^PRST(455.5,"A"_Z1,DUZ,TLI))<1 D Q
47 . S TLE=$P($G(^PRST(455.5,TLI,0)),"^",1)
48 . S PRSTL(TLE)="",TLI=""
49 S DIC("S")="I $D(^PRST(455.5,+Y,Z1,DUZ))"
50TL S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="Select T&L Unit: "
51 F D Q:TLI=""!(TLI="^")
52 . W !
53 . I $D(PRSTL) S DIC("A")="Select Another T&L Unit: "
54 . D ^DIC
55 . I "^"[X!$D(DTOUT) S TLI="^" Q
56 . S TLI=+Y
57 . Q:'TLI
58 . S TLE=$P($G(^PRST(455.5,TLI,0)),"^",1)
59 . S PRSTL(TLE)=""
60 Q
61 ;
62DATE S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
63 Q:Y<1
64 S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
65 Q:PPI<1
66 S PPE=$P($G(^PRST(458,PPI,0)),U,1)
67 S MDAT=$P($G(^PRST(458,PPI,1)),U,1)
68 Q
69 ;
70DEVICE W !
71 S %ZIS("A")="Select DEVICE: ",%ZIS="MQ"
72 D ^%ZIS Q:POP
73 ;
74LOOP ; Loop through T&Ls identifying PTP's w/ exceptions
75 K ^TMP($J,"PRSPCPPE DATA")
76 S TLE="",QT=0
77 F S TLE=$O(PRSTL(TLE)) Q:TLE="" D Q:QT
78 . S TL="ATL"_TLE
79 . S NAME="",DATA1=$G(^PRST(458,PPI,1))
80 . F S NAME=$O(^PRSPC(TL,NAME)) Q:NAME="" D Q:QT
81 . . S PRSIEN=$O(^PRSPC(TL,NAME,0))
82 . . Q:'PRSIEN
83 . . Q:'+$$MIEN^PRSPUT1(PRSIEN,MDAT) ; Employee is not a PTP w/ Memo
84DAYCHK . . ; Loop through the days in the PP checking the ESR status
85 . . S (DAYCHK,IDAYS)=0
86 . . F DAY=1:1:14 Q:$P(DATA1,U,DAY)>DT D
87 . . . S DAYCHK=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7)),U,1)
88 . . . Q:DAYCHK>3 ; Not an exception
89 . . . S IDAYS=IDAYS+1
90 . . Q:IDAYS=0
91 . . ; Found at least 1 incomplete ESR
92 . . S ^TMP($J,"PRSPCPPE DATA",$P(^PRSPC(PRSIEN,0),U,1))=PRSIEN_"^"_IDAYS
93 Q
94 ;
95DISPLAY ; Display ESR for entire Pay Period. Sorted alphabetically
96 U IO
97 S QT=0,(NAME,PRSIEN)="",$P(DASH,"_",80)="_"
98 D LOOP^PRSPCPP1
99 D ^%ZISC K %ZIS,IOP
100 Q
101 ;
102 ;====================================================================
103TOP W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
104 W !?27,"DISPLAY PP ESR EXCEPTIONS"
105 Q
106 ;
107 ;====================================================================
108 ;
109EXIT ; Clean up variables
110 K %DT,%ZIS,D1,DASH,DATA,DATA0,DATA1,DATA5,DATA6,DATA7,DAY,DAY1,DAYCHK
111 K DFN,DIR,DIRUT,DTOUT,EDLSM,HRS,IDAYS,MDAT,MIEN,MT,NAME,PDT,PG,POP
112 K PPE,PPI,PRSALST,PRSAPGM,PRSIEN,PRSTL,PRSTLV,PTPRMKS,QT,QUIT,RC,RCEX
113 K SCRTTL,SEG,SSN,START,STAT,STATEX,STOP,SUPRMKS,T1,T1EX,T2,T2EX
114 K TL,TLE,TLI,TLSCREEN,TOT,TOTEX,USR,X,Y,Z1
115 K ^TMP($J,"PRSPCPPE DATA")
116 Q
Note: See TracBrowser for help on using the repository browser.