source: FOIAVistA/tag/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSRPT2.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1BPSRPT2 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-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 ;
5 Q
6 ;
7 ;Save One Report Entry
8 ;
9 ; Input variables -> See BPSRPT0 for description
10 ; BPTMPGL,BPDFN,BPRX,BPREF,BP59,BPENDDT,BPPHARM,BPSUMDET,BPGRPLAN,BPRLDT,BPPAYBL,BPREJFL,BPRXDRG
11 ;
12SETTMP(BPTMPGL,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,BPPHARM,BPSUMDET,BPGRPLAN,BPRLDT,BPPAYBL,BPREJFL,BPRXDRG,BPSTATUS) ;
13 N BPCLSDT,BPDATA,BPDIV,BPFILDT,BPISSDT,BPSMSG,BPSREJ,BPREST,BPSRWR,BPTDTTM,BPTRDT
14 ;
15 ;Check for bad data
16 I BPREF,$$IFREFILL^BPSRPT6(BPRX,BPREF)=0 G EXIT
17 ;
18 ;Retrieve Close Date
19 S BPCLSDT=$P($$CLOSEDT(BP59),".")
20 ;
21 ;If NO refills
22 I BPREF=0 D
23 . S BPFILDT=$$RXFILDT^BPSRPT6(BPRX)
24 . S BPISSDT=$$RXISSDT^BPSRPT6(BPRX)
25 ;
26 ;If Refills
27 I BPREF>0 D
28 . S BPFILDT=$$REFFILDT^BPSRPT6(BPRX,BPREF)
29 . S BPISSDT=$$REFISSDT^BPSRPT6(BPRX,BPREF)
30 ;
31 ;Get Transaction Date/Transaction Date and Time
32 S BPTRDT=$$TRANDT(BP59,0)
33 S BPTDTTM=$$TRANDT(BP59,1)
34 ;
35 ;Get Result, Message, Reject Information, and BPS Pharmacy
36 S BPREST=$$RESULT(BP59,.BPSRWR)
37 S BPSMSG=$$MSG(BPSRWR,.BPSMSG,BP59)
38 S BPSREJ=$S(BPREJFL=0:"",1:$$REJECT(BPREST,.BPSREJ,BP59))
39 S BPDIV=+$P($G(^BPST(BP59,1)),"^",7)
40 ;
41 ;Set up data node
42 S BPDATA=BPRLDT_U_BPTRDT_U_BP59_U_BPRX_U_BPREF_U_BPREST_U_BPSTATUS_U_BPFILDT_U_BPISSDT_U_U_U_BPPAYBL_U_BPREJFL_U_BPRXDRG_U_BPSRWR
43 ;
44 ;For Totals by Date - No Insurance Sort
45 I BPRTYPE=6 S BPGRPLAN="~"
46 ;
47 ;Sort by transaction date
48 I BPRTYPE'=7 D:$$CHKDT(+$G(BPTRDT),BPBEGDT,BPENDDT)
49 . ;
50 . ;For Recent Transactions tack on Txn date and Time to Ins
51 . I BPRTYPE=5 S BPGRPLAN=-BPTDTTM_"^"_BPGRPLAN
52 . S @BPTMPGL@(BPDIV,BPGRPLAN,BPDFN,BPTRDT,BPRX,BPREF)=BPDATA
53 ;
54 ;Sort by close date
55 I BPRTYPE=7 D:$$CHKDT(+$G(BPCLSDT),BPBEGDT,BPENDDT)
56 . S @BPTMPGL@(BPDIV,BPGRPLAN,BPDFN,BPCLSDT,BPRX,BPREF)=BPDATA
57 ;
58EXIT Q
59 ;
60 ;Get Transaction date and Time
61 ;
62 ; Input Variables -> BP59 - ptr to BPS TRANSACTION
63 ; TIME - 1 - Return DT.TM, 0 - DT
64 ; Returned Value -> Transaction or Transaction Date.Time
65 ;
66TRANDT(BP59,TIME) N X
67 S X=$P($G(^BPST(BP59,0)),U,8)
68 Q $S(TIME=0:X\1,1:X)
69 ;
70 ;Determine the Claim Close Date
71 ;
72 ; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
73 ; Returned Value -> CL = Claim Close Date and Time
74 ;
75CLOSEDT(BP59) N CL,BP02
76 S BP02=+$P($G(^BPST(BP59,0)),U,4)
77 S CL=+$P($G(^BPSC(BP02,900)),U,2)
78 Q CL
79 ;
80 ;Get Result
81 ;
82RESULT(BP59,RWR) N X
83 I BP59 S RWR=$$CATEG^BPSOSUC(BP59)
84 E S RWR=""
85 I RWR?1"E ".E D
86 . S X=RWR
87 . I X="E PAYABLE" S X=4
88 . E I X="E CAPTURED" S X=3
89 . E I X="E DUPLICATE" S X=2
90 . E I X="E REJECTED" S X=1
91 . E I X="E REVERSAL ACCEPTED" S X=11
92 . E I X="E REVERSAL REJECTED" S X=12
93 . E S X=0
94 E I RWR="PAPER" S X=9
95 E I RWR="PAPER REVERSAL" S X=19
96 E S X=15
97 Q X
98 ;
99 ;Message
100 ;
101MSG(RWR,MSGTEXT,BP59) N BPRET
102 S BPRET=0
103 ; If the claim has any message text, store it
104 I RWR?1"E ".E D
105 . S X=$$MESSAG59(BP59,1)
106 . I X]"" S MSGTEXT(1)=X
107 . S X=$$MESSAG59(BP59,2)
108 . I X]"" S MSGTEXT(2)=X
109 . I $D(MSGTEXT) S MSGTEXT="MSGTEXT"
110 . S BPRET=1
111 Q BPRET
112 ;
113 ;Reject Text
114 ;
115 ; Output Variable -> BPSRTEXT,BPRET
116 ;
117REJECT(RWR,BPSRTEXT,BP59) N BPRET,BPSRESP,BPSECME,BPSPOS
118 S BPRET=0
119 ; If it's a rejected claim, build the rejection text
120 I RWR="E REJECTED"!(RWR="E REVERSAL REJECTED") D
121 . D RESP59(BP59,.BPSRESP,.BPSECME) ; set BPSRESP,BPSECME pointers
122 . D REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT)
123 . ; word processing text goes into FDA(FILE,IENS,FIELD,n)=text
124 . S BPSRTEXT=$S($D(BPSRTEXT):"REJTEXT",1:"")
125 . S:$D(BPSRTEXT) BPRET=1
126 Q BPRET
127 ;
128 ;Messages
129 ;
130MESSAG59(BP59,N) N MSG,BPSRESP,BPSPOS
131 I 'BP59 S MSG="" G XMSG59
132 D RESP59(59,.BPSRESP,.BPSPOS) I 'BPSRESP!'BPSPOS S MSG="" G XMSG59
133 I '$D(N) S N=0
134 I N=1 S MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS,1) I 1
135 I N=2 S MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS,2) I 1
136 E S MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS)
137XMSG59 Q MSG
138 ;
139 ;Responds
140RESP59(BP59,BPSRESP,BPSPOS) ;EP - caller should N BPSRESP,BPSPOS
141 ;Input: BP59
142 ;Output:
143 ; BPSRESP,BPSPOS by reference
144 I $G(^BPST(BP59,4)) D ; reversal
145 . S BPSRESP=$P($G(^BPST(BP59,4)),U,2)
146 . S BPSPOS=1
147 E D
148 . S BPSRESP=$P($G(^BPST(BP59,0)),U,5)
149 . S BPSPOS=$P($G(^BPST(BP59,0)),U,9)
150 Q
151 ;
152 ;Check and compare dates
153CHKDT(BPTSTDT,BPBEGDT,BPENDDT) ;
154 I BPTSTDT=0 Q 0
155 I BPTSTDT'<BPBEGDT,BPTSTDT'>BPENDDT Q 1
156 Q 0
157 ;
158 ;Populate passed in Array
159 ;
160REJTEXT(BP59,ARR) N BBX,BPSRESP,BPSPOS,A,I,X,R
161 S BBX=$G(^BPST(BP59,0))
162 S BPSRESP=$P(BBX,U,5)
163 S BPSPOS=$P(BBX,U,9)
164 S (A,I)=0
165 I BPSRESP&BPSPOS D
166 . K ARR
167 . F S A=$O(^BPSR(BPSRESP,1000,BPSPOS,511,A)) Q:'A D
168 . . S R=$P(^BPSR(BPSRESP,1000,BPSPOS,511,A,0),U)
169 . . Q:R=""
170 . . N S S S=$O(^BPSF(9002313.93,"B",R,0))
171 . . I S S X=$TR($G(^BPSF(9002313.93,S,0)),U,":")
172 . . E S X=R_" unrecognized reject code"
173 . . S I=I+1,ARR(I)=X
174 . . K S
175 Q I
176 ;
177 ;Get Claim ID
178CLAIMID(BP59) N BP02
179 S BP02=+$P($G(^BPST(BP59,0)),U,4)
180 Q $P($G(^BPSC(BP02,0)),U)
181 ;
182 ;Determine $Ins Paid
183 ;
184INSPAID(BP59) N X,RESP,POSITION
185 S X=$G(^BPST(BP59,0))
186 S RESP=$P(X,U,5)
187 S POSITION=$P(X,U,9)
188 Q $S(RESP&POSITION:$$INSPAID1^BPSOS03(RESP,POSITION),1:0)
189 ;
190 ;Get the Cardholder ID
191CRDHLDID(BP59) N BP02
192 S BP02=+$P($G(^BPST(BP59,0)),U,4)
193 Q $P($G(^BPSC(BP02,300)),U,2)
194 ;
195GRPID(BP59) ;sent by IB in RX^IBNCPDP
196 N BP02
197 S BP02=+$P($G(^BPST(BP59,0)),U,4)
198 Q $P($G(^BPSC(BP02,300)),U)
Note: See TracBrowser for help on using the repository browser.