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

PRSA8BTH.m

Go to the documentation of this file.
  1. PRSA8BTH ;WOIFO/JAH - Tour Hours Display ;7/9/08
  1. ;;4.0;PAID;**117,110**;Sep 21, 1995;Build 7
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. TOURHRP ;Tour Hours Display for payroll
  1. N PRSTLV,FORWHO,TLS
  1. S PRSTLV=7
  1. S TLS=0
  1. S FORWHO="for Payroll"
  1. D MAIN
  1. Q
  1. ;
  1. TOURHRT ; Tour hours display for timekeeper
  1. N TLS,PRSTLV,FORWHO S TLS=1,PRSTLV=2,FORWHO="for Timekeeper"
  1. D MAIN
  1. Q
  1. ;
  1. TOURHRS ; Tour hours for T&L supervisor
  1. N PRSTLV,TLS,FORWHO S TLS=1,PRSTLV=3,FORWHO="for T&A Supervisor"
  1. D MAIN
  1. Q
  1. ;
  1. MAIN ;
  1. N DIR,DIRUT,Y,PPI,PPE,NOTOUR,NOTCARD,PPRANGE,DAILYHRS,EP,SP,SDT,EDT
  1. N SHONOTES,PRSIEN,TLI
  1. S PRSIEN=0
  1. I TLS=1 D
  1. . D ^PRSAUTL
  1. . Q:TLS=1&($G(TLI)="")
  1. . S PRSIEN=$$SELEMP(TLE)
  1. E D
  1. . S PRSIEN=$$SELEMP(0)
  1. Q:TLS=1&($G(TLI)="")!(PRSIEN'>0)
  1. ;
  1. S PPI=$$GETPP^PRSA8BNI()
  1. Q:PPI'>0
  1. S PPE=$P($G(^PRST(458,PPI,0)),U)
  1. S SDT=$P($G(^PRST(458,PPI,2)),U)
  1. S EDT=$P($G(^PRST(458,PPI,2)),U,14)
  1. S SP=$L(SDT," ")
  1. S EP=$L(EDT," ")
  1. S PPRANGE=$P(SDT," ",SP)_" thru "_$P(EDT," ",EP)
  1. ;
  1. S SHONOTES=$$SHONOTES^PRSA8BNI() ; want to see footnotes to display?
  1. Q:SHONOTES<0
  1. ;
  1. N %ZIS,POP,IOP,ZTSK
  1. S %ZIS="MQ"
  1. D ^%ZIS
  1. Q:POP
  1. I $D(IO("Q")) D
  1. . K IO("Q")
  1. . N ZTDESC,ZTRTN,ZTSAVE
  1. . S ZTDESC="PAID REPORT: TOUR HOURS DISPLAY"
  1. . S ZTRTN="TOUR8B^PRSA8BTH(PRSIEN)"
  1. . S ZTSAVE("PRSTLV")=""
  1. . S ZTSAVE("PRSIEN")=""
  1. . S ZTSAVE("TLE")=""
  1. . S ZTSAVE("PPI")=""
  1. . S ZTSAVE("PPE")=""
  1. . S ZTSAVE("TLS")=""
  1. . S ZTSAVE("PPRANGE")=""
  1. . S ZTSAVE("FORWHO")=""
  1. . S ZTSAVE("SHONOTES")=""
  1. . D ^%ZTLOAD
  1. . I $D(ZTSK) W !,"Task ",ZTSK," Queued."
  1. E D
  1. . D TOUR8B(PRSIEN)
  1. K PRSTLV
  1. D ^%ZISC K %ZIS,IOP
  1. W ! S OUT=$$ASK^PRSLIB00(1)
  1. Q
  1. ;
  1. SELEMP(TLE) ;Select employee by T&L or any employee if TLE = 0
  1. ;
  1. N DIC,EMPLOYEE,D,Y
  1. S DIC("A")="Select EMPLOYEE: "
  1. S DIC(0)="AEQM"
  1. S DIC="^PRSPC("
  1. I TLE]0 D
  1. . S D="ATL"_TLE
  1. . S DIC("S")="I $P(^(0),""^"",8)=TLE"
  1. . D IX^DIC
  1. E D
  1. . D ^DIC
  1. S EMPLOYEE=+Y
  1. Q EMPLOYEE
  1. ;
  1. TOUR8B(PRSIEN) ;
  1. U IO
  1. N DFN,OUT,TLECNT,TSTAMP,Y,%,%I,PG,ATL,ENT
  1. N EMPNODE,PRSENAME,HRS,EMPND1,SEPIND,WEEKHRS,PRSD,PRSSN
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. D NOW^%DTC S Y=% D DD^%DT S TSTAMP=$P(Y,":",1,2)
  1. S (OUT,PG)=0
  1. D HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE,1)
  1. ; skip Extended LWOP or anyone without a timecard
  1. I $G(^PRST(458,PPI,"E",PRSIEN,0))="" D Q
  1. . W !,"Employee doesn't have a timecard in this pay period"
  1. I $P($G(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,2)="" D Q
  1. . W !,"Employee doesn't have a tour of duty in this pay period" Q
  1. ;
  1. ; Try to get employee entitlement from the pay period being displayed
  1. ; otherwise we'll have to settle for current entitlement
  1. N ENTPOINT
  1. S ENTPOINT=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,5)
  1. I ENTPOINT>0 D
  1. . S ENT=$G(^PRST(457.5,ENTPOINT,0))
  1. I $G(ENT)="" D
  1. . S DFN=PRSIEN D ^PRSAENT
  1. I $E(ENT)="D"!($E(ENT,1,2)="0D") D Q
  1. . W !,"This employee is on daily tours with no tour hours"
  1. S EMPNODE=$G(^PRSPC(PRSIEN,0))
  1. S EMPND1=$G(^PRSPC(PRSIEN,1))
  1. S SEPIND=$P(EMPND1,U,33)
  1. Q:EMPNODE=""!(SEPIND="Y")
  1. ; call to get tour hours and 8b normal hours for the pay period, but
  1. ; if no 8b string on file then normal hours are current normal hrs.
  1. S WEEKHRS=$$GETHOURS^PRSA8BNI(PPI,PRSIEN)
  1. S PRSENAME=$P($G(^PRSPC(PRSIEN,0)),U)
  1. S PRSSN=$P($G(^PRSPC(PRSIEN,0)),U,9)
  1. S PRSSN=$S(PRSTLV=7:$E(PRSSN,1,3)_"-"_$E(PRSSN,4,5),PRSTLV'<2:$E(PRSSN,1)_"XX-XX",1:"XXX-XX")_"-"_$E(PRSSN,6,9)
  1. D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
  1. ; show the actual tour hours for each day
  1. N HRS,I
  1. D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
  1. D TRHDR^PRSA8BNI
  1. F PRSD=1:1:7 D Q:OUT
  1. . I $Y>(IOSL-4) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS),TRHDR^PRSA8BNI
  1. . Q:OUT
  1. . D TOURDISP^PRSA8BNH(PPI,PRSIEN,PRSD,.HRS)
  1. I SHONOTES S OUT=$$ASK^PRSLIB00() I 'OUT W @IOF D FOOTNOTE^PRSA8BNI(1)
  1. Q