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 Dec 13, 2024@02:24:28 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
