| [613] | 1 | IBCRHU2 ;ALB/ARH - RATES: UPLOAD UTILITIES (ADD CM ELEMENTS) ; 10-OCT-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**106,138,245,175,307**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | RG(NAME,DIV,ID,TY) ; add a new Billing Region for Reasonable Charges (363.31), input region name, MC division site #
|
|---|
| 6 | ; returns IFN of billing region (new or existing) ^ region name, null otherwise
|
|---|
| 7 | ; the part of the name before a dash is used to attempt a match with existing regions
|
|---|
| 8 | N IBA,IBDV,IBFN,IBNEW,IBX,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y S DIV=$G(DIV),IBDV="",(IBFN,IBNEW)=0
|
|---|
| 9 | I $G(NAME)="" G RGQ
|
|---|
| 10 | I NAME[" (DIV)" S NAME=$P(NAME," (DIV)",1)_$P(NAME," (DIV)",2)
|
|---|
| 11 | I NAME[" (2)" S NAME=$P(NAME," (2)",1)_$P(NAME," (2)",2)
|
|---|
| 12 | I NAME[" (3)" S NAME=$P(NAME," (2)",1)_$P(NAME," (3)",2)
|
|---|
| 13 | ;
|
|---|
| 14 | S IBX="" F S IBX=$O(^IBE(363.31,"B",IBX)) Q:IBX="" I $P(IBX,"-",1)=$P(NAME,"-",1) S IBFN=$O(^IBE(363.31,"B",IBX,0)) Q
|
|---|
| 15 | I +IBFN S IBFN=IBFN_U_$E(IBX,1,30),IBNEW=0 G RGQ
|
|---|
| 16 | ;
|
|---|
| 17 | S IBDV=$$DIV(DIV) I 'IBDV D MSG(" *** Warning: No MC division "_DIV_" defined, no division added to Region")
|
|---|
| 18 | ;
|
|---|
| 19 | I $G(ID)'="" S DIC("DR")=".02////"_$E(ID,1,10)_";"
|
|---|
| 20 | I $G(TY)'="" S DIC("DR")=$G(DIC("DR"))_".03////"_$E(TY,1,10)
|
|---|
| 21 | K DD,DO S DLAYGO=363.31,DIC="^IBE(363.31,",DIC(0)="L",X=$E(NAME,1,30) D FILE^DICN K DIC,DD,DO I Y<1 K X,Y Q
|
|---|
| 22 | S IBFN=Y,IBNEW=1
|
|---|
| 23 | ;
|
|---|
| 24 | I +IBDV S DLAYGO=363.31,DA(1)=+IBFN,DIC="^IBE(363.31,"_DA(1)_",11,",DIC(0)="L",X=+IBDV,DIC("P")="363.3111P" D ^DIC K DIC,DIE,DLAYGO
|
|---|
| 25 | ;
|
|---|
| 26 | RGQ I +IBNEW!($D(IBA)) S IBA(1)=" >> "_$E(NAME,1,30)_" Billing Region "_$S('$G(IBFN):"NOT ",1:"")_"added "_$S(+IBDV:"for MCD "_$P(IBDV,U,3)_" "_$P(IBDV,U,2),1:"") D MSGP
|
|---|
| 27 | Q $G(IBFN)
|
|---|
| 28 | ;
|
|---|
| 29 | CS(NAME,RATE,EVENT,RG,CT,RV,BS) ; add Charge Set for Reasonable Charges (363.1), all input in external form
|
|---|
| 30 | ; returns IFN of new charge set, 0 otherwise
|
|---|
| 31 | N IBA,IBBR,IBBE,IBRG,IBRV,IBBS,IBCT,IBOK,IBFN,IBCSN,IBJ,DD,DO,DLAYGO,DINUM,DIC,DIE,DA,DR,X,Y,IBFND S IBOK=1
|
|---|
| 32 | S NAME=$G(NAME),RATE=$G(RATE),EVENT=$G(EVENT),RG=$G(RG),CT=$G(CT),RV=$G(RV),BS=$G(BS) I NAME=""!(RATE="") G CSQ
|
|---|
| 33 | ;
|
|---|
| 34 | S IBFND=+$O(^IBE(363.1,"B",$E(NAME,1,30),0)) I +IBFND S IBFN=IBFND,IBCSN=NAME G CSQ
|
|---|
| 35 | ;
|
|---|
| 36 | S IBBR=$O(^IBE(363.3,"B",RATE,0)) I 'IBBR S IBOK=0 D MSG(" *** Error: "_RATE_" Billing Rate does not exist")
|
|---|
| 37 | S IBBE=$$MCCRUTL(EVENT,14) I 'IBBE S IBOK=0 D MSG(" *** Error: "_EVENT_" Billable Event undefined")
|
|---|
| 38 | S IBRG="" I RG'="" S IBRG=$O(^IBE(363.31,"B",$E(RG,1,30),0))
|
|---|
| 39 | I 'IBRG,RG'="" S IBOK=0 D MSG(" *** Error: "_$E(RG,1,30)_" Billing Region does not exist")
|
|---|
| 40 | I '$G(IBOK) G CSQ
|
|---|
| 41 | S IBRV=$$RVCD(RV) I 'IBRV D MSG(" *** Warning: No default revenue code added for Charge Set")
|
|---|
| 42 | S IBBS=$$MCCRUTL(BS,5) I 'IBBS D MSG(" *** Warning: No default bedsection added for Charge Set")
|
|---|
| 43 | S IBCT=$S($E(CT)="I":1,$E(CT)="P":2,1:"")
|
|---|
| 44 | ;
|
|---|
| 45 | F IBJ=1:1 S IBFN=$G(^IBE(363.1,IBJ,0)) I IBFN="" S DINUM=IBJ Q
|
|---|
| 46 | ;
|
|---|
| 47 | K DD,DO S DLAYGO=363.1,DIC="^IBE(363.1,",DIC(0)="L",X=$E(NAME,1,30) D FILE^DICN K DIC K DIC,DINUM,DLAYGO,DD,DO I Y<1 K X,Y Q
|
|---|
| 48 | S IBFN=+Y,IBCSN=$P(Y,U,2)
|
|---|
| 49 | ;
|
|---|
| 50 | S DR=".02////"_IBBR_";.03////"_IBBE_";.04////"_IBCT_";.07////"_IBRG
|
|---|
| 51 | I +IBRV S DR=DR_";.05////"_IBRV
|
|---|
| 52 | I +IBBS S DR=DR_";.06////"_IBBS
|
|---|
| 53 | S DIE="^IBE(363.1,",DA=+IBFN D ^DIE K DIE,DA,DR,X,Y
|
|---|
| 54 | ;
|
|---|
| 55 | ;
|
|---|
| 56 | CSQ I +$G(IBFN),$G(IBCSN)'="" D RS(IBCSN)
|
|---|
| 57 | ;
|
|---|
| 58 | S IBA(1)=" >> "_$E(NAME,1,30)_" Charge Set "_$S('$G(IBFN):"NOT ",1:"")_$S(+$G(IBFND):"used",1:"added") D MSGP
|
|---|
| 59 | Q +$G(IBFN)
|
|---|
| 60 | ;
|
|---|
| 61 | USECS(CSN) ; return an existing CS for a set of RC charges, given the name to look for, or write an error message
|
|---|
| 62 | N IBCS S IBCS=0
|
|---|
| 63 | I $G(CSN)'="" S IBCS=$O(^IBE(363.1,"B",$E(CSN,1,30),0))
|
|---|
| 64 | I 'IBCS W !," *** Warning: No Charge Set found for these charges"
|
|---|
| 65 | I +IBCS W !," >> "_$E(CSN,1,30)_" Charge Set used"
|
|---|
| 66 | Q IBCS
|
|---|
| 67 | ;
|
|---|
| 68 | MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
|
|---|
| 69 | N IBX,IBY S IBY=""
|
|---|
| 70 | 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
|
|---|
| 71 | Q IBY
|
|---|
| 72 | ;
|
|---|
| 73 | RVCD(RVCD) ; check for valid revenue code (#399.2), input either revenue code or revenue code IFN
|
|---|
| 74 | ; returns IFN if revenue code is valid and active, null otherwise
|
|---|
| 75 | N IBX,IBY S IBY=""
|
|---|
| 76 | I +$G(RVCD) S IBX=$G(^DGCR(399.2,+RVCD,0)) I +$P(IBX,U,3) S IBY=+RVCD
|
|---|
| 77 | Q IBY
|
|---|
| 78 | ;
|
|---|
| 79 | DIV(DIV) ; check for valid medical center division (#40.8), input facility/site number
|
|---|
| 80 | ; returns 'IFN ^ name ^ #' of division if it exists in Medical Center Division file (40.8), 0 otherwise
|
|---|
| 81 | N IBX,IBY S IBX=0
|
|---|
| 82 | I $G(DIV)'="" S DIV=+$O(^DG(40.8,"C",DIV,0))
|
|---|
| 83 | I +$G(DIV) S IBY=$G(^DG(40.8,+DIV,0)) I IBY'="" S IBX=DIV_U_$P(IBY,U,1,2)
|
|---|
| 84 | Q IBX
|
|---|
| 85 | ;
|
|---|
| 86 | MSG(X) ; add message to end of message list, reserves IBA(1) for primary message
|
|---|
| 87 | N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
|
|---|
| 88 | S IBA(IBX)=$G(X)
|
|---|
| 89 | Q
|
|---|
| 90 | MSGP ; print error messages in IBA
|
|---|
| 91 | N IBX S IBX="" F S IBX=$O(IBA(IBX)) Q:'IBX W !,IBA(IBX)
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | ;
|
|---|
| 95 | RS(CSN) ; add new Reasonable Charges Charge Sets to Rate Schedules, input Charge Set Name
|
|---|
| 96 | ; finds the RS to add the CS to based on the effective/inactive dates of the RS and version being loaded
|
|---|
| 97 | ; for RC 1.x only adds physician to inpt if there was also inpatient facility charges
|
|---|
| 98 | ; Tort Feasor began using Reasonable Charges on 01/07/04
|
|---|
| 99 | N IBCSFN,IBRSN,IBRS,IBRS0,IBRSLST,IBVBEG,IBVEND,IBVERS,IBAUTO,IBFND,IBSITE,IBI,DINUM,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y
|
|---|
| 100 | ;
|
|---|
| 101 | I $G(CSN)="" Q
|
|---|
| 102 | I $E(CSN,1,2)'="RC" Q
|
|---|
| 103 | S IBCSFN=$O(^IBE(363.1,"B",$E(CSN,1,30),0)) I 'IBCSFN Q
|
|---|
| 104 | S IBAUTO=1 I $P($G(^IBE(363.3,+$P($G(^IBE(363.1,+IBCSFN,0)),U,2),0)),U,4)=9 S IBAUTO=""
|
|---|
| 105 | S IBVERS=$$VERSION^IBCRHBRV,IBVBEG=$$VERSDT^IBCRHBRV,IBVEND=$$VERSEDT^IBCRHBRV,IBFND=1
|
|---|
| 106 | S IBI=$L(CSN," "),IBSITE=$P(CSN," ",IBI)
|
|---|
| 107 | ;
|
|---|
| 108 | I IBVERS<2 D
|
|---|
| 109 | . I CSN["INPT " S IBRSLST="RI-INPT,NF-INPT,WC-INPT"
|
|---|
| 110 | . I CSN["SNF " S IBRSLST="RI-INPT,NF-INPT,WC-INPT"
|
|---|
| 111 | . I CSN["OPT " S IBRSLST="RI-OPT,NF-OPT,WC-OPT"
|
|---|
| 112 | . I CSN["PHYS" S IBRSLST="RI-OPT,NF-OPT,WC-OPT"
|
|---|
| 113 | . I CSN["PHYS",$O(^IBE(363.1,"B","RC-INPT ANC "_IBSITE,0)) S IBRSLST=IBRSLST_",RI-INPT,NF-INPT,WC-INPT"
|
|---|
| 114 | ;
|
|---|
| 115 | I IBVERS'<2 D
|
|---|
| 116 | . I CSN["INPT " S IBRSLST="RI-INPT,NF-INPT,WC-INPT,TF-INPT"
|
|---|
| 117 | . I CSN["SNF " S IBRSLST="RI-SNF,NF-SNF,WC-SNF,TF-SNF"
|
|---|
| 118 | . I CSN["OPT " S IBRSLST="RI-OPT,NF-OPT,WC-OPT,TF-OPT"
|
|---|
| 119 | . I CSN[" FS " S IBRSLST="RI-OPT,NF-OPT,WC-OPT,TF-OPT"
|
|---|
| 120 | I $G(IBRSLST)="" Q
|
|---|
| 121 | ;
|
|---|
| 122 | F IBI=1:1 S IBRSN=$P(IBRSLST,",",IBI) Q:IBRSN="" D
|
|---|
| 123 | . S IBRS=0 F S IBRS=$O(^IBE(363,"B",IBRSN,IBRS)) Q:'IBRS D Q:+IBFND
|
|---|
| 124 | .. S IBRS0=$G(^IBE(363,IBRS,0))
|
|---|
| 125 | .. I $E(IBRSN,1,3)="TF-",+$P(IBRS0,U,6),$P(IBRS0,U,6)<3040107 S IBFND=0 Q
|
|---|
| 126 | .. I +$P(IBRS0,U,6),$P(IBRS0,U,6)<IBVBEG S IBFND=0 Q
|
|---|
| 127 | .. I +IBVEND,+$P(IBRS0,U,5),$P(IBRS0,U,5)>IBVEND S IBFND=0 Q
|
|---|
| 128 | .. S IBFND=1 I $O(^IBE(363,+IBRS,11,"B",+IBCSFN,0)) Q
|
|---|
| 129 | .. I +IBAUTO S DIC("DR")=".02////"_1
|
|---|
| 130 | .. S DLAYGO=363,DA(1)=+IBRS,DIC="^IBE(363,"_DA(1)_",11,",DIC(0)="LX",X=CSN,DIC("P")="363.0011P" D ^DIC K DIC,DIE
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | ;
|
|---|
| 134 | ;
|
|---|
| 135 | GETDIV(RGFN) ; ask the user for the divisions for a Billing Region
|
|---|
| 136 | N IBX,DIC,DIE,DA,DR,X,Y,DIDEL,DLAYGO Q:'$G(RGFN) S IBX=$G(^IBE(363.31,+RGFN,0)) Q:IBX=""
|
|---|
| 137 | W !!,"Enter the Divisions associated with these charges: ",$P(IBX,U,1)
|
|---|
| 138 | S (DLAYGO,DIDEL)=363.31,DIE="^IBE(363.31,",DA=+RGFN,DR=11 D ^DIE K DIE,DR,X,Y,DIDEL,DLAYGO
|
|---|
| 139 | Q
|
|---|
| 140 | ;
|
|---|
| 141 | RSBR(CSFN,AUTO,EFFDT) ; add the charge set to any Rate Schedule that already has charge sets of this Billing Rate assigned
|
|---|
| 142 | ; CSFN - IFN of Charge Set to add, AUTO - 1 if charges should be auto added, EFFDT - effective date of charges
|
|---|
| 143 | ; will add the Charge Set to any Rate Schedule that already has a Set of same Billing Rate and is not inactive
|
|---|
| 144 | N IBCS0,IBCSN,IBBRFN,IBRS,IBRSIA,IBCSE,IBNEW,IBFND,DINUM,DD,DO,DLAYGO,DIC,DIE,DA,DR,X,Y S DLAYGO=363,IBNEW=0
|
|---|
| 145 | ;
|
|---|
| 146 | S CSFN=+$G(CSFN) I 'CSFN Q
|
|---|
| 147 | I $G(^IBE(363.1,CSFN,0))="" Q
|
|---|
| 148 | I +$O(^IBE(363,"C",CSFN,0)) Q ; charge set already assigned to rate schedules
|
|---|
| 149 | ;
|
|---|
| 150 | S IBCS0=$G(^IBE(363.1,CSFN,0)),IBCSN=$P(IBCS0,U,1),IBBRFN=$P(IBCS0,U,2) Q:'IBBRFN
|
|---|
| 151 | ;
|
|---|
| 152 | S IBRS=0 F S IBRS=$O(^IBE(363,IBRS)) Q:'IBRS S IBFND=0 D
|
|---|
| 153 | . I $O(^IBE(363,IBRS,11,"B",CSFN,0)) Q ; charge set already assigned to RS
|
|---|
| 154 | . I +$G(EFFDT) S IBRSIA=$P($G(^IBE(363,IBRS,0)),U,6) I +IBRSIA,EFFDT>IBRSIA Q ; RS inactive before CS active
|
|---|
| 155 | . ;
|
|---|
| 156 | . S IBCSE=0 F S IBCSE=$O(^IBE(363,IBRS,11,"B",IBCSE)) Q:'IBCSE D Q:IBFND
|
|---|
| 157 | .. I $D(^IBE(363.1,"C",IBBRFN,IBCSE)) D S IBFND=1,IBNEW=1 ; schedule has charge sets of same billing rate
|
|---|
| 158 | ... ;
|
|---|
| 159 | ... I +$G(AUTO) S DIC("DR")=".02////"_1
|
|---|
| 160 | ... S DA(1)=+IBRS,DIC="^IBE(363,"_DA(1)_",11,",DIC(0)="LX",X=IBCSN,DIC("P")="363.0011P" D ^DIC K DIC,DIE
|
|---|
| 161 | ... W !," Charge Set added to Rate Schedule ",$P($G(^IBE(363,+IBRS,0)),U,1)
|
|---|
| 162 | ;
|
|---|
| 163 | I 'IBNEW W !," *** Warning: ",IBCSN," not added to any Rate Schedule,",!," set manually using Enter/Edit Charge Master option."
|
|---|
| 164 | Q
|
|---|
