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