Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBEFUNC3

IBEFUNC3.m

Go to the documentation of this file.
  1. IBEFUNC3 ;ALB/ARH - EXTRINSIC FUNCTIONS ;26-FEB-02
  1. ;;2.0;INTEGRATED BILLING;**174,363**;21-MAR-94;Build 35
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;;
  1. 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)
  1. ; Input: IBVIFN pointer to Visit (9000010)
  1. ; Returns: true if Billable Data Source
  1. N IBDS,IBDSN,IBFLG S IBDSN="",IBFLG=1
  1. ;
  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
  1. . I IBDSN="PROSTHETICS DATA" S IBFLG=0
  1. Q IBFLG
  1. ;
  1. 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
  1. ; NDC# stored in the PRESCRIPTION file (#52) as the NDC can change after
  1. ; the bill has been entered. This algorithm compares the NDC# between
  1. ; the 2 files and returns a value which represents whether the NDC# values
  1. ; are the same or not the same.
  1. ; input - IBIFN = internal entry number of BILL/CLAIMS file (#399)
  1. ; IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
  1. ; output - IBRXARY = array (passed in by reference) representing the collection of Rx records
  1. ; that have different NDC#S between IB and OP files.
  1. ; IBARRAY = array containing values returned from the entry in file 362.4
  1. ; IBDA = internal entry number of the entry in file 362.4
  1. ; IBRXDA = pointer to entry in the PRESCRIPTION file (#52) associated with billing record
  1. ; IBDATE = Fill/refill date taken from entry in 362.4
  1. ; IBNDC = National Drug Code (NDC) number taken from entry in 362.4
  1. ; IB52NDC = NDC number taken from entry in file 52 associated with the billing record
  1. N IBARRAY,IBDA,IBRXDA,IBDATE,IBNDC,IB52DATE,IB52NDC,IBRFL
  1. K IBRXARY ; remove any incoming values
  1. K ^TMP($J,"IBEFUNC3")
  1. S IBDA=0 F S IBDA=$O(^IBA(362.4,"C",IBIFN,IBDA)) Q:'IBDA D
  1. . D GETS^DIQ(362.4,IBDA_",",".02;.03;.05;.08","I","IBARRAY")
  1. . S IBRXDA=IBARRAY(362.4,IBDA_",",.05,"I"),IBDATE=IBARRAY(362.4,IBDA_",",.03,"I")
  1. . I 'IBRXDA Q ;try next if no RX ien
  1. . S IBNDC=IBARRAY(362.4,IBDA_",",.08,"I")
  1. . S IB52NDC=$$GETNDC(IBDFN,IBRXDA,IBDATE)
  1. . S:IB52NDC'=IBNDC IBRXARY(IBRXDA)=$$RXAPI1^IBNCPUT1(IBRXDA,.01,"E")
  1. Q
  1. ;
  1. GETNDC(IBDFN,IBRXIEN,IBDT) ; get NDC# associated with fill/refill in file 52
  1. ; Approved usage of $$GETNDC^PSONDCUT function (IA 4705)
  1. ; Input - IBDFN = internal entry number of PATIENT file (#2) associated with the billing record
  1. ; IBRXIEN = internal entry number of PRESCRIPTION file (#50) associated with the
  1. ; billing record
  1. ; IBDT = Fill/refill date taken from entry in 362.4
  1. ; Output - IBRXNDC = NDC number taken from sub-entry of REFILL multiple of file 52 associated
  1. ; with the billing record
  1. ; ; IB52DT = Fill/refill date taken from top entry or refill multiple of 52
  1. N IBRXNDC,IB52DT
  1. ; RX^PSO52API returns data existing at the 0, 2, and refill multiple of file 52
  1. D RX^PSO52API(IBDFN,"IBEFUNC3",IBRXIEN,,"2,R")
  1. S IB52DT=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,22)) ; original fill date
  1. I +IB52DT=IBDT S IBRXNDC=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,27)) ;original fill NDC#
  1. E D
  1. .; data examination needed on the REFILL multiple of file 52
  1. .; IBSUBDA = REFILL multiple (52.1) IEN
  1. . N IBSUBDA,IBQUIT
  1. . S (IBQUIT,IBSUBDA,IBRXNDC)=0
  1. . F S IBSUBDA=$O(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA)) Q:'IBSUBDA Q:IBQUIT D
  1. . . S IB52DT=$G(^TMP($J,"IBEFUNC3",IBDFN,IBRXIEN,"RF",IBSUBDA,.01)) ; refill date
  1. . . I +IB52DT=IBDT S IBRXNDC=$$GETNDC^PSONDCUT(IBRXIEN,IBSUBDA),IBQUIT=1 ; refill NDC#
  1. Q IBRXNDC