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

IB20P625.m

Go to the documentation of this file.
IB20P625 ;ALB/CXW - IB*2.0*625 COST BASED & INTER AGENCY RATE UPDATE;07/02/18
 ;;2.0;INTEGRATED BILLING;**625**;21-MAR-94;Build 25
 ;;Per VA Directive 6402, this routine should not be modified.
 ; 
 ;
 ; Add 2018 Cost Based/Interagency Charges to Charge Master 363.2
 Q
POST ;
 N IBEFFDT,IBA,U S U="^"
 D MSG("    IB*2.0*625 Post-Install .....")
 S IBEFFDT=3180828 ; effective date of 08/28/2018
 D ADDCI(IBEFFDT)  ; add Charge Items (363.2) with new rates
 D MSG("    IB*2.0*625 Post-Install Complete")
 Q
 ;
ADDCI(IBEFFDT) ; pass in the effective date to add charge items with new charges
 N IBCNT,IBCNT1,IBDFLTDT,IBI,IBLN
 D MSG("")
 S (IBCNT,IBCNT1)=0,IBDFLTDT=+$G(IBEFFDT)
 I 'IBDFLTDT D MSG("** Error: No Effective Date, No Charges Added") G CIQ
 ;
 F IBI=1:1 S IBLN=$P($T(CIF+IBI),";;",2) Q:+IBLN!(IBLN="")  I $E(IBLN)?1A D SETCI
 ;
 I +IBCNT1 D MSG("    >> "_IBCNT1_" Duplicate Charge Items already exist, not re-added")
 ;
CIQ D MSG("    >> "_IBCNT_" Cost Based/Interagency Charge Items added to CHARGE ITEM file (#363.2)")
 D MSG("")
 Q
 ;
SETCI ; set Charge Item (duplicates based on item, CS, eff dt, rev cd)
 ;
 N IBCHG,IBCI,IBCS,IBDT,IBFN,IBPE,IBRVCD,IBX,IBXRF,IBZ,DA,DD,DO,DLAYGO,DIC,DIE,DR,X,Y
 S IBCS=$P(IBLN,U,2),IBCS=+$O(^IBE(363.1,"B",IBCS,0)) I 'IBCS D MSG("** Error: Charge Set "_$P(IBLN,U,2)_" undefined") Q
 S IBCI=+$$MCCRUTL($P(IBLN,U,1),5) I 'IBCI D MSG("** Error: Bed Section "_$P(IBLN,U,1)_" undefined") Q
 S IBDT=IBDFLTDT I +$P(IBLN,U,3) S IBDT=+$P(IBLN,U,3)
 S IBRVCD=$$RVCD($P(IBLN,U,4))
 S IBCHG=+$P(IBLN,U,5)
 S IBXRF="AIVDTS"_IBCS
 ;
 S IBX=0 F  S IBX=$O(^IBA(363.2,IBXRF,IBCI,-IBDT,IBX)) Q:'IBX  S IBZ=$G(^IBA(363.2,IBX,0)) I $P(IBZ,U,6)=IBRVCD D
 . S IBCI=0,IBCNT1=IBCNT1+1 I +$P(IBZ,U,5)'=IBCHG D MSG("** Error: Item exists, wrong charge: "_IBLN)
 Q:'IBCI
 ;
 S DLAYGO=363.2,DIC="^IBA(363.2,",DIC(0)="L",X=IBCI_";DGCR(399.1," D FILE^DICN
 I Y<1 D MSG("** Error: when adding the charge item "_$P(IBLN,U,2)_" with rate "_IBCHG_" to the file, Log a ticket!") Q
 S IBFN=+Y,IBCNT=IBCNT+1
 ;
 S DR=".02///"_IBCS_";.03///"_IBDT_";.05///"_IBCHG I +IBRVCD S DR=DR_";.06///"_IBRVCD
 S DIE="^IBA(363.2,",DA=+IBFN D ^DIE
 Q
 ;
 ;
MCCRUTL(IBC,IBPE) ; returns IEN in 399.1 if Name is found and piece P is true
 N IBX,IBY S IBY=""
 I $G(IBC)'="" S IBX=0 F  S IBX=$O(^DGCR(399.1,"B",IBC,IBX)) Q:'IBX  I $P($G(^DGCR(399.1,IBX,0)),U,+$G(IBPE)) S IBY=IBX
 Q IBY
 ;
RVCD(RVCD) ; returns IFN if revenue code is valid and active
 N IBX,IBY S IBY=""
 I +$G(RVCD) S IBX=$G(^DGCR(399.2,+RVCD,0)) I +$P(IBX,U,3) S IBY=+RVCD
 Q IBY
 ;
MSG(IBA) ;
 D MES^XPDUTL(IBA)
 Q
 ;
CIF ; 68 Charge Items (363.2): Bedsection ^ Charge Set ^Effective Date ^ Revenue Code ^ Charge
 ;;     
