| [613] | 1 | IBCECSA7 ;ALB/ESG - VIEW EOB SCREEN CONTINUED ;26-JUN-2003
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**135,155**;21-MAR-1994
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | Q ; Must be called at proper entry points
|
|---|
| 6 | ;
|
|---|
| 7 | LLVLA ;line level adjustment
|
|---|
| 8 | Q:'$G(IBSRC) ; no MRA
|
|---|
| 9 | D MRALLA^IBCECSA5
|
|---|
| 10 | Q
|
|---|
| 11 | RDATA ;
|
|---|
| 12 | I '$G(IBSRC) Q ; no review data for IB/MRA
|
|---|
| 13 | I $G(IBSRC) Q ; no review data for AR either
|
|---|
| 14 | N IBRM,IBREC,IBFLG,IBFST
|
|---|
| 15 | S IB=$$SETSTR^VALM1("REVIEW DATA:","",1,50)
|
|---|
| 16 | D SET(IB)
|
|---|
| 17 | D CNTRL^VALM10(VALMCNT,1,12,IORVON,IORVOFF)
|
|---|
| 18 | S ^TMP("IBCECSD",$J,"X",8)=VALMCNT
|
|---|
| 19 | S (Y,IBFLG)=0 F S Y=$O(^IBM(361.1,IBCNT,21,Y)) Q:'Y D
|
|---|
| 20 | . S IBREC=$G(^IBM(361.1,IBCNT,21,Y,0)),IBFLG=1
|
|---|
| 21 | . D SET(" REVIEW DATE/TIME: "_$$DAT1^IBOUTL($P(IBREC,U),1))
|
|---|
| 22 | . S Z=0,IBFST=1 F S Z=$O(^IBM(361.1,IBCNT,21,Y,1,Z)) Q:'Z D
|
|---|
| 23 | .. S IBRM=$G(^IBM(361.1,IBCNT,21,Y,1,Z,0))
|
|---|
| 24 | .. D:IBFST SET(" COMMENT:"_$E(IBRM,1,68))
|
|---|
| 25 | .. D TXT^IBCECSA5(IBRM,68,11)
|
|---|
| 26 | .. S IBFST=0
|
|---|
| 27 | D:'IBFLG SET(" NONE")
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | ARCP ; A/R corrected payment data from splitting payment in EOB Worklist
|
|---|
| 31 | N Z,Z0
|
|---|
| 32 | I '$O(^IBM(361.1,IBCNT,8,0)) Q
|
|---|
| 33 | S IB=$$SETSTR^VALM1(" **A/R CORRECTED PAYMENT DATA:","",1,50)
|
|---|
| 34 | D SET(IB)
|
|---|
| 35 | I '$G(IBSRC) D
|
|---|
| 36 | . D CNTRL^VALM10(VALMCNT,1,27,IORVON,IORVOFF)
|
|---|
| 37 | . S ^TMP("IBCECSD",$J,"X",5)=VALMCNT
|
|---|
| 38 | D SET(" TOTAL AMT PD: "_$J(+$P($G(^IBM(361.1,IBCNT,1)),U,1),"",2))
|
|---|
| 39 | S Z=0 F S Z=$O(^IBM(361.1,IBCNT,8,Z)) Q:'Z S Z0=$G(^(Z,0)) D
|
|---|
| 40 | . S IB=$E($J("",6)_$S($P(Z0,U,3):$$BN1^PRCAFN(+$P(Z0,U,3)),1:"[suspense]"_$P(Z0,U))_$J("",25),1,25)_" "_$J(+$P(Z0,U,2),"",2)
|
|---|
| 41 | . D SET(IB)
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | INSINF(IBREC,CNT,IBCNT) ; Extract insured information (moved from IBCECSA6)
|
|---|
| 45 | N IB,IBZ,IBSEQ,IBREL,Z,Z0
|
|---|
| 46 | S IBSEQ=+$$COBN^IBCEF(IBREC)
|
|---|
| 47 | S IB=$$SETSTR^VALM1("Patient Name: "_$P($G(^DPT(+$P($G(^DGCR(399,IBREC,0)),U,2),0)),U),"",2,39)
|
|---|
| 48 | D F^IBCEF("N-ALL INSURED PT RELATION","IBZ",,IBREC)
|
|---|
| 49 | S IBREL=$G(IBZ(IBSEQ))
|
|---|
| 50 | S IB=$$SETSTR^VALM1("Pt. Relation : "_$$EXTERNAL^DILFD(2.312,16,"",IBREL),IB,41,38)
|
|---|
| 51 | D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
|
|---|
| 52 | S Z=2,Z0=39,IB=""
|
|---|
| 53 | I +IBREL'=1 D
|
|---|
| 54 | . D F^IBCEF("N-ALL INSURED FULL NAMES","IBZ",,IBREC)
|
|---|
| 55 | . S IB=$$SETSTR^VALM1("Insured Name: "_$G(IBZ(IBSEQ)),IB,Z,Z0)
|
|---|
| 56 | . S Z=41,Z0=38
|
|---|
| 57 | D F^IBCEF("N-ALL INSURANCE NUMBER","IBZ",,IBREC)
|
|---|
| 58 | S IB=$$SETSTR^VALM1("Insured ID "_$S(Z=41:" ",1:"")_": "_$G(IBZ(IBSEQ)),IB,Z,Z0)
|
|---|
| 59 | D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | SET(IB,IBSAV) ;
|
|---|
| 63 | I '$G(IBSAV) D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
