IBCEU5 ;ALB/TMP - EDI UTILITIES (continued) FOR CMS-1500 ;13-DEC-99
;;2.0;INTEGRATED BILLING;**51,137,232,348,349,432,592,608**;21-MAR-94;Build 90
;;Per VA Directive 6402, this routine should not be modified.
Q
;
EXTCR(IBPRV) ; Called by trigger on field .02 of file 399.0222
; Also called by trigger on field .02 of file 399.0404 (DEM;432).
; Function returns the first 3 digits of the provider's degree if
; a VA provider or the credentials in file 355.9 if non-VA provider
; IBPRV = vp to file 200 or 355.93
Q $E($$CRED^IBCEU(IBPRV),1,3)
;
FTPRV(IBIFN,NOASK) ; If form type changes from UB-04 to CMS-1500 or vice
; versa, ask to change provider function to appropriate function for
; form type (ATTENDING = UB-04, RENDERING = CMS-1500)
; IBIFN = ien of bill in file 399
; NOASK (flag) = 1 if change should happen without asking first
N ATT,REN,FT
S FT=$$FT^IBCEF(IBIFN)
S REN=$$CKPROV^IBCEU(IBIFN,3,1)
S ATT=$$CKPROV^IBCEU(IBIFN,4,1)
;JWS;IB*2.0*592;add Dental form check
I $S(FT=2:'REN&ATT,FT=3:'ATT&REN,FT=7:'REN&ATT,1:0) D
. I '$G(NOASK) D TXFERPRV(IBIFN,FT) Q
. D PRVCHG(IBIFN,FT)
D CLEANUP(IBIFN,FT)
Q
;
TXFERPRV(IBIFN,FT) ; Ask to change the function of the main provider on
; bill IBIFN to the function appropriate to the form type FT
;
N DIR,X,Y,Z,DIE,DA,DR,HAVE,NEED,IBZ
; DEM;432 - Changed the prompt from uppercase to mixed case.
W ! S DIR("A")=" Change the Claim Level "_$S(FT=3:"Rendering",1:"Attending")_" provider's function to "_$S(FT=3:"Attending",1:"Rendering")_"?: "
S DIR(0)="YA",DIR("B")="NO",DIR("?",1)="If you answer YES here, you will make the claim level provider functions",DIR("?")=" consistent with the form type of the bill"
D ^DIR K DIR
I Y'=1 Q
D PRVCHG(IBIFN,FT)
Q
;
PRVCHG(IBIFN,IBFT) ; Change provider type to type consistent with current
; data on bill
N Z,IBZ,HAVE,NEED,DIE,DA,X,Y
S HAVE=$S(IBFT=3:3,1:4)
S NEED=$S(IBFT=3:4,1:3)
S Z=$O(^DGCR(399,IBIFN,"PRV","B",HAVE,0))
I Z D
. S DA(1)=IBIFN,DA=+Z
. D FDA^DILF(399.0222,.DA,.01,,NEED,"IBZ")
. D FILE^DIE(,"IBZ")
;I Z S DA(1)=IBIFN,DIE="^DGCR(399,"_DA(1)_",""PRV"",",DA=+Z,DR=".01////"_NEED D FILE^DIE(,DIE
Q
;
CLEANUP(IBIFN,FT) ; If form type changes remove any extra provider FUNCTIONS.
N X,PRV,CLEAN,DA,DIE
;
;JWS;IB*2.0*592 US1108 - If form type changes to (7) J430D - Dental, default Bill Charge Type
I FT=7 S CLEAN(399,IBIFN_",",.27)=2
; (3) If form type changes from CMS-1500 to UB-04, remove any extra provider FUNCTIONS.
;JWS;IB*2.0*592 US1108 - added 6-ASSISTANT SURGEON
I FT=3 F X=5,6 D ; 5-SUPERVISING, 6-ASSISTANT SURGEON
. I $D(^DGCR(399,IBIFN,"PRV","B",X)) D
.. S PRV=0 F S PRV=$O(^DGCR(399,IBIFN,"PRV","B",X,PRV)) Q:+PRV=0 D
... S DA(1)=IBIFN,DA=PRV D FDA^DILF(399.0222,.DA,.01,,"@","CLEAN")
;
; (2) If form type changes from UB-04 to CMS-1500, remove any extra provider FUNCTIONS.
;JWS;IB*2.0*592 US1108 - added 6-ASSISTANT SURGEON
I FT=2 F X=2,4,6,9 D ; 2-OPERATING, 4-ATTENDING, 6-ASSISTANT SURGEON, 9-OTHER
. I $D(^DGCR(399,IBIFN,"PRV","B",X)) D
.. S PRV=0 F S PRV=$O(^DGCR(399,IBIFN,"PRV","B",X,PRV)) Q:+PRV=0 D
... S DA(1)=IBIFN,DA=PRV D FDA^DILF(399.0222,.DA,.01,,"@","CLEAN")
;
I $D(CLEAN) D FILE^DIE(,"CLEAN")
Q
;
PRVHELP ; Text for the provider function help
Q:$G(X)'="??"
N IBZ,IBQUIT,IB,IB1,DIR,Z
S IBQUIT=0
S Z=""
I '$D(IOSL)!'$D(IOST) D HOME^%ZIS
Q:IOST'["C-"
D:$G(D0) SPECIFIC(D0)
N DIR,X,Y S DIR(0)="E" D ^DIR K DIR W @IOF
S:$G(D0) Z=$$FT^IBCEF(D0)
S IB=IOSL,IB1=1
F IBZ=1:1 S:$P($T(HLPTXT+IBZ),";;",2)="" IBQUIT=1 Q:IBQUIT S IB1=1 D
. I $Y>(IB-3) N DIR,X,Y S IB1=0,DIR(0)="E" D ^DIR K DIR S IB=IB+IOSL I Y'=1 S IBQUIT=1 Q
. W !,$P($T(HLPTXT+IBZ),";;",2)
I IB1 D
. N DIR,X,Y S DIR(0)="E" D ^DIR K DIR
W @IOF
Q
;
SPECIFIC(IBIFN) ; Display specific provider requirements for the bill IBIFN
N IBFT,IBPRV,IBR,ONBILL,Z,IBZ
S IBFT=$$FT^IBCEF(IBIFN)
D GETPRV^IBCEU(IBIFN,"ALL",.IBPRV) ;Returns needed providers
;JWS;IB*2.0*592 US1108 - added Dental form #7
W !,"This bill is ",$S(IBFT=7:"J430D",IBFT=3:"UB-04",1:"CMS-1500"),"/",$S($$INPAT^IBCEF(IBIFN):"Inpatient",1:"Outpatient")
W !!,"The valid provider functions for this bill are:"
;JWS;IB*2.0*592 US1108 - changed loop from :5 to :6 for Assistant Surgeon
F IBZ=1:1:6,9 I $$PRVOK^IBCEU(IBZ,IBIFN) D
. S ONBILL=$$CKPROV^IBCEU(IBIFN,IBZ)
. S IBR=$S($G(IBPRV(IBZ,"NOTOPT")):1,$G(IBPRV(IBZ,"SITUATIONAL")):2,1:0) ; DEM;432 added "SITUATIONAL" check.
. ;JWS;IB*2.0*592 US1108 - dental form#7
. I IBFT=7 S IBR=2
. ; ib2.0*432
. ; W !,IBZ," ",$$EXPAND^IBTRE(399.0222,.01,IBZ),?18,$S(IBR&'ONBILL:"**",1:""),?20,$S(IBR:"REQUIRED",1:"OPTIONAL"),$S(ONBILL:" - ALREADY ON BILL",1:" - NOT ON BILL")
. W !,IBZ," ",$$EXPAND^IBTRE(399.0222,.01,IBZ),?18,$S(IBR&'ONBILL:"**",1:""),?23,$S(IBR=1:"REQUIRED",IBR=2:"SITUATIONAL",1:"OPTIONAL")
W !
Q
;
HLPTXT ; Helptext for provider function
;;
;;PROVIDER FUNCTION requirements:
;;
;;RENDERING: UB-04 Situational, CMS-1500 Situational, or J430D Situational
;; This is the provider who performed a service.
;;
;;ATTENDING: UB-04 REQUIRED
;; The physician who has primary responsibility
;; for the patient's medical care and treatment.
;;
;;OPERATING: UB-04 SITUATIONAL
;; The provider who performed the principal procedure(s)
;; being billed.
;; UB-04 (inpatient): Situational IF type of bill has first 2
;; digits of 11, and there is a principal
;; procedure that will print in Form
;; Locator 74 of the claim, there must be
;; an Operating or Rendering Provider.
;; UB-04 (outpatient):REQUIRED IF type of bill has first 2
;; digits of 83, and there is a principal
;; procedure that will print in Form
;; Locator 74 of the claim.
;;
;;REFERRING: UB-04, CMS-1500, or J430D SITUATIONAL
;; The provider who referred the patient for the services being billed.
;;
;;SUPERVISING: CMS-1500 OPTIONAL or J430D SITUATIONAL
;; Required when the rendering provider is supervised
;; by another provider. Data will not be printed.
;;
;;OTHER OPERATING: UB-04 SITUATIONAL
;; Used to report another Operating Physician. There must
;; also be an Operating Physician on the claim.
;;
;;ASSISTANT SURGEON: J430D SITUATIONAL
;; Use when the Rendering Provider provided these services in the role
;; of the Assisting Surgeon.
;;
;; There are providers who performed specific functions for
;; the services on this bill. These providers are needed to
;; enable the V.A. to collect reimbursement when more than
;; one provider function is involved in the billable episode
;; (like an operating physician or referring provider).
;;
;; This data identifies the type of function that was performed
;; by a provider.
;;
;
LINKRX(IBIFN,IBREV) ; Ask for revenue code's RX if not already there
N DIR,X,Y,IBZ,IBRX,Z,Z0,DA
Q:$P($G(^DGCR(399,IBIFN,"RC",IBREV,0)),U,11)!($P($G(^(0)),U,10)'=3)
S Z=0 F S Z=$O(^DGCR(399,IBIFN,"RC",Z)) Q:'Z I Z'=IBREV S Z0=$G(^(Z,0)) I $P(Z0,U,10)=3,$P(Z0,U,11) S IBRX(+$P(Z0,U,11))=""
S DIR(0)="PAO^IBA(362.4,:AEMQ",DIR("S")="I $P(^(0),U,2)=IBIFN,'$D(IBRX(+Y))"
S DIR("A")="Select Rx for this charge: "
S DIR("?",1)="Enter an Rx# for this revenue code"
S DIR("?")=" The Rx must not already have an associated revenue code"
D ^DIR K DIR
I Y>0 D
. S DA(1)=IBIFN,DA=IBREV,IBZ=""
. D FDA^DILF(399.042,.DA,.11,"R",+Y,"IBZ")
. D FILE^DIE(,"IBZ")
Q
;
LINKCPT(IBIFN,IBREV) ; Ask for revenue code's CPT
N DIR,X,Y,IBZ,IBCP,Z,Z0,Z1,DA,IBRC,IBP
S IBRC=$G(^DGCR(399,IBIFN,"RC",IBREV,0))
Q:$P(IBRC,U,8)!($P(IBRC,U,10)'=4)
S IBP=+$P(IBRC,U,6)
I $P(IBRC,U,11) W !,"PROCEDURE #"_$P(IBRC,U,11)_" HAS BEEN ASSOCIATED WITH THIS MANUAL CHARGE"
I '$P(IBRC,U,11) D Q:IBRC=""
. S DIR("?",1)="Respond YES if this revenue code charge specifically references the data for"
. S DIR("?",2)=" a particular procedure that was manually entered on the previous screen."
. S DIR("?",3)=" For outpatient UB-04 bills, associating a manual revenue code charge with",DIR("?")=" a procedure is the only way to print a modifier in box 44"
. S DIR(0)="YA",DIR("A")="SHOULD A PROCEDURE ENTRY BE ASSOCIATED WITH THIS CHARGE?: ",DIR("B")=$S(IBP:"YES",1:"NO") W ! D ^DIR K DIR W !
. I Y'=1 S IBRC="" Q
I $P(IBRC,U,11) D
. S DIR("?",1)="Respond YES if you no longer want this revenue code charge to reference a",DIR("?")=" specific manually entered procedure"
. S DIR(0)="YA",DIR("A")="DELETE THE EXISTING PROCEDURE ASSOCIATION?: ",DIR("B")="NO" W ! D ^DIR K DIR
. I Y=1 D UPDPTR(IBIFN,IBREV,"") S $P(IBRC,U,11)=""
S Z=0 F S Z=$O(^DGCR(399,IBIFN,"RC",Z)) Q:'Z S Z0=$G(^(Z,0)) I IBREV'=Z,$P(Z0,U,11) D
. ; Don't allow to link to 'used' proc
. I $P(Z0,U,10)=4 S IBCP($P(Z0,U,11))="" Q
. I $P(Z0,U,10)=3,$P(Z0,U,15) S IBCP($P(Z0,U,15))=""
S DIR(0)="PAO^DGCR(399,"_IBIFN_",""CP"",:AEMQ",DIR("S")="I '$D(IBCP(+Y)),$P(^(0),U)[""CPT"",+^(0)="_+$P($G(^DGCR(399,IBIFN,"RC",IBREV,0)),U,6)
S DIR("A")="SELECT A PROCEDURE ENTRY: "_$S($P(IBRC,U,11):"#"_$P(IBRC,U,11)_" - "_$$EXPAND^IBTRE(399.0304,.01,$P($G(^DGCR(399,IBIFN,"CP",$P(IBRC,U,11),0)),U))_"// ",1:"")
S DIR("?")="Enter a manually-added CPT procedure to associate with this charge"
S DA(1)=IBIFN
D ^DIR K DIR W !
I Y>0 D UPDPTR(IBIFN,IBREV,+Y)
Q
;
UPDPTR(IBIFN,IBREV,Y) ;
N IBZ,DA
S DA(1)=IBIFN,DA=IBREV,IBZ=""
D FDA^DILF(399.042,.DA,.11,"R",$S(Y:+Y,1:""),"IBZ")
D FILE^DIE(,"IBZ")
Q
;
INSFT(IBIFN) ; Returns 1 if form type is UB-04, 0 if CMS-1500 or J430D
Q ($$FT^IBCEF(IBIFN)=3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEU5 9956 printed Sep 23, 2025@19:48:50 Page 2
IBCEU5 ;ALB/TMP - EDI UTILITIES (continued) FOR CMS-1500 ;13-DEC-99
+1 ;;2.0;INTEGRATED BILLING;**51,137,232,348,349,432,592,608**;21-MAR-94;Build 90
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
EXTCR(IBPRV) ; Called by trigger on field .02 of file 399.0222
+1 ; Also called by trigger on field .02 of file 399.0404 (DEM;432).
+2 ; Function returns the first 3 digits of the provider's degree if
+3 ; a VA provider or the credentials in file 355.9 if non-VA provider
+4 ; IBPRV = vp to file 200 or 355.93
+5 QUIT $EXTRACT($$CRED^IBCEU(IBPRV),1,3)
+6 ;
FTPRV(IBIFN,NOASK) ; If form type changes from UB-04 to CMS-1500 or vice
+1 ; versa, ask to change provider function to appropriate function for
+2 ; form type (ATTENDING = UB-04, RENDERING = CMS-1500)
+3 ; IBIFN = ien of bill in file 399
+4 ; NOASK (flag) = 1 if change should happen without asking first
+5 NEW ATT,REN,FT
+6 SET FT=$$FT^IBCEF(IBIFN)
+7 SET REN=$$CKPROV^IBCEU(IBIFN,3,1)
+8 SET ATT=$$CKPROV^IBCEU(IBIFN,4,1)
+9 ;JWS;IB*2.0*592;add Dental form check
+10 IF $SELECT(FT=2:'REN&ATT,FT=3:'ATT&REN,FT=7:'REN&ATT,1:0)
Begin DoDot:1
+11 IF '$GET(NOASK)
DO TXFERPRV(IBIFN,FT)
QUIT
+12 DO PRVCHG(IBIFN,FT)
End DoDot:1
+13 DO CLEANUP(IBIFN,FT)
+14 QUIT
+15 ;
TXFERPRV(IBIFN,FT) ; Ask to change the function of the main provider on
+1 ; bill IBIFN to the function appropriate to the form type FT
+2 ;
+3 NEW DIR,X,Y,Z,DIE,DA,DR,HAVE,NEED,IBZ
+4 ; DEM;432 - Changed the prompt from uppercase to mixed case.
+5 WRITE !
SET DIR("A")=" Change the Claim Level "_$SELECT(FT=3:"Rendering",1:"Attending")_" provider's function to "_$SELECT(FT=3:"Attending",1:"Rendering")_"?: "
+6 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("?",1)="If you answer YES here, you will make the claim level provider functions"
SET DIR("?")=" consistent with the form type of the bill"
+7 DO ^DIR
KILL DIR
+8 IF Y'=1
QUIT
+9 DO PRVCHG(IBIFN,FT)
+10 QUIT
+11 ;
PRVCHG(IBIFN,IBFT) ; Change provider type to type consistent with current
+1 ; data on bill
+2 NEW Z,IBZ,HAVE,NEED,DIE,DA,X,Y
+3 SET HAVE=$SELECT(IBFT=3:3,1:4)
+4 SET NEED=$SELECT(IBFT=3:4,1:3)
+5 SET Z=$ORDER(^DGCR(399,IBIFN,"PRV","B",HAVE,0))
+6 IF Z
Begin DoDot:1
+7 SET DA(1)=IBIFN
SET DA=+Z
+8 DO FDA^DILF(399.0222,.DA,.01,,NEED,"IBZ")
+9 DO FILE^DIE(,"IBZ")
End DoDot:1
+10 ;I Z S DA(1)=IBIFN,DIE="^DGCR(399,"_DA(1)_",""PRV"",",DA=+Z,DR=".01////"_NEED D FILE^DIE(,DIE
+11 QUIT
+12 ;
CLEANUP(IBIFN,FT) ; If form type changes remove any extra provider FUNCTIONS.
+1 NEW X,PRV,CLEAN,DA,DIE
+2 ;
+3 ;JWS;IB*2.0*592 US1108 - If form type changes to (7) J430D - Dental, default Bill Charge Type
+4 IF FT=7
SET CLEAN(399,IBIFN_",",.27)=2
+5 ; (3) If form type changes from CMS-1500 to UB-04, remove any extra provider FUNCTIONS.
+6 ;JWS;IB*2.0*592 US1108 - added 6-ASSISTANT SURGEON
+7 ; 5-SUPERVISING, 6-ASSISTANT SURGEON
IF FT=3
FOR X=5,6
Begin DoDot:1
+8 IF $DATA(^DGCR(399,IBIFN,"PRV","B",X))
Begin DoDot:2
+9 SET PRV=0
FOR
SET PRV=$ORDER(^DGCR(399,IBIFN,"PRV","B",X,PRV))
if +PRV=0
QUIT
Begin DoDot:3
+10 SET DA(1)=IBIFN
SET DA=PRV
DO FDA^DILF(399.0222,.DA,.01,,"@","CLEAN")
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;
+12 ; (2) If form type changes from UB-04 to CMS-1500, remove any extra provider FUNCTIONS.
+13 ;JWS;IB*2.0*592 US1108 - added 6-ASSISTANT SURGEON
+14 ; 2-OPERATING, 4-ATTENDING, 6-ASSISTANT SURGEON, 9-OTHER
IF FT=2
FOR X=2,4,6,9
Begin DoDot:1
+15 IF $DATA(^DGCR(399,IBIFN,"PRV","B",X))
Begin DoDot:2
+16 SET PRV=0
FOR
SET PRV=$ORDER(^DGCR(399,IBIFN,"PRV","B",X,PRV))
if +PRV=0
QUIT
Begin DoDot:3
+17 SET DA(1)=IBIFN
SET DA=PRV
DO FDA^DILF(399.0222,.DA,.01,,"@","CLEAN")
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;
+19 IF $DATA(CLEAN)
DO FILE^DIE(,"CLEAN")
+20 QUIT
+21 ;
PRVHELP ; Text for the provider function help
+1 if $GET(X)'="??"
QUIT
+2 NEW IBZ,IBQUIT,IB,IB1,DIR,Z
+3 SET IBQUIT=0
+4 SET Z=""
+5 IF '$DATA(IOSL)!'$DATA(IOST)
DO HOME^%ZIS
+6 if IOST'["C-"
QUIT
+7 if $GET(D0)
DO SPECIFIC(D0)
+8 NEW DIR,X,Y
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE @IOF
+9 if $GET(D0)
SET Z=$$FT^IBCEF(D0)
+10 SET IB=IOSL
SET IB1=1
+11 FOR IBZ=1:1
if $PIECE($TEXT(HLPTXT+IBZ),";;",2)=""
SET IBQUIT=1
if IBQUIT
QUIT
SET IB1=1
Begin DoDot:1
+12 IF $Y>(IB-3)
NEW DIR,X,Y
SET IB1=0
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET IB=IB+IOSL
IF Y'=1
SET IBQUIT=1
QUIT
+13 WRITE !,$PIECE($TEXT(HLPTXT+IBZ),";;",2)
End DoDot:1
+14 IF IB1
Begin DoDot:1
+15 NEW DIR,X,Y
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+16 WRITE @IOF
+17 QUIT
+18 ;
SPECIFIC(IBIFN) ; Display specific provider requirements for the bill IBIFN
+1 NEW IBFT,IBPRV,IBR,ONBILL,Z,IBZ
+2 SET IBFT=$$FT^IBCEF(IBIFN)
+3 ;Returns needed providers
DO GETPRV^IBCEU(IBIFN,"ALL",.IBPRV)
+4 ;JWS;IB*2.0*592 US1108 - added Dental form #7
+5 WRITE !,"This bill is ",$SELECT(IBFT=7:"J430D",IBFT=3:"UB-04",1:"CMS-1500"),"/",$SELECT($$INPAT^IBCEF(IBIFN):"Inpatient",1:"Outpatient")
+6 WRITE !!,"The valid provider functions for this bill are:"
+7 ;JWS;IB*2.0*592 US1108 - changed loop from :5 to :6 for Assistant Surgeon
+8 FOR IBZ=1:1:6,9
IF $$PRVOK^IBCEU(IBZ,IBIFN)
Begin DoDot:1
+9 SET ONBILL=$$CKPROV^IBCEU(IBIFN,IBZ)
+10 ; DEM;432 added "SITUATIONAL" check.
SET IBR=$SELECT($GET(IBPRV(IBZ,"NOTOPT")):1,$GET(IBPRV(IBZ,"SITUATIONAL")):2,1:0)
+11 ;JWS;IB*2.0*592 US1108 - dental form#7
+12 IF IBFT=7
SET IBR=2
+13 ; ib2.0*432
+14 ; W !,IBZ," ",$$EXPAND^IBTRE(399.0222,.01,IBZ),?18,$S(IBR&'ONBILL:"**",1:""),?20,$S(IBR:"REQUIRED",1:"OPTIONAL"),$S(ONBILL:" - ALREADY ON BILL",1:" - NOT ON BILL")
+15 WRITE !,IBZ," ",$$EXPAND^IBTRE(399.0222,.01,IBZ),?18,$SELECT(IBR&'ONBILL:"**",1:""),?23,$SELECT(IBR=1:"REQUIRED",IBR=2:"SITUATIONAL",1:"OPTIONAL")
End DoDot:1
+16 WRITE !
+17 QUIT
+18 ;
HLPTXT ; Helptext for provider function
+1 ;;
+2 ;;PROVIDER FUNCTION requirements:
+3 ;;
+4 ;;RENDERING: UB-04 Situational, CMS-1500 Situational, or J430D Situational
+5 ;; This is the provider who performed a service.
+6 ;;
+7 ;;ATTENDING: UB-04 REQUIRED
+8 ;; The physician who has primary responsibility
+9 ;; for the patient's medical care and treatment.
+10 ;;
+11 ;;OPERATING: UB-04 SITUATIONAL
+12 ;; The provider who performed the principal procedure(s)
+13 ;; being billed.
+14 ;; UB-04 (inpatient): Situational IF type of bill has first 2
+15 ;; digits of 11, and there is a principal
+16 ;; procedure that will print in Form
+17 ;; Locator 74 of the claim, there must be
+18 ;; an Operating or Rendering Provider.
+19 ;; UB-04 (outpatient):REQUIRED IF type of bill has first 2
+20 ;; digits of 83, and there is a principal
+21 ;; procedure that will print in Form
+22 ;; Locator 74 of the claim.
+23 ;;
+24 ;;REFERRING: UB-04, CMS-1500, or J430D SITUATIONAL
+25 ;; The provider who referred the patient for the services being billed.
+26 ;;
+27 ;;SUPERVISING: CMS-1500 OPTIONAL or J430D SITUATIONAL
+28 ;; Required when the rendering provider is supervised
+29 ;; by another provider. Data will not be printed.
+30 ;;
+31 ;;OTHER OPERATING: UB-04 SITUATIONAL
+32 ;; Used to report another Operating Physician. There must
+33 ;; also be an Operating Physician on the claim.
+34 ;;
+35 ;;ASSISTANT SURGEON: J430D SITUATIONAL
+36 ;; Use when the Rendering Provider provided these services in the role
+37 ;; of the Assisting Surgeon.
+38 ;;
+39 ;; There are providers who performed specific functions for
+40 ;; the services on this bill. These providers are needed to
+41 ;; enable the V.A. to collect reimbursement when more than
+42 ;; one provider function is involved in the billable episode
+43 ;; (like an operating physician or referring provider).
+44 ;;
+45 ;; This data identifies the type of function that was performed
+46 ;; by a provider.
+47 ;;
+48 ;
LINKRX(IBIFN,IBREV) ; Ask for revenue code's RX if not already there
+1 NEW DIR,X,Y,IBZ,IBRX,Z,Z0,DA
+2 if $PIECE($GET(^DGCR(399,IBIFN,"RC",IBREV,0)),U,11)!($PIECE($GET(^(0)),U,10)'=3)
QUIT
+3 SET Z=0
FOR
SET Z=$ORDER(^DGCR(399,IBIFN,"RC",Z))
if 'Z
QUIT
IF Z'=IBREV
SET Z0=$GET(^(Z,0))
IF $PIECE(Z0,U,10)=3
IF $PIECE(Z0,U,11)
SET IBRX(+$PIECE(Z0,U,11))=""
+4 SET DIR(0)="PAO^IBA(362.4,:AEMQ"
SET DIR("S")="I $P(^(0),U,2)=IBIFN,'$D(IBRX(+Y))"
+5 SET DIR("A")="Select Rx for this charge: "
+6 SET DIR("?",1)="Enter an Rx# for this revenue code"
+7 SET DIR("?")=" The Rx must not already have an associated revenue code"
+8 DO ^DIR
KILL DIR
+9 IF Y>0
Begin DoDot:1
+10 SET DA(1)=IBIFN
SET DA=IBREV
SET IBZ=""
+11 DO FDA^DILF(399.042,.DA,.11,"R",+Y,"IBZ")
+12 DO FILE^DIE(,"IBZ")
End DoDot:1
+13 QUIT
+14 ;
LINKCPT(IBIFN,IBREV) ; Ask for revenue code's CPT
+1 NEW DIR,X,Y,IBZ,IBCP,Z,Z0,Z1,DA,IBRC,IBP
+2 SET IBRC=$GET(^DGCR(399,IBIFN,"RC",IBREV,0))
+3 if $PIECE(IBRC,U,8)!($PIECE(IBRC,U,10)'=4)
QUIT
+4 SET IBP=+$PIECE(IBRC,U,6)
+5 IF $PIECE(IBRC,U,11)
WRITE !,"PROCEDURE #"_$PIECE(IBRC,U,11)_" HAS BEEN ASSOCIATED WITH THIS MANUAL CHARGE"
+6 IF '$PIECE(IBRC,U,11)
Begin DoDot:1
+7 SET DIR("?",1)="Respond YES if this revenue code charge specifically references the data for"
+8 SET DIR("?",2)=" a particular procedure that was manually entered on the previous screen."
+9 SET DIR("?",3)=" For outpatient UB-04 bills, associating a manual revenue code charge with"
SET DIR("?")=" a procedure is the only way to print a modifier in box 44"
+10 SET DIR(0)="YA"
SET DIR("A")="SHOULD A PROCEDURE ENTRY BE ASSOCIATED WITH THIS CHARGE?: "
SET DIR("B")=$SELECT(IBP:"YES",1:"NO")
WRITE !
DO ^DIR
KILL DIR
WRITE !
+11 IF Y'=1
SET IBRC=""
QUIT
End DoDot:1
if IBRC=""
QUIT
+12 IF $PIECE(IBRC,U,11)
Begin DoDot:1
+13 SET DIR("?",1)="Respond YES if you no longer want this revenue code charge to reference a"
SET DIR("?")=" specific manually entered procedure"
+14 SET DIR(0)="YA"
SET DIR("A")="DELETE THE EXISTING PROCEDURE ASSOCIATION?: "
SET DIR("B")="NO"
WRITE !
DO ^DIR
KILL DIR
+15 IF Y=1
DO UPDPTR(IBIFN,IBREV,"")
SET $PIECE(IBRC,U,11)=""
End DoDot:1
+16 SET Z=0
FOR
SET Z=$ORDER(^DGCR(399,IBIFN,"RC",Z))
if 'Z
QUIT
SET Z0=$GET(^(Z,0))
IF IBREV'=Z
IF $PIECE(Z0,U,11)
Begin DoDot:1
+17 ; Don't allow to link to 'used' proc
+18 IF $PIECE(Z0,U,10)=4
SET IBCP($PIECE(Z0,U,11))=""
QUIT
+19 IF $PIECE(Z0,U,10)=3
IF $PIECE(Z0,U,15)
SET IBCP($PIECE(Z0,U,15))=""
End DoDot:1
+20 SET DIR(0)="PAO^DGCR(399,"_IBIFN_",""CP"",:AEMQ"
SET DIR("S")="I '$D(IBCP(+Y)),$P(^(0),U)[""CPT"",+^(0)="_+$PIECE($GET(^DGCR(399,IBIFN,"RC",IBREV,0)),U,6)
+21 SET DIR("A")="SELECT A PROCEDURE ENTRY: "_$SELECT($PIECE(IBRC,U,11):"#"_$PIECE(IBRC,U,11)_" - "_$$EXPAND^IBTRE(399.0304,.01,$PIECE($GET(^DGCR(399,IBIFN,"CP",$PIECE(IBRC,U,11),0)),U))_"// ",1:"")
+22 SET DIR("?")="Enter a manually-added CPT procedure to associate with this charge"
+23 SET DA(1)=IBIFN
+24 DO ^DIR
KILL DIR
WRITE !
+25 IF Y>0
DO UPDPTR(IBIFN,IBREV,+Y)
+26 QUIT
+27 ;
UPDPTR(IBIFN,IBREV,Y) ;
+1 NEW IBZ,DA
+2 SET DA(1)=IBIFN
SET DA=IBREV
SET IBZ=""
+3 DO FDA^DILF(399.042,.DA,.11,"R",$SELECT(Y:+Y,1:""),"IBZ")
+4 DO FILE^DIE(,"IBZ")
+5 QUIT
+6 ;
INSFT(IBIFN) ; Returns 1 if form type is UB-04, 0 if CMS-1500 or J430D
+1 QUIT ($$FT^IBCEF(IBIFN)=3)
