BPSSCR03 ;BHAM ISC/SS - ECME USR SCREEN UTILITIES ;05-APR-05
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,20,23**;JUN 2004;Build 44
;;Per VA Directive 6402, this routine should not be modified.
Q
;/**
;BP59 - ptr to 9002313.59
; BPARR to return formatted info via ref
; BPMLEM - max len for each line
; BPMODE - mode
; R -regular for main screen, will show only latest comment
; C - comment mode - show all comments
ADDINF(BP59,BPARR,BPMLEN,BPMODE) ;to return additional information about the claim*/
N BPX,BPN,BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1,BPN2,BPSTATUS,BPSCOBA,BP59X,I
S BPN=0,(BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1)=""
I BPMODE="R" D
. S BPX=$$COMMENT^BPSSCRU3(BP59)
. I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=$P(BPX,U)
. I $P(BPX,U,2)]"" S BPN=BPN+1,BPARR(BPN)="("_$P(BPX,U,2)_")"
E D
. N BPCMNT,BPX1 S BPCMNT=99999999
. F S BPCMNT=$O(^BPST(BP59,11,BPCMNT),-1) Q:+BPCMNT=0 D
. . S BPX1=$G(^BPST(BP59,11,BPCMNT,0))
. . I BPX1="" Q
. . S BPX=$$DATTIM^BPSSCRU3($P(BPX1,U,1)\1)_$S(+$P(BPX1,U,4):" (Pharm)",1:"")_" - "_$P(BPX1,U,3)
. . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=BPX
. . I +$P(BPX1,U,2)]"" D
. . . S BPX=$$USERNAM^BPSCMT01(+$P(BPX1,U,2))
. . . I BPX'="" S BPX="("_BPX_")",BPN=BPN+1,BPARR(BPN)=BPX
S BPX=$$CLAIMST^BPSSCRU3(BP59)
S BPSTATUS=$P(BPX,U)
; Show status for this BPS Transaction
S BPTXT1=$$COBCLST^BPSSCRU6(BP59)
; Append status for associated claim, if one exists
S BPSCOBA=$$ALLCOB59^BPSUTIL2(BP59)
F I=1:1 S BP59X=$P(BPSCOBA,U,I) Q:BP59X="" D
. Q:BP59X=BP59
. S BPTXT1=BPTXT1_" ("_$$COBCLST^BPSSCRU6(BP59X)_")"
;
; build the TRI/CVA non-billable reject/reason lines (bps*1*20)
I $$NB(BP59) D
. I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1 ; store the current line
. S BPTXT1=""
. S BPN=BPN+1,BPARR(BPN)=$$EREJTXT(BP59) ; store the eT/eC non-billable reject/reason line
. Q
;
I (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED") D
. I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1
. S BPTXT1=""
. S BPN2=BPN
. D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
. D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0)
. D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0)
;
I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E UNSTRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL OTHER")!(BPSTATUS["E REVERSAL UNSTRANDED") D
. I (BPSTATUS["E OTHER")!(BPSTATUS["E REVERSAL OTHER")!(BPSTATUS["IN PROGRESS") S BPX1=$P(BPX,U,3) I BPTXT1=BPX1 S BPX1=""
. S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,BP59)
. I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","")
;
S BPTXT2=$E(BPTXT1,1,BPMLEN)
S BPTXT3=$E(BPTXT1,BPMLEN+1,2*BPMLEN)
S BPTXT4=$E(BPTXT1,(2*BPMLEN)+1,3*BPMLEN)
I $L(BPTXT2)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT2
I $L(BPTXT3)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT3
I $L(BPTXT4)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT4
Q BPN
;
CLMINF(BP59) ;ptr to #9002313.59
W !,"Claim info. Press a key"
D PAUSE^VALM1
Q
;
EREJTXT(BP59) ; return the eT/eC line for non-billable entry
N ELIG,BPX2
S BPX2=""
S ELIG=$$GET1^DIQ(9002313.59,BP59,901.04)
I '$F(".T.C.","."_$E(ELIG,1)_".") G EREJTX ; must be TRI/CVA eligibility for non-billable
S BPX2="e"_$E(ELIG,1)_":"_ELIG_"-RX NOT BILLABLE ("_$P($G(^BPST(BP59,3)),U,1)_")" ; build eT / eC line
EREJTX ;
Q BPX2
;
COMM(BP59) ;ptr to #9002313.59
W !,"the latest comment. Press a key"
D PAUSE^VALM1
Q
;
RESP(BP59) ;Payer Response Information
W !,"payer Response Information. Press a key"
D PAUSE^VALM1
Q
;
;/**
;Checks if the claim is closed and sets the "/Closed" indicator at the end of the text
;BP59 - pointer to file #9002313.59
;BPTXT - Current status text to be displayed
;return:
;if the claim is not closed, BPTXT is returned. If it is closed BPTXT_"/Closed " is returned
CLMCLSTX(BP59,BPTXT) ;*/
Q $S($$CLOSED02($P($G(^BPST(BP59,0)),U,4)):BPTXT_"/Closed ",1:BPTXT)
;
;/**
;Checks if the CLAIM for specific Transaction is CLOSED?
;BPCLAIM - ptr to #9002313.02
;see also CLOSED^BPSSCRU1
CLOSED02(BPCLAIM) ;*/
I +$G(BPCLAIM)=0 Q 0
; get closed status
Q +$P($G(^BPSC(BPCLAIM,900)),U)=1
;
;return:
; 1 - okay. matches criteria
; 0- not okay, doesn't match criteria
FILTER(BP59,BPARR) ;
N BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM,BPRTBB
N BPRET,BPSRPU,BPSFT
S BPRET=1 ;1 - okay by default
S BPST0=$G(^BPST(BP59,0))
S BPST1=$G(^BPST(BP59,1))
; Do not display eligibility verification requests
I $P(BPST0,U,15)="E" Q 0
S BPRXREF=$$RXREF^BPSSCRU2(BP59)
S BPRX52=+$P(BPRXREF,U) ;ptr to #52
S BPREFNUM=$P(BPRXREF,U,2) ;refill #
;
;Check for Open Claim
I '$$NB(BP59),$G(BPARR(2.02))="O",$$CLOSED02(+$P(BPST0,U,4)) Q 0 ; n/a for non-billables
;Check for Closed Claim
I '$$NB(BP59),$G(BPARR(2.02))="C",'$$CLOSED02(+$P(BPST0,U,4)) Q 0 ; n/a for non-billables
;
I $G(BPARR(1.19))="O",$$NBCL(BP59) Q 0 ; non-billable entry - Open entries only
I $G(BPARR(1.19))="C",$$NBOP(BP59) Q 0 ; non-billable entry - Closed entries only
;
;Eligibility Indicator
I '$$FLTELIG^BPSSCR05(BP59,.BPARR) Q 0
;
;Submission type
I '$$NB(BP59),'$$FLTSUBTP^BPSSCR05(BP59,.BPARR) Q 0 ; n/a for non-billables
;
;user
I $G(BPARR(1.01))="U",$$FLTUSR(BPST0,.BPARR)=0 Q 0
;
;patient
I $G(BPARR(1.02))="P",$$FLTPAT(BPST0,.BPARR)=0 Q 0
;
;RX
I $G(BPARR(1.03))="R",$$FLTRX(BPST1,.BPARR)=0 Q 0
;
S BPSRPU=1
I '$$NB(BP59) D ; n/a for non-billables
. S BPSRPU=0
. I ($G(BPARR(1.06))["R")&($$REJECTED^BPSSCR02(BP59)=1) S BPSRPU=1
. I ($G(BPARR(1.06))["P")&($$PAYABLE^BPSSCR02(BP59)=1) S BPSRPU=1
. I ($G(BPARR(1.06))["U")&($$UNSTRAND^BPSSCR02(BP59)=1) S BPSRPU=1
. I $G(BPARR(1.06))["A" S BPSRPU=1
I BPSRPU=0 Q 0
;
;released
I $G(BPARR(1.07))="R",$$RL^BPSSCRU2(BP59)'="R" Q 0
;non released
I $G(BPARR(1.07))="N",$$RL^BPSSCRU2(BP59)="R" Q 0
;
;window/cmop/mail
I $G(BPARR(1.08))'="A",$$ISMWC(BPRX52,BPREFNUM,$G(BPARR(1.08)))=0 Q 0
;
; filter checks for fill type
S BPRTBB=$$RTBB^BPSSCRU2(BP59) I BPRTBB="**" S BPRTBB="RT"
S BPSFT=1
I $G(BPARR(1.09))'["A" D
. S BPSFT=0
. I $G(BPARR(1.09))["B",BPRTBB="BB" S BPSFT=1 ; filter for back billing
. I $G(BPARR(1.09))["P",BPRTBB="P2" S BPSFT=1 ; filter for PRO Option
. I $G(BPARR(1.09))["S",BPRTBB="RS" S BPSFT=1 ; filter for ECME user screen resubmits (BPS*1*20)
. I $G(BPARR(1.09))["R",BPRTBB="RT" S BPSFT=1 ; filter for real time
I BPSFT=0 Q 0
;
;if only rejected and only specific rejected codes should be displayed
;I $G(BPARR(1.06))["R",$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
I (($G(BPARR(1.06))["R")!($G(BPARR(1.06))="A")),$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
;
;insurance
I '$$FLTINS^BPSSCR05(BP59,.BPARR) Q 0
;
;divisions - ECME pharmacies
I $G(BPARR(1.13))="D",BPARR("DIVS")'[(";"_$P(BPST1,U,7)_";") Q 0
Q 1
;
;check user filter
;input:
;BPST0 - zero node of #9002313.59
;BPARR array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTUSR(BPST0,BPARR) ;
I $L($G(BPARR(1.16)))=0 Q 0
I $P(BPST0,U,10)=$G(BPARR(1.16)) Q 1
I $G(BPARR(1.16))[(";"_$P(BPST0,U,10)_";") Q 1
Q 0
;
;check patient filter
;input:
;BPST0 - zero node of #9002313.59
;BPARR array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTPAT(BPST0,BPARR) ;
I $L($G(BPARR(1.17)))=0 Q 0
I $P(BPST0,U,6)=$G(BPARR(1.17)) Q 1
I $G(BPARR(1.17))[(";"_$P(BPST0,U,6)_";") Q 1
Q 0
;check RX filter
;input:
;BPST1 - 1st node of #9002313.59
;BPARR array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTRX(BPST1,BPARR) ;
I $L($G(BPARR(1.18)))=0 Q 0
I $P(BPST1,U,11)=$G(BPARR(1.18)) Q 1
I $G(BPARR(1.18))[(";"_$P(BPST1,U,11)_";") Q 1
Q 0
;input:
;BP59 - zero node of #9002313.59
;BPARR array with user's preferences
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
FLTREJ(BP59,BPARR) ;
N BPRCODES
N BPSRJCD,BPSRJFLAG,BPSRJIEN
D REJCODES^BPSSCRU3(BP59,.BPRCODES,1) ; bps*1*20 include possible non-billable pseudo-reject codes too
;
S BPSRJCD="",BPSRJFLAG=0
F S BPSRJCD=$O(BPRCODES(BPSRJCD)) Q:BPSRJCD="" Q:BPSRJFLAG=1 D
. S BPSRJIEN="",BPSRJIEN=$O(^BPSF(9002313.93,"B",BPSRJCD,BPSRJIEN))
. I BPARR(1.15)=BPSRJIEN S BPSRJFLAG=1
. I BPARR(1.15)[(";"_BPSRJIEN_";") S BPSRJFLAG=1
Q BPSRJFLAG
;
;check W(indow)/C(mop)/M(ail)
;input:
;BPRX52 - ptr to #52
;BPREFNUM - refill #
;BPMWC - given value from CMOP/MAIL/WINDOW instance 1.08 of BPS USRSCR parameters
;returns :
;1 -okay, leave in the list
;0 -not okay, exclude from the list
ISMWC(BPRX52,BPREFNUM,BPMWC) ;
I BPMWC[$$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM)) Q 1
Q 0
;
FILTRALL(BPTMP1,BPTMP2,BPARR) ;
N BP59
S BP59=0
F S BP59=+$O(@BPTMP1@(BP59)) Q:+BP59=0 D
. I $$FILTER(BP59,.BPARR) S @BPTMP2@(BP59)=""
Q
;
;go thru all FILE59 entries and run SETTRDFN for each of them
;
TRDFNALL(BPTMP) ;
N BP59
S BP59=0
F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
. D SETTRDFN(BPTMP,BP59)
Q
;
;sorting for "TRANSACTION DATE" type is
;actually sorting by patients , but patient should be sorted not in alphabetical order:
;the first patient is the one which has the most recent transaction and so on
;BPTMP - TMP global
;BP59 - ptr to #9002313.59
SETTRDFN(BPTMP,BP59) ;
;the following stores the latest transaction date of the claims, which
;was found for this particular combination of patient and insurance
;@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
;the following stores the latest transaction date BPTRDT,patient BPDFN and
;insurance BPINSUR to provide a proper order
;@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
N BPZERO,BPTRDT,BPDFN,BPPREV,BPINSUR
S BPZERO=$G(^BPST(BP59,0)) ;
S BPTRDT=-$P(BPZERO,U,8) ;"transaction" date
S BPDFN=+$P(BPZERO,U,6) ;patient ptr to #2
S BPINSUR=+$$GETINSUR^BPSSCRU2(BP59) ;insurance ien
;in the beginning we don't have any "DFN-TRDT" and "TRDTDFN"
;so create them and quit
I '$D(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)) D Q
. S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
. S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
;if we already have them then get the latest into BPPREV
S BPPREV=+$G(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR))
;and compare it against the BPTRDT for this BP59
;if the BPTRDT is greater then replace the values in "DFN-TRDT"
;and "TRDTDFN"
I BPTRDT<BPPREV D
. S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
. S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
. K @BPTMP@("TRDTDFN",BPPREV,BPDFN,BPINSUR)
Q
;
NB(BP59) ; Is this BPS Transaction a TRI/CVA non-billable entry?
I $P($G(^BPST(+$G(BP59),0)),U,15)="N" Q 1 ; yep
Q 0 ; nope
;
NBCL(BP59) ; Is this BPS Transaction a Closed TRI/CVA non-billable entry?
I $$NB(+$G(BP59)),$P($G(^BPST(+$G(BP59),3)),U,2) Q 1 ; yep
Q 0 ; nope
;
NBOP(BP59) ; Is this BPS Transaction an Open TRI/CVA non-billable entry?
I $$NB(+$G(BP59)),'$P($G(^BPST(+$G(BP59),3)),U,2) Q 1 ; yep
Q 0 ; nope
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCR03 11341 printed Oct 16, 2024@17:53:52 Page 2
BPSSCR03 ;BHAM ISC/SS - ECME USR SCREEN UTILITIES ;05-APR-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,20,23**;JUN 2004;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;/**
+5 ;BP59 - ptr to 9002313.59
+6 ; BPARR to return formatted info via ref
+7 ; BPMLEM - max len for each line
+8 ; BPMODE - mode
+9 ; R -regular for main screen, will show only latest comment
+10 ; C - comment mode - show all comments
ADDINF(BP59,BPARR,BPMLEN,BPMODE) ;to return additional information about the claim*/
+1 NEW BPX,BPN,BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1,BPN2,BPSTATUS,BPSCOBA,BP59X,I
+2 SET BPN=0
SET (BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1)=""
+3 IF BPMODE="R"
Begin DoDot:1
+4 SET BPX=$$COMMENT^BPSSCRU3(BP59)
+5 IF $LENGTH(BPX)>0
SET BPN=BPN+1
SET BPARR(BPN)=$PIECE(BPX,U)
+6 IF $PIECE(BPX,U,2)]""
SET BPN=BPN+1
SET BPARR(BPN)="("_$PIECE(BPX,U,2)_")"
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 NEW BPCMNT,BPX1
SET BPCMNT=99999999
+9 FOR
SET BPCMNT=$ORDER(^BPST(BP59,11,BPCMNT),-1)
if +BPCMNT=0
QUIT
Begin DoDot:2
+10 SET BPX1=$GET(^BPST(BP59,11,BPCMNT,0))
+11 IF BPX1=""
QUIT
+12 SET BPX=$$DATTIM^BPSSCRU3($PIECE(BPX1,U,1)\1)_$SELECT(+$PIECE(BPX1,U,4):" (Pharm)",1:"")_" - "_$PIECE(BPX1,U,3)
+13 IF $LENGTH(BPX)>0
SET BPN=BPN+1
SET BPARR(BPN)=BPX
+14 IF +$PIECE(BPX1,U,2)]""
Begin DoDot:3
+15 SET BPX=$$USERNAM^BPSCMT01(+$PIECE(BPX1,U,2))
+16 IF BPX'=""
SET BPX="("_BPX_")"
SET BPN=BPN+1
SET BPARR(BPN)=BPX
End DoDot:3
End DoDot:2
End DoDot:1
+17 SET BPX=$$CLAIMST^BPSSCRU3(BP59)
+18 SET BPSTATUS=$PIECE(BPX,U)
+19 ; Show status for this BPS Transaction
+20 SET BPTXT1=$$COBCLST^BPSSCRU6(BP59)
+21 ; Append status for associated claim, if one exists
+22 SET BPSCOBA=$$ALLCOB59^BPSUTIL2(BP59)
+23 FOR I=1:1
SET BP59X=$PIECE(BPSCOBA,U,I)
if BP59X=""
QUIT
Begin DoDot:1
+24 if BP59X=BP59
QUIT
+25 SET BPTXT1=BPTXT1_" ("_$$COBCLST^BPSSCRU6(BP59X)_")"
End DoDot:1
+26 ;
+27 ; build the TRI/CVA non-billable reject/reason lines (bps*1*20)
+28 IF $$NB(BP59)
Begin DoDot:1
+29 ; store the current line
IF $LENGTH(BPTXT1)>0
SET BPN=BPN+1
SET BPARR(BPN)=BPTXT1
+30 SET BPTXT1=""
+31 ; store the eT/eC non-billable reject/reason line
SET BPN=BPN+1
SET BPARR(BPN)=$$EREJTXT(BP59)
+32 QUIT
End DoDot:1
+33 ;
+34 IF (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED")
Begin DoDot:1
+35 IF $LENGTH(BPTXT1)>0
SET BPN=BPN+1
SET BPARR(BPN)=BPTXT1
+36 SET BPTXT1=""
+37 SET BPN2=BPN
+38 DO GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
+39 DO WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0)
+40 DO WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0)
End DoDot:1
+41 ;
+42 IF (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E UNSTRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL OTHER")!(BPSTATUS["E REVERSAL UNSTRANDED")
Begin DoDot:1
+43 IF (BPSTATUS["E OTHER")!(BPSTATUS["E REVERSAL OTHER")!(BPSTATUS["IN PROGRESS")
SET BPX1=$PIECE(BPX,U,3)
IF BPTXT1=BPX1
SET BPX1=""
+44 if BPX1=""
SET BPX1=$$GETMESS^BPSSCRU3(504,BP59)
+45 IF $LENGTH(BPX1)>0
SET BPTXT1=BPTXT1_"- "_$TRANSLATE(BPX1,"]","")
End DoDot:1
+46 ;
+47 SET BPTXT2=$EXTRACT(BPTXT1,1,BPMLEN)
+48 SET BPTXT3=$EXTRACT(BPTXT1,BPMLEN+1,2*BPMLEN)
+49 SET BPTXT4=$EXTRACT(BPTXT1,(2*BPMLEN)+1,3*BPMLEN)
+50 IF $LENGTH(BPTXT2)>0
SET BPN=BPN+1
SET BPARR(BPN)=BPTXT2
+51 IF $LENGTH(BPTXT3)>0
SET BPN=BPN+1
SET BPARR(BPN)=BPTXT3
+52 IF $LENGTH(BPTXT4)>0
SET BPN=BPN+1
SET BPARR(BPN)=BPTXT4
+53 QUIT BPN
+54 ;
CLMINF(BP59) ;ptr to #9002313.59
+1 WRITE !,"Claim info. Press a key"
+2 DO PAUSE^VALM1
+3 QUIT
+4 ;
EREJTXT(BP59) ; return the eT/eC line for non-billable entry
+1 NEW ELIG,BPX2
+2 SET BPX2=""
+3 SET ELIG=$$GET1^DIQ(9002313.59,BP59,901.04)
+4 ; must be TRI/CVA eligibility for non-billable
IF '$FIND(".T.C.","."_$EXTRACT(ELIG,1)_".")
GOTO EREJTX
+5 ; build eT / eC line
SET BPX2="e"_$EXTRACT(ELIG,1)_":"_ELIG_"-RX NOT BILLABLE ("_$PIECE($GET(^BPST(BP59,3)),U,1)_")"
EREJTX ;
+1 QUIT BPX2
+2 ;
COMM(BP59) ;ptr to #9002313.59
+1 WRITE !,"the latest comment. Press a key"
+2 DO PAUSE^VALM1
+3 QUIT
+4 ;
RESP(BP59) ;Payer Response Information
+1 WRITE !,"payer Response Information. Press a key"
+2 DO PAUSE^VALM1
+3 QUIT
+4 ;
+5 ;/**
+6 ;Checks if the claim is closed and sets the "/Closed" indicator at the end of the text
+7 ;BP59 - pointer to file #9002313.59
+8 ;BPTXT - Current status text to be displayed
+9 ;return:
+10 ;if the claim is not closed, BPTXT is returned. If it is closed BPTXT_"/Closed " is returned
CLMCLSTX(BP59,BPTXT) ;*/
+1 QUIT $SELECT($$CLOSED02($PIECE($GET(^BPST(BP59,0)),U,4)):BPTXT_"/Closed ",1:BPTXT)
+2 ;
+3 ;/**
+4 ;Checks if the CLAIM for specific Transaction is CLOSED?
+5 ;BPCLAIM - ptr to #9002313.02
+6 ;see also CLOSED^BPSSCRU1
CLOSED02(BPCLAIM) ;*/
+1 IF +$GET(BPCLAIM)=0
QUIT 0
+2 ; get closed status
+3 QUIT +$PIECE($GET(^BPSC(BPCLAIM,900)),U)=1
+4 ;
+5 ;return:
+6 ; 1 - okay. matches criteria
+7 ; 0- not okay, doesn't match criteria
FILTER(BP59,BPARR) ;
+1 NEW BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM,BPRTBB
+2 NEW BPRET,BPSRPU,BPSFT
+3 ;1 - okay by default
SET BPRET=1
+4 SET BPST0=$GET(^BPST(BP59,0))
+5 SET BPST1=$GET(^BPST(BP59,1))
+6 ; Do not display eligibility verification requests
+7 IF $PIECE(BPST0,U,15)="E"
QUIT 0
+8 SET BPRXREF=$$RXREF^BPSSCRU2(BP59)
+9 ;ptr to #52
SET BPRX52=+$PIECE(BPRXREF,U)
+10 ;refill #
SET BPREFNUM=$PIECE(BPRXREF,U,2)
+11 ;
+12 ;Check for Open Claim
+13 ; n/a for non-billables
IF '$$NB(BP59)
IF $GET(BPARR(2.02))="O"
IF $$CLOSED02(+$PIECE(BPST0,U,4))
QUIT 0
+14 ;Check for Closed Claim
+15 ; n/a for non-billables
IF '$$NB(BP59)
IF $GET(BPARR(2.02))="C"
IF '$$CLOSED02(+$PIECE(BPST0,U,4))
QUIT 0
+16 ;
+17 ; non-billable entry - Open entries only
IF $GET(BPARR(1.19))="O"
IF $$NBCL(BP59)
QUIT 0
+18 ; non-billable entry - Closed entries only
IF $GET(BPARR(1.19))="C"
IF $$NBOP(BP59)
QUIT 0
+19 ;
+20 ;Eligibility Indicator
+21 IF '$$FLTELIG^BPSSCR05(BP59,.BPARR)
QUIT 0
+22 ;
+23 ;Submission type
+24 ; n/a for non-billables
IF '$$NB(BP59)
IF '$$FLTSUBTP^BPSSCR05(BP59,.BPARR)
QUIT 0
+25 ;
+26 ;user
+27 IF $GET(BPARR(1.01))="U"
IF $$FLTUSR(BPST0,.BPARR)=0
QUIT 0
+28 ;
+29 ;patient
+30 IF $GET(BPARR(1.02))="P"
IF $$FLTPAT(BPST0,.BPARR)=0
QUIT 0
+31 ;
+32 ;RX
+33 IF $GET(BPARR(1.03))="R"
IF $$FLTRX(BPST1,.BPARR)=0
QUIT 0
+34 ;
+35 SET BPSRPU=1
+36 ; n/a for non-billables
IF '$$NB(BP59)
Begin DoDot:1
+37 SET BPSRPU=0
+38 IF ($GET(BPARR(1.06))["R")&($$REJECTED^BPSSCR02(BP59)=1)
SET BPSRPU=1
+39 IF ($GET(BPARR(1.06))["P")&($$PAYABLE^BPSSCR02(BP59)=1)
SET BPSRPU=1
+40 IF ($GET(BPARR(1.06))["U")&($$UNSTRAND^BPSSCR02(BP59)=1)
SET BPSRPU=1
+41 IF $GET(BPARR(1.06))["A"
SET BPSRPU=1
End DoDot:1
+42 IF BPSRPU=0
QUIT 0
+43 ;
+44 ;released
+45 IF $GET(BPARR(1.07))="R"
IF $$RL^BPSSCRU2(BP59)'="R"
QUIT 0
+46 ;non released
+47 IF $GET(BPARR(1.07))="N"
IF $$RL^BPSSCRU2(BP59)="R"
QUIT 0
+48 ;
+49 ;window/cmop/mail
+50 IF $GET(BPARR(1.08))'="A"
IF $$ISMWC(BPRX52,BPREFNUM,$GET(BPARR(1.08)))=0
QUIT 0
+51 ;
+52 ; filter checks for fill type
+53 SET BPRTBB=$$RTBB^BPSSCRU2(BP59)
IF BPRTBB="**"
SET BPRTBB="RT"
+54 SET BPSFT=1
+55 IF $GET(BPARR(1.09))'["A"
Begin DoDot:1
+56 SET BPSFT=0
+57 ; filter for back billing
IF $GET(BPARR(1.09))["B"
IF BPRTBB="BB"
SET BPSFT=1
+58 ; filter for PRO Option
IF $GET(BPARR(1.09))["P"
IF BPRTBB="P2"
SET BPSFT=1
+59 ; filter for ECME user screen resubmits (BPS*1*20)
IF $GET(BPARR(1.09))["S"
IF BPRTBB="RS"
SET BPSFT=1
+60 ; filter for real time
IF $GET(BPARR(1.09))["R"
IF BPRTBB="RT"
SET BPSFT=1
End DoDot:1
+61 IF BPSFT=0
QUIT 0
+62 ;
+63 ;if only rejected and only specific rejected codes should be displayed
+64 ;I $G(BPARR(1.06))["R",$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
+65 IF (($GET(BPARR(1.06))["R")!($GET(BPARR(1.06))="A"))
IF $GET(BPARR(1.1))="R"
IF $$FLTREJ(BP59,.BPARR)=0
QUIT 0
+66 ;
+67 ;insurance
+68 IF '$$FLTINS^BPSSCR05(BP59,.BPARR)
QUIT 0
+69 ;
+70 ;divisions - ECME pharmacies
+71 IF $GET(BPARR(1.13))="D"
IF BPARR("DIVS")'[(";"_$PIECE(BPST1,U,7)_";")
QUIT 0
+72 QUIT 1
+73 ;
+74 ;check user filter
+75 ;input:
+76 ;BPST0 - zero node of #9002313.59
+77 ;BPARR array with user's preferences
+78 ;returns :
+79 ;1 -okay, leave in the list
+80 ;0 -not okay, exclude from the list
FLTUSR(BPST0,BPARR) ;
+1 IF $LENGTH($GET(BPARR(1.16)))=0
QUIT 0
+2 IF $PIECE(BPST0,U,10)=$GET(BPARR(1.16))
QUIT 1
+3 IF $GET(BPARR(1.16))[(";"_$PIECE(BPST0,U,10)_";")
QUIT 1
+4 QUIT 0
+5 ;
+6 ;check patient filter
+7 ;input:
+8 ;BPST0 - zero node of #9002313.59
+9 ;BPARR array with user's preferences
+10 ;returns :
+11 ;1 -okay, leave in the list
+12 ;0 -not okay, exclude from the list
FLTPAT(BPST0,BPARR) ;
+1 IF $LENGTH($GET(BPARR(1.17)))=0
QUIT 0
+2 IF $PIECE(BPST0,U,6)=$GET(BPARR(1.17))
QUIT 1
+3 IF $GET(BPARR(1.17))[(";"_$PIECE(BPST0,U,6)_";")
QUIT 1
+4 QUIT 0
+5 ;check RX filter
+6 ;input:
+7 ;BPST1 - 1st node of #9002313.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
FLTRX(BPST1,BPARR) ;
+1 IF $LENGTH($GET(BPARR(1.18)))=0
QUIT 0
+2 IF $PIECE(BPST1,U,11)=$GET(BPARR(1.18))
QUIT 1
+3 IF $GET(BPARR(1.18))[(";"_$PIECE(BPST1,U,11)_";")
QUIT 1
+4 QUIT 0
+5 ;input:
+6 ;BP59 - zero node of #9002313.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
FLTREJ(BP59,BPARR) ;
+1 NEW BPRCODES
+2 NEW BPSRJCD,BPSRJFLAG,BPSRJIEN
+3 ; bps*1*20 include possible non-billable pseudo-reject codes too
DO REJCODES^BPSSCRU3(BP59,.BPRCODES,1)
+4 ;
+5 SET BPSRJCD=""
SET BPSRJFLAG=0
+6 FOR
SET BPSRJCD=$ORDER(BPRCODES(BPSRJCD))
if BPSRJCD=""
QUIT
if BPSRJFLAG=1
QUIT
Begin DoDot:1
+7 SET BPSRJIEN=""
SET BPSRJIEN=$ORDER(^BPSF(9002313.93,"B",BPSRJCD,BPSRJIEN))
+8 IF BPARR(1.15)=BPSRJIEN
SET BPSRJFLAG=1
+9 IF BPARR(1.15)[(";"_BPSRJIEN_";")
SET BPSRJFLAG=1
End DoDot:1
+10 QUIT BPSRJFLAG
+11 ;
+12 ;check W(indow)/C(mop)/M(ail)
+13 ;input:
+14 ;BPRX52 - ptr to #52
+15 ;BPREFNUM - refill #
+16 ;BPMWC - given value from CMOP/MAIL/WINDOW instance 1.08 of BPS USRSCR parameters
+17 ;returns :
+18 ;1 -okay, leave in the list
+19 ;0 -not okay, exclude from the list
ISMWC(BPRX52,BPREFNUM,BPMWC) ;
+1 IF BPMWC[$$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM))
QUIT 1
+2 QUIT 0
+3 ;
FILTRALL(BPTMP1,BPTMP2,BPARR) ;
+1 NEW BP59
+2 SET BP59=0
+3 FOR
SET BP59=+$ORDER(@BPTMP1@(BP59))
if +BP59=0
QUIT
Begin DoDot:1
+4 IF $$FILTER(BP59,.BPARR)
SET @BPTMP2@(BP59)=""
End DoDot:1
+5 QUIT
+6 ;
+7 ;go thru all FILE59 entries and run SETTRDFN for each of them
+8 ;
TRDFNALL(BPTMP) ;
+1 NEW BP59
+2 SET BP59=0
+3 FOR
SET BP59=+$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:1
+4 DO SETTRDFN(BPTMP,BP59)
End DoDot:1
+5 QUIT
+6 ;
+7 ;sorting for "TRANSACTION DATE" type is
+8 ;actually sorting by patients , but patient should be sorted not in alphabetical order:
+9 ;the first patient is the one which has the most recent transaction and so on
+10 ;BPTMP - TMP global
+11 ;BP59 - ptr to #9002313.59
SETTRDFN(BPTMP,BP59) ;
+1 ;the following stores the latest transaction date of the claims, which
+2 ;was found for this particular combination of patient and insurance
+3 ;@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
+4 ;the following stores the latest transaction date BPTRDT,patient BPDFN and
+5 ;insurance BPINSUR to provide a proper order
+6 ;@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
+7 NEW BPZERO,BPTRDT,BPDFN,BPPREV,BPINSUR
+8 ;
SET BPZERO=$GET(^BPST(BP59,0))
+9 ;"transaction" date
SET BPTRDT=-$PIECE(BPZERO,U,8)
+10 ;patient ptr to #2
SET BPDFN=+$PIECE(BPZERO,U,6)
+11 ;insurance ien
SET BPINSUR=+$$GETINSUR^BPSSCRU2(BP59)
+12 ;in the beginning we don't have any "DFN-TRDT" and "TRDTDFN"
+13 ;so create them and quit
+14 IF '$DATA(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR))
Begin DoDot:1
+15 SET @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
+16 SET @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
End DoDot:1
QUIT
+17 ;if we already have them then get the latest into BPPREV
+18 SET BPPREV=+$GET(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR))
+19 ;and compare it against the BPTRDT for this BP59
+20 ;if the BPTRDT is greater then replace the values in "DFN-TRDT"
+21 ;and "TRDTDFN"
+22 IF BPTRDT<BPPREV
Begin DoDot:1
+23 SET @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
+24 SET @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
+25 KILL @BPTMP@("TRDTDFN",BPPREV,BPDFN,BPINSUR)
End DoDot:1
+26 QUIT
+27 ;
NB(BP59) ; Is this BPS Transaction a TRI/CVA non-billable entry?
+1 ; yep
IF $PIECE($GET(^BPST(+$GET(BP59),0)),U,15)="N"
QUIT 1
+2 ; nope
QUIT 0
+3 ;
NBCL(BP59) ; Is this BPS Transaction a Closed TRI/CVA non-billable entry?
+1 ; yep
IF $$NB(+$GET(BP59))
IF $PIECE($GET(^BPST(+$GET(BP59),3)),U,2)
QUIT 1
+2 ; nope
QUIT 0
+3 ;
NBOP(BP59) ; Is this BPS Transaction an Open TRI/CVA non-billable entry?
+1 ; yep
IF $$NB(+$GET(BP59))
IF '$PIECE($GET(^BPST(+$GET(BP59),3)),U,2)
QUIT 1
+2 ; nope
QUIT 0
+3 ;
