Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRSATE2

PRSATE2.m

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