| 1 | IBCREQ ;ALB/ARH-RATES: CM FAST ENTER/EDIT OPTION ;22-MAY-1996
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,153,167,187**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ENTER ; OPTION: fast enter Tort or Interagency rates - this option requires charge sets defined as released,
|
|---|
| 6 | ; name not changed and a standard set of charges
|
|---|
| 7 | N DIR,DIRUT,DTOUT,DUOUT,X,Y,IBARR,IBRATE,IBEFDT,IBRVCD
|
|---|
| 8 | W @IOF W !!,?10,"Fast Enter of Tortiously Liable and Interagency Rates",!!
|
|---|
| 9 | ;
|
|---|
| 10 | S DIR(0)="SO^T:Tortiously Liable;I:Interagency",DIR("A")="Enter which rates" D ^DIR K DIR
|
|---|
| 11 | S IBRATE=$S(Y="T":"1^TORTIOUSLY LIABLE",Y="I":"2^INTERAGENCY",1:"") Q:'IBRATE
|
|---|
| 12 | ;
|
|---|
| 13 | S IBEFDT=$$GETDT^IBCRU1() I IBEFDT'?7N Q
|
|---|
| 14 | I +IBRATE=1 S IBRVCD=$$NPFRC Q:'IBRVCD I '$$TORT(IBRATE,IBEFDT,.IBARR,IBRVCD) Q
|
|---|
| 15 | I +IBRATE=2 I '$$IA(IBRATE,IBEFDT,.IBARR) Q
|
|---|
| 16 | ;
|
|---|
| 17 | D DISP(IBRATE,.IBARR) Q:$D(DIRUT)
|
|---|
| 18 | I +IBRATE=2 D SET(IBRATE,.IBARR)
|
|---|
| 19 | E D SET(IBRATE,.IBARR):'$$MT
|
|---|
| 20 | ;
|
|---|
| 21 | I IBRATE=1 D ENR^IBEMTO K IBRUN ; bill MT OPT charges awaiting the new copay rate
|
|---|
| 22 | ;
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | TORT(IBRATE,EFDT,ARR,IBRVCD) ; find the standard charge sets for Tort rates
|
|---|
| 26 | N IBCSN,IBX K ARR S ARR=$G(EFDT),IBRVCD=$G(IBRVCD),IBX=0
|
|---|
| 27 | S ARR(1)="INPATIENT^INPT",ARR(2)="OUTPATIENT VISIT^OPT VISIT",ARR(3)="PRESCRIPTION REFILL^RX REFILL"
|
|---|
| 28 | S ARR(4)="OUTPATIENT DENTAL^OPT DENTAL" ;ARR(5)="MT OUTPATIENT COPAYMENT^MT OPT COPAY"
|
|---|
| 29 | S IBCSN="TL-INPT (INCLUSIVE)" I '$$CS(IBRATE,IBCSN,1,1,"","(All Inclusive)",.ARR) G TORTQ
|
|---|
| 30 | S IBCSN="TL-INPT (NPF)" I '$$CS(IBRATE,IBCSN,1,2,$P(IBRVCD,U,1),"(Room,board)",.ARR) G TORTQ
|
|---|
| 31 | S IBCSN="TL-INPT (NPF)" I '$$CS(IBRATE,IBCSN,1,3,$P(IBRVCD,U,2),"(Ancillary)",.ARR) G TORTQ
|
|---|
| 32 | S IBCSN="TL-INPT (PF)" I '$$CS(IBRATE,IBCSN,1,4,"","(Physician)",.ARR) G TORTQ
|
|---|
| 33 | S IBCSN="TL-OPT VST" I '$$CS(IBRATE,IBCSN,2,1,"","",.ARR) G TORTQ
|
|---|
| 34 | S IBCSN="TL-RX FILL" I '$$CS(IBRATE,IBCSN,3,1,"","",.ARR) G TORTQ
|
|---|
| 35 | S IBCSN="TL-OPT DENTAL" I '$$CS(IBRATE,IBCSN,4,1,"","",.ARR) G TORTQ
|
|---|
| 36 | ;S IBCSN="TL-MT OPT COPAY" I '$$CS(IBRATE,IBCSN,5,1,"","",.ARR) G TORTQ
|
|---|
| 37 | S IBX=1
|
|---|
| 38 | TORTQ I 'IBX W !!,"The Fast Enter of rates expects to find the standard rates and sets released",!,"nationally, if these are not found this option can not be used."
|
|---|
| 39 | Q IBX
|
|---|
| 40 | ;
|
|---|
| 41 | IA(IBRATE,EFDT,ARR) ; find the standard charge sets for Interagency rates
|
|---|
| 42 | N IBCSN,IBX K ARR S ARR=$G(EFDT),IBX=0
|
|---|
| 43 | S ARR(1)="INPATIENT",ARR(2)="OUTPATIENT VISIT",ARR(3)="PRESCRIPTION REFILL",ARR(4)="OUTPATIENT DENTAL"
|
|---|
| 44 | S ARR(1)="INPATIENT^INPT",ARR(2)="OUTPATIENT VISIT^OPT VISIT",ARR(3)="PRESCRIPTION REFILL^RX REFILL",ARR(4)="OUTPATIENT DENTAL^OPT DENTAL"
|
|---|
| 45 | S IBCSN="IA-INPT" I '$$CS(IBRATE,IBCSN,1,1,"","(All Inclusive)",.ARR) G IAQ
|
|---|
| 46 | S IBCSN="IA-OPT VST" I '$$CS(IBRATE,IBCSN,2,1,"","",.ARR) G IAQ
|
|---|
| 47 | S IBCSN="IA-RX FILL" I '$$CS(IBRATE,IBCSN,3,1,"","",.ARR) G IAQ
|
|---|
| 48 | S IBCSN="IA-OPT DENTAL" I '$$CS(IBRATE,IBCSN,4,1,"","",.ARR) G IAQ
|
|---|
| 49 | S IBX=1
|
|---|
| 50 | IAQ I 'IBX W !!,"The Fast Enter of rates expects to find the standard rates and sets released",!,"nationally, if these are not found this option can not be used."
|
|---|
| 51 | Q IBX
|
|---|
| 52 | ;
|
|---|
| 53 | CS(IBRATE,IBCSN,TYPE,ITEM,RVCD,DESC,ARR) ; accumulate standard charge sets for a rate
|
|---|
| 54 | ; check the billing rate is correct and return all relevant info
|
|---|
| 55 | ; Output: ARR(event type) = event type name
|
|---|
| 56 | ; ARR(event type, X) = CS name ^ CS IFN ^ default rev code ^ rev code to store ^ description of charge
|
|---|
| 57 | N IBX,IBCS,IBLN,IBERROR S (IBERROR,IBX)=""
|
|---|
| 58 | S IBCS=$O(^IBE(363.1,"B",IBCSN,0)) I +IBCS D
|
|---|
| 59 | . S IBLN=$G(^IBE(363.1,IBCS,0)) Q:IBLN=""
|
|---|
| 60 | . I $P(IBLN,U,2)'=+IBRATE S IBERROR="*** Error: Charge Set "_IBCSN_" is not a "_$P(IBRATE,U,2)_" rate." Q
|
|---|
| 61 | . S IBX=IBCS,ARR(TYPE,ITEM)=IBCSN_U_IBCS_U_$S($G(RVCD):RVCD,1:$P(IBLN,U,5))_U_$G(RVCD)_U_$G(DESC)
|
|---|
| 62 | I 'IBX,IBERROR="" S IBERROR="*** Error: The Charge Set "_IBCSN_" was not found."
|
|---|
| 63 | I IBERROR'="" W !!!,IBERROR,!," Can not continue!"
|
|---|
| 64 | Q IBX
|
|---|
| 65 | ;
|
|---|
| 66 | SET(IBRATE,ARR) ; add/edit charges: for each type of charge and each item, displays rev code and description
|
|---|
| 67 | ; then askes the user for bedsection and charge
|
|---|
| 68 | ;
|
|---|
| 69 | N IBEFDT,IBTYP,IBBS,IBJ,IBIT,IBLN,IBCS,IBRVCD,IBCHG,IBOCHG,IBCI,IBX,IBDFTY,DIR,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 70 | S IBEFDT=+ARR
|
|---|
| 71 | S IBTYP=0 F S IBTYP=$O(ARR(IBTYP)) Q:'IBTYP D Q:IBBS<0
|
|---|
| 72 | . W !!,"--------------------------------------------------------------------------------"
|
|---|
| 73 | . W !,"Enter ",$P(ARR(IBTYP),U,1)," ",$P(IBRATE,U,2)," charges effective ",$$FMTE^XLFDT(IBEFDT),":"
|
|---|
| 74 | . W !,"--------------------------------------------------------------------------------"
|
|---|
| 75 | . S IBDFTY=IBTYP
|
|---|
| 76 | . F IBJ=1:1 W ! S IBBS=$$GETBS(10,$P(ARR(IBTYP),U,2),IBDFTY) Q:IBBS<1 D I IBTYP>1 S IBDFTY=""
|
|---|
| 77 | .. S IBIT=0 F S IBIT=$O(ARR(IBTYP,IBIT)) Q:'IBIT D I $D(DUOUT) Q
|
|---|
| 78 | ... S IBLN=ARR(IBTYP,IBIT),IBCS=$P(IBLN,U,2),IBRVCD=$P(IBLN,U,4),IBOCHG=""
|
|---|
| 79 | ... S IBX=$E($P(IBBS,U,2),1,28)
|
|---|
| 80 | ... S IBX=IBX_$J("",(30-$L(IBX)))_$P(IBLN,U,5)
|
|---|
| 81 | ... S IBX=IBX_$J("",(50-$L(IBX)))_$P($G(^DGCR(399.2,+$P(IBLN,U,3),0)),U,1)_" $ = "
|
|---|
| 82 | ... S IBCI=$$FINDCI^IBCRU4(IBCS,+IBBS,IBEFDT,"",IBRVCD)
|
|---|
| 83 | ... I +IBCI S IBOCHG=$P($G(^IBA(363.2,+IBCI,0)),U,5),DIR("B")=$FN(IBOCHG,"",2)
|
|---|
| 84 | ... S DIR("A")=IBX,DIR(0)="NAO^0:999999:2" D ^DIR K DIR S IBCHG=+Y I IBCHG<1!(IBCHG=IBOCHG) Q
|
|---|
| 85 | ... I 'IBCI S IBCI=$$ADDCI^IBCREF(IBCS,+IBBS,IBEFDT,IBCHG,IBRVCD) I +IBCI W ?74,"added" Q
|
|---|
| 86 | ... I +IBCI D EDITCI^IBCREF(+IBCI,+IBCHG) W ?74,"edited"
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | NPFRC() ; get the default revenue codes for non-professional inpatient services
|
|---|
| 90 | ;
|
|---|
| 91 | N IBX,DIC,X,Y,DTOUT,DUOUT,IBY S IBX=0
|
|---|
| 92 | W !!,"Enter the Revenue Code to use for all non-professional inpatient services:",!
|
|---|
| 93 | S DIC("A")="Room, Board, Nursing Services: ",DIC("B")=101,DIC("S")="I +$P(^(0),U,3)"
|
|---|
| 94 | S DIC="^DGCR(399.2,",DIC(0)="AEQ" D ^DIC I Y<1 G NPFRCQ
|
|---|
| 95 | S IBY=+Y
|
|---|
| 96 | ;
|
|---|
| 97 | S DIC("A")="Ancillary Services: ",DIC("B")=240,DIC("S")="I +$P(^(0),U,3)"
|
|---|
| 98 | S DIC="^DGCR(399.2,",DIC(0)="AEQ" D ^DIC I Y<1 G NPFRCQ
|
|---|
| 99 | S IBX=IBY_U_+Y
|
|---|
| 100 | ;
|
|---|
| 101 | NPFRCQ I 'IBX W !!,"Both of these revenue codes are required for the Inpatient Non-Professional",!,"charges to be added to bills. Can Not Continue!",!
|
|---|
| 102 | Q IBX
|
|---|
| 103 | ;
|
|---|
| 104 | DISP(IBRATE,ARR) ;
|
|---|
| 105 | N IBTYP,IBI,IBLN
|
|---|
| 106 | W @IOF,!,$P(IBRATE,U,2)," charges effective ",$$FMTE^XLFDT(ARR)," will be added as follows:"
|
|---|
| 107 | W !,"Charge Type",?30,"Charge Set",?55,"Rev Code",!,"--------------------------------------------------------------------------------",!
|
|---|
| 108 | S IBTYP=0 F S IBTYP=$O(ARR(IBTYP)) Q:'IBTYP D
|
|---|
| 109 | . W $P(ARR(IBTYP),U,1)
|
|---|
| 110 | . S IBI=0 F S IBI=$O(ARR(IBTYP,IBI)) Q:'IBI D
|
|---|
| 111 | .. S IBLN=ARR(IBTYP,IBI)
|
|---|
| 112 | .. W ?30,$P(IBLN,U,1),?55,$P($G(^DGCR(399.2,+$P(IBLN,U,3),0)),U,1),?65,$P(IBLN,U,5),!
|
|---|
| 113 | W !,"If any of the revenue codes are incorrect then change the Default Revenue for",!,"the Charge set." W:+IBRATE=1 " (except the non-prof inpt rev codes entered above)"
|
|---|
| 114 | W !!,"If any of the Charge Sets are incorrect DO NOT USE this option."
|
|---|
| 115 | W !,"This option may NOT be used to delete rates or add zero charges."
|
|---|
| 116 | W !!,"The charges will be asked in sections based on the Charge Types listed above."
|
|---|
| 117 | W !,"The first section is INPATIENT, enter all Inpatient Bedsections and their"
|
|---|
| 118 | W !,"charges, then press return at the Select Bedsection prompt to move to the"
|
|---|
| 119 | W !,"OUTPATIENT VISIT section and enter the Outpatient Visit Bedsection and charge..."
|
|---|
| 120 | W ! S DIR(0)="E" D ^DIR K DIR
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | GETBS(COL,PROMPT,TYPE) ; ask and return billable bedsection (399.1): (-1 if ^, 0 if none) IFN^.01
|
|---|
| 124 | ; if type is inpatient then not PRESCRIPTION or OUTPATIENT bedsections can be selected
|
|---|
| 125 | ; if type is not inpatient then default bedsections are provided
|
|---|
| 126 | N IBX,DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT S IBX=0
|
|---|
| 127 | S DIC("S")="I +$P(^(0),U,5)=1"
|
|---|
| 128 | I $G(TYPE)=1 S DIC("S")=DIC("S")_",$P(^(0),U,1)'[""OUTPATIENT"",$P(^(0),U,1)'[""PRESCRIPTION"""
|
|---|
| 129 | I +$G(TYPE)>1 S DIC("B")=$S(TYPE=3:"PRESCRIPTION",TYPE=4:"OUTPATIENT DENTAL",1:"OUTPATIENT VISIT")
|
|---|
| 130 | S DIC("A")=$J("",$G(COL))_"Select "_$G(PROMPT)_" BEDSECTION: "
|
|---|
| 131 | S DIC="^DGCR(399.1,",DIC(0)="AENQ" D ^DIC K DIC
|
|---|
| 132 | I $D(DTOUT)!($D(DUOUT)) S IBX=-1
|
|---|
| 133 | I +Y>0 S IBX=Y
|
|---|
| 134 | Q IBX
|
|---|
| 135 | ;
|
|---|
| 136 | MT() ; do the new mt rate format (misc type) eff 12/6/01 ib*2*167
|
|---|
| 137 | N IBCS,IBTYPE,IBITEM,IBCI,IBX,IBOCHG,DIR,X,Y,IBCHG,IBERROR
|
|---|
| 138 | S IBCS=$$CSN^IBCRU3("TL-MT OPT COPAY"),(IBOCHG,IBERROR)=""
|
|---|
| 139 | I 'IBCS W !,"*** Error: Charge set TL-MT OPT COPAY not found" Q 1
|
|---|
| 140 | W !!,"--------------------------------------------------------------------------------"
|
|---|
| 141 | W !,"Enter MT OUTPATIENT COPAYMENT charges effective ",$$FMTE^XLFDT(IBEFDT),":"
|
|---|
| 142 | W !,"--------------------------------------------------------------------------------"
|
|---|
| 143 | F IBTYPE="BASIC CARE","SPECIALTY CARE" D Q:$L(IBERROR)
|
|---|
| 144 | . S IBITEM=+$$ADDBI^IBCREF("MISCELLANEOUS",IBTYPE)
|
|---|
| 145 | . I 'IBITEM S IBERROR="*** Error: Billable Item "_IBTYPE_" not found" Q
|
|---|
| 146 | . S IBX=IBTYPE_$J("",(50-$L(IBTYPE)))_"$ ="
|
|---|
| 147 | . S IBCI=$$FINDCI^IBCRU4(IBCS,+IBITEM,IBEFDT)
|
|---|
| 148 | . I +IBCI S IBOCHG=$P($G(^IBA(363.2,+IBCI,0)),U,5),DIR("B")=$FN(IBOCHG,"",2)
|
|---|
| 149 | . S DIR("A")=IBX,DIR(0)="NAO^0:999999:2" D ^DIR K DIR S IBCHG=+Y I IBCHG<1!(IBCHG=IBOCHG) Q
|
|---|
| 150 | . I 'IBCI S IBCI=$$ADDCI^IBCREF(IBCS,+IBITEM,IBEFDT,IBCHG) I +IBCI W ?74,"added" Q
|
|---|
| 151 | . I +IBCI D EDITCI^IBCREF(+IBCI,+IBCHG) W ?74,"edited"
|
|---|
| 152 | W !,IBERROR
|
|---|
| 153 | Q $L(IBERROR)
|
|---|
