Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCRHBS6

IBCRHBS6.m

Go to the documentation of this file. 
  1. IBCRHBS6 ;ALB/ARH - RATES: UPLOAD (RC 2+) CALCULATIONS SETUP ; 10-OCT-03
  1.  ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. INPT(IBSITE,IBXRF1) ; Create Charge Sets for Inpatient and SNF Charges
  1.  N IBRG,IBDIVN,IBEVNT,IBBS,TYPE
  1.  W !,$P(IBSITE,U,2)," ",$P(IBSITE,U,3)," - Inpatient and SNF Charges"
  1.  ;
  1.  ; set billing region
  1.  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))
  1.  S IBRG=$P(IBRG,U,2),IBDIVN=$P(IBSITE,U,2)
  1.  ;
  1.  S TYPE=$P(IBSITE,U,5) Q:TYPE'=1
  1.  ;
  1.  ;
  1.  ; Inpatient Facility Per Diem Charges from Table A (DRG Based)
  1.  S IBEVNT="INPATIENT DRG",IBBS="GENERAL MEDICAL CARE" ; Inpatient Standard DRG Charges
  1.  D SETUP(IBXRF1,"Inpt PD R&B","RC-INPT R&B","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",101,IBBS)
  1.  D SETUP(IBXRF1,"Inpt PD Anc","RC-INPT ANC","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",240,IBBS)
  1.  ;
  1.  S IBEVNT="INPATIENT DRG",IBBS="ICU" ; Inpatient ICU DRG Charges
  1.  D SETUP(IBXRF1,"Inpt PD R&B ICU","RC-INPT R&B ICU","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",200,IBBS)
  1.  D SETUP(IBXRF1,"Inpt PD Anc ICU","RC-INPT ANC ICU","RC INPATIENT FACILITY",IBDIVN,4,IBEVNT,IBRG,"INST",240,IBBS)
  1.  ;
  1.  S IBEVNT="INPATIENT BEDSECTION STAY",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; Inpatient SNF Charges
  1.  D SETUP(IBXRF1,"SNF PD INC","RC-SNF INC","RC FACILITY PER DIEM",IBDIVN,1,IBEVNT,IBRG,"INST",101,IBBS)
  1.  ;
  1.  ;
  1.  ; Inpatient Facility Charges from Table B (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="GENERAL MEDICAL CARE" ; Inpatient Facility Charges
  1.  D SETUP(IBXRF1,"Inpt Fac 1","RC-INPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  D SETUP(IBXRF1,"Inpt Fac 2","RC-INPT FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  D SETUP(IBXRF1,"Inpt Fac 4","RC-INPT FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  ;
  1.  S IBEVNT="PROCEDURE",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; SNF Facility Charges
  1.  D SETUP(IBXRF1,"SNF Fac 1","RC-SNF FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  D SETUP(IBXRF1,"SNF Fac 2","RC-SNF FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  D SETUP(IBXRF1,"SNF Fac 4","RC-SNF FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  ;
  1.  ;
  1.  ; Inpatient Facility Charges from Table C (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="GENERAL MEDICAL CARE" ; Inpatient Facility CPT Charges
  1.  D SETUP(IBXRF1,"Inpt Fac/Phys 1","RC-INPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  ;
  1.  S IBEVNT="PROCEDURE",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; SNF Facility CPT Charges
  1.  D SETUP(IBXRF1,"SNF Fac/Phys 1","RC-SNF FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",240,IBBS)
  1.  ;
  1.  ;
  1.  ; Inpatient Physician Charges from Table C (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="GENERAL MEDICAL CARE" ; Inpatient Professional CPT Charges
  1.  D SETUP(IBXRF1,"Inpt Phys 1","RC-PHYSICIAN INPT PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
  1.  D SETUP(IBXRF1,"Inpt Phys 3","RC-PHYSICIAN INPT MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
  1.  ;
  1.  S IBEVNT="PROCEDURE",IBBS="SKILLED NURSING/SUB-ACUTE CARE" ; SNF Professional CPT Charges
  1.  D SETUP(IBXRF1,"SNF Phys 1","RC-PHYSICIAN SNF PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
  1.  D SETUP(IBXRF1,"SNF Phys 3","RC-PHYSICIAN SNF MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",960,IBBS)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. OPT(IBSITE,IBXRF1) ; Create Charge Sets for Outpatient Facilities (CPT based and Partial Hospitalization)
  1.  N IBRG,IBDIVN,IBEVNT,IBBS,TYPE
  1.  W !,$P(IBSITE,U,2)," ",$P(IBSITE,U,3)," - Outpatient Charges"
  1.  ;
  1.  ; set billing region
  1.  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))
  1.  S IBRG=$P(IBRG,U,2),IBDIVN=$P(IBSITE,U,2)
  1.  ;
  1.  S TYPE=$P(IBSITE,U,5) Q:TYPE'<3
  1.  ;
  1.  ;
  1.  ; Outpatient Facility Charges from Table B (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Outpatient Facility CPT Charges
  1.  D SETUP(IBXRF1,"Opt Fac 1","RC-OPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
  1.  D SETUP(IBXRF1,"Opt Fac 2","RC-OPT FAC HR","RC FACILITY HR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
  1.  D SETUP(IBXRF1,"Opt Fac 4","RC-OPT FAC ML","RC FACILITY ML",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
  1.  ;
  1.  S IBEVNT="UNASSOCIATED",IBBS="PARTIAL HOSPITALIZATION" ; Partial Hospitalization Facility Per Diem Charge
  1.  D SETUP(IBXRF1,"Opt PD PHosp","RC-OPT MISC","RC MISCELLANEOUS",IBDIVN,9,IBEVNT,IBRG,"INST",912,IBBS)
  1.  ;
  1.  ;
  1.  ; Outpatient Facility Charges from Table C (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Outpatient Facility CPT Charges
  1.  D SETUP(IBXRF1,"Opt Fac/Phys 1","RC-OPT FAC PR","RC FACILITY PR",IBDIVN,2,IBEVNT,IBRG,"INST",510,IBBS)
  1.  ;
  1.  ;
  1.  ; Outpatient Physician Charges from Table C (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Outpatient Professional CPT Charges
  1.  D SETUP(IBXRF1,"Opt Phys 1","RC-PHYSICIAN OPT PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  D SETUP(IBXRF1,"Opt Phys 3","RC-PHYSICIAN OPT MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FREE(IBSITE,IBXRF1) ; Create Charge Sets for Freestanding Facilities
  1.  N IBRG,IBDIVN,IBEVNT,IBBS,TYPE
  1.  W !,$P(IBSITE,U,2)," ",$P(IBSITE,U,3)," - Freestanding Charges"
  1.  ;
  1.  ; set billing region
  1.  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))
  1.  S IBRG=$P(IBRG,U,2),IBDIVN=$P(IBSITE,U,2)
  1.  ;
  1.  S TYPE=$P(IBSITE,U,5) Q:TYPE'=3
  1.  ;
  1.  ;
  1.  ; Freestanding Physician Charges from Table C (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Freestanding Professional CPT Charges
  1.  D SETUP(IBXRF1,"FS Phys 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  D SETUP(IBXRF1,"FS Phys 3","RC-PHYSICIAN FS MN","RC PHYSICIAN MN",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  ;
  1.  ;
  1.  ; Freestanding Physician Charges from Table B (CPT Based)
  1.  S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Freestanding Professional CPT Charges
  1.  D SETUP(IBXRF1,"FS Phys/Opt 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  D SETUP(IBXRF1,"FS Phys/Opt 4","RC-PHYSICIAN FS ML","RC PHYSICIAN ML",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  D SETUP(IBXRF1,"FS Phys/Opt TC 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  ;
  1.  ;
  1.  ; Freestanding Physician Global Charges from Table C (CPT Based, sum of TC and 26)
  1.  S IBEVNT="PROCEDURE",IBBS="OUTPATIENT VISIT" ; Freestanding Professional CPT Charges
  1.  D SETUP(IBXRF1,"FS Phys/Add 00 1","RC-PHYSICIAN FS PR","RC PHYSICIAN PR",IBDIVN,2,IBEVNT,IBRG,"PROF",510,IBBS)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SETUP(IBXRF1,IBXRF2,CSNM,BRATE,DIVN,BITEM,EVNT,RG,CHGTYP,RVCD,BS) ; Set up XTMP array and Charge Set for Charges
  1.  N IBCS
  1.  ;
  1.  S IBCS=$$CS^IBCRHU2(CSNM_" "_DIVN,BRATE,EVNT,RG,CHGTYP,RVCD,BS)
  1.  ;
  1.  D SETHDR(IBXRF1,IBXRF2,IBCS,BITEM)
  1.  ;
  1.  Q
  1.  ;
  1. SETHDR(IBXRF1,IBXRF2,CS,BITYPE) ; set up header for XTMP file
  1.  N IBX
  1.  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)
  1.  S ^XTMP(IBXRF1,0)=$$FMADD^XLFDT(DT,2)_U_DT_U_IBX
  1.  ;
  1.  S ^XTMP(IBXRF1,IBXRF2)=0_U_$G(BITYPE)_U_$G(CS)
  1.  Q