source: FOIAVistA/trunk/r/PAID-PRS/PRSATE.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1PRSATE ;WCIOFO/JAH - Enter/Edit Employee (emp) Tour of Duty (ToD) ;03/15/2005
2 ;;4.0;PAID;**8,11,27,45,55,93,112**;Sep 21, 1995;Build 54
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 N PPI,PPE,PRSTLV,TLI,TLE,DFN
5 ;
6 ; PPI = pay period (pp) internal #.
7 ; PPE = pp external form (99-06).
8 ; PRSTLV = flag indicates timekeeper (TK) in T&L lookup ^PRSAUTL.
9 ; TLI = T&L unit internal #.
10 ; TLU = T&L unit # 3-digit
11 ;
12 ; -Get current pp-internal & external. -Ask user for T&L.
13 ; -Loop to ask for emp until TK is done.
14 ; --Emp lookup screens emps not in T&L returned by PRSAUTL call.
15 ;
16 S PRSTLV=2 D ^PRSAUTL Q:TLI<1
17 F S DFN=$$GETEMP^PRSATE6(TLE) Q:DFN<1 D
18 . S PPI=$P(^PRST(458,0),"^",3),PPE=$P($G(^PRST(458,PPI,0)),"^",1)
19 . D TOUREDIT(DFN,PPI,PPE,TLI,TLE,PRSTLV)
20 Q
21 ;=======================
22 ;
23TOUREDIT(DFN,PPI,PPE,TLI,TLE,PRSTLV) ;
24 ;
25 N C0,NH,FLX,PMP,PP,PB,ENT,SRT,WTL,TYP,Z,TD,ERROR,NOERROR
26 ;
27 ; Entitlement lookup leaks many variables. Following R used in
28 ; this routine but may be looked up again despite the fact they R
29 ; leaked by ^PRSAENT. See PRSAENT for further doc.
30 ;
31 ; C0=emps 0 node in file 450 NH= emps 8B normal hrs
32 ; FLX= compressed/flextime code (0=none,C=compressed,F=flextime)
33 ; PMP= premium pay indicator
34 ; ( D=entitled Sun., F=entitled Sat./Sun.,
35 ; E=entitled variable Sat./Sun. premium pay,
36 ; G=entitled variable Sun. prem pay, X=title 5 emps
37 ; R,C,O=different types of firefighters)
38 ; * PP= emps pay plan
39 ; DB = pay basis-1:full,2:part,3:intermit
40 ; ENT= 39 char entitlement string
41 ;
42 ; Entitlement lookup.
43 ;
44 D ^PRSAENT I ENT="" D ERROR(1) S OUT=1 Q
45 ;
46 ; Display header/Ask pp (NOL^PRSATE2 returns SRT = Current, Next, Last)
47 ;
48 D NOW^%DTC S NOW=% K %
49 W:$E(IOST,1,2)="C-" @IOF
50 W !?26,"VA TIME & ATTENDANCE SYSTEM"
51 W !?29,"EMPLOYEE TOUR OF DUTY"
52 D HDR^PRSADP1,NOL^PRSATE2
53 Q:SRT="^"
54 I SRT="L" S PPI=PPI-1,PPE=$P($G(^PRST(458,PPI,0)),"^",1)
55 ;
56 ; Get emp's flexitime code
57 ;
58 S FLX=$$FLEXIND^PRSATE6(PPI,DFN,SRT)
59 ;
60 ; Is emp entitled reg. shed. hrs.?
61 ;
62 I $E(ENT,1)="0" D
63 . S Z=$E(ENT,2),TD=$S(Z="D":3,1:4) D NONE
64 E D
65 .;
66 .; initialize t&l for this ToD
67 .;
68 . S WTL=TLI
69 . I "NL"[SRT D
70 .. S TYP=0
71 . E D
72 .. S TYP=$$ISTEMPTR()
73 ..;
74 ..; For temp ToDs--ask user for T&L ToD will be worked
75 ..; Quit if we don't get a valid T&L unit.
76 ..;
77 .. I TYP S WTL=$$ASKTLWRK^PRSATE6(TLE)
78 .;
79 .; Save current ToD in case user aborts with an unacceptable ToD.
80 .;
81 . D SAVETOUR^PRSATE6(PPI,DFN)
82 .;
83 . I WTL'<1,TYP'["^" D
84 .. D A1
85 ..;
86 ..; verify firefighter ToD after compressed ind. edit. Don't accept
87 ..; ToD until its within guidlines. If TK force exits, restore old ToD.
88 ..;
89 .. S NOERROR=0
90 .. F D Q:NOERROR
91 ... N ERROR D FFTOUR^PRSATE6(PPI,DFN,SRT,.ERROR)
92 ... I $$ISERRORS^PRSATE6(.ERROR) D
93 .... I $$ASKTOFIX^PRSATE6() D
94 ..... D A1
95 .... E D
96 ..... D RESTORE^PRSATE6(PPI,DFN) S NOERROR=1
97 ... E D
98 .... S NOERROR=1
99 K NOW Q
100 ;=======================
101 ;
102ISTEMPTR() ; IS TEMPORARY ToD ?
103 ; Ask user if ToD is temp or perm & convert TYP to true false flag
104 ; Permanent set TYP=0, Temporary set TYP=true (1)
105 ;
106 S TYP=$$ASKTEMP^PRSATE6() I TYP'["^" S TYP=$E(TYP,1)="T",WTL=TLI
107 Q TYP
108 ;=======================
109 ;
110A1 ; Set up for emps ToD look up. Screen allows Daily ToDs & days off
111 ; for daily emps. Everyone else gets days off & all other ToDs.
112 ; Screen further ensures ToD is available either to all t&ls
113 ; or to t&l that this emp is working in.
114 ;
115 N DIC,X
116 S DIC="^PRST(457.1,",DIC(0)="AEQMN"
117 S DIC("S")="I "_$S($E(ENT,1)="D":"Y<3",1:"Y>5!(Y=1)")_",$P(^PRST(457.1,+Y,0),U,4)!($D(^PRST(457.1,+Y,""T"",""B"",WTL)))"
118 ;
119 ; Setup a fixed or varying ToD. Compressed ToDs must be varying;
120 ; ask TK about all others.
121 ;
122 S DB=$P(C0,U,10) I FLX="C"!("KM"[PP&(DB=1)&(NH=72)) D
123 . D VAR
124 E D
125 . S X=$$ASKFIXED()
126 . Q:X="^"
127 . I X="N" D
128 .. D VAR
129 . E D FX
130 K DB Q
131 ;=======================
132 ;
133FX ; Fixed ToD
134 S DIC("A")="Select TOUR OF DUTY: "
135 W ! D ^DIC
136 Q:Y'>0
137 S TD=+Y,Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6),HRS=TDH*10
138 S (ZENT,STR)=""
139 D OT^PRSATP,VS^PRSATE0
140 I STR'="" W *7,!!,STR G FX
141 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14"
142 I SRT="N" D
143 . D F1
144 E D
145 . F DAY=2:1:6,9:1:13 D SET
146 . S TD=1,(Y,TDH)="" F DAY=1,7,8,14 D SET
147 . W " ... done" D:HRS'=NH ERROR(2,NH,HRS)
148 . D T2,^PRSATE5
149 D HOL,RS K HRS,STR
150 Q
151 ;=======================
152 ;
153F1 F DAY=2:1:6,9:1:13 D NX
154 S TD=1 F DAY=1,7,8,14 D NX
155 W " ... done"
156 D:HRS'=NH ERROR(2,NH,HRS)
157 Q
158 ;=======================
159 ;
160VAR ; Variable ToD
161 D ^PRSATE0
162 I SRT'="N" D T2,^PRSATE5
163 D HOL,RS
164 Q
165 ;=======================
166 ;
167NONE ; No ToD
168 N TYP2,UPDT,Y,TDH
169 W !!,"This is an intermittent employee with no specified tour."
170 W !!,"Time records will now be updated to indicate this."
171 I '$D(^PRST(458,PPI,"E",DFN,"D",0)) S ^(0)="^458.02^14^14"
172 I '$$PERM^PRSALIB(PPI,DFN) D
173 . W !!,"Not all tour days are assigned a permanent status."
174 . I $$UPDTQ^PRSALIB(),$$TMPST^PRSALIB(.TYP2) D UPDSTAT^PRSALIB(PPI,DFN,TYP2)
175 S (Y,TDH)="",TYP=0,WTL=TLI
176 I SRT="N" D
177 . F DAY=1:1:14 D NX
178 E D
179 . F DAY=1:1:14 D SET
180 W " ... done"
181 D HOL,RS
182 Q
183 ;=======================
184 ;
185RS ; Get Comp Ind
186 S Y=$G(^PRST(458,PPI,"E",DFN,0))
187 S FLX=$S((SRT="N")&($P(Y,U,7)]""):$P(Y,U,7),1:$P(Y,U,6))
188 S DIR(0)="SAM^C:Compressed;F:Flexitime;0:None"
189 S DIR("A")="Compressed Tour Indicator: "
190 S DIR("B")=$S(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None")
191 D ^DIR K DIR I "^C^F^0^"'[(U_Y_U) S Y=FLX
192 ;
193 ; Intermittent employee cannot have compressed tour.
194 ;
195 I $P(C0,U,10)=3,Y="C" D G RS
196 . W *7,!?5,"Compressed tour not valid for this employee."
197 ;
198 I Y="F" S Z=0 D I Z G RS
199 .S PAY=$P(C0,U,21),PB=$P(C0,U,20)
200 .I "0123456789GU"'[PAY S Z=1
201 .I PAY="G",PB'=2 S Z=1
202 .I PAY="U","27EXT"'[PB S Z=1
203 .I Z W *7,!?5,"Flexitime not valid for this employee."
204 .Q
205 S $P(^PRST(458,PPI,"E",DFN,0),U,$S(SRT="N":7,1:6))=Y
206 I $D(^PRST(458,"ATC",DFN)) D UPD^PRSASAL
207 K PAY,ZENT Q
208 ;=======================
209 ;
210NX ; Set Next ToD
211 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0))
212 Q:$P(Z,"^",2)=TD&('$P(Z,"^",3))
213 ;
214 S $P(Z,"^",3,4)="2^"_TD,$P(Z,"^",10,11)=DUZ_"^"_NOW
215 S ^PRST(458,PPI,"E",DFN,"D",DAY,0)=Z,^PRST(458,"ATC",DFN,PPI,DAY)=""
216 Q
217 ;=======================
218 ;
219SET ; Set ToD
220 N ZLASTPP
221 S U="^"
222 ;
223 ; Get Zero node of emp pp rec, Old ToD, & Prior scheduled ToD.
224 ; ZLASTPP is true if a ToD present on this day last pp.
225 ;
226 S Z=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0))
227 S ZLASTPP=$P($G(^PRST(458,PPI-1,"E",DFN,"D",DAY,0)),U,2)'=""
228 S OLD=$P(Z,U,2),SCH=$P(Z,U,4)
229 ;
230 ; Quit if old ToD=this ToD & emp rec start/stop=ToD file start/stop.
231 ;
232 Q:(OLD=TD)&($G(^PRST(458,PPI,"E",DFN,"D",DAY,1))=Y)
233 ;
234 ; Z is updated with new ToD info & replaces the emp ToD record.
235 ;
236 S $P(Z,U,8)=TDH
237 S $P(Z,U,10,11)=DUZ_U_NOW
238 I $P(Z,U,12) S $P(Z,U,12)="" ; remove holiday flag
239 ;
240 ; Temp ToD, store T&L ToD will be worked if it's not emp's usual t&l.
241 ;
242 I TYP S:TLI'=WTL $P(Z,U,9)=WTL
243 ;
244 ; No existing ToD on this day.
245 ;
246 I OLD="" D
247 . S $P(Z,U,1,3)=DAY_U_TD_U_TYP
248 . I ZLASTPP D S0
249 E D
250 .;
251 .; clean out postings and other ToD info since ToD is changing
252 .;
253 . D CLEANTOD(PPI,DFN,DAY,TD)
254 .;
255 .;
256 .;
257 . S:SCH $P(Z,U,5,7)="^^"
258 . I SCH="" D
259 .. S $P(Z,U,2,4)=TD_U_TYP_U_OLD
260 .. D S0
261 . E D
262 .. I SCH=TD D
263 ... S $P(Z,U,2,4)=TD_"^^"
264 ... K ^PRST(458,"ATC",DFN,PPI,DAY)
265 .. E D
266 ... S $P(Z,U,2,3)=TD_U_TYP
267 ... D S0
268 ;
269 D S1
270 K OLD,SCH Q
271 ;=======================
272 ;
273 ; Set up x-ref for supervisor approval of ToD change
274 ;
275S0 S ^PRST(458,"ATC",DFN,PPI,DAY)=""
276 Q
277 ;=======================
278 ;
279S1 ;
280 S ^PRST(458,PPI,"E",DFN,"D",DAY,0)=Z S:Y'="" ^(1)=Y
281 Q
282 ;=======================
283 ;
284T2 ; Ask if second ToD
285 N X
286 ;
287 ; Don't ask for Daily ToDs
288 ;
289 Q:$E(ENT,1)="D"
290 ;
291 S X=$$ASK2NDTR()
292 Q:X'="Y" G ^PRSATE4
293 ;=======================
294 ;
295HOL ; Determine if Holiday within ToD
296 N DAY
297 D ^PRSAPPH
298 Q:'$D(HOL)
299 S TT="HX",DUP=1
300 D E^PRSAPPH K DUP,HOL,TT
301 Q
302 ;=======================
303 ;
304CLEANTOD(PPI,DFN,DAY,TD) ; CLEAN OUT TOUR
305 N PRSDT,MIEN
306 K ^PRST(458,PPI,"E",DFN,"D",DAY,1),^(2),^(3),^(10) I TD<5 K ^(4) S $P(Z,U,13,15)="^^"
307 ; if employee is PTP with active memo then reset the ESR day
308 S PRSDT=$P($G(^PRST(458,PPI,1)),U,DAY)
309 S MIEN=$$MIEN^PRSPUT1(DFN,PRSDT)
310 I MIEN D
311 . N PRSFDA
312 . S PRSFDA(458.02,DAY_","_DFN_","_PPI_",",146)="3" ; status = resubmit
313 . S PRSFDA(458.02,DAY_","_DFN_","_PPI_",",148)="Tour Changed" ; remarks
314 . D FILE^DIE("","PRSFDA"),MSG^DIALOG()
315 Q
316 ;=======================
317 ;
318ERROR(NUM,VAR1,VAR2) ;
319 W *7,!!
320 I NUM=1 W "Employee has no Pay Entitlement table entry."
321 I NUM=2 D
322 . Q:$G(NH)=112
323 . W "Warning: Normal Hours are ",$G(VAR1),"; Tour Hours are ",$G(VAR2)
324 Q
325 ;=======================
326 ;
327ASKFIXED() ;GET USER'S YES OR NO RESPONSE TO FIXED ToD QUESTION
328 N DIR,DIRUT,Y
329 S DIR("A")="Do you wish to enter a fixed Mon-Fri Tour"
330 S DIR(0)="Y"
331 S DIR("?")="Answer NO to create any other type of tour."
332 S DIR("?",1)="Fixed tours are Monday - Friday with the same hours."
333 D ^DIR
334 Q $S(Y=1:"Y",Y=0:"N",1:"^")
335 ;=======================
336 ;
337ASK2NDTR() ;GET USER'S YES OR NO RESPONSE TO 2nd ToD QUESTION
338 N DIR,DIRUT,Y
339 S DIR("A")="Do you wish to enter a Second Tour for any Day"
340 S DIR(0)="Y"
341 S DIR("B")="N"
342 S DIR("?",1)="Answer Yes to add a second tour. No to continue."
343 S DIR("?")="Enter ^ to escape and cancel this tour change."
344 D ^DIR
345 Q $S(Y=1:"Y",Y=0:"N",1:"^")
346 ;=======================
347 ;
Note: See TracBrowser for help on using the repository browser.