| [613] | 1 | PRSPCPPE ; 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 | ;
|
|---|
| 6 | TK ; TimeKeeper Entry
|
|---|
| 7 | S PRSTLV=2 D T0 Q
|
|---|
| 8 | SUP ; Supervisor Entry
|
|---|
| 9 | S PRSTLV=3
|
|---|
| 10 | T0 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 | ;
|
|---|
| 29 | QEN ; 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 | ;
|
|---|
| 38 | TLL ; 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))"
|
|---|
| 50 | TL 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 | ;
|
|---|
| 62 | DATE 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 | ;
|
|---|
| 70 | DEVICE W !
|
|---|
| 71 | S %ZIS("A")="Select DEVICE: ",%ZIS="MQ"
|
|---|
| 72 | D ^%ZIS Q:POP
|
|---|
| 73 | ;
|
|---|
| 74 | LOOP ; 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
|
|---|
| 84 | DAYCHK . . ; 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 | ;
|
|---|
| 95 | DISPLAY ; 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 | ;====================================================================
|
|---|
| 103 | TOP 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 | ;
|
|---|
| 109 | EXIT ; 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
|
|---|
