| 1 | IBCRER  ;ALB/ARH - RATES: CM RC NATIONAL ENTER/EDIT OPTION ; 13-FEB-2007 | 
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**370**;21-MAR-94;Build 5 | 
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | EN      ; Enter/Edit Option: enter National Interim Reasonable Charges | 
|---|
| 6 | N IBI,IBX,IBXL,IBLN,IBEFF,IBTYPE S IBXL="",$P(IBXL,"-",80)="" | 
|---|
| 7 | ; | 
|---|
| 8 | W !,"Enter National Reasonable Charges:",! | 
|---|
| 9 | W !,"This option is used to enter the National Interim Reasonable Charges. " | 
|---|
| 10 | W !,"These non-site specific charges are provided when new CPT/HCPCS codes are" | 
|---|
| 11 | W !,"released as interim charges until the next full release of Reasonable Charges.",! | 
|---|
| 12 | W !,"Procedures and their charge data are entered then they will be added to the " | 
|---|
| 13 | W !,"appropriate charges sets for every division of Reasonable Charges defined " | 
|---|
| 14 | W !,"on your system.  Enter Professional Charges first.",! | 
|---|
| 15 | W !,"This option should ONLY be used to add the National Interim Reasonable Charges.",! | 
|---|
| 16 | ; | 
|---|
| 17 | F IBI=1:1 D  Q:IBLN<0  W !,IBXL,! | 
|---|
| 18 | . D CHGLN^IBCRER1(.IBEFF,.IBTYPE,.IBLN) Q:IBLN<1  W ! | 
|---|
| 19 | . D DISPLN(IBLN) W ! | 
|---|
| 20 | . I +$$ASKLN(IBLN) W ! D SAVELN(IBLN) W ! | 
|---|
| 21 | ; | 
|---|
| 22 | Q | 
|---|
| 23 | ; | 
|---|
| 24 | SAVELN(LN)      ; Save charge to Charge Master (#363.2), identify Charge Set based on Type (I/P) and Indicators (I/S/O/F) | 
|---|
| 25 | ; freestanding sites will recieve any fs indicated charge as a professional charge regardless of charge type | 
|---|
| 26 | N IBTYP,IBBRTY,IBITM,IBEFF,IBMOD,IBCHGU,IBINCR,IBCHGI,IBINP,IBSNF,IBOPT,IBFS,IBCARE,IBCS,IBCS0,IBCSN,IBBR0,IBCNT | 
|---|
| 27 | ; | 
|---|
| 28 | S IBCNT=0 S IBTYP=$P($G(LN),U,4) I IBTYP="" W !,"Missing Charge Type, Not Saved" Q | 
|---|
| 29 | S IBBRTY=$S(IBTYP="I":"RC FACILITY",IBTYP="P":"RC PHYSICIAN",1:"") I IBBRTY="" W !,"Bad Bill Rate, Not Saved" Q | 
|---|
| 30 | ; | 
|---|
| 31 | S IBITM=+LN,IBEFF=+$P(LN,U,2),IBMOD=$P(LN,U,3),IBCHGU=+$P(LN,U,5),IBINCR=$P(LN,U,6),IBCHGI=$P(LN,U,7) | 
|---|
| 32 | S IBINP=+$P(LN,U,8),IBSNF=+$P(LN,U,9),IBOPT=+$P(LN,U,10),IBFS=+$P(LN,U,11) | 
|---|
| 33 | ; | 
|---|
| 34 | S IBCS=0 F  S IBCS=$O(^IBE(363.1,IBCS)) Q:'IBCS  D | 
|---|
| 35 | . S IBCS0=$G(^IBE(363.1,IBCS,0)),IBCSN=$P(IBCS0,U,1) I $E(IBCSN,1,3)'="RC-" Q | 
|---|
| 36 | . S IBCARE=$S(IBCSN["INPT ":"INP",IBCSN["SNF ":"SNF",IBCSN["OPT ":"OPT",IBCSN["FS ":"FS",1:"") Q:IBCARE="" | 
|---|
| 37 | . ; | 
|---|
| 38 | . S IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0)) | 
|---|
| 39 | . I $P(IBBR0,U,1)'[IBBRTY,IBCARE'="FS" Q | 
|---|
| 40 | . I $P(IBBR0,U,4)'=2 Q | 
|---|
| 41 | . I IBINCR="PR",$P(IBBR0,U,5)'=1 Q | 
|---|
| 42 | . I IBINCR="ML",$P(IBBR0,U,5)'=4 Q | 
|---|
| 43 | . I IBINCR="MN",$P(IBBR0,U,5)'=5 Q | 
|---|
| 44 | . I IBINCR="HR",$P(IBBR0,U,5)'=6 Q | 
|---|
| 45 | . ; | 
|---|
| 46 | . I +IBFS,IBCARE="FS" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q | 
|---|
| 47 | . I +IBINP,IBCARE="INP" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q | 
|---|
| 48 | . I +IBSNF,IBCARE="SNF" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q | 
|---|
| 49 | . I +IBOPT,IBCARE="OPT" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q | 
|---|
| 50 | ; | 
|---|
| 51 | I 'IBCNT W !,"No Reasonable Charges set found for ",IBBRTY,$S(IBINCR="ML":" Ambulance",IBINCR="MN":" Anesthesia",IBINCR="HR":" Observation",1:""),", Charge Not Added." | 
|---|
| 52 | Q | 
|---|
| 53 | ; | 
|---|
| 54 | ADDCHG(CS,ITM,EFF,CHG,MOD,CHGI,LN)      ; Add charge to Charge Master | 
|---|
| 55 | N IBCI S CS=+$G(CS),ITM=+$G(ITM),EFF=+$G(EFF),CHG=+$G(CHG),MOD=$G(MOD),CHGI=$G(CHGI) Q:'CHG | 
|---|
| 56 | ; | 
|---|
| 57 | S IBCI=$$ITCHG^IBCRCI(CS,ITM,EFF,MOD) | 
|---|
| 58 | I +IBCI W !,"Active charge already exists ",$P($G(^IBE(363.1,CS,0)),U,1),", Charge Not Added." Q | 
|---|
| 59 | ; | 
|---|
| 60 | S IBCI=$$ADDCI^IBCREF(CS,ITM,EFF,CHG,,MOD,,CHGI) | 
|---|
| 61 | I +IBCI D DISPLN($P($G(LN),U,1,7)) W ?45,"added "_$P($G(^IBE(363.1,CS,0)),U,1) | 
|---|
| 62 | I 'IBCI D DISPLN($P($G(LN),U,1,7)) W ?45,"CHARGE NOT ADDED "_$P($G(^IBE(363.1,CS,0)),U,1) | 
|---|
| 63 | Q | 
|---|
| 64 | ; | 
|---|
| 65 | ASKLN(LN)       ; Ask user if charge should be saved | 
|---|
| 66 | ; Returns: 1 for save, 0 for no or invalid | 
|---|
| 67 | N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=0 | 
|---|
| 68 | I $G(LN)'="",$P(LN,U,8,11)'[1 W !,"No Sites Selected, Charge Not Added." Q 0 | 
|---|
| 69 | S DIR("?")="Enter Yes to save the charge for all divisions, otherwise enter No." | 
|---|
| 70 | ; | 
|---|
| 71 | S DIR(0)="Y",DIR("A")="Save Charge for all Divisions",DIR("B")="No" D ^DIR I Y=1 S IBX=1 | 
|---|
| 72 | I $D(DTOUT)!$D(DUOUT) S IBX=0 | 
|---|
| 73 | Q IBX | 
|---|
| 74 | ; | 
|---|
| 75 | DISPLN(LN)      ; Print charge line | 
|---|
| 76 | ; string 'cpt ifn^eff dt^mod ifn^type (I/P)^charge^incr type (PR/ML/HR/MN)^incr charge^inpt^snf^opt^free' | 
|---|
| 77 | Q:$G(LN)="" | 
|---|
| 78 | W !,$P($$CPT^ICPTCOD(+LN),U,2),$S(+$P(LN,U,3):"-"_$P($$MOD^ICPTMOD(+$P(LN,U,3),"I"),U,2),1:"") | 
|---|
| 79 | W ?11,$$DATE(+$P(LN,U,2)),?21,$S($P(LN,U,4)="I":"Inst",1:"Prof"),?27,$J(+$P(LN,U,5),8,2) | 
|---|
| 80 | W $S(+$P(LN,U,7):"+"_$J(+$P(LN,U,7),0,2),1:""),$S($P(LN,U,6)="PR":"",1:$$LOW^XLFSTR($P(LN,U,6))) | 
|---|
| 81 | W ?47,$S(+$P(LN,U,8):"Inpt ",1:""),$S(+$P(LN,U,9):"SNF ",1:""),$S(+$P(LN,U,10):"Opt ",1:""),$S(+$P(LN,U,11):"FreeSt ",1:"") | 
|---|
| 82 | Q | 
|---|
| 83 | ; | 
|---|
| 84 | DATE(X) ; returns VA date in external form | 
|---|
| 85 | N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) | 
|---|
| 86 | Q Y | 
|---|