- 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 Feb 18, 2025@23:55:05 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
