235 lines
7.1 KiB
Mathematica
235 lines
7.1 KiB
Mathematica
BPSSCRU3 ;BHAM ISC/SS - ECME 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.
|
|
;USER SCREEN
|
|
Q
|
|
;get comment from BPS TRANSACTION file
|
|
;BP59 - ien in that file
|
|
COMMENT(BP59) ;
|
|
N BPCMNT,BPX
|
|
S BPCMNT=$O(^BPST(BP59,11,999999),-1)
|
|
I BPCMNT="" Q ""
|
|
S BPX=$G(^BPST(BP59,11,BPCMNT,0))
|
|
Q $$DATTIM($P(BPX,U,1)\1)_" - "_$P(BPX,U,3)_U_$$USERNAM^BPSCMT01($P(BPX,U,2))
|
|
;
|
|
DATTIM(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format.
|
|
I +X=0 W ""
|
|
N DATE,YR,BPT,BPM,BPH,BPAP
|
|
I $G(X) S YR=$E(X,2,3)
|
|
I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
|
|
S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT))
|
|
S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4)
|
|
S BPAP="a" I BPH>12 S BPH=BPH-12,BPAP="p" S:$L(BPH)<2 BPH="0"_BPH
|
|
I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP
|
|
Q $G(DATE)
|
|
;/**
|
|
;BP59 - ptr to 9002313.59
|
|
;returns the string with none, one or more than one of the following:
|
|
; PB - payable
|
|
; RJ - rejected
|
|
; RA - reversal accepted
|
|
; RR
|
|
; AR - autoreversal
|
|
; SR - stranded
|
|
; example: "^RV^AR"
|
|
CLAIMST(BP59,BPDESRC) ;*/
|
|
N BPX,BPRET,BPSTATUS
|
|
S BPRET="^"
|
|
S BPX=$$RXREF^BPSSCRU2(BP59)
|
|
S BPSTATUS=$$STATUS^BPSOSRX(+BPX,$P(BPX,U,2))
|
|
Q $P(BPSTATUS,U,1,3)
|
|
;Q $P(BPSTATUS,U,1)_U_$P(BPSTATUS,U,2)_U_$P(BPSTATUS,U,3)
|
|
;/**
|
|
;BP59 - ptr to 9002313.59
|
|
;returns the string with none, one or more tha one of the following:
|
|
; PB - payable
|
|
; RJ - rejected
|
|
; RV - reversal
|
|
; AR - autoreversal
|
|
; SR - stranded
|
|
; example: "^RV^AR"
|
|
CLAIMST2(BP59) ;*/
|
|
N BPX,BPRET,BPSTATUS
|
|
S BPRET="^"
|
|
S BPX=$$RXREF^BPSSCRU2(BP59)
|
|
S BPSTATUS=$$STATUS^BPSOSRX(+BPX,$P(BPX,U,2))
|
|
I BPSTATUS["E REVERSAL" S BPRET=BPRET_"RV^"
|
|
I BPSTATUS["E PAYABLE" S BPRET=BPRET_"PB^"
|
|
I BPSTATUS["E REJECTED" S BPRET=BPRET_"RJ^"
|
|
I BPSTATUS["E STRANDED" S BPRET=BPRET_"SR^"
|
|
I BPSTATUS["E REVERSAL STRANDED" S BPRET=BPRET_"SR^"
|
|
Q BPRET
|
|
;/**
|
|
;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
|
|
;B59 - ptr to #9002313.59
|
|
;BPRESP - ptr to #9002313.03
|
|
;BPPOS - position inside #9002313.03 (i.e. the number
|
|
;of the claim in the transmission - currently we always have only 1
|
|
GRESPPOS(BP59,BPRESP,BPPOS) ;*/
|
|
I $G(^BPST(BP59,4)) D ; reversal kind of message
|
|
. S BPRESP=+$P(^BPST(BP59,4),U,2)
|
|
. S BPPOS=1
|
|
E D
|
|
. S BPRESP=+$P($G(^BPST(BP59,0)),U,5)
|
|
. S BPPOS=+$P($G(^BPST(BP59,0)),U,9)
|
|
Q:+BPRESP=0 0
|
|
Q:+BPPOS=0 0
|
|
Q 1
|
|
;
|
|
;/**
|
|
;reject message from RESPONSE file
|
|
;BP59 - ptr to 9002313.59
|
|
;BPTOP - top level index (for exmpl "504" for ^BPSR(D0,504)= (#504) Message [1F]
|
|
;BPDEEP - lower level (for exmpl BPTOP=1000 and BPDEEP=525 for
|
|
; ^BPSR(D0,1000,D1,525)= (#525) DUR Response Data [1F]
|
|
;
|
|
GETMESS(BPTOP,BPDEEP,BP59) ;
|
|
N BP59DAT,BPRESP,BPPOS
|
|
N BP1
|
|
;S (BPRESP,BPPOS)=0
|
|
;get response and position in the BPS RESPONSE file
|
|
I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q ""
|
|
; -------- transmission specific message ----------
|
|
I BPTOP=504 Q $P($G(^BPSR(BPRESP,504)),U)
|
|
;
|
|
; -------claim specific message-----------
|
|
;assuming there is only one claim/response per transmission
|
|
S BP1=$O(^BPSR(BPRESP,BPTOP,0))
|
|
I BP1=0 Q ""
|
|
;---525: DUR
|
|
;---526: Additional Message Information
|
|
;---504: Message for the claim
|
|
I (BPDEEP=525)!(BPDEEP=526)!(BPDEEP=504) Q $P($G(^BPSR(BPRESP,1000,BPPOS,BPDEEP)),U)
|
|
Q ""
|
|
;
|
|
;reject message from RESPONSE file
|
|
;BP59 - ptr to 9002313.59
|
|
;BPARR1 - array to return messages (by ref)
|
|
;BPN1 - index for the array (by ref - will
|
|
; be incremented if more than one node added)
|
|
;BPMLEN - max length for each string
|
|
;PBPREF - for prefix string
|
|
;. D GETMESS^BPSSCRU3(1000,504,BP59,.BPARR,.BPN,50)
|
|
;compare GETRJCOD from BPSSCRu2
|
|
GETRJCOD(BP59,BPARR1,BPN1,BPMLEN,PBPREF) ;
|
|
N BP59DAT S BP59DAT=$G(^BPST(BP59,0))
|
|
N BPRESP,BPPOS
|
|
N BPRJCOD
|
|
N BPRJTXT
|
|
N BPSTR
|
|
N BPRJ
|
|
;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
|
|
;get response and position
|
|
I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q
|
|
S BPRJ=0
|
|
S BPSTR=""
|
|
F S BPRJ=$O(^BPSR(BPRESP,1000,BPPOS,511,BPRJ)) Q:+BPRJ=0 D
|
|
. S BPRJCOD=$P($G(^BPSR(BPRESP,1000,BPPOS,511,BPRJ,0)),U)
|
|
. Q:$L(BPRJCOD)=0
|
|
. S BPRJTXT=$$GETRJNAM(BPRJCOD)
|
|
. S BPN1=BPN1+1,BPARR1(BPN1)=PBPREF_BPRJTXT
|
|
Q BPN1
|
|
;/**
|
|
;Input:
|
|
; BP59 - pointer to file #9002313.59
|
|
;Output:
|
|
; BPRCODES - array for reject codes by reference
|
|
REJCODES(BP59,BPRCODES) ;get reject codes
|
|
N BPRESP,BPPOS,BPA,BPR
|
|
;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
|
|
;get response and position
|
|
I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q
|
|
;
|
|
S BPA=0
|
|
F S BPA=$O(^BPSR(BPRESP,1000,BPPOS,511,BPA)) Q:'BPA D
|
|
. S BPR=$P(^BPSR(BPRESP,1000,BPPOS,511,BPA,0),U)
|
|
. I BPR'="" S BPRCODES(BPR)=""
|
|
Q
|
|
;/**
|
|
;BPRJCODE - code
|
|
GETRJNAM(BPRJCODE) ;*/
|
|
N BPRJIEN
|
|
S BPRJIEN=$O(^BPSF(9002313.93,"B",BPRJCODE,0))
|
|
Q:+BPRJIEN=0 ""
|
|
Q BPRJCODE_":"_$P($G(^BPSF(9002313.93,BPRJIEN,0)),U,2)
|
|
;/**
|
|
;BP59 - ptr to 9002313.59
|
|
;was the claim ever autoreversed ?
|
|
AUTOREV(BP59) ;*/
|
|
N BP02
|
|
S BP02=+$P($G(^BPST(BP59,0)),U,4)
|
|
Q +$P($G(^BPSC(BP02,0)),U,7)
|
|
;
|
|
;/**
|
|
;BP59 - ptr to 9002313.59
|
|
;returns :
|
|
;0 Waiting to start
|
|
;10 Gathering claim info
|
|
;19 Special Grouping
|
|
;30 Waiting for packet build
|
|
;31 Wait for retry (insurer asleep)
|
|
;40 Packet being built
|
|
;50 Waiting for transmit
|
|
;51 Wait for retry (comms error)
|
|
;60 Transmitting
|
|
;70 Receiving Response
|
|
;80 Waiting to process response
|
|
;90 Processing response
|
|
;99 Done
|
|
;
|
|
PRCNTG(BP59) ;*/
|
|
Q +$P($G(^BPST(BP59,0)),U,2)
|
|
;
|
|
;
|
|
LINE(BPN,BPCH) ;
|
|
N BP1
|
|
S $P(BP1,BPCH,BPN+1)=""
|
|
Q BP1
|
|
;
|
|
DTTIME(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format.
|
|
I +X=0 W ""
|
|
N DATE,YR,BPT,BPM,BPH,BPAP,BPS
|
|
I $G(X) S YR=$E(X,1,3)+1700
|
|
I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
|
|
S BPT=$P(X,".",2)
|
|
I BPT S:$L(BPT)<6 BPT=BPT_$E("000000",1,6-$L(BPT))
|
|
S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4),BPS=$E(BPT,5,6)
|
|
I BPT S DATE=DATE_"@"_BPH_":"_BPM_":"_BPS
|
|
Q $G(DATE)
|
|
;
|
|
;call IB API to get insurance data, then select proper insurance by its name
|
|
;get its phone number
|
|
;input:
|
|
; DFN - patient IEN in #2
|
|
; BPDOS - date of service
|
|
; BPINSNM - insurance name
|
|
;output: insurance ien^insurance name^phone
|
|
GETPHONE(BPDFN,BPDOS,BPINSNM) ;
|
|
N BPX,BPZZ,BP1,BPPHONE
|
|
S BPPHONE=""
|
|
I $$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,6")'=1 Q ""
|
|
S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
|
|
. I BPINSNM=$P($G(BPZZ("IBBAPI","INSUR",BP1,1)),U,2) S BPPHONE=$G(BPZZ("IBBAPI","INSUR",BP1,6)) Q
|
|
Q BPPHONE
|
|
;
|
|
;try to get insurance name and phone from #9002313.59, #9002313.57 and from INSUR^IBBAPI
|
|
;input: BP59 - ien in #9002313.59
|
|
;return insurance_name^phone#
|
|
NAMEPHON(BP59) ;
|
|
N BPHONE,BPINSNM,BPINSID,BP57,BPINSN
|
|
S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2)
|
|
S BPINSNM=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),0)),U,7)
|
|
S BP57=0
|
|
F Q:(BPHONE'="")&(BPINSNM'="") S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D
|
|
. S BPINSN=+$G(^BPSTL(BP57,9))
|
|
. S:BPHONE="" BPHONE=$P($G(^BPSTL(BP57,10,BPINSN,3)),U,2)
|
|
. S:BPINSNM="" BPINSNM=$P($G(^BPSTL(BP57,10,BPINSN,0)),U,7)
|
|
;
|
|
I (BPINSNM'="")&(BPHONE="") D
|
|
. 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)
|
|
. S BPHONE=$$GETPHONE(BPDFN,BPDOS,BPINSNM)
|
|
Q BPINSNM_U_BPHONE
|
|
;
|