| [613] | 1 | BPSSCRCL ;BHAM ISC/SS - ECME SCREEN CLOSE CLAIMS ;05-APR-05
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5**;JUN 2004;Build 45
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | CLO ;entry point to close claims
|
|---|
| 7 | N BPRET,BPSARR59
|
|---|
| 8 | I '$D(@(VALMAR)) Q
|
|---|
| 9 | D FULL^VALM1
|
|---|
| 10 | W !,"Enter the line numbers for the claim(s) to be closed."
|
|---|
| 11 | S BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,VALMAR)
|
|---|
| 12 | I BPRET="^" S VALMBCK="R" Q
|
|---|
| 13 | ;close claims
|
|---|
| 14 | ;update the content of the screen
|
|---|
| 15 | ;only if at least one claim was closed
|
|---|
| 16 | I $$CLOSE(.BPSARR59) D REDRAW^BPSSCRUD("Updating screen for closed claims...")
|
|---|
| 17 | E S VALMBCK="R"
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ;close claims
|
|---|
| 21 | ;input:
|
|---|
| 22 | ; BP59ARR - array with ptrs to BPS TRANSACTION FILE
|
|---|
| 23 | ; BP59ARR(ien59)="ien in TMP ^ number on the user screen"
|
|---|
| 24 | ;returns:
|
|---|
| 25 | ; BPCLTOT - number of closed claims
|
|---|
| 26 | CLOSE(BP59ARR) ;
|
|---|
| 27 | N BPNEWARR,BPRETV,BPREJFLG,X
|
|---|
| 28 | N BPDFN,BP59,BPIFANY,BPQ
|
|---|
| 29 | N BPREAS,BPCOMM,BP90ANSW,BPRCOPAY,BPRXINFO,BPCOP,BPCLTOT,BPINS,BPINSNM,BP59FRST
|
|---|
| 30 | S BPRETV=$$MKNEWARR(.BP59ARR,.BPNEWARR,.BPINS)
|
|---|
| 31 | S BPQ="",BPIFANY=0,BPREJFLG=1
|
|---|
| 32 | S BPDFN=""
|
|---|
| 33 | F S BPDFN=$O(BPNEWARR(BPDFN)) Q:BPDFN="" D Q:BPQ="^"
|
|---|
| 34 | . W !!,"You've chosen to close the following prescription(s) for",!,$E($$PATNAME^BPSSCRU2(BPDFN),1,13)_" :"
|
|---|
| 35 | . S BP59="" F S BP59=$O(BPNEWARR(BPDFN,BP59)) Q:BP59="" D Q:BPQ="^"
|
|---|
| 36 | . . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
|
|---|
| 37 | . . S BPIFANY=1,BPQ=""
|
|---|
| 38 | . . ;I $P($G(BPNEWARR(BPDFN,BP59)),U,3)=1 W:BPREJFLG=0 ! S BPREJFLG=1
|
|---|
| 39 | . . ;E W:BPREJFLG=1 ! S BPREJFLG=0
|
|---|
| 40 | . . S BPREJFLG=+$P($G(BPNEWARR(BPDFN,BP59)),U,3)
|
|---|
| 41 | . . W !,@VALMAR@(+$G(BPNEWARR(BPDFN,BP59)),0)
|
|---|
| 42 | . . D DISPREJ^BPSSCRU6(BP59)
|
|---|
| 43 | . . W:BPREJFLG=0 !,"Claim NOT Rejected and cannot be Closed."
|
|---|
| 44 | I +BPRETV=0 Q $$QUITCL()
|
|---|
| 45 | I BPQ="^" Q $$QUITCL()
|
|---|
| 46 | ;
|
|---|
| 47 | W !!,"ALL Selected Rxs will be CLOSED using the same information gathered in the following prompts.",!
|
|---|
| 48 | S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
|
|---|
| 49 | I BPQ'=1 Q $$QUITCL()
|
|---|
| 50 | ;
|
|---|
| 51 | ; ask questions for all of them
|
|---|
| 52 | W !!
|
|---|
| 53 | I $$ASKQUEST(+$P(BPRETV,U,2),.BPREAS,.BPCOMM,.BP90ANSW,.BPRCOPAY)'=1 Q $$QUITCL()
|
|---|
| 54 | ;
|
|---|
| 55 | ; check 2nd insurance
|
|---|
| 56 | S BPQ=""
|
|---|
| 57 | I BP90ANSW'="D" D
|
|---|
| 58 | . S BPDFN="" F S BPDFN=$O(BPINS(BPDFN)) Q:BPDFN="" D Q:BPQ="^"
|
|---|
| 59 | . . S BPINSNM="" F S BPINSNM=$O(BPINS(BPDFN,BPINSNM)) Q:BPINSNM="" D Q:BPQ="^"
|
|---|
| 60 | . . . S BP59FRST=0
|
|---|
| 61 | . . . S BP59=""
|
|---|
| 62 | . . . K BPRXINFO
|
|---|
| 63 | . . . F S BP59=$O(BPINS(BPDFN,BPINSNM,BP59)) Q:BP59="" D Q:BPQ="^"
|
|---|
| 64 | . . . . S:BP59FRST=0 BP59FRST=BP59
|
|---|
| 65 | . . . . S BPRXINFO(BP59)=$E($G(@VALMAR@(+$G(BP59ARR(BP59)),0)),7,99)
|
|---|
| 66 | . . . ; call CH2NDINS^BPSSCRU5 only once for all claims for this patient and insurance
|
|---|
| 67 | . . . ; you can use one BP59FRST for the group of claims here as a parameter since
|
|---|
| 68 | . . . ; they all are all identical from the "patient-insurance pair" point of view
|
|---|
| 69 | . . . D:BP59FRST>0 CH2NDINS^BPSSCRU5(BP59FRST,$E($$PATNAME^BPSSCRU2(BPDFN),1,13),BPINSNM,.BPRXINFO)
|
|---|
| 70 | ;
|
|---|
| 71 | I BPQ="^" Q $$QUITCL()
|
|---|
| 72 | ;
|
|---|
| 73 | W @IOF
|
|---|
| 74 | ;and finally close all
|
|---|
| 75 | S BPCLTOT=0
|
|---|
| 76 | S BPDFN="" F S BPDFN=$O(BPNEWARR(BPDFN)) Q:BPDFN="" D
|
|---|
| 77 | . S BP59="" F S BP59=$O(BPNEWARR(BPDFN,BP59)) Q:BP59="" D
|
|---|
| 78 | . . I $P($G(BPNEWARR(BPDFN,BP59)),U,3)=0 Q ;can't be closed
|
|---|
| 79 | . . S BPCOP=0
|
|---|
| 80 | . . I +BPRCOPAY=1,$P($G(BPNEWARR(BPDFN,BP59)),U,4)=1 S BPCOP=1 ;release copay
|
|---|
| 81 | . . I $$CLOSEIT(BP59,$P(BPREAS,U,2),BPCOMM,BP90ANSW,BPCOP)>0 D
|
|---|
| 82 | . . . S BPCLTOT=BPCLTOT+1
|
|---|
| 83 | ;
|
|---|
| 84 | W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been closed.",!
|
|---|
| 85 | D PAUSE^VALM1
|
|---|
| 86 | Q BPCLTOT
|
|---|
| 87 | ;
|
|---|
| 88 | QUITCL() ;
|
|---|
| 89 | W !!,"0 claims have been closed."
|
|---|
| 90 | D PAUSE^VALM1
|
|---|
| 91 | Q 0
|
|---|
| 92 | ;/**
|
|---|
| 93 | ;Ask all necessary questions
|
|---|
| 94 | ;Input
|
|---|
| 95 | ; BPRELCOP - ask release copay question
|
|---|
| 96 | ; .BPREAZ - ptr to #356.8 ^ CLOSE REASON NAME ^ ECME FLAG ^ ECME PAPER FLAG
|
|---|
| 97 | ; .BPCOMZ - close comment (string)
|
|---|
| 98 | ; .BP90ANSZ - "", "D"(drop to paper) or "N" (non-billable)
|
|---|
| 99 | ; .BPRCOPAZ - 1(Yes) or 0(No) , answer to "release copay" question
|
|---|
| 100 | ;Output:
|
|---|
| 101 | ; 0 - cancel process
|
|---|
| 102 | ; ^ - emergency quit (cancel process)
|
|---|
| 103 | ; 1 - ok, can proceed
|
|---|
| 104 | ASKQUEST(BPRELCOP,BPREAZ,BPCOMZ,BP90ANSZ,BPRCOPAZ) ;*/
|
|---|
| 105 | S BPCOMZ=""
|
|---|
| 106 | S BP90ANSZ=""
|
|---|
| 107 | S BPRCOPAZ=0
|
|---|
| 108 | ;ask the user to choose the close reason from #356.8
|
|---|
| 109 | ;using set of close reasons in IB file 356.8
|
|---|
| 110 | S BPREAZ=$$REASON()
|
|---|
| 111 | I BPREAZ="^" Q "^"
|
|---|
| 112 | I ($P(BPREAZ,U,4)=1) D ;if has ECME PAPER FLAG
|
|---|
| 113 | . ;ask if the claim is still billable thru paper?
|
|---|
| 114 | . S BP90ANSZ=$$PROMPT^BPSSCRCV("S^N:NON-BILLABLE;D:DROP TO PAPER","Treat as (N)on-Billable Episode or (D)rop Bill to Paper?","")
|
|---|
| 115 | I BP90ANSZ=-1 Q "^"
|
|---|
| 116 | S BPCOMZ=$$COMMENT("Comment ",40)
|
|---|
| 117 | I (BPCOMZ="^") Q "^"
|
|---|
| 118 | I $L(BPCOMZ)>0,BPCOMZ?1" "." " S BPCOMZ=""
|
|---|
| 119 | ;check copay
|
|---|
| 120 | ;ask "release copay?" in all NON-BILLABLE cases, i.e. except user answered "DROP TO PAPER"
|
|---|
| 121 | ;(even in cases when he was not asked about it)
|
|---|
| 122 | I BP90ANSZ'="D",BPRELCOP D
|
|---|
| 123 | . ; Ask user if s/he wants to release a copay
|
|---|
| 124 | . S BPRCOPAZ=$$YESNO^BPSSCRRS("Release Patient CoPay(Y/N)")
|
|---|
| 125 | I BPRCOPAZ=-1 Q "^"
|
|---|
| 126 | ;
|
|---|
| 127 | S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
|
|---|
| 128 | I BPQ=-1 Q "^" ;quit by "^"
|
|---|
| 129 | I BPQ'=1 Q 0 ;doesn't want to proceed
|
|---|
| 130 | Q 1 ; answers can be used
|
|---|
| 131 | ;
|
|---|
| 132 | ;/**
|
|---|
| 133 | ;ask for the close reason
|
|---|
| 134 | ;return:
|
|---|
| 135 | ; ptr to #356.8 ^ CLOSE REASON NAME ^ ECME FLAG ^ ECME PAPER FLAG
|
|---|
| 136 | REASON() ;
|
|---|
| 137 | N DIC,BPREASNM,BP3568,Y
|
|---|
| 138 | ; - Asks for REASON for Closing
|
|---|
| 139 | S DIC="^IBE(356.8,",DIC(0)="AEQMZ"
|
|---|
| 140 | S DIC("S")="I $P(^(0),U,2)=1"
|
|---|
| 141 | D ^DIC
|
|---|
| 142 | I Y=-1 Q "^"
|
|---|
| 143 | Q +Y_U_Y(0)
|
|---|
| 144 | ;/**
|
|---|
| 145 | ;enter the comment
|
|---|
| 146 | ;BPSTR -prompt string
|
|---|
| 147 | ;BPMLEN -maxlen
|
|---|
| 148 | COMMENT(BPSTR,BPMLEN) ;*/
|
|---|
| 149 | N DIR,DTOUT,DUOUT,BPQ
|
|---|
| 150 | I '$D(BPSTR) S BPSTR="Comment "
|
|---|
| 151 | I '$D(BPMLEN) S BPMLEN=40
|
|---|
| 152 | S DIR(0)="FO^0:250"
|
|---|
| 153 | S DIR("A")=BPSTR
|
|---|
| 154 | S DIR("?",1)="This response must have at least 0 characters and no more"
|
|---|
| 155 | S DIR("?")="than "_BPMLEN_" characters and must not contain embedded uparrow"
|
|---|
| 156 | S BPQ=0
|
|---|
| 157 | F D Q:+BPQ'=0
|
|---|
| 158 | . D ^DIR
|
|---|
| 159 | . I $D(DUOUT)!($D(DTOUT)) S BPQ=-1 Q
|
|---|
| 160 | . I $L(Y)'>BPMLEN S BPQ=1 Q
|
|---|
| 161 | . W !!,"This response must have at least 0 characters and no more"
|
|---|
| 162 | . W !,"than "_BPMLEN_" characters and must not contain embedded uparrow.",!
|
|---|
| 163 | . S DIR("B")=$E(Y,1,BPMLEN)
|
|---|
| 164 | Q:BPQ<0 "^"
|
|---|
| 165 | Q Y
|
|---|
| 166 | ;/**
|
|---|
| 167 | ;close the claim
|
|---|
| 168 | ;the approach and code partially borrowed from IHS code CLOSE^BPSOS6N
|
|---|
| 169 | ;BPSTRA - ptr to #9002313.59
|
|---|
| 170 | ;REASON - text name of the close reason
|
|---|
| 171 | ;BPSCLCM - comment
|
|---|
| 172 | ;BPDROP:
|
|---|
| 173 | ; "D" - DROP BILL TO PAPER
|
|---|
| 174 | ; "N" - NON-BILLABLE
|
|---|
| 175 | ;BPRELCOP - 1 (Yes) or 0 (No) release copay or not?
|
|---|
| 176 | CLOSEIT(BPSTRA,REASON,BPSCLCM,BPDROP,BPRELCOP) ;
|
|---|
| 177 | N BPSCLA,ERROR,DA,DR,BPLCK,DIE
|
|---|
| 178 | S BPSCLA=$$GET1^DIQ(9002313.59,BPSTRA,3,"I")
|
|---|
| 179 | W !,"Closing Claim ",$$GET1^DIQ(9002313.02,BPSCLA,.01),"..."
|
|---|
| 180 | S BPLCK=0
|
|---|
| 181 | L +^BPSC(BPSCLA):0
|
|---|
| 182 | I $T S BPLCK=1
|
|---|
| 183 | E W !," *** CLAIM ",$$GET1^DIQ(9002313.02,BPSCLA,.01)," IN USE ***" Q 0
|
|---|
| 184 | D CLOSE^BPSBUTL(BPSCLA,BPSTRA,REASON,$S($G(BPDROP)="D":1,1:0),BPRELCOP,BPSCLCM,.ERROR)
|
|---|
| 185 | I $D(ERROR) W "NOT OK" D DSPERR(ERROR) D Q 0
|
|---|
| 186 | . I BPLCK=1 L -^BPSC(BPSCLA)
|
|---|
| 187 | S DIE="^BPSC(",DA=BPSCLA,DR="901///1;902///"_$$NOW^XLFDT()_";903///"_$G(DUZ)_";904///"_REASON_";905////"_BPDROP D ^DIE
|
|---|
| 188 | I BPLCK=1 L -^BPSC(BPSCLA)
|
|---|
| 189 | H 1 W "OK"
|
|---|
| 190 | Q 1
|
|---|
| 191 | ;
|
|---|
| 192 | DSPERR(MSG) ; Display the ERROR message
|
|---|
| 193 | W !,"Error: *** ",MSG," ***"
|
|---|
| 194 | Q
|
|---|
| 195 | ;
|
|---|
| 196 | ;/**
|
|---|
| 197 | ;ECME has tried to submit the claim to insurance with the name BPINSNAM
|
|---|
| 198 | ;but the claim was rejected and now we need to determine if the patient
|
|---|
| 199 | ;has any other insurance with pharmacy coverage that can be billed for the RX
|
|---|
| 200 | ;Input:
|
|---|
| 201 | ; BP59 - pointer to file #9002313.59
|
|---|
| 202 | ; BPINSNAM - insurance that have already been used by ECME
|
|---|
| 203 | ;Output:
|
|---|
| 204 | ; 0 - not found
|
|---|
| 205 | ; 1 ^ Insurance Name ^ Group Number ^ Date of service
|
|---|
| 206 | NEXTINS(BP59,BPINSNAM) ;get insurance info by the pointer of #9002313.59
|
|---|
| 207 | N BPDOS,BPDFN,BPZZ,BP36,BPX,BPHONE,BPY,BPINSNM
|
|---|
| 208 | N BPPHARM,BPCOORD,BPINS,BPFOUND
|
|---|
| 209 | S BPY=0
|
|---|
| 210 | S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2)
|
|---|
| 211 | S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1
|
|---|
| 212 | I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1
|
|---|
| 213 | S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
|
|---|
| 214 | ; call INSUR^IBBAPI to get information about:
|
|---|
| 215 | ;1 = Insurance Company Name
|
|---|
| 216 | ;7 = Coordination of Benefits (primary, secondary, tertiary)
|
|---|
| 217 | ;15 = Pharmacy Coverage?
|
|---|
| 218 | ;18 = Group Number
|
|---|
| 219 | S BPX=$$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,7,15,18")
|
|---|
| 220 | S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
|
|---|
| 221 | . ;get pharmacy coverage
|
|---|
| 222 | . S BPPHARM=+$G(BPZZ("IBBAPI","INSUR",BP1,15))
|
|---|
| 223 | I BPX<1 Q 0
|
|---|
| 224 | D PROCINS(.BPZZ)
|
|---|
| 225 | ;check pharmacy coverage
|
|---|
| 226 | S BPFOUND=0 ;if found will be set to insurance node in the INSUR^IBBAPI array
|
|---|
| 227 | S BPPHARM=1 ;look only at those with pharmacy coverage
|
|---|
| 228 | S BPCOORD=0
|
|---|
| 229 | F S BPCOORD=+$O(BPZZ("RES",BPPHARM,BPCOORD)) Q:BPCOORD=0!(BPFOUND'=0) D
|
|---|
| 230 | . S BPINS=+$O(BPZZ("RES",BPPHARM,BPCOORD,0))
|
|---|
| 231 | . I BPINS>0 I $P($G(BPZZ("IBBAPI","INSUR",BPINS,1)),U,2)'=BPINSNAM S BPFOUND=BPINS
|
|---|
| 232 | I BPFOUND=0 Q 0
|
|---|
| 233 | Q 1_U_$P($G(BPZZ("IBBAPI","INSUR",BPFOUND,1)),U,2)_U_$P($G(BPZZ("IBBAPI","INSUR",BPFOUND,18)),U)_U_BPDOS
|
|---|
| 234 | ;
|
|---|
| 235 | ;process insurances
|
|---|
| 236 | ;input: local array returned by INSUR^IBBAPI
|
|---|
| 237 | ;output: BPZZ("RES",pharmacy coverage,coordination,insurance element # in BPZZ array)
|
|---|
| 238 | PROCINS(BPZZ) ;
|
|---|
| 239 | N BP1,BP2,BP0,BPPHONE,BPPHARM,BPCOORD
|
|---|
| 240 | S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
|
|---|
| 241 | . ;get pharmacy coverage
|
|---|
| 242 | . S BPPHARM=+$G(BPZZ("IBBAPI","INSUR",BP1,15))
|
|---|
| 243 | . ;get coordination of benefits
|
|---|
| 244 | . S BPCOORD=+$G(BPZZ("IBBAPI","INSUR",BP1,7))
|
|---|
| 245 | . ;create ^TMP to sort results by pharmacy coverage and coordination of benefits
|
|---|
| 246 | . S BPZZ("RES",BPPHARM,BPCOORD,BP1)=""
|
|---|
| 247 | Q
|
|---|
| 248 | ;
|
|---|
| 249 | ;------------
|
|---|
| 250 | MKNEWARR(BPARR,BPNEWARR,BPINSARR) ;
|
|---|
| 251 | N BP59,BPREJ,BPREJCNT,BPRELCNT,BPREL,BPINS
|
|---|
| 252 | S BPREJCNT=0,BPRELCNT=0
|
|---|
| 253 | S BPINS=0
|
|---|
| 254 | S BP59="" F S BP59=$O(BPARR(BP59)) Q:BP59="" D
|
|---|
| 255 | . S BPREJ=0
|
|---|
| 256 | . S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
|
|---|
| 257 | . S BPREJ=$S($P($$CLAIMST^BPSSCRU3(BP59),U)="E REJECTED":1,1:0)
|
|---|
| 258 | . S:BPREJ BPREJCNT=BPREJCNT+1
|
|---|
| 259 | . S BPREL=$S($$RXAPI1^BPSUTIL1(+$P($$RXREF^BPSSCRU2(BP59),U),106,"I"):1,1:0)
|
|---|
| 260 | . S:BPREL BPRELCNT=BPRELCNT+1
|
|---|
| 261 | . S BPNEWARR(BPDFN,BP59)=BPARR(BP59)_U_BPREJ_U_BPREL
|
|---|
| 262 | . S BPINS=$P($$GETINSUR^BPSSCRU2(BP59),U,2)
|
|---|
| 263 | . I BPREJ=1,$L(BPINS)>0 S BPINSARR(BPDFN,BPINS,BP59)=BPARR(BP59)
|
|---|
| 264 | Q BPREJCNT_U_BPRELCNT
|
|---|
| 265 | ;
|
|---|
