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