Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSPCPPE

PRSPCPPE.m

Go to the documentation of this file.
  1. PRSPCPPE ; HISC/MGD - DISPLAY PP ESR EXCEPTIONS ;05/18/05
  1. ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. TK ; TimeKeeper Entry
  1. S PRSTLV=2 D T0 Q
  1. SUP ; Supervisor Entry
  1. S PRSTLV=3
  1. T0 D TOP ; print header
  1. S USR="",SSN=$P($G(^VA(200,DUZ,1)),"^",9)
  1. I SSN="" D D EXIT Q
  1. . W !!,*7,"Your SSN was not found in the New Person File!"
  1. . S TLI=""
  1. S USR=$O(^PRSPC("SSN",SSN,0))
  1. D TLL ; Loop to prompt for T&Ls
  1. K DIC
  1. I '$D(PRSTL) D EXIT Q
  1. ; Prompt for Pay Period Date
  1. S PPI=""
  1. D DATE
  1. I Y<1!(PPI<1) D EXIT Q
  1. D DEVICE I POP D EXIT Q
  1. I $D(IO("Q")) D D EXIT Q
  1. . S PRSAPGM="QEN^PRSPCPPE"
  1. . S PRSALST="MDAT^PPE^PPI^PRSIEN^PRSTL("
  1. . D QUE^PRSAUTL
  1. ;
  1. QEN ; queued entry point
  1. ;
  1. ; Loop through T&Ls identifying PTP's w/ exceptions
  1. D LOOP
  1. ; Display Exceptions
  1. D DISPLAY
  1. D EXIT
  1. Q
  1. ;
  1. TLL ; Loop to allow enting more than one T&L unit
  1. ; Select T&L from among those allowed
  1. K DIC,PRSTL
  1. S Z1=$S(PRSTLV="2":"T",PRSTLV="3":"S",1:"*")
  1. S TLI=$O(^PRST(455.5,"A"_Z1,DUZ,0))
  1. I TLI<1 D Q
  1. . W !!,*7,"No T&L Units have been assigned to you!"
  1. . S TLI="^"
  1. I $O(^PRST(455.5,"A"_Z1,DUZ,TLI))<1 D Q
  1. . S TLE=$P($G(^PRST(455.5,TLI,0)),"^",1)
  1. . S PRSTL(TLE)="",TLI=""
  1. S DIC("S")="I $D(^PRST(455.5,+Y,Z1,DUZ))"
  1. TL S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="Select T&L Unit: "
  1. F D Q:TLI=""!(TLI="^")
  1. . W !
  1. . I $D(PRSTL) S DIC("A")="Select Another T&L Unit: "
  1. . D ^DIC
  1. . I "^"[X!$D(DTOUT) S TLI="^" Q
  1. . S TLI=+Y
  1. . Q:'TLI
  1. . S TLE=$P($G(^PRST(455.5,TLI,0)),"^",1)
  1. . S PRSTL(TLE)=""
  1. Q
  1. ;
  1. DATE S %DT="AEPX",%DT("A")="Posting Date: ",%DT(0)=-DT W ! D ^%DT
  1. Q:Y<1
  1. S D1=Y S Y=$G(^PRST(458,"AD",D1)),PPI=$P(Y,"^",1)
  1. Q:PPI<1
  1. S PPE=$P($G(^PRST(458,PPI,0)),U,1)
  1. S MDAT=$P($G(^PRST(458,PPI,1)),U,1)
  1. Q
  1. ;
  1. DEVICE W !
  1. S %ZIS("A")="Select DEVICE: ",%ZIS="MQ"
  1. D ^%ZIS Q:POP
  1. ;
  1. LOOP ; Loop through T&Ls identifying PTP's w/ exceptions
  1. K ^TMP($J,"PRSPCPPE DATA")
  1. S TLE="",QT=0
  1. F S TLE=$O(PRSTL(TLE)) Q:TLE="" D Q:QT
  1. . S TL="ATL"_TLE
  1. . S NAME="",DATA1=$G(^PRST(458,PPI,1))
  1. . F S NAME=$O(^PRSPC(TL,NAME)) Q:NAME="" D Q:QT
  1. . . S PRSIEN=$O(^PRSPC(TL,NAME,0))
  1. . . Q:'PRSIEN
  1. . . Q:'+$$MIEN^PRSPUT1(PRSIEN,MDAT) ; Employee is not a PTP w/ Memo
  1. DAYCHK . . ; Loop through the days in the PP checking the ESR status
  1. . . S (DAYCHK,IDAYS)=0
  1. . . F DAY=1:1:14 Q:$P(DATA1,U,DAY)>DT D
  1. . . . S DAYCHK=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7)),U,1)
  1. . . . Q:DAYCHK>3 ; Not an exception
  1. . . . S IDAYS=IDAYS+1
  1. . . Q:IDAYS=0
  1. . . ; Found at least 1 incomplete ESR
  1. . . S ^TMP($J,"PRSPCPPE DATA",$P(^PRSPC(PRSIEN,0),U,1))=PRSIEN_"^"_IDAYS
  1. Q
  1. ;
  1. DISPLAY ; Display ESR for entire Pay Period. Sorted alphabetically
  1. U IO
  1. S QT=0,(NAME,PRSIEN)="",$P(DASH,"_",80)="_"
  1. D LOOP^PRSPCPP1
  1. D ^%ZISC K %ZIS,IOP
  1. Q
  1. ;
  1. ;====================================================================
  1. TOP W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
  1. W !?27,"DISPLAY PP ESR EXCEPTIONS"
  1. Q
  1. ;
  1. ;====================================================================
  1. ;
  1. EXIT ; Clean up variables
  1. K %DT,%ZIS,D1,DASH,DATA,DATA0,DATA1,DATA5,DATA6,DATA7,DAY,DAY1,DAYCHK
  1. K DFN,DIR,DIRUT,DTOUT,EDLSM,HRS,IDAYS,MDAT,MIEN,MT,NAME,PDT,PG,POP
  1. K PPE,PPI,PRSALST,PRSAPGM,PRSIEN,PRSTL,PRSTLV,PTPRMKS,QT,QUIT,RC,RCEX
  1. K SCRTTL,SEG,SSN,START,STAT,STATEX,STOP,SUPRMKS,T1,T1EX,T2,T2EX
  1. K TL,TLE,TLI,TLSCREEN,TOT,TOTEX,USR,X,Y,Z1
  1. K ^TMP($J,"PRSPCPPE DATA")
  1. Q