IBRUTL ;ALB/CPM-INTEGRATED BILLING - A/R INTERFACE UTILITIES ;03-MAR-92
;;2.0;INTEGRATED BILLING;**70,82,132,142,176,179,202,223,363,554**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
;
IB(IEN,RETN) ; Are there any IB Actions on hold for this bill?
; Input: IEN -- ien of Bill(#399), A/R(#430)
; RETN (opt) -- Want array of IB Actions? (1-Yes,0-No)
; if yes, returns IBA(num)=ibn
; Returns: 1 -- Yes, 0 -- No
;
N ATYPE,BTYPE,BILLS,DFN,IBFR,IB0,IBTO,IBU,IBN,IBND,IBNUM,IBOK
S:'$D(RETN) RETN=0 S BILLS=0
;
; - determine patient, bill type and billing dates
S IB0=$G(^DGCR(399,IEN,0)),IBU=$G(^("U")),DFN=+$P(IB0,"^",2)
S BTYPE=$S(+$P(IB0,"^",5)<3:"I",1:"O"),IBFR=+IBU,IBTO=$P(IBU,"^",2)
;
; - loop through all bills on hold, and set flag if there is an
; - IB Action of the same type as the UB-82 which has been billed
; - within the statement dates of the UB-82. Store all actions
; - in the array IBA if required.
S (IBN,IBNUM)=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN D I IBOK Q:'RETN S IBNUM=IBNUM+1,IBA(IBNUM)=IBN
. S IBOK=0,IBND=$G(^IB(IBN,0)) Q:'IBND
. S ATYPE=$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["OPT":"O",1:"I") Q:ATYPE'=BTYPE
. Q:$P(IBND,"^",15)<IBFR!($P(IBND,"^",14)>IBTO) S (IBOK,BILLS)=1
;
Q BILLS
;
;
HOLD(X,IBN,IBDUZ,IBSEQNO) ; Place IB Action on hold?
; Input: X -- Zeroth node of IB Action
; IBN -- ien of IB Action
; IBDUZ -- User ID
; IBSEQNO -- 1 (New Action), 3 (Update Action)
; Returns: 1 -- Yes, 0 -- No
;
N DFN,IBCOV,IBINDT,IBOUTP,HOLD,IBHOLDP,IBDUZ,I,INS,BUF
N IBVDT,IBAT,IBCAT,IBALTC,TRICHP,J,XX,TYPNAM,COV,RCOV
;
S (HOLD,COV,TRICHP,J)=0
S IBHOLDP=$P($G(^IBE(350.9,1,1)),"^",20) ; Site parameter - HOLD MT BILLS W/INSURANCE
S DFN=+$P(X,"^",2)
;
;check if ECME RX copay needs to be placed on HOLD
I $$HOLDECME^IBNCPUT1(X)=0 G HOLDQ
;
I $P(X,"^",5)=8 G HOLDQ ; action is already on hold
I '$P($G(^IBE(350.1,+$P(X,"^",3),0)),"^",10) G HOLDQ ; action can't be placed on hold
;
; - see if patient has insurance on Charge 'To' Date (otherwise Event date)
; - includes check of plan coverage limitation
S IBINDT=+$P($G(^IB(+$G(IBN),0)),U,15)
I 'IBINDT S IBINDT=+$P($G(^IB(+$P(X,"^",16),0)),"^",17) I 'IBINDT S IBINDT=DT
S IBOUTP=1
D ^IBCNS
;
; IB*2.0*554 - baa
;When placing charges On Hold added check so if only insurance for the
;patient is Tricare or CHAMPVA the charge is Not placed On Hold.
;Previously if the patient had any active insurance the charge was placed On Hold.
I IBINS D
. N XX
. S (J,TRICHP,COV)=0
. S XX=0 F S XX=$O(IBDD(XX)) Q:XX="" D
.. S INS=+XX_","
.. S RCOV=$$GET1^DIQ(36,INS,1,"I") S RCOV=$S(RCOV="N":0,1:1)
.. S TYPNAM=$$GET1^DIQ(36,INS,.13,"E"),J=J+1
.. I TYPNAM'["TRICARE",TYPNAM'["CHAMPVA",RCOV,'COV S COV=$$IBCOV(XX)
.. S:TYPNAM["TRICARE" TRICHP=1 S:TYPNAM["CHAMPVA" TRICHP=1
;
S BUF=$$BUFFER^IBCNBU1(DFN)
I $G(J)=1,TRICHP S (IBCOV,HOLD)=0 G HOLDQ ; don't place on hold if only has TRICARE OR CHAMPVA
I $G(J)>1,TRICHP I 'COV,'BUF S (IBCOV,HOLD)=0 G HOLDQ ; don't place on hold if no cov & no buffer entry.
I 'TRICHP,'COV,'BUF S (IBCOV,HOLD)=0 G HOLDQ ; don't place on hold if no tricare and no coverage and no buffer entry
; IB*2.0*544 - baa
;
S IBVDT=$S(IBINDT'="":IBINDT,1:DT),IBAT=$P(^IBE(350.1,(+$P(X,U,3)),0),U,11)
S IBCAT=$S(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
S IBCOV="" I IBCAT'="" S IBCOV=$$PTCOV^IBCNSU3(DFN,IBVDT,IBCAT),HOLD=IBCOV
I 'IBCOV,+$$BUFFER^IBCNBU1(DFN) S (IBCOV,HOLD)=1 ; if patient has a buffer entry place charge on hold
;
; - generate bulletin if patient has insurance, bulletin not suppressed
I IBCOV,'$P($G(^IBE(350.9,1,0)),"^",15),'$$ECME(IBN) D ^IBRBUL
;
; - update action to 'Hold' if parameter is set and vet has insurance
I IBHOLDP,IBCOV S DIE="^IB(",DA=IBN,DR=".05////8" D ^DIE,UP3^IBR:IBSEQNO=3 K DA,DIE,DR
;
HOLDQ Q +$G(HOLD)
;
ECME(IBN) ; return 1 if ECME billed already and bulleting should not go
N IBX,IBR,IBZ
S (IBR,IBX)=0,IBZ=^IB(IBN,0)
F S IBX=$O(^IBA(362.4,"B",$P($P(IBZ,"^",8),"-"),IBX)) Q:'IBX!(IBR) I $P($G(^DGCR(399,+$P(^IBA(362.4,IBX,0),"^",2),0)),"^",13)=4,$$FMDIFF^XLFDT($P(IBZ,"^",17),$P(^(0),"^",3),1)<6 S IBR=1
Q IBR
;
IBCOV(POLCY) ; Check for coverage only on non CHAMPVA and TRICARE ins
N IBVDT,IBAT,IBCAT,PLAN,CATLIM
S IBVDT=$S(IBINDT'="":IBINDT,1:DT),IBAT=$P(^IBE(350.1,(+$P(X,U,3)),0),U,11)
S IBCAT=$S(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
S IBCAT=$O(^IBE(355.31,"B",IBCAT,""))
S PLAN=$P($G(IBDD(POLCY)),U,18)
I PLAN="" Q 0
S IBCOV=$$PLCOV^IBCNSU3(PLAN,IBVDT,IBCAT)
Q IBCOV
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBRUTL 4927 printed Dec 13, 2024@02:26:59 Page 2
IBRUTL ;ALB/CPM-INTEGRATED BILLING - A/R INTERFACE UTILITIES ;03-MAR-92
+1 ;;2.0;INTEGRATED BILLING;**70,82,132,142,176,179,202,223,363,554**;21-MAR-94;Build 81
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
IB(IEN,RETN) ; Are there any IB Actions on hold for this bill?
+1 ; Input: IEN -- ien of Bill(#399), A/R(#430)
+2 ; RETN (opt) -- Want array of IB Actions? (1-Yes,0-No)
+3 ; if yes, returns IBA(num)=ibn
+4 ; Returns: 1 -- Yes, 0 -- No
+5 ;
+6 NEW ATYPE,BTYPE,BILLS,DFN,IBFR,IB0,IBTO,IBU,IBN,IBND,IBNUM,IBOK
+7 if '$DATA(RETN)
SET RETN=0
SET BILLS=0
+8 ;
+9 ; - determine patient, bill type and billing dates
+10 SET IB0=$GET(^DGCR(399,IEN,0))
SET IBU=$GET(^("U"))
SET DFN=+$PIECE(IB0,"^",2)
+11 SET BTYPE=$SELECT(+$PIECE(IB0,"^",5)<3:"I",1:"O")
SET IBFR=+IBU
SET IBTO=$PIECE(IBU,"^",2)
+12 ;
+13 ; - loop through all bills on hold, and set flag if there is an
+14 ; - IB Action of the same type as the UB-82 which has been billed
+15 ; - within the statement dates of the UB-82. Store all actions
+16 ; - in the array IBA if required.
+17 SET (IBN,IBNUM)=0
FOR
SET IBN=$ORDER(^IB("AH",DFN,IBN))
if 'IBN
QUIT
Begin DoDot:1
+18 SET IBOK=0
SET IBND=$GET(^IB(IBN,0))
if 'IBND
QUIT
+19 SET ATYPE=$SELECT($PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")["OPT":"O",1:"I")
if ATYPE'=BTYPE
QUIT
+20 if $PIECE(IBND,"^",15)<IBFR!($PIECE(IBND,"^",14)>IBTO)
QUIT
SET (IBOK,BILLS)=1
End DoDot:1
IF IBOK
if 'RETN
QUIT
SET IBNUM=IBNUM+1
SET IBA(IBNUM)=IBN
+21 ;
+22 QUIT BILLS
+23 ;
+24 ;
HOLD(X,IBN,IBDUZ,IBSEQNO) ; Place IB Action on hold?
+1 ; Input: X -- Zeroth node of IB Action
+2 ; IBN -- ien of IB Action
+3 ; IBDUZ -- User ID
+4 ; IBSEQNO -- 1 (New Action), 3 (Update Action)
+5 ; Returns: 1 -- Yes, 0 -- No
+6 ;
+7 NEW DFN,IBCOV,IBINDT,IBOUTP,HOLD,IBHOLDP,IBDUZ,I,INS,BUF
+8 NEW IBVDT,IBAT,IBCAT,IBALTC,TRICHP,J,XX,TYPNAM,COV,RCOV
+9 ;
+10 SET (HOLD,COV,TRICHP,J)=0
+11 ; Site parameter - HOLD MT BILLS W/INSURANCE
SET IBHOLDP=$PIECE($GET(^IBE(350.9,1,1)),"^",20)
+12 SET DFN=+$PIECE(X,"^",2)
+13 ;
+14 ;check if ECME RX copay needs to be placed on HOLD
+15 IF $$HOLDECME^IBNCPUT1(X)=0
GOTO HOLDQ
+16 ;
+17 ; action is already on hold
IF $PIECE(X,"^",5)=8
GOTO HOLDQ
+18 ; action can't be placed on hold
IF '$PIECE($GET(^IBE(350.1,+$PIECE(X,"^",3),0)),"^",10)
GOTO HOLDQ
+19 ;
+20 ; - see if patient has insurance on Charge 'To' Date (otherwise Event date)
+21 ; - includes check of plan coverage limitation
+22 SET IBINDT=+$PIECE($GET(^IB(+$GET(IBN),0)),U,15)
+23 IF 'IBINDT
SET IBINDT=+$PIECE($GET(^IB(+$PIECE(X,"^",16),0)),"^",17)
IF 'IBINDT
SET IBINDT=DT
+24 SET IBOUTP=1
+25 DO ^IBCNS
+26 ;
+27 ; IB*2.0*554 - baa
+28 ;When placing charges On Hold added check so if only insurance for the
+29 ;patient is Tricare or CHAMPVA the charge is Not placed On Hold.
+30 ;Previously if the patient had any active insurance the charge was placed On Hold.
+31 IF IBINS
Begin DoDot:1
+32 NEW XX
+33 SET (J,TRICHP,COV)=0
+34 SET XX=0
FOR
SET XX=$ORDER(IBDD(XX))
if XX=""
QUIT
Begin DoDot:2
+35 SET INS=+XX_","
+36 SET RCOV=$$GET1^DIQ(36,INS,1,"I")
SET RCOV=$SELECT(RCOV="N":0,1:1)
+37 SET TYPNAM=$$GET1^DIQ(36,INS,.13,"E")
SET J=J+1
+38 IF TYPNAM'["TRICARE"
IF TYPNAM'["CHAMPVA"
IF RCOV
IF 'COV
SET COV=$$IBCOV(XX)
+39 if TYPNAM["TRICARE"
SET TRICHP=1
if TYPNAM["CHAMPVA"
SET TRICHP=1
End DoDot:2
End DoDot:1
+40 ;
+41 SET BUF=$$BUFFER^IBCNBU1(DFN)
+42 ; don't place on hold if only has TRICARE OR CHAMPVA
IF $GET(J)=1
IF TRICHP
SET (IBCOV,HOLD)=0
GOTO HOLDQ
+43 ; don't place on hold if no cov & no buffer entry.
IF $GET(J)>1
IF TRICHP
IF 'COV
IF 'BUF
SET (IBCOV,HOLD)=0
GOTO HOLDQ
+44 ; don't place on hold if no tricare and no coverage and no buffer entry
IF 'TRICHP
IF 'COV
IF 'BUF
SET (IBCOV,HOLD)=0
GOTO HOLDQ
+45 ; IB*2.0*544 - baa
+46 ;
+47 SET IBVDT=$SELECT(IBINDT'="":IBINDT,1:DT)
SET IBAT=$PIECE(^IBE(350.1,(+$PIECE(X,U,3)),0),U,11)
+48 SET IBCAT=$SELECT(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
+49 SET IBCOV=""
IF IBCAT'=""
SET IBCOV=$$PTCOV^IBCNSU3(DFN,IBVDT,IBCAT)
SET HOLD=IBCOV
+50 ; if patient has a buffer entry place charge on hold
IF 'IBCOV
IF +$$BUFFER^IBCNBU1(DFN)
SET (IBCOV,HOLD)=1
+51 ;
+52 ; - generate bulletin if patient has insurance, bulletin not suppressed
+53 IF IBCOV
IF '$PIECE($GET(^IBE(350.9,1,0)),"^",15)
IF '$$ECME(IBN)
DO ^IBRBUL
+54 ;
+55 ; - update action to 'Hold' if parameter is set and vet has insurance
+56 IF IBHOLDP
IF IBCOV
SET DIE="^IB("
SET DA=IBN
SET DR=".05////8"
DO ^DIE
if IBSEQNO=3
DO UP3^IBR
KILL DA,DIE,DR
+57 ;
HOLDQ QUIT +$GET(HOLD)
+1 ;
ECME(IBN) ; return 1 if ECME billed already and bulleting should not go
+1 NEW IBX,IBR,IBZ
+2 SET (IBR,IBX)=0
SET IBZ=^IB(IBN,0)
+3 FOR
SET IBX=$ORDER(^IBA(362.4,"B",$PIECE($PIECE(IBZ,"^",8),"-"),IBX))
if 'IBX!(IBR)
QUIT
IF $PIECE($GET(^DGCR(399,+$PIECE(^IBA(362.4,IBX,0),"^",2),0)),"^",13)=4
IF $$FMDIFF^XLFDT($PIECE(IBZ,"^",17),$PIECE(^(0),"^",3),1)<6
SET IBR=1
+4 QUIT IBR
+5 ;
IBCOV(POLCY) ; Check for coverage only on non CHAMPVA and TRICARE ins
+1 NEW IBVDT,IBAT,IBCAT,PLAN,CATLIM
+2 SET IBVDT=$SELECT(IBINDT'="":IBINDT,1:DT)
SET IBAT=$PIECE(^IBE(350.1,(+$PIECE(X,U,3)),0),U,11)
+3 SET IBCAT=$SELECT(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
+4 SET IBCAT=$ORDER(^IBE(355.31,"B",IBCAT,""))
+5 SET PLAN=$PIECE($GET(IBDD(POLCY)),U,18)
+6 IF PLAN=""
QUIT 0
+7 SET IBCOV=$$PLCOV^IBCNSU3(PLAN,IBVDT,IBCAT)
+8 QUIT IBCOV
