| 1 | IBNCPDP2 ;OAK/ELZ - PROCESSING FOR ECME RESP ;20-JUN-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**223,276,342,347,363**;21-MAR-94;Build 35
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;NCPDP PHASE III
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | ECME(DFN,IBD) ; function called by STORESP^IBNCPDP
|
|---|
| 9 | ; input - DFN - patient IEN for the prescription
|
|---|
| 10 | ; IBD array passed in by reference
|
|---|
| 11 | ; The IBD array is passed to various subroutines depending
|
|---|
| 12 | ; on the ePharmacy event as evaluated by IBD("STATUS")
|
|---|
| 13 | I $G(IBD("EPHARM"))="" S IBD("EPHARM")=$$EPHARM(+$G(IBD("PRESCRIPTION")),+$G(IBD("FILL NUMBER")))
|
|---|
| 14 | I IBD("STATUS")="PAID" Q $$BILL(DFN,.IBD)
|
|---|
| 15 | I IBD("STATUS")="REVERSED" Q $$REVERSE^IBNCPDP3(DFN,.IBD)
|
|---|
| 16 | I IBD("STATUS")="CLOSED" Q $$CLOSE^IBNCPDP4(DFN,.IBD)
|
|---|
| 17 | I IBD("STATUS")="RELEASED" Q $$RELEASE^IBNCPDP4(DFN,.IBD)
|
|---|
| 18 | I IBD("STATUS")="SUBMITTED" Q $$SUBMIT^IBNCPDP4(DFN,.IBD)
|
|---|
| 19 | I IBD("STATUS")="REOPEN" Q $$REOPEN^IBNCPDP4(DFN,.IBD)
|
|---|
| 20 | D LOG("UNKNOWN")
|
|---|
| 21 | Q "0^Cannot determine ECME event status"
|
|---|
| 22 | ;
|
|---|
| 23 | MATCH(BCID) ;
|
|---|
| 24 | N IBX,IBHAVE
|
|---|
| 25 | S IBX=0,IBHAVE=0 F S IBX=$O(^DGCR(399,"AG",BCID,IBX)) Q:'IBX S IBHAVE=1 I '$P($G(^DGCR(399,IBX,"S")),U,16) Q
|
|---|
| 26 | I 'IBX,IBHAVE Q ""
|
|---|
| 27 | Q +IBX
|
|---|
| 28 | ;
|
|---|
| 29 | ;
|
|---|
| 30 | BILL(DFN,IBD) ; create fi bill
|
|---|
| 31 | N IBRVCD,IBBS,IBUNITS,IBCPT,IBDIV,IBAA,IBTYPE,IBITEM,IBAMT,IBY,IBSERV,IBFAC,IBSITE,IBDRX,IB,IBCDFN,IBINS,IBIDS,IBIFN,IBDFN,PRCASV,PRCAERR,IBADT,IBRXN,IBFIL,IBTRKRN,DIE,DA,DR,IBRES,IBLOCK,IBLDT,IBNOW,IBDUZ,RCDUZ,IBPREV,IBQUERY,IBPAID,IBACT
|
|---|
| 32 | ;
|
|---|
| 33 | S IBDUZ=.5 ;POSTMASTER
|
|---|
| 34 | ;I $G(IBD("FILLED BY")),$D(^VA(200,+IBD("FILLED BY"))) S IBDUZ=+IBD("FILLED BY")
|
|---|
| 35 | S RCDUZ=IBDUZ
|
|---|
| 36 | ;
|
|---|
| 37 | S IBY=1,IBLOCK=0
|
|---|
| 38 | I 'DFN S IBY="0^Missing DFN" G BILLQ
|
|---|
| 39 | S IBAMT=+$G(IBD("BILLED")) ;FI portion of charge
|
|---|
| 40 | I 'IBAMT S IBY="-1^Zero amount billed" G BILLQ
|
|---|
| 41 | S IBADT=+$G(IBD("FILL DATE"),DT)
|
|---|
| 42 | S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBY="0^Missing Rx IEN" G BILLQ
|
|---|
| 43 | S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBY="0^No fill number" G BILLQ
|
|---|
| 44 | S IBDIV=+$G(IBD("DIVISION"))
|
|---|
| 45 | I '$L($G(IBD("CLAIMID"))) S IBY="-1^Missing ECME Number" G BILLQ
|
|---|
| 46 | S IBD("BCID")=(+IBD("CLAIMID"))_";"_IBADT ; The BCID#
|
|---|
| 47 | L +^DGCR(399,"AG",IBD("BCID")):15 E S IBY="0^Cannot lock ECME number." G BILLQ
|
|---|
| 48 | S IBLOCK=1
|
|---|
| 49 | S IBLDT=$G(^DGCR(399,"AG",IBD("BCID"))) ;Last time called
|
|---|
| 50 | D NOW^%DTC S IBNOW=%
|
|---|
| 51 | ; 2 calls in 45 sec
|
|---|
| 52 | I $P(IBLDT,"^",2)="B" I $$FMDIFF^XLFDT(IBNOW,+IBLDT,2)<45 S IBY="0^Duplicate billing call" G BILLQ
|
|---|
| 53 | ;
|
|---|
| 54 | I $$MATCH(IBD("BCID")) D ;cancel the previous bill
|
|---|
| 55 | . N IBARR M IBARR=IBD I $$REVERSE^IBNCPDP3(DFN,.IBARR,2)
|
|---|
| 56 | ;
|
|---|
| 57 | ; derive minimal variables
|
|---|
| 58 | I '$$CHECK^IBECEAU(0) S IBY="-1^IB SITE" G BILLQ
|
|---|
| 59 | S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4)
|
|---|
| 60 | I '$$SERV^IBARX1(IBSERV) S IBY="-1^IB SERVICE" G BILLQ
|
|---|
| 61 | I 'IBDIV S IBDIV=$P($$MCDIV^IBNCPEB(IBRXN,IBFIL),U,2)
|
|---|
| 62 | I 'IBDIV S IBDIV=+$P($G(^SC(+$$FILE^IBRXUTL(IBRXN,5),0)),"^",15)
|
|---|
| 63 | I 'IBDIV S IBDIV=+$P($G(^IBE(350.9,1,1)),U,25) ;dflt
|
|---|
| 64 | I IBDIV S IBD("DIVISION")=IBDIV
|
|---|
| 65 | ; - establish a stub claim/receivable
|
|---|
| 66 | D SET^IBR I IBY<0 G BILLQ
|
|---|
| 67 | ;
|
|---|
| 68 | ; set up the following variables for claim establishment:
|
|---|
| 69 | ; .01 BILL #
|
|---|
| 70 | ; .17 ORIG CLAIM
|
|---|
| 71 | ; .2 AUTO?
|
|---|
| 72 | ; .02 DFN
|
|---|
| 73 | ; .06 TIMEFRAME
|
|---|
| 74 | ; .07 RATE TYPE
|
|---|
| 75 | ; .18 SC AT TIME?
|
|---|
| 76 | ; .04 LOCATION
|
|---|
| 77 | ; .22 DIVISION
|
|---|
| 78 | ; .05 BILL CLASSIF (3)
|
|---|
| 79 | ; .03 EVT DATE (FILL DATE)
|
|---|
| 80 | ; 151 BILL FROM
|
|---|
| 81 | ; 152 BILL TO
|
|---|
| 82 | ; 101 PRIMARY INS CARRIER
|
|---|
| 83 | K IB
|
|---|
| 84 | S (IB(.02),IBDFN)=DFN
|
|---|
| 85 | S IB(.07)=+$$RT^IBNCPDPU(DFN)
|
|---|
| 86 | I 'IB(.07) S IBY="-1^IB RATE TYPE" G BILLQ
|
|---|
| 87 | ;
|
|---|
| 88 | S IBIFN=PRCASV("ARREC")
|
|---|
| 89 | S IB(.01)=$P(PRCASV("ARBIL"),"-",2)
|
|---|
| 90 | S IB(.17)=""
|
|---|
| 91 | S IB(.2)=0
|
|---|
| 92 | S IB(.06)=1
|
|---|
| 93 | S IB(.18)=$$SC^IBCU3(DFN)
|
|---|
| 94 | S IB(.04)=$S(+$P($G(^DG(40.8,+IBDIV,0)),U,3):7,1:1)
|
|---|
| 95 | S:IBDIV IB(.22)=+IBDIV
|
|---|
| 96 | S IB(.05)=3
|
|---|
| 97 | S (IB(.03),IB(151),IB(152))=IBADT
|
|---|
| 98 | S IBINS=$P($G(^IBA(355.3,+$G(IBD("PLAN")),0)),"^") I IBINS S IB(101)=IBINS
|
|---|
| 99 | ;
|
|---|
| 100 | ; set 362.4 node to rx#^p50^days sup^fill date^qty^ndc
|
|---|
| 101 | S IB(362.4,IBRXN,1)=IBD("RX NO")_"^"_IBD("DRUG")_"^"_IBD("DAYS SUPPLY")_"^"_IBD("FILL DATE")_"^"_IBD("QTY")_"^"_IBD("NDC")
|
|---|
| 102 | ;
|
|---|
| 103 | ; call the autobiller module to create the claim with a default
|
|---|
| 104 | ; diagnosis and procedure for prescriptions
|
|---|
| 105 | D EN^IBCD3(.IBQUERY)
|
|---|
| 106 | D CLOSE^IBSDU(.IBQUERY)
|
|---|
| 107 | ;
|
|---|
| 108 | S ^DGCR(399,"AG",IBD("BCID"))=IBNOW_"^B"
|
|---|
| 109 | S DIE="^DGCR(399,",DA=IBIFN
|
|---|
| 110 | ; update the ECME fields
|
|---|
| 111 | S DR="460////^S X=IBD(""BCID"")" S:$L($G(IBD("AUTH #"))) DR=DR_";461////^S X=IBD(""AUTH #"")"
|
|---|
| 112 | D ^DIE K DA,DR,DIE
|
|---|
| 113 | D SETCT ; Set Claims Tracking record
|
|---|
| 114 | ;
|
|---|
| 115 | ; IEN to 2.3121
|
|---|
| 116 | S IBCDFN=$$PLANN^IBNCPDPU(DFN,IBD("PLAN"),IBADT)
|
|---|
| 117 | I 'IBCDFN S IBY="-1^Plan not found in Patient's Profile." G BILLQ
|
|---|
| 118 | ;
|
|---|
| 119 | ; add the payer (fiscal intermediary) to the claim
|
|---|
| 120 | S IBINS=+IBCDFN,IBCDFN=$P(IBCDFN,"^",2)
|
|---|
| 121 | S DIE="^DGCR(399,",DA=IBIFN,DR="112////"_IBCDFN
|
|---|
| 122 | D ^DIE K DA,DR,DIE,DGRVRCAL
|
|---|
| 123 | ;
|
|---|
| 124 | ; need to make sure we have computed charges.
|
|---|
| 125 | D BILL^IBCRBC(IBIFN)
|
|---|
| 126 | ;
|
|---|
| 127 | ; update the authorize/print fields
|
|---|
| 128 | S DIE="^DGCR(399,",DA=IBIFN
|
|---|
| 129 | S DR="9////1;12////"_DT D ^DIE
|
|---|
| 130 | K DA,DR,DIE
|
|---|
| 131 | ;
|
|---|
| 132 | ; pass the claim to AR
|
|---|
| 133 | D GVAR^IBCBB,ARRAY^IBCBB1 S PRCASV("APR")=IBDUZ D ^PRCASVC6
|
|---|
| 134 | I 'PRCASV("OKAY") S IBY="-1^Cannot establish receivable in AR." G BILLQ
|
|---|
| 135 | D REL^PRCASVC
|
|---|
| 136 | ;
|
|---|
| 137 | ; update the AR status to Active
|
|---|
| 138 | ; D AUDITX^PRCAUDT(PRCASV("ARREC"))
|
|---|
| 139 | S PRCASV("STATUS")=16
|
|---|
| 140 | D STATUS^PRCASVC1
|
|---|
| 141 | ;
|
|---|
| 142 | ; decrease adjust bill
|
|---|
| 143 | ; Auto decrease from service Bill#,Tran amt,person,reason,Tran date
|
|---|
| 144 | S IBAMT=$G(^DGCR(399,IBIFN,"U1"))
|
|---|
| 145 | S IBPAID=IBD("PAID")
|
|---|
| 146 | D:IBAMT-IBPAID>.01
|
|---|
| 147 | . D DEC^PRCASER1(PRCASV("ARREC"),IBAMT-IBPAID,IBDUZ,"Adjust based on ECME amount paid.",IBADT)
|
|---|
| 148 | . I 'IBPAID S PRCASV("STATUS")=22 D STATUS^PRCASVC1 ; collected/closed
|
|---|
| 149 | ;
|
|---|
| 150 | D ; set the user in 399
|
|---|
| 151 | . N IBI,IBT F IBI=2,5,11,13,15 S IBT(399,IBIFN_",",IBI)=IBDUZ
|
|---|
| 152 | . D FILE^DIE("","IBT")
|
|---|
| 153 | ;
|
|---|
| 154 | BILLQ S IBRES=$S(IBY<0:"0^"_$S($L($P(IBY,"^",2)):$P(IBY,"^",2),1:$P(IBY,"^",3)),$G(IBIFN):+IBIFN,1:IBY)
|
|---|
| 155 | I $G(IBIFN) S IBD("BILL")=IBIFN
|
|---|
| 156 | D LOG("BILL",IBRES)
|
|---|
| 157 | I IBY<0 D BULL^IBNCPEB($G(DFN),.IBD,IBRES,$G(IBIFN))
|
|---|
| 158 | I IBLOCK L -^DGCR(399,"AG",IBD("BCID"))
|
|---|
| 159 | Q IBRES
|
|---|
| 160 | ;
|
|---|
| 161 | ; update claims tracking saying bill has been billed
|
|---|
| 162 | SETCT ;
|
|---|
| 163 | S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0))
|
|---|
| 164 | I IBTRKRN S DIE="^IBT(356,",DA=IBTRKRN,DR=".11////^S X=IBIFN;.17///@" D ^DIE
|
|---|
| 165 | I IBTRKRN,IBIFN D CTB^IBCDC(IBTRKRN,IBIFN)
|
|---|
| 166 | Q
|
|---|
| 167 | ;
|
|---|
| 168 | ;/**
|
|---|
| 169 | ;Log values passed into IB by outside applications
|
|---|
| 170 | ;
|
|---|
| 171 | ;implicit input variables/arrays :
|
|---|
| 172 | ; IBD array with values sent to IB (see calling subroutines)
|
|---|
| 173 | ; DFN - patient's IEN (file #2)
|
|---|
| 174 | ; DUZ - user's IEN(file #200)
|
|---|
| 175 | ;explicit parameters:
|
|---|
| 176 | ; PROC - type of event as string, i.e. BILL, REJECT and so on
|
|---|
| 177 | ; RESULT - result of the event processing, format: return_code^message
|
|---|
| 178 | LOG(PROC,RESULT) ;Store the data
|
|---|
| 179 | D LOG^IBNCPLOG(.IBD,DFN,PROC,RESULT,$J,$$NOW^XLFDT(),+DUZ)
|
|---|
| 180 | Q
|
|---|
| 181 | ;
|
|---|
| 182 | ;returns ien of #9002313.56 BPS PHARMACIES associated
|
|---|
| 183 | ;with the prescription specified by:
|
|---|
| 184 | ; IBRX - IEN in file #52
|
|---|
| 185 | ; IBREFILL - zero(0) for the original prescription or the refill
|
|---|
| 186 | ; number for a refill (IEN of REFILL multiple #52.1)
|
|---|
| 187 | EPHARM(IBRX,IBREFILL) ;
|
|---|
| 188 | I +$G(IBRX)=0 Q ""
|
|---|
| 189 | I $G(IBREFILL)="" Q ""
|
|---|
| 190 | N IBDIV59
|
|---|
| 191 | S IBDIV59=+$$RXSITE^PSOBPSUT(+IBRX,+IBREFILL)
|
|---|
| 192 | I IBDIV59>0 Q $$GETPHARM^BPSUTIL(IBDIV59)
|
|---|
| 193 | Q ""
|
|---|
| 194 | ;
|
|---|
| 195 | ;IBNCPDP2
|
|---|
