| 1 | BPSSCR03 ;BHAM ISC/SS - ECME USR SCREEN UTILITIES ;05-APR-05
|
---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | Q
|
---|
| 5 | ;/**
|
---|
| 6 | ;BP59 - ptr to 9002313.59
|
---|
| 7 | ; BPARR to return formatted info via ref
|
---|
| 8 | ; BPMLEM - max len for each line
|
---|
| 9 | ; BPMODE - mode
|
---|
| 10 | ; R -regular for main screen, will show only latest comment
|
---|
| 11 | ; C - comment mode - show all comments
|
---|
| 12 | ADDINF(BP59,BPARR,BPMLEN,BPMODE) ;to return additional information about the claim*/
|
---|
| 13 | N BPX,BPN,BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1,BPPRCNTG,BPN2,BPSTATUS
|
---|
| 14 | S BPN=0,(BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1)=""
|
---|
| 15 | I BPMODE="R" D
|
---|
| 16 | . S BPX=$$COMMENT^BPSSCRU3(BP59)
|
---|
| 17 | . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=$P(BPX,U)
|
---|
| 18 | . I $P(BPX,U,2)]"" S BPN=BPN+1,BPARR(BPN)="("_$P(BPX,U,2)_")"
|
---|
| 19 | E D
|
---|
| 20 | . N BPCMNT,BPX1 S BPCMNT=99999999
|
---|
| 21 | . F S BPCMNT=$O(^BPST(BP59,11,BPCMNT),-1) Q:+BPCMNT=0 D
|
---|
| 22 | . . S BPX1=$G(^BPST(BP59,11,BPCMNT,0))
|
---|
| 23 | . . I BPX1="" Q
|
---|
| 24 | . . S BPX=$$DATTIM^BPSSCRU3($P(BPX1,U,1)\1)_" - "_$P(BPX1,U,3)
|
---|
| 25 | . . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=BPX
|
---|
| 26 | . . I +$P(BPX1,U,2)]"" D
|
---|
| 27 | . . . S BPX=$$USERNAM^BPSCMT01(+$P(BPX1,U,2))
|
---|
| 28 | . . . I BPX'="" S BPX="("_BPX_")",BPN=BPN+1,BPARR(BPN)=BPX
|
---|
| 29 | S BPX=$$CLAIMST^BPSSCRU3(BP59)
|
---|
| 30 | S BPSTATUS=$P(BPX,U)
|
---|
| 31 | S BPPRCNTG=$$LJ^BPSSCR02("("_$$PRCNTG^BPSSCRU3(BP59)_"%) ",6)
|
---|
| 32 | ;I BPX["AR" S BPARR(BPN)="Auto-Reversal",BPN=BPN+1
|
---|
| 33 | I BPSTATUS["E REVERSAL ACCEPTED" S BPTXT1=BPTXT1_"Reversal accepted "
|
---|
| 34 | I BPSTATUS["E REVERSAL REJECTED" S BPTXT1=BPTXT1_"Reversal rejected "
|
---|
| 35 | I BPSTATUS["E PAYABLE" S BPTXT1=BPTXT1_"Payable "
|
---|
| 36 | I BPSTATUS["E REJECTED" S BPTXT1=BPTXT1_"Rejected "
|
---|
| 37 | I BPSTATUS["E STRANDED" S BPTXT1=BPTXT1_"Stranded "
|
---|
| 38 | I BPSTATUS["E REVERSAL STRANDED" S BPTXT1=BPTXT1_"Stranded reversal"
|
---|
| 39 | I BPSTATUS["E CAPTURED" S BPTXT1=BPTXT1_"Captured "
|
---|
| 40 | I BPSTATUS["E DUPLICATE" S BPTXT1=BPTXT1_"Duplicate "
|
---|
| 41 | I BPSTATUS["E OTHER" S BPTXT1=BPTXT1_"Other "
|
---|
| 42 | I BPSTATUS["IN PROGRESS" S BPTXT1=BPTXT1_"In progress "
|
---|
| 43 | I BPSTATUS["CORRUPT" S BPTXT1=BPTXT1_"Corrupt "
|
---|
| 44 | I BPSTATUS["E REVERSAL OTHER" S BPTXT1=BPTXT1_"Reversal Other "
|
---|
| 45 | I BPTXT1="" S BPTXT1="Unknown status "
|
---|
| 46 | ;
|
---|
| 47 | I (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED") D
|
---|
| 48 | . I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1
|
---|
| 49 | . S BPTXT1=""
|
---|
| 50 | . S BPN2=BPN
|
---|
| 51 | . D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
|
---|
| 52 | . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,504,BP59),74,"",0)
|
---|
| 53 | . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,526,BP59),74,"",0)
|
---|
| 54 | . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,0,BP59),74,"",0)
|
---|
| 55 | . I BPN>BPN2 Q ;reject codes are enough
|
---|
| 56 | . ;S BPX1=$P($P(BPX,U,3),"[") I BPTXT1=BPX1 S BPX1=""
|
---|
| 57 | . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,0,BP59)
|
---|
| 58 | . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","")
|
---|
| 59 | ;
|
---|
| 60 | I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E STRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL STRANDED") D
|
---|
| 61 | . I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS") S BPX1=$P(BPX,U,3) I BPTXT1=BPX1 S BPX1=""
|
---|
| 62 | . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,0,BP59)
|
---|
| 63 | . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","")
|
---|
| 64 | ;
|
---|
| 65 | S BPTXT2=$E(BPTXT1,1,BPMLEN)
|
---|
| 66 | S BPTXT3=$E(BPTXT1,BPMLEN+1,2*BPMLEN)
|
---|
| 67 | S BPTXT4=$E(BPTXT1,(2*BPMLEN)+1,3*BPMLEN)
|
---|
| 68 | I $L(BPTXT2)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT2
|
---|
| 69 | I $L(BPTXT3)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT3
|
---|
| 70 | I $L(BPTXT4)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT4
|
---|
| 71 | Q BPN
|
---|
| 72 | ;
|
---|
| 73 | CLMINF(BP59) ;ptr to #9002313.59
|
---|
| 74 | W !,"Claim info. Press a key"
|
---|
| 75 | D PAUSE^VALM1
|
---|
| 76 | Q
|
---|
| 77 | ;
|
---|
| 78 | ;
|
---|
| 79 | COMM(BP59) ;ptr to #9002313.59
|
---|
| 80 | W !,"the latest comment. Press a key"
|
---|
| 81 | D PAUSE^VALM1
|
---|
| 82 | Q
|
---|
| 83 | ;
|
---|
| 84 | RESP(BP59) ;Payer Response Information
|
---|
| 85 | W !,"payer Response Information. Press a key"
|
---|
| 86 | D PAUSE^VALM1
|
---|
| 87 | Q
|
---|
| 88 | ;
|
---|
| 89 | ;/**
|
---|
| 90 | ;Checks if the CLAIM for specific Transaction is CLOSED?
|
---|
| 91 | ;BPCLAIM - ptr to #9002313.02
|
---|
| 92 | ;see also CLOSED^BPSSCRU1
|
---|
| 93 | CLOSED02(BPCLAIM) ;*/
|
---|
| 94 | ; get closed status
|
---|
| 95 | Q +$P($G(^BPSC(BPCLAIM,900)),U)=1 ;Q $$GET1^DIQ(9002313.02,CLAIM,901,"I")
|
---|
| 96 | ;
|
---|
| 97 | ;return:
|
---|
| 98 | ; 1 - okay. matches criteria
|
---|
| 99 | ; 0- not okay, doesn't match criteria
|
---|
| 100 | FILTER(BP59,BPARR) ;
|
---|
| 101 | N BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM
|
---|
| 102 | N BPRET
|
---|
| 103 | S BPRET=1 ;1 - okay bt default
|
---|
| 104 | S BPST0=$G(^BPST(BP59,0))
|
---|
| 105 | S BPST1=$G(^BPST(BP59,1))
|
---|
| 106 | S BPRXREF=$$RXREF^BPSSCRU2(BP59)
|
---|
| 107 | S BPRX52=+$P(BPRXREF,U) ;ptr to #52
|
---|
| 108 | S BPREFNUM=$P(BPRXREF,U,2) ;refill #
|
---|
| 109 | ;if closed
|
---|
| 110 | I $$CLOSED02(+$P(BPST0,U,4)) Q 0
|
---|
| 111 | ;user
|
---|
| 112 | I $G(BPARR(1.01))="U",$$FLTUSR(BPST0,.BPARR)=0 Q 0
|
---|
| 113 | ;patient
|
---|
| 114 | I $G(BPARR(1.02))="P",$$FLTPAT(BPST0,.BPARR)=0 Q 0
|
---|
| 115 | ;RX
|
---|
| 116 | I $G(BPARR(1.03))="R",$$FLTRX(BPST1,.BPARR)=0 Q 0
|
---|
| 117 | ;only rejected
|
---|
| 118 | I $G(BPARR(1.06))="R",$$REJECTED^BPSSCR02(BP59)=0 Q 0
|
---|
| 119 | ;only payable
|
---|
| 120 | I $G(BPARR(1.06))="P",$$PAYABLE^BPSSCR02(BP59)=0 Q 0
|
---|
| 121 | ;released
|
---|
| 122 | I $G(BPARR(1.07))="R",$$RL^BPSSCRU2(BP59)'="RL" Q 0
|
---|
| 123 | ;non released
|
---|
| 124 | I $G(BPARR(1.07))="N",$$RL^BPSSCRU2(BP59)="RL" Q 0
|
---|
| 125 | ;window/cmop/mail
|
---|
| 126 | I $G(BPARR(1.08))'="A",$$ISMWC(BPRX52,BPREFNUM,$G(BPARR(1.08)))=0 Q 0
|
---|
| 127 | ;Back billing
|
---|
| 128 | I $G(BPARR(1.09))="B",$$RTBB^BPSSCRU2(BP59)'="BB" Q 0
|
---|
| 129 | ;real time
|
---|
| 130 | I $G(BPARR(1.09))="R",$$RTBB^BPSSCRU2(BP59)="BB" Q 0
|
---|
| 131 | ;if only rejected and only specific rejected codes should be displayed
|
---|
| 132 | I $G(BPARR(1.06))="R",$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0
|
---|
| 133 | ;insurance
|
---|
| 134 | I $G(BPARR(1.11))="I",$G(BPARR(1.14))'="",$P($$GETINSUR^BPSSCRU2(+BP59),U,2)'=$G(BPARR(1.14)) Q 0
|
---|
| 135 | ;divisions - ECME pharmacies
|
---|
| 136 | I $G(BPARR(1.13))="D",BPARR("DIVS")'[(";"_$P(BPST1,U,7)_";") Q 0
|
---|
| 137 | Q 1
|
---|
| 138 | ;
|
---|
| 139 | ;check user filter
|
---|
| 140 | ;input:
|
---|
| 141 | ;BPST0 - zero node of #9002313.59
|
---|
| 142 | ;BPARR array with user's preferences
|
---|
| 143 | ;returns :
|
---|
| 144 | ;1 -okay, leave in the list
|
---|
| 145 | ;0 -not okay, exclude from the list
|
---|
| 146 | FLTUSR(BPST0,BPARR) ;
|
---|
| 147 | I $L($G(BPARR(1.16)))=0 Q 0
|
---|
| 148 | I $P(BPST0,U,10)'=$G(BPARR(1.16)) Q 0
|
---|
| 149 | Q 1
|
---|
| 150 | ;check patient filter
|
---|
| 151 | ;input:
|
---|
| 152 | ;BPST0 - zero node of #9002313.59
|
---|
| 153 | ;BPARR array with user's preferences
|
---|
| 154 | ;returns :
|
---|
| 155 | ;1 -okay, leave in the list
|
---|
| 156 | ;0 -not okay, exclude from the list
|
---|
| 157 | FLTPAT(BPST0,BPARR) ;
|
---|
| 158 | I $L($G(BPARR(1.17)))=0 Q 0
|
---|
| 159 | I $P(BPST0,U,6)'=$G(BPARR(1.17)) Q 0
|
---|
| 160 | Q 1
|
---|
| 161 | ;check RX filter
|
---|
| 162 | ;input:
|
---|
| 163 | ;BPST1 - 1st node of #9002313.59
|
---|
| 164 | ;BPARR array with user's preferences
|
---|
| 165 | ;returns :
|
---|
| 166 | ;1 -okay, leave in the list
|
---|
| 167 | ;0 -not okay, exclude from the list
|
---|
| 168 | FLTRX(BPST1,BPARR) ;
|
---|
| 169 | I $L($G(BPARR(1.18)))=0 Q 0
|
---|
| 170 | I $P(BPST1,U,11)'=$G(BPARR(1.18)) Q 0
|
---|
| 171 | Q 1
|
---|
| 172 | ;input:
|
---|
| 173 | ;BP59 - zero node of #9002313.59
|
---|
| 174 | ;BPARR array with user's preferences
|
---|
| 175 | ;returns :
|
---|
| 176 | ;1 -okay, leave in the list
|
---|
| 177 | ;0 -not okay, exclude from the list
|
---|
| 178 | FLTREJ(BP59,BPARR) ;
|
---|
| 179 | N BPRCODES
|
---|
| 180 | N BPRJCD
|
---|
| 181 | S BPRJCD=$P($G(^BPSF(9002313.93,+$G(BPARR(1.15)),0)),U)
|
---|
| 182 | I $L(BPRJCD)=0 Q 0
|
---|
| 183 | D REJCODES^BPSSCRU3(BP59,.BPRCODES)
|
---|
| 184 | I $D(BPRCODES(BPRJCD)) Q 1
|
---|
| 185 | Q 0
|
---|
| 186 | ;check W(indow)/C(mop)/M(ail)
|
---|
| 187 | ;input:
|
---|
| 188 | ;BPRX52 - ptr to #52
|
---|
| 189 | ;BPREFNUM - refill #
|
---|
| 190 | ;BPMWC - given value from CMOP/MAIL/WINDOW instance 1.08 of BPS USRSCR parameters
|
---|
| 191 | ;returns :
|
---|
| 192 | ;1 -okay, leave in the list
|
---|
| 193 | ;0 -not okay, exclude from the list
|
---|
| 194 | ISMWC(BPRX52,BPREFNUM,BPMWC) ;
|
---|
| 195 | I $$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM))=BPMWC Q 1
|
---|
| 196 | Q 0
|
---|
| 197 | ;
|
---|
| 198 | FILTRALL(BPTMP1,BPTMP2,BPARR) ;
|
---|
| 199 | N BP59
|
---|
| 200 | S BP59=0
|
---|
| 201 | F S BP59=+$O(@BPTMP1@(BP59)) Q:+BP59=0 D
|
---|
| 202 | . I $$FILTER(BP59,.BPARR) S @BPTMP2@(BP59)=""
|
---|
| 203 | Q
|
---|
| 204 | ;
|
---|
| 205 | ;go thru all FILE59 entries and run SETTRDFN for each of them
|
---|
| 206 | ;
|
---|
| 207 | TRDFNALL(BPTMP) ;
|
---|
| 208 | N BP59
|
---|
| 209 | S BP59=0
|
---|
| 210 | F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
---|
| 211 | . D SETTRDFN(BPTMP,BP59)
|
---|
| 212 | Q
|
---|
| 213 | ;
|
---|
| 214 | ;sorting for "TRANSACTION DATE" type is
|
---|
| 215 | ;actually sorting by patients , but patient should be sorted not in alphabetical order:
|
---|
| 216 | ;the first patient is the one which has the most recent transaction and so on
|
---|
| 217 | ;BPTMP - TMP global
|
---|
| 218 | ;BP59 - ptr to #9002313.59
|
---|
| 219 | SETTRDFN(BPTMP,BP59) ;
|
---|
| 220 | ;the following stores the latest transaction date of the claims, which
|
---|
| 221 | ;was found for this particular combination of patient and insurance
|
---|
| 222 | ;@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
|
---|
| 223 | ;the following stores the latest transaction date BPTRDT,patient BPDFN and
|
---|
| 224 | ;insurance BPINSUR to provide a proper order
|
---|
| 225 | ;@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
|
---|
| 226 | N BPZERO,BPTRDT,BPDFN,BPPREV,BPINSUR
|
---|
| 227 | S BPZERO=$G(^BPST(BP59,0)) ;
|
---|
| 228 | S BPTRDT=-$P(BPZERO,U,8) ;"transaction" date
|
---|
| 229 | S BPDFN=+$P(BPZERO,U,6) ;patient ptr to #2
|
---|
| 230 | S BPINSUR=+$$GETINSUR^BPSSCRU2(BP59) ;insurance ien
|
---|
| 231 | ;in the beginning we don't have any "DFN-TRDT" and "TRDTDFN"
|
---|
| 232 | ;so create them and quit
|
---|
| 233 | I '$D(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)) D Q
|
---|
| 234 | . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
|
---|
| 235 | . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
|
---|
| 236 | ;if we already have them then get the latest into BPPREV
|
---|
| 237 | S BPPREV=+$G(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR))
|
---|
| 238 | ;and compare it against the BPTRDT for this BP59
|
---|
| 239 | ;if the BPTRDT is greater then replace the values in "DFN-TRDT"
|
---|
| 240 | ;and "TRDTDFN"
|
---|
| 241 | I BPTRDT<BPPREV D
|
---|
| 242 | . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)=""
|
---|
| 243 | . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT
|
---|
| 244 | . K @BPTMP@("TRDTDFN",BPPREV,BPDFN,BPINSUR)
|
---|
| 245 | Q
|
---|