BPSSCR03 ;BHAM ISC/SS - ECME USR SCREEN UTILITIES ;05-APR-05 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45 ;;Per VHA Directive 2004-038, 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,BPPRCNTG,BPN2,BPSTATUS 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)_" - "_$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) S BPPRCNTG=$$LJ^BPSSCR02("("_$$PRCNTG^BPSSCRU3(BP59)_"%) ",6) ;I BPX["AR" S BPARR(BPN)="Auto-Reversal",BPN=BPN+1 I BPSTATUS["E REVERSAL ACCEPTED" S BPTXT1=BPTXT1_"Reversal accepted " I BPSTATUS["E REVERSAL REJECTED" S BPTXT1=BPTXT1_"Reversal rejected " I BPSTATUS["E PAYABLE" S BPTXT1=BPTXT1_"Payable " I BPSTATUS["E REJECTED" S BPTXT1=BPTXT1_"Rejected " I BPSTATUS["E STRANDED" S BPTXT1=BPTXT1_"Stranded " I BPSTATUS["E REVERSAL STRANDED" S BPTXT1=BPTXT1_"Stranded reversal" I BPSTATUS["E CAPTURED" S BPTXT1=BPTXT1_"Captured " I BPSTATUS["E DUPLICATE" S BPTXT1=BPTXT1_"Duplicate " I BPSTATUS["E OTHER" S BPTXT1=BPTXT1_"Other " I BPSTATUS["IN PROGRESS" S BPTXT1=BPTXT1_"In progress " I BPSTATUS["CORRUPT" S BPTXT1=BPTXT1_"Corrupt " I BPSTATUS["E REVERSAL OTHER" S BPTXT1=BPTXT1_"Reversal Other " I BPTXT1="" S BPTXT1="Unknown status " ; 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(1000,504,BP59),74,"",0) . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,526,BP59),74,"",0) . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,0,BP59),74,"",0) . I BPN>BPN2 Q ;reject codes are enough . ;S BPX1=$P($P(BPX,U,3),"[") I BPTXT1=BPX1 S BPX1="" . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,0,BP59) . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","") ; I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E STRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL STRANDED") D . I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS") S BPX1=$P(BPX,U,3) I BPTXT1=BPX1 S BPX1="" . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,0,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 ; ; 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 for specific Transaction is CLOSED? ;BPCLAIM - ptr to #9002313.02 ;see also CLOSED^BPSSCRU1 CLOSED02(BPCLAIM) ;*/ ; get closed status Q +$P($G(^BPSC(BPCLAIM,900)),U)=1 ;Q $$GET1^DIQ(9002313.02,CLAIM,901,"I") ; ;return: ; 1 - okay. matches criteria ; 0- not okay, doesn't match criteria FILTER(BP59,BPARR) ; N BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM N BPRET S BPRET=1 ;1 - okay bt default S BPST0=$G(^BPST(BP59,0)) S BPST1=$G(^BPST(BP59,1)) S BPRXREF=$$RXREF^BPSSCRU2(BP59) S BPRX52=+$P(BPRXREF,U) ;ptr to #52 S BPREFNUM=$P(BPRXREF,U,2) ;refill # ;if closed I $$CLOSED02(+$P(BPST0,U,4)) Q 0 ;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 ;only rejected I $G(BPARR(1.06))="R",$$REJECTED^BPSSCR02(BP59)=0 Q 0 ;only payable I $G(BPARR(1.06))="P",$$PAYABLE^BPSSCR02(BP59)=0 Q 0 ;released I $G(BPARR(1.07))="R",$$RL^BPSSCRU2(BP59)'="RL" Q 0 ;non released I $G(BPARR(1.07))="N",$$RL^BPSSCRU2(BP59)="RL" Q 0 ;window/cmop/mail I $G(BPARR(1.08))'="A",$$ISMWC(BPRX52,BPREFNUM,$G(BPARR(1.08)))=0 Q 0 ;Back billing I $G(BPARR(1.09))="B",$$RTBB^BPSSCRU2(BP59)'="BB" Q 0 ;real time I $G(BPARR(1.09))="R",$$RTBB^BPSSCRU2(BP59)="BB" 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 ;insurance I $G(BPARR(1.11))="I",$G(BPARR(1.14))'="",$P($$GETINSUR^BPSSCRU2(+BP59),U,2)'=$G(BPARR(1.14)) 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 0 Q 1 ;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 0 Q 1 ;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 0 Q 1 ;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 BPRJCD S BPRJCD=$P($G(^BPSF(9002313.93,+$G(BPARR(1.15)),0)),U) I $L(BPRJCD)=0 Q 0 D REJCODES^BPSSCRU3(BP59,.BPRCODES) I $D(BPRCODES(BPRJCD)) Q 1 Q 0 ;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 $$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM))=BPMWC 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