- 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 Jan 18, 2025@02:54:16 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 ;