| 1 | IBCNRDV ;OAKFO/ELZ - INSURANCE INFORMATION EXCHANGE VIA RDV;27-MAR-03
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**214,231,361**;21-MAR-94;Build 9
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This routine is used to exchange insurance information between
|
|---|
| 6 | ; facilities.
|
|---|
| 7 | OPT ; Menu option entry point. This is used to select a patient to request
|
|---|
| 8 | ; information about from the remote treating facilities.
|
|---|
| 9 | N DFN,DIC,X,Y,DTOUT,DUOUT,IBT,%,%Y,IBX,VADM,IBB,IBD,IBH,IBI,IBICN,IBR,IBRZ,IBX,IBY,IBZ,IBWAIT,IBL,DO,IBTYPE,IB1
|
|---|
| 10 | ;
|
|---|
| 11 | ; prompt for patient
|
|---|
| 12 | AGAIN S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y
|
|---|
| 13 | ;
|
|---|
| 14 | BACKGND ; background/tasked entry point
|
|---|
| 15 | ; IBTYPE is being used as a flag to indicate this is running in background
|
|---|
| 16 | ;
|
|---|
| 17 | ; look up treating facilities
|
|---|
| 18 | K IBT S IBT=$$TFL^IBARXMU(DFN,.IBT)
|
|---|
| 19 | I IBT<1,'$D(IBTYPE) W !!,"This patient has no remote treating facilities to query." G AGAIN
|
|---|
| 20 | I IBT<1 Q
|
|---|
| 21 | ;
|
|---|
| 22 | ; display and verify we want to do this
|
|---|
| 23 | 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)
|
|---|
| 24 | I '$D(IBTYPE) W !!,"Do you want to perform this Remote Query" S %=1 D YN^DICN G:%'=1 AGAIN
|
|---|
| 25 | ;
|
|---|
| 26 | ; get ICN
|
|---|
| 27 | S IBICN=$$ICN^IBARXMU(DFN) I 'IBICN,'$D(IBTYPE) W !!,"No ICN for this patient" G AGAIN
|
|---|
| 28 | I 'IBICN Q
|
|---|
| 29 | ;
|
|---|
| 30 | ; sent off the remote queries and get back handles
|
|---|
| 31 | S IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1 D
|
|---|
| 32 | . D SEND(.IBH,IBX,IBICN,$S($D(IBTYPE):"IBCN INSURANCE QUERY TASK",1:"IBCN INSURANCE QUERY"))
|
|---|
| 33 | . 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)")
|
|---|
| 34 | ;
|
|---|
| 35 | ; no handles returned
|
|---|
| 36 | I $D(IBT)<9,'$D(IBTYPE) W !!,"Unable to perform any remote queries.",! G AGAIN
|
|---|
| 37 | I $D(IBT)<9 Q
|
|---|
| 38 | ;
|
|---|
| 39 | ; go through every IBT()
|
|---|
| 40 | S IBP="|",IBX=0 F S IBX=$O(IBT(IBX)) Q:IBX<1!($D(IBT)<9) D
|
|---|
| 41 | . ;
|
|---|
| 42 | . ; do I have a return data.
|
|---|
| 43 | . F IBWAIT=1:1:60 W:'$D(IBTYPE) "." H 1 D CHECK(.IBR,$P(IBT(IBX),"^",5)) I $G(IBR(0))["Done" Q
|
|---|
| 44 | . I $G(IBR(0))'["Done" W:'$D(IBTYPE) !!,"Unable to communicate with ",$P(IBT(IBX),U,2) Q
|
|---|
| 45 | . K IBR
|
|---|
| 46 | . D RETURN(.IBR,$P(IBT(IBX),"^",5))
|
|---|
| 47 | . ;
|
|---|
| 48 | . ; no data returned or error message
|
|---|
| 49 | . S IBRZ=$S(-1=+$G(IBR):IBR,$G(IBR(0))="":$G(IBR(1)),1:$G(IBR(0)))
|
|---|
| 50 | . ;
|
|---|
| 51 | . ; no info to proceed
|
|---|
| 52 | . 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
|
|---|
| 53 | . ;
|
|---|
| 54 | . ; received insurance info, need to file and display message
|
|---|
| 55 | . W:'$D(IBTYPE) !,"Received ",$G(IBR(0))," insurance companies from ",$P(IBT(IBX),U,2) D FILE(+IBR(0))
|
|---|
| 56 | . ;
|
|---|
| 57 | . S IBY=0 F S IBY=$O(IBR(IBY)) Q:IBY<1 D
|
|---|
| 58 | .. F IBL=5:1 S IBT=$P($T(MAP+IBL),";",3) Q:IBT="" D
|
|---|
| 59 | ... ;
|
|---|
| 60 | ... ; am I on the right MAP line
|
|---|
| 61 | ... I $P(IBT,IBP,3)=$S(IBY#6:IBY#6,1:6) S IBZ=$P(IBR(IBY),"^",$P(IBT,IBP,4)) I $L(IBZ) D
|
|---|
| 62 | .... ;
|
|---|
| 63 | .... ; xecute code to change external to internal
|
|---|
| 64 | .... X:$L($P(IBT,IBP,7)) $P(IBT,IBP,7)
|
|---|
| 65 | .... ;
|
|---|
| 66 | .... ; put the info in the array for the buffer file
|
|---|
| 67 | .... S:$D(IBZ) IBB($P(IBT,IBP,5))=IBZ
|
|---|
| 68 | .. ;
|
|---|
| 69 | .. ; need to avoid duplicates if possible.
|
|---|
| 70 | .. I $G(IBB(20.01))["MEDICARE (WNR)" S X=0 F S X=$O(^DPT(DFN,.312,X)) Q:X<1 I $P($G(^DIC(36,+$P($G(^DPT(DFN,.312,X,0)),"^"),0)),"^")["MEDICARE (WNR)" K IBB Q
|
|---|
| 71 | .. Q:'$D(IBB)
|
|---|
| 72 | .. ;
|
|---|
| 73 | .. ; file in the buffer file & where else needed
|
|---|
| 74 | .. I IBY#6=0 D
|
|---|
| 75 | ... I $L($G(IBB(20.01))) D
|
|---|
| 76 | .... S IBB(.14)=$$IEN^XUAF4(+IBT(IBX))
|
|---|
| 77 | .... S IBB=$$ADDSTF^IBCNBES($G(IBB(.03),1),DFN,.IBB)
|
|---|
| 78 | ... I '$D(IB1),$D(IBTYPE),$L($G(IBB(20.01))) 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
|
|---|
| 79 | ... W:'$D(IBTYPE)&($L($G(IBB(20.01)))) !,$P($G(IBB),"^")," Buffer File entry for ",$G(IBB(20.01))
|
|---|
| 80 | ... K IBB
|
|---|
| 81 | ;
|
|---|
| 82 | ; flag so I don't do this patient again within 90 days
|
|---|
| 83 | S ^IBT(356,"ARDV",DFN,$$FMADD^XLFDT(DT,90))=""
|
|---|
| 84 | ;
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | RPC(IBD,IBICN) ; RPC entry for looking up insurance info
|
|---|
| 88 | N DFN,IBZ,IBX,IBY,IBP,IBI,IBT,IBZ
|
|---|
| 89 | S DFN=$$DFN^IBARXMU(IBICN) I 'DFN S IBD(0)="-1^ICN Not found" Q
|
|---|
| 90 | D ALL^IBCNS1(DFN,"IBY",3)
|
|---|
| 91 | I '$D(IBY) S IBD(0)="-1^No insurance on file" Q
|
|---|
| 92 | ; set up return format
|
|---|
| 93 | ; IBD(0) = # of insurance companies
|
|---|
| 94 | S IBD(0)=$G(IBY(0))
|
|---|
| 95 | ;
|
|---|
| 96 | ; where n starts at 1 and increments 6 for each insurance company
|
|---|
| 97 | ; IBD(n) = 355.33, zero node format
|
|---|
| 98 | ; IBD(n+1) = 355.33, 20 node format
|
|---|
| 99 | ; IBD(n+2) = 355.33, 21 node format
|
|---|
| 100 | ; IBD(n+3) = 355.33, 40 node format
|
|---|
| 101 | ; IBD(n+4) = 355.33, 60 node format
|
|---|
| 102 | ; IBD(n+5) = 355.33, 61 node format
|
|---|
| 103 | ;
|
|---|
| 104 | S IBP="|"
|
|---|
| 105 | 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
|
|---|
| 106 | . S IBZ=$P($G(IBY(IBI,+IBT)),"^",$P(IBT,IBP,2)) ; set the existing data
|
|---|
| 107 | . I $L($P(IBT,IBP,6)) X $P(IBT,IBP,6) ; output transform
|
|---|
| 108 | . S $P(IBD(IBI-1*6+$P(IBT,IBP,3)),"^",$P(IBT,IBP,4))=IBZ ; set data IBD
|
|---|
| 109 | Q
|
|---|
| 110 | ;
|
|---|
| 111 | MAP ; this is a mapping of data returned from ALL^IBCNS1 to the buffer file
|
|---|
| 112 | ; format is: node number | piece | extract node | extract piece
|
|---|
| 113 | ; | 355.33 field number | format out code (if any)
|
|---|
| 114 | ; | format in code (if any)
|
|---|
| 115 | ; the extract nodes will be sequential to match buffer file DD
|
|---|
| 116 | ;;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
|
|---|
| 117 | ;;0|2|5|4|60.04;subscriber id
|
|---|
| 118 | ;;0|4|5|3|60.03;experation date
|
|---|
| 119 | ;;0|6|5|5|60.05;who's insurance
|
|---|
| 120 | ;;0|8|5|2|60.02;effective date
|
|---|
| 121 | ;;0|16|5|6|60.06;pt relationship to insured
|
|---|
| 122 | ;;0|17|5|7|60.07;name of insured
|
|---|
| 123 | ;;0|20|5|12|60.12;coordination of benefits
|
|---|
| 124 | ;;1|3|1|10|.1||I IBZ<$$FMADD^XLFDT(DT,-180) K IBZ;date (last) verified
|
|---|
| 125 | ;;1|9|1|3|.03;source of information
|
|---|
| 126 | ;;2|1|6|5|61.05;send bill to employer
|
|---|
| 127 | ;;2|2|6|6|61.06;employer claims street address (line 1)
|
|---|
| 128 | ;;2|3|6|7|61.07;employer claims street address line 2
|
|---|
| 129 | ;;2|4|6|8|61.08;employer claims street address line 3
|
|---|
| 130 | ;;2|5|6|9|61.09;employer claims city
|
|---|
| 131 | ;;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
|
|---|
| 132 | ;;2|7|6|11|61.11;employer claims zip code
|
|---|
| 133 | ;;2|8|6|12|61.12;employer claims phone
|
|---|
| 134 | ;;2|10|6|1|61.01;esghp
|
|---|
| 135 | ;;2|11|6|3|61.03;employment status
|
|---|
| 136 | ;;2|12|6|4|61.04;retirement date
|
|---|
| 137 | ;;3|1|5|8|60.08;insured's dob
|
|---|
| 138 | ;;3|5|5|9|60.09;insured's ssn
|
|---|
| 139 | ;;3|12|5|13|60.13;insured's sex
|
|---|
| 140 | ;;4|1|5|10|60.1;primary care provider
|
|---|
| 141 | ;;4|2|5|11|60.11;primary provider phone
|
|---|
| 142 | ;;355.3|2|4|1|40.01;is this a group policy
|
|---|
| 143 | ;;355.3|3|4|2|40.02;group name
|
|---|
| 144 | ;;355.3|4|4|3|40.03;group number
|
|---|
| 145 | ;;355.3|5|4|4|40.04;(is) utilization required
|
|---|
| 146 | ;;355.3|6|4|5|40.05;(is) pre-certification required
|
|---|
| 147 | ;;355.3|7|4|7|40.07;exclude pre-existing condition
|
|---|
| 148 | ;;355.3|8|4|8|40.08;benefits assignable
|
|---|
| 149 | ;;355.3|9|4|9|40.09;type of plan
|
|---|
| 150 | ;;355.3|12|4|6|40.06;ambulatory care certification
|
|---|
| 151 | ;;36|2|2|5|20.05;reimburse
|
|---|
| 152 | ;;36.11|1|3|1|21.01;street address line 1
|
|---|
| 153 | ;;36.11|2|3|2|21.02;street address line 2
|
|---|
| 154 | ;;36.11|3|3|3|21.03;street address line 3
|
|---|
| 155 | ;;36.11|4|3|4|21.04;city
|
|---|
| 156 | ;;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
|
|---|
| 157 | ;;36.11|6|3|6|21.06;zip code
|
|---|
| 158 | ;;36.13|1|2|2|20.02;phone number
|
|---|
| 159 | ;;36.13|2|2|3|20.03;billing phone number
|
|---|
| 160 | ;;36.13|3|2|4|20.04;precertification phone number
|
|---|
| 161 | ;;
|
|---|
| 162 | ;
|
|---|
| 163 | SEND(IBH,IBX,IBICN,IBRPC) ; called to send off queries
|
|---|
| 164 | D EN1^XWB2HL7(.IBH,IBX,IBRPC,"",IBICN)
|
|---|
| 165 | Q
|
|---|
| 166 | ;
|
|---|
| 167 | CHECK(IBR,IBH) ; called to check the return status of an RPC
|
|---|
| 168 | D RPCCHK^XWB2HL7(.IBR,IBH)
|
|---|
| 169 | Q
|
|---|
| 170 | ;
|
|---|
| 171 | RETURN(IBR,IBH) ; called to get the return data and clear the broker
|
|---|
| 172 | N IBZ
|
|---|
| 173 | D RTNDATA^XWBDRPC(.IBR,IBH),CLEAR^XWBDRPC(.IBZ,IBH)
|
|---|
| 174 | Q
|
|---|
| 175 | ;
|
|---|
| 176 | TASK ; queue off task job
|
|---|
| 177 | N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE
|
|---|
| 178 | S ZTRTN="BACKGND^IBCNRDV",ZTDESC="Query Remote Facilities for Insurance",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT),(ZTIO,ZTSAVE("DFN"),ZTSAVE("IBSAVE*"),ZTSAVE("IBTYPE"))="" D ^%ZTLOAD
|
|---|
| 179 | Q
|
|---|
| 180 | ;
|
|---|
| 181 | TRKR(DFN,IBSAVEI,IBSAVEJ,IBDUZ) ; claims tracking entry
|
|---|
| 182 | N IBTYPE,IBT
|
|---|
| 183 | Q:$D(^IBT(356,"ARDV",DFN)) ; have already done recently
|
|---|
| 184 | Q:'$$TFL^IBARXMU(DFN,.IBT) ; no remote facilities
|
|---|
| 185 | S IBTYPE="TRKR" D
|
|---|
| 186 | . I DUZ=.5 N DUZ S DUZ=+$G(IBDUZ),DUZ(2)=+$$SITE^VASITE
|
|---|
| 187 | . D TASK
|
|---|
| 188 | Q
|
|---|
| 189 | ;
|
|---|
| 190 | ADM(DFN,IBSAVE1,IBSAVE2,IBSAVE3,IBSAVE4) ; admit event entry
|
|---|
| 191 | N IBTYPE S IBTYPE="ADM" D TASK
|
|---|
| 192 | Q
|
|---|
| 193 | ;
|
|---|
| 194 | FILE(IBX) ; updates data into the log file
|
|---|
| 195 | ;IBX = number of insurance co's found
|
|---|
| 196 | N DIC,DA,DIE,IBM,DO,X,Y,IBZ,DR
|
|---|
| 197 | S IBM=$E($$DT^XLFDT,1,5)_"00",DA=+$O(^IBA(355.34,"B",IBM,0))
|
|---|
| 198 | 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)
|
|---|
| 199 | L +^IBA(355.34,DA):10
|
|---|
| 200 | S IBZ=^IBA(355.34,DA,0),DIE="^IBA(355.34,"
|
|---|
| 201 | S DR=".02///"_($P(IBZ,"^",2)+1)_";.03///"_($P(IBZ,"^",3)+IBX) D ^DIE
|
|---|
| 202 | L -^IBA(355.34,DA)
|
|---|
| 203 | Q
|
|---|
