IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;27-MAR-03
;;2.0;INTEGRATED BILLING;**214,231,361,371,452,593,631,664,763**;21-MAR-94;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
; This routine is used to exchange insurance information between
; facilities.
OPT ; Menu option entry point. This is used to select a patient to request
; information about from the remote treating facilities.
;IB*2.0*664/TAZ - Add CTR to New List
N CTR,DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBFASTXT,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1
;
; prompt for patient
AGAIN S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y
;
BACKGND ; background/tasked entry point
; IBTYPE is being used as a flag to indicate this is running in background
;
;IB*763/TAZ - Check Insurance Import Enabled flag and quit if not enabled.
; for background jobs only
I $D(IBTYPE),'$$GET1^DIQ(350.9,"1,",54.01,"I") Q
;
; look up treating facilities
K IBT S IBT=$$TFL^IBARXMU(DFN,.IBT)
I IBT<1,'$D(IBTYPE) W !!,"This patient has no remote treating facilities to query." G AGAIN
I IBT<1 Q
;
; display and verify we want to do this
I '$D(IBTYPE) D DEM^VADPT W !!,"The patient ",VADM(1)," has the following ",IBT," remote facilitie(s)",! S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 W !?10,$P(IBT(IBX),"^",2)
I '$D(IBTYPE) W !!,"Do you want to perform this Remote Query" S %=1 D YN^DICN G:%'=1 AGAIN
;
; get ICN
S IBICN=$$ICN^IBARXMU(DFN) I 'IBICN,'$D(IBTYPE) W !!,"No ICN for this patient" G AGAIN
I 'IBICN Q
;
; sent off the remote queries and get back handles
S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 D
. D SEND(.IBH,IBX,IBICN,$S($D(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY"))
. X $S(IBH(0)'="":"S $P(IBT(IBX),U,5)=IBH(0)",1:"W:'$D(IBTYPE) !,""No handle returned for "",$P(IBT(IBX),U,2) K IBT(IBX)")
;
; no handles returned
I $D(IBT)<9,'$D(IBTYPE) W !!,"Unable to perform any remote queries.",! G AGAIN
I $D(IBT)<9 Q
;
;Create Duplicate Check Index
;IB*2.0*664/TAZ - Only build index for Background calls
I $D(IBTYPE) D INDEX(DFN)
;
; go through every IBT()
S IBP="|",IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1!($D(IBT)<9) D
. ;
. ; do I have a return data.
. F IBWAIT=1:1:60 W:'$D(IBTYPE) "." H 1 D CHECK(.IBR,$P(IBT(IBX),"^",5)) I $G(IBR(0))["Done" Q
. I $G(IBR(0))'["Done" W:'$D(IBTYPE) !!,"Unable to communicate with ",$P(IBT(IBX),U,2) Q
. K IBR
. D RETURN(.IBR,$P(IBT(IBX),"^",5))
. ;
. ; no data returned or error message
. S IBRZ=$S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0)))
. ;
. ; no info to proceed
. I IBRZ<1 W:'$D(IBTYPE) !,"Response from ",$P(IBT(IBX),U,2),!,$P(IBRZ,"^",2) K IBT(IBX) D:IBRZ="-1^No insurance on file" FILE(0) Q
. ;
. ; received insurance info, need to file and display message
. W:'$D(IBTYPE) !,"Received ",$G(IBR(0))," insurance companies from ",$P(IBT(IBX),U,2) D FILE(+IBR(0))
. ;
. S IBY=0 F S IBY=$O(IBR(IBY)) Q:IBY<1 D
.. F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D
... ;
... ; am I on the right MAP line
... ;IB*2.0*631/TAZ - Insurance data comes in multiples of 7
... I $P(IBT,IBP,3)=$S(IBY#7:IBY#7,1:7) S IBZ=$P(IBR(IBY),"^",$P(IBT,IBP,4)) I $L(IBZ) D
.... ;
.... ; execute code to change external to internal
.... X:$L($P(IBT,IBP,7)) $P(IBT,IBP,7)
.... ;
.... ; put the info in the array for the buffer file
.... S:$D(IBZ) IBB($P(IBT,IBP,5))=IBZ
.. ;
.. ; file in the buffer file & where else needed
.. ;IB*2.0*631/TAZ - File on the 7th multiple line (i.e. 7,14,21...)
.. I IBY#7=0 D
... I $L($G(IBB(20.01))) D
.... N IBOK S IBOK=1
.... S IBB(.14)=$$IEN^XUAF4(+IBT(IBX))
.... S IBB(.03)=$O(^IBE(355.12,"C","INSURANCE IMPORT",""))
.... D VCHECK(.IBB) I 'IBOK Q
.... ;IB*2.0*664/TAZ - Set up ^TMP Array for input to ListMan screen if interactive
.... I '$D(IBTYPE) D Q
..... S CTR=$O(^TMP($J,"IBCNRDV",""),-1)+1
..... M ^TMP($J,"IBCNRDV",CTR)=IBB
.... S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB)
.... ;IB*2.0*664/TAZ - Moved the following line into this dotted Do struction since it only executed if $L($G(IBB(20.01)))
.... I '$D(IB1),$D(IBTYPE) D SCH^IBTUTL2(DFN,$G(IBSAVEI),$G(IBSAVEJ)):IBTYPE="TRKR",ADM^IBTUTL($G(IBSAVE1),$G(IBSAVE2),$G(IBSAVE3),$G(IBSAVE4)):IBTYPE="ADM" S IB1=1
... K IBB
;
;IB*2.0*664/TAZ - Branch to ListMan screen if interactive
I '$D(IBTYPE),$D(^TMP($J,"IBCNRDV")) H 3 D EN^IBCNRDV1
;
; flag so I don't do this patient again within 90 days
S ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))=""
;
; Clean up ^TMP global
K ^TMP($J,"IBCNRDV")
;
Q
;
VCHECK(IBB) ; Check to make sure the record is not duplicate and passes validity check.
;
;Check for duplicates
;IB*2.0*664/TAZ - Only check for duplicates when processing in background
I $D(IBTYPE),$$DUP(.IBB) S IBOK=0 G VCHECKX
; Validate entries to insure we are only getting the data we want.
I '$$VALID(.IBB) S IBOK=0 G VCHECKX
;IB*2.0*664/TAZ - Only add to INDEX for background processing
I '$D(IBTYPE) G VCHECKX
;Add to index
N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
S IBINSNM=$G(IBB(20.01)) I IBINSNM']"" S IBINSNM=" "
S IBGRP=$G(IBB(40.03)) I IBGRP']"" S IBGRP=" "
S IBSUBID=$G(IBB(60.04)) I IBSUBID']"" S IBSUBID=" "
S IBNAME=$P($G(IBB(60.07))," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
S IBDOB=$G(IBB(60.08)) I 'IBDOB S IBDOB=" "
S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
;
VCHECKX ;
Q
;
INDEX(DFN) ;
K ^TMP("IBCNRDV",$J)
N IBBUFDA,IBIEN
; From Buffer
S IBBUFDA=0
F S IBBUFDA=$O(^IBA(355.33,"C",DFN,IBBUFDA)) Q:'IBBUFDA D
. N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
. S IBINSNM=$$GET1^DIQ(355.33,IBBUFDA_",","INSURANCE COMPANY NAME") I IBINSNM']"" S IBINSNM=" "
. S IBGRP=$$GET1^DIQ(355.33,IBBUFDA_",","GROUP NUMBER") I IBGRP']"" S IBGRP=" "
. S IBSUBID=$$GET1^DIQ(355.33,IBBUFDA_",","SUBSCRIBER ID") I IBSUBID']"" S IBSUBID=" "
. S IBNAME=$P($$GET1^DIQ(355.33,IBBUFDA_",","NAME OF INSURED")," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
. S IBDOB=$$GET1^DIQ(355.33,IBBUFDA_",","INSURED'S DOB","I") I 'IBDOB S IBDOB=" "
. S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
; From active Insurance
K IBINS
D ALL^IBCNS1(DFN,"IBINS",2) ; Get all active insurance
I $G(IBINS(0)) S IBIEN=0 F S IBIEN=$O(IBINS(IBIEN)) Q:'IBIEN D
. N IBDOB,IBGRP,IBINSIEN,IBINSNM,IBNAME,IBSUBID
. S IBINSIEN=+$P($G(IBINS(IBIEN,0)),U,1)
. S IBINSNM=$$GET1^DIQ(36,IBINSIEN_",","NAME") I IBINSNM']"" S IBINSNM=" "
. S IBGRP=$P($G(IBINS(IBIEN,355.3)),U,4) I IBGRP']"" S IBGRP=" "
. S IBSUBID=$P($G(IBINS(IBIEN,7)),U,2) I IBSUBID']"" S IBSUBID=" "
. S IBNAME=$P($P($G(IBINS(IBIEN,7)),U)," ") I IBNAME']"" S IBNAME=" "
. S IBDOB=$P($G(IBINS(IBIEN,3)),U) I 'IBDOB S IBDOB=" "
. S ^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
K IBINS
;
Q
;
RPC(IBD,IBICN) ; RPC entry for looking up insurance info
N DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ
S DFN=$$DFN^IBARXMU(IBICN) I 'DFN S IBD(0)="-1^ICN Not found" Q
D ALL^IBCNS1(DFN,"IBY",3)
I '$D(IBY) S IBD(0)="-1^No insurance on file" Q
; set up return format
; IBD(0) = # of insurance companies
S IBD(0)=$G(IBY(0))
;
; where n starts at 1 and increments to 7 for each insurance company
; IBD(n) = 355.33, zero node format
; IBD(n+1) = 355.33, 20 node format
; IBD(n+2) = 355.33, 21 node format
; IBD(n+3) = 355.33, 40 node format
; IBD(n+4) = 355.33, 60 node format
; IBD(n+5) = 355.33, 61 node format
; IBD(n+6) = 355.33, 62 node format
;
S IBP="|"
S IBI=0 F S IBI=$O(IBY(IBI)) Q:IBI<1 F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D
. S IBZ=$P($G(IBY(IBI,+IBT)),"^",$P(IBT,IBP,2)) ; set the existing data
. I $L($P(IBT,IBP,6)) X $P(IBT,IBP,6) ; output transform
. S $P(IBD(IBI-1*7+$P(IBT,IBP,3)),"^",$P(IBT,IBP,4))=IBZ ; set data IBD
Q
;
MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file
; format is: node number | piece | extract node | extract piece
; | 355.33 field number | format out code (if any)
; | format in code (if any)
; the extract nodes will be sequential to match buffer file DD
;;0|1|2|1|20.01|N Z X "F Z=0,.11,.13 S IBY(IBI,36+Z)=$G(^DIC(36,IBZ,Z))" S IBZ=$P(IBY(IBI,36),"^");ins co name
;;0|2|5|4|60.04;subscriber id
;;0|4|5|3|60.03;experation date
;;0|6|5|5|60.05;who's insurance
;;0|8|5|2|60.02;effective date
;;0|16|5|6|60.06;pt relationship to insured
;;0|17|5|7|60.07;name of insured
;;0|20|5|12|60.12;coordination of benefits
;;1|1|1|1|.01||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date entered ;IB*593/TAZ
;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified
;;1|9|1|3|.03||S IBZ=$O(^IBE(355.12,"C","INSURANCE IMPORT",""));source of information ; Patch #593 Set to INSPT
;;2|1|6|5|61.05;send bill to employer
;;2|2|6|6|61.06;employer claims street address (line 1)
;;2|3|6|7|61.07;employer claims street address line 2
;;2|4|6|8|61.08;employer claims street address line 3
;;2|5|6|9|61.09;employer claims city
;;2|6|6|10|61.1|S IBZ=$$EXTERNAL^DILFD(2.312,2.06,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;employer claims state
;;2|7|6|11|61.11;employer claims zip code
;;2|8|6|12|61.12;employer claims phone
;;2|10|6|1|61.01;esghp
;;2|11|6|3|61.03;employment status
;;2|12|6|4|61.04;retirement date
;;3|1|5|8|60.08;insured's dob
;;3|5|5|9|60.09;insured's ssn
;;3|12|5|13|60.13;insured's sex
;;4|1|5|10|60.1;primary care provider
;;4|2|5|11|60.11;primary provider phone
;;4|5|5|15|60.15;pharmacy relationship code
;;4|6|5|16|60.16;pharmacy person code
;;5|1|7|1|62.01;patient id
;;355.3|2|4|1|40.01;is this a group policy
;;355.3|3|4|2|40.02;group name
;;355.3|4|4|3|40.03;group number
;;355.3|5|4|4|40.04;(is) utilization required
;;355.3|6|4|5|40.05;(is) pre-certification required
;;355.3|7|4|7|40.07;exclude pre-existing condition
;;355.3|8|4|8|40.08;benefits assignable
;;355.3|9|4|9|40.09;type of plan
;;355.3|12|4|6|40.06;ambulatory care certification
;;36|2|2|5|20.05;reimburse
;;36.11|1|3|1|21.01;street address line 1
;;36.11|2|3|2|21.02;street address line 2
;;36.11|3|3|3|21.03;street address line 3
;;36.11|4|3|4|21.04;city
;;36.11|5|3|5|21.05|S IBZ=$$EXTERNAL^DILFD(36,.115,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;state
;;36.11|6|3|6|21.06;zip code
;;36.13|1|2|2|20.02;phone number
;;36.13|2|2|3|20.03;billing phone number
;;36.13|3|2|4|20.04;precertification phone number
;;
;
SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries
D EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN)
Q
;
CHECK(IBR,IBH) ; called to check the return status of an RPC
D RPCCHK^XWB2HL7(.IBR,IBH)
Q
;
RETURN(IBR,IBH) ; called to get the return data and clear the broker
N IBZ
D RTNDATA^XWBDRPC(.IBR,IBH),CLEAR^XWBDRPC(.IBZ,IBH)
Q
;
TASK ; queue off task job
N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
S ZTRTN="BACKGND^IBCNRDV",ZTDESC="Query Remote Facilities for Insurance",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT),(ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))="" D ^%ZTLOAD
Q
;
TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry
N IBTYPE,IBT
Q:$D(^IBT(356,"ARDV",DFN)) ; have already done recently
Q:'$$TFL^IBARXMU(DFN,.IBT) ; no remote facilities
S IBTYPE="TRKR" D
. I DUZ=.5 N DUZ S DUZ=+$G(IBDUZ),DUZ(2)=+$$SITE^VASITE
. D TASK
Q
;
ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry
N IBTYPE S IBTYPE="ADM" D TASK
Q
;
FILE(IBX) ; updates data into the log file
;IBX = number of insurance co's found
N DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR
S IBM=$E($$DT^XLFDT,1,5)_"00",DA=+$O(^IBA(355.34,"B",IBM,0))
I 'DA K DA L +^IBA(355.34,"B",IBM):10 S X=IBM,DIC="^IBA(355.34,",DIC(0)="F" D FILE^DICN S DA=+Y L -^IBA(355.34,"B",IBM)
L +^IBA(355.34,DA):10
S IBZ=^IBA(355.34,DA,0),DIE="^IBA(355.34,"
S DR=".02///"_($P(IBZ,"^",2)+1)_";.03///"_($P(IBZ,"^",3)+IBX) D ^DIE
L -^IBA(355.34,DA)
Q
;
VALID(IBARY) ; Check for invalid entries in the incoming data
;Screen for Active Policy
;Screen for EXPIRATION DATE - Don't file expired policies
N DATA,EXCLUDE,IBEFFDT,IBEXPDT,IBTOP,LN,TAG,VALID
S VALID=1
; Check for expired policy
S IBEXPDT=$G(IBARY(60.03))
I IBEXPDT'="",($$FMDIFF^XLFDT(DT,IBEXPDT,1)>0) S VALID=0 G VALIDQ
I IBEXPDT="" D I 'VALID G VALIDQ
. ;Use LAST VERIFIED
. I $G(IBARY(.1)) D Q
.. I $$FMDIFF^XLFDT(DT,IBARY(.1),1)>730 S VALID=0 ;POLICY GREATER THAN 2 YEARS OLD.
. ;Use Date Entered
. I $G(IBARY(.01)),$$FMDIFF^XLFDT(DT,$G(IBARY(.01)),1)>730 S VALID=0 ;POLICY GREATER THAN 2 YEARS OLD.
;
;Screen EFFECTIVE DATE - Cannot be blank or future
S IBEFFDT=$G(IBARY(60.02))
I IBEFFDT="" S VALID=0 G VALIDQ ;BLANK EFFECTIVE DATE IS INVALID
I IBEFFDT'="",($$FMDIFF^XLFDT(DT,IBEFFDT,1)<0) S VALID=0 G VALIDQ ;FUTURE EFFECTIVE DATE IS INVALID
;
;Screen Type of Plan
S EXCLUDE="^"
F LN=2:1 S TAG="EXCTOP+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" S EXCLUDE=EXCLUDE_$$FIND1^DIC(355.1,"","X",DATA)_"^"
S IBTOP=$G(IBARY(40.09))
I IBTOP'="",$F(EXCLUDE,(U_IBTOP_U)) S VALID=0 G VALIDQ
;
; Re-Initialize variables for filing.
S IBARY(.01)=DT ;Set DATE ENTERED = today's date
S IBARY(.02)="" ;Set ENTERED BY = NULL
S IBARY(.1)="" ;Set DATE VERIFIED = NULL
S IBARY(.11)="" ;Set VERIFIED BY = NULL
;
VALIDQ ;
I 'VALID K IBARY
Q VALID
;
DUP(IBARY) ; Check for duplicate in the incoming data
N IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
S IBINSNM=$G(IBARY(20.01)) I IBINSNM']"" S IBINSNM=" "
S IBGRP=$G(IBARY(40.03)) I IBGRP']"" S IBGRP=" "
S IBSUBID=$G(IBARY(60.04)) I IBSUBID']"" S IBSUBID=" "
S IBNAME=$P($G(IBARY(60.07))," ") I IBNAME']"" S IBNAME=" " ;Only match on LAST,FIRST
S IBDOB=$G(IBARY(60.08)) I 'IBDOB S IBDOB=" "
Q $D(^TMP("IBCNRDV",$J,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB))
;
EXCTOP ;Plan Types to Exclude
;
;;ACCIDENT AND HEALTH INSURANCE
;;AUTOMOBILE
;;AVIATION TRIP INSURANCE
;;CATASTROPHIC INSURANCE
;;COINSURANCE
;;DUAL COVERAGE
;;HOSPITAL-MEDICAL INSURANCE
;;INCOME PROTECTION (INDEMNITY)
;;KEY-MAN HEALTH INSURANCE
;;MAJOR MEDICAL EXPENSE INSURANCE
;;MEDI-CAL
;;MEDICAID
;;MEDICARE/MEDICAID (MEDI-CAL)
;;NO-FAULT INSURANCE
;;QUALIFIED IMPAIRMENT INSURANCE
;;SPECIAL CLASS INSURANCE
;;SPECIAL RISK INSURANCE
;;SPECIFIED DISEASE INSURANCE
;;TORT FEASOR
;;WORKERS' COMPENSATION INSURANCE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRDV 14569 printed Dec 13, 2024@02:16:10 Page 2
IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV ;27-MAR-03
+1 ;;2.0;INTEGRATED BILLING;**214,231,361,371,452,593,631,664,763**;21-MAR-94;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; This routine is used to exchange insurance information between
+5 ; facilities.
OPT ; Menu option entry point. This is used to select a patient to request
+1 ; information about from the remote treating facilities.
+2 ;IB*2.0*664/TAZ - Add CTR to New List
+3 NEW CTR,DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBFASTXT,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1
+4 ;
+5 ; prompt for patient
AGAIN SET DIC="^DPT("
SET DIC(0)="AEMNQ"
DO ^DIC
if Y<1
QUIT
SET DFN=+Y
+1 ;
BACKGND ; background/tasked entry point
+1 ; IBTYPE is being used as a flag to indicate this is running in background
+2 ;
+3 ;IB*763/TAZ - Check Insurance Import Enabled flag and quit if not enabled.
+4 ; for background jobs only
+5 IF $DATA(IBTYPE)
IF '$$GET1^DIQ(350.9,"1,",54.01,"I")
QUIT
+6 ;
+7 ; look up treating facilities
+8 KILL IBT
SET IBT=$$TFL^IBARXMU(DFN,.IBT)
+9 IF IBT<1
IF '$DATA(IBTYPE)
WRITE !!,"This patient has no remote treating facilities to query."
GOTO AGAIN
+10 IF IBT<1
QUIT
+11 ;
+12 ; display and verify we want to do this
+13 IF '$DATA(IBTYPE)
DO DEM^VADPT
WRITE !!,"The patient ",VADM(1)," has the following ",IBT," remote facilitie(s)",!
SET IBX=0
FOR
SET IBX=$ORDER(IBT(IBX))
if IBX<1
QUIT
WRITE !?10,$PIECE(IBT(IBX),"^",2)
+14 IF '$DATA(IBTYPE)
WRITE !!,"Do you want to perform this Remote Query"
SET %=1
DO YN^DICN
if %'=1
GOTO AGAIN
+15 ;
+16 ; get ICN
+17 SET IBICN=$$ICN^IBARXMU(DFN)
IF 'IBICN
IF '$DATA(IBTYPE)
WRITE !!,"No ICN for this patient"
GOTO AGAIN
+18 IF 'IBICN
QUIT
+19 ;
+20 ; sent off the remote queries and get back handles
+21 SET IBX=0
FOR
SET IBX=$ORDER(IBT(IBX))
if IBX<1
QUIT
Begin DoDot:1
+22 DO SEND(.IBH,IBX,IBICN,$SELECT($DATA(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY"))
+23 XECUTE $SELECT(IBH(0)'="":"S $P(IBT(IBX),U,5)=IBH(0)",1:"W:'$D(IBTYPE) !,""No handle returned for "",$P(IBT(IBX),U,2) K IBT(IBX)")
End DoDot:1
+24 ;
+25 ; no handles returned
+26 IF $DATA(IBT)<9
IF '$DATA(IBTYPE)
WRITE !!,"Unable to perform any remote queries.",!
GOTO AGAIN
+27 IF $DATA(IBT)<9
QUIT
+28 ;
+29 ;Create Duplicate Check Index
+30 ;IB*2.0*664/TAZ - Only build index for Background calls
+31 IF $DATA(IBTYPE)
DO INDEX(DFN)
+32 ;
+33 ; go through every IBT()
+34 SET IBP="|"
SET IBX=0
FOR
SET IBX=$ORDER(IBT(IBX))
if IBX<1!($DATA(IBT)<9)
QUIT
Begin DoDot:1
+35 ;
+36 ; do I have a return data.
+37 FOR IBWAIT=1:1:60
if '$DATA(IBTYPE)
WRITE "."
HANG 1
DO CHECK(.IBR,$PIECE(IBT(IBX),"^",5))
IF $GET(IBR(0))["Done"
QUIT
+38 IF $GET(IBR(0))'["Done"
if '$DATA(IBTYPE)
WRITE !!,"Unable to communicate with ",$PIECE(IBT(IBX),U,2)
QUIT
+39 KILL IBR
+40 DO RETURN(.IBR,$PIECE(IBT(IBX),"^",5))
+41 ;
+42 ; no data returned or error message
+43 SET IBRZ=$SELECT(-1=+$GET(IBR):IBR,$GET(IBR(0))="":$GET(IBR(1)),1:$GET(IBR(0)))
+44 ;
+45 ; no info to proceed
+46 IF IBRZ<1
if '$DATA(IBTYPE)
WRITE !,"Response from ",$PIECE(IBT(IBX),U,2),!,$PIECE(IBRZ,"^",2)
KILL IBT(IBX)
if IBRZ="-1^No insurance on file"
DO FILE(0)
QUIT
+47 ;
+48 ; received insurance info, need to file and display message
+49 if '$DATA(IBTYPE)
WRITE !,"Received ",$GET(IBR(0))," insurance companies from ",$PIECE(IBT(IBX),U,2)
DO FILE(+IBR(0))
+50 ;
+51 SET IBY=0
FOR
SET IBY=$ORDER(IBR(IBY))
if IBY<1
QUIT
Begin DoDot:2
+52 FOR IBL=5:1
SET IBT=$PIECE($TEXT(MAP+IBL),";",3)
if IBT=""
QUIT
Begin DoDot:3
+53 ;
+54 ; am I on the right MAP line
+55 ;IB*2.0*631/TAZ - Insurance data comes in multiples of 7
+56 IF $PIECE(IBT,IBP,3)=$SELECT(IBY#7:IBY#7,1:7)
SET IBZ=$PIECE(IBR(IBY),"^",$PIECE(IBT,IBP,4))
IF $LENGTH(IBZ)
Begin DoDot:4
+57 ;
+58 ; execute code to change external to internal
+59 if $LENGTH($PIECE(IBT,IBP,7))
XECUTE $PIECE(IBT,IBP,7)
+60 ;
+61 ; put the info in the array for the buffer file
+62 if $DATA(IBZ)
SET IBB($PIECE(IBT,IBP,5))=IBZ
End DoDot:4
End DoDot:3
+63 ;
+64 ; file in the buffer file & where else needed
+65 ;IB*2.0*631/TAZ - File on the 7th multiple line (i.e. 7,14,21...)
+66 IF IBY#7=0
Begin DoDot:3
+67 IF $LENGTH($GET(IBB(20.01)))
Begin DoDot:4
+68 NEW IBOK
SET IBOK=1
+69 SET IBB(.14)=$$IEN^XUAF4(+IBT(IBX))
+70 SET IBB(.03)=$ORDER(^IBE(355.12,"C","INSURANCE IMPORT",""))
+71 DO VCHECK(.IBB)
IF 'IBOK
QUIT
+72 ;IB*2.0*664/TAZ - Set up ^TMP Array for input to ListMan screen if interactive
+73 IF '$DATA(IBTYPE)
Begin DoDot:5
+74 SET CTR=$ORDER(^TMP($JOB,"IBCNRDV",""),-1)+1
+75 MERGE ^TMP($JOB,"IBCNRDV",CTR)=IBB
End DoDot:5
QUIT
+76 SET IBB=$$ADDSTF^IBCNBES($GET(IBB(.03),1),DFN,.IBB)
+77 ;IB*2.0*664/TAZ - Moved the following line into this dotted Do struction since it only executed if $L($G(IBB(20.01)))
+78 IF '$DATA(IB1)
IF $DATA(IBTYPE)
if IBTYPE="TRKR"
DO SCH^IBTUTL2(DFN,$GET(IBSAVEI),$GET(IBSAVEJ))
if IBTYPE="ADM"
DO ADM^IBTUTL($GET(IBSAVE1),$GET(IBSAVE2),$GET(IBSAVE3),$GET(IBSAVE4))
SET IB1=1
End DoDot:4
+79 KILL IBB
End DoDot:3
End DoDot:2
End DoDot:1
+80 ;
+81 ;IB*2.0*664/TAZ - Branch to ListMan screen if interactive
+82 IF '$DATA(IBTYPE)
IF $DATA(^TMP($JOB,"IBCNRDV"))
HANG 3
DO EN^IBCNRDV1
+83 ;
+84 ; flag so I don't do this patient again within 90 days
+85 SET ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))=""
+86 ;
+87 ; Clean up ^TMP global
+88 KILL ^TMP($JOB,"IBCNRDV")
+89 ;
+90 QUIT
+91 ;
VCHECK(IBB) ; Check to make sure the record is not duplicate and passes validity check.
+1 ;
+2 ;Check for duplicates
+3 ;IB*2.0*664/TAZ - Only check for duplicates when processing in background
+4 IF $DATA(IBTYPE)
IF $$DUP(.IBB)
SET IBOK=0
GOTO VCHECKX
+5 ; Validate entries to insure we are only getting the data we want.
+6 IF '$$VALID(.IBB)
SET IBOK=0
GOTO VCHECKX
+7 ;IB*2.0*664/TAZ - Only add to INDEX for background processing
+8 IF '$DATA(IBTYPE)
GOTO VCHECKX
+9 ;Add to index
+10 NEW IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
+11 SET IBINSNM=$GET(IBB(20.01))
IF IBINSNM']""
SET IBINSNM=" "
+12 SET IBGRP=$GET(IBB(40.03))
IF IBGRP']""
SET IBGRP=" "
+13 SET IBSUBID=$GET(IBB(60.04))
IF IBSUBID']""
SET IBSUBID=" "
+14 ;Only match on LAST,FIRST
SET IBNAME=$PIECE($GET(IBB(60.07))," ")
IF IBNAME']""
SET IBNAME=" "
+15 SET IBDOB=$GET(IBB(60.08))
IF 'IBDOB
SET IBDOB=" "
+16 SET ^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
+17 ;
VCHECKX ;
+1 QUIT
+2 ;
INDEX(DFN) ;
+1 KILL ^TMP("IBCNRDV",$JOB)
+2 NEW IBBUFDA,IBIEN
+3 ; From Buffer
+4 SET IBBUFDA=0
+5 FOR
SET IBBUFDA=$ORDER(^IBA(355.33,"C",DFN,IBBUFDA))
if 'IBBUFDA
QUIT
Begin DoDot:1
+6 NEW IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
+7 SET IBINSNM=$$GET1^DIQ(355.33,IBBUFDA_",","INSURANCE COMPANY NAME")
IF IBINSNM']""
SET IBINSNM=" "
+8 SET IBGRP=$$GET1^DIQ(355.33,IBBUFDA_",","GROUP NUMBER")
IF IBGRP']""
SET IBGRP=" "
+9 SET IBSUBID=$$GET1^DIQ(355.33,IBBUFDA_",","SUBSCRIBER ID")
IF IBSUBID']""
SET IBSUBID=" "
+10 ;Only match on LAST,FIRST
SET IBNAME=$PIECE($$GET1^DIQ(355.33,IBBUFDA_",","NAME OF INSURED")," ")
IF IBNAME']""
SET IBNAME=" "
+11 SET IBDOB=$$GET1^DIQ(355.33,IBBUFDA_",","INSURED'S DOB","I")
IF 'IBDOB
SET IBDOB=" "
+12 SET ^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
End DoDot:1
+13 ; From active Insurance
+14 KILL IBINS
+15 ; Get all active insurance
DO ALL^IBCNS1(DFN,"IBINS",2)
+16 IF $GET(IBINS(0))
SET IBIEN=0
FOR
SET IBIEN=$ORDER(IBINS(IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+17 NEW IBDOB,IBGRP,IBINSIEN,IBINSNM,IBNAME,IBSUBID
+18 SET IBINSIEN=+$PIECE($GET(IBINS(IBIEN,0)),U,1)
+19 SET IBINSNM=$$GET1^DIQ(36,IBINSIEN_",","NAME")
IF IBINSNM']""
SET IBINSNM=" "
+20 SET IBGRP=$PIECE($GET(IBINS(IBIEN,355.3)),U,4)
IF IBGRP']""
SET IBGRP=" "
+21 SET IBSUBID=$PIECE($GET(IBINS(IBIEN,7)),U,2)
IF IBSUBID']""
SET IBSUBID=" "
+22 SET IBNAME=$PIECE($PIECE($GET(IBINS(IBIEN,7)),U)," ")
IF IBNAME']""
SET IBNAME=" "
+23 SET IBDOB=$PIECE($GET(IBINS(IBIEN,3)),U)
IF 'IBDOB
SET IBDOB=" "
+24 SET ^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB)=""
End DoDot:1
+25 KILL IBINS
+26 ;
+27 QUIT
+28 ;
RPC(IBD,IBICN) ; RPC entry for looking up insurance info
+1 NEW DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ
+2 SET DFN=$$DFN^IBARXMU(IBICN)
IF 'DFN
SET IBD(0)="-1^ICN Not found"
QUIT
+3 DO ALL^IBCNS1(DFN,"IBY",3)
+4 IF '$DATA(IBY)
SET IBD(0)="-1^No insurance on file"
QUIT
+5 ; set up return format
+6 ; IBD(0) = # of insurance companies
+7 SET IBD(0)=$GET(IBY(0))
+8 ;
+9 ; where n starts at 1 and increments to 7 for each insurance company
+10 ; IBD(n) = 355.33, zero node format
+11 ; IBD(n+1) = 355.33, 20 node format
+12 ; IBD(n+2) = 355.33, 21 node format
+13 ; IBD(n+3) = 355.33, 40 node format
+14 ; IBD(n+4) = 355.33, 60 node format
+15 ; IBD(n+5) = 355.33, 61 node format
+16 ; IBD(n+6) = 355.33, 62 node format
+17 ;
+18 SET IBP="|"
+19 SET IBI=0
FOR
SET IBI=$ORDER(IBY(IBI))
if IBI<1
QUIT
FOR IBL=5:1
SET IBT=$PIECE($TEXT(MAP+IBL),";",3)
if IBT=""
QUIT
Begin DoDot:1
+20 ; set the existing data
SET IBZ=$PIECE($GET(IBY(IBI,+IBT)),"^",$PIECE(IBT,IBP,2))
+21 ; output transform
IF $LENGTH($PIECE(IBT,IBP,6))
XECUTE $PIECE(IBT,IBP,6)
+22 ; set data IBD
SET $PIECE(IBD(IBI-1*7+$PIECE(IBT,IBP,3)),"^",$PIECE(IBT,IBP,4))=IBZ
End DoDot:1
+23 QUIT
+24 ;
MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file
+1 ; format is: node number | piece | extract node | extract piece
+2 ; | 355.33 field number | format out code (if any)
+3 ; | format in code (if any)
+4 ; the extract nodes will be sequential to match buffer file DD
+5 ;;0|1|2|1|20.01|N Z X "F Z=0,.11,.13 S IBY(IBI,36+Z)=$G(^DIC(36,IBZ,Z))" S IBZ=$P(IBY(IBI,36),"^");ins co name
+6 ;;0|2|5|4|60.04;subscriber id
+7 ;;0|4|5|3|60.03;experation date
+8 ;;0|6|5|5|60.05;who's insurance
+9 ;;0|8|5|2|60.02;effective date
+10 ;;0|16|5|6|60.06;pt relationship to insured
+11 ;;0|17|5|7|60.07;name of insured
+12 ;;0|20|5|12|60.12;coordination of benefits
+13 ;;1|1|1|1|.01||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date entered ;IB*593/TAZ
+14 ;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified
+15 ;;1|9|1|3|.03||S IBZ=$O(^IBE(355.12,"C","INSURANCE IMPORT",""));source of information ; Patch #593 Set to INSPT
+16 ;;2|1|6|5|61.05;send bill to employer
+17 ;;2|2|6|6|61.06;employer claims street address (line 1)
+18 ;;2|3|6|7|61.07;employer claims street address line 2
+19 ;;2|4|6|8|61.08;employer claims street address line 3
+20 ;;2|5|6|9|61.09;employer claims city
+21 ;;2|6|6|10|61.1|S IBZ=$$EXTERNAL^DILFD(2.312,2.06,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;employer claims state
+22 ;;2|7|6|11|61.11;employer claims zip code
+23 ;;2|8|6|12|61.12;employer claims phone
+24 ;;2|10|6|1|61.01;esghp
+25 ;;2|11|6|3|61.03;employment status
+26 ;;2|12|6|4|61.04;retirement date
+27 ;;3|1|5|8|60.08;insured's dob
+28 ;;3|5|5|9|60.09;insured's ssn
+29 ;;3|12|5|13|60.13;insured's sex
+30 ;;4|1|5|10|60.1;primary care provider
+31 ;;4|2|5|11|60.11;primary provider phone
+32 ;;4|5|5|15|60.15;pharmacy relationship code
+33 ;;4|6|5|16|60.16;pharmacy person code
+34 ;;5|1|7|1|62.01;patient id
+35 ;;355.3|2|4|1|40.01;is this a group policy
+36 ;;355.3|3|4|2|40.02;group name
+37 ;;355.3|4|4|3|40.03;group number
+38 ;;355.3|5|4|4|40.04;(is) utilization required
+39 ;;355.3|6|4|5|40.05;(is) pre-certification required
+40 ;;355.3|7|4|7|40.07;exclude pre-existing condition
+41 ;;355.3|8|4|8|40.08;benefits assignable
+42 ;;355.3|9|4|9|40.09;type of plan
+43 ;;355.3|12|4|6|40.06;ambulatory care certification
+44 ;;36|2|2|5|20.05;reimburse
+45 ;;36.11|1|3|1|21.01;street address line 1
+46 ;;36.11|2|3|2|21.02;street address line 2
+47 ;;36.11|3|3|3|21.03;street address line 3
+48 ;;36.11|4|3|4|21.04;city
+49 ;;36.11|5|3|5|21.05|S IBZ=$$EXTERNAL^DILFD(36,.115,"",IBZ)|N DIC,X,Y S DIC="^DIC(5,",X=IBZ,DIC(0)="OX" D ^DIC K:+Y<1 IBZ S:+Y>0 IBZ=+Y;state
+50 ;;36.11|6|3|6|21.06;zip code
+51 ;;36.13|1|2|2|20.02;phone number
+52 ;;36.13|2|2|3|20.03;billing phone number
+53 ;;36.13|3|2|4|20.04;precertification phone number
+54 ;;
+55 ;
SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries
+1 DO EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN)
+2 QUIT
+3 ;
CHECK(IBR,IBH) ; called to check the return status of an RPC
+1 DO RPCCHK^XWB2HL7(.IBR,IBH)
+2 QUIT
+3 ;
RETURN(IBR,IBH) ; called to get the return data and clear the broker
+1 NEW IBZ
+2 DO RTNDATA^XWBDRPC(.IBR,IBH)
DO CLEAR^XWBDRPC(.IBZ,IBH)
+3 QUIT
+4 ;
TASK ; queue off task job
+1 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
+2 SET ZTRTN="BACKGND^IBCNRDV"
SET ZTDESC="Query Remote Facilities for Insurance"
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT)
SET (ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))=""
DO ^%ZTLOAD
+3 QUIT
+4 ;
TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry
+1 NEW IBTYPE,IBT
+2 ; have already done recently
if $DATA(^IBT(356,"ARDV",DFN))
QUIT
+3 ; no remote facilities
if '$$TFL^IBARXMU(DFN,.IBT)
QUIT
+4 SET IBTYPE="TRKR"
Begin DoDot:1
+5 IF DUZ=.5
NEW DUZ
SET DUZ=+$GET(IBDUZ)
SET DUZ(2)=+$$SITE^VASITE
+6 DO TASK
End DoDot:1
+7 QUIT
+8 ;
ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry
+1 NEW IBTYPE
SET IBTYPE="ADM"
DO TASK
+2 QUIT
+3 ;
FILE(IBX) ; updates data into the log file
+1 ;IBX = number of insurance co's found
+2 NEW DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR
+3 SET IBM=$EXTRACT($$DT^XLFDT,1,5)_"00"
SET DA=+$ORDER(^IBA(355.34,"B",IBM,0))
+4 IF 'DA
KILL DA
LOCK +^IBA(355.34,"B",IBM):10
SET X=IBM
SET DIC="^IBA(355.34,"
SET DIC(0)="F"
DO FILE^DICN
SET DA=+Y
LOCK -^IBA(355.34,"B",IBM)
+5 LOCK +^IBA(355.34,DA):10
+6 SET IBZ=^IBA(355.34,DA,0)
SET DIE="^IBA(355.34,"
+7 SET DR=".02///"_($PIECE(IBZ,"^",2)+1)_";.03///"_($PIECE(IBZ,"^",3)+IBX)
DO ^DIE
+8 LOCK -^IBA(355.34,DA)
+9 QUIT
+10 ;
VALID(IBARY) ; Check for invalid entries in the incoming data
+1 ;Screen for Active Policy
+2 ;Screen for EXPIRATION DATE - Don't file expired policies
+3 NEW DATA,EXCLUDE,IBEFFDT,IBEXPDT,IBTOP,LN,TAG,VALID
+4 SET VALID=1
+5 ; Check for expired policy
+6 SET IBEXPDT=$GET(IBARY(60.03))
+7 IF IBEXPDT'=""
IF ($$FMDIFF^XLFDT(DT,IBEXPDT,1)>0)
SET VALID=0
GOTO VALIDQ
+8 IF IBEXPDT=""
Begin DoDot:1
+9 ;Use LAST VERIFIED
+10 IF $GET(IBARY(.1))
Begin DoDot:2
+11 ;POLICY GREATER THAN 2 YEARS OLD.
IF $$FMDIFF^XLFDT(DT,IBARY(.1),1)>730
SET VALID=0
End DoDot:2
QUIT
+12 ;Use Date Entered
+13 ;POLICY GREATER THAN 2 YEARS OLD.
IF $GET(IBARY(.01))
IF $$FMDIFF^XLFDT(DT,$GET(IBARY(.01)),1)>730
SET VALID=0
End DoDot:1
IF 'VALID
GOTO VALIDQ
+14 ;
+15 ;Screen EFFECTIVE DATE - Cannot be blank or future
+16 SET IBEFFDT=$GET(IBARY(60.02))
+17 ;BLANK EFFECTIVE DATE IS INVALID
IF IBEFFDT=""
SET VALID=0
GOTO VALIDQ
+18 ;FUTURE EFFECTIVE DATE IS INVALID
IF IBEFFDT'=""
IF ($$FMDIFF^XLFDT(DT,IBEFFDT,1)<0)
SET VALID=0
GOTO VALIDQ
+19 ;
+20 ;Screen Type of Plan
+21 SET EXCLUDE="^"
+22 FOR LN=2:1
SET TAG="EXCTOP+"_LN
SET DATA=$PIECE($TEXT(@TAG),";;",2)
if DATA=""
QUIT
SET EXCLUDE=EXCLUDE_$$FIND1^DIC(355.1,"","X",DATA)_"^"
+23 SET IBTOP=$GET(IBARY(40.09))
+24 IF IBTOP'=""
IF $FIND(EXCLUDE,(U_IBTOP_U))
SET VALID=0
GOTO VALIDQ
+25 ;
+26 ; Re-Initialize variables for filing.
+27 ;Set DATE ENTERED = today's date
SET IBARY(.01)=DT
+28 ;Set ENTERED BY = NULL
SET IBARY(.02)=""
+29 ;Set DATE VERIFIED = NULL
SET IBARY(.1)=""
+30 ;Set VERIFIED BY = NULL
SET IBARY(.11)=""
+31 ;
VALIDQ ;
+1 IF 'VALID
KILL IBARY
+2 QUIT VALID
+3 ;
DUP(IBARY) ; Check for duplicate in the incoming data
+1 NEW IBDOB,IBGRP,IBINSNM,IBNAME,IBSUBID
+2 SET IBINSNM=$GET(IBARY(20.01))
IF IBINSNM']""
SET IBINSNM=" "
+3 SET IBGRP=$GET(IBARY(40.03))
IF IBGRP']""
SET IBGRP=" "
+4 SET IBSUBID=$GET(IBARY(60.04))
IF IBSUBID']""
SET IBSUBID=" "
+5 ;Only match on LAST,FIRST
SET IBNAME=$PIECE($GET(IBARY(60.07))," ")
IF IBNAME']""
SET IBNAME=" "
+6 SET IBDOB=$GET(IBARY(60.08))
IF 'IBDOB
SET IBDOB=" "
+7 QUIT $DATA(^TMP("IBCNRDV",$JOB,IBINSNM,IBGRP,IBSUBID,IBNAME,IBDOB))
+8 ;
EXCTOP ;Plan Types to Exclude
+1 ;
+2 ;;ACCIDENT AND HEALTH INSURANCE
+3 ;;AUTOMOBILE
+4 ;;AVIATION TRIP INSURANCE
+5 ;;CATASTROPHIC INSURANCE
+6 ;;COINSURANCE
+7 ;;DUAL COVERAGE
+8 ;;HOSPITAL-MEDICAL INSURANCE
+9 ;;INCOME PROTECTION (INDEMNITY)
+10 ;;KEY-MAN HEALTH INSURANCE
+11 ;;MAJOR MEDICAL EXPENSE INSURANCE
+12 ;;MEDI-CAL
+13 ;;MEDICAID
+14 ;;MEDICARE/MEDICAID (MEDI-CAL)
+15 ;;NO-FAULT INSURANCE
+16 ;;QUALIFIED IMPAIRMENT INSURANCE
+17 ;;SPECIAL CLASS INSURANCE
+18 ;;SPECIAL RISK INSURANCE
+19 ;;SPECIFIED DISEASE INSURANCE
+20 ;;TORT FEASOR
+21 ;;WORKERS' COMPENSATION INSURANCE
+22 ;
