Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNS1

IBCNS1.m

Go to the documentation of this file.
  1. IBCNS1 ;ALB/AAS - INSURANCE MANAGEMENT SUPPORTED FUNCTIONS ;22-JULY-91
  1. ;;2.0;INTEGRATED BILLING;**28,60,52,85,107,51,137,240,371,516**;21-MAR-94;Build 123
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. INSURED(DFN,IBINDT) ; -- Is patient insured
  1. ; --Input DFN = patient
  1. ; IBINDT = (optional) date insured (default = today)
  1. ; -- Output = 0 - not insured
  1. ; = 1 - insured
  1. ;
  1. N J,X,IBINS S IBINS=0,J=0
  1. I '$G(DFN) G INSQ
  1. I '$G(IBINDT) S IBINDT=DT
  1. F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) S IBINS=$$CHK(X,IBINDT) Q:IBINS
  1. INSQ Q IBINS
  1. ;
  1. PRE(DFN,IBINDT) ; -- is pre-certification required for patient
  1. N X,Y,J,IBPRE
  1. S IBPRE=0,J=0
  1. S:'$G(IBINDT) IBINDT=DT
  1. F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) I $$CHK(X,IBINDT),$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",6) S IBPRE=1 Q
  1. PREQ Q IBPRE
  1. ;
  1. UR(DFN,IBINDT) ; -- is ur required for patient
  1. N X,Y,J,IBPRE
  1. S IBUR=0,J=0
  1. S:'$G(IBINDT) IBINDT=DT
  1. F S J=$O(^DPT(DFN,.312,J)) Q:'J S X=$G(^(J,0)) I $$CHK(X,IBINDT),$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",5) S IBUR=1 Q
  1. URQ Q IBUR
  1. ;
  1. CHK(X,Z,Y) ; -- check one entry for active
  1. ; -- Input X = Zeroth node of entry in insurance multiple (2.312)
  1. ; Z = date to check
  1. ; Y = 2 if want will not reimburse
  1. ; = 3 if want will not reimburse AND indemnity plans
  1. ; = 4 if want will not reimburse, but only if it's
  1. ; MEDICARE
  1. ; -- Output 1 = Insurance Active
  1. ; 0 = Inactive
  1. ;
  1. N Z1,X1
  1. S Z1=0,Y=$G(Y)
  1. I Y'=3,$$INDEM(X) G CHKQ ; is an indemnity policy or company
  1. S X1=$G(^DIC(36,+X,0)) G:X1="" CHKQ ;insurance company entry doesn't exist
  1. I $P(X,"^",8) G:Z<$P(X,"^",8) CHKQ ;effective date later than care
  1. I $P(X,"^",4) G:Z>$P(X,"^",4) CHKQ ;care after expiration date
  1. I $P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",11) G CHKQ ;plan is inactive
  1. G:$P(X1,"^",5) CHKQ ;insurance company inactive
  1. I Y<2 G:$P(X1,"^",2)="N" CHKQ ;insurance company will not reimburse
  1. I Y=4,$P(X1,"^",2)="N",'$$MCRWNR^IBEFUNC(+X) G CHKQ ;only MEDICARE WNR
  1. S Z1=1
  1. CHKQ Q Z1
  1. ;
  1. ACTIVE(IBCIFN) ; -- is this company active for this patient for this date
  1. ; -- called from input transform and x-refs for fields 101,102,103
  1. ; -- input
  1. N ACTIVE,DFN,IBINDT
  1. S DFN=$P(^DGCR(399,DA,0),"^",2),IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT)
  1. ;
  1. ACTIVEQ Q ACTIVE
  1. ;
  1. DD ; - called from input transform and x-refs for field 101,102,103
  1. ; - input requires da=internal entry number in 399
  1. ; - outputs IBdd(ins co.) array
  1. N DFN S DFN=$P(^DGCR(399,DA,0),"^",2),IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT)
  1. D ALLACT
  1. DDQ K IBINDT Q
  1. ;
  1. ;
  1. ALLACT ; -- return active insurance zeroth nodes in ibdd(ins co,entry in mult)
  1. N X,X1
  1. S (X1,IBDD)=0
  1. F S X1=$O(^DPT(DFN,.312,X1)) Q:'X1 S X=$G(^(X,0)) I $$CHK(X,IBINDT) S IBDD(+X,X1)=X
  1. ;
  1. ALLACTQ Q
  1. ;
  1. HDR W !?4,"Insurance Co.",?22,"Policy #",?40,"Group",?52,"Holder",?60,"Effective",?70,"Expires" S X="",$P(X,"=",IOM-4)="" W !?4,X
  1. Q
  1. ;
  1. ;
  1. D1 N X Q:'$D(IBINS)
  1. W !?4,$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,16),1:"UNKNOWN")
  1. W ?22,$E($P(IBINS,"^",2),1,16)
  1. W ?40,$E($$GRP^IBCNS($P(IBINS,"^",18)),1,10)
  1. S X=$P(IBINS,"^",6) W ?52,$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER")
  1. W ?60,$$DAT1^IBOUTL($P(IBINS,"^",8)),?70,$$DAT1^IBOUTL($P(IBINS,"^",4))
  1. Q
  1. ;
  1. ALL(DFN,VAR,ACT,ADT,SOP) ; -- find all insurance data on a patient
  1. ;
  1. ; -- input DFN = patient
  1. ; VAR = variable to output in format of abc
  1. ; or abc(dfn)
  1. ; or ^tmp($j,"Insurance")
  1. ; ACT = 1 if only active ins. desired
  1. ; = 2 if active and will not reimburse desired
  1. ; = 3 if active, will not reimburse, and indemnity are
  1. ; all desired (for the $$INSTYP function below)
  1. ; = 4 if only active and MEDICARE WNR only desired
  1. ; ADT = if ACT=1 or 4, then ADT is the internal date to check
  1. ; active for, default = dt
  1. ; SOP = if SOP=1, then sort policies in COB order
  1. ;
  1. ; -- output var(0) =: number of entries insurance multiple
  1. ; var(x,0) =: ^dpt(dfn,.312,x,0)
  1. ; var(x,1) =: ^dpt(dfn,.312,x,1)
  1. ; var(x,2) =: ^dpt(dfn,.312,x,2)
  1. ; var(x,3) =: ^dpt(dfn,.312,x,3)
  1. ; var(x,4) =: ^dpt(dfn,.312,x,4)
  1. ; var(x,5) =: ^dpt(dfn,.312,x,5)
  1. ; var(x,7) =: ^dpt(dfn,.312,x,7)
  1. ; var(x,355.3) =: ^iba(355.3,$p(var(x,0),"^",18),0)
  1. ; var("S",COB sequence,x) =: (null) as an xref for COB
  1. ;
  1. N X,IBMRA,IBSP,IBIENS
  1. S X=0 I $G(ACT),$E($G(ADT),1,7)'?7N S ADT=DT
  1. S (IBMRA,IBSP)=0 ;Flag to say if pt has medicare wnr, spouse has policy
  1. F S X=$O(^DPT(DFN,.312,X)) Q:'X I $D(^(X,0)) D
  1. .I $G(ACT),'$$CHK(^DPT(DFN,.312,X,0),ADT,$G(ACT)) Q
  1. .S @VAR@(0)=$G(@VAR@(0))+1
  1. .S @VAR@(X,0)=$$ZND(DFN,X)
  1. .S @VAR@(X,1)=$G(^DPT(DFN,.312,X,1))
  1. .S @VAR@(X,2)=$G(^DPT(DFN,.312,X,2))
  1. .S @VAR@(X,3)=$G(^DPT(DFN,.312,X,3))
  1. .S @VAR@(X,4)=$G(^DPT(DFN,.312,X,4))
  1. .S @VAR@(X,5)=$G(^DPT(DFN,.312,X,5))
  1. .S @VAR@(X,7)=$G(^DPT(DFN,.312,X,7))
  1. .S IBIENS=+$P($G(^DPT(DFN,.312,X,0)),"^",18)
  1. .S @VAR@(X,355.3)=$G(^IBA(355.3,IBIENS,0))
  1. .;IB*2.0*516/TAZ - Place HIPAA compliant fields in original location.
  1. .S $P(@VAR@(X,355.3),U,3)=$$GET1^DIQ(355.3,IBIENS_",",2.01),$P(@VAR@(X,355.3),U,4)=$$GET1^DIQ(355.3,IBIENS_",",2.02)
  1. .I $G(SOP) D
  1. ..N COB,WHO
  1. ..S COB=$P(@VAR@(X,0),U,20)
  1. ..S WHO=$P(@VAR@(X,0),U,6) S:WHO="s" IBSP=1
  1. ..I $$MCRWNR^IBEFUNC(+@VAR@(X,0)) D
  1. ... S COB=.5,IBMRA=1
  1. ..S COB=$S(COB'="":COB,WHO="v":1,WHO="s":$S(IBMRA:1,1:2),1:3)
  1. ..S @VAR@("S",COB,X)=""
  1. ..Q
  1. ; Ck for spouse's insurance, move it before any MEDICARE WNR if sorting
  1. I $G(SOP),IBMRA,IBSP D
  1. . ; Shuffle Medicare WNR, if necessary
  1. . S X=0 F S X=$O(@VAR@("S",.5,X)) Q:'X S @VAR@("S",2,X)="" K @VAR@("S",.5,X)
  1. . S X=0 F S X=$O(@VAR@("S",2,X)) Q:'X I $P(@VAR@(X,0),U,6)="s",'$P(@VAR@(X,0),U,20) S @VAR@("S",1,X)="" K @VAR@("S",2,X)
  1. ALLQ Q
  1. ;
  1. ALLWNR(DFN,VAR,ADT) ; Returns 'all active and MEDICARE WNR'
  1. D ALL(DFN,VAR,4,ADT)
  1. Q
  1. ;
  1. ZND(DFN,NODE,ZNDFILE) ; -- Pull zeroth node from Patient's Insurance Type
  1. ; subfile. This function returns the zeroth node of the Insurance Type
  1. ; subfile of the Patient file, i.e. ^DPT(DFN,.312,NODE,0). Both DFN
  1. ; and NODE must be passed in. Pieces 3 (Group Number) and 15 (Group
  1. ; Name) will be pulled from file# 355.3, Group Insurance Plan, based
  1. ; on the Group Plan field on the zeroth node (piece 18). If the
  1. ; ZNDFILE/399 flag is not set to '399', then the Subscriber ID and Name
  1. ; of Insured will be overwritten with the values in the new HIPAA-
  1. ; compliant fields, which are on the seven node.
  1. ;
  1. ;IB*2.0*516/TAZ - Original code:
  1. ;N X,Y S (X,Y)=""
  1. ;I '$G(DFN)!('$G(NODE)) G ZNDQ
  1. ;S X=$G(^DPT(+DFN,.312,+NODE,0))
  1. ;S Y=$G(^IBA(355.3,+$P(X,"^",18),0)) I Y="" G ZNDQ
  1. ;S $P(X,"^",3)=$P(Y,"^",4) ; move group number
  1. ;S $P(X,"^",15)=$P(Y,"^",3) ; move group name
  1. ;
  1. N X,IBIENS
  1. S X=""
  1. I '$G(DFN)!('$G(NODE)) G ZNDQ
  1. S X=$G(^DPT(+DFN,.312,+NODE,0))
  1. ; IB*2.0*516/TAZ - If the ZNDFILE flag is set to '399', then the data
  1. ; returned is going to be filed on a Bill/Claim in file# 399. In that
  1. ; case, we do not wish to overwrite the Subscriber ID and Name of
  1. ; Insured because that data will be stored on the Bill/Claim in
  1. ; another place (^DGCR(399,IEN,"I?7").
  1. I $G(ZNDFILE)'=399 D
  1. . S IBIENS=+NODE_","_DFN
  1. . S $P(X,U,2)=$$GET1^DIQ(2.312,IBIENS_",",7.02) ; Subscriber ID
  1. . S $P(X,U,17)=$$GET1^DIQ(2.312,IBIENS_",",7.01) ;Name of Insured
  1. S IBIENS=+$P(X,U,18) I 'IBIENS G ZNDQ
  1. S $P(X,U,3)=$$GET1^DIQ(355.3,IBIENS_",",2.02) ;group number
  1. S $P(X,U,15)=$$GET1^DIQ(355.3,IBIENS_",",2.01) ;group name
  1. ;
  1. ZNDQ Q X
  1. ;
  1. INDEM(X) ; -- is this an indemnity plan
  1. ; -- input zeroth node if insurance type field
  1. N IBINDEM,IBCTP
  1. S IBINDEM=1
  1. I $P($G(^DIC(36,+X,0)),"^",13)=15 G INDEMQ ; company is indemnity co.
  1. S IBCTP=$P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",9)
  1. I IBCTP,$P($G(^IBE(355.1,+IBCTP,0)),"^",3)=9 G INDEMQ ; plan is an indemnity plan
  1. S IBINDEM=0
  1. INDEMQ Q IBINDEM
  1. ;
  1. ;
  1. INSTYP(DFN,DATE) ; -- return type of insurance policy for patient
  1. ;
  1. ; -- input dfn := pointer to patient file (required)
  1. ; date := date of insurance (optional, default = today)
  1. ;
  1. ; -- output Major Category of type of Plan (file 355.1, field .03)
  1. ; for policy which would be billed first (cob)
  1. ; null no insurance found
  1. ; 1 MAJOR MEDICAL (default)
  1. ; 2 DENTAL
  1. ; 3 HMO
  1. ; 4 PPO
  1. ; 5 MEDICARE
  1. ; 6 MEDICAID
  1. ; 7 TRICARE
  1. ; 8 WORKMANS COMP
  1. ; 9 INDEMNITY
  1. ; 10 PRESCRIPTION
  1. ; 11 MEDICARE SUPPLEMENTAL
  1. ; 12 ALL OTHER
  1. ;
  1. N TYPE,POL,IBCPOL
  1. S TYPE=""
  1. I '$G(DFN) G INSTYPQ
  1. I '$G(DATE) S DATE=DT
  1. D ALL(DFN,"POL",3,DATE)
  1. I $G(POL(0))<1 G INSTYPQ
  1. I $G(POL(0))=1 S IBCPOL=+$O(POL(0))
  1. I $G(POL(0))>1 S IBCPOL=$$COB(.POL)
  1. ;
  1. I IBCPOL S TYPE=$P($G(^IBE(355.1,+$P($G(POL(IBCPOL,355.3)),"^",9),0)),"^",3)
  1. I TYPE="" S TYPE=1 ;default is major medical
  1. ;
  1. INSTYPQ Q TYPE
  1. ;
  1. COB(POL) ; -- find policy with high coordination of benefits
  1. N I,X,IBC,COB,WHO,IBCOB
  1. ;
  1. S IBC=""
  1. S I=0 F S I=$O(POL(I)) Q:'I D
  1. .S WHO=$P($G(POL(I,0)),"^",6),COB=$P($G(POL(I,0)),"^",20)
  1. .S X=$S(COB'="":COB,WHO="v":1,WHO="s":2,1:3)
  1. .I 'IBC S IBC=I,IBCOB=X Q
  1. .I X<IBCOB S IBC=I,IBCOB=X
  1. Q IBC