source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSNCPD2.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1BPSNCPD2 ;BHAM ISC/LJE - Continuation of BPSNCPDP (IB Billing Determiation) ;08/01/03
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 ;External reference $$RX^IBNCPDP supported by DBIA 4299
5 ;
6 ;
7 ; EN - Call IB Billing Determination. If good to go, update MOREDATA array
8 ; Notes about variables
9 ;input:
10 ; DFN - PATIENT file #2 ien
11 ; BWHERE - shows where the code is called from and what needs to be done
12 ; the following should be passed by reference:
13 ; MOREDATA - Initialized by BPSNCPDP and more data is added here
14 ; BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination
15 ; IB - Returned to BPSNCPDP
16 ; CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP
17 ;
18EN(DFN,BWHERE,MOREDATA,BPSARRY,IB) ;
19 I '$G(CERTIEN) D I IB=2 Q
20 . ;
21 . ;For NCPDP IB call to see if we need to 3rd Party Bill and if so, get insurance/payer sheet info
22 . S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;IB CALL
23 . Q:'$D(MOREDATA("BILL"))
24 . ;
25 . ; If calling program is the ECME user screen and we can't bill because of NEEDS SC DETERMINATION
26 . ; or EI, then prompt the user to see if they want to bill
27 . I BWHERE="ERES",$P(MOREDATA("BILL"),U,1)=0,$G(BPSARRY("SC/EI NO ANSW"))]"" D
28 .. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,I,BPEISC
29 .. F I=1:1:$L($G(BPSARRY("SC/EI NO ANSW")),",") S BPEISC=$P($G(BPSARRY("SC/EI NO ANSW")),",",I) I BPEISC]"" D
30 ... W !,"The prescription is potentially ",BPEISC,"-related and needs ",BPEISC," determination."
31 ... W !,"Prescriptions related to ",BPEISC," cannot be billed to Third Party Insurance.",!
32 .. S DIR(0)="Y",DIR("A")="Are you sure you want to bill this prescription"
33 .. S DIR("B")="NO"
34 .. S DIR("?")="If you want to bill this prescription, enter 'Yes' - otherwise, enter 'No'"
35 .. W ! D ^DIR K DIR
36 .. I '+Y Q
37 .. S BPSARRY("SC/EI OVR")=1
38 .. S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;Call IB again
39 . ;
40 . ; Quit if no response from IB call
41 . Q:'$D(MOREDATA("BILL"))
42 . I $P(MOREDATA("BILL"),U,1)=0 S IB=2 Q ;IB says not to bill
43 . S IB=1
44 . M MOREDATA("IBDATA")=BPSARRY("INS")
45 . S $P(MOREDATA("BPSDATA",1),U,1)=BPSARRY("QTY")
46 . S $P(MOREDATA("BPSDATA",1),U,2)=BPSARRY("COST")
47 . S $P(MOREDATA("BPSDATA",1),U,3)=BPSARRY("NDC")
48 . S $P(MOREDATA("BPSDATA",1),U,4)=BFILL
49 . S $P(MOREDATA("BPSDATA",1),U,5)="" ; Certify Mode
50 . S $P(MOREDATA("BPSDATA",1),U,6)="" ; Cert IEN
51 . S $P(MOREDATA("BPSDATA",1),U,7)=BPSARRY("UNITS")
52 ;
53 ; If certification mode on and no IB result (somewhat redundant since IB is not called
54 ; for certification), get data from BPS Certification table
55 I $G(CERTIEN),'$G(IB) D
56 . N NODE,FLD,NFLD,CERTARY
57 . S MOREDATA("BILL")=1
58 . S MOREDATA("IBDATA",1,1)="",MOREDATA("IBDATA",1,2)="",MOREDATA("BPSDATA",1)=""
59 . S $P(MOREDATA("BPSDATA",1),U,5)=1 ;Certify Mode
60 . S $P(MOREDATA("BPSDATA",1),U,6)=CERTIEN ;Cert IEN
61 . S $P(MOREDATA("IBDATA",1,1),U,1)=1 ;Plan IEN
62 . S $P(MOREDATA("IBDATA",1,1),U,4)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"E") ;Payer Sheet
63 . S $P(MOREDATA("IBDATA",1,1),U,10)="01" ;Home State Plan
64 . S $P(MOREDATA("IBDATA",1,1),U,11)="" ;B2 Payer Sheet (reversal)
65 . S $P(MOREDATA("IBDATA",1,1),U,12)="" ;B3 Payer Sheet (rebill)
66 . S $P(MOREDATA("IBDATA",1,1),U,14)="" ;Plan Name
67 . S $P(MOREDATA("IBDATA",1,2),U,5)=0 ;Admin Fee
68 . ;
69 . ;Get data from non-mulitple fields and add to MOREDATA
70 . K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","1*","","CERTARY")
71 . S NODE="" F S NODE=$O(CERTARY(9002313.311,NODE)) Q:NODE="" D
72 .. S FLD="" F S FLD=$O(CERTARY(9002313.311,NODE,FLD)) Q:FLD="" D
73 ... I FLD=.01 S NFLD=CERTARY(9002313.311,NODE,FLD) D
74 .... I NFLD=101 S $P(MOREDATA("IBDATA",1,1),U,2)=CERTARY(9002313.311,NODE,.02) ;BIN
75 .... I NFLD=104 S $P(MOREDATA("IBDATA",1,1),U,3)=CERTARY(9002313.311,NODE,.02) ;PCN
76 .... I NFLD=110 S $P(MOREDATA("IBDATA",1,1),U,13)=CERTARY(9002313.311,NODE,.02) ;Certification ID
77 . ;
78 . ;Get data from mulitple fields and add to MOREDATA
79 . K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","2*","","CERTARY")
80 . S NODE="" F S NODE=$O(CERTARY(9002313.3121,NODE)) Q:NODE="" D
81 .. S FLD="" F S FLD=$O(CERTARY(9002313.3121,NODE,FLD)) Q:FLD="" D
82 ... I FLD=.01 S NFLD=CERTARY(9002313.3121,NODE,FLD) D
83 .... I NFLD=301 S $P(MOREDATA("IBDATA",1,1),U,5)=CERTARY(9002313.3121,NODE,.02) ;Group ID
84 .... I NFLD=302 S $P(MOREDATA("IBDATA",1,1),U,6)=CERTARY(9002313.3121,NODE,.02) ;Cardholder ID
85 .... I NFLD=306 S $P(MOREDATA("IBDATA",1,1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Patient Rel Code
86 .... I NFLD=312 S $P(MOREDATA("IBDATA",1,1),U,8)=CERTARY(9002313.3121,NODE,.02) ;Cardholder First Name
87 .... I NFLD=313 S $P(MOREDATA("IBDATA",1,1),U,9)=CERTARY(9002313.3121,NODE,.02) ;Cardholder Last Name
88 .... I NFLD=412 S $P(MOREDATA("IBDATA",1,2),U,1)=CERTARY(9002313.3121,NODE,.02) ;Dispensing Fee
89 .... I NFLD=423 S $P(MOREDATA("IBDATA",1,2),U,2)=CERTARY(9002313.3121,NODE,.02) ;Basis of Cost Determination
90 .... I NFLD=426 S $P(MOREDATA("IBDATA",1,2),U,3)=CERTARY(9002313.3121,NODE,.02) ;Usual & Customary - Base Price
91 .... I NFLD=430 S $P(MOREDATA("IBDATA",1,2),U,4)=CERTARY(9002313.3121,NODE,.02) ;Gross Amt Due
92 .... I NFLD=442 S $P(MOREDATA("BPSDATA",1),U,1)=CERTARY(9002313.3121,NODE,.02) ;Qty
93 .... I NFLD=409 S $P(MOREDATA("BPSDATA",1),U,2)=CERTARY(9002313.3121,NODE,.02) ;Unit Cost
94 .... I NFLD=407 S $P(MOREDATA("BPSDATA",1),U,3)=CERTARY(9002313.3121,NODE,.02) ;NDC
95 .... I NFLD=403 S $P(MOREDATA("BPSDATA",1),U,4)=CERTARY(9002313.3121,NODE,.02) ;Fill #
96 .... I NFLD=600 S $P(MOREDATA("BPSDATA",1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Unit of Measure
97 . ;
98 . ; If Gross Amt Due is missing, use Usual and Customary
99 . I $P(MOREDATA("IBDATA",1,2),U,4)="" S $P(MOREDATA("IBDATA",1,2),U,4)=$P(MOREDATA("IBDATA",1,2),U,3)
100 ;
101 ; The code below checks if Sequence one is missing and move the next number down if needed.
102 ; DMB - This is existing code so I am not sure if it is needed or not.
103 I '$D(MOREDATA("IBDATA",1)) D
104 . N WW
105 . S WW=$O(MOREDATA("IBDATA",""))
106 . I WW'="" M MOREDATA("IBDATA",1)=MOREDATA("IBDATA",WW) K MOREDATA("IBDATA",WW)
107 ;
108 ; Uppercase the IBDATA
109 ; DMB - Assume this was adding in case any of the BPS Certification data was entered as lowercase
110 S MOREDATA("IBDATA",1,1)=$TR(MOREDATA("IBDATA",1,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
111 S MOREDATA("IBDATA",1,2)=$TR(MOREDATA("IBDATA",1,2),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
112 S MOREDATA("BPSDATA",1)=$TR(MOREDATA("BPSDATA",1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
113 ;
114 Q
Note: See TracBrowser for help on using the repository browser.