PRSRL41 ;HISC/JH-INDIVIDUAL EMPLOYEE LEAVE USAGE PATTERN (Continued) ;09/24/01
;;4.0;PAID;**2,19,21,35,69,141**;Sep 21, 1995;Build 3
;;Per VHA Directive 2004-038, this routine should not be modified
;
S ORG=$E(ORG,1,12)
D HDR1
S (PP(1),DAY(1),DATT(1))=""
S DATE(1)=0
;
;initialize leave arrays, subscripted by ("AL","SL","ML","WP"...)
F I=1:1 S X=$P($P(LVT,";",I+1),":") Q:X="" S LEV(X)="",TLEV(X)=""
D TYPSTF^PRSRUT0
S INX=0
;
;Loop through LEAVE pattern temp global.
;
;debug line
;W !!,"LEAVE PATTERN TEMP GLOBAL: "," ^TMP(",$J,",USE," Q
F I=0:0 S INX=$O(^TMP($J,"USE",INX)) Q:INX'>0 D Q:POUT
.;
.; Loop through each pay period.
. S PP=""
. F I=0:0 S PP=$O(^TMP($J,"USE",INX,PP)) Q:PP="" S SW(1)=0 D Q:POUT
..;
..; Loop through the dates within the pay period.
.. S DATE=0
.. F I=0:0 S DATE=$O(^TMP($J,"USE",INX,PP,DATE)) Q:DATE'>0 D Q:POUT
...;
...; Loop through days of week (even though only one per loop)
... S DAY=""
... F I=0:0 S DAY=$O(^TMP($J,"USE",INX,PP,DATE,DAY)) Q:DAY="" S TOUR=$G(^(DAY)) Q:TOUR="" S SW(3)=0 D Q:POUT
....;
.... D:($Y>(IOSL-5)) HDR Q:POUT
.... S DATT=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
.... D CHK,VLIN0:X>1
.... W !,"|"
.... W $S(PP'=PP(1):$E(PP,3,7),1:"")
.... W ?7,"|",DAY,?12,"|"
.... W $S(DATT'=DATT(1):DATT,1:""),?22,"|" D
..... D:TOUR["DO" DAY
..... I TOUR'["DO" F K=1:4 Q:$P(TOUR,"^",K+2)="" S LEV=$P(TOUR,"^",K+2),%=$F(LVT,";"_LEV_":") W:SW(3) !,"|",?7,"|",?12,"|",?22,"|" D
...... W:%>0 ?23,LEV
...... W ?27,"|",$P(TOUR,"^",K)
...... W ?35,"|",$P(TOUR,"^",K+1)
...... W ?43,"|"
...... S Z="^^"_DATE_"^"_$P(TOUR,"^",K)_"^"_DATE_"^"_$P(TOUR,"^",K+1) D
....... S COM=$G(^TMP($J,"US",INX))
....... D D^PRSRLL:$P($E(LVT,%,999),";")="ML"!(SW(2)=77),H^PRSRLL:$P($E(LVT,%,999),";")'="ML"&(SW(2)=73) W $S(SW(2)=77:$J(TIM,6),1:$J(TIM,6,2)),?($X+1),TYL,?52,"|",$S($D(COM):$E(COM,1,26),1:""),?79,"|" D
........ S LEV(LEV)=LEV(LEV)+TIM,TLEV(LEV)=TLEV(LEV)+TIM S SW(1)=SW(1)+1,SW(3)=1
........ Q
....... Q
...... Q
..... S PP(1)=PP,DATT(1)=DATT,DAY(1)=DAY,DATE(1)=DATE Q
.... Q
... Q
.. Q
. Q
;
; Print Totals
;
Q:POUT
D:$Y>(IOSL-7) VLIN0,HDR Q:POUT
I SW(1) D VLIN0 W !,"|",?7,"|",?12,"|",?15,"TOTALS:" S (SW(3),TLEV)=0,X="" D
. F I=0:0 S X=$O(TLEV(X)) Q:X="" D:$Y>(IOSL-5) HDR Q:POUT S %=$F(LVT,";"_X_":") W:SW(3)&(TLEV(X)'="") !,"|",?7,"|",?12,"|",?22,"|" S TLEV=TLEV+TLEV(X) D
.. W:TLEV(X)'="" ?24,$P($E(LVT,%,999),";"),?44,$S(SW(2)=77:$J($G(TLEV(X)),6),1:$J($G(TLEV(X)),6,2)),?($X+1),TYL,?52,"|",?79,"|" S:'SW(3)&(TLEV(X)'="") SW(3)=1
.. Q
. Q
I IOSL<66 F I=$Y:1:IOSL-6 D VLIN0
Q
CHK S X1=DATE,X2=DATE(1) D ^%DTC Q
DAY W TOUR,?27,"|",?35,"|",?43,"|",?52,"|",?79,"|" S SW(1)=SW(1)+1 Q
HDR S CODE="L005",FOOT="VA TIME & ATTENDANCE SYSTEM" D VLIDSH0,FOOT2^PRSRUT0
I $E(IOST)="C"!($G(IOT)="VTRM") R !,"Press Return/Enter to continue. ",II:DTIME S:II="^" POUT=1 Q:POUT
Q:POUT
HDR1 ; Main header for report contains:
; Title, ALL/ONLY, date, date range, employee, cost center, T&L unit
;
; Subheader according to type of report user selected
S SUBHDR=$S(ALOO="A":"All Leave Taken With Days Off",1:"Every Occurrence of Leave, ONLY Before And After Days Off")
W @IOF
W !?29,^TMP($J,"USE"),?66
W "DATE: ",DAT,!?22,"from: ",XX," to ",YY
W !,?(80-$L(SUBHDR))\2,SUBHDR ;tab depending on length of subheader
W !?25,"for: ",NAM," - "
W ORG,!,?33
W "T&L Unit: ",TLE
D VLIDSH0
W !,"|","P/P",?7,"|","DAY",?12,"|","DATE",?22,"|","TYPE",?27,"|","FROM",?35,"|","TO",?43,"|","LENGTH",?52,"|","COMMENT",?79,"|" D VLIDSH0 Q
VLIDSH0 W !,"|------|----|---------|----|-------|-------|--------|--------------------------|" Q
VLIN0 W !,"|",?7,"|",?12,"|",?22,"|",?27,"|",?35,"|",?43,"|",?52,"|",?79,"|" Q
ASKDSPLY() ; Ask user if they want to see all leave, including days off and
; Holidays or if they want to see only leave taken immediately
; before or after Holidays and days off.
N DIR
S RTN=""
S DIR(0)="SM^A:All leave;O:Only around days off & holidays"
S DIR("A")=" Choose A or O "
S DIR("A",1)="You may display ALL leave taken within the date range"
S DIR("A",2)="or ONLY leave taken the day before and after holidays"
S DIR("A",3)="and scheduled days off."
S DIR("A",4)=""
S DIR("?",1)="If you select ONLY leave around days off and holidays,"
S DIR("?",2)="then for example, when an employee with weekends off has"
S DIR("?",3)="taken annual leave for the entire week (Mon-Fri), only"
S DIR("?",4)="the leave for Monday and Friday will be displayed."
S DIR("?")="Selecting ALL, will display all leave taken."
D ^DIR S RTN=Y
Q RTN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSRL41 4770 printed Apr 09, 2024@21:27:45 Page 2
PRSRL41 ;HISC/JH-INDIVIDUAL EMPLOYEE LEAVE USAGE PATTERN (Continued) ;09/24/01
+1 ;;4.0;PAID;**2,19,21,35,69,141**;Sep 21, 1995;Build 3
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 SET ORG=$EXTRACT(ORG,1,12)
+5 DO HDR1
+6 SET (PP(1),DAY(1),DATT(1))=""
+7 SET DATE(1)=0
+8 ;
+9 ;initialize leave arrays, subscripted by ("AL","SL","ML","WP"...)
+10 FOR I=1:1
SET X=$PIECE($PIECE(LVT,";",I+1),":")
if X=""
QUIT
SET LEV(X)=""
SET TLEV(X)=""
+11 DO TYPSTF^PRSRUT0
+12 SET INX=0
+13 ;
+14 ;Loop through LEAVE pattern temp global.
+15 ;
+16 ;debug line
+17 ;W !!,"LEAVE PATTERN TEMP GLOBAL: "," ^TMP(",$J,",USE," Q
+18 FOR I=0:0
SET INX=$ORDER(^TMP($JOB,"USE",INX))
if INX'>0
QUIT
Begin DoDot:1
+19 ;
+20 ; Loop through each pay period.
+21 SET PP=""
+22 FOR I=0:0
SET PP=$ORDER(^TMP($JOB,"USE",INX,PP))
if PP=""
QUIT
SET SW(1)=0
Begin DoDot:2
+23 ;
+24 ; Loop through the dates within the pay period.
+25 SET DATE=0
+26 FOR I=0:0
SET DATE=$ORDER(^TMP($JOB,"USE",INX,PP,DATE))
if DATE'>0
QUIT
Begin DoDot:3
+27 ;
+28 ; Loop through days of week (even though only one per loop)
+29 SET DAY=""
+30 FOR I=0:0
SET DAY=$ORDER(^TMP($JOB,"USE",INX,PP,DATE,DAY))
if DAY=""
QUIT
SET TOUR=$GET(^(DAY))
if TOUR=""
QUIT
SET SW(3)=0
Begin DoDot:4
+31 ;
+32 if ($Y>(IOSL-5))
DO HDR
if POUT
QUIT
+33 SET DATT=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+34 DO CHK
if X>1
DO VLIN0
+35 WRITE !,"|"
+36 WRITE $SELECT(PP'=PP(1):$EXTRACT(PP,3,7),1:"")
+37 WRITE ?7,"|",DAY,?12,"|"
+38 WRITE $SELECT(DATT'=DATT(1):DATT,1:""),?22,"|"
Begin DoDot:5
+39 if TOUR["DO"
DO DAY
+40 IF TOUR'["DO"
FOR K=1:4
if $PIECE(TOUR,"^",K+2)=""
QUIT
SET LEV=$PIECE(TOUR,"^",K+2)
SET %=$FIND(LVT,";"_LEV_":")
if SW(3)
WRITE !,"|",?7,"|",?12,"|",?22,"|"
Begin DoDot:6
+41 if %>0
WRITE ?23,LEV
+42 WRITE ?27,"|",$PIECE(TOUR,"^",K)
+43 WRITE ?35,"|",$PIECE(TOUR,"^",K+1)
+44 WRITE ?43,"|"
+45 SET Z="^^"_DATE_"^"_$PIECE(TOUR,"^",K)_"^"_DATE_"^"_$PIECE(TOUR,"^",K+1)
Begin DoDot:7
+46 SET COM=$GET(^TMP($JOB,"US",INX))
+47 if $PIECE($EXTRACT(LVT,%,999),";")="ML"!(SW(2)=77)
DO D^PRSRLL
if $PIECE($EXTRACT(LVT,%,999),";")'="ML"&(SW(2)=73)
DO H^PRSRLL
WRITE $SELECT(SW(2)=77:$JUSTIFY(TIM,6),1:$JUSTIFY(TIM,6,2)),?($X+1),TYL,?52,"|",$SELECT($DATA(COM):$EXTRACT(COM,1,26),1:""),?79,"|"
Begin DoDot:8
+48 SET LEV(LEV)=LEV(LEV)+TIM
SET TLEV(LEV)=TLEV(LEV)+TIM
SET SW(1)=SW(1)+1
SET SW(3)=1
+49 QUIT
End DoDot:8
+50 QUIT
End DoDot:7
+51 QUIT
End DoDot:6
+52 SET PP(1)=PP
SET DATT(1)=DATT
SET DAY(1)=DAY
SET DATE(1)=DATE
QUIT
End DoDot:5
+53 QUIT
End DoDot:4
if POUT
QUIT
+54 QUIT
End DoDot:3
if POUT
QUIT
+55 QUIT
End DoDot:2
if POUT
QUIT
+56 QUIT
End DoDot:1
if POUT
QUIT
+57 ;
+58 ; Print Totals
+59 ;
+60 if POUT
QUIT
+61 if $Y>(IOSL-7)
DO VLIN0
DO HDR
if POUT
QUIT
+62 IF SW(1)
DO VLIN0
WRITE !,"|",?7,"|",?12,"|",?15,"TOTALS:"
SET (SW(3),TLEV)=0
SET X=""
Begin DoDot:1
+63 FOR I=0:0
SET X=$ORDER(TLEV(X))
if X=""
QUIT
if $Y>(IOSL-5)
DO HDR
if POUT
QUIT
SET %=$FIND(LVT,";"_X_":")
if SW(3)&(TLEV(X)'="")
WRITE !,"|",?7,"|",?12,"|",?22,"|"
SET TLEV=TLEV+TLEV(X)
Begin DoDot:2
+64 if TLEV(X)'=""
WRITE ?24,$PIECE($EXTRACT(LVT,%,999),";"),?44,$SELECT(SW(2)=77:$JUSTIFY($GET(TLEV(X)),6),1:$JUSTIFY($GET(TLEV(X)),6,2)),?($X+1),TYL,?52,"|",?79,"|"
if 'SW(3)&(TLEV(X)'="")
SET SW(3)=1
+65 QUIT
End DoDot:2
+66 QUIT
End DoDot:1
+67 IF IOSL<66
FOR I=$Y:1:IOSL-6
DO VLIN0
+68 QUIT
CHK SET X1=DATE
SET X2=DATE(1)
DO ^%DTC
QUIT
DAY WRITE TOUR,?27,"|",?35,"|",?43,"|",?52,"|",?79,"|"
SET SW(1)=SW(1)+1
QUIT
HDR SET CODE="L005"
SET FOOT="VA TIME & ATTENDANCE SYSTEM"
DO VLIDSH0
DO FOOT2^PRSRUT0
+1 IF $EXTRACT(IOST)="C"!($GET(IOT)="VTRM")
READ !,"Press Return/Enter to continue. ",II:DTIME
if II="^"
SET POUT=1
if POUT
QUIT
+2 if POUT
QUIT
HDR1 ; Main header for report contains:
+1 ; Title, ALL/ONLY, date, date range, employee, cost center, T&L unit
+2 ;
+3 ; Subheader according to type of report user selected
+4 SET SUBHDR=$SELECT(ALOO="A":"All Leave Taken With Days Off",1:"Every Occurrence of Leave, ONLY Before And After Days Off")
+5 WRITE @IOF
+6 WRITE !?29,^TMP($JOB,"USE"),?66
+7 WRITE "DATE: ",DAT,!?22,"from: ",XX," to ",YY
+8 ;tab depending on length of subheader
WRITE !,?(80-$LENGTH(SUBHDR))\2,SUBHDR
+9 WRITE !?25,"for: ",NAM," - "
+10 WRITE ORG,!,?33
+11 WRITE "T&L Unit: ",TLE
+12 DO VLIDSH0
+13 WRITE !,"|","P/P",?7,"|","DAY",?12,"|","DATE",?22,"|","TYPE",?27,"|","FROM",?35,"|","TO",?43,"|","LENGTH",?52,"|","COMMENT",?79,"|"
DO VLIDSH0
QUIT
VLIDSH0 WRITE !,"|------|----|---------|----|-------|-------|--------|--------------------------|"
QUIT
VLIN0 WRITE !,"|",?7,"|",?12,"|",?22,"|",?27,"|",?35,"|",?43,"|",?52,"|",?79,"|"
QUIT
ASKDSPLY() ; Ask user if they want to see all leave, including days off and
+1 ; Holidays or if they want to see only leave taken immediately
+2 ; before or after Holidays and days off.
+3 NEW DIR
+4 SET RTN=""
+5 SET DIR(0)="SM^A:All leave;O:Only around days off & holidays"
+6 SET DIR("A")=" Choose A or O "
+7 SET DIR("A",1)="You may display ALL leave taken within the date range"
+8 SET DIR("A",2)="or ONLY leave taken the day before and after holidays"
+9 SET DIR("A",3)="and scheduled days off."
+10 SET DIR("A",4)=""
+11 SET DIR("?",1)="If you select ONLY leave around days off and holidays,"
+12 SET DIR("?",2)="then for example, when an employee with weekends off has"
+13 SET DIR("?",3)="taken annual leave for the entire week (Mon-Fri), only"
+14 SET DIR("?",4)="the leave for Monday and Friday will be displayed."
+15 SET DIR("?")="Selecting ALL, will display all leave taken."
+16 DO ^DIR
SET RTN=Y
+17 QUIT RTN