TORT ;; Cost Based (Tortiously Liable) - All Inclusive
 ;;        
 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (INCLUSIVE)^^^1963
 ;;BLIND REHABILITATION^TL-INPT (INCLUSIVE)^^^1843
 ;;GENERAL MEDICAL CARE^TL-INPT (INCLUSIVE)^^^4025
 ;;INTERMEDIATE CARE^TL-INPT (INCLUSIVE)^^^2483
 ;;NEUROLOGY^TL-INPT (INCLUSIVE)^^^3805
 ;;NURSING HOME CARE^TL-INPT (INCLUSIVE)^^^1268
 ;;POLYTRAUMA INPATIENT^TL-INPT (INCLUSIVE)^^^3113
 ;;PRRTP^TL-INPT (INCLUSIVE)^^^768
 ;;PSYCHIATRIC CARE^TL-INPT (INCLUSIVE)^^^1993
 ;;REHABILITATION MEDICINE^TL-INPT (INCLUSIVE)^^^2749
 ;;SPINAL CORD INJURY CARE^TL-INPT (INCLUSIVE)^^^2431
 ;;SURGICAL CARE^TL-INPT (INCLUSIVE)^^^6832
 ;;             
 ;; Non-Professional: Nursing/Room/Board 101 & Ancillary 240    
 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^101^1322
 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^240^454
 ;;BLIND REHABILITATION^TL-INPT (NPF)^^101^779
 ;;BLIND REHABILITATION^TL-INPT (NPF)^^240^916
 ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^101^2494
 ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^240^1049
 ;;INTERMEDIATE CARE^TL-INPT (NPF)^^101^1997
 ;;INTERMEDIATE CARE^TL-INPT (NPF)^^240^364
 ;;NEUROLOGY^TL-INPT (NPF)^^101^2243
 ;;NEUROLOGY^TL-INPT (NPF)^^240^1005
 ;;NURSING HOME CARE^TL-INPT (NPF)^^101^1057
 ;;NURSING HOME CARE^TL-INPT (NPF)^^240^172
 ;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^101^1808
 ;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^240^951
 ;;PRRTP^TL-INPT (NPF)^^101^639
 ;;PRRTP^TL-INPT (NPF)^^240^81
 ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^101^1491
 ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^240^314
 ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^101^1597
 ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^240^840
 ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^101^1518
 ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^240^612
 ;;SURGICAL CARE^TL-INPT (NPF)^^101^4007
 ;;SURGICAL CARE^TL-INPT (NPF)^^240^2072
 ;;              
 ;; Professional Physician
 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (PF)^^^187
 ;;BLIND REHABILITATION^TL-INPT (PF)^^^148
 ;;GENERAL MEDICAL CARE^TL-INPT (PF)^^^482
 ;;INTERMEDIATE CARE^TL-INPT (PF)^^^122
 ;;NEUROLOGY^TL-INPT (PF)^^^557
 ;;NURSING HOME CARE^TL-INPT (PF)^^^39
 ;;POLYTRAUMA INPATIENT^TL-INPT (PF)^^^354
 ;;PRRTP^TL-INPT (PF)^^^48
 ;;PSYCHIATRIC CARE^TL-INPT (PF)^^^188
 ;;REHABILITATION MEDICINE^TL-INPT (PF)^^^312
 ;;SPINAL CORD INJURY CARE^TL-INPT (PF)^^^301
 ;;SURGICAL CARE^TL-INPT (PF)^^^753
 ;;                    
 ;; Outpatient Care Other
 ;;OUTPATIENT DENTAL^TL-OPT DENTAL^^^362
 ;;OUTPATIENT VISIT^TL-OPT VST^^^362
 ;;POLYTRAUMA OUTPATIENT VISIT^TL-OPT VST POLYTRAUMA^^^602
 ;;PM&RS OUTPATIENT VISIT^TL-OPT VST PM&RS^^^223
 ;;          
IA ;; Interagency
 ;;            
 ;;ALCOHOL AND DRUG TREATMENT^IA-INPT^^^1884
 ;;BLIND REHABILITATION^IA-INPT^^^1770
 ;;GENERAL MEDICAL CARE^IA-INPT^^^3882
 ;;INTERMEDIATE CARE^IA-INPT^^^2388
 ;;NEUROLOGY^IA-INPT^^^3664
 ;;NURSING HOME CARE^IA-INPT^^^1218
 ;;POLYTRAUMA INPATIENT^IA-INPT^^^2981
 ;;PRRTP^IA-INPT^^^740
 ;;PSYCHIATRIC CARE^IA-INPT^^^1913
 ;;REHABILITATION MEDICINE^IA-INPT^^^2641
 ;;SPINAL CORD INJURY CARE^IA-INPT^^^2338
 ;;SURGICAL CARE^IA-INPT^^^6590
 ;;OUTPATIENT DENTAL^IA-OPT DENTAL^^^350
 ;;OUTPATIENT VISIT^IA-OPT VST^^^350
 ;;POLYTRAUMA OUTPATIENT VISIT^IA-OPT VST POLYTRAUMA^^^580
 ;;PM&RS OUTPATIENT VISIT^IA-OPT VST PM&RS^^^213
 ;;
 Q