Routine: IBJTLA1

IBJTLA1 ;ALB/ARH - TPI ACTIVE BILLS LIST BUILD ;2/14/95

 ;;2.0;INTEGRATED BILLING;**39,80,61,51,153,137,183,276,451,516,530,568,592**;21-MAR-94;Build 58

 ;;Per VA Directive 6402, this routine should not be modified.

BLDA ; build active list for third party joint inquiry active list

 N IBIFN,IBCNT S VALMCNT=0,IBCNT=0

 S IBIFN=0 F  S IBIFN=$O(^DGCR(399,"C",DFN,IBIFN)) Q:'IBIFN  I $$ACTIVE^IBJTU4(IBIFN) W "." D SCRN

 I VALMCNT=0 D SET(" ",0),SET("No Active Bills for this Patient",0)

SCRN ; add bill to screen list (IBIFN,DFN must be defined)

 N X,IBY,IBD0,IBDU,IBDM,TYPE,REJFLAG,INDFLG,IBJTLA1 S X=""

 S IBCNT=IBCNT+1,IBD0=$G(^DGCR(399,+IBIFN,0)),IBDU=$G(^DGCR(399,+IBIFN,"U")),IBDM=$G(^DGCR(399,+IBIFN,"M"))

 S IBY=IBCNT,X=$$SETFLD^VALM1(IBY,X,"NUMBER")

 ; IB*2.0*451 - get EEOB indicator for bill # when applicable

 S IBPFLAG=$$EEOB(+IBIFN)

 S REJFLAG=+$$BILLREJ^IBJTU6($P(IBD0,U)) ;IB*2.0*530 Add indicator for rejects

 S INDFLG=$S($G(IBPFLAG)'="":"%",1:"")_$S(REJFLAG:"c",1:"") S:INDFLG="" INDFLG=" "

 S IBY=INDFLG_$P(IBD0,U,1)_$$ECME^IBTRE(IBIFN),X=$$SETFLD^VALM1(IBY,X,"BILL") ;add EEOB indicator '%' to bill number when applicable

 S IBY=$S($$REF^IBJTU31(+IBIFN):"r",1:""),X=$$SETFLD^VALM1(IBY,X,"REFER")

 S IBY=$S($$IB^IBRUTL(+IBIFN,0):"*",1:""),X=$$SETFLD^VALM1(IBY,X,"HD")

 S IBY=$$DATE($P(IBDU,U,1)),X=$$SETFLD^VALM1(IBY,X,"STFROM")

 S IBY=$$DATE($P(IBDU,U,2)),X=$$SETFLD^VALM1(IBY,X,"STTO")

 S IBY=$P($$LST^DGMTU(DFN,$P(IBDU,U)),U,4),IBY=$S(IBY="C":"YES",IBY="P":"PEN",IBY="R":"REQ",IBY="G":"GMT",1:"NO"),X=$$SETFLD^VALM1(IBY,X,"MT?")

 ;S IBY=$$TYPE($P(IBD0,U,5))_$$TF($P(IBD0,U,6))_$S($P(IBD0,U,27)=1:"I",$P(IBD0,U,27)=2:"P",1:""),X=$$SETFLD^VALM1(IBY,X,"TYPE")  ; 516 - baa

 S TYPE=$$TYPE($P(IBD0,U,5)) I $E(TYPE,2)="P" S TYPE=$E(TYPE)  ; 516 - baa

 ;S IBY=TYPE_"/"_$S($P(IBD0,U,27)=1:"I",$P(IBD0,U,27)=2:"P",1:""),X=$$SETFLD^VALM1(IBY,X,"TYPE")  ; 516 - baa

 ;IB*2.0*592; If the claim is a Dental Claim, set the 2nd piece of the TYPE to "D" for Dental

 ;IA# 10116

 S IBY=TYPE_"/"_$S($$FT^IBCEF(IBIFN)=7:"D",$P(IBD0,U,27)=1:"I",$P(IBD0,U,27)=2:"P",1:" "),X=$$SETFLD^VALM1(IBY,X,"TYPE")  ; 592 (vd-US14) ;568 - lmh ret space if null

 ; Return care type for (I)npat,(O)utpat, (R)x or (P)rosthetics - add under TJPI screen TYPE column - 568

 S IBTYP=$$TYP^IBRFN(IBIFN)

 S IBTYP=$S(IBTYP="":-1,IBTYP="PR":"P",IBTYP="PH":"R",1:IBTYP)

 S IBY=IBY_"/"_IBTYP,X=$$SETFLD^VALM1(IBY,X,"TYPE")

 S IBY=" "_$P($$ARSTATA^IBJTU4(IBIFN),U,2),X=$$SETFLD^VALM1(IBY,X,"ARST")

 S IBY=$P($G(^DGCR(399.3,+$P(IBD0,U,7),0)),U,4),X=$$SETFLD^VALM1(IBY,X,"RATE")

 S IBY=$S($$MINS^IBJTU31(+IBIFN):"+",1:""),X=$$SETFLD^VALM1(IBY,X,"CB")

 S IBY=+$G(^DGCR(399,+IBIFN,"MP"))

 I 'IBY,$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)) S IBY=+$$CURR^IBCEF2(IBIFN)

 S IBY=$P($G(^DIC(36,+IBY,0)),U,1)

 S X=$$SETFLD^VALM1(IBY,X,"INSUR")

 S IBY=$$BILL^RCJIBFN2(IBIFN)

 S X=$$SETFLD^VALM1($J(+$P(IBY,U,1),8,2),X,"OAMT")

 S X=$$SETFLD^VALM1($J(+$P(IBY,U,3),8,2),X,"CAMT")

 D SET(X,IBCNT)

DATE(X) ; date in external format

 N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)

