IBCSC10 ;ALB/MJB - MCCR SCREEN 10 (UB-82 BILL SPECIFIC INFO) ;27 MAY 88 10:20
;;2.0;INTEGRATED BILLING;**432,547,574,592,759**;21-MAR-94;Build 24
;;Per VA Directive 6402, this routine should not be modified.
;
;MAP TO DGCRSC8
;
; DEM;432 - Moved IBCSC8* billing screen routines to IBCSC10* billing screen
; routines and created a new billing screen 8 routine IBCSC8.
;
;JWS;IB*2.0*592 US1108 - Dental form 7
EN S IBCUBFT=$$FT^IBCU3(IBIFN) I IBCUBFT=2!(IBCUBFT=7) K IBCUBFT G ^IBCSC10H ; hcfa 1500 ;JWS 3/6/17 Dental Form
I IBCUBFT=3 K IBCUBFT G ^IBCSC102 ; ub-92
;I $P(^DGCR(399,IBIFN,0),"^",19)=2 G ^IBCSC10H ;hcfa 1500
D ^IBCSCU S IBSR=10,IBSR1="",IBV1="000000000" S:IBV IBV1="111111111" F I="U","U1",0 S IB(I)=$S($D(^DGCR(399,IBIFN,I)):^(I),1:"")
D H^IBCSCU
S Z=1,IBW=1 X IBWW W " Bill Remark : ",$S($P(IB("U1"),U,8)]"":$P(IB("U1"),U,8),1:IBUN)
S IBX="^^^2^9^27^45" F I=4:1:7 S Z=(I-2),IBW=1 X IBWW W " Form Locator ",$P(IBX,U,I),$S($E($P(IBX,U,I),2)="":" : ",1:": "),$S($P(IB("U1"),U,I)]"":$P(IB("U1"),U,I),1:IBUN)
S IBX=91 F I=13,14 S Z=(I-7),IBW=1,IBX=IBX+1 X IBWW W " Form Locator ",IBX,": ",$S($P(IB("U1"),U,I)]"":$P(IB("U1"),U,I),1:IBUN)
S Z=8,IBW=1 X IBWW W " Tx Auth. Code : ",$S($P(IB("U"),U,13)]"":$P(IB("U"),U,13),1:IBUN)
G ^IBCSCP
Q Q
;
;WCJ;IB*2.0*547
ACINTEL(IBINSDAT,IBNEXT) ; build some intelligence in this Alternate ID branching logic called from both screen 10 templates.
;
; assumes IBIFN = the ien to file 399
;
; Input:
; IBINSDAT - INS DATA node
; IBNEXT - where to branch if not correct plan
;
; Returns - where to branch to
; kind of misleading. It either changes IBNEXT to null or leaves it alone.
; Assumes calling routine knew where to branch to if it failed
;
N IBPLAN,IBEPT,IBINSPRF
S IBPLAN=$P(IBINSDAT,U,18)
I IBPLAN="" Q IBNEXT
S IBPLAN=$G(^IBA(355.3,+IBPLAN,0))
I IBPLAN="" Q IBNEXT
S IBEPT=$P(IBPLAN,U,15)
I IBEPT="" Q IBNEXT
I IBEPT="MX" Q:'$D(^IBE(350.9,1,81,"B")) IBNEXT ; no medicare set up in site parameters
I IBEPT'="MX" Q:'$D(^IBE(350.9,1,82,"B")) IBNEXT ; no commercial set up in site parameters
;
; Use form type not charge type 09/07/2016
;S IBINSPRF=$$INSPRF^IBCEF(IBIFN)
S IBINSPRF=$$FT^IBCEF(+IBIFN)=3 ; set IBINST flag=1 if it is institutional,0 for professional.
;
; Institutional
I IBINSPRF=1 Q:'$D(^DIC(36,+IBINSDAT,15,"B")) IBNEXT ; this insurance company has no institutional set up
;
; Professional
I IBINSPRF=0 Q:'$D(^DIC(36,+IBINSDAT,16,"B")) IBNEXT ; this insurance company has no professional set up
;
; now it gets complicated :)
; there needs to be one set up for this form type in the ins comp file
; and also set up for medicare/commercial in the site parameter file
N IBTMPINS,IBTMPSP,IBLOOP,IBFOUND
M IBTMPINS=^DIC(36,+IBINSDAT,$S(IBINSPRF=1:15,1:16),"B")
M IBTMPSP=^IBE(350.9,1,$S(IBEPT="MX":81,1:82),"B")
S IBLOOP="",IBFOUND=0
F S IBLOOP=$O(IBTMPINS(IBLOOP)) Q:IBLOOP="" D Q:IBFOUND
. Q:'$D(IBTMPSP(IBLOOP))
. S IBFOUND=1
I IBFOUND Q ""
Q IBNEXT
;
;WCJ;IB759
BBB(IBIFN) ; aka Baby Bird Beaks
; this is an API to tell if any insurer on the claim has Alternate Payer IDs properly defined.
; If not, it returns a 0 and the section of the billing screen is uneditable
; which shows as <#> to the biller
;
; Input:
; IBIFN - Internalk Entry Number to file 399
;
; Returns 1 or 0, yay or nay
N IBDATA,IBRESULT,IBLOOP,IBX
S IBRESULT=0
F IBLOOP=1:1:3 S IBDATA=$G(^DGCR(399,IBIFN,"I"_IBLOOP)) I IBDATA]"" S IBX=$$ACINTEL(IBDATA,"@WHATEVER") I IBX'="@WHATEVER" S IBRESULT=1 Q
Q IBRESULT
;
;IBCSC10
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCSC10 3650 printed Sep 02, 2024@19:05:17 Page 2
IBCSC10 ;ALB/MJB - MCCR SCREEN 10 (UB-82 BILL SPECIFIC INFO) ;27 MAY 88 10:20
+1 ;;2.0;INTEGRATED BILLING;**432,547,574,592,759**;21-MAR-94;Build 24
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRSC8
+5 ;
+6 ; DEM;432 - Moved IBCSC8* billing screen routines to IBCSC10* billing screen
+7 ; routines and created a new billing screen 8 routine IBCSC8.
+8 ;
+9 ;JWS;IB*2.0*592 US1108 - Dental form 7
EN ; hcfa 1500 ;JWS 3/6/17 Dental Form
SET IBCUBFT=$$FT^IBCU3(IBIFN)
IF IBCUBFT=2!(IBCUBFT=7)
KILL IBCUBFT
GOTO ^IBCSC10H
+1 ; ub-92
IF IBCUBFT=3
KILL IBCUBFT
GOTO ^IBCSC102
+2 ;I $P(^DGCR(399,IBIFN,0),"^",19)=2 G ^IBCSC10H ;hcfa 1500
+3 DO ^IBCSCU
SET IBSR=10
SET IBSR1=""
SET IBV1="000000000"
if IBV
SET IBV1="111111111"
FOR I="U","U1",0
SET IB(I)=$SELECT($DATA(^DGCR(399,IBIFN,I)):^(I),1:"")
+4 DO H^IBCSCU
+5 SET Z=1
SET IBW=1
XECUTE IBWW
WRITE " Bill Remark : ",$SELECT($PIECE(IB("U1"),U,8)]"":$PIECE(IB("U1"),U,8),1:IBUN)
+6 SET IBX="^^^2^9^27^45"
FOR I=4:1:7
SET Z=(I-2)
SET IBW=1
XECUTE IBWW
WRITE " Form Locator ",$PIECE(IBX,U,I),$SELECT($EXTRACT($PIECE(IBX,U,I),2)="":" : ",1:": "),$SELECT($PIECE(IB("U1"),U,I)]"":$PIECE(IB("U1"),U,I),1:IBUN)
+7 SET IBX=91
FOR I=13,14
SET Z=(I-7)
SET IBW=1
SET IBX=IBX+1
XECUTE IBWW
WRITE " Form Locator ",IBX,": ",$SELECT($PIECE(IB("U1"),U,I)]"":$PIECE(IB("U1"),U,I),1:IBUN)
+8 SET Z=8
SET IBW=1
XECUTE IBWW
WRITE " Tx Auth. Code : ",$SELECT($PIECE(IB("U"),U,13)]"":$PIECE(IB("U"),U,13),1:IBUN)
+9 GOTO ^IBCSCP
Q QUIT
+1 ;
+2 ;WCJ;IB*2.0*547
ACINTEL(IBINSDAT,IBNEXT) ; build some intelligence in this Alternate ID branching logic called from both screen 10 templates.
+1 ;
+2 ; assumes IBIFN = the ien to file 399
+3 ;
+4 ; Input:
+5 ; IBINSDAT - INS DATA node
+6 ; IBNEXT - where to branch if not correct plan
+7 ;
+8 ; Returns - where to branch to
+9 ; kind of misleading. It either changes IBNEXT to null or leaves it alone.
+10 ; Assumes calling routine knew where to branch to if it failed
+11 ;
+12 NEW IBPLAN,IBEPT,IBINSPRF
+13 SET IBPLAN=$PIECE(IBINSDAT,U,18)
+14 IF IBPLAN=""
QUIT IBNEXT
+15 SET IBPLAN=$GET(^IBA(355.3,+IBPLAN,0))
+16 IF IBPLAN=""
QUIT IBNEXT
+17 SET IBEPT=$PIECE(IBPLAN,U,15)
+18 IF IBEPT=""
QUIT IBNEXT
+19 ; no medicare set up in site parameters
IF IBEPT="MX"
if '$DATA(^IBE(350.9,1,81,"B"))
QUIT IBNEXT
+20 ; no commercial set up in site parameters
IF IBEPT'="MX"
if '$DATA(^IBE(350.9,1,82,"B"))
QUIT IBNEXT
+21 ;
+22 ; Use form type not charge type 09/07/2016
+23 ;S IBINSPRF=$$INSPRF^IBCEF(IBIFN)
+24 ; set IBINST flag=1 if it is institutional,0 for professional.
SET IBINSPRF=$$FT^IBCEF(+IBIFN)=3
+25 ;
+26 ; Institutional
+27 ; this insurance company has no institutional set up
IF IBINSPRF=1
if '$DATA(^DIC(36,+IBINSDAT,15,"B"))
QUIT IBNEXT
+28 ;
+29 ; Professional
+30 ; this insurance company has no professional set up
IF IBINSPRF=0
if '$DATA(^DIC(36,+IBINSDAT,16,"B"))
QUIT IBNEXT
+31 ;
+32 ; now it gets complicated :)
+33 ; there needs to be one set up for this form type in the ins comp file
+34 ; and also set up for medicare/commercial in the site parameter file
+35 NEW IBTMPINS,IBTMPSP,IBLOOP,IBFOUND
+36 MERGE IBTMPINS=^DIC(36,+IBINSDAT,$SELECT(IBINSPRF=1:15,1:16),"B")
+37 MERGE IBTMPSP=^IBE(350.9,1,$SELECT(IBEPT="MX":81,1:82),"B")
+38 SET IBLOOP=""
SET IBFOUND=0
+39 FOR
SET IBLOOP=$ORDER(IBTMPINS(IBLOOP))
if IBLOOP=""
QUIT
Begin DoDot:1
+40 if '$DATA(IBTMPSP(IBLOOP))
QUIT
+41 SET IBFOUND=1
End DoDot:1
if IBFOUND
QUIT
+42 IF IBFOUND
QUIT ""
+43 QUIT IBNEXT
+44 ;
+45 ;WCJ;IB759
BBB(IBIFN) ; aka Baby Bird Beaks
+1 ; this is an API to tell if any insurer on the claim has Alternate Payer IDs properly defined.
+2 ; If not, it returns a 0 and the section of the billing screen is uneditable
+3 ; which shows as <#> to the biller
+4 ;
+5 ; Input:
+6 ; IBIFN - Internalk Entry Number to file 399
+7 ;
+8 ; Returns 1 or 0, yay or nay
+9 NEW IBDATA,IBRESULT,IBLOOP,IBX
+10 SET IBRESULT=0
+11 FOR IBLOOP=1:1:3
SET IBDATA=$GET(^DGCR(399,IBIFN,"I"_IBLOOP))
IF IBDATA]""
SET IBX=$$ACINTEL(IBDATA,"@WHATEVER")
IF IBX'="@WHATEVER"
SET IBRESULT=1
QUIT
+12 QUIT IBRESULT
+13 ;
+14 ;IBCSC10