| [613] | 1 | BPSOS03 ;BHAM ISC/FCS/DRS - 9002313.03 utilities ;06/01/2004
|
|---|
| 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 | ;
|
|---|
| 5 | Q
|
|---|
| 6 | ; General utilities for retrieval from 9002313.03, Claim Response
|
|---|
| 7 | ; $$INSPAID is used by BPSOSQL
|
|---|
| 8 | INSPAID(N) ;EP - from BPSOSQL - total amount paid by insurer
|
|---|
| 9 | N RX,TOT,X S (TOT,RX)=0
|
|---|
| 10 | F S RX=$O(^BPSR(N,1000,RX)) Q:'RX D
|
|---|
| 11 | . ; Try Gross Amount Due, and if that's zero, Usual and Customary
|
|---|
| 12 | . S X=$$INSPAID1(N,RX)
|
|---|
| 13 | . S TOT=TOT+X
|
|---|
| 14 | Q TOT
|
|---|
| 15 | INSPAID1(N,RX) ;EP -
|
|---|
| 16 | N X S X=$$509(N,RX) Q X
|
|---|
| 17 | NETPAID1(N,RX) ; EP - computed field in 9002313.57 and 9002313.59
|
|---|
| 18 | N X S X=$$509(N,RX) ; X = (#509) Total Amount Paid
|
|---|
| 19 | N SUB S SUB=1 ; Do we need to subtract (#505) Patient Pay Amount?
|
|---|
| 20 | N IEN02,INS,FMT S IEN02=$P(^BPSR(RESP,0),U)
|
|---|
| 21 | I IEN02 D
|
|---|
| 22 | . S INS=$P($G(^BPSC(IEN02,0)),U,2) Q:'INS ;IHS/SD/lwj 9/11/02
|
|---|
| 23 | . S FMT=INS
|
|---|
| 24 | . N X S X=$P(^BPSF(9002313.92,FMT,1),U,10)
|
|---|
| 25 | . I X S SUB=0 ; Total paid means total paid by insurance
|
|---|
| 26 | I SUB S X=X-$$505(N,RX)
|
|---|
| 27 | I X<0,SUB D ; apparently this format is supposed to be excl.
|
|---|
| 28 | . Q:'$G(FMT)
|
|---|
| 29 | . S $P(^BPSF(9002313.92,FMT,1),U,10)=1
|
|---|
| 30 | . S X=X+$$505(N,RX) ;*1.26*1*
|
|---|
| 31 | Q X
|
|---|
| 32 | REJTEXT(RESP,POS,ARR) ; EP - fills array (passed by ref)
|
|---|
| 33 | K ARR
|
|---|
| 34 | N A,I,X,R S (A,I)=0
|
|---|
| 35 | F S A=$O(^BPSR(RESP,1000,POS,511,A)) Q:'A D
|
|---|
| 36 | . S R=$P(^BPSR(RESP,1000,POS,511,A,0),U)
|
|---|
| 37 | . Q:R=""
|
|---|
| 38 | . N S S S=$O(^BPSF(9002313.93,"B",R,0))
|
|---|
| 39 | . I S S X=$TR($G(^BPSF(9002313.93,S,0)),U,":")
|
|---|
| 40 | . E S X=R_" unrecognized reject code"
|
|---|
| 41 | . S I=I+1,ARR(I)=X
|
|---|
| 42 | Q
|
|---|
| 43 | MESSAGE(RESP,POS,N) ; EP - get additional message from response
|
|---|
| 44 | I $G(N)=1 Q $P($G(^BPSR(RESP,1000,POS,504)),U)
|
|---|
| 45 | I $G(N)=2 Q $P($G(^BPSR(RESP,1000,POS,526)),U)
|
|---|
| 46 | Q $$MESSAGE(RESP,POS,1)_$$MESSAGE(RESP,POS,2)
|
|---|
| 47 | DFF2EXT(X) Q $$DFF2EXT^BPSECFM(X)
|
|---|
| 48 | 505(M,N) Q $$500(M,N,5) ; Patient Pay Amount
|
|---|
| 49 | 506(M,N) Q $$500(M,N,6) ; Ingredient Cost Paid
|
|---|
| 50 | 507(M,N) Q $$500(M,N,7) ; Contract Fee Paid
|
|---|
| 51 | 508(M,N) Q $$500(M,N,8) ; Sales Tax Paid
|
|---|
| 52 | 509(M,N) Q $$500(M,N,9) ; Total Amount Paid
|
|---|
| 53 | 512(M,N) Q $$500(M,N,12) ; Accumulated Deductible Amount
|
|---|
| 54 | 513(M,N) Q $$500(M,N,13) ; Remaining Deductible Amount
|
|---|
| 55 | 514(M,N) Q $$500(M,N,14) ; Remaining Benefit Amount
|
|---|
| 56 | 517(M,N) Q $$500(M,N,17) ; Amt Applied to Periodic Deduct
|
|---|
| 57 | 518(M,N) Q $$500(M,N,18) ; Amount of Copay/CoInsurance
|
|---|
| 58 | 519(M,N) Q $$500(M,N,19) ; Amt Attrib to Prod Selection
|
|---|
| 59 | 520(M,N) Q $$500(M,N,20) ; Amt Exceed Per Benefit Max
|
|---|
| 60 | 521(M,N) Q $$500(M,N,21) ; Incentive Fee Paid
|
|---|
| 61 | 523(M,N) Q $$500(M,N,23) ; Amount Attributed to Sales Tax
|
|---|
| 62 | 500(M,N,J) ; field #500+J signed numeric
|
|---|
| 63 | Q:'M!'N ""
|
|---|
| 64 | N X S X=$P($G(^BPSR(M,1000,N,500)),U,J)
|
|---|
| 65 | I $E(X,1,2)?2U S X=$E(X,3,$L(X))
|
|---|
| 66 | S X=$$DFF2EXT(X)
|
|---|
| 67 | Q X
|
|---|
