PRSA8BTH ;WOIFO/JAH - Tour Hours Display ;7/9/08
;;4.0;PAID;**117,110**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
TOURHRP ;Tour Hours Display for payroll
N PRSTLV,FORWHO,TLS
S PRSTLV=7
S TLS=0
S FORWHO="for Payroll"
D MAIN
Q
;
TOURHRT ; Tour hours display for timekeeper
N TLS,PRSTLV,FORWHO S TLS=1,PRSTLV=2,FORWHO="for Timekeeper"
D MAIN
Q
;
TOURHRS ; Tour hours for T&L supervisor
N PRSTLV,TLS,FORWHO S TLS=1,PRSTLV=3,FORWHO="for T&A Supervisor"
D MAIN
Q
;
MAIN ;
N DIR,DIRUT,Y,PPI,PPE,NOTOUR,NOTCARD,PPRANGE,DAILYHRS,EP,SP,SDT,EDT
N SHONOTES,PRSIEN,TLI
S PRSIEN=0
I TLS=1 D
. D ^PRSAUTL
. Q:TLS=1&($G(TLI)="")
. S PRSIEN=$$SELEMP(TLE)
E D
. S PRSIEN=$$SELEMP(0)
Q:TLS=1&($G(TLI)="")!(PRSIEN'>0)
;
S PPI=$$GETPP^PRSA8BNI()
Q:PPI'>0
S PPE=$P($G(^PRST(458,PPI,0)),U)
S SDT=$P($G(^PRST(458,PPI,2)),U)
S EDT=$P($G(^PRST(458,PPI,2)),U,14)
S SP=$L(SDT," ")
S EP=$L(EDT," ")
S PPRANGE=$P(SDT," ",SP)_" thru "_$P(EDT," ",EP)
;
S SHONOTES=$$SHONOTES^PRSA8BNI() ; want to see footnotes to display?
Q:SHONOTES<0
;
N %ZIS,POP,IOP,ZTSK
S %ZIS="MQ"
D ^%ZIS
Q:POP
I $D(IO("Q")) D
. K IO("Q")
. N ZTDESC,ZTRTN,ZTSAVE
. S ZTDESC="PAID REPORT: TOUR HOURS DISPLAY"
. S ZTRTN="TOUR8B^PRSA8BTH(PRSIEN)"
. S ZTSAVE("PRSTLV")=""
. S ZTSAVE("PRSIEN")=""
. S ZTSAVE("TLE")=""
. S ZTSAVE("PPI")=""
. S ZTSAVE("PPE")=""
. S ZTSAVE("TLS")=""
. S ZTSAVE("PPRANGE")=""
. S ZTSAVE("FORWHO")=""
. S ZTSAVE("SHONOTES")=""
. D ^%ZTLOAD
. I $D(ZTSK) W !,"Task ",ZTSK," Queued."
E D
. D TOUR8B(PRSIEN)
K PRSTLV
D ^%ZISC K %ZIS,IOP
W ! S OUT=$$ASK^PRSLIB00(1)
Q
;
SELEMP(TLE) ;Select employee by T&L or any employee if TLE = 0
;
N DIC,EMPLOYEE,D,Y
S DIC("A")="Select EMPLOYEE: "
S DIC(0)="AEQM"
S DIC="^PRSPC("
I TLE]0 D
. S D="ATL"_TLE
. S DIC("S")="I $P(^(0),""^"",8)=TLE"
. D IX^DIC
E D
. D ^DIC
S EMPLOYEE=+Y
Q EMPLOYEE
;
TOUR8B(PRSIEN) ;
U IO
N DFN,OUT,TLECNT,TSTAMP,Y,%,%I,PG,ATL,ENT
N EMPNODE,PRSENAME,HRS,EMPND1,SEPIND,WEEKHRS,PRSD,PRSSN
I $D(ZTQUEUED) S ZTREQ="@"
D NOW^%DTC S Y=% D DD^%DT S TSTAMP=$P(Y,":",1,2)
S (OUT,PG)=0
D HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE,1)
; skip Extended LWOP or anyone without a timecard
I $G(^PRST(458,PPI,"E",PRSIEN,0))="" D Q
. W !,"Employee doesn't have a timecard in this pay period"
I $P($G(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,2)="" D Q
. W !,"Employee doesn't have a tour of duty in this pay period" Q
;
; Try to get employee entitlement from the pay period being displayed
; otherwise we'll have to settle for current entitlement
N ENTPOINT
S ENTPOINT=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,5)
I ENTPOINT>0 D
. S ENT=$G(^PRST(457.5,ENTPOINT,0))
I $G(ENT)="" D
. S DFN=PRSIEN D ^PRSAENT
I $E(ENT)="D"!($E(ENT,1,2)="0D") D Q
. W !,"This employee is on daily tours with no tour hours"
S EMPNODE=$G(^PRSPC(PRSIEN,0))
S EMPND1=$G(^PRSPC(PRSIEN,1))
S SEPIND=$P(EMPND1,U,33)
Q:EMPNODE=""!(SEPIND="Y")
; call to get tour hours and 8b normal hours for the pay period, but
; if no 8b string on file then normal hours are current normal hrs.
S WEEKHRS=$$GETHOURS^PRSA8BNI(PPI,PRSIEN)
S PRSENAME=$P($G(^PRSPC(PRSIEN,0)),U)
S PRSSN=$P($G(^PRSPC(PRSIEN,0)),U,9)
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)
D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
; show the actual tour hours for each day
N HRS,I
D TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
D TRHDR^PRSA8BNI
F PRSD=1:1:7 D Q:OUT
. I $Y>(IOSL-4) S OUT=$$RET^PRSA8BNI(TSTAMP) Q:OUT D EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS),TRHDR^PRSA8BNI
. Q:OUT
. D TOURDISP^PRSA8BNH(PPI,PRSIEN,PRSD,.HRS)
I SHONOTES S OUT=$$ASK^PRSLIB00() I 'OUT W @IOF D FOOTNOTE^PRSA8BNI(1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSA8BTH 3935 printed Oct 16, 2024@18:23:57 Page 2
PRSA8BTH ;WOIFO/JAH - Tour Hours Display ;7/9/08
+1 ;;4.0;PAID;**117,110**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
TOURHRP ;Tour Hours Display for payroll
+1 NEW PRSTLV,FORWHO,TLS
+2 SET PRSTLV=7
+3 SET TLS=0
+4 SET FORWHO="for Payroll"
+5 DO MAIN
+6 QUIT
+7 ;
TOURHRT ; Tour hours display for timekeeper
+1 NEW TLS,PRSTLV,FORWHO
SET TLS=1
SET PRSTLV=2
SET FORWHO="for Timekeeper"
+2 DO MAIN
+3 QUIT
+4 ;
TOURHRS ; Tour hours for T&L supervisor
+1 NEW PRSTLV,TLS,FORWHO
SET TLS=1
SET PRSTLV=3
SET FORWHO="for T&A Supervisor"
+2 DO MAIN
+3 QUIT
+4 ;
MAIN ;
+1 NEW DIR,DIRUT,Y,PPI,PPE,NOTOUR,NOTCARD,PPRANGE,DAILYHRS,EP,SP,SDT,EDT
+2 NEW SHONOTES,PRSIEN,TLI
+3 SET PRSIEN=0
+4 IF TLS=1
Begin DoDot:1
+5 DO ^PRSAUTL
+6 if TLS=1&($GET(TLI)="")
QUIT
+7 SET PRSIEN=$$SELEMP(TLE)
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET PRSIEN=$$SELEMP(0)
End DoDot:1
+10 if TLS=1&($GET(TLI)="")!(PRSIEN'>0)
QUIT
+11 ;
+12 SET PPI=$$GETPP^PRSA8BNI()
+13 if PPI'>0
QUIT
+14 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U)
+15 SET SDT=$PIECE($GET(^PRST(458,PPI,2)),U)
+16 SET EDT=$PIECE($GET(^PRST(458,PPI,2)),U,14)
+17 SET SP=$LENGTH(SDT," ")
+18 SET EP=$LENGTH(EDT," ")
+19 SET PPRANGE=$PIECE(SDT," ",SP)_" thru "_$PIECE(EDT," ",EP)
+20 ;
+21 ; want to see footnotes to display?
SET SHONOTES=$$SHONOTES^PRSA8BNI()
+22 if SHONOTES<0
QUIT
+23 ;
+24 NEW %ZIS,POP,IOP,ZTSK
+25 SET %ZIS="MQ"
+26 DO ^%ZIS
+27 if POP
QUIT
+28 IF $DATA(IO("Q"))
Begin DoDot:1
+29 KILL IO("Q")
+30 NEW ZTDESC,ZTRTN,ZTSAVE
+31 SET ZTDESC="PAID REPORT: TOUR HOURS DISPLAY"
+32 SET ZTRTN="TOUR8B^PRSA8BTH(PRSIEN)"
+33 SET ZTSAVE("PRSTLV")=""
+34 SET ZTSAVE("PRSIEN")=""
+35 SET ZTSAVE("TLE")=""
+36 SET ZTSAVE("PPI")=""
+37 SET ZTSAVE("PPE")=""
+38 SET ZTSAVE("TLS")=""
+39 SET ZTSAVE("PPRANGE")=""
+40 SET ZTSAVE("FORWHO")=""
+41 SET ZTSAVE("SHONOTES")=""
+42 DO ^%ZTLOAD
+43 IF $DATA(ZTSK)
WRITE !,"Task ",ZTSK," Queued."
End DoDot:1
+44 IF '$TEST
Begin DoDot:1
+45 DO TOUR8B(PRSIEN)
End DoDot:1
+46 KILL PRSTLV
+47 DO ^%ZISC
KILL %ZIS,IOP
+48 WRITE !
SET OUT=$$ASK^PRSLIB00(1)
+49 QUIT
+50 ;
SELEMP(TLE) ;Select employee by T&L or any employee if TLE = 0
+1 ;
+2 NEW DIC,EMPLOYEE,D,Y
+3 SET DIC("A")="Select EMPLOYEE: "
+4 SET DIC(0)="AEQM"
+5 SET DIC="^PRSPC("
+6 IF TLE]0
Begin DoDot:1
+7 SET D="ATL"_TLE
+8 SET DIC("S")="I $P(^(0),""^"",8)=TLE"
+9 DO IX^DIC
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 DO ^DIC
End DoDot:1
+12 SET EMPLOYEE=+Y
+13 QUIT EMPLOYEE
+14 ;
TOUR8B(PRSIEN) ;
+1 USE IO
+2 NEW DFN,OUT,TLECNT,TSTAMP,Y,%,%I,PG,ATL,ENT
+3 NEW EMPNODE,PRSENAME,HRS,EMPND1,SEPIND,WEEKHRS,PRSD,PRSSN
+4 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET TSTAMP=$PIECE(Y,":",1,2)
+6 SET (OUT,PG)=0
+7 DO HDR^PRSA8BNI(.PG,TSTAMP,0,FORWHO,PPE,PPRANGE,1)
+8 ; skip Extended LWOP or anyone without a timecard
+9 IF $GET(^PRST(458,PPI,"E",PRSIEN,0))=""
Begin DoDot:1
+10 WRITE !,"Employee doesn't have a timecard in this pay period"
End DoDot:1
QUIT
+11 IF $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,2)=""
Begin DoDot:1
+12 WRITE !,"Employee doesn't have a tour of duty in this pay period"
QUIT
End DoDot:1
QUIT
+13 ;
+14 ; Try to get employee entitlement from the pay period being displayed
+15 ; otherwise we'll have to settle for current entitlement
+16 NEW ENTPOINT
+17 SET ENTPOINT=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",1,0)),U,5)
+18 IF ENTPOINT>0
Begin DoDot:1
+19 SET ENT=$GET(^PRST(457.5,ENTPOINT,0))
End DoDot:1
+20 IF $GET(ENT)=""
Begin DoDot:1
+21 SET DFN=PRSIEN
DO ^PRSAENT
End DoDot:1
+22 IF $EXTRACT(ENT)="D"!($EXTRACT(ENT,1,2)="0D")
Begin DoDot:1
+23 WRITE !,"This employee is on daily tours with no tour hours"
End DoDot:1
QUIT
+24 SET EMPNODE=$GET(^PRSPC(PRSIEN,0))
+25 SET EMPND1=$GET(^PRSPC(PRSIEN,1))
+26 SET SEPIND=$PIECE(EMPND1,U,33)
+27 if EMPNODE=""!(SEPIND="Y")
QUIT
+28 ; call to get tour hours and 8b normal hours for the pay period, but
+29 ; if no 8b string on file then normal hours are current normal hrs.
+30 SET WEEKHRS=$$GETHOURS^PRSA8BNI(PPI,PRSIEN)
+31 SET PRSENAME=$PIECE($GET(^PRSPC(PRSIEN,0)),U)
+32 SET PRSSN=$PIECE($GET(^PRSPC(PRSIEN,0)),U,9)
+33 SET PRSSN=$SELECT(PRSTLV=7:$EXTRACT(PRSSN,1,3)_"-"_$EXTRACT(PRSSN,4,5),PRSTLV'<2:$EXTRACT(PRSSN,1)_"XX-XX",1:"XXX-XX")_"-"_$EXTRACT(PRSSN,6,9)
+34 DO EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
+35 ; show the actual tour hours for each day
+36 NEW HRS,I
+37 DO TOURHRS^PRSARC07(.HRS,PPI,PRSIEN)
+38 DO TRHDR^PRSA8BNI
+39 FOR PRSD=1:1:7
Begin DoDot:1
+40 IF $Y>(IOSL-4)
SET OUT=$$RET^PRSA8BNI(TSTAMP)
if OUT
QUIT
DO EMPINFO^PRSA8BNI(PRSENAME,PRSSN,WEEKHRS)
DO TRHDR^PRSA8BNI
+41 if OUT
QUIT
+42 DO TOURDISP^PRSA8BNH(PPI,PRSIEN,PRSD,.HRS)
End DoDot:1
if OUT
QUIT
+43 IF SHONOTES
SET OUT=$$ASK^PRSLIB00()
IF 'OUT
WRITE @IOF
DO FOOTNOTE^PRSA8BNI(1)
+44 QUIT
