Changeset 623 for WorldVistAEHR/trunk/r/PAID-PRS/PRSAOTT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSAOTT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PAID-PRS/PRSAOTT.m
r613 r623 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 1 PRSAOTT ;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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 18 GETOTS(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 42 WARNSUP(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 62 DISPLAY(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 73 GET8BOT(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 ; 111 APOTWEEK(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 139 OTREQ(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 143 OTAPPR(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 147 WEEKRNG(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 165 GET8BCDS(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 179 ARRAY8B(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 ;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = 217 CODES(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 TracChangeset
for help on using the changeset viewer.
