source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBAAFSF.m@ 1801

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1FBAAFSF ;WCIOFO/dmk,SAB-OUTPATIENT 75TH PERCENTILE FEE SCHEDULE ;5/18/1999
2 ;;3.5;FEE BASIS;**4**;JAN 30, 1995
3 ;
4 Q
5 ;
6PRCTL(CPT,MODL,DOS) ; Calculate 75th Percentile Fee Schedule Amount
7 ; input
8 ; CPT - CPT/HCPCS code, external, required
9 ; MODL - list of optional CPT/HCPCS modifiers (external values)
10 ; delimited by commas
11 ; DOS - date of service, fileman format, required
12 ; returns $ amount or null if not on schedule
13 N FBAMT,FBERR
14 ;
15 ; initialize
16 S FBAMT=""
17 K FBERR
18 ;
19 ;validate parameters
20 S CPT=$G(CPT)
21 S DOS=$G(DOS)
22 I CPT="" D ERR^FBAAFS("Missing CPT")
23 I DOS'?7N D ERR^FBAAFS("Invalid Date of Service")
24 ;
25 I '$D(FBERR) D
26 . ; get data from 163.99 (stored in previous fiscal year)
27 . N FBDA,FBFY,FBI,FBMOD,FBMODA,FBMODLE,FBX
28 . S FBFY=$E(DOS,1,3)+1700+$E(DOS,4) ; fiscal year of service
29 . ;
30 . ; build a sorted list of the CPT modifiers
31 . F FBI=1:1 S FBMOD=$P(MODL,",",FBI) Q:FBMOD="" S FBMODA(FBMOD)=""
32 . S (FBMOD,FBMODLE)=""
33 . F S FBMOD=$O(FBMODA(FBMOD)) Q:FBMOD="" S FBMODLE=FBMODLE_","_FBMOD
34 . S:$E(FBMODLE)="," FBMODLE=$E(FBMODLE,2,999)
35 . ;
36 . ; build lookup value from CPT and sorted list of modifiers
37 . S FBX=CPT_$S(FBMODLE]"":"-"_FBMODLE,1:"")
38 . ; look in file
39 . S FBDA=$O(^FBAA(163.99,"B",FBX,0))
40 . I FBDA S FBAMT=$P($G(^FBAA(163.99,FBDA,"FY",FBFY-1,0)),U,5)
41 ;
42 ; return result
43 Q FBAMT
44 ;
45 ;FBAAFSF
Note: See TracBrowser for help on using the repository browser.