- PRSATE2 ; HISC/REL,WIRMFO/JAH - Display Employee Tour of Duty ;3/3/1998
- ;;4.0;PAID;**8,22,35,114,132**;Sep 21, 1995;Build 13
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;VARIABLES:
- ; PPI = Pay period internal entry number from file 458
- ; PPE = Pay period number in YY-PP format (e.g. 97-03)
- ; HOLDSCR = dummy variable used to hold value from hold screen
- ; extrinsic function call.
- ; PRSTLV = flag: contains 2 for timekeepers and 3 for supervisors.
- ; TLI = Internal entry of the T&L unit
- ; DFN = DFN is defined in a call from routine PRSATE to label NOL.
- ; Otherwise DFN is set to zero.
- ; SRT = Report sort entered by user.
- ; (C = current pp, L = last pp, N = next pp)
- ;
- TK ; TimeKeeper Entry
- S PRSTLV=2 G TL
- SUP ; Supervisor Entry
- S PRSTLV=3 G TL
- TL N HOLDSCR
- ;
- ;Ask user to select a Time and Leave Unit: go to exit if unsuccessful
- D ^PRSAUTL G:TLI<1 EX
- ;
- ;set PPI to the last pay period opened by Payroll
- S PPI=$P(^PRST(458,0),"^",3),PPE=$P($G(^PRST(458,PPI,0)),"^",1)
- ;
- ;
- S DFN=0 D NOL G:SRT="^" EX
- ;
- ;If user chose last pay periods tour then decrement pay period.
- I SRT="L" S PPI=PPI-1,PPE=$P($G(^PRST(458,PPI,0)),"^",1)
- ;
- ;If user chose Next pay period's tour of duty
- ;then increment pay period. This value is for display only,
- ;since the actual data for a tour change for the next pay period
- ;is stored on the 4 node of the current pay period.
- I SRT="N" S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7)
- ;
- T1 ;ask type of output
- S DIR(0)="SA^S:SHORT;L:LONG"
- S DIR("A")="Select Type of Display (S or L): ",DIR("B")="SHORT"
- S DIR("?")="Answer S for Tour Titles, L for Detailed Time Segments"
- D ^DIR K DIR G:$D(DIRUT) EX
- S TYP=Y
- ;
- NME ;Ask user what employee they want to display tour of duty for.
- K DIC S DIC("A")="Select EMPLOYEE: "
- S DIC("S")="I $P(^(0),""^"",8)=TLE"
- S DIC(0)="AEQM"
- S DIC="^PRSPC(",D="ATL"_TLE
- W ! D IX^DIC S DFN=+Y K DIC
- ;
- I DFN<1 G EX
- W ! K IOP,%ZIS
- S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
- I $D(IO("Q")) S PRSAPGM="Q1^PRSATE2",PRSALST="TLI^TLE^TYP^SRT^DFN^PPI^PPE" D QUE^PRSAUTL G NME
- U IO D Q1 D ^%ZISC K %ZIS,IOP G NME
- Q1 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
- W !?29,"EMPLOYEE TOUR OF DUTY"
- D:TYP="S" S0
- D:TYP="L" L0
- I $E(IOST,1,2)="C-" S HOLDSCR=$$ASK^PRSLIB00(1)
- Q
- ;====================================================================
- S0 ; Short Display
- ;Loop thru both weeks of pay period simultaneously,
- ;displaying sun-sat side by side.
- D HDR^PRSADP1,DT
- W !!?7,"TW Week 1 - ",$E(Y1,5,13),?41,"TW Week 2 - ",$E(Y2,5,13),!
- F DAY=1:1:7 D S1
- Q
- ;====================================================================
- S1 ;
- ; Y1 = employee tour of duty node 4 current day of week one.
- ; Y2 = employee tour of duty node 4 current day of week two.
- ; Y2 = node 8 telework
- ; TD = tour of duty pointer to Tour of Duty file.
- ;
- N Y1,Y2,Y8,TD,PRSA
- S Y1=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),Y8=$G(^(8)),TD=$P(Y1,"^",2),PRSA=$P(Y8,U)
- I SRT="N",$P(Y1,"^",3) S TD=$P(Y1,"^",4),PRSA=$P(Y8,U,5)
- W !?2,$P("Sun Mon Tue Wed Thu Fri Sat"," ",DAY)
- W ?7,PRSA W:TD ?11,$P($G(^PRST(457.1,TD,0)),"^",1)
- S Y2=$G(^PRST(458,PPI,"E",DFN,"D",DAY+7,0)),Y8=$G(^(8)),TD=$P(Y2,"^",2),PRSA=$P(Y8,U)
- I SRT="N",$P(Y2,"^",3) S TD=$P(Y2,"^",4),PRSA=$P(Y8,U,5)
- W ?41,PRSA W:TD ?45,$P($G(^PRST(457.1,TD,0)),"^",1) Q:SRT="N"
- I $P(Y1,"^",13)="",$P(Y2,"^",13)="" Q
- W ! S TD=$P(Y1,"^",13)
- W:TD ?11,$P($G(^PRST(457.1,TD,0)),"^",1)
- S TD=$P(Y2,"^",13) W:TD ?45,$P($G(^PRST(457.1,TD,0)),"^",1)
- Q
- ;====================================================================
- L0 ; Long Display
- S C0=^PRSPC(DFN,0)
- W !!,$P(C0,U),?30,"Telework Indicator: ",$S($P($$TWE^PRSATE0(DFN,PPI),U,3)]"":$P($$TWE^PRSATE0(DFN,PPI),U,3),1:"None")
- S X=$P(C0,U,9) W ?65,$E(X),"XX-XX-",$E(X,6,9)
- D DT W !!,?7,"TW Week 1 - ",$E(Y1,5,13),?41,"TW Week 2 - ",$E(Y2,5,13),!
- F DAY=1:1:7 D ^PRSATE3
- Q
- ;
- H1 I $E(IOST,1,2)="C-" S QT=$$ASK^PRSLIB00()
- Q
- DT ; Get date of PP
- I SRT'="N" S Y1=$P($G(^PRST(458,PPI,2)),"^",1),Y2=$P($G(^(2)),"^",8) Q
- N X,Y,X1,X2 S X1=$P($G(^PRST(458,PPI,1)),"^",1),X2=14 D C^%DTC,DTP^PRSAPPU S Y1=" "_Y
- S X1=X,X2=7 D C^%DTC,DTP^PRSAPPU S Y2=" "_Y Q
- Q
- NOL ; Select this PP or Next
- ;
- ;SCL is set to 1 when NOL is called from this routine.
- ;SCL is set to CN when NOL is called from PRSATE.
- S SCL=$S(DFN:"",1:"CN")
- ;
- ;X,D1 is set to FileMan dates of selected pay period.
- S (X,D1)=$P($G(^PRST(458,PPI,1)),"^",1)
- W !
- ;
- ;if called from PRSATE and employee has data in this pay period
- ;then set sort = next pp. Then if the timecard has been transmitted
- ;already set sort = current, next
- I DFN,$D(^PRST(458,PPI,"E",DFN,0)) S SCL="N" I $P(^(0),"^",2)="T" S SCL="CN"
- ;DTP takes X in FM date and returns a printable date in Y
- I SCL["C" D DTP^PRSAPPU W !,"C = Current Pay Period beginning ",Y
- G:'$D(^PRST(458,PPI-1,1)) N0
- ;
- ;if called from PRSATE and last pay period has NOT been transmitted.
- I DFN,$P($G(^PRST(458,PPI-1,"E",DFN,0)),"^",2)'="T" G N0
- ;
- ;Show date of current pay period
- S X1=D1,X2=-14
- D C^%DTC,DTP^PRSAPPU W !,"L = Last Pay Period beginning ",Y
- S SCL=SCL_"L"
- ;
- ;
- N0 I SCL["N" S X1=D1,X2=14 D C^%DTC,DTP^PRSAPPU W !,"N = Next Pay Period beginning ",Y
- I SCL="" S SRT="^" Q
- S SRTD=$E(SCL,1)
- N1 W !!,"Which Pay Period? ",SRTD," // " R SRT:DTIME S:'$T SRT="^" S:SRT="" SRT=SRTD Q:SRT="^"
- S SRT=$TR(SRT,"ncl","NCL") I SCL'[SRT W $C(7)," Choose from C, N or L if displayed" G N1
- Q
- EX G KILL^XUSCLEAN
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATE2 5679 printed Jan 18, 2025@03:25:39 Page 2
- PRSATE2 ; HISC/REL,WIRMFO/JAH - Display Employee Tour of Duty ;3/3/1998
- +1 ;;4.0;PAID;**8,22,35,114,132**;Sep 21, 1995;Build 13
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;VARIABLES:
- +5 ; PPI = Pay period internal entry number from file 458
- +6 ; PPE = Pay period number in YY-PP format (e.g. 97-03)
- +7 ; HOLDSCR = dummy variable used to hold value from hold screen
- +8 ; extrinsic function call.
- +9 ; PRSTLV = flag: contains 2 for timekeepers and 3 for supervisors.
- +10 ; TLI = Internal entry of the T&L unit
- +11 ; DFN = DFN is defined in a call from routine PRSATE to label NOL.
- +12 ; Otherwise DFN is set to zero.
- +13 ; SRT = Report sort entered by user.
- +14 ; (C = current pp, L = last pp, N = next pp)
- +15 ;
- TK ; TimeKeeper Entry
- +1 SET PRSTLV=2
- GOTO TL
- SUP ; Supervisor Entry
- +1 SET PRSTLV=3
- GOTO TL
- TL NEW HOLDSCR
- +1 ;
- +2 ;Ask user to select a Time and Leave Unit: go to exit if unsuccessful
- +3 DO ^PRSAUTL
- if TLI<1
- GOTO EX
- +4 ;
- +5 ;set PPI to the last pay period opened by Payroll
- +6 SET PPI=$PIECE(^PRST(458,0),"^",3)
- SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)
- +7 ;
- +8 ;
- +9 SET DFN=0
- DO NOL
- if SRT="^"
- GOTO EX
- +10 ;
- +11 ;If user chose last pay periods tour then decrement pay period.
- +12 IF SRT="L"
- SET PPI=PPI-1
- SET PPE=$PIECE($GET(^PRST(458,PPI,0)),"^",1)
- +13 ;
- +14 ;If user chose Next pay period's tour of duty
- +15 ;then increment pay period. This value is for display only,
- +16 ;since the actual data for a tour change for the next pay period
- +17 ;is stored on the 4 node of the current pay period.
- +18 IF SRT="N"
- SET PPE=$EXTRACT($$NXTPP^PRSAPPU(PPE),3,7)
- +19 ;
- T1 ;ask type of output
- +1 SET DIR(0)="SA^S:SHORT;L:LONG"
- +2 SET DIR("A")="Select Type of Display (S or L): "
- SET DIR("B")="SHORT"
- +3 SET DIR("?")="Answer S for Tour Titles, L for Detailed Time Segments"
- +4 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO EX
- +5 SET TYP=Y
- +6 ;
- NME ;Ask user what employee they want to display tour of duty for.
- +1 KILL DIC
- SET DIC("A")="Select EMPLOYEE: "
- +2 SET DIC("S")="I $P(^(0),""^"",8)=TLE"
- +3 SET DIC(0)="AEQM"
- +4 SET DIC="^PRSPC("
- SET D="ATL"_TLE
- +5 WRITE !
- DO IX^DIC
- SET DFN=+Y
- KILL DIC
- +6 ;
- +7 IF DFN<1
- GOTO EX
- +8 WRITE !
- KILL IOP,%ZIS
- +9 SET %ZIS("A")="Select Device: "
- SET %ZIS="MQ"
- DO ^%ZIS
- KILL %ZIS,IOP
- if POP
- GOTO EX
- +10 IF $DATA(IO("Q"))
- SET PRSAPGM="Q1^PRSATE2"
- SET PRSALST="TLI^TLE^TYP^SRT^DFN^PPI^PPE"
- DO QUE^PRSAUTL
- GOTO NME
- +11 USE IO
- DO Q1
- DO ^%ZISC
- KILL %ZIS,IOP
- GOTO NME
- Q1 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- WRITE !?26,"VA TIME & ATTENDANCE SYSTEM"
- +1 WRITE !?29,"EMPLOYEE TOUR OF DUTY"
- +2 if TYP="S"
- DO S0
- +3 if TYP="L"
- DO L0
- +4 IF $EXTRACT(IOST,1,2)="C-"
- SET HOLDSCR=$$ASK^PRSLIB00(1)
- +5 QUIT
- +6 ;====================================================================
- S0 ; Short Display
- +1 ;Loop thru both weeks of pay period simultaneously,
- +2 ;displaying sun-sat side by side.
- +3 DO HDR^PRSADP1
- DO DT
- +4 WRITE !!?7,"TW Week 1 - ",$EXTRACT(Y1,5,13),?41,"TW Week 2 - ",$EXTRACT(Y2,5,13),!
- +5 FOR DAY=1:1:7
- DO S1
- +6 QUIT
- +7 ;====================================================================
- S1 ;
- +1 ; Y1 = employee tour of duty node 4 current day of week one.
- +2 ; Y2 = employee tour of duty node 4 current day of week two.
- +3 ; Y2 = node 8 telework
- +4 ; TD = tour of duty pointer to Tour of Duty file.
- +5 ;
- +6 NEW Y1,Y2,Y8,TD,PRSA
- +7 SET Y1=$GET(^PRST(458,PPI,"E",DFN,"D",DAY,0))
- SET Y8=$GET(^(8))
- SET TD=$PIECE(Y1,"^",2)
- SET PRSA=$PIECE(Y8,U)
- +8 IF SRT="N"
- IF $PIECE(Y1,"^",3)
- SET TD=$PIECE(Y1,"^",4)
- SET PRSA=$PIECE(Y8,U,5)
- +9 WRITE !?2,$PIECE("Sun Mon Tue Wed Thu Fri Sat"," ",DAY)
- +10 WRITE ?7,PRSA
- if TD
- WRITE ?11,$PIECE($GET(^PRST(457.1,TD,0)),"^",1)
- +11 SET Y2=$GET(^PRST(458,PPI,"E",DFN,"D",DAY+7,0))
- SET Y8=$GET(^(8))
- SET TD=$PIECE(Y2,"^",2)
- SET PRSA=$PIECE(Y8,U)
- +12 IF SRT="N"
- IF $PIECE(Y2,"^",3)
- SET TD=$PIECE(Y2,"^",4)
- SET PRSA=$PIECE(Y8,U,5)
- +13 WRITE ?41,PRSA
- if TD
- WRITE ?45,$PIECE($GET(^PRST(457.1,TD,0)),"^",1)
- if SRT="N"
- QUIT
- +14 IF $PIECE(Y1,"^",13)=""
- IF $PIECE(Y2,"^",13)=""
- QUIT
- +15 WRITE !
- SET TD=$PIECE(Y1,"^",13)
- +16 if TD
- WRITE ?11,$PIECE($GET(^PRST(457.1,TD,0)),"^",1)
- +17 SET TD=$PIECE(Y2,"^",13)
- if TD
- WRITE ?45,$PIECE($GET(^PRST(457.1,TD,0)),"^",1)
- +18 QUIT
- +19 ;====================================================================
- L0 ; Long Display
- +1 SET C0=^PRSPC(DFN,0)
- +2 WRITE !!,$PIECE(C0,U),?30,"Telework Indicator: ",$SELECT($PIECE($$TWE^PRSATE0(DFN,PPI),U,3)]"":$PIECE($$TWE^PRSATE0(DFN,PPI),U,3),1:"None")
- +3 SET X=$PIECE(C0,U,9)
- WRITE ?65,$EXTRACT(X),"XX-XX-",$EXTRACT(X,6,9)
- +4 DO DT
- WRITE !!,?7,"TW Week 1 - ",$EXTRACT(Y1,5,13),?41,"TW Week 2 - ",$EXTRACT(Y2,5,13),!
- +5 FOR DAY=1:1:7
- DO ^PRSATE3
- +6 QUIT
- +7 ;
- H1 IF $EXTRACT(IOST,1,2)="C-"
- SET QT=$$ASK^PRSLIB00()
- +1 QUIT
- DT ; Get date of PP
- +1 IF SRT'="N"
- SET Y1=$PIECE($GET(^PRST(458,PPI,2)),"^",1)
- SET Y2=$PIECE($GET(^(2)),"^",8)
- QUIT
- +2 NEW X,Y,X1,X2
- SET X1=$PIECE($GET(^PRST(458,PPI,1)),"^",1)
- SET X2=14
- DO C^%DTC
- DO DTP^PRSAPPU
- SET Y1=" "_Y
- +3 SET X1=X
- SET X2=7
- DO C^%DTC
- DO DTP^PRSAPPU
- SET Y2=" "_Y
- QUIT
- +4 QUIT
- NOL ; Select this PP or Next
- +1 ;
- +2 ;SCL is set to 1 when NOL is called from this routine.
- +3 ;SCL is set to CN when NOL is called from PRSATE.
- +4 SET SCL=$SELECT(DFN:"",1:"CN")
- +5 ;
- +6 ;X,D1 is set to FileMan dates of selected pay period.
- +7 SET (X,D1)=$PIECE($GET(^PRST(458,PPI,1)),"^",1)
- +8 WRITE !
- +9 ;
- +10 ;if called from PRSATE and employee has data in this pay period
- +11 ;then set sort = next pp. Then if the timecard has been transmitted
- +12 ;already set sort = current, next
- +13 IF DFN
- IF $DATA(^PRST(458,PPI,"E",DFN,0))
- SET SCL="N"
- IF $PIECE(^(0),"^",2)="T"
- SET SCL="CN"
- +14 ;DTP takes X in FM date and returns a printable date in Y
- +15 IF SCL["C"
- DO DTP^PRSAPPU
- WRITE !,"C = Current Pay Period beginning ",Y
- +16 if '$DATA(^PRST(458,PPI-1,1))
- GOTO N0
- +17 ;
- +18 ;if called from PRSATE and last pay period has NOT been transmitted.
- +19 IF DFN
- IF $PIECE($GET(^PRST(458,PPI-1,"E",DFN,0)),"^",2)'="T"
- GOTO N0
- +20 ;
- +21 ;Show date of current pay period
- +22 SET X1=D1
- SET X2=-14
- +23 DO C^%DTC
- DO DTP^PRSAPPU
- WRITE !,"L = Last Pay Period beginning ",Y
- +24 SET SCL=SCL_"L"
- +25 ;
- +26 ;
- N0 IF SCL["N"
- SET X1=D1
- SET X2=14
- DO C^%DTC
- DO DTP^PRSAPPU
- WRITE !,"N = Next Pay Period beginning ",Y
- +1 IF SCL=""
- SET SRT="^"
- QUIT
- +2 SET SRTD=$EXTRACT(SCL,1)
- N1 WRITE !!,"Which Pay Period? ",SRTD," // "
- READ SRT:DTIME
- if '$TEST
- SET SRT="^"
- if SRT=""
- SET SRT=SRTD
- if SRT="^"
- QUIT
- +1 SET SRT=$TRANSLATE(SRT,"ncl","NCL")
- IF SCL'[SRT
- WRITE $CHAR(7)," Choose from C, N or L if displayed"
- GOTO N1
- +2 QUIT
- EX GOTO KILL^XUSCLEAN