| [613] | 1 | IBNCPDPU ;OAK/ELZ - UTILITIES FOR NCPCP ;24-JUN-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**223,276,347**;21-MAR-94;Build 24
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;NCPDP PHASE III
|
|---|
| 6 | Q
|
|---|
| 7 | ;IA 4702
|
|---|
| 8 | ;
|
|---|
| 9 | ;
|
|---|
| 10 | CT(DFN,IBRXN,IBFIL,IBADT,IBRMARK) ; files in claims tracking
|
|---|
| 11 | ; Input:
|
|---|
| 12 | ; DFN - Patient IEN
|
|---|
| 13 | ; IBRXN - Rx IEN
|
|---|
| 14 | ; IBFIL - Fill#
|
|---|
| 15 | ; IBADT - Fill Date
|
|---|
| 16 | ; IBRMARK - Non-billable Reason (.01 from 356.8)
|
|---|
| 17 | ;
|
|---|
| 18 | N DIE,DR,DA,IBRXTYP,IBEABD
|
|---|
| 19 | I IBTRKRN D:$D(IBRMARK) Q
|
|---|
| 20 | . S DIE="^IBT(356,",DA=IBTRKRN,DR=".19///"_IBRMARK D ^DIE
|
|---|
| 21 | ; event type pointer for rx billing
|
|---|
| 22 | S IBRXTYP=$O(^IBE(356.6,"AC",4,0))
|
|---|
| 23 | ; earliest auto-billing date
|
|---|
| 24 | S IBEABD=$$EABD^IBTUTL(IBRXTYP,$$FMADD^XLFDT(IBADT,60))
|
|---|
| 25 | ; space out earliest auto bill date
|
|---|
| 26 | D REFILL^IBTUTL1(DFN,IBRXTYP,IBADT,IBRXN,IBFIL,$G(IBRMARK),IBEABD)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | NDC(X) ; Massage the NDC as it is stored in Pharmacy
|
|---|
| 30 | ; Input: X -- The NDC as it is stored in Pharmacy
|
|---|
| 31 | ; Output: X -- The NDC in the format 5N 1"-" 4N 1"-" 2N
|
|---|
| 32 | ;
|
|---|
| 33 | I $G(X)="" S X="" G NDCQ
|
|---|
| 34 | ;
|
|---|
| 35 | N LEN,PCE,Y,Z
|
|---|
| 36 | ;
|
|---|
| 37 | S Z(1)=5,Z(2)=4,Z(3)=2
|
|---|
| 38 | S PCE=0 F S PCE=$O(Z(PCE)) Q:'PCE S LEN=Z(PCE) D
|
|---|
| 39 | .S Y=$P(X,"-",PCE)
|
|---|
| 40 | .I $L(Y)>LEN S Y=$E(Y,2,LEN+1)
|
|---|
| 41 | .I $L(+Y)<LEN S Y=$$FILL(Y,LEN)
|
|---|
| 42 | .S $P(X,"-",PCE)=Y
|
|---|
| 43 | ;
|
|---|
| 44 | NDCQ Q X
|
|---|
| 45 | ;
|
|---|
| 46 | FILL(X,LEN) ; Zero-fill, right justified.
|
|---|
| 47 | N Y
|
|---|
| 48 | S:'$G(LEN) LEN=1
|
|---|
| 49 | S Y=$E($G(X),1,LEN)
|
|---|
| 50 | F Q:$L(Y)>(LEN-1) S Y="0"_Y
|
|---|
| 51 | Q Y
|
|---|
| 52 | ;
|
|---|
| 53 | PLANN(DFN,IBX,IBADT) ; returns the ien in the insurance multiple for the given plan
|
|---|
| 54 | ; /patient privided.
|
|---|
| 55 | ; ien in multiple^insurance co ien
|
|---|
| 56 | N IBPOL,IBY,IBR
|
|---|
| 57 | S IBR=""
|
|---|
| 58 | D ALL^IBCNS1(DFN,"IBPOL",3,IBADT)
|
|---|
| 59 | S IBY=0 F S IBY=$O(IBPOL(IBY)) Q:IBY<1!(IBR) I $P(IBPOL(IBY,0),"^",18)=IBX S IBR=$P(IBPOL(IBY,0),"^")_"^"_IBY
|
|---|
| 60 | Q IBR
|
|---|
| 61 | ;
|
|---|
| 62 | RT(DFN,IBINS,IBN) ; returns rate type to use for bill
|
|---|
| 63 | ; pass in insurance by ref and which insurance entry to use
|
|---|
| 64 | ; if '$d(ibn) then it loops through to find the first one
|
|---|
| 65 | ; format is RT (ien) ^ Rate Type (Tort or Awp or Cost)
|
|---|
| 66 | N VAEL,VAERR,IBPT,IBRT,IBX
|
|---|
| 67 | D ELIG^VADPT
|
|---|
| 68 | ;
|
|---|
| 69 | ; if primary elig is vet type, use reimbursable
|
|---|
| 70 | S IBPT=$P($G(^DIC(8,+VAEL(1),0)),"^",5) ; = N:NON-VETERAN;Y:VETERAN
|
|---|
| 71 | I IBPT="Y" S IBRT=$O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)) Q $S(IBRT:IBRT,1:8)_"^T"
|
|---|
| 72 | ;
|
|---|
| 73 | ;**** temp for initial testing only, we are not doing Tricare or Champva
|
|---|
| 74 | Q $S($D(IBRT):IBRT,1:"0^unable to determine rate type")
|
|---|
| 75 | ;
|
|---|
| 76 | ; if primary elig is TRICARE/CHAMPUS use one of the champus', depending
|
|---|
| 77 | ; on insurance coverage
|
|---|
| 78 | I $P($G(^DIC(8.1,+$P($G(^DIC(8,+VAEL(3),0)),"^",9),0)),"^")="TRICARE/CHAMPUS" S IBRT=$$UINS("CHAMPUS",.IBINS,.IBN)
|
|---|
| 79 | ;
|
|---|
| 80 | ; if primary elig is CHAMPVA use one of the champva's, depending
|
|---|
| 81 | ; on insurance coverage
|
|---|
| 82 | I $P($G(^DIC(8.1,+$P($G(^DIC(8,+VAEL(3),0)),"^",9),0)),"^")="CHAMPVA" S IBRT=$$UINS("CHAMPVA",.IBINS,.IBN)
|
|---|
| 83 | ;
|
|---|
| 84 | Q $S($D(IBRT):IBRT,1:"0^unable to determine rate type")
|
|---|
| 85 | ;
|
|---|
| 86 | ;
|
|---|
| 87 | UINS(IBT,IBINS,IBN) ; in the case of tricare or champva you may have to use
|
|---|
| 88 | ; insurance different rate types insted of the actual tricare or champva
|
|---|
| 89 | N IBRT
|
|---|
| 90 | S IBN=+$G(IBN,$O(IBINS("S",+$O(IBINS("S",0)),0)))
|
|---|
| 91 | I $P($G(^IBE(355.1,+$P($G(IBINS(IBN,355.3)),"^",9),0)),"^")=IBT S IBRT=$O(^DGCR(399.3,"B",IBT,0)),IBRT=$S(IBRT:IBRT_"^"_$S(IBT="CHAMPUS":"A",1:"C"),1:"0^"_IBT_" Rate type not found")
|
|---|
| 92 | I '$D(IBRT) S IBRT=$O(^DGCR(399.3,"B",IBT_" REIMB. INS.",0)),IBRT=$S(IBRT:IBRT_"^"_$S(IBT="CHAMPUS":"A",1:"C"),1:"0^"_IBT_" REIMB. INS. Rate type not found")
|
|---|
| 93 | Q IBRT
|
|---|
| 94 | ;
|
|---|
| 95 | BS() ; returns the mccr utility to use
|
|---|
| 96 | N IBX
|
|---|
| 97 | S IBX=0 F S IBX=$O(^DGCR(399.1,"B","PRESCRIPTION",IBX)) Q:IBX<1 I $P($G(^DGCR(399.1,+$G(IBX),0)),U,5) Q
|
|---|
| 98 | Q IBX
|
|---|
| 99 | ;
|
|---|
| 100 | ; Match IB Bill by the 7-digit ECME number
|
|---|
| 101 | RXBIL(IBINP,IBERR) ; Matching NCPDP payments
|
|---|
| 102 | ;Input:
|
|---|
| 103 | ; IBINP("ECME") - the 7-digit ECME number (Reference Number)
|
|---|
| 104 | ; IBINP("FILLDT") - the Rx fill date, YYYYMMDD or FileMan format
|
|---|
| 105 | ; IBINP("PNM") (optional) - the patient's last name
|
|---|
| 106 | ;Returns:
|
|---|
| 107 | ; IBERR (by ref) - the error code, or null string if found
|
|---|
| 108 | ; $$RXBIL - IB Bill IEN, or 0 if not matched
|
|---|
| 109 | N IBKEY,IBECME,BILLDA,IBFOUND,IBMATCH,IBDAT,IBPNAME
|
|---|
| 110 | S IBERR=""
|
|---|
| 111 | S IBECME=$G(IBINP("ECME"))
|
|---|
| 112 | I IBECME'?1.7N S IBERR="Invalid ECME number" Q 0
|
|---|
| 113 | S IBDAT=$G(IBINP("FILLDT")) ; Rx fill date
|
|---|
| 114 | I IBDAT?8N S IBDAT=($E(IBDAT,1,4)-1700)_$E(IBDAT,5,8) ; conv date to FM format
|
|---|
| 115 | I IBDAT'?7N Q $$RXBILND(IBECME) ; date is not correct or null
|
|---|
| 116 | S IBPNAME=$G(IBINP("PNM")) ; patient's name (optional)
|
|---|
| 117 | S IBKEY=+IBECME_";"_IBDAT ; The ECME Number (BC ID)
|
|---|
| 118 | S BILLDA="",IBFOUND=0,IBMATCH=0
|
|---|
| 119 | ; Search backward
|
|---|
| 120 | F S BILLDA=$O(^DGCR(399,"AG",IBKEY,BILLDA),-1) Q:BILLDA="" D Q:IBFOUND
|
|---|
| 121 | . I 'BILLDA Q ; IEN must be numeric
|
|---|
| 122 | . I '$D(^DGCR(399,BILLDA,0)) Q ; Corrupted index
|
|---|
| 123 | . S IBMATCH=1
|
|---|
| 124 | . I IBPNAME'="" I '$$TXMATCH($P(IBPNAME,","),$P($G(^DPT(+$P(^DGCR(399,BILLDA,0),U,2),0)),","),8) Q ; Patient name doesn't match
|
|---|
| 125 | . S IBFOUND=1
|
|---|
| 126 | I 'BILLDA S IBERR=$S(IBMATCH:"Patient's name does not match",1:"Matching bill not found") ; not matched
|
|---|
| 127 | Q +BILLDA
|
|---|
| 128 | ;
|
|---|
| 129 | RXBILND(IBECME) ;Match the bill with no date
|
|---|
| 130 | N IBKEY,IBBC,BILLDA,IBY,IBCUT
|
|---|
| 131 | S IBKEY=+IBECME_";"
|
|---|
| 132 | S IBCUT=$$FMADD^XLFDT(DT,-180) ; only 180 days in the past
|
|---|
| 133 | S BILLDA=0
|
|---|
| 134 | ; Search PRNT/TX forward
|
|---|
| 135 | S IBBC=IBKEY_IBCUT
|
|---|
| 136 | F S IBBC=$O(^DGCR(399,"AG",IBBC)) Q:IBBC'[IBKEY D Q:BILLDA
|
|---|
| 137 | . S IBY="" F S IBY=$O(^DGCR(399,"AG",IBBC,IBY)) Q:'IBY D Q:BILLDA
|
|---|
| 138 | .. I $P($G(^DGCR(399,+IBY,0)),U,13)'=4 Q ; not PRNT/TX
|
|---|
| 139 | .. S BILLDA=+IBY
|
|---|
| 140 | I BILLDA Q BILLDA
|
|---|
| 141 | ; Search ANY backward
|
|---|
| 142 | S IBBC=IBKEY_"8000000"
|
|---|
| 143 | F S IBBC=$O(^DGCR(399,"AG",IBBC),-1) Q:IBBC'[IBKEY Q:$P(IBBC,";",2)<IBCUT D Q:BILLDA
|
|---|
| 144 | . S IBY="" F S IBY=$O(^DGCR(399,"AG",IBBC,IBY),-1) Q:IBY="" D Q:BILLDA
|
|---|
| 145 | .. ;I $P($G(^DGCR(399,+IBY,0)),U,13)'=7 Q ; not CANCELLED
|
|---|
| 146 | .. S BILLDA=+IBY
|
|---|
| 147 | Q BILLDA
|
|---|
| 148 | ;
|
|---|
| 149 | ;Check matching of two strings - case insensitive, no spaces etc.
|
|---|
| 150 | TXMATCH(IBTXT1,IBTXT2,IBMAX) ;
|
|---|
| 151 | N IBTR1,IBTR2,IBT1,IBT2
|
|---|
| 152 | ;Checking only first IBMAX characters (long names may be trancated
|
|---|
| 153 | S IBTR1="ABCDEFGHIJKLMNOPQRSTUVWXYZ:;"",'._()<>/\|@#$%&*-=!`~ "
|
|---|
| 154 | S IBTR2="abcdefghijklmnopqrstuvwxyz"
|
|---|
| 155 | S IBT1=$E($TR(IBTXT1,IBTR1,IBTR2),1,IBMAX)
|
|---|
| 156 | S IBT2=$E($TR(IBTXT2,IBTR1,IBTR2),1,IBMAX)
|
|---|
| 157 | Q IBT1=IBT2
|
|---|
| 158 | ;
|
|---|
| 159 | ECMEBIL(DFN,IBADT) ; Is the pat ECME Billable (pharmacy coverage only)
|
|---|
| 160 | ; DFN - ptr to the patient
|
|---|
| 161 | ; IBADT - the date
|
|---|
| 162 | N IBANY,IBERMSG,IBX,IBINS,IBT,IBZ,IBRES,IBCAT,IBCOV,IBPCOV
|
|---|
| 163 | S IBRES=0 ; Not ECME Billable by default
|
|---|
| 164 | S (IBCOV,IBPCOV)=0
|
|---|
| 165 | ; -- look up ins with Rx
|
|---|
| 166 | D ALL^IBCNS1(DFN,"IBINS",1,IBADT,1)
|
|---|
| 167 | S IBERMSG="" ; Error message
|
|---|
| 168 | S IBCAT=$O(^IBE(355.31,"B","PHARMACY",0))
|
|---|
| 169 | S IBX=0 F S IBX=$O(IBINS("S",IBX)) Q:'IBX D Q:IBRES
|
|---|
| 170 | . S IBT=0 F S IBT=$O(IBINS("S",IBX,IBT)) Q:'IBT D Q:IBRES
|
|---|
| 171 | . . N IBZ,IBPIEN,IBY,IBPL
|
|---|
| 172 | . . S IBZ=$G(IBINS(IBT,0))
|
|---|
| 173 | . . S IBPL=+$P(IBZ,U,18) Q:'IBPL
|
|---|
| 174 | . . S IBCOV=1 ; covered
|
|---|
| 175 | . . I '$$PLCOV^IBCNSU3(IBPL,IBADT,IBCAT) Q
|
|---|
| 176 | . . S IBPCOV=1
|
|---|
| 177 | . . S IBPIEN=+$G(^IBA(355.3,IBPL,6))
|
|---|
| 178 | . . I 'IBPIEN S IBERMSG="Plan not linked to the Payer" Q ; Not linked
|
|---|
| 179 | . . D STCHK^IBCNRU1(IBPIEN,.IBY)
|
|---|
| 180 | . . I $E($G(IBY(1)))'="A" S:IBERMSG="" IBERMSG=$$ERMSG^IBNCPDP1($P($G(IBY(6)),",")) Q
|
|---|
| 181 | . . S IBRES=1
|
|---|
| 182 | I 'IBCOV Q "0^Not Insured"
|
|---|
| 183 | I 'IBPCOV Q "0^No Pharmacy Coverage"
|
|---|
| 184 | I 'IBRES,IBERMSG'="" Q "0^"_IBERMSG
|
|---|
| 185 | I 'IBRES Q "0^No Insurance ECME billable"
|
|---|
| 186 | ;
|
|---|
| 187 | Q IBRES
|
|---|
| 188 | ;
|
|---|
| 189 | SUBMIT(IBRX,IBFIL) ; Submit the Rx claim through ECME
|
|---|
| 190 | ; IBRX - RX ien in file #52
|
|---|
| 191 | ; IBFIL - Fill No (0 for orig fill)
|
|---|
| 192 | N IBDT,IBNDC,IBX
|
|---|
| 193 | I '$G(IBRX)!('$D(IBFIL)) Q "0^Invalid parameters."
|
|---|
| 194 | S IBDT=$S('IBFIL:$$FILE^IBRXUTL(IBRX,22),1:$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,.01))
|
|---|
| 195 | S IBX=$$EN^BPSNCPDP(+IBRX,+IBFIL,IBDT,"BB")
|
|---|
| 196 | I +IBX=0 D ECMEACT^PSOBPSU1(+IBRX,+IBFIL,"Claim submitted to 3rd party payer: IB BACK BILLING")
|
|---|
| 197 | Q IBX
|
|---|
| 198 | ;
|
|---|
| 199 | REASON(IBX,EXACT) ; Close Claim Reasons
|
|---|
| 200 | Q $P($G(^IBE(356.8,+IBX,0)),U) ; non-billable reason
|
|---|
| 201 | ;
|
|---|
| 202 | NABP(IBIFN) ;NABP Number
|
|---|
| 203 | N IBY,IBTRKN,IBRX,IBFIL,IBZ,IBNABP
|
|---|
| 204 | S IBY=+$O(^IBT(356.399,"C",IBIFN,0)) I 'IBY Q ""
|
|---|
| 205 | S IBTRKN=$P($G(^IBT(356.399,IBY,0)),U) I 'IBTRKN Q ""
|
|---|
| 206 | S IBZ=$G(^IBT(356,IBTRKN,0)) I IBZ="" Q ""
|
|---|
| 207 | S IBRX=$P(IBZ,U,8)
|
|---|
| 208 | S IBFIL=$P(IBZ,U,10)
|
|---|
| 209 | S IBNABP=$$NABP^BPSBUTL(IBRX,IBFIL)
|
|---|
| 210 | Q $S(IBNABP=0:"",1:IBNABP)
|
|---|
| 211 | ;
|
|---|
| 212 | ; Get the K-bill# from CT
|
|---|
| 213 | BILL(IBRX,IBFIL) ;
|
|---|
| 214 | N IBTRKN,IBIFN
|
|---|
| 215 | S IBTRKN=+$O(^IBT(356,"ARXFL",+$G(IBRX),+$G(IBFIL),""))
|
|---|
| 216 | S IBIFN=+$P($G(^IBT(356,IBTRKN,0)),U,11)
|
|---|
| 217 | Q $P($G(^DGCR(399,IBIFN,0)),U)
|
|---|
| 218 | ;
|
|---|
| 219 | REJECT(IBECME,IBDATE) ; Is the e-claim rejected?
|
|---|
| 220 | N IBINP,IBTRKRN,IBY
|
|---|
| 221 | I IBECME'?1.7N Q 0
|
|---|
| 222 | ;S IBINP("ECME")=IBECME
|
|---|
| 223 | ;S IBINP("FILLDT")=IBDATE
|
|---|
| 224 | ;I $$RXBIL(.IBINP) Q 0 ; bill exists
|
|---|
| 225 | S IBTRKRN=+$O(^IBT(356,"AE",IBECME,0)) I 'IBTRKRN Q 0
|
|---|
| 226 | S IBY=$G(^IBT(356,IBTRKRN,1))
|
|---|
| 227 | I $P(IBY,U,11)>0 Q 1 ; Rejected or closed
|
|---|
| 228 | Q 0
|
|---|
| 229 | ;
|
|---|
| 230 | ;
|
|---|
| 231 | ;IBNCPDPU
|
|---|
