source: FOIAVistA/trunk/r/PAID-PRS/PRSATE6.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: 8.2 KB
Line 
1PRSATE6 ; WCIOFO/JAH-VALIDATE FIREFIGHTER TOURS OF DUTY (ToD);3/19/99
2 ;;4.0;PAID;**45**;Sep 21, 1995
3 Q
4FFTOUR(PPI,DFN,WHICHPP,ERROR) ; Validate a Firefighter ToD
5 N WK1BTOT,WK2BTOT,BASEMAX,PMP
6 ;
7 S PMP=$$GETPMP(DFN)
8 ;
9 ;Define maximum base hrs for 1 week of a firefighter ToD.
10 ;
11 S BASEMAX=$$GETBSMAX(DFN,PPI,WHICHPP)
12 ;
13 ; Loop thru week 1,2 & get total base ToD hrs scheduled.
14 ;
15 D GETTOTS(PPI,DFN,WHICHPP,.WK1BTOT,.WK2BTOT)
16 ;
17 ; convert minutes to 1/4 hour segments
18 ;
19 S WK1BTOT=WK1BTOT/15,WK2BTOT=WK2BTOT/15
20 ;
21 ; Determine any error in ToD
22 ;
23 D GETERROR(WK1BTOT,WK2BTOT,BASEMAX,PMP,.ERROR)
24 ;
25 ; display any errors
26 ;
27 I $$ISERRORS(.ERROR) D
28 . D DISPERR(PPI,DFN,PMP,WHICHPP,.ERROR,BASEMAX)
29 Q
30 ;=======================
31 ;
32GETBSMAX(DFN,PPI,WHICHPP) ; GET MAX BASE ToD HRS FOR FIREFIGHTER'S WEEK
33 ;INPUT:
34 ; Employee DFN or internal entry number in file 450
35 ;OUTPUT:
36 ; return total base hrs in .25 hr segments that
37 ; this fire fighter is allowed in a week of thier ToD.
38 ; If this isn't a firefighter (Premium pay indicator C)
39 ; then return 0
40 ;
41 S MAX=0
42 S TOURTYPE=$$FLEXIND(PPI,DFN,WHICHPP)
43 S MAX=$S(TOURTYPE="C":53,1:40)
44 Q MAX*4
45 ;=======================
46 ;
47GETPMP(DFN) ; RETURN PREMIUM PAY INDICATOR CODE FROM FILE 450
48 ;^DD(450,548,0) = PREMIUM PAY IND^F^^PREMIUM;6
49 Q $P($G(^PRSPC(DFN,"PREMIUM")),"^",6)
50 ;=======================
51 ;
52GETTOTS(PPI,DFN,WHICHPP,WK1TOT,WK2TOT) ;
53 N TOURDAY,TOUR,SEGMNT,START,STOP,SPECIND
54 ;
55 S (WK1TOT,WK2TOT)=0
56 F TOURDAY=1:1:14 D
57 . S TOUR=$$GETTOUR(PPI,DFN,WHICHPP,TOURDAY)
58 . S MEAL=$$MEALTM(PPI,DFN,TOURDAY,WHICHPP)
59 .;
60 .; Read each segment of ToD.
61 .;
62 . F SEGMNT=1:3 D Q:$P(TOUR,"^",SEGMNT)=""
63 .. S (STARTHR,START)=$P(TOUR,"^",SEGMNT)
64 .. S (STOPHR,STOP)=$P(TOUR,"^",SEGMNT+1)
65 .. S SPECIND=$P(TOUR,"^",SEGMNT+2)
66 ..;
67 ..; if this is base ToD hours then add the time to the approriate
68 ..; week.
69 ..;
70 .. I SPECIND="",$G(START)'="",$G(STOP)'="" D
71 ... D MINUTES(.START,.STOP)
72 ... S (WK1LEN,WK2LEN)=0
73 ...;
74 ...; when ToD crosses midnight check if it's Sat. or Sun
75 ...; & adjust the stop time
76 ...;
77 ... I STOP<(START+1) D
78 .... I (TOURDAY#7)=0 D
79 ..... D SPLIT(STARTHR,STOPHR,.WK1LEN,.WK2LEN)
80 ..... I WK1LEN+1>WK2LEN S WK1LEN=WK1LEN-MEAL
81 ..... I WK1LEN<WK2LEN S WK2LEN=WK2LEN-MEAL
82 ..... D UPTOT(.WK1TOT,.WK2TOT,WK1LEN,WK2LEN)
83 .... E D
84 ..... S STOP=1440+STOP
85 ..... S LEN=STOP-START-MEAL
86 ..... I TOURDAY<8 D UPTOT(.WK1TOT,.WK2TOT,LEN,0)
87 ..... I TOURDAY>7 D UPTOT(.WK1TOT,.WK2TOT,0,LEN)
88 ... E D
89 .... S LEN=STOP-START-MEAL
90 .... I TOURDAY<8 D UPTOT(.WK1TOT,.WK2TOT,LEN,0)
91 .... I TOURDAY>7 D UPTOT(.WK1TOT,.WK2TOT,0,LEN)
92 ;
93 Q
94 ;=======================
95 ;
96MEALTM(PPI,DFN,DAY,WHICHPP) ;
97 ; RETURN LENGTH OF MEALTIME FOR THIS EMPs ToD ON THIS DAY.
98 N TOUR
99 S LEN=0
100 S TOUR=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0))
101 S TOUR=$P(TOUR,"^",2)
102 I $P(TOUR,"^",4),(WHICHPP="N") S TOUR=$P(TOUR,"^",4)
103 I TOUR S LEN=$P($G(^PRST(457.1,TOUR,0)),"^",3)
104 ;
105 Q LEN
106 ;=======================
107 ;
108MINUTES(T1,T2) ; CONVERT TIME 1 & TWO TO MINUTES FROM MIDNIGHT
109 ; OF THE CURRENT DAY. IF T2 IS LESS THAN OR EQUAL TO T1 THEN
110 ; IT IS ASSUMMED TO BE ON THE NEXT DAY.
111 ;
112 N X,Y
113 ;
114 ;call to convert start & stop to minutes from midnight
115 ;
116 S X=T1_"^"_T2
117 D CNV^PRSATIM
118 S T1=$P(Y,"^",1),T2=$P(Y,"^",2)
119 Q
120 ;=======================
121 ;
122SPLIT(DAY,T1,T2,L1,L2) ; SPLIT two day ToD into 2 segments.
123 ;INPUT:
124 ; DAY = day of pay period that the ToD begins.
125 ; T1 = start time of ToD in 08:00A format.
126 ; T2 = stop time of ToD in 11:00P format.
127 ;OUTPUT:
128 ; L1 = Length of ToD (minutes) from start time to midnight.
129 ; L2 = Length of ToD (min) from midnight to stop time in next day.
130 ;
131 N X,Y
132 S X=T1_"^"_"MID"
133 D CNV^PRSATIM
134 S L1=$P(Y,"^",2)-$P(Y,"^",1)
135 S X="MID^"_T2
136 S L2=$P(Y,"^",2)-$P(Y,"^",1)
137 ;
138 ; If it's the 2nd Sat of the pay period then move the carry over
139 ; to the first week of this pay period.
140 ;
141 I DAY=14 S TEMP=L2,L2=L1,L1=TEMP
142 Q
143 ;=======================
144 ;
145UPTOT(W1T,W2T,W1LN,W2LN) ;
146 S W1T=W1T+W1LN
147 S W2T=W2T+W2LN
148 Q
149 ;=======================
150 ;
151GETERROR(W1TOT,W2TOT,BMAX,PMP,ERROR) ;
152 ;
153 ; 1. Code C firefighters on compressed ToDs may not have base
154 ; ToD hours that exceed 53 for either week 1 or 2.
155 ; 2. Code C firefighters without compressed ToDs may not have
156 ; base hours that exceed 40 for either week 1 or 2.
157 ; 3. Code C firefighters may not have base ToD hours that
158 ; exceed 80.
159 ;
160 I PMP="C" D
161 . I W1TOT>BMAX S ERROR(1)=1
162 . I W2TOT>BMAX S ERROR(2)=1
163 . I (W2TOT+W1TOT)>(80*4) S ERROR(3)=1
164 Q
165 ;=======================
166 ;
167ISERRORS(ERROR) ; RETURN TRUE IF THERE ARE ERRORS IN THE ERROR ARRAY
168 S (ENUM,IS)=0
169 F S ENUM=$O(ERROR(ENUM)) Q:ENUM=""!IS I +$G(ERROR(ENUM)) S IS=1
170 ;
171 Q IS
172 ;=======================
173 ;
174DISPERR(PPI,DFN,PMP,WHICHPP,ERROR,BMAX) ;
175 ;
176 ; See GETERRORS for error descriptions.
177 ;
178 N FLX,COUNT,WK
179 S FLX=$$FLEXIND(PPI,DFN,WHICHPP)
180 S FLX=$S(FLX="C":"Compressed",FLX="F":"Flexitime",1:"None")
181 ;
182 S WK="",COUNT=0
183 I $G(ERROR(1)) S WK="one"
184 I $G(ERROR(2)) S WK="two"
185 I WK="two",$G(ERROR(1)) S WK="one and two"
186 W @IOF,!!!,?5,"There are the following problems with the tour entered:"
187 I +$G(ERROR(1))!(+$G(ERROR(2))) D
188 . S COUNT=COUNT+1
189 . W !!,?7,COUNT,". Code ",PMP," firefighters with a compressed/flex "
190 . W !,?11,"indicator of ",FLX," may not have BASE tour hours that "
191 . W !,?11,"exceed ",BMAX/4," for week ",WK,"."
192 ;
193 I +$G(ERROR(3)) D
194 . S COUNT=COUNT+1
195 . W !!,?7,COUNT,". Code ",PMP," firefighters may not have BASE tour "
196 . W !,?11,"hours that exceed 80 for the pay period."
197 ;
198 Q
199 ;=======================
200 ;
201ASKTOFIX() ;RETURN TK RESPONSE--DO YOU WANT TO FIX THE ToD?
202 N DIR,DIRUT,Y
203 W !!
204 S DIR("A",1)="This tour MUST BE CORRECTED or it will be removed."
205 S DIR("A")="Correct the tour"
206 S DIR(0)="Y"
207 S DIR("B")="Y"
208 S DIR("?",1)=" You must correct the tour. Answer Yes to re-edit the tour."
209 S DIR("?")=" If you answer No the entire tour will be removed. "
210 D ^DIR
211 Q Y
212 ;=======================
213 ;
214GETTOUR(PPI,DFN,WHICHPP,PPDAY) ; This function returns the employees ToD
215 ; based on the WHICHPP variable. WHICHPP can be set to N, for next
216 ; pay period, or C for current pay period or 'L' for last. If set
217 ; to 'N'ext, we have to look at the prior scheduled field in the
218 ; current pay period to see if the ToD is changing next pp.
219 ;
220 N TEMPTOUR,TOURNODE,TOUR
221 I PPI'>0!(DFN'>0)!(PPDAY'>0) Q 0
222 S TOURNODE=$G(^PRST(458,PPI,"E",DFN,"D",PPDAY,0))
223 S TOUR=$P(TOURNODE,U,2)
224 S TEMPTOUR=$P(TOURNODE,U,3)
225 I WHICHPP="N",+TEMPTOUR D
226 . S TOUR=$P(TOURNODE,"^",4)
227 I TOUR'>0 Q 0
228 Q $G(^PRST(457.1,TOUR,1))
229 ;=======================
230 ;
231SAVETOUR(PPI,DFN) ;SAVE ToD in ^TMP global
232 ;
233 S %X="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
234 S %Y="^TMP($J,""OLDTOUR""," D %XY^%RCR
235 Q
236 ;=======================
237 ;
238RESTORE(PPI,DFN) ;restore a ToD
239 ; use with EXTREME CAUTION. SAVETOUR should be called 1st.
240 ; This utility first removes the entire "D" node from the
241 ; input employee's pay period record. It depends on the fact that
242 ; a backup of an earlier copy of the "D" node was saved in TMP.
243 N %X,%Y
244 K ^PRST(458,PPI,"E",DFN,"D")
245 S %X="^TMP($J,""OLDTOUR"","
246 S %Y="^PRST(458,"_PPI_",""E"","_DFN_",""D"","
247 D %XY^%RCR
248 Q
249 ;=======================
250 ;
251ASKTEMP() ; ASK USER-TEMP OR PERM ToD CHANGE
252 N DIR,DIRUT
253 S DIR("A")="Is this tour change Temporary or Permanent? "
254 S DIR("B")="P"
255 S DIR(0)="SAMO^P:Permanent;T:Temporary"
256 S DIR("?")="A Temporary change is for this Pay Period only."
257 S DIR("?",1)="A Permanent change is for this and future Pay Periods."
258 D ^DIR
259 I $D(DIRUT) S Y="^"
260 Q Y
261 ;=======================
262 ;
263GETEMP(TLE) ; SELECT EMP FROM THE PASSED T&L UNIT
264 N DIC,X,Y,D
265 S DIC("A")="Select EMPLOYEE: "
266 S DIC("S")="I $P(^(0),""^"",8)=TLE"
267 S DIC(0)="AEQM"
268 S DIC="^PRSPC("
269 S D="ATL"_TLE
270 W ! D IX^DIC S DFN=+Y K DIC
271 Q DFN
272 ;=======================
273 ;
274FLEXIND(PPI,DFN,WHICHPP) ;
275 ;Return emp's flexitime code (compressed, flex or none)
276 ; INPUT:
277 ; PPI = pp internal #
278 ; DFN = emps internal # from 450/458
279 ; WHICHPP = N for next pp otherwise current
280 Q $P($G(^PRST(458,PPI,"E",DFN,0)),"^",$S(WHICHPP="N":7,1:6))
281 ;=======================
282 ;
283ASKTLWRK(TLE) ; ASK TIMEKEEP WHICH TLU ToD WILL BE WORKED
284 N DIC,X,Y
285 S DIC="^PRST(455.5,"
286 S DIC(0)="AEQM"
287 S DIC("A")="T&L on which Tour will be worked: "
288 S DIC("B")=TLE
289 W ! D ^DIC
290 Q +Y
Note: See TracBrowser for help on using the repository browser.