Q Y

TYPE(X) ; return abbreviated form of Bill Classification (399,.05)

 Q $S(X=1:"IP",X=2:"IH",X=3:"OP",X=4:"OH",1:"")

TF(X) ; return abbreviated form of Timeframe of Bill (399,.06)

 Q $S(X=2:"-F",X=3:"-C",X=4:"-L",X'=1:"-O",1:"")

SET(X,CNT) ; set up list manager screen array

 S VALMCNT=VALMCNT+1

 S ^TMP("IBJTLA",$J,VALMCNT,0)=X Q:'CNT

 S ^TMP("IBJTLA",$J,"IDX",VALMCNT,+CNT)=""

 S ^TMP("IBJTLAX",$J,CNT)=VALMCNT_U_IBIFN

EEOB(IBIFN) ; get payment information

 ; IB*2.0*451 - find an EOB payment for a bill

 ; input is the IEN for the bill # in file #399 and must be valid,

 ; output is the EEOB indicator '%' if a payment is found in file #361.1,

 ; exclude EOB type MRA (Medicare).

 N IBPFLAG,IBVAL,Z

 I $G(IBIFN)=0 Q ""

 I '$O(^IBM(361.1,"B",IBIFN,0)) Q ""  ; no entry here

 I $P($G(^DGCR(399,IBIFN,0)),"^",13)=1 Q ""  ;avoid 'ENTERED/NOT REVIEWED' status

 ; handle both single and multiple bill entries in file #361.1

 S Z=0 F  S Z=$O(^IBM(361.1,"B",IBIFN,Z)) Q:'Z  D  Q:$G(IBPFLAG)="%"

 . S IBVAL=$G(^IBM(361.1,Z,0))

 . S IBPFLAG=$S($P(IBVAL,"^",4)=1:"",$P(IBVAL,"^",4)=0:"%",1:"")

 Q IBPFLAG  ; EOB indicator for either 1st or 3rd payment on bill

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTLA1   4334     printed  Feb 18, 2025@23:50:21                                                                                                                                                                                                     Page 2

IBJTLA1   ;ALB/ARH - TPI ACTIVE BILLS LIST BUILD ;2/14/95

 +1       ;;2.0;INTEGRATED BILLING;**39,80,61,51,153,137,183,276,451,516,530,568,592**;21-MAR-94;Build 58

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

BLDA      ; build active list for third party joint inquiry active list

 +1        NEW IBIFN,IBCNT

           SET VALMCNT=0

           SET IBCNT=0

 +2        SET IBIFN=0

FOR

               SET IBIFN=$ORDER(^DGCR(399,"C",DFN,IBIFN))

               if 'IBIFN

                   QUIT

               IF $$ACTIVE^IBJTU4(IBIFN)

                   WRITE "."

                   DO SCRN

 +3       ;

 +4        IF VALMCNT=0

               DO SET(" ",0)

               DO SET("No Active Bills for this Patient",0)

 +5       ;

 +6        QUIT

 +7       ;

SCRN      ; add bill to screen list (IBIFN,DFN must be defined)

 +1        NEW X,IBY,IBD0,IBDU,IBDM,TYPE,REJFLAG,INDFLG,IBJTLA1

           SET X=""

 +2        SET IBCNT=IBCNT+1

           SET IBD0=$GET(^DGCR(399,+IBIFN,0))

           SET IBDU=$GET(^DGCR(399,+IBIFN,"U"))

           SET IBDM=$GET(^DGCR(399,+IBIFN,"M"))

 +3        SET IBY=IBCNT

           SET X=$$SETFLD^VALM1(IBY,X,"NUMBER")

 +4       ; IB*2.0*451 - get EEOB indicator for bill # when applicable

 +5        SET IBPFLAG=$$EEOB(+IBIFN)

 +6       ;IB*2.0*530 Add indicator for rejects

           SET REJFLAG=+$$BILLREJ^IBJTU6($PIECE(IBD0,U))

 +7        SET INDFLG=$SELECT($GET(IBPFLAG)'="":"%",1:"")_$SELECT(REJFLAG:"c",1:"")

           if INDFLG=""

               SET INDFLG=" "

 +8       ;add EEOB indicator '%' to bill number when applicable

           SET IBY=INDFLG_$PIECE(IBD0,U,1)_$$ECME^IBTRE(IBIFN)

           SET X=$$SETFLD^VALM1(IBY,X,"BILL")

 +9        SET IBY=$SELECT($$REF^IBJTU31(+IBIFN):"r",1:"")

           SET X=$$SETFLD^VALM1(IBY,X,"REFER")

 +10       SET IBY=$SELECT($$IB^IBRUTL(+IBIFN,0):"*",1:"")

           SET X=$$SETFLD^VALM1(IBY,X,"HD")

 +11       SET IBY=$$DATE($PIECE(IBDU,U,1))

           SET X=$$SETFLD^VALM1(IBY,X,"STFROM")

 +12       SET IBY=$$DATE($PIECE(IBDU,U,2))

           SET X=$$SETFLD^VALM1(IBY,X,"STTO")

 +13      ;

 +14       SET IBY=$PIECE($$LST^DGMTU(DFN,$PIECE(IBDU,U)),U,4)

           SET IBY=$SELECT(IBY="C":"YES",IBY="P":"PEN",IBY="R":"REQ",IBY="G":"GMT",1:"NO")

           SET X=$$SETFLD^VALM1(IBY,X,"MT?")

 +15      ;S IBY=$$TYPE($P(IBD0,U,5))_$$TF($P(IBD0,U,6))_$S($P(IBD0,U,27)=1:"I",$P(IBD0,U,27)=2:"P",1:""),X=$$SETFLD^VALM1(IBY,X,"TYPE")  ; 516 - baa

 +16      ; 516 - baa

           SET TYPE=$$TYPE($PIECE(IBD0,U,5))

           IF $EXTRACT(TYPE,2)="P"

               SET TYPE=$EXTRACT(TYPE)

 +17      ;S IBY=TYPE_"/"_$S($P(IBD0,U,27)=1:"I",$P(IBD0,U,27)=2:"P",1:""),X=$$SETFLD^VALM1(IBY,X,"TYPE")  ; 516 - baa

 +18      ;IB*2.0*592; If the claim is a Dental Claim, set the 2nd piece of the TYPE to "D" for Dental

 +19      ;IA# 10116

 +20      ; 592 (vd-US14) ;568 - lmh ret space if null

           SET IBY=TYPE_"/"_$SELECT($$FT^IBCEF(IBIFN)=7:"D",$PIECE(IBD0,U,27)=1:"I",$PIECE(IBD0,U,27)=2:"P",1:" ")

           SET X=$$SETFLD^VALM1(IBY,X,"TYPE")

 +21      ;

 +22      ; Return care type for (I)npat,(O)utpat, (R)x or (P)rosthetics - add under TJPI screen TYPE column - 568

 +23       SET IBTYP=$$TYP^IBRFN(IBIFN)

 +24       SET IBTYP=$SELECT(IBTYP="":-1,IBTYP="PR":"P",IBTYP="PH":"R",1:IBTYP)

 +25       SET IBY=IBY_"/"_IBTYP

           SET X=$$SETFLD^VALM1(IBY,X,"TYPE")

 +26      ;

 +27       SET IBY=" "_$PIECE($$ARSTATA^IBJTU4(IBIFN),U,2)

           SET X=$$SETFLD^VALM1(IBY,X,"ARST")

 +28      ;

 +29       SET IBY=$PIECE($GET(^DGCR(399.3,+$PIECE(IBD0,U,7),0)),U,4)

           SET X=$$SETFLD^VALM1(IBY,X,"RATE")

 +30       SET IBY=$SELECT($$MINS^IBJTU31(+IBIFN):"+",1:"")

           SET X=$$SETFLD^VALM1(IBY,X,"CB")

 +31       SET IBY=+$GET(^DGCR(399,+IBIFN,"MP"))

 +32       IF 'IBY

               IF $$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN))

                   SET IBY=+$$CURR^IBCEF2(IBIFN)

 +33       SET IBY=$PIECE($GET(^DIC(36,+IBY,0)),U,1)

 +34       SET X=$$SETFLD^VALM1(IBY,X,"INSUR")

 +35       SET IBY=$$BILL^RCJIBFN2(IBIFN)

 +36       SET X=$$SETFLD^VALM1($JUSTIFY(+$PIECE(IBY,U,1),8,2),X,"OAMT")

 +37       SET X=$$SETFLD^VALM1($JUSTIFY(+$PIECE(IBY,U,3),8,2),X,"CAMT")

 +38       DO SET(X,IBCNT)

 +39       QUIT

 +40      ;

