IBCRHBS6 ;ALB/ARH - RATES: UPLOAD (RC 2+) CALCULATIONS SETUP ; 10-OCT-03
;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
INPT(IBSITE,IBXRF1) ; Create Charge Sets for Inpatient and SNF Charges
N IBRG,IBDIVN,IBEVNT,IBBS,TYPE
W !,$P(IBSITE,U,2)," ",$P(IBSITE,U,3)," - Inpatient and SNF Charges"
;
; set billing region
S IBRG=$$RG^IBCRHU2("RC "_$P(IBSITE,U,2)_" - "_$P(IBSITE,U,3),$P(IBSITE,U,2),$P(IBSITE,U,4),$P(IBSITE,U,5))
S IBRG=$P(IBRG,U,2),IBDIVN=$P(IBSITE,U,2)
;
S TYPE=$P(IBSITE,U,5) Q:TYPE'=1
;
;
; Inpatient Facility Per Diem Charges from Table A (DRG Based)
S IBEVNT="INPATIENT DRG",IBBS="GENERAL MEDICAL CARE" ; Inpatient Standard DRG Charges
D SETUP(IBXRF1,"Inpt PD R&B","RC-INPT R&B","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",101,IBBS)
D SETUP(IBXRF1,"Inpt PD Anc","RC-INPT ANC","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",240,IBBS)
;
S IBEVNT="INPATIENT DRG",IBBS="ICU" ; Inpatient ICU DRG Charges
D SETUP(IBXRF1,"Inpt PD R&B ICU","RC-INPT R&B ICU","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",200,IBBS)
D SETUP(IBXRF1,"Inpt PD Anc ICU","RC-INPT ANC ICU","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",240,IBBS)
;
S IBEVNT="INPATIENT BEDSECTION STAY",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; Inpatient SNF Charges
D SETUP(IBXRF1,"SNF PD INC","RC-SNF INC","RC FACILITY PER DIEM",IBDIVN,1,IBEVNT,IBRG,"INST",101,IBBS)
;
;
; Inpatient Facility Charges from Table B (CPT Based)
S IBEVNT="PROCEDURE",IBBS="GENERAL MEDICAL CARE" ; Inpatient Facility Charges
D SETUP(IBXRF1,"Inpt Fac 1","RC-INPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
D SETUP(IBXRF1,"Inpt Fac 2","RC-INPT FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
D SETUP(IBXRF1,"Inpt Fac 4","RC-INPT FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
;
S IBEVNT="PROCEDURE",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; SNF Facility Charges
D SETUP(IBXRF1,"SNF Fac 1","RC-SNF FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
D SETUP(IBXRF1,"SNF Fac 2","RC-SNF FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
D SETUP(IBXRF1,"SNF Fac 4","RC-SNF FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
;
;
; Inpatient Facility Charges from Table C (CPT Based)
S IBEVNT="PROCEDURE",IBBS="GENERAL MEDICAL CARE" ; Inpatient Facility CPT Charges
D SETUP(IBXRF1,"Inpt Fac/Phys 1","RC-INPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
;
S IBEVNT="PROCEDURE",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; SNF Facility CPT Charges
D SETUP(IBXRF1,"SNF Fac/Phys 1","RC-SNF FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
;
;
; Inpatient Physician Charges from Table C (CPT Based)
S IBEVNT="PROCEDURE",IBBS="GENERAL MEDICAL CARE" ; Inpatient Professional CPT Charges
D SETUP(IBXRF1,"Inpt Phys 1","RC-PHYSICIAN INPT PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
D SETUP(IBXRF1,"Inpt Phys 3","RC-PHYSICIAN INPT MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
;
S IBEVNT="PROCEDURE",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; SNF Professional CPT Charges
D SETUP(IBXRF1,"SNF Phys 1","RC-PHYSICIAN SNF PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
D SETUP(IBXRF1,"SNF Phys 3","RC-PHYSICIAN SNF MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
;
Q
;
;
OPT(IBSITE,IBXRF1) ; Create Charge Sets for Outpatient Facilities (CPT based and Partial Hospitalization)
N IBRG,IBDIVN,IBEVNT,IBBS,TYPE
W !,$P(IBSITE,U,2)," ",$P(IBSITE,U,3)," - Outpatient Charges"
;
; set billing region
S IBRG=$$RG^IBCRHU2("RC "_$P(IBSITE,U,2)_" - "_$P(IBSITE,U,3),$P(IBSITE,U,2),$P(IBSITE,U,4),$P(IBSITE,U,5))
S IBRG=$P(IBRG,U,2),IBDIVN=$P(IBSITE,U,2)
;
S TYPE=$P(IBSITE,U,5) Q:TYPE'<3
;
;
; Outpatient Facility Charges from Table B (CPT Based)
S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Outpatient Facility CPT Charges
D SETUP(IBXRF1,"Opt Fac 1","RC-OPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
D SETUP(IBXRF1,"Opt Fac 2","RC-OPT FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
D SETUP(IBXRF1,"Opt Fac 4","RC-OPT FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
;
S IBEVNT="UNASSOCIATED",IBBS="PARTIAL HOSPITALIZATION" ; Partial Hospitalization Facility Per Diem Charge
D SETUP(IBXRF1,"Opt PD PHosp","RC-OPT MISC","RC MISCELLANEOUS",IBDIVN,9,IBEVNT,IBRG,"INST",912,IBBS)
;
;
; Outpatient Facility Charges from Table C (CPT Based)
S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Outpatient Facility CPT Charges
D SETUP(IBXRF1,"Opt Fac/Phys 1","RC-OPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
;
;
; Outpatient Physician Charges from Table C (CPT Based)
S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Outpatient Professional CPT Charges
D SETUP(IBXRF1,"Opt Phys 1","RC-PHYSICIAN OPT PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
D SETUP(IBXRF1,"Opt Phys 3","RC-PHYSICIAN OPT MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
;
Q
;
;
FREE(IBSITE,IBXRF1) ; Create Charge Sets for Freestanding Facilities
N IBRG,IBDIVN,IBEVNT,IBBS,TYPE
W !,$P(IBSITE,U,2)," ",$P(IBSITE,U,3)," - Freestanding Charges"
;
; set billing region
S IBRG=$$RG^IBCRHU2("RC "_$P(IBSITE,U,2)_" - "_$P(IBSITE,U,3),$P(IBSITE,U,2),$P(IBSITE,U,4),$P(IBSITE,U,5))
S IBRG=$P(IBRG,U,2),IBDIVN=$P(IBSITE,U,2)
;
S TYPE=$P(IBSITE,U,5) Q:TYPE'=3
;
;
; Freestanding Physician Charges from Table C (CPT Based)
S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Freestanding Professional CPT Charges
D SETUP(IBXRF1,"FS Phys 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
D SETUP(IBXRF1,"FS Phys 3","RC-PHYSICIAN FS MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
;
;
; Freestanding Physician Charges from Table B (CPT Based)
S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Freestanding Professional CPT Charges
D SETUP(IBXRF1,"FS Phys/Opt 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
D SETUP(IBXRF1,"FS Phys/Opt 4","RC-PHYSICIAN FS ML","RC PHYSICIAN ML",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
D SETUP(IBXRF1,"FS Phys/Opt TC 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
;
;
; Freestanding Physician Global Charges from Table C (CPT Based, sum of TC and 26)
S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Freestanding Professional CPT Charges
D SETUP(IBXRF1,"FS Phys/Add 00 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
;
Q
;
;
SETUP(IBXRF1,IBXRF2,CSNM,BRATE,DIVN,BITEM,EVNT,RG,CHGTYP,RVCD,BS) ; Set up XTMP array and Charge Set for Charges
N IBCS
;
S IBCS=$$CS^IBCRHU2(CSNM_" "_DIVN,BRATE,EVNT,RG,CHGTYP,RVCD,BS)
;
D SETHDR(IBXRF1,IBXRF2,IBCS,BITEM)
;
Q
;
SETHDR(IBXRF1,IBXRF2,CS,BITYPE) ; set up header for XTMP file
N IBX
S IBX="IB Upload RC v"_$$VERSION^IBCRHBRV_" "_$P(IBXRF1,"UPLOAD RC ",2)_", "_$P($$HTE^XLFDT($H,2),":",1,2)_" by "_$P($G(^VA(200,+$G(DUZ),0)),U,1)
S ^XTMP(IBXRF1,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_IBX
;
S ^XTMP(IBXRF1,IBXRF2)=0_U_$G(BITYPE)_U_$G(CS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRHBS6 7306 printed Nov 22, 2024@17:29:33 Page 2
IBCRHBS6 ;ALB/ARH - RATES: UPLOAD (RC 2+) CALCULATIONS SETUP ; 10-OCT-03
+1 ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
INPT(IBSITE,IBXRF1) ; Create Charge Sets for Inpatient and SNF Charges
+1 NEW IBRG,IBDIVN,IBEVNT,IBBS,TYPE
+2 WRITE !,$PIECE(IBSITE,U,2)," ",$PIECE(IBSITE,U,3)," - Inpatient and SNF Charges"
+3 ;
+4 ; set billing region
+5 SET IBRG=$$RG^IBCRHU2("RC "_$PIECE(IBSITE,U,2)_" - "_$PIECE(IBSITE,U,3),$PIECE(IBSITE,U,2),$PIECE(IBSITE,U,4),$PIECE(IBSITE,U,5))
+6 SET IBRG=$PIECE(IBRG,U,2)
SET IBDIVN=$PIECE(IBSITE,U,2)
+7 ;
+8 SET TYPE=$PIECE(IBSITE,U,5)
if TYPE'=1
QUIT
+9 ;
+10 ;
+11 ; Inpatient Facility Per Diem Charges from Table A (DRG Based)
+12 ; Inpatient Standard DRG Charges
SET IBEVNT="INPATIENT DRG"
SET IBBS="GENERAL MEDICAL CARE"
+13 DO SETUP(IBXRF1,"Inpt PD R&B","RC-INPT R&B","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",101,IBBS)
+14 DO SETUP(IBXRF1,"Inpt PD Anc","RC-INPT ANC","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",240,IBBS)
+15 ;
+16 ; Inpatient ICU DRG Charges
SET IBEVNT="INPATIENT DRG"
SET IBBS="ICU"
+17 DO SETUP(IBXRF1,"Inpt PD R&B ICU","RC-INPT R&B ICU","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",200,IBBS)
+18 DO SETUP(IBXRF1,"Inpt PD Anc ICU","RC-INPT ANC ICU","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",240,IBBS)
+19 ;
+20 ; Inpatient SNF Charges
SET IBEVNT="INPATIENT BEDSECTION STAY"
SET IBBS="SKILLED NURSING/SUB-ACUTE CARE"
+21 DO SETUP(IBXRF1,"SNF PD INC","RC-SNF INC","RC FACILITY PER DIEM",IBDIVN,1,IBEVNT,IBRG,"INST",101,IBBS)
+22 ;
+23 ;
+24 ; Inpatient Facility Charges from Table B (CPT Based)
+25 ; Inpatient Facility Charges
SET IBEVNT="PROCEDURE"
SET IBBS="GENERAL MEDICAL CARE"
+26 DO SETUP(IBXRF1,"Inpt Fac 1","RC-INPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+27 DO SETUP(IBXRF1,"Inpt Fac 2","RC-INPT FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+28 DO SETUP(IBXRF1,"Inpt Fac 4","RC-INPT FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+29 ;
+30 ; SNF Facility Charges
SET IBEVNT="PROCEDURE"
SET IBBS="SKILLED NURSING/SUB-ACUTE CARE"
+31 DO SETUP(IBXRF1,"SNF Fac 1","RC-SNF FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+32 DO SETUP(IBXRF1,"SNF Fac 2","RC-SNF FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+33 DO SETUP(IBXRF1,"SNF Fac 4","RC-SNF FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+34 ;
+35 ;
+36 ; Inpatient Facility Charges from Table C (CPT Based)
+37 ; Inpatient Facility CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="GENERAL MEDICAL CARE"
+38 DO SETUP(IBXRF1,"Inpt Fac/Phys 1","RC-INPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+39 ;
+40 ; SNF Facility CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="SKILLED NURSING/SUB-ACUTE CARE"
+41 DO SETUP(IBXRF1,"SNF Fac/Phys 1","RC-SNF FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
+42 ;
+43 ;
+44 ; Inpatient Physician Charges from Table C (CPT Based)
+45 ; Inpatient Professional CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="GENERAL MEDICAL CARE"
+46 DO SETUP(IBXRF1,"Inpt Phys 1","RC-PHYSICIAN INPT PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
+47 DO SETUP(IBXRF1,"Inpt Phys 3","RC-PHYSICIAN INPT MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
+48 ;
+49 ; SNF Professional CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="SKILLED NURSING/SUB-ACUTE CARE"
+50 DO SETUP(IBXRF1,"SNF Phys 1","RC-PHYSICIAN SNF PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
+51 DO SETUP(IBXRF1,"SNF Phys 3","RC-PHYSICIAN SNF MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
+52 ;
+53 QUIT
+54 ;
+55 ;
OPT(IBSITE,IBXRF1) ; Create Charge Sets for Outpatient Facilities (CPT based and Partial Hospitalization)
+1 NEW IBRG,IBDIVN,IBEVNT,IBBS,TYPE
+2 WRITE !,$PIECE(IBSITE,U,2)," ",$PIECE(IBSITE,U,3)," - Outpatient Charges"
+3 ;
+4 ; set billing region
+5 SET IBRG=$$RG^IBCRHU2("RC "_$PIECE(IBSITE,U,2)_" - "_$PIECE(IBSITE,U,3),$PIECE(IBSITE,U,2),$PIECE(IBSITE,U,4),$PIECE(IBSITE,U,5))
+6 SET IBRG=$PIECE(IBRG,U,2)
SET IBDIVN=$PIECE(IBSITE,U,2)
+7 ;
+8 SET TYPE=$PIECE(IBSITE,U,5)
if TYPE'<3
QUIT
+9 ;
+10 ;
+11 ; Outpatient Facility Charges from Table B (CPT Based)
+12 ; Outpatient Facility CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="OUTPATIENT VISIT"
+13 DO SETUP(IBXRF1,"Opt Fac 1","RC-OPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
+14 DO SETUP(IBXRF1,"Opt Fac 2","RC-OPT FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
+15 DO SETUP(IBXRF1,"Opt Fac 4","RC-OPT FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
+16 ;
+17 ; Partial Hospitalization Facility Per Diem Charge
SET IBEVNT="UNASSOCIATED"
SET IBBS="PARTIAL HOSPITALIZATION"
+18 DO SETUP(IBXRF1,"Opt PD PHosp","RC-OPT MISC","RC MISCELLANEOUS",IBDIVN,9,IBEVNT,IBRG,"INST",912,IBBS)
+19 ;
+20 ;
+21 ; Outpatient Facility Charges from Table C (CPT Based)
+22 ; Outpatient Facility CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="OUTPATIENT VISIT"
+23 DO SETUP(IBXRF1,"Opt Fac/Phys 1","RC-OPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
+24 ;
+25 ;
+26 ; Outpatient Physician Charges from Table C (CPT Based)
+27 ; Outpatient Professional CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="OUTPATIENT VISIT"
+28 DO SETUP(IBXRF1,"Opt Phys 1","RC-PHYSICIAN OPT PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+29 DO SETUP(IBXRF1,"Opt Phys 3","RC-PHYSICIAN OPT MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+30 ;
+31 QUIT
+32 ;
+33 ;
FREE(IBSITE,IBXRF1) ; Create Charge Sets for Freestanding Facilities
+1 NEW IBRG,IBDIVN,IBEVNT,IBBS,TYPE
+2 WRITE !,$PIECE(IBSITE,U,2)," ",$PIECE(IBSITE,U,3)," - Freestanding Charges"
+3 ;
+4 ; set billing region
+5 SET IBRG=$$RG^IBCRHU2("RC "_$PIECE(IBSITE,U,2)_" - "_$PIECE(IBSITE,U,3),$PIECE(IBSITE,U,2),$PIECE(IBSITE,U,4),$PIECE(IBSITE,U,5))
+6 SET IBRG=$PIECE(IBRG,U,2)
SET IBDIVN=$PIECE(IBSITE,U,2)
+7 ;
+8 SET TYPE=$PIECE(IBSITE,U,5)
if TYPE'=3
QUIT
+9 ;
+10 ;
+11 ; Freestanding Physician Charges from Table C (CPT Based)
+12 ; Freestanding Professional CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="OUTPATIENT VISIT"
+13 DO SETUP(IBXRF1,"FS Phys 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+14 DO SETUP(IBXRF1,"FS Phys 3","RC-PHYSICIAN FS MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+15 ;
+16 ;
+17 ; Freestanding Physician Charges from Table B (CPT Based)
+18 ; Freestanding Professional CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="OUTPATIENT VISIT"
+19 DO SETUP(IBXRF1,"FS Phys/Opt 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+20 DO SETUP(IBXRF1,"FS Phys/Opt 4","RC-PHYSICIAN FS ML","RC PHYSICIAN ML",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+21 DO SETUP(IBXRF1,"FS Phys/Opt TC 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+22 ;
+23 ;
+24 ; Freestanding Physician Global Charges from Table C (CPT Based, sum of TC and 26)
+25 ; Freestanding Professional CPT Charges
SET IBEVNT="PROCEDURE"
SET IBBS="OUTPATIENT VISIT"
+26 DO SETUP(IBXRF1,"FS Phys/Add 00 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
+27 ;
+28 QUIT
+29 ;
+30 ;
SETUP(IBXRF1,IBXRF2,CSNM,BRATE,DIVN,BITEM,EVNT,RG,CHGTYP,RVCD,BS) ; Set up XTMP array and Charge Set for Charges
+1 NEW IBCS
+2 ;
+3 SET IBCS=$$CS^IBCRHU2(CSNM_" "_DIVN,BRATE,EVNT,RG,CHGTYP,RVCD,BS)
+4 ;
+5 DO SETHDR(IBXRF1,IBXRF2,IBCS,BITEM)
+6 ;
+7 QUIT
+8 ;
SETHDR(IBXRF1,IBXRF2,CS,BITYPE) ; set up header for XTMP file
+1 NEW IBX
+2 SET IBX="IB Upload RC v"_$$VERSION^IBCRHBRV_" "_$P(IBXRF1,"UPLOAD RC ",2)_", "_$PIECE($$HTE^XLFDT($HOROLOG,2),":",1,2)_" by "_$PIECE($GET(^VA(200,+$GET(DUZ),0)),U,1)
+3 SET ^XTMP(IBXRF1,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_IBX
+4 ;
+5 SET ^XTMP(IBXRF1,IBXRF2)=0_U_$GET(BITYPE)_U_$GET(CS)
+6 QUIT
