| 1 | PRSATE6 ; WCIOFO/JAH-VALIDATE FIREFIGHTER TOURS OF DUTY (ToD);3/19/99
|
|---|
| 2 | ;;4.0;PAID;**45**;Sep 21, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | FFTOUR(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 | ;
|
|---|
| 32 | GETBSMAX(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 | ;
|
|---|
| 47 | GETPMP(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 | ;
|
|---|
| 52 | GETTOTS(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 | ;
|
|---|
| 96 | MEALTM(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 | ;
|
|---|
| 108 | MINUTES(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 | ;
|
|---|
| 122 | SPLIT(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 | ;
|
|---|
| 145 | UPTOT(W1T,W2T,W1LN,W2LN) ;
|
|---|
| 146 | S W1T=W1T+W1LN
|
|---|
| 147 | S W2T=W2T+W2LN
|
|---|
| 148 | Q
|
|---|
| 149 | ;=======================
|
|---|
| 150 | ;
|
|---|
| 151 | GETERROR(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 | ;
|
|---|
| 167 | ISERRORS(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 | ;
|
|---|
| 174 | DISPERR(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 | ;
|
|---|
| 201 | ASKTOFIX() ;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 | ;
|
|---|
| 214 | GETTOUR(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 | ;
|
|---|
| 231 | SAVETOUR(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 | ;
|
|---|
| 238 | RESTORE(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 | ;
|
|---|
| 251 | ASKTEMP() ; 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 | ;
|
|---|
| 263 | GETEMP(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 | ;
|
|---|
| 274 | FLEXIND(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 | ;
|
|---|
| 283 | ASKTLWRK(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
|
|---|
