BPSSCR05 ;BHAM ISC/BNT - ECME USR SCREEN UTILITIES ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**7,23**;JUN 2004;Build 44
;;Per VA Directive 6402, this routine should not be modified.
Q
;Filter Eligibility of Veteran, Tricare, or ChampVA (ChampVA is reserved for future use)
;input:
;BP59 - ptr to #59
;BPARR - array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTELIG(BP59,BPARR) ;
Q:$G(BPARR(2.01))="A" 1
I $G(BPARR(2.01))="" S BPARR(2.01)="V"
I $G(BPARR(2.01))[$$ELIGCODE(BP59) Q 1
Q 0
;Filter Submission Type of Billing Requests or Reversals
;input:
;BP59 - ptr to #59
;BPARR - array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTSUBTP(BP59,BPARR) ;
N BPSCLM,BPTRCD
Q:$G(BPARR(2.03))="A" 1
Q:$G(BPARR(2.03))="" 1
; Get the claim IEN
S BPSCLM=$S($P($G(^BPST(BP59,4)),U)>0:$P($G(^BPST(BP59,4)),U),1:$P($G(^BPST(BP59,0)),U,4))
Q:BPSCLM="" 0
; Get the Transaction Code from BPS CLAIMS
S BPTRCD=$$TRNSCODE(BPSCLM)
Q:BPTRCD="" 0
; Transaction Code B1 = Billing Request, B2 = Reversal
Q $S((BPTRCD="B1")&($G(BPARR(2.03))="B"):1,(BPTRCD="B2")&($G(BPARR(2.03))="R"):1,1:0)
;
;Filter Insurance companies
;input:
;BP59 - ptr to #59
;BPARR - array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTINS(BP59,BPARR) ;
Q:$G(BPARR(1.11))="A" 1
Q:$G(BPARR(2.04))="" 1
N BPINS,BPJ,BPINSIEN,I
S BPINSIEN=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),0)),U)
S BPINS=0
F I=2:1 S BPJ=$P(BPARR(2.04),";",I) Q:BPJ="" D Q:BPINS
. S BPINS=$S($$INSPL^IBNCPDPI(BPINSIEN)=BPJ:1,1:0)
Q BPINS
;
;/**
;Returns the Eligibility Code for the entry in file 59
;input:
;BP59 - ptr to file 59
;returns:
;V=Veteran, T=Tricare, C=ChampVA, or null
ELIGCODE(BP59) ; **/
Q $P($G(^BPST(BP59,9)),U,4)
;
;Returns the Transaction Code for a claim
;input:
;BP02 - ptr to BPS CLAIMS file
;returns:
;Internal value of TRANSACTION CODE field
;B1 = Billing, B2 = Reversal, B3 = Rebill, etc.
TRNSCODE(BP02) ;
Q $P($G(^BPSC(BP02,100)),U,3)
;
;MKNEWARR is called by CLOSE^BPSSCRCL to create an array
;of BP59 records for use by the Close Claims option.
;
MKNEWARR(BPARR,BPNEWARR,BPINSARR) ;
N BP59,BPREJ,BPREJCNT,BPRELCNT,BPREL,BPINS,BPCLST,BPDFN
S BPREJCNT=0,BPRELCNT=0
S BPINS=0
S BP59="" F S BP59=$O(BPARR(BP59)) Q:BP59="" D
. S BPREJ=0
. S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
. S BPCLST=$$CLAIMST^BPSSCRU3(BP59)
. S BPREJ=$S($P(BPCLST,U)="E REJECTED":1,$P(BPCLST,U)="E REVERSAL ACCEPTED":1,1:0)
. S:BPREJ BPREJCNT=BPREJCNT+1
. S BPREL=$S($$RXAPI1^BPSUTIL1(+$P($$RXREF^BPSSCRU2(BP59),U),106,"I"):1,1:0)
. S:BPREL BPRELCNT=BPRELCNT+1
. S BPNEWARR(BPDFN,BP59)=BPARR(BP59)_U_BPREJ_U_BPREL
. S BPINS=$P($$GETINSUR^BPSSCRU2(BP59),U,2)
. I BPREJ=1,$L(BPINS)>0 S BPINSARR(BPDFN,BPINS,BP59)=BPARR(BP59)
Q BPREJCNT_U_BPRELCNT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCR05 2997 printed Sep 23, 2025@19:29:19 Page 2
BPSSCR05 ;BHAM ISC/BNT - ECME USR SCREEN UTILITIES ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**7,23**;JUN 2004;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;Filter Eligibility of Veteran, Tricare, or ChampVA (ChampVA is reserved for future use)
+5 ;input:
+6 ;BP59 - ptr to #59
+7 ;BPARR - array with user's preferences
+8 ;returns :
+9 ;1 -okay, leave in the list
+10 ;0 -not okay, exclude from the list
FLTELIG(BP59,BPARR) ;
+1 if $GET(BPARR(2.01))="A"
QUIT 1
+2 IF $GET(BPARR(2.01))=""
SET BPARR(2.01)="V"
+3 IF $GET(BPARR(2.01))[$$ELIGCODE(BP59)
QUIT 1
+4 QUIT 0
+5 ;Filter Submission Type of Billing Requests or Reversals
+6 ;input:
+7 ;BP59 - ptr to #59
+8 ;BPARR - array with user's preferences
+9 ;returns :
+10 ;1 -okay, leave in the list
+11 ;0 -not okay, exclude from the list
FLTSUBTP(BP59,BPARR) ;
+1 NEW BPSCLM,BPTRCD
+2 if $GET(BPARR(2.03))="A"
QUIT 1
+3 if $GET(BPARR(2.03))=""
QUIT 1
+4 ; Get the claim IEN
+5 SET BPSCLM=$SELECT($PIECE($GET(^BPST(BP59,4)),U)>0:$PIECE($GET(^BPST(BP59,4)),U),1:$PIECE($GET(^BPST(BP59,0)),U,4))
+6 if BPSCLM=""
QUIT 0
+7 ; Get the Transaction Code from BPS CLAIMS
+8 SET BPTRCD=$$TRNSCODE(BPSCLM)
+9 if BPTRCD=""
QUIT 0
+10 ; Transaction Code B1 = Billing Request, B2 = Reversal
+11 QUIT $SELECT((BPTRCD="B1")&($GET(BPARR(2.03))="B"):1,(BPTRCD="B2")&($GET(BPARR(2.03))="R"):1,1:0)
+12 ;
+13 ;Filter Insurance companies
+14 ;input:
+15 ;BP59 - ptr to #59
+16 ;BPARR - array with user's preferences
+17 ;returns :
+18 ;1 -okay, leave in the list
+19 ;0 -not okay, exclude from the list
FLTINS(BP59,BPARR) ;
+1 if $GET(BPARR(1.11))="A"
QUIT 1
+2 if $GET(BPARR(2.04))=""
QUIT 1
+3 NEW BPINS,BPJ,BPINSIEN,I
+4 SET BPINSIEN=$PIECE($GET(^BPST(BP59,10,+$GET(^BPST(BP59,9)),0)),U)
+5 SET BPINS=0
+6 FOR I=2:1
SET BPJ=$PIECE(BPARR(2.04),";",I)
if BPJ=""
QUIT
Begin DoDot:1
+7 SET BPINS=$SELECT($$INSPL^IBNCPDPI(BPINSIEN)=BPJ:1,1:0)
End DoDot:1
if BPINS
QUIT
+8 QUIT BPINS
+9 ;
+10 ;/**
+11 ;Returns the Eligibility Code for the entry in file 59
+12 ;input:
+13 ;BP59 - ptr to file 59
+14 ;returns:
+15 ;V=Veteran, T=Tricare, C=ChampVA, or null
ELIGCODE(BP59) ; **/
+1 QUIT $PIECE($GET(^BPST(BP59,9)),U,4)
+2 ;
+3 ;Returns the Transaction Code for a claim
+4 ;input:
+5 ;BP02 - ptr to BPS CLAIMS file
+6 ;returns:
+7 ;Internal value of TRANSACTION CODE field
+8 ;B1 = Billing, B2 = Reversal, B3 = Rebill, etc.
TRNSCODE(BP02) ;
+1 QUIT $PIECE($GET(^BPSC(BP02,100)),U,3)
+2 ;
+3 ;MKNEWARR is called by CLOSE^BPSSCRCL to create an array
+4 ;of BP59 records for use by the Close Claims option.
+5 ;
MKNEWARR(BPARR,BPNEWARR,BPINSARR) ;
+1 NEW BP59,BPREJ,BPREJCNT,BPRELCNT,BPREL,BPINS,BPCLST,BPDFN
+2 SET BPREJCNT=0
SET BPRELCNT=0
+3 SET BPINS=0
+4 SET BP59=""
FOR
SET BP59=$ORDER(BPARR(BP59))
if BP59=""
QUIT
Begin DoDot:1
+5 SET BPREJ=0
+6 SET BPDFN=+$PIECE($GET(^BPST(BP59,0)),U,6)
+7 SET BPCLST=$$CLAIMST^BPSSCRU3(BP59)
+8 SET BPREJ=$SELECT($PIECE(BPCLST,U)="E REJECTED":1,$PIECE(BPCLST,U)="E REVERSAL ACCEPTED":1,1:0)
+9 if BPREJ
SET BPREJCNT=BPREJCNT+1
+10 SET BPREL=$SELECT($$RXAPI1^BPSUTIL1(+$PIECE($$RXREF^BPSSCRU2(BP59),U),106,"I"):1,1:0)
+11 if BPREL
SET BPRELCNT=BPRELCNT+1
+12 SET BPNEWARR(BPDFN,BP59)=BPARR(BP59)_U_BPREJ_U_BPREL
+13 SET BPINS=$PIECE($$GETINSUR^BPSSCRU2(BP59),U,2)
+14 IF BPREJ=1
IF $LENGTH(BPINS)>0
SET BPINSARR(BPDFN,BPINS,BP59)=BPARR(BP59)
End DoDot:1
+15 QUIT BPREJCNT_U_BPRELCNT
+16 ;
