IBCNSU3 ;ALB/TMP - Functions for billing decisions; 08-AUG-95
;;2.0;INTEGRATED BILLING;**43,80,592**;21-MAR-94;Build 58
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
PTCOV(DFN,IBVDT,IBCAT,ANYINS,INSONBIL) ; Determine if patient is covered for coverage category on a visit dt
; Function returns 1 if covered, 0 if not covered
; DFN - ifn of patient (req)
; IBVDT - fileman format visit date (req)
; IBCAT - entry in file 355.31 limitation of coverage category (req)
; ANYINS - optional parameter, but if passed by reference, returns 0 if
; no active insurance at all and 1 if any active insurance found
; INSONBIL - this is an array of insurances on the bill. if it is sent, only those insurances will be checked.
; INSONBIL(INS CO IEN)=""
;
N IBCOV,IBDD,PLAN,POLCY
S (IBCOV,ANYINS)=0
I $G(DFN)=""!($G(IBCAT)="")!($G(IBVDT)="") G PTCOVQ ; Required fields not present
S IBCAT=$O(^IBE(355.31,"B",IBCAT,"")) G:IBCAT="" PTCOVQ
S IBVDT=IBVDT\1
D ALL^IBCNS1(DFN,"IBDD",1,IBVDT) ;All active ins policies returned in IBDD array
S ANYINS=($O(IBDD(0))'="") ;Set flag for any active insurance found
S POLCY=0 F S POLCY=$O(IBDD(POLCY)) Q:'POLCY D Q:IBCOV
.S PLAN=$P($G(IBDD(POLCY,0)),U,18) Q:PLAN=""
.I $D(INSONBIL)>9,'$D(INSONBIL(+$P(IBDD(POLCY,0),U))) Q ; WCJ;IB592;I only want to check specific insurances that are on a bill/claim
.S IBCOV=$$PLCOV(PLAN,IBVDT,IBCAT)
.I 'IBCOV,$D(^IBA(355.7,"APP",DFN,POLCY,+$P($G(^IBE(355.31,+IBCAT,0)),U,3)))'=0 S IBCOV=1
PTCOVQ Q IBCOV
;
PLCOV(IBPL,IBVDT,IBCAT,COMMENT) ; Determine if a specific plan covers a category of coverage as of a date and returns comments
; IBPL - pointer to file 355.3 group insurance plan (req)
; IBVDT - fileman format visit date (req)
; IBCAT - pointer to file 355.31 limitation of coverage category (req)
; COMMENT - if passed by reference and the coverage is conditional will contain limitation comments
N CATLIM,X,Y K COMMENT
S CATLIM=$O(^IBA(355.32,"APCD",IBPL,IBCAT,+$O(^IBA(355.32,"APCD",IBPL,IBCAT,-(IBVDT+1))),""))
S X=$S(CATLIM="":1,1:+$P($G(^IBA(355.32,CATLIM,0)),U,4))
I X>1 S COMMENT=CATLIM,Y=0 F S Y=$O(^IBA(355.32,CATLIM,2,Y)) Q:'Y S COMMENT(Y)=$G(^IBA(355.32,CATLIM,2,Y,0))
Q X
;
RIDERS(DFN,IBCDFN,RIDERS) ; Returns all Riders (355.7) associated with a patient's policy in array if RIDERS is passed by reference
N Y K RIDERS
I +$G(DFN),+$G(IBCDFN) S Y=0 F S Y=$O(^IBA(355.7,"APP",DFN,IBCDFN,Y)) Q:'Y S RIDERS(Y)=$P($G(^IBE(355.6,Y,0)),U,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNSU3 2544 printed Dec 13, 2024@02:17:59 Page 2
IBCNSU3 ;ALB/TMP - Functions for billing decisions; 08-AUG-95
+1 ;;2.0;INTEGRATED BILLING;**43,80,592**;21-MAR-94;Build 58
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
PTCOV(DFN,IBVDT,IBCAT,ANYINS,INSONBIL) ; Determine if patient is covered for coverage category on a visit dt
+1 ; Function returns 1 if covered, 0 if not covered
+2 ; DFN - ifn of patient (req)
+3 ; IBVDT - fileman format visit date (req)
+4 ; IBCAT - entry in file 355.31 limitation of coverage category (req)
+5 ; ANYINS - optional parameter, but if passed by reference, returns 0 if
+6 ; no active insurance at all and 1 if any active insurance found
+7 ; INSONBIL - this is an array of insurances on the bill. if it is sent, only those insurances will be checked.
+8 ; INSONBIL(INS CO IEN)=""
+9 ;
+10 NEW IBCOV,IBDD,PLAN,POLCY
+11 SET (IBCOV,ANYINS)=0
+12 ; Required fields not present
IF $GET(DFN)=""!($GET(IBCAT)="")!($GET(IBVDT)="")
GOTO PTCOVQ
+13 SET IBCAT=$ORDER(^IBE(355.31,"B",IBCAT,""))
if IBCAT=""
GOTO PTCOVQ
+14 SET IBVDT=IBVDT\1
+15 ;All active ins policies returned in IBDD array
DO ALL^IBCNS1(DFN,"IBDD",1,IBVDT)
+16 ;Set flag for any active insurance found
SET ANYINS=($ORDER(IBDD(0))'="")
+17 SET POLCY=0
FOR
SET POLCY=$ORDER(IBDD(POLCY))
if 'POLCY
QUIT
Begin DoDot:1
+18 SET PLAN=$PIECE($GET(IBDD(POLCY,0)),U,18)
if PLAN=""
QUIT
+19 ; WCJ;IB592;I only want to check specific insurances that are on a bill/claim
IF $DATA(INSONBIL)>9
IF '$DATA(INSONBIL(+$PIECE(IBDD(POLCY,0),U)))
QUIT
+20 SET IBCOV=$$PLCOV(PLAN,IBVDT,IBCAT)
+21 IF 'IBCOV
IF $DATA(^IBA(355.7,"APP",DFN,POLCY,+$PIECE($GET(^IBE(355.31,+IBCAT,0)),U,3)))'=0
SET IBCOV=1
End DoDot:1
if IBCOV
QUIT
PTCOVQ QUIT IBCOV
+1 ;
PLCOV(IBPL,IBVDT,IBCAT,COMMENT) ; Determine if a specific plan covers a category of coverage as of a date and returns comments
+1 ; IBPL - pointer to file 355.3 group insurance plan (req)
+2 ; IBVDT - fileman format visit date (req)
+3 ; IBCAT - pointer to file 355.31 limitation of coverage category (req)
+4 ; COMMENT - if passed by reference and the coverage is conditional will contain limitation comments
+5 NEW CATLIM,X,Y
KILL COMMENT
+6 SET CATLIM=$ORDER(^IBA(355.32,"APCD",IBPL,IBCAT,+$ORDER(^IBA(355.32,"APCD",IBPL,IBCAT,-(IBVDT+1))),""))
+7 SET X=$SELECT(CATLIM="":1,1:+$PIECE($GET(^IBA(355.32,CATLIM,0)),U,4))
+8 IF X>1
SET COMMENT=CATLIM
SET Y=0
FOR
SET Y=$ORDER(^IBA(355.32,CATLIM,2,Y))
if 'Y
QUIT
SET COMMENT(Y)=$GET(^IBA(355.32,CATLIM,2,Y,0))
+9 QUIT X
+10 ;
RIDERS(DFN,IBCDFN,RIDERS) ; Returns all Riders (355.7) associated with a patient's policy in array if RIDERS is passed by reference
+1 NEW Y
KILL RIDERS
+2 IF +$GET(DFN)
IF +$GET(IBCDFN)
SET Y=0
FOR
SET Y=$ORDER(^IBA(355.7,"APP",DFN,IBCDFN,Y))
if 'Y
QUIT
SET RIDERS(Y)=$PIECE($GET(^IBE(355.6,Y,0)),U,1)
+3 QUIT
