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

IB20P418.m

Go to the documentation of this file.
  1. IB20P418 ;ALB/CXW - IB*2*418 POST INIT: ADD TORT/INTERAGENCY RATES JULY 2011;07-11-2011
  1. ;;2.0;INTEGRATED BILLING;**418**;21-MAR-94;Build 16
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. ; Add JULY 2011 Tort and Interagency Charges to the Charge Master, 68 Charge Items
  1. Q
  1. POST ;
  1. N IBEFFDT
  1. D MSG(" IB*2*418 Post-Install .....")
  1. S IBEFFDT=3110711 ; effective date of Tort July 11th, 2011
  1. D ADDBS ; add Billable Events (399.1, .21)
  1. D ADDCS ; add Charge Sets (363.1)
  1. D ADDCI(IBEFFDT) ; add Charge Items (363.2) with new Tort Liable and Interagency charges or and Reasonable Charges
  1. D ADDRS ; add Rate Schedules (363)
  1. ;
  1. D MSG(" IB*2*418 Post-Install Complete")
  1. D MSG("")
  1. Q
  1. ;
  1. ADDBS ; Add new bedsections (399.1, .12)
  1. N IBA,IBCNT,IBI,IBLN,IBRB,IBFN,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
  1. S IBCNT=0
  1. ;
  1. F IBI=1:1 S IBLN=$P($T(BSF+IBI),";;",2) Q:+IBLN!(IBLN="") I $E(IBLN)?1A D
  1. . ;
  1. . I +$$MCCRUTL($P(IBLN,U,1),5) Q
  1. . ;
  1. . S IBRB=$P(IBLN,U,3) I IBRB'="" S IBRB=$$MCCRUTL(IBRB,13) D Q:'IBRB
  1. .. I 'IBRB D MSG(" *** Billable Service "_$P(IBLN,U,3)_" not defined, BS "_$P(IBLN,U,1)_" not created")
  1. . ;
  1. . K DD,DO S DLAYGO=399.1,DIC="^DGCR(399.1,",DIC(0)="L",X=$P(IBLN,U,1) D FILE^DICN K DIC I Y<1 K X,Y Q
  1. . S IBFN=+Y,IBCNT=IBCNT+1
  1. . ;
  1. . S DR=".03///"_$P(IBLN,U,2)_";.12///"_1 I +IBRB S DR=DR_";.25///"_IBRB
  1. . S DIE="^DGCR(399.1,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
  1. . ;
  1. ;
  1. BSQ D MSG(" >> "_IBCNT_" Bedsection added (399.1).")
  1. D MSG("")
  1. Q
  1. ;
  1. ADDCS ; Add Charge Sets (363.1)
  1. N IBA,IBCNT,IBI,IBLN,IBFN,IBBR,IBBE,IBRVCD,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y S IBCNT=0
  1. ;
  1. F IBI=1:1 S IBLN=$P($T(CSF+IBI),";;",2) Q:+IBLN!(IBLN="") I $E(IBLN)?1A D
  1. . ;
  1. . I $O(^IBE(363.1,"B",$P(IBLN,U,1),0)) Q
  1. . S IBBR=$P(IBLN,U,2),IBBR=$O(^IBE(363.3,"B",IBBR,0)) I 'IBBR Q
  1. . S IBBE=$$MCCRUTL($P(IBLN,U,3),14) Q:'IBBE
  1. . S IBRVCD=$$RVCD($P(IBLN,U,5))
  1. . ;
  1. . K DD,DO S DLAYGO=363.1,DIC="^IBE(363.1,",DIC(0)="L",X=$P(IBLN,U,1) D FILE^DICN K DIC I Y<1 K X,Y Q
  1. . S IBFN=+Y,IBCNT=IBCNT+1
  1. . ;
  1. . S DR=".02///"_IBBR_";.03///"_IBBE
  1. . I +$P(IBLN,U,4) S DR=DR_";.04///"_$P(IBLN,U,4)
  1. . I +IBRVCD S DR=DR_";.05///"_IBRVCD
  1. . S DIE="^IBE(363.1,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
  1. ;
  1. CSQ D MSG(" >> "_IBCNT_" Charge Sets added (363.1).")
  1. D MSG("")
  1. Q
  1. ;
  1. ;
  1. ADDCI(IBEFFDT) ; Add Charge Items (363.2) needs Charge Sets, pass in the effective date of the new charges
  1. N IBA,IBCNT,IBCNT1,IBI,IBLN,IBFN,IBCS,IBXRF,IBCI,IBRVCD,IBCHG,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y,IBX,IBZ,IBDFLTDT,IBDT S (IBCNT,IBCNT1)=0
  1. ;
  1. S IBDFLTDT=+$G(IBEFFDT) I 'IBDFLTDT D MSG("** Error: No Date, No Charges Added") G CIQ
  1. ;
  1. F IBI=1:1 S IBLN=$P($T(CIF+IBI),";;",2) Q:+IBLN!(IBLN="") I $E(IBLN)?1A D SETCI
  1. ;
  1. I +IBCNT1 D MSG(IBCNT1_" Duplicate Charge Items already exist, not re-added")
  1. ;
  1. CIQ D MSG(" >> "_IBCNT_" Tort/Interagency Charge Items added (363.2).")
  1. D MSG("")
  1. Q
  1. ;
  1. SETCI ; set Charge Item (duplicates based on item, CS, eff dt, rev cd)
  1. ;
  1. S IBCS=$P(IBLN,U,2),IBCS=+$O(^IBE(363.1,"B",IBCS,0)) I 'IBCS D MSG("** Error: CS "_$P(IBLN,U,2)_" undefined") Q
  1. S IBCI=+$$MCCRUTL($P(IBLN,U,1),5) I 'IBCI D MSG("** Error: BS "_$P(IBLN,U,1)_" undefined") Q
  1. S IBDT=IBDFLTDT I +$P(IBLN,U,3) S IBDT=+$P(IBLN,U,3)
  1. S IBRVCD=$$RVCD($P(IBLN,U,4))
  1. S IBCHG=+$P(IBLN,U,5)
  1. S IBXRF="AIVDTS"_IBCS
  1. ;
  1. 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
  1. . S IBCI=0,IBCNT1=IBCNT1+1 I +$P(IBZ,U,5)'=IBCHG D MSG("** Error: Item exists, wrong charge: "_IBLN)
  1. Q:'IBCI
  1. ;
  1. K DD,DO S DLAYGO=363.2,DIC="^IBA(363.2,",DIC(0)="L",X=IBCI_";DGCR(399.1," D FILE^DICN K DIC I Y<1 K X,Y Q
  1. S IBFN=+Y,IBCNT=IBCNT+1
  1. ;
  1. S DR=".02///"_IBCS_";.03///"_IBDT_";.05///"_IBCHG I +IBRVCD S DR=DR_";.06///"_IBRVCD
  1. S DIE="^IBA(363.2,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
  1. Q
  1. ;
  1. ADDRS ; add Rate Schedules (363)
  1. ; add new charge sets to the link if TL/IA-OPT VST exists
  1. N IBCSFN,IBI,IBJ,IBK,IBCNT,IBLN,IBOTH,IBTLIA,IBRSC,IBRSN,DLAYGO,DIC,DIE,DA,DR,X,Y
  1. S IBI="",IBCNT=0
  1. F S IBI=$O(^IBE(363,"B",IBI)) Q:IBI="" I IBI["OPT" D
  1. . ; the latest entry
  1. . S IBRSN=$O(^IBE(363,"B",IBI,99999),-1)
  1. . ; no CS added if inactive
  1. . I $P($G(^IBE(363,+IBRSN,0)),U,6)'="" Q
  1. . S IBTLIA=""
  1. . ;
  1. A . S IBRSC=0 F S IBRSC=$O(^IBE(363,IBRSN,11,IBRSC)) Q:'IBRSC!(IBTLIA'="") D
  1. .. S IBLN=+$G(^IBE(363,IBRSN,11,IBRSC,0))
  1. .. S IBOTH=$P(^IBE(363.1,IBLN,0),U)
  1. .. S:IBOTH="TL-OPT VST" IBTLIA="TL-OPT VST PM&RS;TL-OPT VST POLYTRAUMA"
  1. .. S:IBOTH="IA-OPT VST" IBTLIA="IA-OPT VST PM&RS;IA-OPT VST POLYTRAUMA"
  1. .. Q:IBTLIA=""
  1. .. ; charge sets (multiple)
  1. .. F IBJ=1:1 S IBK=$P(IBTLIA,";",IBJ) Q:IBK="" D
  1. ... S IBCSFN=$O(^IBE(363.1,"B",IBK,0)) Q:'IBCSFN
  1. ... I $O(^IBE(363,IBRSN,11,"B",IBCSFN,0)) Q
  1. ... K DD,DO S DLAYGO=363,DA(1)=IBRSN,DIC="^IBE(363,"_DA(1)_",11,",DIC(0)="L",X=IBCSFN D FILE^DICN K X,DD,DO,DLAYGO,DIC
  1. ... ; S DIC("DR")=".02///"_1 ;no auto added
  1. ... S:IBJ=1 IBCNT=IBCNT+1
  1. ;
  1. RSQ ;
  1. D MSG(" >> "_IBCNT_" Tort/Interagency Rate Schedules linked (#363) to Reasonable Charges updated.")
  1. D MSG("")
  1. Q
  1. ;
  1. MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
  1. N IBX,IBY S IBY=""
  1. I $G(X)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"B",X,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(P)) S IBY=IBX
  1. Q IBY
  1. ;
  1. RVCD(RVCD) ; returns IFN if revenue code is valid and active
  1. N IBX,IBY S IBY=""
  1. I +$G(RVCD) S IBX=$G(^DGCR(399.2,+RVCD,0)) I +$P(IBX,U,3) S IBY=+RVCD
  1. Q IBY
  1. ;
  1. MSG(X) ;
  1. D MES^XPDUTL(X)
  1. Q
  1. ;
  1. ;
  1. BSF ; Bedsections (399.1, .12): Name ^ Abbreviation
  1. ;;POLYTRAUMA INPATIENT^POYLTRAUMA INPT
  1. ;;PM&RS OUTPATIENT VISIT^PM&RS OPT VISIT
  1. ;;POLYTRAUMA OUTPATIENT VISIT^OPT POLYTRI/TBI
  1. ;
  1. ;
  1. CSF ; Charge Sets (363.1): Name ^ Billing Rate ^ Billable Event ^^ Default Revenue Code
  1. ;;TL-OPT VST PM&RS^TORTIOUSLY LIABLE^OUTPATIENT VISIT DATE^^500
  1. ;;TL-OPT VST POLYTRAUMA^TORTIOUSLY LIABLE^OUTPATIENT VISIT DATE^^500
  1. ;;IA-OPT VST PM&RS^INTERAGENCY^OUTPATIENT VISIT DATE^^500
  1. ;;IA-OPT VST POLYTRAUMA^INTERAGENCY^OUTPATIENT VISIT DATE^^500
  1. ;
  1. ;
  1. CIF ; Charge Items (363.2): Bedsection ^ Charge Set ^Effective Date ^ Revenue Code ^ Charge
  1. ;;
  1. TORT ;; 2011 Tortiously Liable All Inclusive
  1. ;;
  1. ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (INCLUSIVE)^^^1154
  1. ;;BLIND REHABILITATION^TL-INPT (INCLUSIVE)^^^1240
  1. ;;GENERAL MEDICAL CARE^TL-INPT (INCLUSIVE)^^^2384
  1. ;;INTERMEDIATE CARE^TL-INPT (INCLUSIVE)^^^1920
  1. ;;NEUROLOGY^TL-INPT (INCLUSIVE)^^^3899
  1. ;;NURSING HOME CARE^TL-INPT (INCLUSIVE)^^^993
  1. ;;POLYTRAUMA INPATIENT^TL-INPT (INCLUSIVE)^^^3391
  1. ;;PRRTP^TL-INPT (INCLUSIVE)^^^577
  1. ;;PSYCHIATRIC CARE^TL-INPT (INCLUSIVE)^^^801
  1. ;;REHABILITATION MEDICINE^TL-INPT (INCLUSIVE)^^^2122
  1. ;;SPINAL CORD INJURY CARE^TL-INPT (INCLUSIVE)^^^1756
  1. ;;SURGICAL CARE^TL-INPT (INCLUSIVE)^^^4533
  1. ;;
  1. ;; Tortiously Liable Non-Professional
  1. ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^101^777
  1. ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^240^267
  1. ;;BLIND REHABILITATION^TL-INPT (NPF)^^101^524
  1. ;;BLIND REHABILITATION^TL-INPT (NPF)^^240^616
  1. ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^101^1478
  1. ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^240^621
  1. ;;INTERMEDIATE CARE^TL-INPT (NPF)^^101^1544
  1. ;;INTERMEDIATE CARE^TL-INPT (NPF)^^240^282
  1. ;;NEUROLOGY^TL-INPT (NPF)^^101^2299
  1. ;;NEUROLOGY^TL-INPT (NPF)^^240^1029
  1. ;;NURSING HOME CARE^TL-INPT (NPF)^^101^828
  1. ;;NURSING HOME CARE^TL-INPT (NPF)^^240^134
  1. ;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^101^1970
  1. ;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^240^1036
  1. ;;PRRTP^TL-INPT (NPF)^^101^480
  1. ;;PRRTP^TL-INPT (NPF)^^240^61
  1. ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^101^599
  1. ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^240^126
  1. ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^101^1233
  1. ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^240^648
  1. ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^101^1096
  1. ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^240^442
  1. ;;SURGICAL CARE^TL-INPT (NPF)^^101^2658
  1. ;;SURGICAL CARE^TL-INPT (NPF)^^240^1375
  1. ;;
  1. ;; Tortiously Liable Professional
  1. ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (PF)^^^110
  1. ;;BLIND REHABILITATION^TL-INPT (PF)^^^100
  1. ;;GENERAL MEDICAL CARE^TL-INPT (PF)^^^285
  1. ;;INTERMEDIATE CARE^TL-INPT (PF)^^^94
  1. ;;NEUROLOGY^TL-INPT (PF)^^^571
  1. ;;NURSING HOME CARE^TL-INPT (PF)^^^31
  1. ;;POLYTRAUMA INPATIENT^TL-INPT (PF)^^^385
  1. ;;PRRTP^TL-INPT (PF)^^^36
  1. ;;PSYCHIATRIC CARE^TL-INPT (PF)^^^76
  1. ;;REHABILITATION MEDICINE^TL-INPT (PF)^^^241
  1. ;;SPINAL CORD INJURY CARE^TL-INPT (PF)^^^218
  1. ;;SURGICAL CARE^TL-INPT (PF)^^^500
  1. ;;
  1. ;; Tortiously Liable Other
  1. ;;OUTPATIENT VISIT^TL-OPT VST^^^231
  1. ;;OUTPATIENT DENTAL^TL-OPT DENTAL^^^487
  1. ;;PM&RS OUTPATIENT VISIT^TL-OPT VST PM&RS^^^430
  1. ;;POLYTRAUMA OUTPATIENT VISIT^TL-OPT VST POLYTRAUMA^^^573
  1. ;;
  1. ;;
  1. IA ;; 2011 Interagency
  1. ;;
  1. ;;ALCOHOL AND DRUG TREATMENT^IA-INPT^^^1081
  1. ;;BLIND REHABILITATION^IA-INPT^^^1161
  1. ;;GENERAL MEDICAL CARE^IA-INPT^^^2232
  1. ;;INTERMEDIATE CARE^IA-INPT^^^1796
  1. ;;NEUROLOGY^IA-INPT^^^3648
  1. ;;NURSING HOME CARE^IA-INPT^^^929
  1. ;;POLYTRAUMA INPATIENT^IA-INPT^^^3197
  1. ;;PRRTP^IA-INPT^^^540
  1. ;;PSYCHIATRIC CARE^IA-INPT^^^749
  1. ;;REHABILITATION MEDICINE^IA-INPT^^^1992
  1. ;;SPINAL CORD INJURY CARE^IA-INPT^^^1644
  1. ;;SURGICAL CARE^IA-INPT^^^4248
  1. ;;
  1. ;;OUTPATIENT VISIT^IA-OPT VST^^^214
  1. ;;OUTPATIENT DENTAL^IA-OPT DENTAL^^^416
  1. ;;PM&RS OUTPATIENT VISIT^IA-OPT VST PM&RS^^^401
  1. ;;POLYTRAUMA OUTPATIENT VISIT^IA-OPT VST POLYTRAUMA^^^535
  1. ;;
  1. Q