BPSTEST2 ;AITC/CKB - ECME TESTING TOOL ;5/31/2018
;;1.0;E CLAIMS MGMT ENGINE;**24,26,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
SETOVER ;
; the following code was from SETOVER^BPSTEST and is called by SETOVER^BPSTEST
;
; If a eligibility, check for specific reversal overrides and set
I BPSTYPE="E1" D Q
. S BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.08,"I")
. ;
. ; If the response is Stranded, force an <UNDEF> error
. I BPSRRESP="T" S BPSXXXX=BPSUNDEF
. I BPSRRESP]"" S BPSDATA(1,112)=BPSRRESP
. S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSRRESP="R":"R",1:"A")
. ;
. ; If the response is accepted, delete the reject code count and codes
. I BPSRRESP="A" K BPSDATA(1,510),BPSDATA(1,511)
. ;
. ; If the response is rejected, delete the rejections returned by payers
. ; and put in the ones entered by the user
. I BPSRRESP="R" D
.. K BPSDATA(1,509),BPSDATA(1,511)
.. S BPSRCNT=0
.. S BPSRIEN=0 F S BPSRIEN=$O(^BPS(9002313.32,BPSTIEN,1,BPSRIEN)) Q:+BPSRIEN=0 D
... S BPSRCODE=$P($G(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1)
... ; Increment counter and store
... I BPSRCODE]"" D
.... S BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E")
.... I BPSRCD]"" S BPSRCNT=BPSRCNT+1,BPSDATA(1,511,BPSRCNT)=BPSRCD
.. ; Store total number of rejections
.. S BPSDATA(1,510)=BPSRCNT
;
; If a reversal, check for specific reversal overrides and set
I BPSTYPE="B2" D
. S BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I")
. ;
. ; If the response is Stranded, force an <UNDEF> error
. I BPSRRESP="T" S BPSXXXX=BPSUNDEF
. I BPSRRESP]"" S BPSDATA(1,112)=$S(BPSRRESP="D":"T",1:BPSRRESP)
. S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSRRESP="R":"R",1:"A")
. ;
. ; If the response is accepted or duplicate, kill the reject code count and codes
. I BPSRRESP="A"!(BPSRRESP="D")!(BPSRRESP="Q")!(BPSRRESP="S") K BPSDATA(1,510),BPSDATA(1,511)
. ;
. ; If the response is rejected, set the reject codes
. I BPSRRESP="R" D SETREJ^BPSTEST(BPSTRANS)
;
; If a submission, check for specific submission overrides and set
I BPSTYPE="B1" D
. ; Get submission response
. S BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I")
. ;
. ; If the response is Stranded, force an <UNDEF> error
. I BPSSRESP="T" S BPSXXXX=BPSUNDEF
. ;
. ; If BPSSRESP exists, file it
. I BPSSRESP]"" D
.. S BPSDATA(1,112)=BPSSRESP
.. S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSSRESP="R":"R",1:"A")
.. ; If payable or duplicate, get the BPSPAID amount and file it if it
.. ; exists. Also delete any reject codes
.. I BPSSRESP="P"!(BPSSRESP="D")!(BPSSRESP="Q")!(BPSSRESP="S") D
... ;
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.1,"I") ; 505-F5 Patient Pay Amount
... I BPSX]"" S BPSDATA(1,505)=$$DFF^BPSECFM(BPSX,10)
... ;
... S BPSPAID=$$GET1^DIQ(9002313.32,BPSTIEN_",",.04,"I")
... I BPSPAID]"" S BPSDATA(1,509)=$$DFF^BPSECFM(BPSPAID,8) ; 509 Total amount paid
... ;
... K BPSDATA(1,510),BPSDATA(1,511) ; kill Reject Count (510) and Reject Code (511)
... ;
... S BPSCOPAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.06,"I")
... I BPSCOPAY]"" S BPSDATA(1,518)=$$DFF^BPSECFM(BPSCOPAY,8) ; 518 Copay Amount
... ;
... S BPS506=$$GET1^DIQ(9002313.32,BPSTIEN_",",.15,"I")
... I BPS506]"" S BPSDATA(1,506)=$$DFF^BPSECFM(BPS506,8) ; 506 Ingredient Cost Paid
... ;
... S BPS507=$$GET1^DIQ(9002313.32,BPSTIEN_",",.16,"I")
... I BPS507]"" S BPSDATA(1,507)=$$DFF^BPSECFM(BPS507,8) ; 507 Dispensing Fee Paid
... ;
... S BPS513=$$GET1^DIQ(9002313.32,BPSTIEN_",",.17,"I")
... I BPS513]"" S BPSDATA(1,513)=$$DFF^BPSECFM(BPS513,8) ; 513 Remaining Deductible Amount
... ;
... S BPS517=$$GET1^DIQ(9002313.32,BPSTIEN_",",.18,"I")
... I BPS517]"" S BPSDATA(1,517)=$$DFF^BPSECFM(BPS517,8) ; 517 Amount Applied to Periodic Deductible
... Q
.. ;
.. ;if not Stranded (BPSSRESP="T") prompt for the following fields
.. I BPSSRESP'="T" D
... ; D1-D9 fields (BPS*1*15)
... S BPSAJPAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.1,"I") ; Adjudicated Payment Type
... I BPSAJPAY]"" S BPSDATA(1,1028)=$$NFF^BPSECFM(BPSAJPAY,2)
... S BPSNFLDT=$$GET1^DIQ(9002313.32,BPSTIEN_",",.09,"I") ; Override Next Available Fill
... I BPSNFLDT]"" S BPSDATA(1,2004)=$$DTF1^BPSECFM(BPSNFLDT)
... ;
... ; E0-E6 overrides (BPS*1*19)
... ; PERCENTAGE SALES TAX BASIS PAID
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.01,"I")
... I BPSX]"" S BPSDATA(1,561)=BPSX
... ; OTHER AMOUNT PAID QUALIFIER and associated field
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.02,"I")
... I BPSX]"" S BPSDATA(1,564,1)=$$NFF^BPSECFM(BPSX,2),BPSDATA(1,565,1)=$$DFF^BPSECFM(5.64,8),BPSDATA(1,563)=1
... ; PAYER ID QUALIFIER
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.03,"I")
... I BPSX]"" S BPSDATA(9002313.03,9002313.03,"+1,",568)=BPSX
... ; HELP DESK TELEPHONE NUMBER EXTENSION
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.04,"I")
... I BPSX]"" S BPSDATA(1,2022)=$$NFF^BPSECFM(BPSX,8)
... ; PROFESSIONAL SERVICE FEE CONTRACTED/REIMURSEMENT AMOUNT
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.05,"I")
... I BPSX]"" S BPSDATA(1,2033)=$$DFF^BPSECFM(BPSX,8)
... ; OTHER PAYER HELPDESK TELEPHONE EXTENSION
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.06,"I")
... I BPSX]"" S BPSDATA(1,2023,1)=$$NFF^BPSECFM(BPSX,8),BPSDATA(1,338,1)="01"
... ; RESPONSE INTERMEDIARY AUTHORIZATION TYPE ID and associated fields
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.07,"I")
... I BPSX]"" S BPSDATA(1,2053,1)=$$NFF^BPSECFM(BPSX,2),BPSDATA(1,2052)=1
... ; RESPONSE INTERMEDIARY AUTHORIZATION ID and associated fields
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.08,"I")
... I BPSX]"" S BPSDATA(1,2054,1)=$$ANFF^BPSECFM(BPSX,20),BPSDATA(1,2052)=1
... ; INTERMEDIARY MESSAGE and associated fields
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",3.01,"I")
... I BPSX]"" S BPSDATA(1,2051,1)=$$ANFF^BPSECFM(BPSX,200),BPSDATA(1,2052)=1
... ; (BPS*1*22)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.09,"I") ; B98-34 reconciliation id
... I BPSX]"" S BPSDATA(1,2098)=$$ANFF^BPSECFM(BPSX,30)
... ;
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.11,"E") ; 439-E4 reason for service code
... I BPSX]"" S BPSDATA(1,439,1)=$$ANFF^BPSECFM(BPSX,4),BPSDATA(1,567,1)=1
... ;
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.01,"I") ; 931-F8 maximum age qualifier
... I BPSX]"" S BPSDATA(1,931)=$$ANFF^BPSECFM(BPSX,1)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.02,"I") ; 932-GA maximum age
... I BPSX]"" S BPSDATA(1,932)=$$NFF^BPSECFM(BPSX,3)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.03,"I") ; 933-GB maximum amount
... I BPSX]"" S BPSDATA(1,933)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.04,"I") ; 934-GC maximum amt qualifier
... I BPSX]"" S BPSDATA(1,934)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.05,"I") ; 935-GF maximum amt time period
... I BPSX]"" S BPSDATA(1,935)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.06,"I") ; 936-GG maximum amt time period start date
... I BPSX]"" S BPSDATA(1,936)=$$DTF1^BPSECFM(BPSX)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.07,"I") ; 937-GH maximum amt time period end date
... I BPSX]"" S BPSDATA(1,937)=$$DTF1^BPSECFM(BPSX)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.08,"I") ; 938-GJ maximum amt time period units
... I BPSX]"" S BPSDATA(1,938)=$$NFF^BPSECFM(BPSX,4)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.09,"I") ; 943-GQ minimum age qualifier
... I BPSX]"" S BPSDATA(1,943)=$$ANFF^BPSECFM(BPSX,1)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.1,"I") ; 944-GR minimum age
... I BPSX]"" S BPSDATA(1,944)=$$NFF^BPSECFM(BPSX,3)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.11,"I") ; C47-9T other payer adjudicate prog type
... I BPSX]"" S BPSDATA(1,2147)=$$ANFF^BPSECFM(BPSX,30)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.12,"I") ; C93-KN patient pay component amount
... I BPSX]"" S BPSDATA(1,2193)=$$DFF^BPSECFM(BPSX,8)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.13,"I") ; C94-KP patient pay component count
... I BPSX]"" S BPSDATA(1,2194)=$$NFF^BPSECFM(BPSX,4)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.14,"I") ; C95-KQ patient payer component qualifier
... I BPSX]"" S BPSDATA(1,2195)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.15,"I") ; D19-M1 minimum amount
... I BPSX]"" S BPSDATA(1,2219)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.16,"I") ; D20-M2 minimum amount qualifier
... I BPSX]"" S BPSDATA(1,2220)=$$ANFF^BPSECFM(BPSX,3)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.17,"I") ; D23-M5 other payer name
... I BPSX]"" S BPSDATA(1,2223)=$$ANFF^BPSECFM(BPSX,30)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.18,"I") ; D24-M6 remaining amount
... I BPSX]"" S BPSDATA(1,2224)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.19,"I") ; D25-M7 remaining amount qualifier
... I BPSX]"" S BPSDATA(1,2225)=$$ANFF^BPSECFM(BPSX,3)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.2,"I") ; D41-PA other payer relationship type
... I BPSX]"" S BPSDATA(1,2241)=$$ANFF^BPSECFM(BPSX,3)
... ;
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.01,"I") ; E87-ZV invalid provider data source
... I BPSX]"" S BPSDATA(1,2387)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.02,"I") ; E89-ZO formulary alternative eff date
... I BPSX]"" S BPSDATA(1,2389)=$$DTF1^BPSECFM(BPSX)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.03,"I") ; E93-ZC dur/due co-agent description
... I BPSX]"" S BPSDATA(1,2393)=$$ANFF^BPSECFM(BPSX,40)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.04,"I") ; E94-ZA unit of prior dispensed qty
... I BPSX]"" S BPSDATA(1,2394)=$$ANFF^BPSECFM(BPSX,3)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.05,"I") ; E95-Z9 other pharmacy id qualifier
... I BPSX]"" S BPSDATA(1,2395)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.06,"I") ; E97-Z7 other pharmacy name
... I BPSX]"" S BPSDATA(1,2397)=$$ANFF^BPSECFM(BPSX,70)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.07,"I") ; E98-Z6 other pharmacy telephone
... I BPSX]"" S BPSDATA(1,2398)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.08,"I") ; E99-Z5 other prescriber last name
... I BPSX]"" S BPSDATA(1,2399)=$$ANFF^BPSECFM(BPSX,35)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.09,"I") ; F01-Z4 other prescriber id qualifier
... I BPSX]"" S BPSDATA(1,2401)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.10,"I") ; F02-Z3 other prescriber id
... I BPSX]"" S BPSDATA(1,2402)=$$ANFF^BPSECFM(BPSX,35)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.11,"I") ; F03-Z2 other prescriber phone number
... I BPSX]"" S BPSDATA(1,2403)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.12,"I") ; F04-Z1 dur/due compound product id
... I BPSX]"" S BPSDATA(1,2404)=$$ANFF^BPSECFM(BPSX,40)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.13,"I") ; F05-Z0 dur/due compound product id qualifier
... I BPSX]"" S BPSDATA(1,2405)=$$ANFF^BPSECFM(BPSX,2)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.14,"I") ; F06-YO dur/due maximum daily dose qty
... I BPSX]"" S BPSDATA(1,2406)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.15,"I") ; F07-YL dur/due max daily dose - unit
... I BPSX]"" S BPSDATA(1,2407)=$$ANFF^BPSECFM(BPSX,3)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.16,"I") ; F08-YJ dur/due minimum daily dose qty
... I BPSX]"" S BPSDATA(1,2408)=$$NFF^BPSECFM(BPSX,10)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.17,"I") ; F09-YI dur/due min daily dose - unit
... I BPSX]"" S BPSDATA(1,2409)=$$ANFF^BPSECFM(BPSX,3)
... ;
... ; E7 overrides (BPS*1*20)
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.11,"I") I BPSX'="" D ; B88-3R quantity limit per spec time period
.... S BPSDATA(1,2087)=1 ; count field
.... S BPSDATA(1,2088,1)=$$NFF^BPSECFM(BPSX,10) ; data from override file
.... Q
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.12,"I") I BPSX'="" D ; B89-3S quantity limit time period
.... S BPSDATA(1,2087)=1 ; count field
.... S BPSDATA(1,2089,1)=$$NFF^BPSECFM(BPSX,5) ; data from override file
.... Q
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.13,"I") I BPSX'="" D ; B91-3W days supply limit per spec time period
.... S BPSDATA(1,2090)=1 ; count field
.... S BPSDATA(1,2091,1)=$$NFF^BPSECFM(BPSX,3) ; data from override file
.... Q
... S BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.14,"I") I BPSX'="" D ; B92-3X days supply limit time period
.... S BPSDATA(1,2090)=1 ; count field
.... S BPSDATA(1,2092,1)=$$NFF^BPSECFM(BPSX,5) ; data from override file
.... Q
... Q
.. ;
.. ; If rejected, get the rejection code and file them
.. ; Also, delete the BPSPAID amount
.. I BPSSRESP="R" D
... ; Delete old rejections and BPSPAID amount
... K BPSDATA(1,509),BPSDATA(1,511)
... ; Loop through rejections and store
... S BPSRCNT=0
... S BPSRIEN=0 F S BPSRIEN=$O(^BPS(9002313.32,BPSTIEN,1,BPSRIEN)) Q:+BPSRIEN=0 D
.... S BPSRCODE=$P($G(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1)
.... ; Increment counter and store
.... I BPSRCODE]"" D
..... S BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E")
..... I BPSRCD]"" S BPSRCNT=BPSRCNT+1,BPSDATA(1,511,BPSRCNT)=BPSRCD
... ; Store total number of rejections
... S BPSDATA(1,510)=BPSRCNT
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSTEST2 13769 printed Oct 16, 2024@17:54:19 Page 2
BPSTEST2 ;AITC/CKB - ECME TESTING TOOL ;5/31/2018
+1 ;;1.0;E CLAIMS MGMT ENGINE;**24,26,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
SETOVER ;
+1 ; the following code was from SETOVER^BPSTEST and is called by SETOVER^BPSTEST
+2 ;
+3 ; If a eligibility, check for specific reversal overrides and set
+4 IF BPSTYPE="E1"
Begin DoDot:1
+5 SET BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.08,"I")
+6 ;
+7 ; If the response is Stranded, force an <UNDEF> error
+8 IF BPSRRESP="T"
SET BPSXXXX=BPSUNDEF
+9 IF BPSRRESP]""
SET BPSDATA(1,112)=BPSRRESP
+10 SET BPSDATA(9002313.03,9002313.03,"+1,",501)=$SELECT(BPSRRESP="R":"R",1:"A")
+11 ;
+12 ; If the response is accepted, delete the reject code count and codes
+13 IF BPSRRESP="A"
KILL BPSDATA(1,510),BPSDATA(1,511)
+14 ;
+15 ; If the response is rejected, delete the rejections returned by payers
+16 ; and put in the ones entered by the user
+17 IF BPSRRESP="R"
Begin DoDot:2
+18 KILL BPSDATA(1,509),BPSDATA(1,511)
+19 SET BPSRCNT=0
+20 SET BPSRIEN=0
FOR
SET BPSRIEN=$ORDER(^BPS(9002313.32,BPSTIEN,1,BPSRIEN))
if +BPSRIEN=0
QUIT
Begin DoDot:3
+21 SET BPSRCODE=$PIECE($GET(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1)
+22 ; Increment counter and store
+23 IF BPSRCODE]""
Begin DoDot:4
+24 SET BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E")
+25 IF BPSRCD]""
SET BPSRCNT=BPSRCNT+1
SET BPSDATA(1,511,BPSRCNT)=BPSRCD
End DoDot:4
End DoDot:3
+26 ; Store total number of rejections
+27 SET BPSDATA(1,510)=BPSRCNT
End DoDot:2
End DoDot:1
QUIT
+28 ;
+29 ; If a reversal, check for specific reversal overrides and set
+30 IF BPSTYPE="B2"
Begin DoDot:1
+31 SET BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I")
+32 ;
+33 ; If the response is Stranded, force an <UNDEF> error
+34 IF BPSRRESP="T"
SET BPSXXXX=BPSUNDEF
+35 IF BPSRRESP]""
SET BPSDATA(1,112)=$SELECT(BPSRRESP="D":"T",1:BPSRRESP)
+36 SET BPSDATA(9002313.03,9002313.03,"+1,",501)=$SELECT(BPSRRESP="R":"R",1:"A")
+37 ;
+38 ; If the response is accepted or duplicate, kill the reject code count and codes
+39 IF BPSRRESP="A"!(BPSRRESP="D")!(BPSRRESP="Q")!(BPSRRESP="S")
KILL BPSDATA(1,510),BPSDATA(1,511)
+40 ;
+41 ; If the response is rejected, set the reject codes
+42 IF BPSRRESP="R"
DO SETREJ^BPSTEST(BPSTRANS)
End DoDot:1
+43 ;
+44 ; If a submission, check for specific submission overrides and set
+45 IF BPSTYPE="B1"
Begin DoDot:1
+46 ; Get submission response
+47 SET BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I")
+48 ;
+49 ; If the response is Stranded, force an <UNDEF> error
+50 IF BPSSRESP="T"
SET BPSXXXX=BPSUNDEF
+51 ;
+52 ; If BPSSRESP exists, file it
+53 IF BPSSRESP]""
Begin DoDot:2
+54 SET BPSDATA(1,112)=BPSSRESP
+55 SET BPSDATA(9002313.03,9002313.03,"+1,",501)=$SELECT(BPSSRESP="R":"R",1:"A")
+56 ; If payable or duplicate, get the BPSPAID amount and file it if it
+57 ; exists. Also delete any reject codes
+58 IF BPSSRESP="P"!(BPSSRESP="D")!(BPSSRESP="Q")!(BPSSRESP="S")
Begin DoDot:3
+59 ;
+60 ; 505-F5 Patient Pay Amount
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.1,"I")
+61 IF BPSX]""
SET BPSDATA(1,505)=$$DFF^BPSECFM(BPSX,10)
+62 ;
+63 SET BPSPAID=$$GET1^DIQ(9002313.32,BPSTIEN_",",.04,"I")
+64 ; 509 Total amount paid
IF BPSPAID]""
SET BPSDATA(1,509)=$$DFF^BPSECFM(BPSPAID,8)
+65 ;
+66 ; kill Reject Count (510) and Reject Code (511)
KILL BPSDATA(1,510),BPSDATA(1,511)
+67 ;
+68 SET BPSCOPAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.06,"I")
+69 ; 518 Copay Amount
IF BPSCOPAY]""
SET BPSDATA(1,518)=$$DFF^BPSECFM(BPSCOPAY,8)
+70 ;
+71 SET BPS506=$$GET1^DIQ(9002313.32,BPSTIEN_",",.15,"I")
+72 ; 506 Ingredient Cost Paid
IF BPS506]""
SET BPSDATA(1,506)=$$DFF^BPSECFM(BPS506,8)
+73 ;
+74 SET BPS507=$$GET1^DIQ(9002313.32,BPSTIEN_",",.16,"I")
+75 ; 507 Dispensing Fee Paid
IF BPS507]""
SET BPSDATA(1,507)=$$DFF^BPSECFM(BPS507,8)
+76 ;
+77 SET BPS513=$$GET1^DIQ(9002313.32,BPSTIEN_",",.17,"I")
+78 ; 513 Remaining Deductible Amount
IF BPS513]""
SET BPSDATA(1,513)=$$DFF^BPSECFM(BPS513,8)
+79 ;
+80 SET BPS517=$$GET1^DIQ(9002313.32,BPSTIEN_",",.18,"I")
+81 ; 517 Amount Applied to Periodic Deductible
IF BPS517]""
SET BPSDATA(1,517)=$$DFF^BPSECFM(BPS517,8)
+82 QUIT
End DoDot:3
+83 ;
+84 ;if not Stranded (BPSSRESP="T") prompt for the following fields
+85 IF BPSSRESP'="T"
Begin DoDot:3
+86 ; D1-D9 fields (BPS*1*15)
+87 ; Adjudicated Payment Type
SET BPSAJPAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.1,"I")
+88 IF BPSAJPAY]""
SET BPSDATA(1,1028)=$$NFF^BPSECFM(BPSAJPAY,2)
+89 ; Override Next Available Fill
SET BPSNFLDT=$$GET1^DIQ(9002313.32,BPSTIEN_",",.09,"I")
+90 IF BPSNFLDT]""
SET BPSDATA(1,2004)=$$DTF1^BPSECFM(BPSNFLDT)
+91 ;
+92 ; E0-E6 overrides (BPS*1*19)
+93 ; PERCENTAGE SALES TAX BASIS PAID
+94 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.01,"I")
+95 IF BPSX]""
SET BPSDATA(1,561)=BPSX
+96 ; OTHER AMOUNT PAID QUALIFIER and associated field
+97 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.02,"I")
+98 IF BPSX]""
SET BPSDATA(1,564,1)=$$NFF^BPSECFM(BPSX,2)
SET BPSDATA(1,565,1)=$$DFF^BPSECFM(5.64,8)
SET BPSDATA(1,563)=1
+99 ; PAYER ID QUALIFIER
+100 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.03,"I")
+101 IF BPSX]""
SET BPSDATA(9002313.03,9002313.03,"+1,",568)=BPSX
+102 ; HELP DESK TELEPHONE NUMBER EXTENSION
+103 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.04,"I")
+104 IF BPSX]""
SET BPSDATA(1,2022)=$$NFF^BPSECFM(BPSX,8)
+105 ; PROFESSIONAL SERVICE FEE CONTRACTED/REIMURSEMENT AMOUNT
+106 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.05,"I")
+107 IF BPSX]""
SET BPSDATA(1,2033)=$$DFF^BPSECFM(BPSX,8)
+108 ; OTHER PAYER HELPDESK TELEPHONE EXTENSION
+109 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.06,"I")
+110 IF BPSX]""
SET BPSDATA(1,2023,1)=$$NFF^BPSECFM(BPSX,8)
SET BPSDATA(1,338,1)="01"
+111 ; RESPONSE INTERMEDIARY AUTHORIZATION TYPE ID and associated fields
+112 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.07,"I")
+113 IF BPSX]""
SET BPSDATA(1,2053,1)=$$NFF^BPSECFM(BPSX,2)
SET BPSDATA(1,2052)=1
+114 ; RESPONSE INTERMEDIARY AUTHORIZATION ID and associated fields
+115 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.08,"I")
+116 IF BPSX]""
SET BPSDATA(1,2054,1)=$$ANFF^BPSECFM(BPSX,20)
SET BPSDATA(1,2052)=1
+117 ; INTERMEDIARY MESSAGE and associated fields
+118 SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",3.01,"I")
+119 IF BPSX]""
SET BPSDATA(1,2051,1)=$$ANFF^BPSECFM(BPSX,200)
SET BPSDATA(1,2052)=1
+120 ; (BPS*1*22)
+121 ; B98-34 reconciliation id
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.09,"I")
+122 IF BPSX]""
SET BPSDATA(1,2098)=$$ANFF^BPSECFM(BPSX,30)
+123 ;
+124 ; 439-E4 reason for service code
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",2.11,"E")
+125 IF BPSX]""
SET BPSDATA(1,439,1)=$$ANFF^BPSECFM(BPSX,4)
SET BPSDATA(1,567,1)=1
+126 ;
+127 ; 931-F8 maximum age qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.01,"I")
+128 IF BPSX]""
SET BPSDATA(1,931)=$$ANFF^BPSECFM(BPSX,1)
+129 ; 932-GA maximum age
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.02,"I")
+130 IF BPSX]""
SET BPSDATA(1,932)=$$NFF^BPSECFM(BPSX,3)
+131 ; 933-GB maximum amount
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.03,"I")
+132 IF BPSX]""
SET BPSDATA(1,933)=$$NFF^BPSECFM(BPSX,10)
+133 ; 934-GC maximum amt qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.04,"I")
+134 IF BPSX]""
SET BPSDATA(1,934)=$$ANFF^BPSECFM(BPSX,2)
+135 ; 935-GF maximum amt time period
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.05,"I")
+136 IF BPSX]""
SET BPSDATA(1,935)=$$ANFF^BPSECFM(BPSX,2)
+137 ; 936-GG maximum amt time period start date
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.06,"I")
+138 IF BPSX]""
SET BPSDATA(1,936)=$$DTF1^BPSECFM(BPSX)
+139 ; 937-GH maximum amt time period end date
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.07,"I")
+140 IF BPSX]""
SET BPSDATA(1,937)=$$DTF1^BPSECFM(BPSX)
+141 ; 938-GJ maximum amt time period units
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.08,"I")
+142 IF BPSX]""
SET BPSDATA(1,938)=$$NFF^BPSECFM(BPSX,4)
+143 ; 943-GQ minimum age qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.09,"I")
+144 IF BPSX]""
SET BPSDATA(1,943)=$$ANFF^BPSECFM(BPSX,1)
+145 ; 944-GR minimum age
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.1,"I")
+146 IF BPSX]""
SET BPSDATA(1,944)=$$NFF^BPSECFM(BPSX,3)
+147 ; C47-9T other payer adjudicate prog type
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.11,"I")
+148 IF BPSX]""
SET BPSDATA(1,2147)=$$ANFF^BPSECFM(BPSX,30)
+149 ; C93-KN patient pay component amount
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.12,"I")
+150 IF BPSX]""
SET BPSDATA(1,2193)=$$DFF^BPSECFM(BPSX,8)
+151 ; C94-KP patient pay component count
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.13,"I")
+152 IF BPSX]""
SET BPSDATA(1,2194)=$$NFF^BPSECFM(BPSX,4)
+153 ; C95-KQ patient payer component qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.14,"I")
+154 IF BPSX]""
SET BPSDATA(1,2195)=$$ANFF^BPSECFM(BPSX,2)
+155 ; D19-M1 minimum amount
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.15,"I")
+156 IF BPSX]""
SET BPSDATA(1,2219)=$$NFF^BPSECFM(BPSX,10)
+157 ; D20-M2 minimum amount qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.16,"I")
+158 IF BPSX]""
SET BPSDATA(1,2220)=$$ANFF^BPSECFM(BPSX,3)
+159 ; D23-M5 other payer name
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.17,"I")
+160 IF BPSX]""
SET BPSDATA(1,2223)=$$ANFF^BPSECFM(BPSX,30)
+161 ; D24-M6 remaining amount
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.18,"I")
+162 IF BPSX]""
SET BPSDATA(1,2224)=$$NFF^BPSECFM(BPSX,10)
+163 ; D25-M7 remaining amount qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.19,"I")
+164 IF BPSX]""
SET BPSDATA(1,2225)=$$ANFF^BPSECFM(BPSX,3)
+165 ; D41-PA other payer relationship type
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",4.2,"I")
+166 IF BPSX]""
SET BPSDATA(1,2241)=$$ANFF^BPSECFM(BPSX,3)
+167 ;
+168 ; E87-ZV invalid provider data source
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.01,"I")
+169 IF BPSX]""
SET BPSDATA(1,2387)=$$ANFF^BPSECFM(BPSX,2)
+170 ; E89-ZO formulary alternative eff date
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.02,"I")
+171 IF BPSX]""
SET BPSDATA(1,2389)=$$DTF1^BPSECFM(BPSX)
+172 ; E93-ZC dur/due co-agent description
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.03,"I")
+173 IF BPSX]""
SET BPSDATA(1,2393)=$$ANFF^BPSECFM(BPSX,40)
+174 ; E94-ZA unit of prior dispensed qty
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.04,"I")
+175 IF BPSX]""
SET BPSDATA(1,2394)=$$ANFF^BPSECFM(BPSX,3)
+176 ; E95-Z9 other pharmacy id qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.05,"I")
+177 IF BPSX]""
SET BPSDATA(1,2395)=$$ANFF^BPSECFM(BPSX,2)
+178 ; E97-Z7 other pharmacy name
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.06,"I")
+179 IF BPSX]""
SET BPSDATA(1,2397)=$$ANFF^BPSECFM(BPSX,70)
+180 ; E98-Z6 other pharmacy telephone
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.07,"I")
+181 IF BPSX]""
SET BPSDATA(1,2398)=$$NFF^BPSECFM(BPSX,10)
+182 ; E99-Z5 other prescriber last name
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.08,"I")
+183 IF BPSX]""
SET BPSDATA(1,2399)=$$ANFF^BPSECFM(BPSX,35)
+184 ; F01-Z4 other prescriber id qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.09,"I")
+185 IF BPSX]""
SET BPSDATA(1,2401)=$$ANFF^BPSECFM(BPSX,2)
+186 ; F02-Z3 other prescriber id
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.10,"I")
+187 IF BPSX]""
SET BPSDATA(1,2402)=$$ANFF^BPSECFM(BPSX,35)
+188 ; F03-Z2 other prescriber phone number
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.11,"I")
+189 IF BPSX]""
SET BPSDATA(1,2403)=$$NFF^BPSECFM(BPSX,10)
+190 ; F04-Z1 dur/due compound product id
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.12,"I")
+191 IF BPSX]""
SET BPSDATA(1,2404)=$$ANFF^BPSECFM(BPSX,40)
+192 ; F05-Z0 dur/due compound product id qualifier
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.13,"I")
+193 IF BPSX]""
SET BPSDATA(1,2405)=$$ANFF^BPSECFM(BPSX,2)
+194 ; F06-YO dur/due maximum daily dose qty
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.14,"I")
+195 IF BPSX]""
SET BPSDATA(1,2406)=$$NFF^BPSECFM(BPSX,10)
+196 ; F07-YL dur/due max daily dose - unit
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.15,"I")
+197 IF BPSX]""
SET BPSDATA(1,2407)=$$ANFF^BPSECFM(BPSX,3)
+198 ; F08-YJ dur/due minimum daily dose qty
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.16,"I")
+199 IF BPSX]""
SET BPSDATA(1,2408)=$$NFF^BPSECFM(BPSX,10)
+200 ; F09-YI dur/due min daily dose - unit
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",5.17,"I")
+201 IF BPSX]""
SET BPSDATA(1,2409)=$$ANFF^BPSECFM(BPSX,3)
+202 ;
+203 ; E7 overrides (BPS*1*20)
+204 ; B88-3R quantity limit per spec time period
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.11,"I")
IF BPSX'=""
Begin DoDot:4
+205 ; count field
SET BPSDATA(1,2087)=1
+206 ; data from override file
SET BPSDATA(1,2088,1)=$$NFF^BPSECFM(BPSX,10)
+207 QUIT
End DoDot:4
+208 ; B89-3S quantity limit time period
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.12,"I")
IF BPSX'=""
Begin DoDot:4
+209 ; count field
SET BPSDATA(1,2087)=1
+210 ; data from override file
SET BPSDATA(1,2089,1)=$$NFF^BPSECFM(BPSX,5)
+211 QUIT
End DoDot:4
+212 ; B91-3W days supply limit per spec time period
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.13,"I")
IF BPSX'=""
Begin DoDot:4
+213 ; count field
SET BPSDATA(1,2090)=1
+214 ; data from override file
SET BPSDATA(1,2091,1)=$$NFF^BPSECFM(BPSX,3)
+215 QUIT
End DoDot:4
+216 ; B92-3X days supply limit time period
SET BPSX=$$GET1^DIQ(9002313.32,BPSTIEN_",",.14,"I")
IF BPSX'=""
Begin DoDot:4
+217 ; count field
SET BPSDATA(1,2090)=1
+218 ; data from override file
SET BPSDATA(1,2092,1)=$$NFF^BPSECFM(BPSX,5)
+219 QUIT
End DoDot:4
+220 QUIT
End DoDot:3
+221 ;
+222 ; If rejected, get the rejection code and file them
+223 ; Also, delete the BPSPAID amount
+224 IF BPSSRESP="R"
Begin DoDot:3
+225 ; Delete old rejections and BPSPAID amount
+226 KILL BPSDATA(1,509),BPSDATA(1,511)
+227 ; Loop through rejections and store
+228 SET BPSRCNT=0
+229 SET BPSRIEN=0
FOR
SET BPSRIEN=$ORDER(^BPS(9002313.32,BPSTIEN,1,BPSRIEN))
if +BPSRIEN=0
QUIT
Begin DoDot:4
+230 SET BPSRCODE=$PIECE($GET(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1)
+231 ; Increment counter and store
+232 IF BPSRCODE]""
Begin DoDot:5
+233 SET BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E")
+234 IF BPSRCD]""
SET BPSRCNT=BPSRCNT+1
SET BPSDATA(1,511,BPSRCNT)=BPSRCD
End DoDot:5
End DoDot:4
+235 ; Store total number of rejections
+236 SET BPSDATA(1,510)=BPSRCNT
End DoDot:3
End DoDot:2
End DoDot:1
+237 ;
+238 QUIT
