source: FOIAVistA/tag/r/PAID-PRS/PRSAOTT.m@ 1423

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

WorldVistAEHR overlayed on FOIAVistA

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