source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOS03.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1BPSOS03 ;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
8INSPAID(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
15INSPAID1(N,RX) ;EP -
16 N X S X=$$509(N,RX) Q X
17NETPAID1(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
32REJTEXT(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
43MESSAGE(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)
47DFF2EXT(X) Q $$DFF2EXT^BPSECFM(X)
48505(M,N) Q $$500(M,N,5) ; Patient Pay Amount
49506(M,N) Q $$500(M,N,6) ; Ingredient Cost Paid
50507(M,N) Q $$500(M,N,7) ; Contract Fee Paid
51508(M,N) Q $$500(M,N,8) ; Sales Tax Paid
52509(M,N) Q $$500(M,N,9) ; Total Amount Paid
53512(M,N) Q $$500(M,N,12) ; Accumulated Deductible Amount
54513(M,N) Q $$500(M,N,13) ; Remaining Deductible Amount
55514(M,N) Q $$500(M,N,14) ; Remaining Benefit Amount
56517(M,N) Q $$500(M,N,17) ; Amt Applied to Periodic Deduct
57518(M,N) Q $$500(M,N,18) ; Amount of Copay/CoInsurance
58519(M,N) Q $$500(M,N,19) ; Amt Attrib to Prod Selection
59520(M,N) Q $$500(M,N,20) ; Amt Exceed Per Benefit Max
60521(M,N) Q $$500(M,N,21) ; Incentive Fee Paid
61523(M,N) Q $$500(M,N,23) ; Amount Attributed to Sales Tax
62500(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
Note: See TracBrowser for help on using the repository browser.