source: WorldVistAEHR/trunk/r/PAID-PRS/PRSATE2.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1PRSATE2 ; HISC/REL,WIRMFO/JAH - Display Employee Tour of Duty ;3/3/1998
2 ;;4.0;PAID;**8,22,35,114**;Sep 21, 1995;Build 6
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;VARIABLES:
6 ; PPI = Pay period internal entry number from file 458
7 ; PPE = Pay period number in YY-PP format (e.g. 97-03)
8 ; HOLDSCR = dummy variable used to hold value from hold screen
9 ; extrinsic function call.
10 ; PRSTLV = flag: contains 2 for timekeepers and 3 for supervisors.
11 ; TLI = Internal entry of the T&L unit
12 ; DFN = DFN is defined in a call from routine PRSATE to label NOL.
13 ; Otherwise DFN is set to zero.
14 ; SRT = Report sort entered by user.
15 ; (C = current pp, L = last pp, N = next pp)
16 ;
17TK ; TimeKeeper Entry
18 S PRSTLV=2 G TL
19SUP ; Supervisor Entry
20 S PRSTLV=3 G TL
21TL N HOLDSCR
22 ;
23 ;Ask user to select a Time and Leave Unit: go to exit if unsuccessful
24 D ^PRSAUTL G:TLI<1 EX
25 ;
26 ;set PPI to the last pay period opened by Payroll
27 S PPI=$P(^PRST(458,0),"^",3),PPE=$P($G(^PRST(458,PPI,0)),"^",1)
28 ;
29 ;
30 S DFN=0 D NOL G:SRT="^" EX
31 ;
32 ;If user chose last pay periods tour then decrement pay period.
33 I SRT="L" S PPI=PPI-1,PPE=$P($G(^PRST(458,PPI,0)),"^",1)
34 ;
35 ;If user chose Next pay period's tour of duty
36 ;then increment pay period. This value is for display only,
37 ;since the actual data for a tour change for the next pay period
38 ;is stored on the 4 node of the current pay period.
39 I SRT="N" S PPE=$E($$NXTPP^PRSAPPU(PPE),3,7)
40 ;
41T1 ;ask type of output
42 S DIR(0)="SA^S:SHORT;L:LONG"
43 S DIR("A")="Select Type of Display (S or L): ",DIR("B")="SHORT"
44 S DIR("?")="Answer S for Tour Titles, L for Detailed Time Segments"
45 D ^DIR K DIR G:$D(DIRUT) EX
46 S TYP=Y
47 ;
48NME ;Ask user what employee they want to display tour of duty for.
49 K DIC S DIC("A")="Select EMPLOYEE: "
50 S DIC("S")="I $P(^(0),""^"",8)=TLE"
51 S DIC(0)="AEQM"
52 S DIC="^PRSPC(",D="ATL"_TLE
53 W ! D IX^DIC S DFN=+Y K DIC
54 ;
55 I DFN<1 G EX
56 W ! K IOP,%ZIS
57 S %ZIS("A")="Select Device: ",%ZIS="MQ" D ^%ZIS K %ZIS,IOP G:POP EX
58 I $D(IO("Q")) S PRSAPGM="Q1^PRSATE2",PRSALST="TLI^TLE^TYP^SRT^DFN^PPI^PPE" D QUE^PRSAUTL G NME
59 U IO D Q1 D ^%ZISC K %ZIS,IOP G NME
60Q1 W:$E(IOST,1,2)="C-" @IOF W !?26,"VA TIME & ATTENDANCE SYSTEM"
61 W !?29,"EMPLOYEE TOUR OF DUTY"
62 D:TYP="S" S0
63 D:TYP="L" L0
64 I $E(IOST,1,2)="C-" S HOLDSCR=$$ASK^PRSLIB00(1)
65 Q
66 ;====================================================================
67S0 ; Short Display
68 ;Loop thru both weeks of pay period simultaneously,
69 ;displaying sun-sat side by side.
70 D HDR^PRSADP1,DT
71 W !!?11,"Week 1 - ",$E(Y1,5,13),?45,"Week 2 - ",$E(Y2,5,13),!
72 F DAY=1:1:7 D S1
73 Q
74 ;====================================================================
75S1 ;
76 ; Y1 = employee tour of duty node 4 current day of week one.
77 ; Y2 = employee tour of duty node 4 current day of week two.
78 ; TD = tour of duty pointer to Tour of Duty file.
79 ;
80 S Y1=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),TD=$P(Y1,"^",2)
81 I SRT="N",$P(Y1,"^",3) S TD=$P(Y1,"^",4)
82 W !?4,$P("Sun Mon Tue Wed Thu Fri Sat"," ",DAY)
83 W:TD ?11,$P($G(^PRST(457.1,TD,0)),"^",1)
84 S Y2=$G(^PRST(458,PPI,"E",DFN,"D",DAY+7,0)),TD=$P(Y2,"^",2)
85 I SRT="N",$P(Y2,"^",3) S TD=$P(Y2,"^",4)
86 W:TD ?45,$P($G(^PRST(457.1,TD,0)),"^",1) Q:SRT="N"
87 I $P(Y1,"^",13)="",$P(Y2,"^",13)="" Q
88 W ! S TD=$P(Y1,"^",13)
89 W:TD ?11,$P($G(^PRST(457.1,TD,0)),"^",1)
90 S TD=$P(Y2,"^",13) W:TD ?45,$P($G(^PRST(457.1,TD,0)),"^",1)
91 Q
92 ;====================================================================
93L0 ; Long Display
94 S C0=^PRSPC(DFN,0)
95 W !!,$P(C0,U)
96 S X=$P(C0,U,9) W ?65,$E(X),"XX-XX-",$E(X,6,9)
97 D DT W !!,?11,"Week 1 - ",$E(Y1,5,13),?45,"Week 2 - ",$E(Y2,5,13),!
98 F DAY=1:1:7 D ^PRSATE3
99 Q
100 ;
101H1 I $E(IOST,1,2)="C-" S QT=$$ASK^PRSLIB00()
102 Q
103DT ; Get date of PP
104 I SRT'="N" S Y1=$P($G(^PRST(458,PPI,2)),"^",1),Y2=$P($G(^(2)),"^",8) Q
105 N X,Y,X1,X2 S X1=$P($G(^PRST(458,PPI,1)),"^",1),X2=14 D C^%DTC,DTP^PRSAPPU S Y1=" "_Y
106 S X1=X,X2=7 D C^%DTC,DTP^PRSAPPU S Y2=" "_Y Q
107 Q
108NOL ; Select this PP or Next
109 ;
110 ;SCL is set to 1 when NOL is called from this routine.
111 ;SCL is set to CN when NOL is called from PRSATE.
112 S SCL=$S(DFN:"",1:"CN")
113 ;
114 ;X,D1 is set to FileMan dates of selected pay period.
115 S (X,D1)=$P($G(^PRST(458,PPI,1)),"^",1)
116 W !
117 ;
118 ;if called from PRSATE and employee has data in this pay period
119 ;then set sort = next pp. Then if the timecard has been transmitted
120 ;already set sort = current, next
121 I DFN,$D(^PRST(458,PPI,"E",DFN,0)) S SCL="N" I $P(^(0),"^",2)="T" S SCL="CN"
122 ;DTP takes X in FM date and returns a printable date in Y
123 I SCL["C" D DTP^PRSAPPU W !,"C = Current Pay Period beginning ",Y
124 G:'$D(^PRST(458,PPI-1,1)) N0
125 ;
126 ;if called from PRSATE and last pay period has NOT been transmitted.
127 I DFN,$P($G(^PRST(458,PPI-1,"E",DFN,0)),"^",2)'="T" G N0
128 ;
129 ;Show date of current pay period
130 S X1=D1,X2=-14
131 D C^%DTC,DTP^PRSAPPU W !,"L = Last Pay Period beginning ",Y
132 S SCL=SCL_"L"
133 ;
134 ;
135N0 I SCL["N" S X1=D1,X2=14 D C^%DTC,DTP^PRSAPPU W !,"N = Next Pay Period beginning ",Y
136 I SCL="" S SRT="^" Q
137 S SRTD=$E(SCL,1)
138N1 W !!,"Which Pay Period? ",SRTD," // " R SRT:DTIME S:'$T SRT="^" S:SRT="" SRT=SRTD Q:SRT="^"
139 S SRT=$TR(SRT,"ncl","NCL") I SCL'[SRT W $C(7)," Choose from C, N or L if displayed" G N1
140 Q
141EX G KILL^XUSCLEAN
Note: See TracBrowser for help on using the repository browser.