| 1 | IBBFAPI ;OAK/ELZ - FOR OTHER PACKAGES TO QUERY INSURANCE INFO ;19-AUG-2004
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**267,297,249,317,361**;21-MAR-94;Build 9
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; -- see IBBDOC for API documentation
|
|---|
| 6 | ; no applications should call here directly
|
|---|
| 7 | INSUR(DFN,IBDT,IBSTAT,IBR,IBFLDS) ; Return Patient Insurance Information
|
|---|
| 8 | ;
|
|---|
| 9 | N ERROR,ERRORT,FCNT,IBPLN,ICNT,INSP,N,N1,NOK,PASS,PASS1,X,%
|
|---|
| 10 | K ERRORT D ERRORLD
|
|---|
| 11 | S NOK=-1
|
|---|
| 12 | S DFN=$G(DFN)
|
|---|
| 13 | S IBSTAT=$G(IBSTAT)
|
|---|
| 14 | S IBDT=$P($G(IBDT),".")
|
|---|
| 15 | S IBFLDS=$G(IBFLDS)
|
|---|
| 16 | I IBDT,IBSTAT["A" S ERROR=107 D ERROR Q NOK
|
|---|
| 17 | S (ERROR,PASS)=0 K IBR
|
|---|
| 18 | I 'DFN S ERROR=102 D ERROR Q NOK
|
|---|
| 19 | I '$D(^DPT(DFN)) S ERROR=106 D ERROR Q NOK
|
|---|
| 20 | I IBDT]"",IBDT'?7N S ERROR=104 D ERROR Q NOK
|
|---|
| 21 | I +IBDT=0 D NOW^%DTC S IBDT=$P(%,".",1)
|
|---|
| 22 | I IBSTAT]"" N Y F X=1:1:$L(IBSTAT) S Y=$E(IBSTAT,X) I '$F("^A^R^P^O^I^B^",(U_Y_U)) S ERROR=105 D ERROR Q
|
|---|
| 23 | I ERROR=105 Q NOK
|
|---|
| 24 | I IBFLDS]"",IBFLDS'="*" N Y F X=1:1:$L(IBFLDS,",") D
|
|---|
| 25 | . S Y=$P(IBFLDS,",",X)
|
|---|
| 26 | . I Y'?1N.N S ERROR=103
|
|---|
| 27 | . I Y?1N.N,(Y<1)!(Y>21) S ERROR=103
|
|---|
| 28 | I ERROR=103 D ERROR Q NOK
|
|---|
| 29 | K IBR
|
|---|
| 30 | ; set buffer file flag
|
|---|
| 31 | S (X,IBR("BUFFER"))=0 F S X=$O(^IBA(355.33,"C",DFN,X)) Q:'X S IBR("BUFFER")=IBR("BUFFER")+1
|
|---|
| 32 | S (ICNT,N)=0 F S N=$O(^DPT(DFN,.312,N)) Q:'N I $D(^(N,0)) D
|
|---|
| 33 | . S X=^DPT(DFN,.312,N,0)
|
|---|
| 34 | . N X1
|
|---|
| 35 | . S X1=$G(^DIC(36,+X,0)) I X1="" Q ; no insurance company entry
|
|---|
| 36 | . S INSP=$P(X,U,1),IBPLN=$P(X,U,18)
|
|---|
| 37 | . I IBSTAT'["R",$P(X1,U,2)="N" Q ; does not reimburse
|
|---|
| 38 | . I IBSTAT'["B",$$INDEM^IBCNS1(X) Q ; indemnity policy
|
|---|
| 39 | . S PASS1=0
|
|---|
| 40 | . I IBSTAT'["A" D
|
|---|
| 41 | . . I $P(X,U,8),IBDT<$P(X,U,8) S PASS1=1 Q ;effective after care date
|
|---|
| 42 | . . I $P(X,U,4),IBDT>$P(X,U,4) S PASS1=1 Q ;terminated before care date
|
|---|
| 43 | . . I $P($G(^IBA(355.3,+$P(X,U,18),0)),U,11) S PASS1=1 Q ;inactive plan
|
|---|
| 44 | . . I $P(X1,U,5) S PASS1=1 Q ; inactive insurance company
|
|---|
| 45 | . Q:PASS1
|
|---|
| 46 | . S ICNT=ICNT+1
|
|---|
| 47 | . S FCNT=$S(IBFLDS="*":22,1:$L(IBFLDS,",")) ; number of fields to pull
|
|---|
| 48 | . S IBR("IBBAPI","INSUR",ICNT)=""
|
|---|
| 49 | . I IBFLDS'="" F N1=1:1:FCNT D
|
|---|
| 50 | . . N RET,RETVAL
|
|---|
| 51 | . . S RET=$S(IBFLDS="*":N1,1:$P(IBFLDS,",",N1)),RETVAL="" I RET?1N.N,RET>0,RET<23 D @RET S IBR("IBBAPI","INSUR",ICNT,RET)=RETVAL
|
|---|
| 52 | . I IBSTAT["P"!(IBSTAT["O")!(IBSTAT["I") D I PASS1=0 K IBR("IBBAPI","INSUR",ICNT) S ICNT=ICNT-1
|
|---|
| 53 | . . S PASS1=0 Q:IBPLN=""
|
|---|
| 54 | . . I IBSTAT["P",+$$PLCOV(IBPLN,IBDT,"PHARMACY")>0 S PASS1=1
|
|---|
| 55 | . . I IBSTAT["O",+$$PLCOV(IBPLN,IBDT,"OUTPATIENT")>0 S PASS1=1
|
|---|
| 56 | . . I IBSTAT["I",+$$PLCOV(IBPLN,IBDT,"INPATIENT")>0 S PASS1=1
|
|---|
| 57 | I $D(IBR("IBBAPI","INSUR")),$O(IBR("IBBAPI","INSUR",0))'="ERROR" S PASS=1 F X=1:1 Q:'$D(IBR("IBBAPI","INSUR",X)) K:'$O(IBR("IBBAPI","INSUR",X,"")) IBR("IBBAPI","INSUR",X)
|
|---|
| 58 | Q PASS
|
|---|
| 59 | ERRORLD ; load error array
|
|---|
| 60 | F X=1:1:9 S ERRORT(X+100)=$P($T(ERRORLD1+X),";;",2)
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | ERRORLD1 ; error messages
|
|---|
| 64 | ;;DATABASE IS UNAVAILABLE
|
|---|
| 65 | ;;PATIENT ID IS REQUIRED
|
|---|
| 66 | ;;INVALID FIELD LIST
|
|---|
| 67 | ;;INVALID EFFECTIVE DATE
|
|---|
| 68 | ;;INVALID INSURANCE STATUS FILTER
|
|---|
| 69 | ;;INVALID PATIENT ID
|
|---|
| 70 | ;;INVALID COMBINATION, YOU CANNOT USE ""A"" WITH A DATE
|
|---|
| 71 | ;;DATA SOURCE IS NOT DEFINED
|
|---|
| 72 | ;;NO DATA ELEMENTS TO STORE
|
|---|
| 73 | ;;
|
|---|
| 74 | ERROR ;
|
|---|
| 75 | K IBR S IBR("IBBAPI","INSUR","ERROR",ERROR)=ERRORT(ERROR)
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | 1 ; Ins. Comp. name
|
|---|
| 79 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",.01,"I")_U_$$GET1^DIQ(2.312,N_","_DFN_",",.01)
|
|---|
| 80 | Q
|
|---|
| 81 | 2 ; Ins. Comp. Street Address Line 1
|
|---|
| 82 | S RETVAL=$$GET1^DIQ(36,INSP_",",.111)
|
|---|
| 83 | Q
|
|---|
| 84 | 3 ; Ins. Comp. City
|
|---|
| 85 | S RETVAL=$$GET1^DIQ(36,INSP_",",.114)
|
|---|
| 86 | Q
|
|---|
| 87 | 4 ; Ins. Comp. State
|
|---|
| 88 | S RETVAL=$$GET1^DIQ(36,INSP_",",.115,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(36,INSP_",",.115)
|
|---|
| 89 | Q
|
|---|
| 90 | 5 ; Ins. Comp. Zip
|
|---|
| 91 | S RETVAL=$$GET1^DIQ(36,INSP_",",.116)
|
|---|
| 92 | Q
|
|---|
| 93 | 6 ; Ins. Comp. Phone
|
|---|
| 94 | S RETVAL=$$GET1^DIQ(36,INSP_",",.131)
|
|---|
| 95 | Q
|
|---|
| 96 | 7 ; Coordination of Benefits
|
|---|
| 97 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",.2,"I")_U_$$GET1^DIQ(2.312,N_","_DFN_",",.2)
|
|---|
| 98 | I RETVAL="^" S RETVAL=""
|
|---|
| 99 | Q
|
|---|
| 100 | 8 ; Policy Name
|
|---|
| 101 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(355.3,RETVAL,.03)
|
|---|
| 102 | Q
|
|---|
| 103 | 9 ; Policy Reimbursable?
|
|---|
| 104 | S RETVAL=$$GET1^DIQ(36,INSP_",",1,"I")
|
|---|
| 105 | S RETVAL=$S(RETVAL="Y":"1^YES",RETVAL="*":"1^YES",RETVAL="**":"1^YES",RETVAL="":"1^YES",1:"0^NO")
|
|---|
| 106 | Q
|
|---|
| 107 | 10 ; Policy Effective Date
|
|---|
| 108 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",8,"I")
|
|---|
| 109 | Q
|
|---|
| 110 | 11 ; Policy Expiration Date
|
|---|
| 111 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3,"I")
|
|---|
| 112 | Q
|
|---|
| 113 | 12 ; Subscriber Relationship
|
|---|
| 114 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",16,"I")
|
|---|
| 115 | S RETVAL=$S(RETVAL="01":"P^PATIENT",RETVAL="02":"S^SPOUSE",RETVAL:"O^OTHER",1:"")
|
|---|
| 116 | Q
|
|---|
| 117 | 13 ; Subscriber Name
|
|---|
| 118 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",17)
|
|---|
| 119 | Q
|
|---|
| 120 | 14 ; Subscriber ID
|
|---|
| 121 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",1)
|
|---|
| 122 | Q
|
|---|
| 123 | 15 ; Pharmacy Coverage?
|
|---|
| 124 | N IBCOV
|
|---|
| 125 | S IBCOV=$$PLCOV(IBPLN,IBDT,"PHARMACY")
|
|---|
| 126 | S RETVAL=$S(+IBCOV=0:"0^NO",1:"1^YES")
|
|---|
| 127 | Q
|
|---|
| 128 | 16 ; Outpatient Coverage?
|
|---|
| 129 | N IBCOV
|
|---|
| 130 | S IBCOV=$$PLCOV(IBPLN,IBDT,"OUTPATIENT")
|
|---|
| 131 | S RETVAL=$S(+IBCOV=0:"0^NO",1:"1^YES")
|
|---|
| 132 | Q
|
|---|
| 133 | 17 ; Inpatient Coverage?
|
|---|
| 134 | N IBCOV
|
|---|
| 135 | S IBCOV=$$PLCOV(IBPLN,IBDT,"INPATIENT")
|
|---|
| 136 | S RETVAL=$S(+IBCOV=0:"0^NO",1:"1^YES")
|
|---|
| 137 | Q
|
|---|
| 138 | 18 ; Group Number
|
|---|
| 139 | S RETVAL=$$GET1^DIQ(355.3,$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I")_",",.04)
|
|---|
| 140 | Q
|
|---|
| 141 | ;
|
|---|
| 142 | 19 ; Patient Relationship to Subscriber
|
|---|
| 143 | S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",16,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(2.312,N_","_DFN_",",16)
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| 146 | 20 ; VA Advantage and Tricare plan
|
|---|
| 147 | S RETVAL=0 ; VA Advantage to be determined at a later date
|
|---|
| 148 | N PLN,TYP1,TYP2,RETVAL1
|
|---|
| 149 | S PLN=$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I")
|
|---|
| 150 | S TYP1=$$GET1^DIQ(355.3,PLN_",",.09,"I")
|
|---|
| 151 | S TYP2=$$GET1^DIQ(355.1,TYP1_",",.03,"I")
|
|---|
| 152 | S RETVAL1=$S(TYP2=7:1,1:0) ; determine if Tricare plan
|
|---|
| 153 | S RETVAL=RETVAL_U_RETVAL1
|
|---|
| 154 | Q
|
|---|
| 155 | ;
|
|---|
| 156 | 21 ; Plan Type
|
|---|
| 157 | N PLN,TYP1
|
|---|
| 158 | S PLN=$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I")
|
|---|
| 159 | S TYP1=$$GET1^DIQ(355.3,PLN_",",.09,"I")
|
|---|
| 160 | S RETVAL=$S(TYP1:TYP1_U_$$GET1^DIQ(355.1,TYP1_",",.01,"I"),1:"")
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | 22 ; Subscriber Sex
|
|---|
| 164 | D 12
|
|---|
| 165 | I $E(RETVAL)="P" S RETVAL=$$GET1^DIQ(2,DFN_",",.02,"I") S:$L(RETVAL) RETVAL=RETVAL_U_$$GET1^DIQ(2,DFN_",",.02)
|
|---|
| 166 | E S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.12,"I") S:$L(RETVAL) RETVAL=RETVAL_U_$$GET1^DIQ(2.312,N_","_DFN_",",3.12)
|
|---|
| 167 | Q
|
|---|
| 168 | ;
|
|---|
| 169 | PLCOV(IBPL,IBVDT,IBCAT) ; Determine if a specific plan covers a category of coverage as of a date
|
|---|
| 170 | ; IBPL - pointer to file 355.3 group insurance plan (req)
|
|---|
| 171 | ; IBVDT - fileman format visit date (req)
|
|---|
| 172 | ; IBCAT - pointer to file 355.31 limitation of coverage category (req)
|
|---|
| 173 | N CATLIM,X,Y
|
|---|
| 174 | I '$G(IBPL)!('$G(IBVDT))!('$L($G(IBCAT))) Q 0
|
|---|
| 175 | S X=0
|
|---|
| 176 | S IBCAT=$O(^IBE(355.31,"B",IBCAT,"")) G:IBCAT="" PLCOVQ
|
|---|
| 177 | S CATLIM=$O(^IBA(355.32,"APCD",IBPL,IBCAT,+$O(^IBA(355.32,"APCD",IBPL,IBCAT,-(IBVDT+1))),""))
|
|---|
| 178 | S X=$S(CATLIM="":1,1:+$P($G(^IBA(355.32,CATLIM,0)),U,4))
|
|---|
| 179 | PLCOVQ Q X
|
|---|
| 180 | ;
|
|---|
