Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSSCR03

BPSSCR03.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;/**
  1. ;BP59 - ptr to 9002313.59
  1. ; BPARR to return formatted info via ref
  1. ; BPMLEM - max len for each line
  1. ; BPMODE - mode
  1. ; R -regular for main screen, will show only latest comment
  1. ; C - comment mode - show all comments
  1. ADDINF(BP59,BPARR,BPMLEN,BPMODE) ;to return additional information about the claim*/
  1. N BPX,BPN,BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1,BPN2,BPSTATUS,BPSCOBA,BP59X,I
  1. S BPN=0,(BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1)=""
  1. I BPMODE="R" D
  1. . S BPX=$$COMMENT^BPSSCRU3(BP59)
  1. . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=$P(BPX,U)
  1. . I $P(BPX,U,2)]"" S BPN=BPN+1,BPARR(BPN)="("_$P(BPX,U,2)_")"
  1. E D
  1. . N BPCMNT,BPX1 S BPCMNT=99999999
  1. . F S BPCMNT=$O(^BPST(BP59,11,BPCMNT),-1) Q:+BPCMNT=0 D
  1. . . S BPX1=$G(^BPST(BP59,11,BPCMNT,0))
  1. . . I BPX1="" Q
  1. . . S BPX=$$DATTIM^BPSSCRU3($P(BPX1,U,1)\1)_$S(+$P(BPX1,U,4):" (Pharm)",1:"")_" - "_$P(BPX1,U,3)
  1. . . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=BPX
  1. . . I +$P(BPX1,U,2)]"" D
  1. . . . S BPX=$$USERNAM^BPSCMT01(+$P(BPX1,U,2))
  1. . . . I BPX'="" S BPX="("_BPX_")",BPN=BPN+1,BPARR(BPN)=BPX
  1. S BPX=$$CLAIMST^BPSSCRU3(BP59)
  1. S BPSTATUS=$P(BPX,U)
  1. ; Show status for this BPS Transaction
  1. S BPTXT1=$$COBCLST^BPSSCRU6(BP59)
  1. ; Append status for associated claim, if one exists
  1. S BPSCOBA=$$ALLCOB59^BPSUTIL2(BP59)
  1. F I=1:1 S BP59X=$P(BPSCOBA,U,I) Q:BP59X="" D
  1. . Q:BP59X=BP59
  1. . S BPTXT1=BPTXT1_" ("_$$COBCLST^BPSSCRU6(BP59X)_")"
  1. ;
  1. ; build the TRI/CVA non-billable reject/reason lines (bps*1*20)
  1. I $$NB(BP59) D
  1. . I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1 ; store the current line
  1. . S BPTXT1=""
  1. . S BPN=BPN+1,BPARR(BPN)=$$EREJTXT(BP59) ; store the eT/eC non-billable reject/reason line
  1. . Q
  1. ;
  1. I (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED") D
  1. . I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1
  1. . S BPTXT1=""
  1. . S BPN2=BPN
  1. . D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
  1. . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0)
  1. . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0)
  1. ;
  1. I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E UNSTRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL OTHER")!(BPSTATUS["E REVERSAL UNSTRANDED") D
  1. . I (BPSTATUS["E OTHER")!(BPSTATUS["E REVERSAL OTHER")!(BPSTATUS["IN PROGRESS") S BPX1=$P(BPX,U,3) I BPTXT1=BPX1 S BPX1=""
  1. . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,BP59)
  1. . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","")
  1. ;
  1. S BPTXT2=$E(BPTXT1,1,BPMLEN)
  1. S BPTXT3=$E(BPTXT1,BPMLEN+1,2*BPMLEN)
  1. S BPTXT4=$E(BPTXT1,(2*BPMLEN)+1,3*BPMLEN)
  1. I $L(BPTXT2)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT2
  1. I $L(BPTXT3)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT3
  1. I $L(BPTXT4)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT4
  1. Q BPN
  1. ;
  1. CLMINF(BP59) ;ptr to #9002313.59
  1. W !,"Claim info. Press a key"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. EREJTXT(BP59) ; return the eT/eC line for non-billable entry
  1. N ELIG,BPX2
  1. S BPX2=""
  1. S ELIG=$$GET1^DIQ(9002313.59,BP59,901.04)
  1. I '$F(".T.C.","."_$E(ELIG,1)_".") G EREJTX ; must be TRI/CVA eligibility for non-billable
  1. S BPX2="e"_$E(ELIG,1)_":"_ELIG_"-RX NOT BILLABLE ("_$P($G(^BPST(BP59,3)),U,1)_")" ; build eT / eC line
  1. EREJTX ;
  1. Q BPX2
  1. ;
  1. COMM(BP59) ;ptr to #9002313.59
  1. W !,"the latest comment. Press a key"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. RESP(BP59) ;Payer Response Information
  1. W !,"payer Response Information. Press a key"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. ;/**
  1. ;Checks if the claim is closed and sets the "/Closed" indicator at the end of the text
  1. ;BP59 - pointer to file #9002313.59
  1. ;BPTXT - Current status text to be displayed
  1. ;return:
  1. ;if the claim is not closed, BPTXT is returned. If it is closed BPTXT_"/Closed " is returned
  1. CLMCLSTX(BP59,BPTXT) ;*/
  1. Q $S($$CLOSED02($P($G(^BPST(BP59,0)),U,4)):BPTXT_"/Closed ",1:BPTXT)
  1. ;
  1. ;/**
  1. ;Checks if the CLAIM for specific Transaction is CLOSED?
  1. ;BPCLAIM - ptr to #9002313.02
  1. ;see also CLOSED^BPSSCRU1
  1. CLOSED02(BPCLAIM) ;*/
  1. I +$G(BPCLAIM)=0 Q 0
  1. ; get closed status
  1. Q +$P($G(^BPSC(BPCLAIM,900)),U)=1
  1. ;
  1. ;return:
  1. ; 1 - okay. matches criteria
  1. ; 0- not okay, doesn't match criteria
  1. FILTER(BP59,BPARR) ;
  1. N BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM,BPRTBB
  1. N BPRET,BPSRPU,BPSFT
  1. S BPRET=1 ;1 - okay by default
  1. S BPST0=$G(^BPST(BP59,0))
  1. S BPST1=$G(^BPST(BP59,1))
  1. ; Do not display eligibility verification requests
  1. I $P(BPST0,U,15)="E" Q 0
  1. S BPRXREF=$$RXREF^BPSSCRU2(BP59)
  1. S BPRX52=+$P(BPRXREF,U) ;ptr to #52
  1. S BPREFNUM=$P(BPRXREF,U,2) ;refill #
  1. ;
  1. ;Check for Open Claim
  1. I '$$NB(BP59),$G(BPARR(2.02))="O",$$CLOSED02(+$P(BPST0,U,4)) Q 0 ; n/a for non-billables
  1. ;Check for Closed Claim
  1. I '$$NB(BP59),$G(BPARR(2.02))="C",'$$CLOSED02(+$P(BPST0,U,4)) Q 0 ; n/a for non-billables
  1. ;
  1. I $G(BPARR(1.19))="O",$$NBCL(BP59) Q 0 ; non-billable entry - Open entries only
  1. I $G(BPARR(1.19))="C",$$NBOP(BP59) Q 0 ; non-billable entry - Closed entries only
  1. ;
  1. ;Eligibility Indicator
  1. I '$$FLTELIG^BPSSCR05(BP59,.BPARR) Q 0
  1. ;
  1. ;Submission type
  1. I '$$NB(BP59),'$$FLTSUBTP^BPSSCR05(BP59,.BPARR) Q 0 ; n/a for non-billables
  1. ;
  1. ;user
  1. I $G(BPARR(1.01))="U",$$FLTUSR(BPST0,.BPARR)=0 Q 0
  1. ;
  1. ;patient
  1. I $G(BPARR(1.02))="P",$$FLTPAT(BPST0,.BPARR)=0 Q 0
  1. ;
  1. ;RX
  1. I $G(BPARR(1.03))="R",$$FLTRX(BPST1,.BPARR)=0 Q 0
  1. ;
  1. S BPSRPU=1
  1. I '$$NB(BP59) D ; n/a for non-billables
  1. . S BPSRPU=0
  1. . I ($G(BPARR(1.06))["R")&($$REJECTED^BPSSCR02(BP59)=1) S BPSRPU=1
  1. . I ($G(BPARR(1.06))["P")&($$PAYABLE^BPSSCR02(BP59)=1) S BPSRPU=1
  1. . I ($G(BPARR(1.06))["U")&($$UNSTRAND^BPSSCR02(BP59)=1) S BPSRPU=1
  1. . I $G(BPARR(1.06))["A" S BPSRPU=1
  1. I BPSRPU=0 Q 0
  1. ;
  1. ;released
  1. I $G(BPARR(1.07))="R",$$RL^BPSSCRU2(BP59)'="R" Q 0
  1. ;non released
  1. I $G(BPARR(1.07))="N",$$RL^BPSSCRU2(BP59)="R" Q 0
  1. ;
  1. ;window/cmop/mail
  1. I $G(BPARR(1.08))'="A",$$ISMWC(BPRX52,BPREFNUM,$G(BPARR(1.08)))=0 Q 0
  1. ;
  1. ; filter checks for fill type
  1. S BPRTBB=$$RTBB^BPSSCRU2(BP59) I BPRTBB="**" S BPRTBB="RT"
  1. S BPSFT=1
  1. I $G(BPARR(1.09))'["A" D
  1. . S BPSFT=0
  1. . I $G(BPARR(1.09))["B",BPRTBB="BB" S BPSFT=1 ; filter for back billing
  1. . I $G(BPARR(1.09))["P",BPRTBB="P2" S BPSFT=1 ; filter for PRO Option
  1. . I $G(BPARR(1.09))["S",BPRTBB="RS" S BPSFT=1 ; filter for ECME user screen resubmits (BPS*1*20)
  1. . I $G(BPARR(1.09))["R",BPRTBB="RT" S BPSFT=1 ; filter for real time
  1. I BPSFT=0 Q 0
  1. ;
  1. ;if only rejected and only specific rejected codes should be displayed
  1. ;I $G(BPARR(1.06))["R",$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
  1. I (($G(BPARR(1.06))["R")!($G(BPARR(1.06))="A")),$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
  1. ;
  1. ;insurance
  1. I '$$FLTINS^BPSSCR05(BP59,.BPARR) Q 0
  1. ;
  1. ;divisions - ECME pharmacies
  1. I $G(BPARR(1.13))="D",BPARR("DIVS")'[(";"_$P(BPST1,U,7)_";") Q 0
  1. Q 1
  1. ;
  1. ;check user filter
  1. ;input:
  1. ;BPST0 - zero node of #9002313.59
  1. ;BPARR array with user's preferences
  1. ;returns :
  1. ;1 -okay, leave in the list
  1. ;0 -not okay, exclude from the list
  1. FLTUSR(BPST0,BPARR) ;
  1. I $L($G(BPARR(1.16)))=0 Q 0
  1. I $P(BPST0,U,10)=$G(BPARR(1.16)) Q 1
  1. I $G(BPARR(1.16))[(";"_$P(BPST0,U,10)_";") Q 1
  1. Q 0
  1. ;
  1. ;check patient filter
  1. ;input:
  1. ;BPST0 - zero node of #9002313.59
  1. ;BPARR array with user's preferences
  1. ;returns :
  1. ;1 -okay, leave in the list
  1. ;0 -not okay, exclude from the list
  1. FLTPAT(BPST0,BPARR) ;
  1. I $L($G(BPARR(1.17)))=0 Q 0
  1. I $P(BPST0,U,6)=$G(BPARR(1.17)) Q 1
  1. I $G(BPARR(1.17))[(";"_$P(BPST0,U,6)_";") Q 1
  1. Q 0
  1. ;check RX filter
  1. ;input:
  1. ;BPST1 - 1st node of #9002313.59
  1. ;BPARR array with user's preferences
  1. ;returns :
  1. ;1 -okay, leave in the list
  1. ;0 -not okay, exclude from the list
  1. FLTRX(BPST1,BPARR) ;
  1. I $L($G(BPARR(1.18)))=0 Q 0
  1. I $P(BPST1,U,11)=$G(BPARR(1.18)) Q 1
  1. I $G(BPARR(1.18))[(";"_$P(BPST1,U,11)_";") Q 1
  1. Q 0
  1. ;input:
  1. ;BP59 - zero node of #9002313.59
  1. ;BPARR array with user's preferences
  1. ;returns :
  1. ;1 -okay, leave in the list
  1. ;0 -not okay, exclude from the list
  1. FLTREJ(BP59,BPARR) ;
  1. N BPRCODES
  1. N BPSRJCD,BPSRJFLAG,BPSRJIEN
  1. D REJCODES^BPSSCRU3(BP59,.BPRCODES,1) ; bps*1*20 include possible non-billable pseudo-reject codes too
  1. ;
  1. S BPSRJCD="",BPSRJFLAG=0
  1. F S BPSRJCD=$O(BPRCODES(BPSRJCD)) Q:BPSRJCD="" Q:BPSRJFLAG=1 D
  1. . S BPSRJIEN="",BPSRJIEN=$O(^BPSF(9002313.93,"B",BPSRJCD,BPSRJIEN))
  1. . I BPARR(1.15)=BPSRJIEN S BPSRJFLAG=1
  1. . I BPARR(1.15)[(";"_BPSRJIEN_";") S BPSRJFLAG=1
  1. Q BPSRJFLAG
  1. ;
  1. ;check W(indow)/C(mop)/M(ail)
  1. ;input:
  1. ;BPRX52 - ptr to #52
  1. ;BPREFNUM - refill #
  1. ;BPMWC - given value from CMOP/MAIL/WINDOW instance 1.08 of BPS USRSCR parameters
  1. ;returns :
  1. ;1 -okay, leave in the list
  1. ;0 -not okay, exclude from the list
  1. ISMWC(BPRX52,BPREFNUM,BPMWC) ;
  1. I BPMWC[$$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM)) Q 1
  1. Q 0
  1. ;
  1. FILTRALL(BPTMP1,BPTMP2,BPARR) ;
  1. N BP59
  1. S BP59=0
  1. F S BP59=+$O(@BPTMP1@(BP59)) Q:+BP59=0 D
  1. . I $$FILTER(BP59,.BPARR) S @BPTMP2@(BP59)=""
  1. Q
  1. ;
  1. ;go thru all FILE59 entries and run SETTRDFN for each of them
  1. ;
  1. TRDFNALL(BPTMP) ;
  1. N BP59
  1. S BP59=0
  1. F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
  1. . D SETTRDFN(BPTMP,BP59)
  1. Q
  1. ;
  1. ;sorting for "TRANSACTION DATE" type is
  1. ;actually sorting by patients , but patient should be sorted not in alphabetical order:
  1. ;the first patient is the one which has the most recent transaction and so on
  1. ;BPTMP - TMP global
  1. ;BP59 - ptr to #9002313.59
  1. SETTRDFN(BPTMP,BP59) ;
  1. ;the following stores the latest transaction date of the claims, which
  1. ;was found for this particular combination of patient and insurance
  1. ;@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
  1. ;the following stores the latest transaction date BPTRDT,patient BPDFN and
  1. ;insurance BPINSUR to provide a proper order
  1. ;@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
  1. N BPZERO,BPTRDT,BPDFN,BPPREV,BPINSUR
  1. S BPZERO=$G(^BPST(BP59,0)) ;
  1. S BPTRDT=-$P(BPZERO,U,8) ;"transaction" date
  1. S BPDFN=+$P(BPZERO,U,6) ;patient ptr to #2
  1. S BPINSUR=+$$GETINSUR^BPSSCRU2(BP59) ;insurance ien
  1. ;in the beginning we don't have any "DFN-TRDT" and "TRDTDFN"
  1. ;so create them and quit
  1. I '$D(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)) D Q
  1. . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
  1. . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
  1. ;if we already have them then get the latest into BPPREV
  1. S BPPREV=+$G(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR))
  1. ;and compare it against the BPTRDT for this BP59
  1. ;if the BPTRDT is greater then replace the values in "DFN-TRDT"
  1. ;and "TRDTDFN"
  1. I BPTRDT<BPPREV D
  1. . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
  1. . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
  1. . K @BPTMP@("TRDTDFN",BPPREV,BPDFN,BPINSUR)
  1. Q
  1. ;
  1. NB(BP59) ; Is this BPS Transaction a TRI/CVA non-billable entry?
  1. I $P($G(^BPST(+$G(BP59),0)),U,15)="N" Q 1 ; yep
  1. Q 0 ; nope
  1. ;
  1. NBCL(BP59) ; Is this BPS Transaction a Closed TRI/CVA non-billable entry?
  1. I $$NB(+$G(BP59)),$P($G(^BPST(+$G(BP59),3)),U,2) Q 1 ; yep
  1. Q 0 ; nope
  1. ;
  1. NBOP(BP59) ; Is this BPS Transaction an Open TRI/CVA non-billable entry?
  1. I $$NB(+$G(BP59)),'$P($G(^BPST(+$G(BP59),3)),U,2) Q 1 ; yep
  1. Q 0 ; nope
  1. ;