Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF73A.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF73A.m (modified) (3 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF73A.m

@@ -1 +1 @@
 IBCEF73A ;ALB/KJH - FORMATTER AND EXTRACTOR SPECIFIC (NPI) BILL FUNCTIONS ; 30 Aug 2006  10:38 AM
- ;;2.0;INTEGRATED BILLING;**343,374,395**;21-MAR-94;Build 3
+ ;;2.0;INTEGRATED BILLING;**343,374**;21-MAR-94;Build 16
  ;; Per VHA Directive 10-93-142, this routine should not be modified.
  ;
@@ -104 +104 @@
  I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U,3)=NPI
  I NPI<1,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3)
- I $$ISRX^IBCEF1(IBIEN399) S IBORG=$$RXSITE(IBIEN399) I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U,3)=NPI
  Q IBRETVAL
  ;
@@ -129 +128 @@
  I '$L(TAX),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":3,1:IBNOTAX_U_3)
  Q IBRETVAL
- ;
-RXSITE(IBIEN399,IBLIST) ; returns prescription organization (file 4) pointer
- ; for the given bill.  If IBLIST passed by reference, then a list of
- ; the possible organizations are returned for a bill, since a bill may
- ; have more than one prescription.  If more than one rx on the bill, the
- ; $$ return is the pointer of the last prescription found.
- ; IBLIST(rx ien,fill date)=ORGINATION (file 4 pointer)
- ;
- N IBX,IBDATA,IBORG,IBRX,IBDT,IBY,IBRXN,DFN
- K ^TMP($J,"IBCEF73A")
- S IBORG=0,DFN=$P($G(^DGCR(399,IBIEN399,0)),"^",2),IBLIST="IBCEF73A"
- S IBRXN=0 F  S IBRXN=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN)) Q:'IBRXN  S IBX=0 F  S IBX=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN,IBX)) Q:'IBX  D
- . S IBDATA=$G(^IBA(362.4,IBX,0))
- . S IBRX=$P(IBDATA,"^",5),IBDT=$P(IBDATA,"^",3) Q:'IBRX!('IBDT)
- . D RX^PSO52API(DFN,IBLIST,IBRX,,"0,2,R")
- . I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,22)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,20))) Q
- . S IBY=0 F  S IBY=$O(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY)) Q:'IBY  I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,.01)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,8))) Q
- K ^TMP($J,"IBCEF73A")
- Q IBORG
- ;
-PSONPI(IB59IEN) ; returns institution ien for a file 59 ien
- N IB4IEN
- K ^TMP($J,"IBCEF59")
- D PSS^PSO59(IB59IEN,,"IBCEF59")
- S IB4IEN=+$G(^TMP($J,"IBCEF59",IB59IEN,101))
- K ^TMP($J,"IBCEF59")
- Q IB4IEN