- IBCECSA7 ;ALB/ESG - VIEW EOB SCREEN CONTINUED ;26-JUN-2003
- ;;2.0;INTEGRATED BILLING;**135,155**;21-MAR-1994
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- Q ; Must be called at proper entry points
- ;
- LLVLA ;line level adjustment
- Q:'$G(IBSRC) ; no MRA
- D MRALLA^IBCECSA5
- Q
- RDATA ;
- I '$G(IBSRC) Q ; no review data for IB/MRA
- I $G(IBSRC) Q ; no review data for AR either
- N IBRM,IBREC,IBFLG,IBFST
- S IB=$$SETSTR^VALM1("REVIEW DATA:","",1,50)
- D SET(IB)
- D CNTRL^VALM10(VALMCNT,1,12,IORVON,IORVOFF)
- S ^TMP("IBCECSD",$J,"X",8)=VALMCNT
- S (Y,IBFLG)=0 F S Y=$O(^IBM(361.1,IBCNT,21,Y)) Q:'Y D
- . S IBREC=$G(^IBM(361.1,IBCNT,21,Y,0)),IBFLG=1
- . D SET(" REVIEW DATE/TIME: "_$$DAT1^IBOUTL($P(IBREC,U),1))
- . S Z=0,IBFST=1 F S Z=$O(^IBM(361.1,IBCNT,21,Y,1,Z)) Q:'Z D
- .. S IBRM=$G(^IBM(361.1,IBCNT,21,Y,1,Z,0))
- .. D:IBFST SET(" COMMENT:"_$E(IBRM,1,68))
- .. D TXT^IBCECSA5(IBRM,68,11)
- .. S IBFST=0
- D:'IBFLG SET(" NONE")
- Q
- ;
- ARCP ; A/R corrected payment data from splitting payment in EOB Worklist
- N Z,Z0
- I '$O(^IBM(361.1,IBCNT,8,0)) Q
- S IB=$$SETSTR^VALM1(" **A/R CORRECTED PAYMENT DATA:","",1,50)
- D SET(IB)
- I '$G(IBSRC) D
- . D CNTRL^VALM10(VALMCNT,1,27,IORVON,IORVOFF)
- . S ^TMP("IBCECSD",$J,"X",5)=VALMCNT
- D SET(" TOTAL AMT PD: "_$J(+$P($G(^IBM(361.1,IBCNT,1)),U,1),"",2))
- S Z=0 F S Z=$O(^IBM(361.1,IBCNT,8,Z)) Q:'Z S Z0=$G(^(Z,0)) D
- . 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)
- . D SET(IB)
- Q
- ;
- INSINF(IBREC,CNT,IBCNT) ; Extract insured information (moved from IBCECSA6)
- N IB,IBZ,IBSEQ,IBREL,Z,Z0
- S IBSEQ=+$$COBN^IBCEF(IBREC)
- S IB=$$SETSTR^VALM1("Patient Name: "_$P($G(^DPT(+$P($G(^DGCR(399,IBREC,0)),U,2),0)),U),"",2,39)
- D F^IBCEF("N-ALL INSURED PT RELATION","IBZ",,IBREC)
- S IBREL=$G(IBZ(IBSEQ))
- S IB=$$SETSTR^VALM1("Pt. Relation : "_$$EXTERNAL^DILFD(2.312,16,"",IBREL),IB,41,38)
- D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
- S Z=2,Z0=39,IB=""
- I +IBREL'=1 D
- . D F^IBCEF("N-ALL INSURED FULL NAMES","IBZ",,IBREC)
- . S IB=$$SETSTR^VALM1("Insured Name: "_$G(IBZ(IBSEQ)),IB,Z,Z0)
- . S Z=41,Z0=38
- D F^IBCEF("N-ALL INSURANCE NUMBER","IBZ",,IBREC)
- S IB=$$SETSTR^VALM1("Insured ID "_$S(Z=41:" ",1:"")_": "_$G(IBZ(IBSEQ)),IB,Z,Z0)
- D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
- Q
- ;
- SET(IB,IBSAV) ;
- I '$G(IBSAV) D SET^IBCECSA6($G(IBSRC),IB,CNT,IBCNT)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECSA7 2455 printed Feb 18, 2025@23:36:15 Page 2
- IBCECSA7 ;ALB/ESG - VIEW EOB SCREEN CONTINUED ;26-JUN-2003
- +1 ;;2.0;INTEGRATED BILLING;**135,155**;21-MAR-1994
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; Must be called at proper entry points
- QUIT
- +5 ;
- LLVLA ;line level adjustment
- +1 ; no MRA
- if '$GET(IBSRC)
- QUIT
- +2 DO MRALLA^IBCECSA5
- +3 QUIT
- RDATA ;
- +1 ; no review data for IB/MRA
- IF '$GET(IBSRC)
- QUIT
- +2 ; no review data for AR either
- IF $GET(IBSRC)
- QUIT
- +3 NEW IBRM,IBREC,IBFLG,IBFST
- +4 SET IB=$$SETSTR^VALM1("REVIEW DATA:","",1,50)
- +5 DO SET(IB)
- +6 DO CNTRL^VALM10(VALMCNT,1,12,IORVON,IORVOFF)
- +7 SET ^TMP("IBCECSD",$JOB,"X",8)=VALMCNT
- +8 SET (Y,IBFLG)=0
- FOR
- SET Y=$ORDER(^IBM(361.1,IBCNT,21,Y))
- if 'Y
- QUIT
- Begin DoDot:1
- +9 SET IBREC=$GET(^IBM(361.1,IBCNT,21,Y,0))
- SET IBFLG=1
- +10 DO SET(" REVIEW DATE/TIME: "_$$DAT1^IBOUTL($PIECE(IBREC,U),1))
- +11 SET Z=0
- SET IBFST=1
- FOR
- SET Z=$ORDER(^IBM(361.1,IBCNT,21,Y,1,Z))
- if 'Z
- QUIT
- Begin DoDot:2
- +12 SET IBRM=$GET(^IBM(361.1,IBCNT,21,Y,1,Z,0))
- +13 if IBFST
- DO SET(" COMMENT:"_$EXTRACT(IBRM,1,68))
- +14 DO TXT^IBCECSA5(IBRM,68,11)
- +15 SET IBFST=0
- End DoDot:2
- End DoDot:1
- +16 if 'IBFLG
- DO SET(" NONE")
- +17 QUIT
- +18 ;
- ARCP ; A/R corrected payment data from splitting payment in EOB Worklist
- +1 NEW Z,Z0
- +2 IF '$ORDER(^IBM(361.1,IBCNT,8,0))
- QUIT
- +3 SET IB=$$SETSTR^VALM1(" **A/R CORRECTED PAYMENT DATA:","",1,50)
- +4 DO SET(IB)
- +5 IF '$GET(IBSRC)
- Begin DoDot:1
- +6 DO CNTRL^VALM10(VALMCNT,1,27,IORVON,IORVOFF)
- +7 SET ^TMP("IBCECSD",$JOB,"X",5)=VALMCNT
- End DoDot:1
- +8 DO SET(" TOTAL AMT PD: "_$JUSTIFY(+$PIECE($GET(^IBM(361.1,IBCNT,1)),U,1),"",2))
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^IBM(361.1,IBCNT,8,Z))
- if 'Z
- QUIT
- SET Z0=$GET(^(Z,0))
- Begin DoDot:1
- +10 SET IB=$EXTRACT($JUSTIFY("",6)_$SELECT($PIECE(Z0,U,3):$$BN1^PRCAFN(+$PIECE(Z0,U,3)),1:"[suspense]"_$PIECE(Z0,U))_$JUSTIFY("",25),1,25)_" "_$JUSTIFY(+$PIECE(Z0,U,2),"",2)
- +11 DO SET(IB)
- End DoDot:1
- +12 QUIT
- +13 ;
- INSINF(IBREC,CNT,IBCNT) ; Extract insured information (moved from IBCECSA6)
- +1 NEW IB,IBZ,IBSEQ,IBREL,Z,Z0
- +2 SET IBSEQ=+$$COBN^IBCEF(IBREC)
- +3 SET IB=$$SETSTR^VALM1("Patient Name: "_$PIECE($GET(^DPT(+$PIECE($GET(^DGCR(399,IBREC,0)),U,2),0)),U),"",2,39)
- +4 DO F^IBCEF("N-ALL INSURED PT RELATION","IBZ",,IBREC)
- +5 SET IBREL=$GET(IBZ(IBSEQ))
- +6 SET IB=$$SETSTR^VALM1("Pt. Relation : "_$$EXTERNAL^DILFD(2.312,16,"",IBREL),IB,41,38)
- +7 DO SET^IBCECSA6($GET(IBSRC),IB,CNT,IBCNT)
- +8 SET Z=2
- SET Z0=39
- SET IB=""
- +9 IF +IBREL'=1
- Begin DoDot:1
- +10 DO F^IBCEF("N-ALL INSURED FULL NAMES","IBZ",,IBREC)
- +11 SET IB=$$SETSTR^VALM1("Insured Name: "_$GET(IBZ(IBSEQ)),IB,Z,Z0)
- +12 SET Z=41
- SET Z0=38
- End DoDot:1
- +13 DO F^IBCEF("N-ALL INSURANCE NUMBER","IBZ",,IBREC)
- +14 SET IB=$$SETSTR^VALM1("Insured ID "_$SELECT(Z=41:" ",1:"")_": "_$GET(IBZ(IBSEQ)),IB,Z,Z0)
- +15 DO SET^IBCECSA6($GET(IBSRC),IB,CNT,IBCNT)
- +16 QUIT
- +17 ;
- SET(IB,IBSAV) ;
- +1 IF '$GET(IBSAV)
- DO SET^IBCECSA6($GET(IBSRC),IB,CNT,IBCNT)
- +2 QUIT
- +3 ;
