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

IBBFAPI.m

Go to the documentation of this file. 
  1. IBBFAPI ;OAK/ELZ - FOR OTHER PACKAGES TO QUERY INSURANCE INFO ;2/18/10
  1.  ;;2.0;INTEGRATED BILLING;**267,297,249,317,361,384,404,516,554,737**;21-MAR-94;Build 19
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; -- see IBBDOC for API documentation
  1.  ;    no applications should call here directly
  1. INSUR(DFN,IBDT,IBSTAT,IBR,IBFLDS) ; Return Patient Insurance Information
  1.  ;
  1.  N ERROR,ERRORT,FCNT,IBPLN,ICNT,INSP,N,N1,NOK,PASS,PASS1,X,%
  1.  K ERRORT D ERRORLD
  1.  S NOK=-1
  1.  S DFN=$G(DFN)
  1.  S IBSTAT=$G(IBSTAT)
  1.  S IBDT=$P($G(IBDT),".")
  1.  S IBFLDS=$G(IBFLDS)
  1.  I IBDT,IBSTAT["A" S ERROR=107 D ERROR Q NOK
  1.  S (ERROR,PASS)=0 K IBR
  1.  I 'DFN S ERROR=102 D ERROR Q NOK
  1.  I '$D(^DPT(DFN)) S ERROR=106 D ERROR Q NOK
  1.  I IBDT]"",IBDT'?7N S ERROR=104 D ERROR Q NOK
  1.  I +IBDT=0 D NOW^%DTC S IBDT=$P(%,".",1)
  1.  I IBSTAT]"" N Y F X=1:1:$L(IBSTAT) S Y=$E(IBSTAT,X) I '$F("^A^R^P^O^I^B^E^",(U_Y_U)) S ERROR=105 D ERROR Q
  1.  I ERROR=105 Q NOK
  1.  I IBFLDS]"",IBFLDS'="*" N Y F X=1:1:$L(IBFLDS,",") D
  1.  . S Y=$P(IBFLDS,",",X)
  1.  . I Y'?1N.N S ERROR=103
  1.  . I Y?1N.N,(Y<1)!(Y>31) S ERROR=103   ;IB*737/TAZ changed 25 to 31
  1.  I ERROR=103 D ERROR Q NOK
  1.  K IBR
  1.  ; set buffer file flag
  1.  S (X,IBR("BUFFER"))=0 F  S X=$O(^IBA(355.33,"C",DFN,X)) Q:'X  S IBR("BUFFER")=IBR("BUFFER")+1
  1.  ; if ePharmacy requested then don't do Rx coverage, will do that elsewhere,
  1.  ; if E then no generic P allowed!!!  E will limit the P check even more.
  1.  I IBSTAT["E" S IBSTAT=$TR(IBSTAT,"P","")
  1.  S (ICNT,N)=0 F  S N=$O(^DPT(DFN,.312,N)) Q:'N  I $D(^(N,0)) D
  1.  . S X=^DPT(DFN,.312,N,0)
  1.  . N X1
  1.  . S X1=$G(^DIC(36,+X,0)) I X1="" Q  ; no insurance company entry
  1.  . S INSP=$P(X,U,1),IBPLN=$P(X,U,18)
  1.  . I IBSTAT'["R",$P(X1,U,2)="N" Q  ; does not reimburse
  1.  . I IBSTAT'["B",$$INDEM^IBCNS1(X) Q  ; indemnity policy
  1.  . S PASS1=0
  1.  . I IBSTAT'["A" D
  1.  . . I $P(X,U,8),IBDT<$P(X,U,8) S PASS1=1 Q  ;effective after care date
  1.  . . I $P(X,U,4),IBDT>$P(X,U,4) S PASS1=1 Q  ;terminated before care date
  1.  . . I $P($G(^IBA(355.3,+$P(X,U,18),0)),U,11) S PASS1=1 Q  ;inactive plan
  1.  . . I $P(X1,U,5) S PASS1=1 Q  ; inactive insurance company
  1.  . Q:PASS1
  1.  . S ICNT=ICNT+1
  1.  . S FCNT=$S(IBFLDS="*":31,1:$L(IBFLDS,",")) ; number of fields to pull
  1.  . S IBR("IBBAPI","INSUR",ICNT)=N
  1.  . I IBFLDS'="" F N1=1:1:FCNT D
  1.  . . N RET,RETVAL
  1.  . . ;IB*737/TAZ-CKB changed 26 to 32
  1.  . . S RET=$S(IBFLDS="*":N1,1:$P(IBFLDS,",",N1)),RETVAL="" I RET?1N.N,RET>0,RET<32 D @RET S IBR("IBBAPI","INSUR",ICNT,RET)=RETVAL
  1.  . I IBSTAT["P"!(IBSTAT["O")!(IBSTAT["I")!(IBSTAT["E") D  I PASS1=0 K IBR("IBBAPI","INSUR",ICNT) S ICNT=ICNT-1
  1.  . . S PASS1=0 Q:IBPLN=""
  1.  . . I IBSTAT["P",+$$PLCOV(IBPLN,IBDT,"PHARMACY")>0 S PASS1=1
  1.  . . I IBSTAT["O",+$$PLCOV(IBPLN,IBDT,"OUTPATIENT")>0 S PASS1=1
  1.  . . I IBSTAT["I",+$$PLCOV(IBPLN,IBDT,"INPATIENT")>0 S PASS1=1
  1.  . . I IBSTAT["E",+$$PLCOV(IBPLN,IBDT,"PHARMACY")>0,$$EPHARM(IBPLN) S PASS1=1
  1.  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)
  1.  Q PASS
  1. ERRORLD ;  load error array
  1.  F X=1:1:9 S ERRORT(X+100)=$P($T(ERRORLD1+X),";;",2)
  1.  Q
  1.  ;
  1. ERRORLD1 ; error messages
  1.  ;;DATABASE IS UNAVAILABLE
  1.  ;;PATIENT ID IS REQUIRED
  1.  ;;INVALID FIELD LIST
  1.  ;;INVALID EFFECTIVE DATE
  1.  ;;INVALID INSURANCE STATUS FILTER
  1.  ;;INVALID PATIENT ID
  1.  ;;INVALID COMBINATION, YOU CANNOT USE ""A"" WITH A DATE
  1.  ;;DATA SOURCE IS NOT DEFINED
  1.  ;;NO DATA ELEMENTS TO STORE
  1.  ;;
  1. ERROR ;
  1.  K IBR S IBR("IBBAPI","INSUR","ERROR",ERROR)=ERRORT(ERROR)
  1.  Q
  1.  ;
  1. 1 ; Ins. Comp. name
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",.01,"I")_U_$$GET1^DIQ(2.312,N_","_DFN_",",.01)
  1.  Q
  1. 2 ; Ins. Comp. Street Address Line 1
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.111)
  1.  Q
  1. 3 ; Ins. Comp. City
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.114)
  1.  Q
  1. 4 ; Ins. Comp. State
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.115,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(36,INSP_",",.115)
  1.  Q
  1. 5 ; Ins. Comp. Zip
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.116)
  1.  Q
  1. 6 ; Ins. Comp. Phone
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.131)
  1.  Q
  1. 7 ; Coordination of Benefits
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",.2,"I")_U_$$GET1^DIQ(2.312,N_","_DFN_",",.2)
  1.  I RETVAL="^" S RETVAL=""
  1.  Q
  1. 8 ; Policy Name ; patch 516 - baa
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(355.3,RETVAL_",",2.01)
  1.  Q
  1. 9 ; Policy Reimbursable?
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",1,"I")
  1.  S RETVAL=$S(RETVAL="Y":"1^YES",RETVAL="*":"1^YES",RETVAL="**":"1^YES",RETVAL="":"1^YES",1:"0^NO")
  1.  Q
  1. 10 ; Policy Effective Date
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",8,"I")
  1.  Q
  1. 11 ; Policy Expiration Date
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3,"I")
  1.  Q
  1. 12 ; Subscriber Relationship
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",16,"I")
  1.  S RETVAL=$S(RETVAL="01":"P^PATIENT",RETVAL="02":"S^SPOUSE",RETVAL:"O^OTHER",1:"")
  1.  Q
  1. 13 ; Subscriber Name ; patch 516 - baa
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",7.01)
  1.  Q
  1. 14  ; Subscriber ID ; patch 516 - baa
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",7.02)
  1.  Q
  1. 15 ; Pharmacy Coverage?
  1.  N IBCOV
  1.  S IBCOV=$$PLCOV(IBPLN,IBDT,"PHARMACY")
  1.  S RETVAL=$S(+IBCOV=0:"0^NO",1:"1^YES")
  1.  Q
  1. 16 ; Outpatient Coverage?
  1.  N IBCOV
  1.  S IBCOV=$$PLCOV(IBPLN,IBDT,"OUTPATIENT")
  1.  S RETVAL=$S(+IBCOV=0:"0^NO",1:"1^YES")
  1.  Q
  1. 17 ; Inpatient Coverage?
  1.  N IBCOV
  1.  S IBCOV=$$PLCOV(IBPLN,IBDT,"INPATIENT")
  1.  S RETVAL=$S(+IBCOV=0:"0^NO",1:"1^YES")
  1.  Q
  1. 18 ; Group Number ; patch 516 - baa
  1.  S RETVAL=$$GET1^DIQ(355.3,$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I")_",",2.02)
  1.  Q
  1.  ;
  1. 19 ; Patient Relationship to Subscriber
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",16,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(2.312,N_","_DFN_",",16)
  1.  Q
  1.  ;
  1. 20 ; VA Advantage and Tricare plan
  1.  S RETVAL=0  ; VA Advantage to be determined at a later date
  1.  N PLN,TYP1,TYP2,RETVAL1
  1.  S PLN=$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I")
  1.  S TYP1=$$GET1^DIQ(355.3,PLN_",",.09,"I")
  1.  S TYP2=$$GET1^DIQ(355.1,TYP1_",",.03,"I")
  1.  S RETVAL1=$S(TYP2=7:1,1:0)  ; determine if Tricare plan
  1.  S RETVAL=RETVAL_U_RETVAL1
  1.  Q
  1.  ;
  1. 21 ; Plan Type
  1.  N PLN,TYP1
  1.  S PLN=$$GET1^DIQ(2.312,N_","_DFN_",",.18,"I")
  1.  S TYP1=$$GET1^DIQ(355.3,PLN_",",.09,"I")
  1.  S RETVAL=$S(TYP1:TYP1_U_$$GET1^DIQ(355.1,TYP1_",",.01,"I"),1:"")
  1.  Q
  1.  ;
  1. 22 ; Subscriber Sex
  1.  D 12
  1.  I $E(RETVAL)="P" S RETVAL=$$GET1^DIQ(2,DFN_",",.02,"I") S:$L(RETVAL) RETVAL=RETVAL_U_$$GET1^DIQ(2,DFN_",",.02)
  1.  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)
  1.  Q
  1.  ;
  1. 23 ; Ins. Company Street Address Line 2
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.112)
  1.  Q
  1.  ;
  1. 24 ; Ins. Company Street Address Line 3
  1.  S RETVAL=$$GET1^DIQ(36,INSP_",",.113)
  1.  Q
  1.  ;
  1. 25 ; Date Last Verified
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",1.03,"I")
  1.  Q
  1.  ;
  1.  ;IB*737/TAZ added fields in positions 26 - 31
  1. 26 ; Insured's Street 1
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.06)
  1.  Q
  1. 27 ; Insured's Street 2
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.07)
  1.  Q
  1. 28 ; Insured's City
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.08)
  1.  Q
  1. 29 ; Insured's State
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.09,"I") S:RETVAL RETVAL=RETVAL_U_$$GET1^DIQ(2.312,N_","_DFN_",",3.09)
  1.  Q
  1. 30 ; Insured's Zip
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.1)
  1.  Q
  1. 31 ; Insured's Phone
  1.  S RETVAL=$$GET1^DIQ(2.312,N_","_DFN_",",3.11)
  1.  Q
  1.  ;
  1. PLCOV(IBPL,IBVDT,IBCAT) ; Determine if a specific plan covers a category of coverage as of a date
  1.  ; IBPL - pointer to file 355.3 group insurance plan (req)
  1.  ; IBVDT - fileman format visit date (req)
  1.  ; IBCAT -  pointer to file 355.31 limitation of coverage category (req)
  1.  N CATLIM,X,Y
  1.  I '$G(IBPL)!('$G(IBVDT))!('$L($G(IBCAT))) Q 0
  1.  S X=0
  1.  S IBCAT=$O(^IBE(355.31,"B",IBCAT,"")) G:IBCAT="" PLCOVQ
  1.  S CATLIM=$O(^IBA(355.32,"APCD",IBPL,IBCAT,+$O(^IBA(355.32,"APCD",IBPL,IBCAT,-(IBVDT+1))),""))
  1.  S X=$S(CATLIM="":1,1:+$P($G(^IBA(355.32,CATLIM,0)),U,4))
  1. PLCOVQ Q X
  1.  ;
  1. EPHARM(IBPL) ; return if a plan is epharmacy billable
  1.  N IBPIEN,IBOK,IBY
  1.  S IBOK=1
  1.  S IBPIEN=+$G(^IBA(355.3,+IBPL,6))
  1.  I 'IBPIEN S IBOK=0 G EPHARMQ
  1.  D STCHK^IBCNRU1(IBPIEN,.IBY)
  1.  I $E($G(IBY(1)))'="A" S IBOK=0
  1. EPHARMQ ;
  1.  Q IBOK
  1.  ;