266 lines
9.5 KiB
Mathematica
266 lines
9.5 KiB
Mathematica
BPSSCRCL ;BHAM ISC/SS - ECME SCREEN CLOSE CLAIMS ;05-APR-05
|
|
;;1.0;E CLAIMS MGMT ENGINE;**1,3,5**;JUN 2004;Build 45
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
|
Q
|
|
;
|
|
CLO ;entry point to close claims
|
|
N BPRET,BPSARR59
|
|
I '$D(@(VALMAR)) Q
|
|
D FULL^VALM1
|
|
W !,"Enter the line numbers for the claim(s) to be closed."
|
|
S BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,VALMAR)
|
|
I BPRET="^" S VALMBCK="R" Q
|
|
;close claims
|
|
;update the content of the screen
|
|
;only if at least one claim was closed
|
|
I $$CLOSE(.BPSARR59) D REDRAW^BPSSCRUD("Updating screen for closed claims...")
|
|
E S VALMBCK="R"
|
|
Q
|
|
;
|
|
;close claims
|
|
;input:
|
|
; BP59ARR - array with ptrs to BPS TRANSACTION FILE
|
|
; BP59ARR(ien59)="ien in TMP ^ number on the user screen"
|
|
;returns:
|
|
; BPCLTOT - number of closed claims
|
|
CLOSE(BP59ARR) ;
|
|
N BPNEWARR,BPRETV,BPREJFLG,X
|
|
N BPDFN,BP59,BPIFANY,BPQ
|
|
N BPREAS,BPCOMM,BP90ANSW,BPRCOPAY,BPRXINFO,BPCOP,BPCLTOT,BPINS,BPINSNM,BP59FRST
|
|
S BPRETV=$$MKNEWARR(.BP59ARR,.BPNEWARR,.BPINS)
|
|
S BPQ="",BPIFANY=0,BPREJFLG=1
|
|
S BPDFN=""
|
|
F S BPDFN=$O(BPNEWARR(BPDFN)) Q:BPDFN="" D Q:BPQ="^"
|
|
. W !!,"You've chosen to close the following prescription(s) for",!,$E($$PATNAME^BPSSCRU2(BPDFN),1,13)_" :"
|
|
. S BP59="" F S BP59=$O(BPNEWARR(BPDFN,BP59)) Q:BP59="" D Q:BPQ="^"
|
|
. . I $Y>20 D PAUSE^VALM1 W @IOF I X="^" S BPQ="^" Q
|
|
. . S BPIFANY=1,BPQ=""
|
|
. . ;I $P($G(BPNEWARR(BPDFN,BP59)),U,3)=1 W:BPREJFLG=0 ! S BPREJFLG=1
|
|
. . ;E W:BPREJFLG=1 ! S BPREJFLG=0
|
|
. . S BPREJFLG=+$P($G(BPNEWARR(BPDFN,BP59)),U,3)
|
|
. . W !,@VALMAR@(+$G(BPNEWARR(BPDFN,BP59)),0)
|
|
. . D DISPREJ^BPSSCRU6(BP59)
|
|
. . W:BPREJFLG=0 !,"Claim NOT Rejected and cannot be Closed."
|
|
I +BPRETV=0 Q $$QUITCL()
|
|
I BPQ="^" Q $$QUITCL()
|
|
;
|
|
W !!,"ALL Selected Rxs will be CLOSED using the same information gathered in the following prompts.",!
|
|
S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
|
|
I BPQ'=1 Q $$QUITCL()
|
|
;
|
|
; ask questions for all of them
|
|
W !!
|
|
I $$ASKQUEST(+$P(BPRETV,U,2),.BPREAS,.BPCOMM,.BP90ANSW,.BPRCOPAY)'=1 Q $$QUITCL()
|
|
;
|
|
; check 2nd insurance
|
|
S BPQ=""
|
|
I BP90ANSW'="D" D
|
|
. S BPDFN="" F S BPDFN=$O(BPINS(BPDFN)) Q:BPDFN="" D Q:BPQ="^"
|
|
. . S BPINSNM="" F S BPINSNM=$O(BPINS(BPDFN,BPINSNM)) Q:BPINSNM="" D Q:BPQ="^"
|
|
. . . S BP59FRST=0
|
|
. . . S BP59=""
|
|
. . . K BPRXINFO
|
|
. . . F S BP59=$O(BPINS(BPDFN,BPINSNM,BP59)) Q:BP59="" D Q:BPQ="^"
|
|
. . . . S:BP59FRST=0 BP59FRST=BP59
|
|
. . . . S BPRXINFO(BP59)=$E($G(@VALMAR@(+$G(BP59ARR(BP59)),0)),7,99)
|
|
. . . ; call CH2NDINS^BPSSCRU5 only once for all claims for this patient and insurance
|
|
. . . ; you can use one BP59FRST for the group of claims here as a parameter since
|
|
. . . ; they all are all identical from the "patient-insurance pair" point of view
|
|
. . . D:BP59FRST>0 CH2NDINS^BPSSCRU5(BP59FRST,$E($$PATNAME^BPSSCRU2(BPDFN),1,13),BPINSNM,.BPRXINFO)
|
|
;
|
|
I BPQ="^" Q $$QUITCL()
|
|
;
|
|
W @IOF
|
|
;and finally close all
|
|
S BPCLTOT=0
|
|
S BPDFN="" F S BPDFN=$O(BPNEWARR(BPDFN)) Q:BPDFN="" D
|
|
. S BP59="" F S BP59=$O(BPNEWARR(BPDFN,BP59)) Q:BP59="" D
|
|
. . I $P($G(BPNEWARR(BPDFN,BP59)),U,3)=0 Q ;can't be closed
|
|
. . S BPCOP=0
|
|
. . I +BPRCOPAY=1,$P($G(BPNEWARR(BPDFN,BP59)),U,4)=1 S BPCOP=1 ;release copay
|
|
. . I $$CLOSEIT(BP59,$P(BPREAS,U,2),BPCOMM,BP90ANSW,BPCOP)>0 D
|
|
. . . S BPCLTOT=BPCLTOT+1
|
|
;
|
|
W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been closed.",!
|
|
D PAUSE^VALM1
|
|
Q BPCLTOT
|
|
;
|
|
QUITCL() ;
|
|
W !!,"0 claims have been closed."
|
|
D PAUSE^VALM1
|
|
Q 0
|
|
;/**
|
|
;Ask all necessary questions
|
|
;Input
|
|
; BPRELCOP - ask release copay question
|
|
; .BPREAZ - ptr to #356.8 ^ CLOSE REASON NAME ^ ECME FLAG ^ ECME PAPER FLAG
|
|
; .BPCOMZ - close comment (string)
|
|
; .BP90ANSZ - "", "D"(drop to paper) or "N" (non-billable)
|
|
; .BPRCOPAZ - 1(Yes) or 0(No) , answer to "release copay" question
|
|
;Output:
|
|
; 0 - cancel process
|
|
; ^ - emergency quit (cancel process)
|
|
; 1 - ok, can proceed
|
|
ASKQUEST(BPRELCOP,BPREAZ,BPCOMZ,BP90ANSZ,BPRCOPAZ) ;*/
|
|
S BPCOMZ=""
|
|
S BP90ANSZ=""
|
|
S BPRCOPAZ=0
|
|
;ask the user to choose the close reason from #356.8
|
|
;using set of close reasons in IB file 356.8
|
|
S BPREAZ=$$REASON()
|
|
I BPREAZ="^" Q "^"
|
|
I ($P(BPREAZ,U,4)=1) D ;if has ECME PAPER FLAG
|
|
. ;ask if the claim is still billable thru paper?
|
|
. S BP90ANSZ=$$PROMPT^BPSSCRCV("S^N:NON-BILLABLE;D:DROP TO PAPER","Treat as (N)on-Billable Episode or (D)rop Bill to Paper?","")
|
|
I BP90ANSZ=-1 Q "^"
|
|
S BPCOMZ=$$COMMENT("Comment ",40)
|
|
I (BPCOMZ="^") Q "^"
|
|
I $L(BPCOMZ)>0,BPCOMZ?1" "." " S BPCOMZ=""
|
|
;check copay
|
|
;ask "release copay?" in all NON-BILLABLE cases, i.e. except user answered "DROP TO PAPER"
|
|
;(even in cases when he was not asked about it)
|
|
I BP90ANSZ'="D",BPRELCOP D
|
|
. ; Ask user if s/he wants to release a copay
|
|
. S BPRCOPAZ=$$YESNO^BPSSCRRS("Release Patient CoPay(Y/N)")
|
|
I BPRCOPAZ=-1 Q "^"
|
|
;
|
|
S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
|
|
I BPQ=-1 Q "^" ;quit by "^"
|
|
I BPQ'=1 Q 0 ;doesn't want to proceed
|
|
Q 1 ; answers can be used
|
|
;
|
|
;/**
|
|
;ask for the close reason
|
|
;return:
|
|
; ptr to #356.8 ^ CLOSE REASON NAME ^ ECME FLAG ^ ECME PAPER FLAG
|
|
REASON() ;
|
|
N DIC,BPREASNM,BP3568,Y
|
|
; - Asks for REASON for Closing
|
|
S DIC="^IBE(356.8,",DIC(0)="AEQMZ"
|
|
S DIC("S")="I $P(^(0),U,2)=1"
|
|
D ^DIC
|
|
I Y=-1 Q "^"
|
|
Q +Y_U_Y(0)
|
|
;/**
|
|
;enter the comment
|
|
;BPSTR -prompt string
|
|
;BPMLEN -maxlen
|
|
COMMENT(BPSTR,BPMLEN) ;*/
|
|
N DIR,DTOUT,DUOUT,BPQ
|
|
I '$D(BPSTR) S BPSTR="Comment "
|
|
I '$D(BPMLEN) S BPMLEN=40
|
|
S DIR(0)="FO^0:250"
|
|
S DIR("A")=BPSTR
|
|
S DIR("?",1)="This response must have at least 0 characters and no more"
|
|
S DIR("?")="than "_BPMLEN_" characters and must not contain embedded uparrow"
|
|
S BPQ=0
|
|
F D Q:+BPQ'=0
|
|
. D ^DIR
|
|
. I $D(DUOUT)!($D(DTOUT)) S BPQ=-1 Q
|
|
. I $L(Y)'>BPMLEN S BPQ=1 Q
|
|
. W !!,"This response must have at least 0 characters and no more"
|
|
. W !,"than "_BPMLEN_" characters and must not contain embedded uparrow.",!
|
|
. S DIR("B")=$E(Y,1,BPMLEN)
|
|
Q:BPQ<0 "^"
|
|
Q Y
|
|
;/**
|
|
;close the claim
|
|
;the approach and code partially borrowed from IHS code CLOSE^BPSOS6N
|
|
;BPSTRA - ptr to #9002313.59
|
|
;REASON - text name of the close reason
|
|
;BPSCLCM - comment
|
|
;BPDROP:
|
|
; "D" - DROP BILL TO PAPER
|
|
; "N" - NON-BILLABLE
|
|
;BPRELCOP - 1 (Yes) or 0 (No) release copay or not?
|
|
CLOSEIT(BPSTRA,REASON,BPSCLCM,BPDROP,BPRELCOP) ;
|
|
N BPSCLA,ERROR,DA,DR,BPLCK,DIE
|
|
S BPSCLA=$$GET1^DIQ(9002313.59,BPSTRA,3,"I")
|
|
W !,"Closing Claim ",$$GET1^DIQ(9002313.02,BPSCLA,.01),"..."
|
|
S BPLCK=0
|
|
L +^BPSC(BPSCLA):0
|
|
I $T S BPLCK=1
|
|
E W !," *** CLAIM ",$$GET1^DIQ(9002313.02,BPSCLA,.01)," IN USE ***" Q 0
|
|
D CLOSE^BPSBUTL(BPSCLA,BPSTRA,REASON,$S($G(BPDROP)="D":1,1:0),BPRELCOP,BPSCLCM,.ERROR)
|
|
I $D(ERROR) W "NOT OK" D DSPERR(ERROR) D Q 0
|
|
. I BPLCK=1 L -^BPSC(BPSCLA)
|
|
S DIE="^BPSC(",DA=BPSCLA,DR="901///1;902///"_$$NOW^XLFDT()_";903///"_$G(DUZ)_";904///"_REASON_";905////"_BPDROP D ^DIE
|
|
I BPLCK=1 L -^BPSC(BPSCLA)
|
|
H 1 W "OK"
|
|
Q 1
|
|
;
|
|
DSPERR(MSG) ; Display the ERROR message
|
|
W !,"Error: *** ",MSG," ***"
|
|
Q
|
|
;
|
|
;/**
|
|
;ECME has tried to submit the claim to insurance with the name BPINSNAM
|
|
;but the claim was rejected and now we need to determine if the patient
|
|
;has any other insurance with pharmacy coverage that can be billed for the RX
|
|
;Input:
|
|
; BP59 - pointer to file #9002313.59
|
|
; BPINSNAM - insurance that have already been used by ECME
|
|
;Output:
|
|
; 0 - not found
|
|
; 1 ^ Insurance Name ^ Group Number ^ Date of service
|
|
NEXTINS(BP59,BPINSNAM) ;get insurance info by the pointer of #9002313.59
|
|
N BPDOS,BPDFN,BPZZ,BP36,BPX,BPHONE,BPY,BPINSNM
|
|
N BPPHARM,BPCOORD,BPINS,BPFOUND
|
|
S BPY=0
|
|
S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2)
|
|
S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1
|
|
I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1
|
|
S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
|
|
; call INSUR^IBBAPI to get information about:
|
|
;1 = Insurance Company Name
|
|
;7 = Coordination of Benefits (primary, secondary, tertiary)
|
|
;15 = Pharmacy Coverage?
|
|
;18 = Group Number
|
|
S BPX=$$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,7,15,18")
|
|
S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
|
|
. ;get pharmacy coverage
|
|
. S BPPHARM=+$G(BPZZ("IBBAPI","INSUR",BP1,15))
|
|
I BPX<1 Q 0
|
|
D PROCINS(.BPZZ)
|
|
;check pharmacy coverage
|
|
S BPFOUND=0 ;if found will be set to insurance node in the INSUR^IBBAPI array
|
|
S BPPHARM=1 ;look only at those with pharmacy coverage
|
|
S BPCOORD=0
|
|
F S BPCOORD=+$O(BPZZ("RES",BPPHARM,BPCOORD)) Q:BPCOORD=0!(BPFOUND'=0) D
|
|
. S BPINS=+$O(BPZZ("RES",BPPHARM,BPCOORD,0))
|
|
. I BPINS>0 I $P($G(BPZZ("IBBAPI","INSUR",BPINS,1)),U,2)'=BPINSNAM S BPFOUND=BPINS
|
|
I BPFOUND=0 Q 0
|
|
Q 1_U_$P($G(BPZZ("IBBAPI","INSUR",BPFOUND,1)),U,2)_U_$P($G(BPZZ("IBBAPI","INSUR",BPFOUND,18)),U)_U_BPDOS
|
|
;
|
|
;process insurances
|
|
;input: local array returned by INSUR^IBBAPI
|
|
;output: BPZZ("RES",pharmacy coverage,coordination,insurance element # in BPZZ array)
|
|
PROCINS(BPZZ) ;
|
|
N BP1,BP2,BP0,BPPHONE,BPPHARM,BPCOORD
|
|
S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
|
|
. ;get pharmacy coverage
|
|
. S BPPHARM=+$G(BPZZ("IBBAPI","INSUR",BP1,15))
|
|
. ;get coordination of benefits
|
|
. S BPCOORD=+$G(BPZZ("IBBAPI","INSUR",BP1,7))
|
|
. ;create ^TMP to sort results by pharmacy coverage and coordination of benefits
|
|
. S BPZZ("RES",BPPHARM,BPCOORD,BP1)=""
|
|
Q
|
|
;
|
|
;------------
|
|
MKNEWARR(BPARR,BPNEWARR,BPINSARR) ;
|
|
N BP59,BPREJ,BPREJCNT,BPRELCNT,BPREL,BPINS
|
|
S BPREJCNT=0,BPRELCNT=0
|
|
S BPINS=0
|
|
S BP59="" F S BP59=$O(BPARR(BP59)) Q:BP59="" D
|
|
. S BPREJ=0
|
|
. S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
|
|
. S BPREJ=$S($P($$CLAIMST^BPSSCRU3(BP59),U)="E REJECTED":1,1:0)
|
|
. S:BPREJ BPREJCNT=BPREJCNT+1
|
|
. S BPREL=$S($$RXAPI1^BPSUTIL1(+$P($$RXREF^BPSSCRU2(BP59),U),106,"I"):1,1:0)
|
|
. S:BPREL BPRELCNT=BPRELCNT+1
|
|
. S BPNEWARR(BPDFN,BP59)=BPARR(BP59)_U_BPREJ_U_BPREL
|
|
. S BPINS=$P($$GETINSUR^BPSSCRU2(BP59),U,2)
|
|
. I BPREJ=1,$L(BPINS)>0 S BPINSARR(BPDFN,BPINS,BP59)=BPARR(BP59)
|
|
Q BPREJCNT_U_BPRELCNT
|
|
;
|