- 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 Feb 18, 2025@23:49:37 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