IBCRER ;ALB/ARH - RATES: CM RC NATIONAL ENTER/EDIT OPTION ; 13-FEB-2007
;;2.0;INTEGRATED BILLING;**370**;21-MAR-94;Build 5
;;Per VHA Directive 2004-038, this routine should not be modified.
;
EN ; Enter/Edit Option: enter National Interim Reasonable Charges
N IBI,IBX,IBXL,IBLN,IBEFF,IBTYPE S IBXL="",$P(IBXL,"-",80)=""
;
W !,"Enter National Reasonable Charges:",!
W !,"This option is used to enter the National Interim Reasonable Charges. "
W !,"These non-site specific charges are provided when new CPT/HCPCS codes are"
W !,"released as interim charges until the next full release of Reasonable Charges.",!
W !,"Procedures and their charge data are entered then they will be added to the "
W !,"appropriate charges sets for every division of Reasonable Charges defined "
W !,"on your system. Enter Professional Charges first.",!
W !,"This option should ONLY be used to add the National Interim Reasonable Charges.",!
;
F IBI=1:1 D Q:IBLN<0 W !,IBXL,!
. D CHGLN^IBCRER1(.IBEFF,.IBTYPE,.IBLN) Q:IBLN<1 W !
. D DISPLN(IBLN) W !
. I +$$ASKLN(IBLN) W ! D SAVELN(IBLN) W !
;
Q
;
SAVELN(LN) ; Save charge to Charge Master (#363.2), identify Charge Set based on Type (I/P) and Indicators (I/S/O/F)
; freestanding sites will recieve any fs indicated charge as a professional charge regardless of charge type
N IBTYP,IBBRTY,IBITM,IBEFF,IBMOD,IBCHGU,IBINCR,IBCHGI,IBINP,IBSNF,IBOPT,IBFS,IBCARE,IBCS,IBCS0,IBCSN,IBBR0,IBCNT
;
S IBCNT=0 S IBTYP=$P($G(LN),U,4) I IBTYP="" W !,"Missing Charge Type, Not Saved" Q
S IBBRTY=$S(IBTYP="I":"RC FACILITY",IBTYP="P":"RC PHYSICIAN",1:"") I IBBRTY="" W !,"Bad Bill Rate, Not Saved" Q
;
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)
S IBINP=+$P(LN,U,8),IBSNF=+$P(LN,U,9),IBOPT=+$P(LN,U,10),IBFS=+$P(LN,U,11)
;
S IBCS=0 F S IBCS=$O(^IBE(363.1,IBCS)) Q:'IBCS D
. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBCSN=$P(IBCS0,U,1) I $E(IBCSN,1,3)'="RC-" Q
. S IBCARE=$S(IBCSN["INPT ":"INP",IBCSN["SNF ":"SNF",IBCSN["OPT ":"OPT",IBCSN["FS ":"FS",1:"") Q:IBCARE=""
. ;
. S IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0))
. I $P(IBBR0,U,1)'[IBBRTY,IBCARE'="FS" Q
. I $P(IBBR0,U,4)'=2 Q
. I IBINCR="PR",$P(IBBR0,U,5)'=1 Q
. I IBINCR="ML",$P(IBBR0,U,5)'=4 Q
. I IBINCR="MN",$P(IBBR0,U,5)'=5 Q
. I IBINCR="HR",$P(IBBR0,U,5)'=6 Q
. ;
. I +IBFS,IBCARE="FS" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q
. I +IBINP,IBCARE="INP" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q
. I +IBSNF,IBCARE="SNF" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q
. I +IBOPT,IBCARE="OPT" D ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN) S IBCNT=IBCNT+1 Q
;
I 'IBCNT W !,"No Reasonable Charges set found for ",IBBRTY,$S(IBINCR="ML":" Ambulance",IBINCR="MN":" Anesthesia",IBINCR="HR":" Observation",1:""),", Charge Not Added."
Q
;
ADDCHG(CS,ITM,EFF,CHG,MOD,CHGI,LN) ; Add charge to Charge Master
N IBCI S CS=+$G(CS),ITM=+$G(ITM),EFF=+$G(EFF),CHG=+$G(CHG),MOD=$G(MOD),CHGI=$G(CHGI) Q:'CHG
;
S IBCI=$$ITCHG^IBCRCI(CS,ITM,EFF,MOD)
I +IBCI W !,"Active charge already exists ",$P($G(^IBE(363.1,CS,0)),U,1),", Charge Not Added." Q
;
S IBCI=$$ADDCI^IBCREF(CS,ITM,EFF,CHG,,MOD,,CHGI)
I +IBCI D DISPLN($P($G(LN),U,1,7)) W ?45,"added "_$P($G(^IBE(363.1,CS,0)),U,1)
I 'IBCI D DISPLN($P($G(LN),U,1,7)) W ?45,"CHARGE NOT ADDED "_$P($G(^IBE(363.1,CS,0)),U,1)
Q
;
ASKLN(LN) ; Ask user if charge should be saved
; Returns: 1 for save, 0 for no or invalid
N IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y S IBX=0
I $G(LN)'="",$P(LN,U,8,11)'[1 W !,"No Sites Selected, Charge Not Added." Q 0
S DIR("?")="Enter Yes to save the charge for all divisions, otherwise enter No."
;
S DIR(0)="Y",DIR("A")="Save Charge for all Divisions",DIR("B")="No" D ^DIR I Y=1 S IBX=1
I $D(DTOUT)!$D(DUOUT) S IBX=0
Q IBX
;
DISPLN(LN) ; Print charge line
; string 'cpt ifn^eff dt^mod ifn^type (I/P)^charge^incr type (PR/ML/HR/MN)^incr charge^inpt^snf^opt^free'
Q:$G(LN)=""
W !,$P($$CPT^ICPTCOD(+LN),U,2),$S(+$P(LN,U,3):"-"_$P($$MOD^ICPTMOD(+$P(LN,U,3),"I"),U,2),1:"")
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)
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)))
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:"")
Q
;
DATE(X) ; returns VA date in external form
N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRER 4598 printed Dec 13, 2024@02:19:05 Page 2
IBCRER ;ALB/ARH - RATES: CM RC NATIONAL ENTER/EDIT OPTION ; 13-FEB-2007
+1 ;;2.0;INTEGRATED BILLING;**370**;21-MAR-94;Build 5
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
EN ; Enter/Edit Option: enter National Interim Reasonable Charges
+1 NEW IBI,IBX,IBXL,IBLN,IBEFF,IBTYPE
SET IBXL=""
SET $PIECE(IBXL,"-",80)=""
+2 ;
+3 WRITE !,"Enter National Reasonable Charges:",!
+4 WRITE !,"This option is used to enter the National Interim Reasonable Charges. "
+5 WRITE !,"These non-site specific charges are provided when new CPT/HCPCS codes are"
+6 WRITE !,"released as interim charges until the next full release of Reasonable Charges.",!
+7 WRITE !,"Procedures and their charge data are entered then they will be added to the "
+8 WRITE !,"appropriate charges sets for every division of Reasonable Charges defined "
+9 WRITE !,"on your system. Enter Professional Charges first.",!
+10 WRITE !,"This option should ONLY be used to add the National Interim Reasonable Charges.",!
+11 ;
+12 FOR IBI=1:1
Begin DoDot:1
+13 DO CHGLN^IBCRER1(.IBEFF,.IBTYPE,.IBLN)
if IBLN<1
QUIT
WRITE !
+14 DO DISPLN(IBLN)
WRITE !
+15 IF +$$ASKLN(IBLN)
WRITE !
DO SAVELN(IBLN)
WRITE !
End DoDot:1
if IBLN<0
QUIT
WRITE !,IBXL,!
+16 ;
+17 QUIT
+18 ;
SAVELN(LN) ; Save charge to Charge Master (#363.2), identify Charge Set based on Type (I/P) and Indicators (I/S/O/F)
+1 ; freestanding sites will recieve any fs indicated charge as a professional charge regardless of charge type
+2 NEW IBTYP,IBBRTY,IBITM,IBEFF,IBMOD,IBCHGU,IBINCR,IBCHGI,IBINP,IBSNF,IBOPT,IBFS,IBCARE,IBCS,IBCS0,IBCSN,IBBR0,IBCNT
+3 ;
+4 SET IBCNT=0
SET IBTYP=$PIECE($GET(LN),U,4)
IF IBTYP=""
WRITE !,"Missing Charge Type, Not Saved"
QUIT
+5 SET IBBRTY=$SELECT(IBTYP="I":"RC FACILITY",IBTYP="P":"RC PHYSICIAN",1:"")
IF IBBRTY=""
WRITE !,"Bad Bill Rate, Not Saved"
QUIT
+6 ;
+7 SET IBITM=+LN
SET IBEFF=+$PIECE(LN,U,2)
SET IBMOD=$PIECE(LN,U,3)
SET IBCHGU=+$PIECE(LN,U,5)
SET IBINCR=$PIECE(LN,U,6)
SET IBCHGI=$PIECE(LN,U,7)
+8 SET IBINP=+$PIECE(LN,U,8)
SET IBSNF=+$PIECE(LN,U,9)
SET IBOPT=+$PIECE(LN,U,10)
SET IBFS=+$PIECE(LN,U,11)
+9 ;
+10 SET IBCS=0
FOR
SET IBCS=$ORDER(^IBE(363.1,IBCS))
if 'IBCS
QUIT
Begin DoDot:1
+11 SET IBCS0=$GET(^IBE(363.1,IBCS,0))
SET IBCSN=$PIECE(IBCS0,U,1)
IF $EXTRACT(IBCSN,1,3)'="RC-"
QUIT
+12 SET IBCARE=$SELECT(IBCSN["INPT ":"INP",IBCSN["SNF ":"SNF",IBCSN["OPT ":"OPT",IBCSN["FS ":"FS",1:"")
if IBCARE=""
QUIT
+13 ;
+14 SET IBBR0=$GET(^IBE(363.3,+$PIECE(IBCS0,U,2),0))
+15 IF $PIECE(IBBR0,U,1)'[IBBRTY
IF IBCARE'="FS"
QUIT
+16 IF $PIECE(IBBR0,U,4)'=2
QUIT
+17 IF IBINCR="PR"
IF $PIECE(IBBR0,U,5)'=1
QUIT
+18 IF IBINCR="ML"
IF $PIECE(IBBR0,U,5)'=4
QUIT
+19 IF IBINCR="MN"
IF $PIECE(IBBR0,U,5)'=5
QUIT
+20 IF IBINCR="HR"
IF $PIECE(IBBR0,U,5)'=6
QUIT
+21 ;
+22 IF +IBFS
IF IBCARE="FS"
DO ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN)
SET IBCNT=IBCNT+1
QUIT
+23 IF +IBINP
IF IBCARE="INP"
DO ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN)
SET IBCNT=IBCNT+1
QUIT
+24 IF +IBSNF
IF IBCARE="SNF"
DO ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN)
SET IBCNT=IBCNT+1
QUIT
+25 IF +IBOPT
IF IBCARE="OPT"
DO ADDCHG(IBCS,IBITM,IBEFF,IBCHGU,IBMOD,IBCHGI,LN)
SET IBCNT=IBCNT+1
QUIT
End DoDot:1
+26 ;
+27 IF 'IBCNT
WRITE !,"No Reasonable Charges set found for ",IBBRTY,$SELECT(IBINCR="ML":" Ambulance",IBINCR="MN":" Anesthesia",IBINCR="HR":" Observation",1:""),", Charge Not Added."
+28 QUIT
+29 ;
ADDCHG(CS,ITM,EFF,CHG,MOD,CHGI,LN) ; Add charge to Charge Master
+1 NEW IBCI
SET CS=+$GET(CS)
SET ITM=+$GET(ITM)
SET EFF=+$GET(EFF)
SET CHG=+$GET(CHG)
SET MOD=$GET(MOD)
SET CHGI=$GET(CHGI)
if 'CHG
QUIT
+2 ;
+3 SET IBCI=$$ITCHG^IBCRCI(CS,ITM,EFF,MOD)
+4 IF +IBCI
WRITE !,"Active charge already exists ",$PIECE($GET(^IBE(363.1,CS,0)),U,1),", Charge Not Added."
QUIT
+5 ;
+6 SET IBCI=$$ADDCI^IBCREF(CS,ITM,EFF,CHG,,MOD,,CHGI)
+7 IF +IBCI
DO DISPLN($PIECE($GET(LN),U,1,7))
WRITE ?45,"added "_$PIECE($GET(^IBE(363.1,CS,0)),U,1)
+8 IF 'IBCI
DO DISPLN($PIECE($GET(LN),U,1,7))
WRITE ?45,"CHARGE NOT ADDED "_$PIECE($GET(^IBE(363.1,CS,0)),U,1)
+9 QUIT
+10 ;
ASKLN(LN) ; Ask user if charge should be saved
+1 ; Returns: 1 for save, 0 for no or invalid
+2 NEW IBX,DIR,DUOUT,DTOUT,DIRUT,X,Y
SET IBX=0
+3 IF $GET(LN)'=""
IF $PIECE(LN,U,8,11)'[1
WRITE !,"No Sites Selected, Charge Not Added."
QUIT 0
+4 SET DIR("?")="Enter Yes to save the charge for all divisions, otherwise enter No."
+5 ;
+6 SET DIR(0)="Y"
SET DIR("A")="Save Charge for all Divisions"
SET DIR("B")="No"
DO ^DIR
IF Y=1
SET IBX=1
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBX=0
+8 QUIT IBX
+9 ;
DISPLN(LN) ; Print charge line
+1 ; string 'cpt ifn^eff dt^mod ifn^type (I/P)^charge^incr type (PR/ML/HR/MN)^incr charge^inpt^snf^opt^free'
+2 if $GET(LN)=""
QUIT
+3 WRITE !,$PIECE($$CPT^ICPTCOD(+LN),U,2),$SELECT(+$PIECE(LN,U,3):"-"_$PIECE($$MOD^ICPTMOD(+$PIECE(LN,U,3),"I"),U,2),1:"")
+4 WRITE ?11,$$DATE(+$PIECE(LN,U,2)),?21,$SELECT($PIECE(LN,U,4)="I":"Inst",1:"Prof"),?27,$JUSTIFY(+$PIECE(LN,U,5),8,2)
+5 WRITE $SELECT(+$PIECE(LN,U,7):"+"_$JUSTIFY(+$PIECE(LN,U,7),0,2),1:""),$SELECT($PIECE(LN,U,6)="PR":"",1:$$LOW^XLFSTR($PIECE(LN,U,6)))
+6 WRITE ?47,$SELECT(+$PIECE(LN,U,8):"Inpt ",1:""),$SELECT(+$PIECE(LN,U,9):"SNF ",1:""),$SELECT(+$PIECE(LN,U,10):"Opt ",1:""),$SELECT(+$PIECE(LN,U,11):"FreeSt ",1:"")
+7 QUIT
+8 ;
DATE(X) ; returns VA date in external form
+1 NEW Y
SET Y=""
IF $GET(X)?7N.E
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 QUIT Y
