IBEFUNC3 ;ALB/ARH - EXTRINSIC FUNCTIONS ;26-FEB-02
;;2.0;INTEGRATED BILLING;**174,363**;21-MAR-94;Build 35
;;Per VHA Directive 2004-038, this routine should not be modified.
;;
BDSRC(IBVIFN) ; Check if billable Visit Data Source (9000010,81203)
; only 'PROSTHETICS DATA' is non-billable (patch IB*2*174) (these are item, not visits)
; Input: IBVIFN pointer to Visit (9000010)
; Returns: true if Billable Data Source
N IBDS,IBDSN,IBFLG S IBDSN="",IBFLG=1
;
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
. I IBDSN="PROSTHETICS DATA" S IBFLG=0
Q IBFLG
;
VALNDC(IBIFN,IBDFN,IBRXARY) ; NDC validation between file 362.4 and 52
; IB*2*363 - NDC from file 352.4 can become out-of-synch with the latest
; NDC# stored in the PRESCRIPTION file (#52) as the NDC can change after
; the bill has been entered. This algorithm compares the NDC# between
; the 2 files and returns a value which represents whether the NDC# values
; are the same or not the same.
; input - IBIFN = internal entry number of BILL/CLAIMS file (#399)
; IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
; output - IBRXARY = array (passed in by reference) representing the collection of Rx records
; that have different NDC#S between IB and OP files.
; IBARRAY = array containing values returned from the entry in file 362.4
; IBDA = internal entry number of the entry in file 362.4
; IBRXDA = pointer to entry in the PRESCRIPTION file (#52) associated with billing record
; IBDATE = Fill/refill date taken from entry in 362.4
; IBNDC = National Drug Code (NDC) number taken from entry in 362.4
; IB52NDC = NDC number taken from entry in file 52 associated with the billing record
N IBARRAY,IBDA,IBRXDA,IBDATE,IBNDC,IB52DATE,IB52NDC,IBRFL
K IBRXARY ; remove any incoming values
K ^TMP($J,"IBEFUNC3")
S IBDA=0 F S IBDA=$O(^IBA(362.4,"C",IBIFN,IBDA)) Q:'IBDA D
. D GETS^DIQ(362.4,IBDA_",",".02;.03;.05;.08","I","IBARRAY")
. S IBRXDA=IBARRAY(362.4,IBDA_",",.05,"I"),IBDATE=IBARRAY(362.4,IBDA_",",.03,"I")
. I 'IBRXDA Q ;try next if no RX ien
. S IBNDC=IBARRAY(362.4,IBDA_",",.08,"I")
. S IB52NDC=$$GETNDC(IBDFN,IBRXDA,IBDATE)
. S:IB52NDC'=IBNDC IBRXARY(IBRXDA)=$$RXAPI1^IBNCPUT1(IBRXDA,.01,"E")
Q
;
GETNDC(IBDFN,IBRXIEN,IBDT) ; get NDC# associated with fill/refill in file 52
; Approved usage of $$GETNDC^PSONDCUT function (IA 4705)
; Input - IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
; IBRXIEN = internal entry number of PRESCRIPTION file (#50) associated with the
; billing record
; IBDT = Fill/refill date taken from entry in 362.4
; Output - IBRXNDC = NDC number taken from sub-entry of REFILL multiple of file 52 associated
; with the billing record
; ; IB52DT = Fill/refill date taken from top entry or refill multiple of 52
N IBRXNDC,IB52DT
; RX^PSO52API returns data existing at the 0, 2, and refill multiple of file 52
D RX^PSO52API(IBDFN,"IBEFUNC3",IBRXIEN,,"2,R")
S IB52DT=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,22)) ; original fill date
I +IB52DT=IBDT S IBRXNDC=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,27)) ;original fill NDC#
E D
.; data examination needed on the REFILL multiple of file 52
.; IBSUBDA = REFILL multiple (52.1) IEN
. N IBSUBDA,IBQUIT
. S (IBQUIT,IBSUBDA,IBRXNDC)=0
. F S IBSUBDA=$O(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA)) Q:'IBSUBDA Q:IBQUIT D
. . S IB52DT=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA,.01)) ; refill date
. . I +IB52DT=IBDT S IBRXNDC=$$GETNDC^PSONDCUT(IBRXIEN,IBSUBDA),IBQUIT=1 ; refill NDC#
Q IBRXNDC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEFUNC3 3777 printed Apr 09, 2024@21:09:59 Page 2
IBEFUNC3 ;ALB/ARH - EXTRINSIC FUNCTIONS ;26-FEB-02
+1 ;;2.0;INTEGRATED BILLING;**174,363**;21-MAR-94;Build 35
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;;
BDSRC(IBVIFN) ; Check if billable Visit Data Source (9000010,81203)
+1 ; only 'PROSTHETICS DATA' is non-billable (patch IB*2*174) (these are item, not visits)
+2 ; Input: IBVIFN pointer to Visit (9000010)
+3 ; Returns: true if Billable Data Source
+4 NEW IBDS,IBDSN,IBFLG
SET IBDSN=""
SET IBFLG=1
+5 ;
+6 IF +$GET(IBVIFN)
SET IBDS=$PIECE($GET(^AUPNVSIT(+IBVIFN,812)),U,3)
IF +IBDS
SET IBDSN=$PIECE($GET(^PX(839.7,+IBDS,0)),U,1)
Begin DoDot:1
+7 IF IBDSN="PROSTHETICS DATA"
SET IBFLG=0
End DoDot:1
+8 QUIT IBFLG
+9 ;
VALNDC(IBIFN,IBDFN,IBRXARY) ; NDC validation between file 362.4 and 52
+1 ; IB*2*363 - NDC from file 352.4 can become out-of-synch with the latest
+2 ; NDC# stored in the PRESCRIPTION file (#52) as the NDC can change after
+3 ; the bill has been entered. This algorithm compares the NDC# between
+4 ; the 2 files and returns a value which represents whether the NDC# values
+5 ; are the same or not the same.
+6 ; input - IBIFN = internal entry number of BILL/CLAIMS file (#399)
+7 ; IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
+8 ; output - IBRXARY = array (passed in by reference) representing the collection of Rx records
+9 ; that have different NDC#S between IB and OP files.
+10 ; IBARRAY = array containing values returned from the entry in file 362.4
+11 ; IBDA = internal entry number of the entry in file 362.4
+12 ; IBRXDA = pointer to entry in the PRESCRIPTION file (#52) associated with billing record
+13 ; IBDATE = Fill/refill date taken from entry in 362.4
+14 ; IBNDC = National Drug Code (NDC) number taken from entry in 362.4
+15 ; IB52NDC = NDC number taken from entry in file 52 associated with the billing record
+16 NEW IBARRAY,IBDA,IBRXDA,IBDATE,IBNDC,IB52DATE,IB52NDC,IBRFL
+17 ; remove any incoming values
KILL IBRXARY
+18 KILL ^TMP($JOB,"IBEFUNC3")
+19 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBA(362.4,"C",IBIFN,IBDA))
if 'IBDA
QUIT
Begin DoDot:1
+20 DO GETS^DIQ(362.4,IBDA_",",".02;.03;.05;.08","I","IBARRAY")
+21 SET IBRXDA=IBARRAY(362.4,IBDA_",",.05,"I")
SET IBDATE=IBARRAY(362.4,IBDA_",",.03,"I")
+22 ;try next if no RX ien
IF 'IBRXDA
QUIT
+23 SET IBNDC=IBARRAY(362.4,IBDA_",",.08,"I")
+24 SET IB52NDC=$$GETNDC(IBDFN,IBRXDA,IBDATE)
+25 if IB52NDC'=IBNDC
SET IBRXARY(IBRXDA)=$$RXAPI1^IBNCPUT1(IBRXDA,.01,"E")
End DoDot:1
+26 QUIT
+27 ;
GETNDC(IBDFN,IBRXIEN,IBDT) ; get NDC# associated with fill/refill in file 52
+1 ; Approved usage of $$GETNDC^PSONDCUT function (IA 4705)
+2 ; Input - IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
+3 ; IBRXIEN = internal entry number of PRESCRIPTION file (#50) associated with the
+4 ; billing record
+5 ; IBDT = Fill/refill date taken from entry in 362.4
+6 ; Output - IBRXNDC = NDC number taken from sub-entry of REFILL multiple of file 52 associated
+7 ; with the billing record
+8 ; ; IB52DT = Fill/refill date taken from top entry or refill multiple of 52
+9 NEW IBRXNDC,IB52DT
+10 ; RX^PSO52API returns data existing at the 0, 2, and refill multiple of file 52
+11 DO RX^PSO52API(IBDFN,"IBEFUNC3",IBRXIEN,,"2,R")
+12 ; original fill date
SET IB52DT=$GET(^TMP($JOB,"IBEFUNC3",IBDFN,IBRXIEN,22))
+13 ;original fill NDC#
IF +IB52DT=IBDT
SET IBRXNDC=$GET(^TMP($JOB,"IBEFUNC3",IBDFN,IBRXIEN,27))
+14 IF '$TEST
Begin DoDot:1
+15 ; data examination needed on the REFILL multiple of file 52
+16 ; IBSUBDA = REFILL multiple (52.1) IEN
+17 NEW IBSUBDA,IBQUIT
+18 SET (IBQUIT,IBSUBDA,IBRXNDC)=0
+19 FOR
SET IBSUBDA=$ORDER(^TMP($JOB,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA))
if 'IBSUBDA
QUIT
if IBQUIT
QUIT
Begin DoDot:2
+20 ; refill date
SET IB52DT=$GET(^TMP($JOB,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA,.01))
+21 ; refill NDC#
IF +IB52DT=IBDT
SET IBRXNDC=$$GETNDC^PSONDCUT(IBRXIEN,IBSUBDA)
SET IBQUIT=1
End DoDot:2
End DoDot:1
+22 QUIT IBRXNDC
