| [613] | 1 | IBEFUNC3 ;ALB/ARH - EXTRINSIC FUNCTIONS ;26-FEB-02
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**174,363**;21-MAR-94;Build 35
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;;
|
|---|
| 5 | BDSRC(IBVIFN) ; Check if billable Visit Data Source (9000010,81203)
|
|---|
| 6 | ; only 'PROSTHETICS DATA' is non-billable (patch IB*2*174) (these are item, not visits)
|
|---|
| 7 | ; Input: IBVIFN pointer to Visit (9000010)
|
|---|
| 8 | ; Returns: true if Billable Data Source
|
|---|
| 9 | N IBDS,IBDSN,IBFLG S IBDSN="",IBFLG=1
|
|---|
| 10 | ;
|
|---|
| 11 | I +$G(IBVIFN) S IBDS=$P($G(^AUPNVSIT(+IBVIFN,812)),U,3) I +IBDS S IBDSN=$P($G(^PX(839.7,+IBDS,0)),U,1) D
|
|---|
| 12 | . I IBDSN="PROSTHETICS DATA" S IBFLG=0
|
|---|
| 13 | Q IBFLG
|
|---|
| 14 | ;
|
|---|
| 15 | VALNDC(IBIFN,IBDFN,IBRXARY) ; NDC validation between file 362.4 and 52
|
|---|
| 16 | ; IB*2*363 - NDC from file 352.4 can become out-of-synch with the latest
|
|---|
| 17 | ; NDC# stored in the PRESCRIPTION file (#52) as the NDC can change after
|
|---|
| 18 | ; the bill has been entered. This algorithm compares the NDC# between
|
|---|
| 19 | ; the 2 files and returns a value which represents whether the NDC# values
|
|---|
| 20 | ; are the same or not the same.
|
|---|
| 21 | ; input - IBIFN = internal entry number of BILL/CLAIMS file (#399)
|
|---|
| 22 | ; IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
|
|---|
| 23 | ; output - IBRXARY = array (passed in by reference) representing the collection of Rx records
|
|---|
| 24 | ; that have different NDC#S between IB and OP files.
|
|---|
| 25 | ; IBARRAY = array containing values returned from the entry in file 362.4
|
|---|
| 26 | ; IBDA = internal entry number of the entry in file 362.4
|
|---|
| 27 | ; IBRXDA = pointer to entry in the PRESCRIPTION file (#52) associated with billing record
|
|---|
| 28 | ; IBDATE = Fill/refill date taken from entry in 362.4
|
|---|
| 29 | ; IBNDC = National Drug Code (NDC) number taken from entry in 362.4
|
|---|
| 30 | ; IB52NDC = NDC number taken from entry in file 52 associated with the billing record
|
|---|
| 31 | N IBARRAY,IBDA,IBRXDA,IBDATE,IBNDC,IB52DATE,IB52NDC,IBRFL
|
|---|
| 32 | K IBRXARY ; remove any incoming values
|
|---|
| 33 | K ^TMP($J,"IBEFUNC3")
|
|---|
| 34 | S IBDA=0 F S IBDA=$O(^IBA(362.4,"C",IBIFN,IBDA)) Q:'IBDA D
|
|---|
| 35 | . D GETS^DIQ(362.4,IBDA_",",".02;.03;.05;.08","I","IBARRAY")
|
|---|
| 36 | . S IBRXDA=IBARRAY(362.4,IBDA_",",.05,"I"),IBDATE=IBARRAY(362.4,IBDA_",",.03,"I")
|
|---|
| 37 | . I 'IBRXDA Q ;try next if no RX ien
|
|---|
| 38 | . S IBNDC=IBARRAY(362.4,IBDA_",",.08,"I")
|
|---|
| 39 | . S IB52NDC=$$GETNDC(IBDFN,IBRXDA,IBDATE)
|
|---|
| 40 | . S:IB52NDC'=IBNDC IBRXARY(IBRXDA)=$$RXAPI1^IBNCPUT1(IBRXDA,.01,"E")
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | GETNDC(IBDFN,IBRXIEN,IBDT) ; get NDC# associated with fill/refill in file 52
|
|---|
| 44 | ; Approved usage of $$GETNDC^PSONDCUT function (IA 4705)
|
|---|
| 45 | ; Input - IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
|
|---|
| 46 | ; IBRXIEN = internal entry number of PRESCRIPTION file (#50) associated with the
|
|---|
| 47 | ; billing record
|
|---|
| 48 | ; IBDT = Fill/refill date taken from entry in 362.4
|
|---|
| 49 | ; Output - IBRXNDC = NDC number taken from sub-entry of REFILL multiple of file 52 associated
|
|---|
| 50 | ; with the billing record
|
|---|
| 51 | ; ; IB52DT = Fill/refill date taken from top entry or refill multiple of 52
|
|---|
| 52 | N IBRXNDC,IB52DT
|
|---|
| 53 | ; RX^PSO52API returns data existing at the 0, 2, and refill multiple of file 52
|
|---|
| 54 | D RX^PSO52API(IBDFN,"IBEFUNC3",IBRXIEN,,"2,R")
|
|---|
| 55 | S IB52DT=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,22)) ; original fill date
|
|---|
| 56 | I +IB52DT=IBDT S IBRXNDC=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,27)) ;original fill NDC#
|
|---|
| 57 | E D
|
|---|
| 58 | .; data examination needed on the REFILL multiple of file 52
|
|---|
| 59 | .; IBSUBDA = REFILL multiple (52.1) IEN
|
|---|
| 60 | . N IBSUBDA,IBQUIT
|
|---|
| 61 | . S (IBQUIT,IBSUBDA,IBRXNDC)=0
|
|---|
| 62 | . F S IBSUBDA=$O(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA)) Q:'IBSUBDA Q:IBQUIT D
|
|---|
| 63 | . . S IB52DT=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA,.01)) ; refill date
|
|---|
| 64 | . . I +IB52DT=IBDT S IBRXNDC=$$GETNDC^PSONDCUT(IBRXIEN,IBSUBDA),IBQUIT=1 ; refill NDC#
|
|---|
| 65 | Q IBRXNDC
|
|---|
