| 1 | PRSAOTT ;WCIOFO/JAH/PLT- 8B CODES ARRAY. COMPARE OT (8B-vs-APPROVED). ;11/29/2006
|
|---|
| 2 | ;;4.0;PAID;**37,43,54,112**;Sep 21, 1995;Build 54
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;Function & subroutine Index for this routine.
|
|---|
| 6 | ;
|
|---|
| 7 | ; APOTWEEK(PAYPRD,WEEKID,EMP450).....return all approved OT in a week.
|
|---|
| 8 | ; ARRAY8B(RECORD)...............Build employee 8B array for payperiod.
|
|---|
| 9 | ; CODES(WEEK)........return string of valid time codes for week 1,2,3.
|
|---|
| 10 | ; GET8BCDS(TT8B).................return timecode portion of 8B string.
|
|---|
| 11 | ; GET8BOT(EMPIEN,WEEK,TT8B)..........return all OT in an 8b string.
|
|---|
| 12 | ; GETOTS(PP,EI,T8,WK,.O8,.OA)......Get overtimes (tt8b & approved).
|
|---|
| 13 | ; OTREQ(REC).................returns true if Request is type Overtime.
|
|---|
| 14 | ; OTAPPR(REC)...................returns true if a Request is Approved.
|
|---|
| 15 | ; WEEKRNG(PPE,WEEK,FIRST,LAST)........1st & last FM days in a pp week.
|
|---|
| 16 | ; WARNSUP(PPE,EI,E8B,WK,OTERR,O8,OA)... check ot's for a week & warn.
|
|---|
| 17 | Q
|
|---|
| 18 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 19 | GETOTS(PP,EI,T8,WK,O8,OA) ;Get overtimes (tt8b & approved)
|
|---|
| 20 | ; Sample call:
|
|---|
| 21 | ; D GETOTS("98-05",1255,TT8BSTRING,1,.O8,.OA)
|
|---|
| 22 | ; where TT8BSTRING might be =
|
|---|
| 23 | ; "658229548868WIL 8B268380A106 AN320NA060DA030NR300SE080CD000790"
|
|---|
| 24 | ;
|
|---|
| 25 | ; subroutine returns overtime from request file & TT8B string for
|
|---|
| 26 | ; week specified in parameter 4
|
|---|
| 27 | ;
|
|---|
| 28 | ; Input: PP - Pay period in format YY-PP.
|
|---|
| 29 | ; EI - Employees ien from file 450.
|
|---|
| 30 | ; T8 - Entire 8B record. Stored in
|
|---|
| 31 | ; ^PRST(458,PP,"E",EI,5).
|
|---|
| 32 | ; Output: O8 - TT8B overtime calculated
|
|---|
| 33 | ; OA - approved overtime in request fiLE
|
|---|
| 34 | ;
|
|---|
| 35 | S (OA,O8)=0
|
|---|
| 36 | Q:((WK'=1)&(WK'=2))
|
|---|
| 37 | ;
|
|---|
| 38 | S O8=$$GET8BOT^PRSAOTT(EI,WK,T8) ; get all OT from 8b string
|
|---|
| 39 | S OA=$$APOTWEEK^PRSAOTT(PP,WK,EI) ; get approved overtime
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 43 | WARNSUP(PPE,EI,E8B,WK,OTERR,O8,OA) ;Gets overtime from request
|
|---|
| 44 | ; file & TT8B string & displays warning if 8B string has more
|
|---|
| 45 | ; OT than approved requests.
|
|---|
| 46 | ;
|
|---|
| 47 | ;Input: PPE - (P)ay (P)eriod (E)xternal in format YY-PP.
|
|---|
| 48 | ; EI - (E)mployees (I)nternal entry # from file 450.
|
|---|
| 49 | ; E8B - (E)ntire (8B) record. Stored in ^PRST(458,PP,"E",EI,5).
|
|---|
| 50 | ; WK - week number 1 or 2 of pay period.
|
|---|
| 51 | ;Output: Warning message to screen.
|
|---|
| 52 | ;Local: OA - (O)vertime (A)pproved from requests file.
|
|---|
| 53 | ; O8 - (O)vertime totaled from (8)b string.
|
|---|
| 54 | ;
|
|---|
| 55 | S (OA,O8,OTERR)=0
|
|---|
| 56 | ; Compare week of approved ot requests to 8B OT.
|
|---|
| 57 | S O8=$$GET8BOT(EI,WK,E8B) ; get all OT from 8b string
|
|---|
| 58 | S OA=$$APOTWEEK(PPE,WK,EI) ; get approved overtime
|
|---|
| 59 | I OA<O8 D DISPLAY(EI,O8,OA,WK) S OTERR=1 ; Display warning if calc>apprv
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 63 | DISPLAY(IEN,OT8B,OTRQ,WK) ;Output warning message. 8b ot > approved ot.
|
|---|
| 64 | ;
|
|---|
| 65 | ; Input: IEN - employees 450 ien.
|
|---|
| 66 | ; OT8B - employees total overtime calculated from 8b string.
|
|---|
| 67 | ; OTRQ - employees total approved OT request's from 458.2
|
|---|
| 68 | ; WK - week 1 or 2 of payperiod.
|
|---|
| 69 | ;
|
|---|
| 70 | W !,?3,"WARNING: Week ",WK," -Overtime being paid (",OT8B,") is more than approved (",OTRQ,")."
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 74 | GET8BOT(EMPIEN,WEEK,TT8B) ;
|
|---|
| 75 | ; Output: Function returns total hrs of overtime that is coded
|
|---|
| 76 | ; into TT8B string for either week (1) or (2).
|
|---|
| 77 | ; Input: EMPIEN - internal entry # of employee to check 8B overtime
|
|---|
| 78 | ; WEEK - week (1) or (2) of pay period to check 8B overtime.
|
|---|
| 79 | ; TT8B - full 8B string stub & values.
|
|---|
| 80 | ;
|
|---|
| 81 | N PPIEN,TT8BOT,OTCODES,CODE,OTTOTAL,OTTMP
|
|---|
| 82 | S OTTOTAL=0
|
|---|
| 83 | ;
|
|---|
| 84 | ; get time coded portion of 8B string
|
|---|
| 85 | ;
|
|---|
| 86 | S TT8B=$$GET8BCDS(TT8B)
|
|---|
| 87 | Q:$L(TT8B)<2 OTTOTAL ; Aint no coded OT if there aint no codes.
|
|---|
| 88 | ;
|
|---|
| 89 | ; create array of codes & values for this 8b string.
|
|---|
| 90 | D ARRAY8B(TT8B)
|
|---|
| 91 | ;
|
|---|
| 92 | ; create string with all overtime codes.
|
|---|
| 93 | S OTCODES=$S(WEEK=1:"^DA^DB^DC^OA^OB^OC^OK^",1:"^DE^DF^DG^OE^OF^OG^OS^")
|
|---|
| 94 | ; Only count total regular hours @ OT rate when not a firefighter
|
|---|
| 95 | ; with premium pay code "R" or "C". These firefighters get RA/RE from
|
|---|
| 96 | ; their scheduled tour and do not need to have overtime requests. *54
|
|---|
| 97 | I "^R^C^"'[(U_$P($G(^PRSPC(EMPIEN,"PREMIUM")),U,6)_U) D
|
|---|
| 98 | . S OTCODES=OTCODES_$S(WEEK=1:"RA^RB^RC^",1:"RE^RF^RG^")
|
|---|
| 99 | ;
|
|---|
| 100 | ; loop thru employees 8b array to see if they have any of
|
|---|
| 101 | ; overtime codes & add any of them up.
|
|---|
| 102 | ;
|
|---|
| 103 | S CODE=""
|
|---|
| 104 | F S CODE=$O(TT8B(WEEK,CODE)) Q:CODE="" D
|
|---|
| 105 | . I OTCODES[("^"_CODE_"^") D
|
|---|
| 106 | .. S OTTMP=TT8B(WEEK,CODE)
|
|---|
| 107 | .. S OTTOTAL=OTTOTAL+$E(OTTMP,1,2)+($E(OTTMP,3)*.25)
|
|---|
| 108 | Q OTTOTAL
|
|---|
| 109 | ;
|
|---|
| 110 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 111 | ;
|
|---|
| 112 | APOTWEEK(PAYPRD,WEEKID,EMP450) ;
|
|---|
| 113 | ;Function returns approved overtime totals for a week.
|
|---|
| 114 | ;Input: PPE,PAYPRD - pay period of concern. YY-PP
|
|---|
| 115 | ; WEEKID - week (1) or week (2) of pay period
|
|---|
| 116 | ; EMP450 - employees internal entry number in file 450.
|
|---|
| 117 | ;Output: TOTALOT - total hrs of overtime for a week
|
|---|
| 118 | ;
|
|---|
| 119 | ;local vars: D1 - 1st day of payperiod-returned by NX^PRSAPPU
|
|---|
| 120 | ; OTREC - a record containing 1 overtime request.
|
|---|
| 121 | ; START,STOP - 1st & last FM days of week (Sun,Sat)
|
|---|
| 122 | ;
|
|---|
| 123 | ; quit returning 0 if anything is missing.
|
|---|
| 124 | Q:$G(PAYPRD)=""!$G(WEEKID)=""!$G(EMP450)="" 0
|
|---|
| 125 | ;
|
|---|
| 126 | ; Loop thru OT/CT requests file x-ref on requested work date &
|
|---|
| 127 | ; add up all employees approved OT requests within week.
|
|---|
| 128 | ;
|
|---|
| 129 | N D1,PPE,TOTALOT,START,STOP,OTREC
|
|---|
| 130 | S TOTALOT=0
|
|---|
| 131 | D WEEKRNG(PAYPRD,WEEKID,.START,.STOP)
|
|---|
| 132 | S D1=START-.1
|
|---|
| 133 | F S D1=$O(^PRST(458.2,"AD",EMP450,D1)) Q:D1>STOP!(D1="") D
|
|---|
| 134 | . S OTREC=""
|
|---|
| 135 | . F S OTREC=$O(^PRST(458.2,"AD",EMP450,D1,OTREC)) Q:OTREC="" D
|
|---|
| 136 | .. I $$OTREQ(OTREC),$$OTAPPR(OTREC) D
|
|---|
| 137 | ... S TOTALOT=TOTALOT+$P($G(^PRST(458.2,OTREC,0)),"^",6)
|
|---|
| 138 | Q TOTALOT
|
|---|
| 139 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 140 | OTREQ(REC) ;Function returns true if Request is type Overtime.
|
|---|
| 141 | Q:$G(REC)="" 0
|
|---|
| 142 | Q $P($G(^PRST(458.2,REC,0)),"^",5)="OT"
|
|---|
| 143 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 144 | OTAPPR(REC) ;Function returns true if a Request is Approved.
|
|---|
| 145 | Q:$G(REC)="" 0
|
|---|
| 146 | Q "AS"[$P($G(^PRST(458.2,REC,0)),"^",8)
|
|---|
| 147 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 148 | WEEKRNG(PPE,WEEK,FIRST,LAST) ;
|
|---|
| 149 | ;
|
|---|
| 150 | ; Routine takes a pay period & a week number & returns
|
|---|
| 151 | ; 1st & last FileMan days of specified week.
|
|---|
| 152 | ; Input: PPE - pay period in format YY-PP.
|
|---|
| 153 | ; WEEK - week (1) or (2).
|
|---|
| 154 | ; Output: .FIRST - first day of specified week-FM format
|
|---|
| 155 | ; .LAST - last day of specified week-FM format
|
|---|
| 156 | N D1,X1,X2,PPD1
|
|---|
| 157 | D NX^PRSAPPU S PPD1=D1
|
|---|
| 158 | I WEEK=1 D
|
|---|
| 159 | . S (FIRST,X1)=PPD1,X2=6 D C^%DTC S LAST=X
|
|---|
| 160 | E D
|
|---|
| 161 | . S X1=PPD1,X2=7 D C^%DTC S FIRST=X
|
|---|
| 162 | . S X1=PPD1,X2=13 D C^%DTC S LAST=X
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 166 | GET8BCDS(TT8B) ; GET 8B time CoDeS
|
|---|
| 167 | ; Input: Full 8b record as stored on node 5 of employee record
|
|---|
| 168 | ; in time & attendance file.
|
|---|
| 169 | ; Output: Function returns section of 8b record with pay
|
|---|
| 170 | ; codes & values.
|
|---|
| 171 | ;
|
|---|
| 172 | ; i.e. return last portion of 8b record ----- <<AN280AL120CD00040>>
|
|---|
| 173 | ; ^PRST(458,,"E",,5)=658226944741FLI 8B256280A112 AN280AL120CD00040
|
|---|
| 174 | ;
|
|---|
| 175 | ; Input: FULL 8B RECORD
|
|---|
| 176 | ;
|
|---|
| 177 | Q $E(TT8B,33,$L(TT8B))
|
|---|
| 178 | ;
|
|---|
| 179 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 180 | ARRAY8B(RECORD) ; Build employee 8B array.
|
|---|
| 181 | ; calls to this routine are responsible for cleaning up TT8B( array.
|
|---|
| 182 | ;
|
|---|
| 183 | ; Build a TT8B array which contains ONLY codes & values
|
|---|
| 184 | ; that are in employees 8B record.
|
|---|
| 185 | ;
|
|---|
| 186 | ; Input: RECORD - last portion of 8B array with codes & values.
|
|---|
| 187 | ; e.g. <<AN280AL120CD00040>> (see GET8BCDS^PRSAOTT)
|
|---|
| 188 | ;
|
|---|
| 189 | ; Output: array subscripted by time code & set equal to value.
|
|---|
| 190 | ; e.g. TT8B(1,"AN")=010
|
|---|
| 191 | ; TT8B(1,"DA")=020
|
|---|
| 192 | ; TT8B(1,"NA")=020
|
|---|
| 193 | ; TT8B(2,"SL")=080
|
|---|
| 194 | ; TT8B(3,"CD")=000130
|
|---|
| 195 | ;
|
|---|
| 196 | K TT8B S TT8B(0)=0
|
|---|
| 197 | Q:$G(RECORD)=""
|
|---|
| 198 | N EOR,TYPE,VALUE,LOOP,WK
|
|---|
| 199 | S EOR=0
|
|---|
| 200 | F D Q:EOR=1
|
|---|
| 201 | . S TYPE=$E(RECORD,1,2)
|
|---|
| 202 | .; I TYPE="CD" S VALUE=$E(RECORD,3,$L(RECORD)) S EOR=1
|
|---|
| 203 | .;
|
|---|
| 204 | .;traverse record to next code so LOOP gets len of curr code value
|
|---|
| 205 | .;
|
|---|
| 206 | . F LOOP=3:1:$L(RECORD) Q:$E(RECORD,LOOP)?1U
|
|---|
| 207 | . S:LOOP=$L(RECORD) EOR=1
|
|---|
| 208 | . S VALUE=$S(EOR=1:$E(RECORD,3,LOOP),1:$E(RECORD,3,LOOP-1))
|
|---|
| 209 | . S:EOR=0 RECORD=$E(RECORD,LOOP,$L(RECORD))
|
|---|
| 210 | .;
|
|---|
| 211 | .;Put code into corresponding week of TT8B array.
|
|---|
| 212 | .;
|
|---|
| 213 | . S WK=$S($F($$CODES(1),TYPE):1,$F($$CODES(2),TYPE):2,$F($$CODES(3),TYPE):3,1:"unknown")
|
|---|
| 214 | . S TT8B(WK,TYPE)=VALUE,TT8B(0)=TT8B(0)+1
|
|---|
| 215 | Q
|
|---|
| 216 | ;
|
|---|
| 217 | ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|---|
| 218 | CODES(WEEK) ;
|
|---|
| 219 | ; 8b string can contain any number of codes. Some of codes
|
|---|
| 220 | ; are strictly for types of time in week 1 & some are for week 2.
|
|---|
| 221 | ; There are also pay period codes that are independant from weeks.
|
|---|
| 222 | ;
|
|---|
| 223 | ; This function returns a string of codes for specified
|
|---|
| 224 | ; week (1) or (2) -OR- (3)---8b codes independant of week.
|
|---|
| 225 | ;
|
|---|
| 226 | ; Input: WEEK - week (1) (2) of pay period.
|
|---|
| 227 | ;
|
|---|
| 228 | Q:$G(WEEK)="" 0
|
|---|
| 229 | Q:WEEK=1 "AN SK WD NO AU RT CE CU UN NA NB SP SA SB SC DA DB DC TF OA OB OC YA OK OM RA RB RC HA HB HC PT PA ON YD HD VC EA EB TA TC FA FC AD NT RS ND SR SD"
|
|---|
| 230 | ;
|
|---|
| 231 | Q:WEEK=2 "AL SL WP NP AB RL CT CO US NR NS SQ SE SF SG DE DF DG TG OE OF OG YE OS OU RE RF RG HL HM HN PH PB CL YH HO VS EC ED TB TD FB FD AF NH RN NU SS SH"
|
|---|
| 232 | ;
|
|---|
| 233 | Q:WEEK=3 "NL DW IN TL LU LN LD DT TO LA ML CA PC CY RR FF FE CD"
|
|---|
| 234 | Q 0
|
|---|