DATE(X)   ; date in external format

 +1        NEW Y

           SET Y=""

           IF X?7N.E

               SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)

 +2        QUIT Y

 +3       ;

TYPE(X)   ; return abbreviated form of Bill Classification (399,.05)

 +1        QUIT $SELECT(X=1:"IP",X=2:"IH",X=3:"OP",X=4:"OH",1:"")

 +2       ;

TF(X)     ; return abbreviated form of Timeframe of Bill (399,.06)

 +1        QUIT $SELECT(X=2:"-F",X=3:"-C",X=4:"-L",X'=1:"-O",1:"")

 +2       ;

SET(X,CNT) ; set up list manager screen array

 +1        SET VALMCNT=VALMCNT+1

 +2        SET ^TMP("IBJTLA",$JOB,VALMCNT,0)=X

           if 'CNT

               QUIT

 +3        SET ^TMP("IBJTLA",$JOB,"IDX",VALMCNT,+CNT)=""

 +4        SET ^TMP("IBJTLAX",$JOB,CNT)=VALMCNT_U_IBIFN

 +5        QUIT

 +6       ;

EEOB(IBIFN) ; get payment information

 +1       ; IB*2.0*451 - find an EOB payment for a bill

 +2       ; input is the IEN for the bill # in file #399 and must be valid,

 +3       ; output is the EEOB indicator '%' if a payment is found in file #361.1,

 +4       ; exclude EOB type MRA (Medicare).

 +5        NEW IBPFLAG,IBVAL,Z

 +6        IF $GET(IBIFN)=0

               QUIT ""

 +7       ; no entry here

           IF '$ORDER(^IBM(361.1,"B",IBIFN,0))

               QUIT ""

 +8       ;avoid 'ENTERED/NOT REVIEWED' status

           IF $PIECE($GET(^DGCR(399,IBIFN,0)),"^",13)=1

               QUIT ""

 +9       ; handle both single and multiple bill entries in file #361.1

 +10       SET Z=0

FOR

               SET Z=$ORDER(^IBM(361.1,"B",IBIFN,Z))

               if 'Z

                   QUIT

               Begin DoDot:1

 +11               SET IBVAL=$GET(^IBM(361.1,Z,0))

 +12               SET IBPFLAG=$SELECT($PIECE(IBVAL,"^",4)=1:"",$PIECE(IBVAL,"^",4)=0:"%",1:"")

               End DoDot:1

               if $GET(IBPFLAG)="%"

                   QUIT

 +13      ; EOB indicator for either 1st or 3rd payment on bill

           QUIT IBPFLAG

IBJTLA1.m