KIDS Distribution saved on Aug 30, 2011@18:39:44 BPS PSO IB PRCA BUNDLE 6.0 **KIDS**:BPS PSO IB PRCA BUNDLE 6.0^BPS*1.0*10^PSO*7.0*359^IB*2.0*435^PRCA*4.5*271^ **INSTALL NAME** BPS PSO IB PRCA BUNDLE 6.0 "BLD",8310,0) BPS PSO IB PRCA BUNDLE 6.0^^1^3110830^n "BLD",8310,1,0) ^^1^1^3101103^ "BLD",8310,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "BLD",8310,6.3) 27 "BLD",8310,10,0) ^9.63^4^4 "BLD",8310,10,1,0) BPS*1.0*10^1 "BLD",8310,10,2,0) PSO*7.0*359^1 "BLD",8310,10,3,0) IB*2.0*435^1 "BLD",8310,10,4,0) PRCA*4.5*271^1 "BLD",8310,10,"B","BPS*1.0*10",1) "BLD",8310,10,"B","IB*2.0*435",3) "BLD",8310,10,"B","PRCA*4.5*271",4) "BLD",8310,10,"B","PSO*7.0*359",2) "BLD",8310,"KRN",0) ^9.67PA^779.2^20 "BLD",8310,"KRN",.4,0) .4 "BLD",8310,"KRN",.401,0) .401 "BLD",8310,"KRN",.402,0) .402 "BLD",8310,"KRN",.403,0) .403 "BLD",8310,"KRN",.5,0) .5 "BLD",8310,"KRN",.84,0) .84 "BLD",8310,"KRN",3.6,0) 3.6 "BLD",8310,"KRN",3.8,0) 3.8 "BLD",8310,"KRN",9.2,0) 9.2 "BLD",8310,"KRN",9.8,0) 9.8 "BLD",8310,"KRN",19,0) 19 "BLD",8310,"KRN",19.1,0) 19.1 "BLD",8310,"KRN",101,0) 101 "BLD",8310,"KRN",409.61,0) 409.61 "BLD",8310,"KRN",771,0) 771 "BLD",8310,"KRN",779.2,0) 779.2 "BLD",8310,"KRN",870,0) 870 "BLD",8310,"KRN",8989.51,0) 8989.51 "BLD",8310,"KRN",8989.52,0) 8989.52 "BLD",8310,"KRN",8994,0) 8994 "BLD",8310,"KRN","B",.4,.4) "BLD",8310,"KRN","B",.401,.401) "BLD",8310,"KRN","B",.402,.402) "BLD",8310,"KRN","B",.403,.403) "BLD",8310,"KRN","B",.5,.5) "BLD",8310,"KRN","B",.84,.84) "BLD",8310,"KRN","B",3.6,3.6) "BLD",8310,"KRN","B",3.8,3.8) "BLD",8310,"KRN","B",9.2,9.2) "BLD",8310,"KRN","B",9.8,9.8) "BLD",8310,"KRN","B",19,19) "BLD",8310,"KRN","B",19.1,19.1) "BLD",8310,"KRN","B",101,101) "BLD",8310,"KRN","B",409.61,409.61) "BLD",8310,"KRN","B",771,771) "BLD",8310,"KRN","B",779.2,779.2) "BLD",8310,"KRN","B",870,870) "BLD",8310,"KRN","B",8989.51,8989.51) "BLD",8310,"KRN","B",8989.52,8989.52) "BLD",8310,"KRN","B",8994,8994) "MBREQ") 0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "VER") 8.0^22.0 **INSTALL NAME** BPS*1.0*10 "BLD",8104,0) BPS*1.0*10^E CLAIMS MGMT ENGINE^0^3110830^y "BLD",8104,1,0) ^^1^1^3110504^ "BLD",8104,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "BLD",8104,4,0) ^9.64PA^9002313.15^24 "BLD",8104,4,9002313.02,0) 9002313.02 "BLD",8104,4,9002313.02,222) y^y^f^^^^n "BLD",8104,4,9002313.03,0) 9002313.03 "BLD",8104,4,9002313.03,222) y^y^f^^^^n "BLD",8104,4,9002313.15,0) 9002313.15 "BLD",8104,4,9002313.15,2,0) ^9.641^9002313.15^1 "BLD",8104,4,9002313.15,2,9002313.15,0) BPS ASLEEP PAYERS (File-top level) "BLD",8104,4,9002313.15,2,9002313.15,1,0) ^9.6411^.04^1 "BLD",8104,4,9002313.15,2,9002313.15,1,.04,0) PROBER CLAIM "BLD",8104,4,9002313.15,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.15,224) "BLD",8104,4,9002313.19,0) 9002313.19 "BLD",8104,4,9002313.19,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.21,0) 9002313.21 "BLD",8104,4,9002313.21,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.22,0) 9002313.22 "BLD",8104,4,9002313.22,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.23,0) 9002313.23 "BLD",8104,4,9002313.23,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.24,0) 9002313.24 "BLD",8104,4,9002313.24,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.26,0) 9002313.26 "BLD",8104,4,9002313.26,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.27,0) 9002313.27 "BLD",8104,4,9002313.27,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.28,0) 9002313.28 "BLD",8104,4,9002313.28,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.29,0) 9002313.29 "BLD",8104,4,9002313.29,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.31,0) 9002313.31 "BLD",8104,4,9002313.31,2,0) ^9.641^9002313.3124^8 "BLD",8104,4,9002313.31,2,9002313.31,0) BPS CERTIFICATION (File-top level) "BLD",8104,4,9002313.31,2,9002313.31,1,0) ^9.6411^.08^5 "BLD",8104,4,9002313.31,2,9002313.31,1,.04,0) BILLING PAYER SHEET "BLD",8104,4,9002313.31,2,9002313.31,1,.05,0) REVERSAL PAYER SHEET "BLD",8104,4,9002313.31,2,9002313.31,1,.06,0) MAX CLAIMS PER TRANSMISSION "BLD",8104,4,9002313.31,2,9002313.31,1,.07,0) COB INDICATOR "BLD",8104,4,9002313.31,2,9002313.31,1,.08,0) ELIGIBILITY PAYER SHEET "BLD",8104,4,9002313.31,2,9002313.3122,0) SUB CLARIFICATION CODE MULT (sub-file) "BLD",8104,4,9002313.31,2,9002313.3122,1,0) ^9.6411^^0 "BLD",8104,4,9002313.31,2,9002313.3123,0) COB MULTIPLE (sub-file) "BLD",8104,4,9002313.31,2,9002313.3123,1,0) ^9.6411^^0 "BLD",8104,4,9002313.31,2,9002313.31231,0) OTHER PAYER AMT PAID MULTIPLE (sub-file) "BLD",8104,4,9002313.31,2,9002313.31231,1,0) ^9.6411^^0 "BLD",8104,4,9002313.31,2,9002313.31232,0) OTHER PAYER REJECT MULTIPLE (sub-file) "BLD",8104,4,9002313.31,2,9002313.31232,1,0) ^9.6411^^0 "BLD",8104,4,9002313.31,2,9002313.31233,0) OTHER PAYER PATIENT RESP MULT (sub-file) "BLD",8104,4,9002313.31,2,9002313.31233,1,0) ^9.6411^^0 "BLD",8104,4,9002313.31,2,9002313.31234,0) BENEFIT STAGE MULT (sub-file) "BLD",8104,4,9002313.31,2,9002313.31234,1,0) ^9.6411^^ "BLD",8104,4,9002313.31,2,9002313.3124,0) OTHER AMT CLAIMED MULT (sub-file) "BLD",8104,4,9002313.31,2,9002313.3124,1,0) ^9.6411^^ "BLD",8104,4,9002313.31,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.31,224) "BLD",8104,4,9002313.32,0) 9002313.32 "BLD",8104,4,9002313.32,2,0) ^9.641^9002313.32^1 "BLD",8104,4,9002313.32,2,9002313.32,0) BPS PAYER RESPONSE OVERRIDES (File-top level) "BLD",8104,4,9002313.32,2,9002313.32,1,0) ^9.6411^.02^2 "BLD",8104,4,9002313.32,2,9002313.32,1,.02,0) TYPE "BLD",8104,4,9002313.32,2,9002313.32,1,.08,0) ELIGIBILITY RESPONSE "BLD",8104,4,9002313.32,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.32,224) "BLD",8104,4,9002313.57,0) 9002313.57 "BLD",8104,4,9002313.57,2,0) ^9.641^9002313.57902^2 "BLD",8104,4,9002313.57,2,9002313.57,0) BPS LOG OF TRANSACTIONS (File-top level) "BLD",8104,4,9002313.57,2,9002313.57,1,0) ^9.6411^19^3 "BLD",8104,4,9002313.57,2,9002313.57,1,1.05,0) POLICY NUMBER "BLD",8104,4,9002313.57,2,9002313.57,1,19,0) TRANSACTION TYPE "BLD",8104,4,9002313.57,2,9002313.57,1,1201,0) RX ACTION "BLD",8104,4,9002313.57,2,9002313.57902,0) PATIENT INSURANCE MULTIPLE (sub-file) "BLD",8104,4,9002313.57,2,9002313.57902,1,0) ^9.6411^902.36^5 "BLD",8104,4,9002313.57,2,9002313.57902,1,902.02,0) B1 PAYER SHEET "BLD",8104,4,9002313.57,2,9002313.57902,1,902.21,0) B3 PAYER SHEET "BLD",8104,4,9002313.57,2,9002313.57902,1,902.34,0) E1 PAYER SHEET "BLD",8104,4,9002313.57,2,9002313.57902,1,902.35,0) POLICY NUMBER "BLD",8104,4,9002313.57,2,9002313.57902,1,902.36,0) MAXIMUM NCPDP TRANSACTIONS "BLD",8104,4,9002313.57,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.57,224) "BLD",8104,4,9002313.58,0) 9002313.58 "BLD",8104,4,9002313.58,2,0) ^9.641^9002313.58^1 "BLD",8104,4,9002313.58,2,9002313.58,0) BPS STATISTICS (File-top level) "BLD",8104,4,9002313.58,2,9002313.58,1,0) ^9.6411^210^2 "BLD",8104,4,9002313.58,2,9002313.58,1,209,0) RESULT - ELIGIBILITY ACCEPTED "BLD",8104,4,9002313.58,2,9002313.58,1,210,0) RESULT - ELIGIBILITY REJECTED "BLD",8104,4,9002313.58,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.58,224) "BLD",8104,4,9002313.59,0) 9002313.59 "BLD",8104,4,9002313.59,2,0) ^9.641^9002313.59902^2 "BLD",8104,4,9002313.59,2,9002313.59,0) BPS TRANSACTION (File-top level) "BLD",8104,4,9002313.59,2,9002313.59,1,0) ^9.6411^19^3 "BLD",8104,4,9002313.59,2,9002313.59,1,1.05,0) POLICY NUMBER "BLD",8104,4,9002313.59,2,9002313.59,1,19,0) TRANSACTION TYPE "BLD",8104,4,9002313.59,2,9002313.59,1,1201,0) RX ACTION "BLD",8104,4,9002313.59,2,9002313.59902,0) PATIENT INSURANCE MULTIPLE (sub-file) "BLD",8104,4,9002313.59,2,9002313.59902,1,0) ^9.6411^902.36^5 "BLD",8104,4,9002313.59,2,9002313.59902,1,902.02,0) B1 PAYER SHEET "BLD",8104,4,9002313.59,2,9002313.59902,1,902.21,0) B3 PAYER SHEET "BLD",8104,4,9002313.59,2,9002313.59902,1,902.34,0) E1 PAYER SHEET "BLD",8104,4,9002313.59,2,9002313.59902,1,902.35,0) POLICY NUMBER "BLD",8104,4,9002313.59,2,9002313.59902,1,902.36,0) MAXIMUM NCPDP TRANSACTIONS "BLD",8104,4,9002313.59,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.59,224) "BLD",8104,4,9002313.77,0) 9002313.77 "BLD",8104,4,9002313.77,2,0) ^9.641^9002313.77^1 "BLD",8104,4,9002313.77,2,9002313.77,0) BPS REQUESTS (File-top level) "BLD",8104,4,9002313.77,2,9002313.77,1,0) ^9.6411^2.05^14 "BLD",8104,4,9002313.77,2,9002313.77,1,.01,0) KEY1 "BLD",8104,4,9002313.77,2,9002313.77,1,.02,0) KEY2 "BLD",8104,4,9002313.77,2,9002313.77,1,.06,0) ECME TRANSACTION RECORD "BLD",8104,4,9002313.77,2,9002313.77,1,1.01,0) RX ACTION "BLD",8104,4,9002313.77,2,9002313.77,1,1.02,0) OUTPATIENT SITE "BLD",8104,4,9002313.77,2,9002313.77,1,1.04,0) TRANSACTION TYPE "BLD",8104,4,9002313.77,2,9002313.77,1,1.13,0) RX NUMBER "BLD",8104,4,9002313.77,2,9002313.77,1,1.14,0) FILL NO "BLD",8104,4,9002313.77,2,9002313.77,1,1.15,0) PATIENT "BLD",8104,4,9002313.77,2,9002313.77,1,1.16,0) POLICY NUMBER "BLD",8104,4,9002313.77,2,9002313.77,1,2.01,0) DATE OF SERVICE "BLD",8104,4,9002313.77,2,9002313.77,1,2.05,0) CLARIFICATION CODE "BLD",8104,4,9002313.77,2,9002313.77,1,2.1,0) DELAY REASON CODE "BLD",8104,4,9002313.77,2,9002313.77,1,9.01,0) INACTIVATION REASON "BLD",8104,4,9002313.77,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.77,224) "BLD",8104,4,9002313.78,0) 9002313.78 "BLD",8104,4,9002313.78,2,0) ^9.641^9002313.78^1 "BLD",8104,4,9002313.78,2,9002313.78,0) BPS INSURER DATA (File-top level) "BLD",8104,4,9002313.78,2,9002313.78,1,0) ^9.6411^2.07^9 "BLD",8104,4,9002313.78,2,9002313.78,1,.01,0) TRANSACTION ID "BLD",8104,4,9002313.78,2,9002313.78,1,.02,0) B1 PAYER SHEET "BLD",8104,4,9002313.78,2,9002313.78,1,.04,0) B3 PAYER SHEET "BLD",8104,4,9002313.78,2,9002313.78,1,.1,0) E1 PAYER SHEET "BLD",8104,4,9002313.78,2,9002313.78,1,.11,0) POLICY NUMBER "BLD",8104,4,9002313.78,2,9002313.78,1,2.07,0) MAXIMUM NCPDP TRANSACTIONS "BLD",8104,4,9002313.78,2,9002313.78,1,4.01,0) B1 PAYER SHEET NAME "BLD",8104,4,9002313.78,2,9002313.78,1,4.03,0) B3 PAYER SHEET NAME "BLD",8104,4,9002313.78,2,9002313.78,1,4.04,0) E1 PAYER SHEET NAME "BLD",8104,4,9002313.78,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.78,224) "BLD",8104,4,9002313.91,0) 9002313.91 "BLD",8104,4,9002313.91,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.92,0) 9002313.92 "BLD",8104,4,9002313.92,2,0) ^9.641^9002313.9225^18 "BLD",8104,4,9002313.92,2,9002313.92,0) BPS NCPDP FORMATS (File-top level) "BLD",8104,4,9002313.92,2,9002313.92,1,0) ^9.6411^1.02^1 "BLD",8104,4,9002313.92,2,9002313.92,1,1.02,0) VERSION "BLD",8104,4,9002313.92,2,9002313.9205,0) TRANSACTION HEADER SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9205,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9205,1,.01,0) TRANSACTION HEADER ORDER "BLD",8104,4,9002313.92,2,9002313.9205,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9206,0) PATIENT SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9206,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9206,1,.01,0) PATIENT SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9206,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9207,0) INSURANCE SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9207,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9207,1,.01,0) INSURANCE SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9207,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9208,0) CLAIM SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9208,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9208,1,.01,0) CLAIM SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9208,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9209,0) PHARMACY PROVIDER SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9209,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9209,1,.01,0) PHARMACY PROVIDER ORDER "BLD",8104,4,9002313.92,2,9002313.9209,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.921,0) PRESCRIBER SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.921,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.921,1,.01,0) PRESCRIBER SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.921,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9213,0) COB OTHER PAYMENTS SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9213,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9213,1,.01,0) COB OTHER PAYMENTS ORDER "BLD",8104,4,9002313.92,2,9002313.9213,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9214,0) WORKERS COMP SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9214,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9214,1,.01,0) WORKERS COMP SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9214,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9215,0) DUR PPS SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9215,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9215,1,.01,0) DUR PPS SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9215,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9216,0) PRICING SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9216,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9216,1,.01,0) PRICING SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9216,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9217,0) COUPON SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9217,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9217,1,.01,0) COUPON SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9217,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9218,0) COMPOUND SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9218,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9218,1,.01,0) COMPOUND SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9218,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9219,0) PRIOR AUTH SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9219,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.9219,1,.01,0) PRIOR AUTH SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.9219,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.922,0) CLINICAL SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.922,1,0) ^9.6411^1^2 "BLD",8104,4,9002313.92,2,9002313.922,1,.01,0) CLINICAL SEGMENT ORDER "BLD",8104,4,9002313.92,2,9002313.922,1,1,0) SPECIAL CODE "BLD",8104,4,9002313.92,2,9002313.9223,0) ADDL DOC SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9223,1,0) ^9.6411^^ "BLD",8104,4,9002313.92,2,9002313.9224,0) FACILITY SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9224,1,0) ^9.6411^^ "BLD",8104,4,9002313.92,2,9002313.9225,0) NARRATIVE SEGMENT (sub-file) "BLD",8104,4,9002313.92,2,9002313.9225,1,0) ^9.6411^^ "BLD",8104,4,9002313.92,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.92,224) "BLD",8104,4,9002313.93,0) 9002313.93 "BLD",8104,4,9002313.93,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.94,0) 9002313.94 "BLD",8104,4,9002313.94,222) y^y^f^^n^^y^o^n "BLD",8104,4,9002313.99,0) 9002313.99 "BLD",8104,4,9002313.99,2,0) ^9.641^9002313.99^1 "BLD",8104,4,9002313.99,2,9002313.99,0) BPS SETUP (File-top level) "BLD",8104,4,9002313.99,2,9002313.99,1,0) ^9.6411^.08^1 "BLD",8104,4,9002313.99,2,9002313.99,1,.08,0) DEFAULT ELIGIBILITY PHARMACY "BLD",8104,4,9002313.99,222) y^y^p^^^^n^^n "BLD",8104,4,9002313.99,224) "BLD",8104,4,"APDD",9002313.15,9002313.15) "BLD",8104,4,"APDD",9002313.15,9002313.15,.04) "BLD",8104,4,"APDD",9002313.31,9002313.31) "BLD",8104,4,"APDD",9002313.31,9002313.31,.04) "BLD",8104,4,"APDD",9002313.31,9002313.31,.05) "BLD",8104,4,"APDD",9002313.31,9002313.31,.06) "BLD",8104,4,"APDD",9002313.31,9002313.31,.07) "BLD",8104,4,"APDD",9002313.31,9002313.31,.08) "BLD",8104,4,"APDD",9002313.31,9002313.3122) "BLD",8104,4,"APDD",9002313.31,9002313.3123) "BLD",8104,4,"APDD",9002313.31,9002313.31231) "BLD",8104,4,"APDD",9002313.31,9002313.31232) "BLD",8104,4,"APDD",9002313.31,9002313.31233) "BLD",8104,4,"APDD",9002313.31,9002313.31234) "BLD",8104,4,"APDD",9002313.31,9002313.3124) "BLD",8104,4,"APDD",9002313.32,9002313.32) "BLD",8104,4,"APDD",9002313.32,9002313.32,.02) "BLD",8104,4,"APDD",9002313.32,9002313.32,.08) "BLD",8104,4,"APDD",9002313.57,9002313.57) "BLD",8104,4,"APDD",9002313.57,9002313.57,1.05) "BLD",8104,4,"APDD",9002313.57,9002313.57,19) "BLD",8104,4,"APDD",9002313.57,9002313.57,1201) "BLD",8104,4,"APDD",9002313.57,9002313.57902) "BLD",8104,4,"APDD",9002313.57,9002313.57902,902.02) "BLD",8104,4,"APDD",9002313.57,9002313.57902,902.21) "BLD",8104,4,"APDD",9002313.57,9002313.57902,902.34) "BLD",8104,4,"APDD",9002313.57,9002313.57902,902.35) "BLD",8104,4,"APDD",9002313.57,9002313.57902,902.36) "BLD",8104,4,"APDD",9002313.58,9002313.58) "BLD",8104,4,"APDD",9002313.58,9002313.58,209) "BLD",8104,4,"APDD",9002313.58,9002313.58,210) "BLD",8104,4,"APDD",9002313.59,9002313.59) "BLD",8104,4,"APDD",9002313.59,9002313.59,1.05) "BLD",8104,4,"APDD",9002313.59,9002313.59,19) "BLD",8104,4,"APDD",9002313.59,9002313.59,1201) "BLD",8104,4,"APDD",9002313.59,9002313.59902) "BLD",8104,4,"APDD",9002313.59,9002313.59902,902.02) "BLD",8104,4,"APDD",9002313.59,9002313.59902,902.21) "BLD",8104,4,"APDD",9002313.59,9002313.59902,902.34) "BLD",8104,4,"APDD",9002313.59,9002313.59902,902.35) "BLD",8104,4,"APDD",9002313.59,9002313.59902,902.36) "BLD",8104,4,"APDD",9002313.77,9002313.77) "BLD",8104,4,"APDD",9002313.77,9002313.77,.01) "BLD",8104,4,"APDD",9002313.77,9002313.77,.02) "BLD",8104,4,"APDD",9002313.77,9002313.77,.06) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.01) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.02) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.04) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.13) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.14) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.15) "BLD",8104,4,"APDD",9002313.77,9002313.77,1.16) "BLD",8104,4,"APDD",9002313.77,9002313.77,2.01) "BLD",8104,4,"APDD",9002313.77,9002313.77,2.05) "BLD",8104,4,"APDD",9002313.77,9002313.77,2.1) "BLD",8104,4,"APDD",9002313.77,9002313.77,9.01) "BLD",8104,4,"APDD",9002313.78,9002313.78) "BLD",8104,4,"APDD",9002313.78,9002313.78,.01) "BLD",8104,4,"APDD",9002313.78,9002313.78,.02) "BLD",8104,4,"APDD",9002313.78,9002313.78,.04) "BLD",8104,4,"APDD",9002313.78,9002313.78,.1) "BLD",8104,4,"APDD",9002313.78,9002313.78,.11) "BLD",8104,4,"APDD",9002313.78,9002313.78,2.07) "BLD",8104,4,"APDD",9002313.78,9002313.78,4.01) "BLD",8104,4,"APDD",9002313.78,9002313.78,4.03) "BLD",8104,4,"APDD",9002313.78,9002313.78,4.04) "BLD",8104,4,"APDD",9002313.92,9002313.92) "BLD",8104,4,"APDD",9002313.92,9002313.92,1.02) "BLD",8104,4,"APDD",9002313.92,9002313.9205) "BLD",8104,4,"APDD",9002313.92,9002313.9205,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9205,1) "BLD",8104,4,"APDD",9002313.92,9002313.9206) "BLD",8104,4,"APDD",9002313.92,9002313.9206,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9206,1) "BLD",8104,4,"APDD",9002313.92,9002313.9207) "BLD",8104,4,"APDD",9002313.92,9002313.9207,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9207,1) "BLD",8104,4,"APDD",9002313.92,9002313.9208) "BLD",8104,4,"APDD",9002313.92,9002313.9208,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9208,1) "BLD",8104,4,"APDD",9002313.92,9002313.9209) "BLD",8104,4,"APDD",9002313.92,9002313.9209,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9209,1) "BLD",8104,4,"APDD",9002313.92,9002313.921) "BLD",8104,4,"APDD",9002313.92,9002313.921,.01) "BLD",8104,4,"APDD",9002313.92,9002313.921,1) "BLD",8104,4,"APDD",9002313.92,9002313.9213) "BLD",8104,4,"APDD",9002313.92,9002313.9213,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9213,1) "BLD",8104,4,"APDD",9002313.92,9002313.9214) "BLD",8104,4,"APDD",9002313.92,9002313.9214,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9214,1) "BLD",8104,4,"APDD",9002313.92,9002313.9215) "BLD",8104,4,"APDD",9002313.92,9002313.9215,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9215,1) "BLD",8104,4,"APDD",9002313.92,9002313.9216) "BLD",8104,4,"APDD",9002313.92,9002313.9216,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9216,1) "BLD",8104,4,"APDD",9002313.92,9002313.9217) "BLD",8104,4,"APDD",9002313.92,9002313.9217,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9217,1) "BLD",8104,4,"APDD",9002313.92,9002313.9218) "BLD",8104,4,"APDD",9002313.92,9002313.9218,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9218,1) "BLD",8104,4,"APDD",9002313.92,9002313.9219) "BLD",8104,4,"APDD",9002313.92,9002313.9219,.01) "BLD",8104,4,"APDD",9002313.92,9002313.9219,1) "BLD",8104,4,"APDD",9002313.92,9002313.922) "BLD",8104,4,"APDD",9002313.92,9002313.922,.01) "BLD",8104,4,"APDD",9002313.92,9002313.922,1) "BLD",8104,4,"APDD",9002313.92,9002313.9223) "BLD",8104,4,"APDD",9002313.92,9002313.9224) "BLD",8104,4,"APDD",9002313.92,9002313.9225) "BLD",8104,4,"APDD",9002313.99,9002313.99) "BLD",8104,4,"APDD",9002313.99,9002313.99,.08) "BLD",8104,4,"B",9002313.02,9002313.02) "BLD",8104,4,"B",9002313.03,9002313.03) "BLD",8104,4,"B",9002313.15,9002313.15) "BLD",8104,4,"B",9002313.19,9002313.19) "BLD",8104,4,"B",9002313.21,9002313.21) "BLD",8104,4,"B",9002313.22,9002313.22) "BLD",8104,4,"B",9002313.23,9002313.23) "BLD",8104,4,"B",9002313.24,9002313.24) "BLD",8104,4,"B",9002313.26,9002313.26) "BLD",8104,4,"B",9002313.27,9002313.27) "BLD",8104,4,"B",9002313.28,9002313.28) "BLD",8104,4,"B",9002313.29,9002313.29) "BLD",8104,4,"B",9002313.31,9002313.31) "BLD",8104,4,"B",9002313.32,9002313.32) "BLD",8104,4,"B",9002313.57,9002313.57) "BLD",8104,4,"B",9002313.58,9002313.58) "BLD",8104,4,"B",9002313.59,9002313.59) "BLD",8104,4,"B",9002313.77,9002313.77) "BLD",8104,4,"B",9002313.78,9002313.78) "BLD",8104,4,"B",9002313.91,9002313.91) "BLD",8104,4,"B",9002313.92,9002313.92) "BLD",8104,4,"B",9002313.93,9002313.93) "BLD",8104,4,"B",9002313.94,9002313.94) "BLD",8104,4,"B",9002313.99,9002313.99) "BLD",8104,6.3) 27 "BLD",8104,10,0) ^9.63^^ "BLD",8104,"ABPKG") n "BLD",8104,"INI") PRE^BPS10PRE "BLD",8104,"INID") ^y^y "BLD",8104,"INIT") POST^BPS10PST "BLD",8104,"KRN",0) ^9.67PA^779.2^20 "BLD",8104,"KRN",.4,0) .4 "BLD",8104,"KRN",.401,0) .401 "BLD",8104,"KRN",.402,0) .402 "BLD",8104,"KRN",.403,0) .403 "BLD",8104,"KRN",.5,0) .5 "BLD",8104,"KRN",.84,0) .84 "BLD",8104,"KRN",3.6,0) 3.6 "BLD",8104,"KRN",3.8,0) 3.8 "BLD",8104,"KRN",9.2,0) 9.2 "BLD",8104,"KRN",9.8,0) 9.8 "BLD",8104,"KRN",9.8,"NM",0) ^9.68A^89^86 "BLD",8104,"KRN",9.8,"NM",1,0) BPSNCPDP^^0^B79480311 "BLD",8104,"KRN",9.8,"NM",2,0) BPSNCPD3^^0^B48711811 "BLD",8104,"KRN",9.8,"NM",3,0) BPSOSO2^^0^B33642927 "BLD",8104,"KRN",9.8,"NM",4,0) BPSRPT0^^0^B22539987 "BLD",8104,"KRN",9.8,"NM",5,0) BPSRPT7^^0^B105055369 "BLD",8104,"KRN",9.8,"NM",6,0) BPSRPT4^^0^B76530531 "BLD",8104,"KRN",9.8,"NM",7,0) BPSRPT8^^0^B125609567 "BLD",8104,"KRN",9.8,"NM",8,0) BPSRPT5^^0^B136990119 "BLD",8104,"KRN",9.8,"NM",9,0) BPSMHDR^^0^B3502481 "BLD",8104,"KRN",9.8,"NM",10,0) BPSSCRLG^^0^B171520017 "BLD",8104,"KRN",9.8,"NM",11,0) BPSRES^^0^B125666033 "BLD",8104,"KRN",9.8,"NM",12,0) BPSJHLT^^0^B56892816 "BLD",8104,"KRN",9.8,"NM",13,0) BPSRPT1^^0^B53891828 "BLD",8104,"KRN",9.8,"NM",14,0) BPSSCRU2^^0^B46275468 "BLD",8104,"KRN",9.8,"NM",15,0) BPSOSCE^^0^B12883469 "BLD",8104,"KRN",9.8,"NM",16,0) BPSOSCC^^0^B25822348 "BLD",8104,"KRN",9.8,"NM",17,0) BPSOSCD^^0^B76120342 "BLD",8104,"KRN",9.8,"NM",18,0) BPSECA8^^0^B20615528 "BLD",8104,"KRN",9.8,"NM",19,0) BPSECMP2^^0^B98781684 "BLD",8104,"KRN",9.8,"NM",20,0) BPSECMPS^^0^B98920700 "BLD",8104,"KRN",9.8,"NM",21,0) BPSOSCF^^0^B30098289 "BLD",8104,"KRN",9.8,"NM",22,0) BPSOSH2^^0^B136482600 "BLD",8104,"KRN",9.8,"NM",24,0) BPSOSRX^^0^B40198470 "BLD",8104,"KRN",9.8,"NM",25,0) BPSOSRX2^^0^B31124186 "BLD",8104,"KRN",9.8,"NM",26,0) BPSOSRX3^^0^B117328424 "BLD",8104,"KRN",9.8,"NM",27,0) BPSOSRX4^^0^B57083414 "BLD",8104,"KRN",9.8,"NM",28,0) BPSOSRX5^^0^B45774231 "BLD",8104,"KRN",9.8,"NM",29,0) BPSOSIY^^0^B68639944 "BLD",8104,"KRN",9.8,"NM",30,0) BPSOSIZ^^0^B13539436 "BLD",8104,"KRN",9.8,"NM",31,0) BPSOSR2^^1^ "BLD",8104,"KRN",9.8,"NM",32,0) BPSNCPD2^^0^B62016998 "BLD",8104,"KRN",9.8,"NM",33,0) BPSOSRX7^^0^B43038317 "BLD",8104,"KRN",9.8,"NM",34,0) BPSOSRX8^^0^B22878740 "BLD",8104,"KRN",9.8,"NM",35,0) BPSOSRB^^0^B37930857 "BLD",8104,"KRN",9.8,"NM",36,0) BPSOSQA^^0^B9139209 "BLD",8104,"KRN",9.8,"NM",37,0) BPSOSQ2^^0^B16516735 "BLD",8104,"KRN",9.8,"NM",38,0) BPSOSQL^^0^B18210044 "BLD",8104,"KRN",9.8,"NM",39,0) BPSOSU^^0^B38973910 "BLD",8104,"KRN",9.8,"NM",40,0) BPSOSUC^^0^B9012826 "BLD",8104,"KRN",9.8,"NM",41,0) BPSOSS8^^0^B2236526 "BLD",8104,"KRN",9.8,"NM",42,0) BPSOS2C^^0^B1693824 "BLD",8104,"KRN",9.8,"NM",43,0) BPSOS2B^^0^B2413052 "BLD",8104,"KRN",9.8,"NM",44,0) BPSNCPD4^^0^B45568614 "BLD",8104,"KRN",9.8,"NM",45,0) BPSNCPD9^^0^B36538508 "BLD",8104,"KRN",9.8,"NM",47,0) BPSSCR02^^0^B42496170 "BLD",8104,"KRN",9.8,"NM",48,0) BPSOSSG^^0^B29948946 "BLD",8104,"KRN",9.8,"NM",49,0) BPSJPAY^^1^ "BLD",8104,"KRN",9.8,"NM",50,0) BPSNCPD5^^0^B79985749 "BLD",8104,"KRN",9.8,"NM",51,0) BPSSCR03^^0^B40126137 "BLD",8104,"KRN",9.8,"NM",52,0) BPSRDT1^^0^B23897746 "BLD",8104,"KRN",9.8,"NM",53,0) BPSOSQ4^^0^B51328615 "BLD",8104,"KRN",9.8,"NM",54,0) BPSPRRX3^^0^B196212053 "BLD",8104,"KRN",9.8,"NM",55,0) BPSJZPR^^0^B64959398 "BLD",8104,"KRN",9.8,"NM",56,0) BPSRPAY^^0^B33669319 "BLD",8104,"KRN",9.8,"NM",57,0) BPSOSCA^^0^B9122453 "BLD",8104,"KRN",9.8,"NM",58,0) BPSOSCB^^0^B2769935 "BLD",8104,"KRN",9.8,"NM",59,0) BPSOSQG^^0^B6945511 "BLD",8104,"KRN",9.8,"NM",60,0) BPSOSL^^0^B6601315 "BLD",8104,"KRN",9.8,"NM",61,0) BPSECX0^^0^B35429385 "BLD",8104,"KRN",9.8,"NM",63,0) BPSUSCR^^0^B1901475 "BLD",8104,"KRN",9.8,"NM",64,0) BPSUSCR1^^0^B52105056 "BLD",8104,"KRN",9.8,"NM",65,0) BPSUSCR2^^0^B14190168 "BLD",8104,"KRN",9.8,"NM",66,0) BPSUSCR4^^0^B15393480 "BLD",8104,"KRN",9.8,"NM",67,0) BPSSCRU5^^0^B61949980 "BLD",8104,"KRN",9.8,"NM",68,0) BPSOSC2^^0^B59488348 "BLD",8104,"KRN",9.8,"NM",69,0) BPSPRRX5^^0^B48238265 "BLD",8104,"KRN",9.8,"NM",70,0) BPSREOP1^^0^B59523437 "BLD",8104,"KRN",9.8,"NM",71,0) BPSELG^^0^B36086244 "BLD",8104,"KRN",9.8,"NM",72,0) BPSECA1^^0^B13940777 "BLD",8104,"KRN",9.8,"NM",73,0) BPSOSRX6^^0^B23669366 "BLD",8104,"KRN",9.8,"NM",74,0) BPSTEST^^0^B93493261 "BLD",8104,"KRN",9.8,"NM",75,0) BPSECFM^^0^B9768202 "BLD",8104,"KRN",9.8,"NM",76,0) BPSUTIL2^^0^B28691065 "BLD",8104,"KRN",9.8,"NM",77,0) BPSOS57^^0^B15079066 "BLD",8104,"KRN",9.8,"NM",78,0) BPSNCPD6^^0^B28619607 "BLD",8104,"KRN",9.8,"NM",79,0) BPSBUTL^^0^B55262641 "BLD",8104,"KRN",9.8,"NM",80,0) BPSCT^^0^B1444523 "BLD",8104,"KRN",9.8,"NM",81,0) BPSFLD01^^0^B16636556 "BLD",8104,"KRN",9.8,"NM",82,0) BPSOSHF^^0^B48018870 "BLD",8104,"KRN",9.8,"NM",83,0) BPSOSQF^^0^B7245546 "BLD",8104,"KRN",9.8,"NM",84,0) BPSSCRU3^^0^B30414230 "BLD",8104,"KRN",9.8,"NM",85,0) BPSSCRU6^^0^B17791929 "BLD",8104,"KRN",9.8,"NM",86,0) BPSOS03^^0^B9935989 "BLD",8104,"KRN",9.8,"NM",87,0) BPSSCRRS^^0^B34060825 "BLD",8104,"KRN",9.8,"NM",88,0) BPSNCPD1^^0^B45414191 "BLD",8104,"KRN",9.8,"NM",89,0) BPSPRRX6^^0^B57670037 "BLD",8104,"KRN",9.8,"NM","B","BPSBUTL",79) "BLD",8104,"KRN",9.8,"NM","B","BPSCT",80) "BLD",8104,"KRN",9.8,"NM","B","BPSECA1",72) "BLD",8104,"KRN",9.8,"NM","B","BPSECA8",18) "BLD",8104,"KRN",9.8,"NM","B","BPSECFM",75) "BLD",8104,"KRN",9.8,"NM","B","BPSECMP2",19) "BLD",8104,"KRN",9.8,"NM","B","BPSECMPS",20) "BLD",8104,"KRN",9.8,"NM","B","BPSECX0",61) "BLD",8104,"KRN",9.8,"NM","B","BPSELG",71) "BLD",8104,"KRN",9.8,"NM","B","BPSFLD01",81) "BLD",8104,"KRN",9.8,"NM","B","BPSJHLT",12) "BLD",8104,"KRN",9.8,"NM","B","BPSJPAY",49) "BLD",8104,"KRN",9.8,"NM","B","BPSJZPR",55) "BLD",8104,"KRN",9.8,"NM","B","BPSMHDR",9) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD1",88) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD2",32) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD3",2) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD4",44) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD5",50) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD6",78) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPD9",45) "BLD",8104,"KRN",9.8,"NM","B","BPSNCPDP",1) "BLD",8104,"KRN",9.8,"NM","B","BPSOS03",86) "BLD",8104,"KRN",9.8,"NM","B","BPSOS2B",43) "BLD",8104,"KRN",9.8,"NM","B","BPSOS2C",42) "BLD",8104,"KRN",9.8,"NM","B","BPSOS57",77) "BLD",8104,"KRN",9.8,"NM","B","BPSOSC2",68) "BLD",8104,"KRN",9.8,"NM","B","BPSOSCA",57) "BLD",8104,"KRN",9.8,"NM","B","BPSOSCB",58) "BLD",8104,"KRN",9.8,"NM","B","BPSOSCC",16) "BLD",8104,"KRN",9.8,"NM","B","BPSOSCD",17) "BLD",8104,"KRN",9.8,"NM","B","BPSOSCE",15) "BLD",8104,"KRN",9.8,"NM","B","BPSOSCF",21) "BLD",8104,"KRN",9.8,"NM","B","BPSOSH2",22) "BLD",8104,"KRN",9.8,"NM","B","BPSOSHF",82) "BLD",8104,"KRN",9.8,"NM","B","BPSOSIY",29) "BLD",8104,"KRN",9.8,"NM","B","BPSOSIZ",30) "BLD",8104,"KRN",9.8,"NM","B","BPSOSL",60) "BLD",8104,"KRN",9.8,"NM","B","BPSOSO2",3) "BLD",8104,"KRN",9.8,"NM","B","BPSOSQ2",37) "BLD",8104,"KRN",9.8,"NM","B","BPSOSQ4",53) "BLD",8104,"KRN",9.8,"NM","B","BPSOSQA",36) "BLD",8104,"KRN",9.8,"NM","B","BPSOSQF",83) "BLD",8104,"KRN",9.8,"NM","B","BPSOSQG",59) "BLD",8104,"KRN",9.8,"NM","B","BPSOSQL",38) "BLD",8104,"KRN",9.8,"NM","B","BPSOSR2",31) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRB",35) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX",24) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX2",25) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX3",26) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX4",27) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX5",28) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX6",73) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX7",33) "BLD",8104,"KRN",9.8,"NM","B","BPSOSRX8",34) "BLD",8104,"KRN",9.8,"NM","B","BPSOSS8",41) "BLD",8104,"KRN",9.8,"NM","B","BPSOSSG",48) "BLD",8104,"KRN",9.8,"NM","B","BPSOSU",39) "BLD",8104,"KRN",9.8,"NM","B","BPSOSUC",40) "BLD",8104,"KRN",9.8,"NM","B","BPSPRRX3",54) "BLD",8104,"KRN",9.8,"NM","B","BPSPRRX5",69) "BLD",8104,"KRN",9.8,"NM","B","BPSPRRX6",89) "BLD",8104,"KRN",9.8,"NM","B","BPSRDT1",52) "BLD",8104,"KRN",9.8,"NM","B","BPSREOP1",70) "BLD",8104,"KRN",9.8,"NM","B","BPSRES",11) "BLD",8104,"KRN",9.8,"NM","B","BPSRPAY",56) "BLD",8104,"KRN",9.8,"NM","B","BPSRPT0",4) "BLD",8104,"KRN",9.8,"NM","B","BPSRPT1",13) "BLD",8104,"KRN",9.8,"NM","B","BPSRPT4",6) "BLD",8104,"KRN",9.8,"NM","B","BPSRPT5",8) "BLD",8104,"KRN",9.8,"NM","B","BPSRPT7",5) "BLD",8104,"KRN",9.8,"NM","B","BPSRPT8",7) "BLD",8104,"KRN",9.8,"NM","B","BPSSCR02",47) "BLD",8104,"KRN",9.8,"NM","B","BPSSCR03",51) "BLD",8104,"KRN",9.8,"NM","B","BPSSCRLG",10) "BLD",8104,"KRN",9.8,"NM","B","BPSSCRRS",87) "BLD",8104,"KRN",9.8,"NM","B","BPSSCRU2",14) "BLD",8104,"KRN",9.8,"NM","B","BPSSCRU3",84) "BLD",8104,"KRN",9.8,"NM","B","BPSSCRU5",67) "BLD",8104,"KRN",9.8,"NM","B","BPSSCRU6",85) "BLD",8104,"KRN",9.8,"NM","B","BPSTEST",74) "BLD",8104,"KRN",9.8,"NM","B","BPSUSCR",63) "BLD",8104,"KRN",9.8,"NM","B","BPSUSCR1",64) "BLD",8104,"KRN",9.8,"NM","B","BPSUSCR2",65) "BLD",8104,"KRN",9.8,"NM","B","BPSUSCR4",66) "BLD",8104,"KRN",9.8,"NM","B","BPSUTIL2",76) "BLD",8104,"KRN",19,0) 19 "BLD",8104,"KRN",19,"NM",0) ^9.68A^4^3 "BLD",8104,"KRN",19,"NM",1,0) BPS RPT SPENDING ACCOUNT^^0 "BLD",8104,"KRN",19,"NM",2,0) BPS MENU RPT CLAIM STATUS^^2 "BLD",8104,"KRN",19,"NM",4,0) BPS UNSTRAND SCREEN^^0 "BLD",8104,"KRN",19,"NM","B","BPS MENU RPT CLAIM STATUS",2) "BLD",8104,"KRN",19,"NM","B","BPS RPT SPENDING ACCOUNT",1) "BLD",8104,"KRN",19,"NM","B","BPS UNSTRAND SCREEN",4) "BLD",8104,"KRN",19.1,0) 19.1 "BLD",8104,"KRN",101,0) 101 "BLD",8104,"KRN",101,"NM",0) ^9.68A^22^22 "BLD",8104,"KRN",101,"NM",1,0) BPS PRTCL UNSTRAND ALL^^0 "BLD",8104,"KRN",101,"NM",2,0) BPS PRTCL UNSTRAND PRINT^^0 "BLD",8104,"KRN",101,"NM",3,0) BPS PRTCL UNSTRAND SELECT^^0 "BLD",8104,"KRN",101,"NM",4,0) BPS PRTCL RSCH HIDDEN ACTIONS^^0 "BLD",8104,"KRN",101,"NM",5,0) BPS PRTCL RSCH ELIG INQ^^0 "BLD",8104,"KRN",101,"NM",6,0) VALM NEXT SCREEN^^0 "BLD",8104,"KRN",101,"NM",7,0) VALM PREVIOUS SCREEN^^0 "BLD",8104,"KRN",101,"NM",8,0) VALM UP ONE LINE^^0 "BLD",8104,"KRN",101,"NM",9,0) VALM DOWN A LINE^^0 "BLD",8104,"KRN",101,"NM",10,0) VALM REFRESH^^0 "BLD",8104,"KRN",101,"NM",11,0) VALM PRINT SCREEN^^0 "BLD",8104,"KRN",101,"NM",12,0) VALM PRINT LIST^^0 "BLD",8104,"KRN",101,"NM",13,0) VALM RIGHT^^0 "BLD",8104,"KRN",101,"NM",14,0) VALM LEFT^^0 "BLD",8104,"KRN",101,"NM",15,0) VALM TURN ON/OFF MENUS^^0 "BLD",8104,"KRN",101,"NM",16,0) VALM SEARCH LIST^^0 "BLD",8104,"KRN",101,"NM",17,0) VALM QUIT^^0 "BLD",8104,"KRN",101,"NM",18,0) VALM LAST SCREEN^^0 "BLD",8104,"KRN",101,"NM",19,0) VALM FIRST SCREEN^^0 "BLD",8104,"KRN",101,"NM",20,0) VALM GOTO PAGE^^0 "BLD",8104,"KRN",101,"NM",21,0) VALM BLANK 3^^0 "BLD",8104,"KRN",101,"NM",22,0) VALM BLANK 4^^0 "BLD",8104,"KRN",101,"NM","B","BPS PRTCL RSCH ELIG INQ",5) "BLD",8104,"KRN",101,"NM","B","BPS PRTCL RSCH HIDDEN ACTIONS",4) "BLD",8104,"KRN",101,"NM","B","BPS PRTCL UNSTRAND ALL",1) "BLD",8104,"KRN",101,"NM","B","BPS PRTCL UNSTRAND PRINT",2) "BLD",8104,"KRN",101,"NM","B","BPS PRTCL UNSTRAND SELECT",3) "BLD",8104,"KRN",101,"NM","B","VALM BLANK 3",21) "BLD",8104,"KRN",101,"NM","B","VALM BLANK 4",22) "BLD",8104,"KRN",101,"NM","B","VALM DOWN A LINE",9) "BLD",8104,"KRN",101,"NM","B","VALM FIRST SCREEN",19) "BLD",8104,"KRN",101,"NM","B","VALM GOTO PAGE",20) "BLD",8104,"KRN",101,"NM","B","VALM LAST SCREEN",18) "BLD",8104,"KRN",101,"NM","B","VALM LEFT",14) "BLD",8104,"KRN",101,"NM","B","VALM NEXT SCREEN",6) "BLD",8104,"KRN",101,"NM","B","VALM PREVIOUS SCREEN",7) "BLD",8104,"KRN",101,"NM","B","VALM PRINT LIST",12) "BLD",8104,"KRN",101,"NM","B","VALM PRINT SCREEN",11) "BLD",8104,"KRN",101,"NM","B","VALM QUIT",17) "BLD",8104,"KRN",101,"NM","B","VALM REFRESH",10) "BLD",8104,"KRN",101,"NM","B","VALM RIGHT",13) "BLD",8104,"KRN",101,"NM","B","VALM SEARCH LIST",16) "BLD",8104,"KRN",101,"NM","B","VALM TURN ON/OFF MENUS",15) "BLD",8104,"KRN",101,"NM","B","VALM UP ONE LINE",8) "BLD",8104,"KRN",409.61,0) 409.61 "BLD",8104,"KRN",409.61,"NM",0) ^9.68A^4^4 "BLD",8104,"KRN",409.61,"NM",1,0) BPS LSTMN ECME UNSTRAND^^0 "BLD",8104,"KRN",409.61,"NM",2,0) BPS LSTMN ECME REOPEN^^0 "BLD",8104,"KRN",409.61,"NM",3,0) BPS LSTMN ECME USRSCR^^0 "BLD",8104,"KRN",409.61,"NM",4,0) BPS LSTMN RSCH MENU^^0 "BLD",8104,"KRN",409.61,"NM","B","BPS LSTMN ECME REOPEN",2) "BLD",8104,"KRN",409.61,"NM","B","BPS LSTMN ECME UNSTRAND",1) "BLD",8104,"KRN",409.61,"NM","B","BPS LSTMN ECME USRSCR",3) "BLD",8104,"KRN",409.61,"NM","B","BPS LSTMN RSCH MENU",4) "BLD",8104,"KRN",771,0) 771 "BLD",8104,"KRN",779.2,0) 779.2 "BLD",8104,"KRN",870,0) 870 "BLD",8104,"KRN",8989.51,0) 8989.51 "BLD",8104,"KRN",8989.52,0) 8989.52 "BLD",8104,"KRN",8994,0) 8994 "BLD",8104,"KRN","B",.4,.4) "BLD",8104,"KRN","B",.401,.401) "BLD",8104,"KRN","B",.402,.402) "BLD",8104,"KRN","B",.403,.403) "BLD",8104,"KRN","B",.5,.5) "BLD",8104,"KRN","B",.84,.84) "BLD",8104,"KRN","B",3.6,3.6) "BLD",8104,"KRN","B",3.8,3.8) "BLD",8104,"KRN","B",9.2,9.2) "BLD",8104,"KRN","B",9.8,9.8) "BLD",8104,"KRN","B",19,19) "BLD",8104,"KRN","B",19.1,19.1) "BLD",8104,"KRN","B",101,101) "BLD",8104,"KRN","B",409.61,409.61) "BLD",8104,"KRN","B",771,771) "BLD",8104,"KRN","B",779.2,779.2) "BLD",8104,"KRN","B",870,870) "BLD",8104,"KRN","B",8989.51,8989.51) "BLD",8104,"KRN","B",8989.52,8989.52) "BLD",8104,"KRN","B",8994,8994) "BLD",8104,"QUES",0) ^9.62^^ "BLD",8104,"REQB",0) ^9.611^1^1 "BLD",8104,"REQB",1,0) BPS*1.0*9^2 "BLD",8104,"REQB","B","BPS*1.0*9",1) "DATA",9002313.19,1,0) 0^NOT SPECIFIED "DATA",9002313.19,1,1,0) ^9002313.191^1^1^3100930^^ "DATA",9002313.19,1,1,1,0) Not specified. "DATA",9002313.19,2,0) 1^CARDHOLDER "DATA",9002313.19,2,1,0) ^9002313.191^2^2^3100930^^ "DATA",9002313.19,2,1,1,0) The individual that is enrolled in and receives benefits from a health "DATA",9002313.19,2,1,2,0) plan. "DATA",9002313.19,3,0) 2^SPOUSE "DATA",9002313.19,3,1,0) ^^1^1^3100930^ "DATA",9002313.19,3,1,1,0) Patient is the husband/wife/partner of the cardholder. "DATA",9002313.19,4,0) 3^CHILD "DATA",9002313.19,4,1,0) ^^1^1^3100930^ "DATA",9002313.19,4,1,1,0) Patient is a child of the cardholder. "DATA",9002313.19,5,0) 4^OTHER "DATA",9002313.19,5,1,0) ^^1^1^3100930^ "DATA",9002313.19,5,1,1,0) Relationship to cardholder is not precise. "DATA",9002313.21,1,0) 00^NO INTERVENTION "DATA",9002313.21,2,0) AS^PATIENT ASSESSMENT "DATA",9002313.21,3,0) FE^FORMULARY ENFORCEMENT "DATA",9002313.21,4,0) CC^COORDINATION OF CARE "DATA",9002313.21,5,0) GP^GENERIC PRODUCT SELECTION "DATA",9002313.21,6,0) DE^DOSING EVALUATION/DETERMINATION "DATA",9002313.21,7,0) PH^PATIENT MEDICATION HISTORY "DATA",9002313.21,8,0) M0^PRESCRIBER CONSULTED "DATA",9002313.21,9,0) SW^LITERATURE SEARCH/REVIEW "DATA",9002313.21,10,0) MA^MEDICATION ADMINISTRATION "DATA",9002313.21,11,0) TC^PAYER/PROCESSOR CONSULTED "DATA",9002313.21,12,0) MR^MEDICATION REVIEW "DATA",9002313.21,13,0) TH^THERAPEUTIC PRODUCT INTERCHANGE "DATA",9002313.21,14,0) P0^PATIENT CONSULTED "DATA",9002313.21,15,0) PE^PATIENT EDUCATION/INSTRUCTION "DATA",9002313.21,17,0) PM^PATIENT MONITORING "DATA",9002313.21,18,0) R0^PHARMACIST CONSULTED OTHER SOURCE "DATA",9002313.21,19,0) RT^RECOMMENDED LABORATORY TEST "DATA",9002313.21,20,0) SC^SELF-CARE CONSULTATION "DATA",9002313.21,21,0) PT^PERFORM LABORATORY REQUEST "DATA",9002313.21,22,0) DP^DOSAGE EVALUATED "DATA",9002313.21,23,0) MB^OVERRIDING BENEFIT "DATA",9002313.21,24,0) MP^PATIENT WILL BE MONITORED "DATA",9002313.21,25,0) PA^PREVIOUS PATIENT TOLERANCE "DATA",9002313.21,26,0) ZZ^OTHER ACKNOWLEDGEMENT "DATA",9002313.22,1,0) 00^NOT SPECIFIED "DATA",9002313.22,2,0) 2A^PRESCRIPTION NOT FILLED "DATA",9002313.22,3,0) 3A^RECOMMENDATION ACCEPTED "DATA",9002313.22,4,0) 1A^FILLED AS IS, FALSE POSITIVE "DATA",9002313.22,5,0) 2B^NOT FILLED, DIRECTIONS CLARIFIED "DATA",9002313.22,6,0) 3B^RECOMMENDATION NOT ACCEPTED "DATA",9002313.22,7,0) 1B^FILLED PRESCRIPTION AS IS "DATA",9002313.22,8,0) 3C^DISCONTINUED DRUG "DATA",9002313.22,9,0) 1C^FILLED, WITH DIFFERENT DOSE "DATA",9002313.22,10,0) 3D^REGIMEN CHANGED "DATA",9002313.22,11,0) 1D^FILLED, WITH DIFFERENT DIRECTIONS "DATA",9002313.22,12,0) 3E^THERAPY CHANGED "DATA",9002313.22,13,0) 1E^FILLED, WITH DIFFERENT DRUG "DATA",9002313.22,14,0) 3F^THERAPY CHANGED - COST INCREASE ACKNOWLEDGED "DATA",9002313.22,15,0) 1F^FILLED, WITH DIFFERENT QUANTITY "DATA",9002313.22,16,0) 3G^DRUG THERAPY UNCHANGED "DATA",9002313.22,17,0) 1G^FILLED, WITH PRESCRIBER APPROVAL "DATA",9002313.22,18,0) 3H^FOLLOW-UP/REPORT "DATA",9002313.22,19,0) 1H^BRAND-TO-GENERIC CHANGE "DATA",9002313.22,20,0) 3J^PATIENT REFERRAL "DATA",9002313.22,21,0) 1J^RX-TO-OTC CHANGE "DATA",9002313.22,22,0) 3M^COMPLIANCE AID PROVIDED "DATA",9002313.22,23,0) 1K^FILLED, WITH DIFFERENT DOSAGE FORM "DATA",9002313.22,24,0) 3K^INSTRUCTIONS UNDERSTOOD "DATA",9002313.22,25,0) 3N^MEDICATION ADMINISTERED "DATA",9002313.22,26,0) 4A^PRESCRIBED WITH ACKNOWLEDGEMENTS "DATA",9002313.23,1,0) AN^PRESCRIPTION AUTHENTICATION "DATA",9002313.23,2,0) ER^OVERUSE "DATA",9002313.23,3,0) DF^DRUG-FOOD INTERACTION "DATA",9002313.23,4,0) CH^CALL HELP DESK "DATA",9002313.23,5,0) DA^DRUG-ALLERGY "DATA",9002313.23,6,0) DL^DRUG-LAB CONFLICT "DATA",9002313.23,7,0) MS^MISSING INFORMATION/CLARIFICATION "DATA",9002313.23,8,0) MX^EXCESSIVE DURATION "DATA",9002313.23,9,0) DC^DRUG-DISEASE (INFERRED) "DATA",9002313.23,10,0) CS^PATIENT COMPLAINT/SYMPTOM "DATA",9002313.23,11,0) DS^TOBACCO USE "DATA",9002313.23,12,0) NA^DRUG NOT AVAILABLE "DATA",9002313.23,13,0) HD^HIGH DOSE "DATA",9002313.23,14,0) DD^DRUG-DRUG INTERACTION "DATA",9002313.23,15,0) DM^APPARENT DRUG MISUSE "DATA",9002313.23,16,0) OH^ALCOHOL CONFLICT "DATA",9002313.23,17,0) NC^NON-COVERED DRUG PURCHASE "DATA",9002313.23,18,0) LD^LOW DOSE "DATA",9002313.23,19,0) DI^DRUG INCOMPATIBILITY "DATA",9002313.23,20,0) ED^PATIENT EDUCATION/INSTRUCTION "DATA",9002313.23,21,0) NF^NON-FORMULARY DRUG "DATA",9002313.23,22,0) LR^UNDERUSE "DATA",9002313.23,23,0) IC^IATROGENIC CONDITION "DATA",9002313.23,24,0) ND^NEW DISEASE/DIAGNOSIS "DATA",9002313.23,25,0) SE^SIDE EFFECT "DATA",9002313.23,26,0) NP^NEW PATIENT PROCESSING "DATA",9002313.23,27,0) MN^INSUFFICIENT DURATION "DATA",9002313.23,28,0) ID^INGREDIENT DUPLICATION "DATA",9002313.23,29,0) NN^UNNECESSARY DRUG "DATA",9002313.23,30,0) PS^PRODUCT SELECTION OPPORTUNITY "DATA",9002313.23,31,0) NS^INSUFFICIENT QUANTITY "DATA",9002313.23,32,0) MC^DRUG-DISEASE (REPORTED) "DATA",9002313.23,33,0) PC^PATIENT QUESTION/CONCERN "DATA",9002313.23,34,0) PP^PLAN PROTOCOL "DATA",9002313.23,35,0) SF^SUBOPTIMAL DOSAGE FORM "DATA",9002313.23,36,0) NR^LACTATION/NURSING INTERACTION "DATA",9002313.23,37,0) PN^PRESCRIBER CONSULTATION "DATA",9002313.23,38,0) TP^PAYER/PROCESSOR QUESTION "DATA",9002313.23,39,0) SR^SUBOPTIMAL REGIMEN "DATA",9002313.23,40,0) PA^DRUG-AGE "DATA",9002313.23,41,0) RF^HEALTH PROVIDER REFERRAL "DATA",9002313.23,42,0) PG^DRUG-PREGNANCY "DATA",9002313.23,43,0) SD^SUBOPTIMAL DRUG/INDICATION "DATA",9002313.23,44,0) PR^PRIOR ADVERSE REACTION "DATA",9002313.23,45,0) TN^LABORATORY TEST NEEDED "DATA",9002313.23,46,0) SX^DRUG-GENDER "DATA",9002313.23,47,0) TD^THERAPEUTIC "DATA",9002313.23,48,0) LK^LOCK IN RECIPIENT "DATA",9002313.23,49,0) CD^CHRONIC DISEASE MANAGEMENT "DATA",9002313.23,50,0) RE^SUSPECTED ENVIRONMENTAL RISK "DATA",9002313.23,51,0) PH^PREVENTIVE HEALTH CARE "DATA",9002313.23,52,0) SC^SUBOPTIMAL COMPLIANCE "DATA",9002313.23,53,0) AT^ADDITIVE TOXICITY "DATA",9002313.23,54,0) AD^ADDITIONAL DRUG NEEDED "DATA",9002313.23,55,0) AR^ADVERSE DRUG REACTION "DATA",9002313.23,56,0) EX^EXCESSIVE QUANTITY "DATA",9002313.23,57,0) DR^DOSE RANGE CONFLICT "DATA",9002313.23,58,0) UD^DUPLICATE DRUG "DATA",9002313.24,1,0) 0^NO PRODUCT SELECTION INDICATED "DATA",9002313.24,2,0) 1^SUBSTITUTION NOT ALLOWED BY PRESCRIBER "DATA",9002313.24,3,0) 2^SUBSTITUTION ALLOWED-PATIENT REQUESTED PRODUCT DISPENSED "DATA",9002313.24,4,0) 3^SUBSTITUTION ALLOWED-PHARMACIST SELECTED PRODUCT DISPENSED "DATA",9002313.24,5,0) 4^SUBSTITUTION ALLOWED-GENERIC DRUG NOT IN STOCK "DATA",9002313.24,6,0) 5^SUBSTITUTION ALLOWED-BRAND DRUG DISPENSED AS A GENERIC "DATA",9002313.24,7,0) 6^OVERRIDE "DATA",9002313.24,8,0) 7^SUBSTITUTION NOT ALLOWED-BRAND DRUG MANDATED BY LAW "DATA",9002313.24,9,0) 8^SUBSTITUTION ALLOWED-GENERIC DRUG NOT AVAILABLE IN MARKETPLACE "DATA",9002313.24,10,0) 9^SUBSTITUTION ALLOWED BY PRESCRIBER BUT PLAN REQUESTS BRAND "DATA",9002313.26,1,0) 0^NOT SPECIFIED "DATA",9002313.26,2,0) 1^PRIOR AUTHORIZATION "DATA",9002313.26,2,1,0) ^9002313.261^7^7^3101012^^ "DATA",9002313.26,2,1,1,0) a) Code assigned for use with claim billing to allow processing of a "DATA",9002313.26,2,1,2,0) claim which would otherwise reject based upon benefit or program design. "DATA",9002313.26,2,1,3,0) b) Indicator to convey that coverage of the specified product is "DATA",9002313.26,2,1,4,0) dependant upon the prescriber submitting the request (including required "DATA",9002313.26,2,1,5,0) documentation) to the payer/plan or designated utilization management "DATA",9002313.26,2,1,6,0) organization for approval/authorization prior to ordering/dispensing the "DATA",9002313.26,2,1,7,0) product. "DATA",9002313.26,3,0) 2^MEDICAL CERTIFICATION "DATA",9002313.26,3,1,0) ^9002313.261^3^3^3101012^^ "DATA",9002313.26,3,1,1,0) A code indicating that a health care provider practitioner certifies to "DATA",9002313.26,3,1,2,0) an incapacitation, examination, or treatment or to a period of disability "DATA",9002313.26,3,1,3,0) while a patient was or is receiving professional treatment. "DATA",9002313.26,4,0) 3^EPSDT "DATA",9002313.26,4,1,0) ^9002313.261^5^5^3101012^^ "DATA",9002313.26,4,1,1,0) (Early Periodic Screening Diagnosis Treatment)-Code indicating "DATA",9002313.26,4,1,2,0) information about services involving preventative health measures for "DATA",9002313.26,4,1,3,0) children, e.g., screening assessments, tests and their subsequent results "DATA",9002313.26,4,1,4,0) and findings, immunization information, guidance and education given, and "DATA",9002313.26,4,1,5,0) follow-up care required. "DATA",9002313.26,5,0) 4^EXEMPT FROM COPAY/COINSURANCE "DATA",9002313.26,5,1,0) ^9002313.261^3^3^3101105^^^^ "DATA",9002313.26,5,1,1,0) Code used to classify the reason for the prior authorization request as "DATA",9002313.26,5,1,2,0) one used when the member has qualified for an exemption from copay and/or "DATA",9002313.26,5,1,3,0) coinsurance payments according to the benefit design. "DATA",9002313.26,6,0) 5^EXEMPT FROM RX "DATA",9002313.26,6,1,0) ^9002313.261^4^4^3101012^^ "DATA",9002313.26,6,1,1,0) Code used to classify the reason for the prior authorization request as "DATA",9002313.26,6,1,2,0) one used when the member has qualified for an exemption from limitations "DATA",9002313.26,6,1,3,0) on the number of prescriptions covered by the program/plan in a specified "DATA",9002313.26,6,1,4,0) period of time. "DATA",9002313.26,7,0) 6^FAMILY PLANNING INDICATOR "DATA",9002313.26,7,1,0) ^9002313.261^1^1^3101012^^ "DATA",9002313.26,7,1,1,0) Code to indicate the drug prescribed is for management of reproduction. "DATA",9002313.26,8,0) 7^TANF "DATA",9002313.26,8,1,0) ^9002313.261^4^4^3101012^^^^ "DATA",9002313.26,8,1,1,0) (Temporary Assistance for Needy Families) - An organization that provides "DATA",9002313.26,8,1,2,0) assistance and work opportunities to needy families by granting states "DATA",9002313.26,8,1,3,0) the federal funds and the flexibility to develop and implement their own "DATA",9002313.26,8,1,4,0) welfare programs. "DATA",9002313.26,9,0) 8^PAYER DEFINED EXEMPTION "DATA",9002313.26,9,1,0) ^9002313.261^3^3^3101012^^ "DATA",9002313.26,9,1,1,0) Used to indicate the provider is submitting the prior authorization for "DATA",9002313.26,9,1,2,0) the purpose of utilizing a payer defined exemption not covered by one of "DATA",9002313.26,9,1,3,0) the other type codes. "DATA",9002313.26,10,0) 9^EMERGENCY PREPAREDNESS "DATA",9002313.26,10,1,0) ^^1^1^3080312^ "DATA",9002313.26,10,1,1,0) Code used to override claim edits during an emergency situation. "DATA",9002313.27,1,0) 0^NOT SPECIFIED "DATA",9002313.27,1,1,0) ^^1^1^3100817^ "DATA",9002313.27,1,1,1,0) Not Specified - Other patient residence not identified below. "DATA",9002313.27,2,0) 1^HOME "DATA",9002313.27,2,1,0) ^^1^1^3100817^ "DATA",9002313.27,2,1,1,0) Home - Location, other than a hospital or other facility. "DATA",9002313.27,3,0) 2^SKILLED NURSING FACILITY "DATA",9002313.27,3,1,0) ^^1^1^3100817^ "DATA",9002313.27,3,1,1,0) Skilled Nursing Facility. "DATA",9002313.27,4,0) 3^NURSING FACILITY "DATA",9002313.27,4,1,0) ^^1^1^3100817^ "DATA",9002313.27,4,1,1,0) Nursing facility. "DATA",9002313.27,5,0) 4^ASSISTED LIVING FACILITY "DATA",9002313.27,5,1,0) ^^1^1^3100817^ "DATA",9002313.27,5,1,1,0) Assisted living. "DATA",9002313.27,6,0) 5^CUSTODIAL CARE FACILITY "DATA",9002313.27,6,1,0) ^^1^1^3100817^ "DATA",9002313.27,6,1,1,0) Custodial care. "DATA",9002313.27,7,0) 6^GROUP HOME "DATA",9002313.27,7,1,0) ^^1^1^3100817^ "DATA",9002313.27,7,1,1,0) Group. "DATA",9002313.27,8,0) 7^INPATIENT PSYCHIATRIC FACILITY "DATA",9002313.27,8,1,0) ^^1^1^3100817^ "DATA",9002313.27,8,1,1,0) Inpatient Psychiatric. "DATA",9002313.27,9,0) 8^PYSCHIATRIC FACILITY "DATA",9002313.27,9,1,0) ^^1^1^3100817^ "DATA",9002313.27,9,1,1,0) Psychiatric Facility - Partial Hospitalization. "DATA",9002313.27,10,0) 9^INTERMEDIATE CARE FACILITY "DATA",9002313.27,10,1,0) ^^1^1^3100817^ "DATA",9002313.27,10,1,1,0) Intermediate Care Facility/Mentally Retarded. "DATA",9002313.27,11,0) 10^SUBSTANCE ABUSE FACILITY "DATA",9002313.27,11,1,0) ^^1^1^3100817^ "DATA",9002313.27,11,1,1,0) Residential Substance Abuse Treatment Facility. "DATA",9002313.27,12,0) 11^HOSPICE "DATA",9002313.27,12,1,0) ^^1^1^3100817^ "DATA",9002313.27,12,1,1,0) Hospice. "DATA",9002313.27,13,0) 12^PSYCHIATRIC RESIDENTIAL "DATA",9002313.27,13,1,0) ^^1^1^3100817^ "DATA",9002313.27,13,1,1,0) Psychiatric Residential Treatment. "DATA",9002313.27,14,0) 13^INPATIENT REHAB FACILITY "DATA",9002313.27,14,1,0) ^^1^1^3100817^ "DATA",9002313.27,14,1,1,0) Comprehensive Inpatient Rehabilitation Facility. "DATA",9002313.27,15,0) 14^HOMELESS SHELTER "DATA",9002313.27,15,1,0) ^^1^1^3100817^ "DATA",9002313.27,15,1,1,0) Homeless Shelter. "DATA",9002313.27,16,0) 15^CORRECTIONAL INSTITUTION "DATA",9002313.27,16,1,0) ^^1^1^3100817^ "DATA",9002313.27,16,1,1,0) Correctional Institution. "DATA",9002313.28,1,0) 1^COMMUNITY/RETAIL "DATA",9002313.28,1,1,0) ^^1^1^3100819^ "DATA",9002313.28,1,1,1,0) Community/Retail Pharmacy Services "DATA",9002313.28,2,0) 2^COMPOUNDING "DATA",9002313.28,2,1,0) ^^1^1^3100819^ "DATA",9002313.28,2,1,1,0) Compounding Pharmacy Services "DATA",9002313.28,3,0) 3^HOME INFUSION THERAPY "DATA",9002313.28,3,1,0) ^^1^1^3100819^ "DATA",9002313.28,3,1,1,0) Home Infusion Therapy Provider Services "DATA",9002313.28,4,0) 4^INSTITUTIONAL "DATA",9002313.28,4,1,0) ^^1^1^3100819^ "DATA",9002313.28,4,1,1,0) Institutional Pharmacy Services "DATA",9002313.28,5,0) 5^LONG TERM CARE "DATA",9002313.28,5,1,0) ^^1^1^3100819^ "DATA",9002313.28,5,1,1,0) Long Term Care Pharmacy Services "DATA",9002313.28,6,0) 6^MAIL ORDER "DATA",9002313.28,6,1,0) ^^1^1^3100819^ "DATA",9002313.28,6,1,1,0) Mail Order Pharmacy Services "DATA",9002313.28,7,0) 7^MANAGED CARE ORGANIZATION "DATA",9002313.28,7,1,0) ^^1^1^3100819^ "DATA",9002313.28,7,1,1,0) Managed Care Organization Pharmacy Service "DATA",9002313.28,8,0) 8^SPECIALTY CARE "DATA",9002313.28,8,1,0) ^^1^1^3100819^ "DATA",9002313.28,8,1,1,0) Specialty Care Pharmacy Services "DATA",9002313.28,9,0) 99^OTHER "DATA",9002313.28,9,1,0) ^^1^1^3100819^ "DATA",9002313.28,9,1,1,0) Other "DATA",9002313.29,1,0) 1^PROOF OF ELIGIBILITY UNKNOWN "DATA",9002313.29,1,1,0) ^9002313.291^3^3^3110810^^ "DATA",9002313.29,1,1,1,0) Transaction delayed because identification card or verification "DATA",9002313.29,1,1,2,0) transaction not available, or patient enrollment in benefit plan not "DATA",9002313.29,1,1,3,0) complete at the time of service. "DATA",9002313.29,2,0) 2^LITIGATION "DATA",9002313.29,2,1,0) ^^2^2^3110810^ "DATA",9002313.29,2,1,1,0) Transaction delayed because litigation to determine liability for medical "DATA",9002313.29,2,1,2,0) expenditures was unresolved at the time of service. "DATA",9002313.29,3,0) 3^AUTHORIZATION DELAYS "DATA",9002313.29,3,1,0) ^^2^2^3110810^ "DATA",9002313.29,3,1,1,0) Transaction delayed because the review process for authorization of the "DATA",9002313.29,3,1,2,0) service was not completed/finalized at the time of service. "DATA",9002313.29,4,0) 4^DELAY IN CERTIFYING PROVIDER "DATA",9002313.29,4,1,0) ^^2^2^3110810^ "DATA",9002313.29,4,1,1,0) Transaction delayed because the provider certification for participation "DATA",9002313.29,4,1,2,0) with the plan was not completed/finalized at the time of service. "DATA",9002313.29,5,0) 5^DELAY - BILLING FORMS "DATA",9002313.29,5,1,0) ^^2^2^3110810^ "DATA",9002313.29,5,1,1,0) Transaction delayed because specified billing form was not available at "DATA",9002313.29,5,1,2,0) the time of service. "DATA",9002313.29,6,0) 6^DELAY - CUSTOM-MADE APPLIANCES "DATA",9002313.29,6,1,0) ^^2^2^3110810^ "DATA",9002313.29,6,1,1,0) Transaction delayed because custom-fabricated appliance was not ready for "DATA",9002313.29,6,1,2,0) delivery at the time related services/supplies were provided. "DATA",9002313.29,7,0) 7^THIRD PARTY PROCESSING DELAY "DATA",9002313.29,7,1,0) ^^2^2^3110810^ "DATA",9002313.29,7,1,1,0) Transaction delayed because payment decision of third party payer(s) was "DATA",9002313.29,7,1,2,0) not complete/received at the time of service. "DATA",9002313.29,8,0) 8^ELIGIBILITY DETERMINATION "DATA",9002313.29,8,1,0) ^9002313.291^3^3^3110810^^ "DATA",9002313.29,8,1,1,0) Transaction delayed because patient enrollment in benefit plan not "DATA",9002313.29,8,1,2,0) complete at the time of service or subsequent determination made "DATA",9002313.29,8,1,3,0) enrollment retroactive to or prior to the date of service. "DATA",9002313.29,9,0) 9^ORIGINAL CLAIMS REJECTED "DATA",9002313.29,9,1,0) ^^2^2^3110810^ "DATA",9002313.29,9,1,1,0) Transaction delayed for correction of inadequacies or errors on previous, "DATA",9002313.29,9,1,2,0) timely submitted claims. "DATA",9002313.29,10,0) 10^ADMIN DELAY IN PRIOR APPROVAL "DATA",9002313.29,10,1,0) ^^2^2^3110810^ "DATA",9002313.29,10,1,1,0) Transaction delayed because the authorizing entity was unable to complete "DATA",9002313.29,10,1,2,0) and/or provide the authorization prior to the time of service. "DATA",9002313.29,11,0) 11^OTHER "DATA",9002313.29,11,1,0) ^9002313.291^1^1^3110810^^^^ "DATA",9002313.29,11,1,1,0) Does not fit within any of the other delay reason codes "DATA",9002313.29,12,0) 12^RECEIVED LATE W/ NO EXCEPTIONS "DATA",9002313.29,12,1,0) ^9002313.291^1^1^3110810^^^^ "DATA",9002313.29,12,1,1,0) Received late with no exceptions "DATA",9002313.29,13,0) 13^DAMAGE TO PROVIDER RECORDS "DATA",9002313.29,13,1,0) ^9002313.291^2^2^3110810^^ "DATA",9002313.29,13,1,1,0) Transaction delayed because damaged records of services had to be "DATA",9002313.29,13,1,2,0) reconstructed in order to complete the transaction "DATA",9002313.29,14,0) 14^THEFT/OTHER ACTS BY EMPLOYEE "DATA",9002313.29,14,1,0) ^^1^1^3110810^ "DATA",9002313.29,14,1,1,0) Transaction delayed because of employee misconduct "DATA",9002313.91,1,0) 101^^BIN NUMBER^N^^^^6^N "DATA",9002313.91,1,1) "DATA",9002313.91,1,5) A1^6 "DATA",9002313.91,1,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,1,10,1,0) S BPS("X")=$G(BPS("NCPDP","BIN Number")) "DATA",9002313.91,1,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,1,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),6) "DATA",9002313.91,1,25,0) ^9002313.9104^1^1^3040130^^^^ "DATA",9002313.91,1,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),6) "DATA",9002313.91,1,30,0) ^9002313.9103^1^1^3040130^^^^ "DATA",9002313.91,1,30,1,0) S $P(^BPSC(BPS(9002313.02),100),U,1)=BPS("X") "DATA",9002313.91,2,0) 102^^VERSION/RELEASE NUMBER^A/N^^^^2^A/N "DATA",9002313.91,2,1) "DATA",9002313.91,2,5) A2^2 "DATA",9002313.91,2,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,2,10,1,0) S BPS("X")=$G(BPS("NCPDP","Version")) "DATA",9002313.91,2,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,2,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,2,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,2,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,2,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,2,30,1,0) S $P(^BPSC(BPS(9002313.02),100),U,2)=BPS("X") "DATA",9002313.91,3,0) 103^^TRANSACTION CODE^N^^^^2^A/N "DATA",9002313.91,3,1) "DATA",9002313.91,3,5) A3^2 "DATA",9002313.91,3,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,3,10,1,0) S BPS("X")=$G(BPS("Transaction Code")) "DATA",9002313.91,3,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,3,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,3,25,0) ^9002313.9104^1^1^3040130^^^^ "DATA",9002313.91,3,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,3,30,0) ^9002313.9103^1^1^3040130^^^^ "DATA",9002313.91,3,30,1,0) S $P(^BPSC(BPS(9002313.02),100),U,3)=BPS("X") "DATA",9002313.91,4,0) 104^^PROCESSOR CONTROL NUMBER^A/N^^^^10^A/N "DATA",9002313.91,4,1) "DATA",9002313.91,4,5) A4^10 "DATA",9002313.91,4,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,4,10,1,0) S BPS("X")=$G(BPS("NCPDP","PCN")) "DATA",9002313.91,4,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,4,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,4,25,0) ^9002313.9104^1^1^3040820^^^^ "DATA",9002313.91,4,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,4,30,0) ^9002313.9103^1^1^3040820^^^^ "DATA",9002313.91,4,30,1,0) S $P(^BPSC(BPS(9002313.02),100),U,4)=BPS("X") "DATA",9002313.91,5,0) 201^^SERVICE PROVIDER ID^A/N^^^^15^A/N "DATA",9002313.91,5,1) "DATA",9002313.91,5,5) B1^12 "DATA",9002313.91,5,10,0) ^^1^1^3110523^ "DATA",9002313.91,5,10,1,0) S BPS("X")=$G(BPS("Site","NPI")) "DATA",9002313.91,5,20,0) ^9002313.9102^1^1^3110523^ "DATA",9002313.91,5,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,5,25,0) ^^1^1^3110523^ "DATA",9002313.91,5,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,5,30,0) ^^1^1^3110523^ "DATA",9002313.91,5,30,1,0) S $P(^BPSC(BPS(9002313.02),200),U,1)=BPS("X") "DATA",9002313.91,6,0) 301^^GROUP ID^A/N^^^^15^A/N "DATA",9002313.91,6,1) "DATA",9002313.91,6,5) C1^15 "DATA",9002313.91,6,10,0) ^9002313.9101^1^1^3101216^ "DATA",9002313.91,6,10,1,0) S BPS("X")=$G(BPS("Insurer","Group #")) "DATA",9002313.91,6,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,6,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,6,25,0) ^9002313.9104^1^1^3041021^^^^ "DATA",9002313.91,6,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,6,30,0) ^9002313.9103^1^1^3041021^^^^ "DATA",9002313.91,6,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,1)=BPS("X") "DATA",9002313.91,7,0) 302^^CARDHOLDER ID^A/N^^^^20^A/N "DATA",9002313.91,7,1) "DATA",9002313.91,7,5) C2^20 "DATA",9002313.91,7,10,0) ^9002313.9101^1^1^3041021 "DATA",9002313.91,7,10,1,0) S BPS("X")=$G(BPS("Insurer","Policy #")) "DATA",9002313.91,7,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,7,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,7,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,7,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,7,30,0) ^9002313.9103^1^1^3101004^^^ "DATA",9002313.91,7,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,2)=$TR(BPS("X")," ","") "DATA",9002313.91,8,0) 303^^PERSON CODE^A/N^^^^3^A/N "DATA",9002313.91,8,1) "DATA",9002313.91,8,5) C3^3 "DATA",9002313.91,8,10,0) ^9002313.9101^1^1^3040114 "DATA",9002313.91,8,10,1,0) S BPS("X")=$G(BPS("Insurer","Person Code")) "DATA",9002313.91,8,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,8,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,8,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,8,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,8,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,8,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,3)=BPS("X") "DATA",9002313.91,9,0) 304^^DATE OF BIRTH^N^^^^8^N "DATA",9002313.91,9,1) "DATA",9002313.91,9,5) C4^8 "DATA",9002313.91,9,10,0) ^9002313.9101^1^1^3040820 "DATA",9002313.91,9,10,1,0) S BPS("X")=$G(BPS("Patient","DOB")) "DATA",9002313.91,9,20,0) ^9002313.9102^1^1^3101029^ "DATA",9002313.91,9,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,9,25,0) ^9002313.9104^1^1^3040820^^^^ "DATA",9002313.91,9,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,9,30,0) ^9002313.9103^1^1^3101004^ "DATA",9002313.91,9,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,4)=$G(BPS("X")) "DATA",9002313.91,10,0) 305^^PATIENT GENDER CODE^N^^^^1^N "DATA",9002313.91,10,1) "DATA",9002313.91,10,5) C5^1 "DATA",9002313.91,10,10,0) ^9002313.9101^3^3^3040114 "DATA",9002313.91,10,10,1,0) S BPS("X")=$G(BPS("Patient","Sex")) "DATA",9002313.91,10,10,2,0) S BPS("X")=$E(BPS("X"),1,1) "DATA",9002313.91,10,10,3,0) S BPS("X")=$S(BPS("X")="M":"1",BPS("X")="F":"2",1:"0") "DATA",9002313.91,10,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,10,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,10,25,0) ^9002313.9104^1^1^3040114^^ "DATA",9002313.91,10,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,10,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,10,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,5)=BPS("X") "DATA",9002313.91,11,0) 306^^PATIENT RELATIONSHIP CODE^N^^^^1^N "DATA",9002313.91,11,1) "DATA",9002313.91,11,5) C6^1 "DATA",9002313.91,11,10,0) ^9002313.9101^1^1^3040114 "DATA",9002313.91,11,10,1,0) S BPS("X")=$G(BPS("Insurer","Relationship")) "DATA",9002313.91,11,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,11,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,11,25,0) ^9002313.9104^1^1^3040114^^^ "DATA",9002313.91,11,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,11,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,11,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,6)=BPS("X") "DATA",9002313.91,12,0) 308^^OTHER COVERAGE CODE^N^^^^2^N "DATA",9002313.91,12,1) "DATA",9002313.91,12,5) C8^2 "DATA",9002313.91,12,10,0) ^9002313.9101^2^2^3101115^ "DATA",9002313.91,12,10,1,0) S BPS("X")=$G(BPS("Patient","Other Coverage Code")) "DATA",9002313.91,12,10,2,0) S:'BPS("X") BPS("X")=0 "DATA",9002313.91,12,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,12,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,12,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,12,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,12,30,0) ^9002313.9103^1^1^3101115^^^ "DATA",9002313.91,12,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),300),U,8)=BPS("X") "DATA",9002313.91,13,0) 401^^DATE OF SERVICE^N^^^^8^N "DATA",9002313.91,13,1) "DATA",9002313.91,13,5) D1^8 "DATA",9002313.91,13,10,0) ^9002313.9101^1^1^3101116^ "DATA",9002313.91,13,10,1,0) S BPS("X")=$G(BPS("RX",BPS("RX",0),"Date Filled")) "DATA",9002313.91,13,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,13,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,13,25,0) ^9002313.9104^1^1^3040113^^^^ "DATA",9002313.91,13,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,13,30,0) ^9002313.9103^2^2^3101116^ "DATA",9002313.91,13,30,1,0) S $P(^BPSC(BPS(9002313.02),401),U,1)=BPS("X") "DATA",9002313.91,13,30,2,0) S $P(^BPSC(BPS(9002313.02),400,BPS("RX",0),400),U,1)=BPS("X") "DATA",9002313.91,14,0) 307^^PLACE OF SERVICE^A/N^^^^2^N "DATA",9002313.91,14,1) "DATA",9002313.91,14,5) C7^2 "DATA",9002313.91,14,10,0) ^9002313.9101^1^1^3040820 "DATA",9002313.91,14,10,1,0) S BPS("X")=$G(BPS("Patient","Place of Service")) "DATA",9002313.91,14,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,14,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,14,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,14,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,14,30,0) ^9002313.9103^1^1^3100910^^^^ "DATA",9002313.91,14,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,7)=BPS("X") "DATA",9002313.91,15,0) 309^^ELIGIBILITY CLARIFICATION CODE^N^^^^1^N "DATA",9002313.91,15,1) "DATA",9002313.91,15,5) C9^1 "DATA",9002313.91,15,10,0) ^^2^2^3110727^ "DATA",9002313.91,15,10,1,0) S BPS("X")=$G(BPS("Insurer","Eligibility Clarification Code")) "DATA",9002313.91,15,10,2,0) S:BPS("X")="" BPS("X")=0 "DATA",9002313.91,15,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,15,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,15,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,15,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,15,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,15,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,9)=BPS("X") "DATA",9002313.91,16,0) 310^^PATIENT FIRST NAME^A/N^^^^12^A/N "DATA",9002313.91,16,1) "DATA",9002313.91,16,5) CA^12 "DATA",9002313.91,16,10,0) ^^1^1^3101216^ "DATA",9002313.91,16,10,1,0) S BPS("X")=$G(BPS("Patient","First Name")) "DATA",9002313.91,16,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,16,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,16,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,16,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,16,30,0) ^9002313.9103^1^1^3101004^^^^ "DATA",9002313.91,16,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,10)=BPS("X") "DATA",9002313.91,17,0) 311^^PATIENT LAST NAME^A/N^^^^15^A/N "DATA",9002313.91,17,1) "DATA",9002313.91,17,5) CB^15 "DATA",9002313.91,17,10,0) ^^1^1^3101216^ "DATA",9002313.91,17,10,1,0) S BPS("X")=$G(BPS("Patient","Last Name")) "DATA",9002313.91,17,20,0) ^9002313.9102^1^1^3101004^ "DATA",9002313.91,17,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,17,25,0) ^9002313.9104^1^1^3101004^^^ "DATA",9002313.91,17,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,17,30,0) ^9002313.9103^1^1^3101004^^^ "DATA",9002313.91,17,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,11)=$G(BPS("X")) "DATA",9002313.91,18,0) 402^^PRESCRIPTION/SERVICE REF NO^N^^^^12^N "DATA",9002313.91,18,1) PRESCRIPTION/SERVICE REFERENCE NUMBER "DATA",9002313.91,18,5) D2^7 "DATA",9002313.91,18,10,0) ^9002313.9101^1^1^3101115^^^^ "DATA",9002313.91,18,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"RX IEN")) "DATA",9002313.91,18,20,0) ^9002313.9102^2^2^3101006^ "DATA",9002313.91,18,20,1,0) I $L(BPS("X"))>12 S BPS("X")=$E(BPS("X"),$L(BPS("X"))-11,$L(BPS("X"))) "DATA",9002313.91,18,20,2,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,18,25,0) ^9002313.9104^2^2^3101006^^^^ "DATA",9002313.91,18,25,1,0) I $L(BPS("X"))>7 S BPS("X")=$E(BPS("X"),$L(BPS("X"))-6,$L(BPS("X"))) "DATA",9002313.91,18,25,2,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),7) "DATA",9002313.91,18,30,0) ^9002313.9103^1^1^3101115^^^^ "DATA",9002313.91,18,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,2)=BPS("X") "DATA",9002313.91,19,0) 403^^FILL NUMBER^N^^^^2^N "DATA",9002313.91,19,1) "DATA",9002313.91,19,5) D3^2 "DATA",9002313.91,19,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,19,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Refill #")) "DATA",9002313.91,19,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,19,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,19,25,0) ^9002313.9104^1^1^3030718^^ "DATA",9002313.91,19,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,19,30,0) 1^9002313.9103^1^1^3030718^^^ "DATA",9002313.91,19,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,3)=BPS("X") "DATA",9002313.91,21,0) 405^^DAYS SUPPLY^N^^^^3^N "DATA",9002313.91,21,1) "DATA",9002313.91,21,5) D5^3 "DATA",9002313.91,21,10,0) ^9002313.9101^1^1^3040109 "DATA",9002313.91,21,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Days Supply")) "DATA",9002313.91,21,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,21,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,21,25,0) ^9002313.9104^1^1^3030827^^^^ "DATA",9002313.91,21,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,21,30,0) ^9002313.9103^1^1^3030827^^^^ "DATA",9002313.91,21,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,5)=BPS("X") "DATA",9002313.91,22,0) 406^^COMPOUND CODE^N^^^^1^N "DATA",9002313.91,22,1) "DATA",9002313.91,22,5) D6^407 "DATA",9002313.91,22,10,0) ^9002313.9101^2^2^3040114 "DATA",9002313.91,22,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Compound Code")) "DATA",9002313.91,22,10,2,0) S:BPS("X")="" BPS("X")=1 "DATA",9002313.91,22,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,22,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,22,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,22,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,22,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,22,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,6)=BPS("X") "DATA",9002313.91,23,0) 407^^PRODUCT/SERVICE ID^A/N^^^^19^A/N "DATA",9002313.91,23,1) "DATA",9002313.91,23,5) D7^19 "DATA",9002313.91,23,10,0) ^9002313.9101^2^2^3030825 "DATA",9002313.91,23,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"NDC")) "DATA",9002313.91,23,10,2,0) S BPS("X")=$$NDCF^BPSECFM(BPS("X")) "DATA",9002313.91,23,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,23,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,23,25,0) ^9002313.9104^1^1^3030825^^^ "DATA",9002313.91,23,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,23,30,0) ^9002313.9103^1^1^3030825^^^^ "DATA",9002313.91,23,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,7)=BPS("X") "DATA",9002313.91,24,0) 408^^DAW PRODUCT SELECTION CODE^N^^^^1^A/N "DATA",9002313.91,24,1) DISPENSE AS WRITTEN (DAW)/ PRODUCT SELECTION CODE "DATA",9002313.91,24,5) D8^1 "DATA",9002313.91,24,10,0) ^9002313.9101^2^2^3070205 "DATA",9002313.91,24,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"DAW")) "DATA",9002313.91,24,10,2,0) S:BPS("X")="" BPS("X")=0 "DATA",9002313.91,24,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,24,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,24,25,0) ^9002313.9104^1^1^3061120^ "DATA",9002313.91,24,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,24,30,0) ^9002313.9103^1^1^3030722^ "DATA",9002313.91,24,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,8)=BPS("X") "DATA",9002313.91,25,0) 409^^INGREDIENT COST^D^^^^8^D "DATA",9002313.91,25,1) "DATA",9002313.91,25,5) D9^8 "DATA",9002313.91,25,10,0) ^9002313.9101^1^1^3040907 "DATA",9002313.91,25,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Gross Amount Due")) "DATA",9002313.91,25,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,25,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,25,25,0) ^9002313.9104^1^1^3040907^^^^ "DATA",9002313.91,25,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,25,30,0) ^9002313.9103^1^1^3040907^^^^ "DATA",9002313.91,25,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,9)=BPS("X") "DATA",9002313.91,26,0) 411^^PRESCRIBER ID^A/N^^^^15^A/N "DATA",9002313.91,26,1) "DATA",9002313.91,26,5) DB^15 "DATA",9002313.91,26,10,0) ^9002313.9101^1^1^3070214 "DATA",9002313.91,26,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber NPI")) "DATA",9002313.91,26,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,26,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,26,25,0) ^9002313.9104^1^1^3070214^ "DATA",9002313.91,26,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,26,30,0) ^9002313.9103^1^1^3030823^^^^ "DATA",9002313.91,26,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,11)=BPS("X") "DATA",9002313.91,27,0) 414^^DATE PRESCRIPTION WRITTEN^N^^^^8^N "DATA",9002313.91,27,1) "DATA",9002313.91,27,5) DE^8 "DATA",9002313.91,27,10,0) ^9002313.9101^1^1^3040913 "DATA",9002313.91,27,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Date Written")) "DATA",9002313.91,27,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,27,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,27,25,0) ^9002313.9104^1^1^3040913^^^^ "DATA",9002313.91,27,25,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,27,30,0) ^9002313.9103^1^1^3040913^^^^ "DATA",9002313.91,27,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,14)=BPS("X") "DATA",9002313.91,28,0) 415^^NUMBER OF REFILLS AUTHORIZED^N^^^^2^N "DATA",9002313.91,28,1) "DATA",9002313.91,28,5) DF^2 "DATA",9002313.91,28,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,28,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"# Refills")) "DATA",9002313.91,28,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,28,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,28,25,0) ^9002313.9104^1^1^3030718^^ "DATA",9002313.91,28,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,28,30,0) ^9002313.9103^1^1^3030718^^^^ "DATA",9002313.91,28,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,15)=BPS("X") "DATA",9002313.91,29,0) 419^^PRESCRIPTION ORIGIN CODE^N^^^^1^N "DATA",9002313.91,29,1) "DATA",9002313.91,29,5) DJ^1 "DATA",9002313.91,29,10,0) ^9002313.9101^2^2^3030721 "DATA",9002313.91,29,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Origin Code")) "DATA",9002313.91,29,10,2,0) S:BPS("X")="" BPS("X")="0" "DATA",9002313.91,29,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,29,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,29,25,0) ^9002313.9104^1^1^3030721^^^^ "DATA",9002313.91,29,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,29,30,0) ^9002313.9103^1^1^3030721^^^^ "DATA",9002313.91,29,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,19)=BPS("X") "DATA",9002313.91,30,0) 420^^SUBMISSION CLARIFICATION CODE^N^^^^2^N "DATA",9002313.91,30,1) "DATA",9002313.91,30,5) DK^2 "DATA",9002313.91,30,10,0) ^9002313.9101^1^1^3101006^^^^ "DATA",9002313.91,30,10,1,0) ; GET CODE handled by FLD420^BPSOSSG "DATA",9002313.91,30,20,0) ^9002313.9102^1^1^3101006^^^^ "DATA",9002313.91,30,20,1,0) ; vD.0 FORMAT CODE handled by FLD420^BPSOSSG "DATA",9002313.91,30,25,0) ^9002313.9104^1^1^3101006^^^^ "DATA",9002313.91,30,25,1,0) ; FORMAT CODE handled by FLD420^BPSOSSG "DATA",9002313.91,30,30,0) ^9002313.9103^1^1^3101006^^^^ "DATA",9002313.91,30,30,1,0) D FLD420^BPSOSSG "DATA",9002313.91,31,0) 453^^ORIG PRESCR PROD/SERV ID QUAL^N^^^^2^A/N "DATA",9002313.91,31,1) ORIGINALLY PRESCRIBED PRODUCT/SERVICE ID QUALIFIER "DATA",9002313.91,31,5) EJ^2 "DATA",9002313.91,31,10,0) ^9002313.9101^1^1^3040907 "DATA",9002313.91,31,10,1,0) S BPS("X")="" "DATA",9002313.91,31,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,31,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,31,25,0) ^9002313.9104^1^1^3040907^^^^ "DATA",9002313.91,31,25,1,0) S BPS("X")=$$NFF^BPSECFM(BPS("X"),2) "DATA",9002313.91,31,30,0) ^9002313.9103^1^1^3040907^^^ "DATA",9002313.91,31,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,3)="" "DATA",9002313.91,33,0) 423^^BASIS OF COST DETERMINATION^A/N^^^^2^A/N "DATA",9002313.91,33,1) "DATA",9002313.91,33,5) DN^2 "DATA",9002313.91,33,10,0) ^9002313.9101^1^1^3030916 "DATA",9002313.91,33,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Basis of Cost Determination")) "DATA",9002313.91,33,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,33,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,33,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,33,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,33,30,0) ^9002313.9103^1^1^3030916^^^^ "DATA",9002313.91,33,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,23)=BPS("X") "DATA",9002313.91,34,0) 424^^DIAGNOSIS CODE^A/N^^^^15^A/N "DATA",9002313.91,34,1) "DATA",9002313.91,34,5) DO^15 "DATA",9002313.91,34,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,34,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Diagnosis Code")) "DATA",9002313.91,34,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,34,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,34,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,34,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,34,30,0) ^9002313.9103^1^1^3030718^^ "DATA",9002313.91,34,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,24)=BPS("X") "DATA",9002313.91,35,0) 430^^GROSS AMOUNT DUE^D^^^^8^D "DATA",9002313.91,35,1) "DATA",9002313.91,35,5) DU^8 "DATA",9002313.91,35,10,0) ^9002313.9101^1^1^3030722 "DATA",9002313.91,35,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Gross Amount Due")) "DATA",9002313.91,35,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,35,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,35,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,35,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,35,30,0) ^9002313.9103^1^1^3030722^^^^ "DATA",9002313.91,35,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,30)=BPS("X") "DATA",9002313.91,36,0) 433^^PATIENT PAID AMOUNT^D^^^^8^D "DATA",9002313.91,36,1) PATIENT PAID AMOUNT SUBMITTED "DATA",9002313.91,36,5) DX^8 "DATA",9002313.91,36,10,0) ^^2^2^3110727^ "DATA",9002313.91,36,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Patient Paid Amount")) "DATA",9002313.91,36,10,2,0) S:BPS("X")="" BPS("X")="0.00" "DATA",9002313.91,36,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,36,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,36,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,36,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,36,30,0) ^9002313.9103^1^1^3030916^^ "DATA",9002313.91,36,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),430),U,3)=BPS("X") "DATA",9002313.91,37,0) 439^^REASON FOR SERVICE CODE^A/N^^^^2^A/N "DATA",9002313.91,37,1) "DATA",9002313.91,37,5) E4^2 "DATA",9002313.91,37,10,0) ^9002313.9101^1^1^3031230 "DATA",9002313.91,37,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"DUR","DUR Conflict Code",439)) "DATA",9002313.91,37,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,37,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,37,25,0) ^9002313.9104^1^1^3031230^^ "DATA",9002313.91,37,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,37,30,0) ^9002313.9103^1^1^3101115^^^^ "DATA",9002313.91,37,30,1,0) D FLD439^BPSOSSG "DATA",9002313.91,38,0) 440^^PROFESSIONAL SERVICE CODE^A/N^^^^2^A/N "DATA",9002313.91,38,1) "DATA",9002313.91,38,5) E5^2 "DATA",9002313.91,38,10,0) ^9002313.9101^1^1^3031230 "DATA",9002313.91,38,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"DUR","DUR Intervention Code",440)) "DATA",9002313.91,38,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,38,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,38,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,38,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,38,30,0) ^9002313.9103^1^1^3101115^ "DATA",9002313.91,38,30,1,0) D FLD440^BPSOSSG "DATA",9002313.91,39,0) 441^^RESULT OF SERVICE CODE^A/N^^^^2^A/N "DATA",9002313.91,39,1) "DATA",9002313.91,39,5) E6^2 "DATA",9002313.91,39,10,0) ^9002313.9101^2^2^3070214 "DATA",9002313.91,39,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"DUR","DUR Outcome Code",441)) "DATA",9002313.91,39,10,2,0) S:BPS("X")="" BPS("X")="00" "DATA",9002313.91,39,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,39,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,39,25,0) ^9002313.9104^1^1^3070214^^ "DATA",9002313.91,39,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,39,30,0) ^9002313.9103^1^1^3101115^ "DATA",9002313.91,39,30,1,0) D FLD441^BPSOSSG "DATA",9002313.91,40,0) 442^^QUANTITY DISPENSED^N^^^^10^N "DATA",9002313.91,40,1) "DATA",9002313.91,40,5) E7^10 "DATA",9002313.91,40,10,0) ^9002313.9101^1^1^3070620 "DATA",9002313.91,40,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Quantity"))*1000\1 "DATA",9002313.91,40,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,40,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,40,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,40,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,40,30,0) ^9002313.9103^1^1^3040109^^^^ "DATA",9002313.91,40,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),440),U,2)=BPS("X") "DATA",9002313.91,42,0) 412^^DISPENSING FEE SUBMITTED^D^^^^8^D "DATA",9002313.91,42,1) "DATA",9002313.91,42,5) DC^8 "DATA",9002313.91,42,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,42,10,1,0) S BPS("X")=0 "DATA",9002313.91,42,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,42,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,42,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,42,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,42,30,0) ^9002313.9103^1^1^3040907^^^^ "DATA",9002313.91,42,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,12)=BPS("X") "DATA",9002313.91,44,0) 418^^LEVEL OF SERVICE^N^^^^2^N "DATA",9002313.91,44,1) "DATA",9002313.91,44,5) DI^2 "DATA",9002313.91,44,10,0) ^9002313.9101^2^2^3101115^ "DATA",9002313.91,44,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Level of Service")) "DATA",9002313.91,44,10,2,0) S:BPS("X")="" BPS("X")=0 "DATA",9002313.91,44,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,44,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,44,25,0) ^9002313.9104^1^1^3070215^^ "DATA",9002313.91,44,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,44,30,0) ^9002313.9103^1^1^3070215^^^^ "DATA",9002313.91,44,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,18)=BPS("X") "DATA",9002313.91,45,0) 421^^PRIMARY CARE PROVIDER ID^A/N^^^^15^A/N "DATA",9002313.91,45,1) "DATA",9002313.91,45,5) DL^15 "DATA",9002313.91,45,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,45,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Primary Care Provider NPI")) "DATA",9002313.91,45,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,45,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,45,25,0) ^9002313.9104^1^1^3070214^ "DATA",9002313.91,45,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,45,30,0) ^9002313.9103^1^1^3041015^ "DATA",9002313.91,45,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,21)="" "DATA",9002313.91,46,0) 426^^USUAL AND CUSTOMARY CHARGE^D^^^^8^D "DATA",9002313.91,46,1) "DATA",9002313.91,46,5) DQ^8 "DATA",9002313.91,46,10,0) ^9002313.9101^1^1^3031219 "DATA",9002313.91,46,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Usual & Customary")) "DATA",9002313.91,46,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,46,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,46,25,0) ^9002313.9104^1^1^3031219^^^^ "DATA",9002313.91,46,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,46,30,0) ^9002313.9103^1^1^3031219^^^^ "DATA",9002313.91,46,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,26)=BPS("X") "DATA",9002313.91,47,0) 429^^SPECIAL PACKAGING INDICATOR^N^^^^1^N "DATA",9002313.91,47,1) "DATA",9002313.91,47,5) DT^1 "DATA",9002313.91,47,10,0) ^9002313.9101^2^2^3101115^ "DATA",9002313.91,47,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Unit Dose Indicator")) "DATA",9002313.91,47,10,2,0) S:BPS("X")="" BPS("X")=0 "DATA",9002313.91,47,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,47,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,47,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,47,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,47,30,0) ^9002313.9103^1^1^3030823^^^ "DATA",9002313.91,47,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,29)=BPS("X") "DATA",9002313.91,48,0) 431^^OTHER PAYOR AMOUNT^D^^^^8^D "DATA",9002313.91,48,1) "DATA",9002313.91,48,5) DV^8 "DATA",9002313.91,48,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,48,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,48,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,48,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,48,25,0) ^9002313.9104^1^1^3101029^ "DATA",9002313.91,48,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,48,30,0) ^9002313.9103^1^1^3100824 "DATA",9002313.91,48,30,1,0) D SET431^BPSFLD01 "DATA",9002313.91,49,0) 438^^INCENTIVE AMOUNT SUBMITTED^D^^^^8^D "DATA",9002313.91,49,1) "DATA",9002313.91,49,5) E3^8 "DATA",9002313.91,49,10,0) ^^1^1^3110505^ "DATA",9002313.91,49,10,1,0) S BPS("X")=0 "DATA",9002313.91,49,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,49,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,49,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,49,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,49,30,0) ^9002313.9103^1^1^3040907^ "DATA",9002313.91,49,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),430),U,8)="" "DATA",9002313.91,51,0) 443^^OTHER PAYER DATE^N^^^^8^N "DATA",9002313.91,51,1) "DATA",9002313.91,51,5) E8^8 "DATA",9002313.91,51,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,51,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,51,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,51,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,51,25,0) ^9002313.9104^1^1^3040224^ "DATA",9002313.91,51,25,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,51,30,0) ^9002313.9103^1^1^3100824 "DATA",9002313.91,51,30,1,0) D SET443^BPSFLD01 "DATA",9002313.91,52,0) 313^^CARDHOLDER LAST NAME^A/N^^^^15^A/N "DATA",9002313.91,52,1) "DATA",9002313.91,52,5) CD^15 "DATA",9002313.91,52,10,0) ^^1^1^3101216^ "DATA",9002313.91,52,10,1,0) S BPS("X")=$G(BPS("Cardholder","Last Name")) "DATA",9002313.91,52,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,52,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,52,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,52,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),15) "DATA",9002313.91,52,30,0) ^9002313.9103^1^1^3030823^^^^ "DATA",9002313.91,52,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,13)=BPS("X") "DATA",9002313.91,53,0) 312^^CARDHOLDER FIRST NAME^A/N^^^^12^A/N "DATA",9002313.91,53,1) "DATA",9002313.91,53,5) CC^12 "DATA",9002313.91,53,10,0) ^^1^1^3101216^ "DATA",9002313.91,53,10,1,0) S BPS("X")=$G(BPS("Cardholder","First Name")) "DATA",9002313.91,53,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,53,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,53,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,53,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),12) "DATA",9002313.91,53,30,0) ^9002313.9103^1^1^3101115^^^^ "DATA",9002313.91,53,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,12)=BPS("X") "DATA",9002313.91,54,0) 322^^PATIENT STREET ADDRESS^A/N^^^^30^A/N "DATA",9002313.91,54,1) "DATA",9002313.91,54,5) CM^30 "DATA",9002313.91,54,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,54,10,1,0) S BPS("X")=$G(BPS("Patient","Street Address")) "DATA",9002313.91,54,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,54,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,54,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,54,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),30) "DATA",9002313.91,54,30,0) ^9002313.9103^1^1^3030718^^^^ "DATA",9002313.91,54,30,1,0) S $P(^BPSC(BPS(9002313.02),321),U,2)=BPS("X") "DATA",9002313.91,55,0) 323^^PATIENT CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,55,1) "DATA",9002313.91,55,5) CN^20 "DATA",9002313.91,55,10,0) ^9002313.9101^1^1^3030703 "DATA",9002313.91,55,10,1,0) S BPS("X")=$G(BPS("Patient","City")) "DATA",9002313.91,55,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,55,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,55,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,55,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),20) "DATA",9002313.91,55,30,0) ^9002313.9103^1^1^3030703^^^^ "DATA",9002313.91,55,30,1,0) S $P(^BPSC(BPS(9002313.02),321),U,3)=BPS("X") "DATA",9002313.91,56,0) 324^^PATIENT STATE/PROVINCE ADDRESS^A/N^^^^2^A/N "DATA",9002313.91,56,1) "DATA",9002313.91,56,5) CO^2 "DATA",9002313.91,56,10,0) ^9002313.9101^1^1^3030717 "DATA",9002313.91,56,10,1,0) S BPS("X")=$G(BPS("Patient","State")) "DATA",9002313.91,56,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,56,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,56,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,56,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),2) "DATA",9002313.91,56,30,0) ^9002313.9103^1^1^3030717^^^^ "DATA",9002313.91,56,30,1,0) S $P(^BPSC(BPS(9002313.02),321),U,4)=BPS("X") "DATA",9002313.91,57,0) 325^^PATIENT ZIP/POSTAL ZONE^A/N^^^^15^A/N "DATA",9002313.91,57,1) "DATA",9002313.91,57,5) CP^15 "DATA",9002313.91,57,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,57,10,1,0) S BPS("X")=$G(BPS("Patient","Zip")) "DATA",9002313.91,57,20,0) ^9002313.9102^2^2^3101101 "DATA",9002313.91,57,20,1,0) S BPS("X")=$TR(BPS("X"),"-/._","") "DATA",9002313.91,57,20,2,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),15) "DATA",9002313.91,57,25,0) ^9002313.9104^2^2^3030718^^^^ "DATA",9002313.91,57,25,1,0) S BPS("X")=$TR(BPS("X"),"-/._","") "DATA",9002313.91,57,25,2,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),9) "DATA",9002313.91,57,30,0) ^9002313.9103^1^1^3030718^^^^ "DATA",9002313.91,57,30,1,0) S $P(^BPSC(BPS(9002313.02),321),U,5)=BPS("X") "DATA",9002313.91,58,0) 314^^HOME PLAN^A/N^^^^3^A/N "DATA",9002313.91,58,1) "DATA",9002313.91,58,5) CE^3 "DATA",9002313.91,58,10,0) ^9002313.9101^1^1^3030823 "DATA",9002313.91,58,10,1,0) S BPS("X")=$G(BPS("Home Plan")) "DATA",9002313.91,58,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,58,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,58,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,58,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),3) "DATA",9002313.91,58,30,0) ^9002313.9103^1^1^3030823^^^^ "DATA",9002313.91,58,30,1,0) S $P(^BPSC(BPS(9002313.02),300),U,14)=BPS("X") "DATA",9002313.91,59,0) 315^^EMPLOYER NAME^A/N^^^^30^A/N "DATA",9002313.91,59,1) "DATA",9002313.91,59,5) CF^30 "DATA",9002313.91,59,10,0) ^9002313.9101^2^2^3101115^ "DATA",9002313.91,59,10,1,0) D EMPL^BPSOSSG "DATA",9002313.91,59,10,2,0) S BPS("X")=$G(BPS("Employer","Name")) "DATA",9002313.91,59,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,59,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,59,25,0) ^9002313.9104^1^1^3030718^^^ "DATA",9002313.91,59,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),30) "DATA",9002313.91,59,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,59,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),310),U,5)=BPS("X") "DATA",9002313.91,60,0) 316^^EMPLOYER STREET ADDRESS^A/N^^^^30^A/N "DATA",9002313.91,60,1) "DATA",9002313.91,60,5) CG^30 "DATA",9002313.91,60,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,60,10,1,0) S BPS("X")=$G(BPS("Employer","Address")) "DATA",9002313.91,60,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,60,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,60,25,0) ^9002313.9104^1^1^3030718^^^ "DATA",9002313.91,60,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),30) "DATA",9002313.91,60,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,60,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),310),U,6)=BPS("X") "DATA",9002313.91,61,0) 317^^EMPLOYER CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,61,1) "DATA",9002313.91,61,5) CH^20 "DATA",9002313.91,61,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,61,10,1,0) S BPS("X")=$G(BPS("Employer","City")) "DATA",9002313.91,61,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,61,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,61,25,0) ^9002313.9104^1^1^3030718^^ "DATA",9002313.91,61,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),20) "DATA",9002313.91,61,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,61,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),310),U,7)=BPS("X") "DATA",9002313.91,62,0) 318^^EMPLOYER STATE/PROV ADDRESS^A/N^^^^2^A/N "DATA",9002313.91,62,1) EMPLOYER STATE/ PROVINCE ADDRESS "DATA",9002313.91,62,5) CI^2 "DATA",9002313.91,62,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,62,10,1,0) S BPS("X")=$G(BPS("Employer","State")) "DATA",9002313.91,62,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,62,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,62,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,62,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),2) "DATA",9002313.91,62,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,62,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),310),U,8)=BPS("X") "DATA",9002313.91,63,0) 319^^EMPLOYER ZIP/POSTAL ZONE^A/N^^^^15^A/N "DATA",9002313.91,63,1) "DATA",9002313.91,63,5) CJ^15 "DATA",9002313.91,63,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,63,10,1,0) S BPS("X")=$G(BPS("Employer","Zip Code")) "DATA",9002313.91,63,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,63,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,63,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,63,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),15) "DATA",9002313.91,63,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,63,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),310),U,9)=BPS("X") "DATA",9002313.91,64,0) 327^^CARRIER ID^A/N^^^^10^A/N "DATA",9002313.91,64,1) "DATA",9002313.91,64,5) CR^12 "DATA",9002313.91,64,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,64,10,1,0) S BPS("X")=$G(BPS("Carrier ID #")) "DATA",9002313.91,64,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,64,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,64,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,64,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),12) "DATA",9002313.91,64,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,64,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),320),U,7)=BPS("X") "DATA",9002313.91,67,0) 427^^PRESCRIBER LAST NAME^A/N^^^^15^A/N "DATA",9002313.91,67,1) "DATA",9002313.91,67,5) DR^15 "DATA",9002313.91,67,10,0) ^9002313.9101^1^1^3110107^^ "DATA",9002313.91,67,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber Last Name")) "DATA",9002313.91,67,20,0) ^9002313.9102^1^1^3110107^ "DATA",9002313.91,67,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,67,25,0) ^9002313.9104^1^1^3110107^^ "DATA",9002313.91,67,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),15) "DATA",9002313.91,67,30,0) ^9002313.9103^1^1^3110107^^^^ "DATA",9002313.91,67,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),420),U,27)=BPS("X") "DATA",9002313.91,69,0) 434^^DATE OF INJURY^N^^^^8^N "DATA",9002313.91,69,1) "DATA",9002313.91,69,5) DY^8 "DATA",9002313.91,69,10,0) ^9002313.9101^2^2^3101115^ "DATA",9002313.91,69,10,1,0) S BPS("X")=$G(BPS("Date of Injury")) "DATA",9002313.91,69,10,2,0) S BPS("X")=$$DTF1^BPSECFM(BPS("X")) "DATA",9002313.91,69,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,69,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,69,25,0) ^9002313.9104^1^1^3031210^^ "DATA",9002313.91,69,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,69,30,0) ^9002313.9103^1^1^3010125^^ "DATA",9002313.91,69,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,34)=BPS("X") "DATA",9002313.91,70,0) 435^^CLAIM/REFERENCE ID^A/N^^^^30^A/N "DATA",9002313.91,70,1) "DATA",9002313.91,70,5) DZ^30 "DATA",9002313.91,70,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,70,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Claim/Ref ID #")) "DATA",9002313.91,70,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,70,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,70,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,70,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),30) "DATA",9002313.91,70,30,0) ^9002313.9103^1^1^3030718^^^^ "DATA",9002313.91,70,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),400),U,35)=BPS("X") "DATA",9002313.91,71,0) 436^^PRODUCT/SERVICE ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,71,1) "DATA",9002313.91,71,5) E1^2 "DATA",9002313.91,71,10,0) ^9002313.9101^1^1^3040107 "DATA",9002313.91,71,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Alt. Product Type")) "DATA",9002313.91,71,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,71,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,71,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,71,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),2) "DATA",9002313.91,71,30,0) ^9002313.9103^1^1^3040107^^^^ "DATA",9002313.91,71,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),430),U,6)=BPS("X") "DATA",9002313.91,74,0) 498.51^^PRIOR AUTH PROCESSED DATE^A/N^^^^8^N "DATA",9002313.91,74,1) "DATA",9002313.91,74,5) PR^8 "DATA",9002313.91,74,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,74,10,1,0) S BPS("X")="" "DATA",9002313.91,74,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,74,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,75,0) 202^^SERV PROVIDER ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,75,1) SERVICE PROVIDER ID QUALIFIER "DATA",9002313.91,75,5) B2^2 "DATA",9002313.91,75,10,0) ^9002313.9101^1^1^3070214 "DATA",9002313.91,75,10,1,0) S BPS("X")="01" "DATA",9002313.91,75,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,75,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,75,25,0) ^9002313.9104^1^1^3070214^ "DATA",9002313.91,75,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,75,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,75,30,1,0) S $P(^BPSC(BPS(9002313.02),200),U,2)=BPS("X") ;VA "DATA",9002313.91,76,0) 110^^SOFTWARE VENDOR/CERT ID^A/N^^^^10^A/N "DATA",9002313.91,76,1) SOFTWARE VENDOR/ CERTIFICATION ID "DATA",9002313.91,76,5) AK^10 "DATA",9002313.91,76,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,76,10,1,0) S BPS("X")=$G(BPS("NCPDP","Software Vendor/Cert ID")) "DATA",9002313.91,76,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,76,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,76,25,0) ^9002313.9104^1^1^3040202^^^^ "DATA",9002313.91,76,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) ;VA "DATA",9002313.91,76,30,0) ^9002313.9103^1^1^3061023^ "DATA",9002313.91,76,30,1,0) S $P(^BPSC(BPS(9002313.02),100),U,10)=BPS("X") "DATA",9002313.91,77,0) 331^^PATIENT ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,77,1) "DATA",9002313.91,77,5) CX^2 "DATA",9002313.91,77,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,77,10,1,0) S BPS("X")="01" "DATA",9002313.91,77,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,77,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,77,25,0) ^9002313.9104^1^1^3030718^^ "DATA",9002313.91,77,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,77,30,0) ^9002313.9103^1^1^3030718^^^^ "DATA",9002313.91,77,30,1,0) S $P(^BPSC(BPS(9002313.02),330),U,1)=BPS("X") ;VA "DATA",9002313.91,78,0) 332^^PATIENT ID^A/N^^^^20^A/N "DATA",9002313.91,78,1) "DATA",9002313.91,78,5) CY^20 "DATA",9002313.91,78,10,0) ^9002313.9101^1^1^3061023 "DATA",9002313.91,78,10,1,0) S BPS("X")=$G(BPS("Patient","SSN")) "DATA",9002313.91,78,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,78,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,78,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,78,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,78,30,0) ^9002313.9103^1^1^3040820^^^^ "DATA",9002313.91,78,30,1,0) S $P(^BPSC(BPS(9002313.02),330),U,2)=BPS("X") ;VA "DATA",9002313.91,79,0) 326^^PATIENT PHONE NUMBER^N^^^^10^N "DATA",9002313.91,79,1) "DATA",9002313.91,79,5) CQ^10 "DATA",9002313.91,79,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,79,10,1,0) S BPS("X")=$TR($G(BPS("Patient","Phone #")),"#() -_*.@") "DATA",9002313.91,79,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,79,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,79,25,0) ^9002313.9104^1^1^3101115^ "DATA",9002313.91,79,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,79,30,0) ^9002313.9103^1^1^3101115^ "DATA",9002313.91,79,30,1,0) S $P(^BPSC(BPS(9002313.02),321),U,6)=BPS("X") "DATA",9002313.91,80,0) 455^^PRESCRIPTION/SERV REF NO QLFR^A/N^^^^1^A/N "DATA",9002313.91,80,1) PRESCRIPTION/ SERVICE REFERENCE NUMBER QUALIFIER "DATA",9002313.91,80,5) EM^1 "DATA",9002313.91,80,10,0) ^9002313.9101^1^1^3101008^ "DATA",9002313.91,80,10,1,0) S BPS("X")=1 "DATA",9002313.91,80,20,0) ^9002313.9102^1^1^3101007^^ "DATA",9002313.91,80,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,80,25,0) ^9002313.9104^1^1^3101007^^^ "DATA",9002313.91,80,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,80,30,0) ^9002313.9103^1^1^3101007^^^^ "DATA",9002313.91,80,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,5)=BPS("X") "DATA",9002313.91,81,0) 460^^QUANTITY PRESCRIBED^N^^^^10^N "DATA",9002313.91,81,1) "DATA",9002313.91,81,5) ET^10 "DATA",9002313.91,81,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,81,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Quantity"))*1000\1 "DATA",9002313.91,81,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,81,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,81,25,0) ^9002313.9104^1^1^3030827^^^^ "DATA",9002313.91,81,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,81,30,0) ^9002313.9103^1^1^3101115^ "DATA",9002313.91,81,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,10)=BPS("X") "DATA",9002313.91,82,0) 465^^PROVIDER ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,82,1) "DATA",9002313.91,82,5) EY^2 "DATA",9002313.91,82,10,0) ^9002313.9101^1^1^3070214 "DATA",9002313.91,82,10,1,0) S BPS("X")="05" "DATA",9002313.91,82,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,82,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,82,25,0) ^9002313.9104^1^1^3070214^ "DATA",9002313.91,82,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,82,30,0) ^9002313.9103^1^1^3041015^ "DATA",9002313.91,82,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,5)="" "DATA",9002313.91,83,0) 444^^PROVIDER ID^A/N^^^^15^A/N "DATA",9002313.91,83,1) "DATA",9002313.91,83,5) E9^15 "DATA",9002313.91,83,10,0) ^9002313.9101^1^1^3070214 "DATA",9002313.91,83,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Provider NPI")) "DATA",9002313.91,83,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,83,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,83,25,0) ^9002313.9104^1^1^3070214^ "DATA",9002313.91,83,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,83,30,0) ^9002313.9103^1^1^3041015^ "DATA",9002313.91,83,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),440),U,4)="" "DATA",9002313.91,84,0) 466^^PRESCRIBER ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,84,1) "DATA",9002313.91,84,5) EZ^2 "DATA",9002313.91,84,10,0) ^^2^2^3101216^ "DATA",9002313.91,84,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber ID Qualifier")) "DATA",9002313.91,84,10,2,0) S:BPS("X")="" BPS("X")="01" "DATA",9002313.91,84,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,84,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,84,25,0) ^9002313.9104^1^1^3070214^^^^ "DATA",9002313.91,84,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,84,30,0) ^9002313.9103^1^1^3030823^^^^ "DATA",9002313.91,84,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,6)=BPS("X") "DATA",9002313.91,85,0) 467^^PRESCRIBER LOCATION CODE^A/N^^^^3^A/N "DATA",9002313.91,85,1) "DATA",9002313.91,85,5) 1E^3 "DATA",9002313.91,85,10,0) ^9002313.9101^1^1^3030721 "DATA",9002313.91,85,10,1,0) S BPS("X")=$G(BPS("RX",1,"Prescriber Billing Location")) "DATA",9002313.91,85,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,85,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,85,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,85,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,85,30,0) ^9002313.9103^1^1^3030721^^^^ "DATA",9002313.91,85,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,7)=BPS("X") "DATA",9002313.91,86,0) 498^^PRESCRIBER TELEPHONE NUMBER^N^^^^10^N "DATA",9002313.91,86,1) "DATA",9002313.91,86,5) PM^10 "DATA",9002313.91,86,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,86,10,1,0) S BPS("X")=$TR($G(BPS("RX",BPS(9002313.0201),"Prescriber Phone #")),"#() -_*.@") "DATA",9002313.91,86,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,86,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,86,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,86,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,86,30,0) ^9002313.9103^1^1^3100917^^^^ "DATA",9002313.91,86,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),498),U,12)=BPS("X") "DATA",9002313.91,87,0) 468^^PRIMARY CARE PROVIDER ID QLFR^A/N^^^^2^A/N "DATA",9002313.91,87,1) PRIMARY CARE PROVIDER ID QUALIFIER "DATA",9002313.91,87,5) 2E^2 "DATA",9002313.91,87,10,0) ^^2^2^3110727^ "DATA",9002313.91,87,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Primary Care Prov ID Qual")) "DATA",9002313.91,87,10,2,0) S:BPS("X")="" BPS("X")="01" "DATA",9002313.91,87,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,87,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,87,25,0) ^9002313.9104^1^1^3070214^^^^ "DATA",9002313.91,87,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,87,30,0) ^9002313.9103^1^1^3041015^ "DATA",9002313.91,87,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,8)="" "DATA",9002313.91,88,0) 469^^PRIM CARE PROV LOCATION CODE^N^^^^3^A/N "DATA",9002313.91,88,1) "DATA",9002313.91,88,5) H5^3 "DATA",9002313.91,88,10,0) ^9002313.9101^1^1^3040114 "DATA",9002313.91,88,10,1,0) S BPS("X")=$G(BPS("Patient","Primary Care Prov Location Code")) "DATA",9002313.91,88,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,88,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,88,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,88,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,88,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,88,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,9)=BPS("X") "DATA",9002313.91,89,0) 470^^PRIM CARE PROVIDER LAST NAME^A/N^^^^15^A/N "DATA",9002313.91,89,1) PRIMARY CARE PROVIDER LAST NAME "DATA",9002313.91,89,5) 4E^15 "DATA",9002313.91,89,10,0) ^^1^1^3101217^ "DATA",9002313.91,89,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Primary Care Prov Last Name")) "DATA",9002313.91,89,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,89,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,89,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,89,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),15) "DATA",9002313.91,89,30,0) ^9002313.9103^1^1^3030825^^^^ "DATA",9002313.91,89,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,10)=BPS("X") "DATA",9002313.91,91,0) 480^^OTHER AMT CLAIMED SUBMITTED^D^^^^8^D "DATA",9002313.91,91,1) OTHER AMOUNT CLAIMED SUBMITTED "DATA",9002313.91,91,5) H9^8 "DATA",9002313.91,91,10,0) ^9002313.9101^1^1^3101006^^^^ "DATA",9002313.91,91,10,1,0) ; GET CODE handled by FLD480^BPSOSSG "DATA",9002313.91,91,20,0) ^9002313.9102^1^1^3101006^^^^ "DATA",9002313.91,91,20,1,0) ; vD.0 format code handled by FLD480^BPSOSSG "DATA",9002313.91,91,25,0) ^9002313.9104^1^1^3101006^^^^ "DATA",9002313.91,91,25,1,0) ; format code handled by FLD480^BPSOSSG "DATA",9002313.91,91,30,0) ^9002313.9103^1^1^3101006^^^^ "DATA",9002313.91,91,30,1,0) D FLD480^BPSOSSG "DATA",9002313.91,92,0) 109^^TRANSACTION COUNT^A/N^^^^1^A/N "DATA",9002313.91,92,1) "DATA",9002313.91,92,5) A9^1 "DATA",9002313.91,92,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,92,10,1,0) S BPS("X")=$G(BPS("Transaction Count")) "DATA",9002313.91,92,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,92,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,92,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,92,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,92,30,0) ^9002313.9103^1^1^3040114^^^ "DATA",9002313.91,92,30,1,0) S $P(^BPSC(BPS(9002313.02),100),U,9)=BPS("X") "DATA",9002313.91,93,0) 111^^SEGMENT IDENTIFICATION^A/N^^^^2^A/N "DATA",9002313.91,93,1) "DATA",9002313.91,93,5) AM^2 "DATA",9002313.91,93,10,0) ^9002313.9101^1^1^3040114 "DATA",9002313.91,93,10,1,0) S BPS("X")="" "DATA",9002313.91,93,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,93,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,95,0) 112^^TRANSACTION RESPONSE STATUS^A/N^^^^1^A/N "DATA",9002313.91,95,1) "DATA",9002313.91,95,5) AN^2 "DATA",9002313.91,95,10,0) ^9002313.9101^1^1^3101115^^ "DATA",9002313.91,95,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,96,0) 320^^EMPLOYER PHONE NUMBER^N^^^^10^N "DATA",9002313.91,96,1) "DATA",9002313.91,96,5) CK^10 "DATA",9002313.91,96,10,0) ^9002313.9101^1^1^3050802 "DATA",9002313.91,96,10,1,0) S BPS("X")=$TR($G(BPS("Employer","Phone")),"#() -_*.@") "DATA",9002313.91,96,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,96,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,96,25,0) ^9002313.9104^1^1^3061121^ "DATA",9002313.91,96,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),10) "DATA",9002313.91,96,30,0) ^9002313.9103^1^1^3061120^ "DATA",9002313.91,96,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),310),U,10)=BPS("X") "DATA",9002313.91,97,0) 321^^EMPLOYER CONTACT NAME^A/N^^^^30^A/N "DATA",9002313.91,97,1) "DATA",9002313.91,97,5) CL^30 "DATA",9002313.91,97,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,97,10,1,0) S BPS("X")="" "DATA",9002313.91,97,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,97,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,97,25,0) ^9002313.9104^1^1^3040224^^^ "DATA",9002313.91,97,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),30) "DATA",9002313.91,97,30,0) ^9002313.9103^1^1^3040224^ "DATA",9002313.91,97,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),320),U,1)=BPS("X") "DATA",9002313.91,98,0) 330^^ALTERNATE ID^A/N^^^^20^A/N "DATA",9002313.91,98,1) "DATA",9002313.91,98,5) CW^20 "DATA",9002313.91,98,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,98,10,1,0) S BPS("X")="" "DATA",9002313.91,98,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,98,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,98,25,0) ^9002313.9104^1^1^3040224^^^ "DATA",9002313.91,98,25,1,0) S BPS("X")=$$NFF^BPSECFM(BPS("X"),20) "DATA",9002313.91,98,30,0) ^9002313.9103^1^1^3040224^^ "DATA",9002313.91,98,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),320),U,10)=BPS("X") "DATA",9002313.91,99,0) 333^^EMPLOYER ID^A/N^^^^15^A/N "DATA",9002313.91,99,1) "DATA",9002313.91,99,5) CZ^15 "DATA",9002313.91,99,10,0) ^9002313.9101^1^1^3030823 "DATA",9002313.91,99,10,1,0) S BPS("X")="" "DATA",9002313.91,99,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,99,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,99,25,0) ^9002313.9104^1^1^3030823^ "DATA",9002313.91,99,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,99,30,0) ^9002313.9103^1^1^3030823^^^^ "DATA",9002313.91,99,30,1,0) S $P(^BPSC(BPS(9002313.02),330),U,3)=BPS("X") "DATA",9002313.91,100,0) 334^^SMOKER/NONSMOKER^N^^^^1^A/N "DATA",9002313.91,100,1) "DATA",9002313.91,100,5) 1C^1 "DATA",9002313.91,100,10,0) ^9002313.9101^1^1^3070620 "DATA",9002313.91,100,10,1,0) S BPS("X")="" "DATA",9002313.91,100,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,100,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,100,25,0) ^9002313.9104^1^1^3040114^^^^ "DATA",9002313.91,100,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),1) "DATA",9002313.91,100,30,0) ^9002313.9103^1^1^3040114^^^^ "DATA",9002313.91,100,30,1,0) S $P(^BPSC(BPS(9002313.02),330),U,4)=BPS("X") "DATA",9002313.91,101,0) 335^^PREGNANCY INDICATOR^N^^^^1^A/N "DATA",9002313.91,101,1) "DATA",9002313.91,101,5) 2C^1 "DATA",9002313.91,101,10,0) ^9002313.9101^1^1^3030823 "DATA",9002313.91,101,10,1,0) S BPS("X")="" "DATA",9002313.91,101,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,101,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,101,25,0) ^9002313.9104^1^1^3030823^^ "DATA",9002313.91,101,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),1) "DATA",9002313.91,101,30,0) ^9002313.9103^1^1^3030823^^ "DATA",9002313.91,101,30,1,0) S $P(^BPSC(BPS(9002313.02),330),U,5)=BPS("X") "DATA",9002313.91,102,0) 336^^FACILITY ID^A/N^^^^10^A/N "DATA",9002313.91,102,1) "DATA",9002313.91,102,5) 8C^10 "DATA",9002313.91,102,10,0) ^9002313.9101^1^1^3070103 "DATA",9002313.91,102,10,1,0) S BPS("X")=$G(BPS("Insurer","Facility ID")) "DATA",9002313.91,102,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,102,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,102,25,0) ^9002313.9104^1^1^3030823^^ "DATA",9002313.91,102,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),10) "DATA",9002313.91,102,30,0) ^9002313.9103^1^1^3030823^ "DATA",9002313.91,102,30,1,0) S $P(^BPSC(BPS(9002313.02),330),U,6)=BPS("X") "DATA",9002313.91,103,0) 337^^COB/OTHER PAYMENTS COUNT^N^^^^1^N "DATA",9002313.91,103,1) COORDINATION OF BENEFITS/OTHER PAYMENTS COUNT "DATA",9002313.91,103,5) 4C^1 "DATA",9002313.91,103,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,103,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,103,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,103,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,103,25,0) ^9002313.9104^1^1^3040223^^^ "DATA",9002313.91,103,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,103,30,0) ^9002313.9103^1^1^3100824 "DATA",9002313.91,103,30,1,0) D SET337^BPSFLD01 "DATA",9002313.91,104,0) 338^^OTHER PAYER COVERAGE TYPE^N^^^^2^A/N "DATA",9002313.91,104,1) "DATA",9002313.91,104,5) 5C^2 "DATA",9002313.91,104,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,104,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,104,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,104,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,104,25,0) ^9002313.9104^1^1^3101029^ "DATA",9002313.91,104,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,104,30,0) ^9002313.9103^1^1^3101004^ "DATA",9002313.91,104,30,1,0) D SET338^BPSFLD01 "DATA",9002313.91,105,0) 339^^OTHER PAYER ID QUALIFIER^N^^^^2^A/N "DATA",9002313.91,105,1) "DATA",9002313.91,105,5) 6C^2 "DATA",9002313.91,105,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,105,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,105,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,105,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,105,25,0) ^9002313.9104^1^1^3101029^ "DATA",9002313.91,105,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,105,30,0) ^9002313.9103^1^1^3101004^ "DATA",9002313.91,105,30,1,0) D SET339^BPSFLD01 "DATA",9002313.91,106,0) 340^^OTHER PAYER ID^A/N^^^^10^A/N "DATA",9002313.91,106,1) "DATA",9002313.91,106,5) 7C^10 "DATA",9002313.91,106,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,106,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,106,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,106,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,106,25,0) ^9002313.9104^1^1^3040223^^ "DATA",9002313.91,106,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,106,30,0) ^9002313.9103^1^1^3101004^^ "DATA",9002313.91,106,30,1,0) D SET340^BPSFLD01 "DATA",9002313.91,107,0) 341^^OTHER PAYER AMOUNT PAID COUNT^N^^^^1^N "DATA",9002313.91,107,1) "DATA",9002313.91,107,5) HB^1 "DATA",9002313.91,107,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,107,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,107,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,107,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,107,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,107,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,107,30,0) ^9002313.9103^1^1^3100824 "DATA",9002313.91,107,30,1,0) D SET341^BPSFLD01 "DATA",9002313.91,108,0) 342^^OTHER PAYER AMT PAID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,108,1) OTHER PAYER AMOUNT PAID QUALIFIER "DATA",9002313.91,108,5) HC^2 "DATA",9002313.91,108,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,108,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,108,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,108,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,108,25,0) ^9002313.9104^1^1^3101029^ "DATA",9002313.91,108,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,108,30,0) ^9002313.9103^1^1^3100824 "DATA",9002313.91,108,30,1,0) D SET342^BPSFLD01 "DATA",9002313.91,109,0) 343^^DISPENSING STATUS^A/N^^^^1^A/N "DATA",9002313.91,109,1) "DATA",9002313.91,109,5) HD^1 "DATA",9002313.91,109,10,0) ^9002313.9101^1^1^3040913 "DATA",9002313.91,109,10,1,0) S BPS("X")="" "DATA",9002313.91,109,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,109,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,109,25,0) ^9002313.9104^1^1^3040913^^^^ "DATA",9002313.91,109,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,109,30,0) ^9002313.9103^1^1^3070620^ "DATA",9002313.91,109,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),340),U,3)="" "DATA",9002313.91,110,0) 344^^QTY INTENDED TO BE DISPENSED^N^^^^10^N "DATA",9002313.91,110,1) QUANTITY INTENDED TO BE DISPENSED "DATA",9002313.91,110,5) HF^10 "DATA",9002313.91,110,10,0) ^9002313.9101^1^1^3070620 "DATA",9002313.91,110,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Quantity"))*1000\1 "DATA",9002313.91,110,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,110,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,110,25,0) ^9002313.9104^1^1^3070620^ "DATA",9002313.91,110,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,110,30,0) ^9002313.9103^1^1^3070620^ "DATA",9002313.91,110,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),340),U,4)="" "DATA",9002313.91,111,0) 345^^DAYS SUPPLY INTEND TO BE DISP^N^^^^3^N "DATA",9002313.91,111,1) DAYS SUPPLY INTENDED TO BE DISPENSED "DATA",9002313.91,111,5) HG^3 "DATA",9002313.91,111,10,0) ^9002313.9101^1^1^3030827 "DATA",9002313.91,111,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Days Supply"))*1000 "DATA",9002313.91,111,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,111,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,111,25,0) ^9002313.9104^1^1^3030827^^^ "DATA",9002313.91,111,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,111,30,0) ^9002313.9103^1^1^3070620^ "DATA",9002313.91,111,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),340),U,5)="" "DATA",9002313.91,112,0) 346^^BASIS OF CALC - DISPENSING FEE^A/N^^^^2^A/N "DATA",9002313.91,112,1) "DATA",9002313.91,112,5) HH^8 "DATA",9002313.91,112,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,112,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,113,0) 347^^BASIS OF CALC - COPAY^A/N^^^^2^A/N "DATA",9002313.91,113,1) "DATA",9002313.91,113,5) HJ^8 "DATA",9002313.91,113,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,113,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,114,0) 348^^BASIS OF CALC - FLAT SALES TAX^A/N^^^^2^A/N "DATA",9002313.91,114,1) "DATA",9002313.91,114,5) HK^8 "DATA",9002313.91,114,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,114,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,115,0) 349^^BASIS OF CALC - % SALES TAX^A/N^^^^2^A/N "DATA",9002313.91,115,1) "DATA",9002313.91,115,5) HM^8 "DATA",9002313.91,115,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,115,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,116,0) 350^^PATIENT E-MAIL ADDRESS^A/N^^^^80^A/N "DATA",9002313.91,116,1) "DATA",9002313.91,116,5) HN^80 "DATA",9002313.91,116,10,0) ^9002313.9101^1^1^3030512 "DATA",9002313.91,116,10,1,0) S BPS("X")=$G(BPS("Patient","Patient E-Mail Address")) "DATA",9002313.91,116,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,116,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),80) "DATA",9002313.91,116,30,0) ^9002313.9103^1^1^3101101^^^ "DATA",9002313.91,116,30,1,0) S $P(^BPSC(BPS(9002313.02),340),U,10)=$G(BPS("X")) "DATA",9002313.91,117,0) 351^^OTHER PAYER-PAT RESP AMT QLFR^A/N^^^^2^A/N "DATA",9002313.91,117,1) OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT QUALIFIER "DATA",9002313.91,117,5) NP^1 "DATA",9002313.91,117,10,0) ^^1^1^3101222^ "DATA",9002313.91,117,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,117,20,0) ^9002313.9102^1^1^3101220^ "DATA",9002313.91,117,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,117,30,0) ^^1^1^3101222^ "DATA",9002313.91,117,30,1,0) D SET351^BPSFLD01 "DATA",9002313.91,118,0) 352^^OTHER PAYER-PAT RESP AMOUNT^D^^^^10^D "DATA",9002313.91,118,1) OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT "DATA",9002313.91,118,5) NQ^10 "DATA",9002313.91,118,10,0) ^^1^1^3101222^ "DATA",9002313.91,118,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,118,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,118,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,118,25,0) ^9002313.9104^1^1^3031212^ "DATA",9002313.91,118,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,118,30,0) ^9002313.9103^1^1^3101222^^ "DATA",9002313.91,118,30,1,0) D SET352^BPSFLD01 "DATA",9002313.91,119,0) 353^^OTHER PAYER-PAT RESP AMT CNT^N^^^^2^N "DATA",9002313.91,119,1) OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT COUNT "DATA",9002313.91,119,5) NR^1 "DATA",9002313.91,119,10,0) ^^1^1^3101222^ "DATA",9002313.91,119,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,119,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,119,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,119,30,0) ^9002313.9103^1^1^3101222^^ "DATA",9002313.91,119,30,1,0) D SET353^BPSFLD01 "DATA",9002313.91,120,0) 445^^ORIG PRESCRIBED PROD/SERV CODE^A/N^^^^19^A/N "DATA",9002313.91,120,1) ORIGINALLY PRESCRIBED PRODUCT/SERVICE CODE "DATA",9002313.91,120,5) EA^19 "DATA",9002313.91,120,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,120,10,1,0) S BPS("X")="" "DATA",9002313.91,120,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,120,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,120,25,0) ^9002313.9104^1^1^3040107^^ "DATA",9002313.91,120,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),19) "DATA",9002313.91,120,30,0) ^9002313.9103^1^1^3101115^ "DATA",9002313.91,120,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),440),U,5)="" "DATA",9002313.91,121,0) 446^^ORIGINALLY PRESCRIBED QUANTITY^N^^^^10^N "DATA",9002313.91,121,1) "DATA",9002313.91,121,5) EB^10 "DATA",9002313.91,121,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,121,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Quantity"))*1000\1 "DATA",9002313.91,121,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,121,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,121,25,0) ^9002313.9104^1^1^3030828^^^^ "DATA",9002313.91,121,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,121,30,0) ^9002313.9103^1^1^3030828^^^^ "DATA",9002313.91,121,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),440),U,6)=BPS("X") ;VA "DATA",9002313.91,122,0) 454^^SCHEDULED PRESCRIPTION ID NUM^N^^^^12^A/N "DATA",9002313.91,122,1) SCHEDULED PRESCRIPTION ID NUMBER "DATA",9002313.91,122,5) EK^12 "DATA",9002313.91,122,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,122,10,1,0) S BPS("X")="" "DATA",9002313.91,122,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,122,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,122,25,0) ^9002313.9104^1^1^3040224^^ "DATA",9002313.91,122,25,1,0) S BPS("X")=$$NFF^BPSECFM(BPS("X"),12) "DATA",9002313.91,122,30,0) ^9002313.9103^1^1^3040224^^ "DATA",9002313.91,122,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,4)=BPS("X") "DATA",9002313.91,123,0) 456^^ASSOC PRESCRIPTION/SERV REF NO^A/N^^^^12^N "DATA",9002313.91,123,1) ASSOCIATED PRESCRIPTION/ SERVICE REFERENCE NUMBER "DATA",9002313.91,123,5) EN^7 "DATA",9002313.91,123,10,0) ^9002313.9101^1^1^3030823 "DATA",9002313.91,123,10,1,0) S BPS("X")="" "DATA",9002313.91,123,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,123,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,123,25,0) ^9002313.9104^1^1^3030823^^ "DATA",9002313.91,123,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),7) "DATA",9002313.91,123,30,0) ^^1^1^3110720^ "DATA",9002313.91,123,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,6)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "DATA",9002313.91,124,0) 457^^ASSOC PRESCRIPTION/SERV DATE^A/N^^^^8^N "DATA",9002313.91,124,1) ASSOCIATED PRESCRIPTION/ SERVICE DATE "DATA",9002313.91,124,5) EP^8 "DATA",9002313.91,124,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,124,10,1,0) S BPS("X")="" "DATA",9002313.91,124,20,0) ^9002313.9102^1^1^3101029^ "DATA",9002313.91,124,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,124,25,0) ^9002313.9104^1^1^3101029^ "DATA",9002313.91,124,25,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,124,30,0) ^9002313.9103^1^1^3110720^^ "DATA",9002313.91,124,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,7)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "DATA",9002313.91,125,0) 458^^PROCEDURE MODIFIER CODE COUNT^N^^^^2^N "DATA",9002313.91,125,1) "DATA",9002313.91,125,5) SE^1 "DATA",9002313.91,125,10,0) ^9002313.9101^1^1^3040819 "DATA",9002313.91,125,10,1,0) S BPS("X")="" "DATA",9002313.91,125,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,125,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,125,25,0) ^9002313.9104^1^1^3040819^^^^ "DATA",9002313.91,125,25,1,0) S BPS("X")=$$NFF^BPSECFM(BPS("X"),1) "DATA",9002313.91,125,30,0) ^9002313.9103^1^1^3040819^ "DATA",9002313.91,125,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),450),U,8)="" "DATA",9002313.91,126,0) 459^^PROCEDURE MODIFIER CODE^A/N^^^^2^A/N "DATA",9002313.91,126,1) "DATA",9002313.91,126,5) ER^2 "DATA",9002313.91,126,10,0) ^9002313.9101^1^1^3040819 "DATA",9002313.91,126,10,1,0) S BPS("X")="" "DATA",9002313.91,126,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,126,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,126,25,0) ^9002313.9104^1^1^3040819^^^^ "DATA",9002313.91,126,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),2) "DATA",9002313.91,126,30,0) ^^1^1^3110727^ "DATA",9002313.91,126,30,1,0) ; Not implemented "DATA",9002313.91,127,0) 461^^PRIOR AUTHORIZATION TYPE CODE^N^^^^2^N "DATA",9002313.91,127,1) "DATA",9002313.91,127,5) EU^2 "DATA",9002313.91,127,10,0) ^9002313.9101^2^2^3101115^ "DATA",9002313.91,127,10,1,0) S BPS("X")=$G(BPS("Claim",BPS(9002313.0201),"Prior Auth Type")) "DATA",9002313.91,127,10,2,0) S:BPS("X")="" BPS("X")=0 "DATA",9002313.91,127,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,127,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,127,25,0) ^9002313.9104^1^1^3031222^^^^ "DATA",9002313.91,127,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,127,30,0) ^9002313.9103^1^1^3031222^^^^ "DATA",9002313.91,127,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,1)=BPS("X") "DATA",9002313.91,128,0) 462^^PRIOR AUTH NUMBER SUBMITTED^A/N^^^^11^N "DATA",9002313.91,128,1) PRIOR AUTHORIZATION NUMBER SUBMITTED "DATA",9002313.91,128,5) EV^11 "DATA",9002313.91,128,10,0) ^9002313.9101^1^1^3031222 "DATA",9002313.91,128,10,1,0) S BPS("X")=$G(BPS("Claim",BPS(9002313.0201),"Prior Auth Num Sub")) "DATA",9002313.91,128,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,128,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,128,25,0) ^9002313.9104^1^1^3031222^^^^ "DATA",9002313.91,128,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,128,30,0) ^9002313.9103^1^1^3031222^^^^ "DATA",9002313.91,128,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,2)=BPS("X") "DATA",9002313.91,129,0) 464^^INTERMEDIARY AUTHORIZATION ID^A/N^^^^11^A/N "DATA",9002313.91,129,1) "DATA",9002313.91,129,5) EX^11 "DATA",9002313.91,129,10,0) ^^2^2^3110727^ "DATA",9002313.91,129,10,1,0) S BPS("X")=$G(BPS("Claim",BPS(9002313.0201),"Intermediary Auth ID")) "DATA",9002313.91,129,10,2,0) S:BPS("X")="" BPS("X")="" "DATA",9002313.91,129,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,129,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,129,25,0) ^9002313.9104^1^1^3030823^ "DATA",9002313.91,129,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),11) "DATA",9002313.91,129,30,0) ^9002313.9103^1^1^3030823^^^ "DATA",9002313.91,129,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,4)=BPS("X") "DATA",9002313.91,130,0) 471^^OTHER PAYER REJECT COUNT^N^^^^2^N "DATA",9002313.91,130,1) "DATA",9002313.91,130,5) 5E^2 "DATA",9002313.91,130,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,130,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,130,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,130,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,130,25,0) ^9002313.9104^1^1^3040224^^ "DATA",9002313.91,130,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,130,30,0) ^9002313.9103^1^1^3100824 "DATA",9002313.91,130,30,1,0) D SET471^BPSFLD01 "DATA",9002313.91,131,0) 472^^OTHER PAYER REJECT CODE^A/N^^^^3^A/N "DATA",9002313.91,131,1) "DATA",9002313.91,131,5) 6E^3 "DATA",9002313.91,131,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,131,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,131,20,0) ^9002313.9102^1^1^3101206^ "DATA",9002313.91,131,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,131,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,131,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,131,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,131,30,1,0) D SET472^BPSFLD01 "DATA",9002313.91,132,0) 473^^DUR/PPS CODE COUNTER^N^^^^1^N "DATA",9002313.91,132,1) "DATA",9002313.91,132,5) 7E^1 "DATA",9002313.91,132,10,0) ^9002313.9101^1^1^3031230 "DATA",9002313.91,132,10,1,0) S BPS("X")=1 "DATA",9002313.91,132,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,132,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,132,25,0) ^9002313.9104^1^1^3031230^^^^ "DATA",9002313.91,132,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,132,30,0) ^9002313.9103^1^1^3031230^^^^ "DATA",9002313.91,132,30,1,0) D FLD473^BPSOSSG "DATA",9002313.91,133,0) 474^^DUR/PPS LEVEL OF EFFORT^N^^^^2^N "DATA",9002313.91,133,1) "DATA",9002313.91,133,5) 8E^2 "DATA",9002313.91,133,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,133,10,1,0) S BPS("X")=12 "DATA",9002313.91,133,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,133,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,133,25,0) ^9002313.9104^1^1^3030718^ "DATA",9002313.91,133,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,133,30,0) ^9002313.9103^1^1^3030718^ "DATA",9002313.91,133,30,1,0) D FLD474^BPSOSSG "DATA",9002313.91,134,0) 475^^DUR CO-AGENT ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,134,1) "DATA",9002313.91,134,5) J9^2 "DATA",9002313.91,134,10,0) ^9002313.9101^1^1^3030718 "DATA",9002313.91,134,10,1,0) S BPS("X")="" "DATA",9002313.91,134,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,134,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,134,25,0) ^9002313.9104^1^1^3030718^ "DATA",9002313.91,134,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,134,30,0) ^9002313.9103^1^1^3030718^ "DATA",9002313.91,134,30,1,0) D FLD475^BPSOSSG "DATA",9002313.91,135,0) 476^^DUR CO-AGENT ID^A/N^^^^19^A/N "DATA",9002313.91,135,1) "DATA",9002313.91,135,5) H6^19 "DATA",9002313.91,135,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,135,10,1,0) S BPS("X")="" "DATA",9002313.91,135,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,135,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,135,25,0) ^9002313.9104^1^1^3040107^^^ "DATA",9002313.91,135,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,135,30,0) ^9002313.9103^1^1^3101115^^^^ "DATA",9002313.91,135,30,1,0) D FLD476^BPSOSSG "DATA",9002313.91,136,0) 477^^PROF SERVICE FEE SUBMITTED^D^^^^8^D "DATA",9002313.91,136,1) PROFESSIONAL SERVICE FEE SUBMITTED "DATA",9002313.91,136,5) BE^8 "DATA",9002313.91,136,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,136,10,1,0) S BPS("X")=0 "DATA",9002313.91,136,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,136,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,136,25,0) ^9002313.9104^1^1^3101029^ "DATA",9002313.91,136,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,136,30,0) ^9002313.9103^1^1^3030823^^ "DATA",9002313.91,136,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),470),U,7)=BPS("X") "DATA",9002313.91,139,0) 481^^FLAT SALES TAX AMT SUBMITTED^D^^^^8^D "DATA",9002313.91,139,1) FLAT SALES TAX AMOUNT SUBMITTED "DATA",9002313.91,139,5) HA^8 "DATA",9002313.91,139,10,0) ^9002313.9101^1^1^3100916 "DATA",9002313.91,139,10,1,0) S BPS("X")=0 "DATA",9002313.91,139,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,139,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,139,25,0) ^9002313.9104^1^1^3040907^^ "DATA",9002313.91,139,25,1,0) S BPS("X")=$$DFF^BPSECFM(BPS("X"),8) "DATA",9002313.91,139,30,0) ^9002313.9103^1^1^3100923^^^^ "DATA",9002313.91,139,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,1)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "DATA",9002313.91,140,0) 482^^PERCENT SALES TAX AMT SBMTTD^D^^^^8^D "DATA",9002313.91,140,1) PERCENTAGE SALES TAX AMOUNT SUBMITTED "DATA",9002313.91,140,5) GE^8 "DATA",9002313.91,140,10,0) ^9002313.9101^1^1^3050802 "DATA",9002313.91,140,10,1,0) S BPS("X")=0 "DATA",9002313.91,140,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,140,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,140,25,0) ^9002313.9104^1^1^3040907^^^^ "DATA",9002313.91,140,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,140,30,0) ^9002313.9103^1^1^3100923^^^^ "DATA",9002313.91,140,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,2)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "DATA",9002313.91,141,0) 483^^PERCENT SALES TAX RATE SBMTTD^D^^^^7^D "DATA",9002313.91,141,1) PERCENTAGE SALES TAX RATE SUBMITTED "DATA",9002313.91,141,5) HE^7 "DATA",9002313.91,141,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,141,10,1,0) S BPS("X")=+$G(BPS("Insurer","Percent Sales Tax Rate Sub")) "DATA",9002313.91,141,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,141,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),7) "DATA",9002313.91,141,25,0) ^9002313.9104^1^1^3040907^^^^ "DATA",9002313.91,141,25,1,0) S BPS("X")=$$DFF^BPSECFM(BPS("X"),7) "DATA",9002313.91,141,30,0) ^9002313.9103^1^1^3100923^^^^ "DATA",9002313.91,141,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,3)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "DATA",9002313.91,142,0) 484^^PERCENT SALES TAX BASIS SBMTTD^A/N^^^^2^A/N "DATA",9002313.91,142,1) PERCENTAGE SALES TAX BASIS SUBMITTED "DATA",9002313.91,142,5) JE^2 "DATA",9002313.91,142,10,0) ^9002313.9101^1^1^3050802 "DATA",9002313.91,142,10,1,0) S BPS("X")="" "DATA",9002313.91,142,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,142,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,142,25,0) ^9002313.9104^1^1^3030824^ "DATA",9002313.91,142,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),2) "DATA",9002313.91,142,30,0) ^9002313.9103^1^1^3100923^^^^ "DATA",9002313.91,142,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,4)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "DATA",9002313.91,143,0) 485^^COUPON TYPE^A/N^^^^2^A/N "DATA",9002313.91,143,1) "DATA",9002313.91,143,5) KE^2 "DATA",9002313.91,143,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,143,10,1,0) S BPS("X")="" "DATA",9002313.91,143,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,143,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,143,25,0) ^9002313.9104^1^1^3040107^^ "DATA",9002313.91,143,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,143,30,0) ^9002313.9103^1^1^3101115^^^ "DATA",9002313.91,143,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,5)=BPS("X") "DATA",9002313.91,144,0) 486^^COUPON NUMBER^A/N^^^^15^A/N "DATA",9002313.91,144,1) "DATA",9002313.91,144,5) ME^15 "DATA",9002313.91,144,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,144,10,1,0) S BPS("X")="" "DATA",9002313.91,144,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,144,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,144,25,0) ^9002313.9104^1^1^3031210^^ "DATA",9002313.91,144,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,144,30,0) ^9002313.9103^1^1^3031210^^ "DATA",9002313.91,144,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,6)=BPS("X") "DATA",9002313.91,145,0) 487^^COUPON VALUE AMOUNT^D^^^^8^D "DATA",9002313.91,145,1) "DATA",9002313.91,145,5) NE^8 "DATA",9002313.91,145,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,145,10,1,0) S BPS("X")="" "DATA",9002313.91,145,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,145,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,145,25,0) ^9002313.9104^1^1^3031210^^ "DATA",9002313.91,145,25,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,145,30,0) ^9002313.9103^1^1^3031210^^ "DATA",9002313.91,145,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),480),U,7)=BPS("X") "DATA",9002313.91,146,0) 491^^DIAGNOSIS CODE COUNT^N^^^^1^N "DATA",9002313.91,146,1) "DATA",9002313.91,146,5) VE^1 "DATA",9002313.91,146,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,146,10,1,0) S BPS("X")="" "DATA",9002313.91,146,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,146,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,146,25,0) ^9002313.9104^1^1^3040107^^^^ "DATA",9002313.91,146,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,147,0) 492^^DIAGNOSIS CODE QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,147,1) "DATA",9002313.91,147,5) WE^2 "DATA",9002313.91,147,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,147,10,1,0) S BPS("X")="" "DATA",9002313.91,147,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,147,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,147,25,0) ^9002313.9104^1^1^3040224^^^ "DATA",9002313.91,147,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,148,0) 493^^CLINICAL INFORMATION COUNTER^N^^^^1^N "DATA",9002313.91,148,1) "DATA",9002313.91,148,5) XE^1 "DATA",9002313.91,148,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,148,10,1,0) S BPS("X")="" "DATA",9002313.91,148,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,148,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,148,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,148,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,149,0) 498.01^^REQUEST TYPE^N^^^^1^A/N "DATA",9002313.91,149,1) "DATA",9002313.91,149,5) PA^1 "DATA",9002313.91,149,10,0) ^9002313.9101^1^1^3040428 "DATA",9002313.91,149,10,1,0) S BPS("X")="" "DATA",9002313.91,149,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,149,20,1,0) S BPS("X")="" "DATA",9002313.91,149,25,0) ^9002313.9104^1^1^3040428^ "DATA",9002313.91,149,25,1,0) S BPS("X")="" "DATA",9002313.91,150,0) 498.02^^REQUEST PERIOD DATE-BEGIN^A/N^^^^8^N "DATA",9002313.91,150,1) "DATA",9002313.91,150,5) PB^8 "DATA",9002313.91,150,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,150,10,1,0) S BPS("X")="" "DATA",9002313.91,150,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,150,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,151,0) 498.03^^REQUEST PERIOD DATE-END^A/N^^^^8^N "DATA",9002313.91,151,1) "DATA",9002313.91,151,5) PC^8 "DATA",9002313.91,151,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,151,10,1,0) S BPS("X")="" "DATA",9002313.91,151,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,151,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,152,0) 498.04^^BASIS OF REQUEST^A/N^^^^2^A/N "DATA",9002313.91,152,1) "DATA",9002313.91,152,5) PD^2 "DATA",9002313.91,152,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,152,10,1,0) S BPS("X")="" "DATA",9002313.91,152,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,152,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,153,0) 498.05^^AUTHORIZED REP FIRST NAME^A/N^^^^12^A/N "DATA",9002313.91,153,1) "DATA",9002313.91,153,5) PE^12 "DATA",9002313.91,153,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,153,10,1,0) S BPS("X")="" "DATA",9002313.91,153,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,153,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,154,0) 498.06^^AUTHORIZED REP LAST NAME^A/N^^^^15^A/N "DATA",9002313.91,154,1) "DATA",9002313.91,154,5) PF^15 "DATA",9002313.91,154,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,154,10,1,0) S BPS("X")="" "DATA",9002313.91,154,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,154,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,155,0) 498.07^^AUTHORIZED REP STREET ADDRESS^A/N^^^^30^A/N "DATA",9002313.91,155,1) "DATA",9002313.91,155,5) PG^30 "DATA",9002313.91,155,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,155,10,1,0) S BPS("X")="" "DATA",9002313.91,155,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,155,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,156,0) 498.08^^AUTH REP CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,156,1) "DATA",9002313.91,156,5) PH^20 "DATA",9002313.91,156,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,156,10,1,0) S BPS("X")="" "DATA",9002313.91,156,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,156,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,157,0) 498.09^^AUTHORIZED REP STATE/PROV ADDR^A/N^^^^2^A/N "DATA",9002313.91,157,1) "DATA",9002313.91,157,5) PJ^2 "DATA",9002313.91,157,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,157,10,1,0) S BPS("X")="" "DATA",9002313.91,157,20,0) ^9002313.9102^1^1^3101206^ "DATA",9002313.91,157,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,158,0) 498.11^^AUTHORIZED REP ZIP/POSTAL ZONE^A/N^^^^15^A/N "DATA",9002313.91,158,1) "DATA",9002313.91,158,5) PK^15 "DATA",9002313.91,158,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,158,10,1,0) S BPS("X")="" "DATA",9002313.91,158,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,158,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,159,0) 498.12^^PRESCRIBER PHONE NUMBER^N^^^^10^N "DATA",9002313.91,159,1) "DATA",9002313.91,159,5) PM^10 "DATA",9002313.91,159,10,0) ^9002313.9101^1^1^3050802 "DATA",9002313.91,159,10,1,0) S BPS("X")=$TR($G(BPS("RX",BPS(9002313.0201),"Prescriber Phone #")),"#() -_*.@") "DATA",9002313.91,159,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,159,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,159,25,0) ^9002313.9104^1^1^3030722^^ "DATA",9002313.91,159,25,1,0) S BPS("X")=$$NFF^BPSECFM(BPS("X"),10) "DATA",9002313.91,159,30,0) ^9002313.9103^1^1^3030722^^ "DATA",9002313.91,159,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),498),U,12)=BPS("X") "DATA",9002313.91,160,0) 498.13^^PRIOR AUTH SUPPORTING DOCUMENT^A/N^^^^500^A/N "DATA",9002313.91,160,1) "DATA",9002313.91,160,5) PP^200 "DATA",9002313.91,160,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,160,10,1,0) S BPS("X")="" "DATA",9002313.91,160,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,160,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),500) "DATA",9002313.91,161,0) 498.14^^PRIOR AUTH NUMBER-ASSIGNED^N^^^^11^N "DATA",9002313.91,161,1) "DATA",9002313.91,161,5) PY^8 "DATA",9002313.91,161,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,161,10,1,0) S BPS("X")="" "DATA",9002313.91,161,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,161,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,162,0) 498.52^^PRIOR AUTH EFFECTIVE DATE^A/N^^^^8^N "DATA",9002313.91,162,1) "DATA",9002313.91,162,5) PS^8 "DATA",9002313.91,162,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,162,10,1,0) S BPS("X")="" "DATA",9002313.91,162,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,162,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,163,0) 498.53^^PRIOR AUTH EXPIRATION DATE^A/N^^^^8^N "DATA",9002313.91,163,1) "DATA",9002313.91,163,5) PT^8 "DATA",9002313.91,163,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,163,10,1,0) S BPS("X")="" "DATA",9002313.91,163,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,163,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,164,0) 498.54^^PRIOR AUTH NO REFILLS AUTH^N^^^^2^N "DATA",9002313.91,164,1) "DATA",9002313.91,164,5) PW^8 "DATA",9002313.91,164,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,164,10,1,0) S BPS("X")="" "DATA",9002313.91,164,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,164,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,165,0) 498.55^^PRIOR AUTH QTY ACCUMULATED^N^^^^10^N "DATA",9002313.91,165,1) "DATA",9002313.91,165,5) PX^8 "DATA",9002313.91,165,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,165,10,1,0) S BPS("X")="" "DATA",9002313.91,165,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,165,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,166,0) 498.57^^PRIOR AUTHORIZATION QUANTITY^A/N^^^^10^N "DATA",9002313.91,166,1) "DATA",9002313.91,166,5) RA^3 "DATA",9002313.91,166,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,166,10,1,0) S BPS("X")="" "DATA",9002313.91,166,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,166,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,167,0) 498.58^^PRIOR AUTH DOLLARS AUTHORIZED^N^^^^8^D "DATA",9002313.91,167,1) "DATA",9002313.91,167,5) RB^8 "DATA",9002313.91,167,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,167,10,1,0) S BPS("X")="" "DATA",9002313.91,167,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,167,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,168,0) 498.59^^AUTH REP CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,168,1) "DATA",9002313.91,168,5) PH^20 "DATA",9002313.91,168,10,0) ^9002313.9101^1^1^3030512 "DATA",9002313.91,168,10,1,0) S BPS("X")="" "DATA",9002313.91,168,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,168,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,169,0) 501^^HEADER RESPONSE STATUS^A/N^^^^1^A/N "DATA",9002313.91,169,1) "DATA",9002313.91,169,5) AN^1 "DATA",9002313.91,169,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,169,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,170,0) 503^^AUTHORIZATION NUMBER^A/N^^^^20^A/N "DATA",9002313.91,170,1) "DATA",9002313.91,170,5) F3^20 "DATA",9002313.91,170,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,170,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,171,0) 504^^MESSAGE^A/N^^^^200^A/N "DATA",9002313.91,171,1) "DATA",9002313.91,171,5) F4^200 "DATA",9002313.91,171,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,171,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,172,0) 505^^PATIENT PAY AMOUNT^A/N^^^^8^D "DATA",9002313.91,172,1) "DATA",9002313.91,172,5) F5^8 "DATA",9002313.91,172,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,172,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,173,0) 506^^INGREDIENT COST PAID^A/N^^^^8^D "DATA",9002313.91,173,1) "DATA",9002313.91,173,5) F6^8 "DATA",9002313.91,173,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,173,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,174,0) 507^^DISPENSING FEE PAID^A/N^^^^8^D "DATA",9002313.91,174,1) "DATA",9002313.91,174,5) F7^8 "DATA",9002313.91,174,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,174,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,175,0) 509^^TOTAL AMOUNT PAID^A/N^^^^8^D "DATA",9002313.91,175,1) "DATA",9002313.91,175,5) F9^8 "DATA",9002313.91,175,10,0) ^9002313.9101^1^1^3101115^^ "DATA",9002313.91,175,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,176,0) 510^^REJECT COUNT^N^^^^2^N "DATA",9002313.91,176,1) "DATA",9002313.91,176,5) FA^2 "DATA",9002313.91,176,10,0) ^9002313.9101^1^1^3101115^^ "DATA",9002313.91,176,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,177,0) 511^^REJECT CODE^A/N^^^^3^A/N "DATA",9002313.91,177,1) "DATA",9002313.91,177,5) FB^3 "DATA",9002313.91,177,10,0) ^9002313.9101^1^1^3101115^^ "DATA",9002313.91,177,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,178,0) 512^^ACCUMULATED DEDUCTIBLE AMOUNT^A/N^^^^8^D "DATA",9002313.91,178,1) "DATA",9002313.91,178,5) FC^8 "DATA",9002313.91,178,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,178,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,179,0) 513^^REMAINING DEDUCTIBLE AMOUNT^A/N^^^^8^D "DATA",9002313.91,179,1) "DATA",9002313.91,179,5) FD^8 "DATA",9002313.91,179,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,179,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,180,0) 514^^REMAINING BENEFIT AMOUNT^A/N^^^^8^D "DATA",9002313.91,180,1) "DATA",9002313.91,180,5) FE^8 "DATA",9002313.91,180,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,180,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,182,0) 517^^AMT APPLIED TO PERIODIC DEDUCT^D^^^^8^D "DATA",9002313.91,182,1) "DATA",9002313.91,182,5) FH^8 "DATA",9002313.91,182,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,182,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,183,0) 518^^AMOUNT OF COPAY^D^^^^8^D "DATA",9002313.91,183,1) "DATA",9002313.91,183,5) FI^8 "DATA",9002313.91,183,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,183,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,184,0) 519^^AMT ATTRIBUTED TO PRODUCT SEL^D^^^^8^D "DATA",9002313.91,184,1) "DATA",9002313.91,184,5) FJ^8 "DATA",9002313.91,184,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,184,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,185,0) 520^^AMOUNT EXCEEDING PERIODIC MAX^D^^^^8^D "DATA",9002313.91,185,1) "DATA",9002313.91,185,5) FK^8 "DATA",9002313.91,185,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,185,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,186,0) 521^^INCENTIVE AMOUNT PAID^A/N^^^^8^D "DATA",9002313.91,186,1) "DATA",9002313.91,186,5) FL^8 "DATA",9002313.91,186,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,186,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,187,0) 522^^BASIS OF REIMB DETERMINATION^N^^^^2^N "DATA",9002313.91,187,1) "DATA",9002313.91,187,5) FM^2 "DATA",9002313.91,187,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,187,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,188,0) 523^^AMOUNT ATTRIBUTED TO SALES TAX^D^^^^8^D "DATA",9002313.91,188,1) "DATA",9002313.91,188,5) FN^8 "DATA",9002313.91,188,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,188,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,189,0) 524^^PLAN ID^A/N^^^^8^A/N "DATA",9002313.91,189,1) "DATA",9002313.91,189,5) FO^8 "DATA",9002313.91,189,10,0) ^^1^1^3110301^ "DATA",9002313.91,189,10,1,0) S BPS("X")=$G(BPS("Insurer","Plan ID")) "DATA",9002313.91,189,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,189,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,189,25,0) ^9002313.9104^1^1^3061122^ "DATA",9002313.91,189,25,1,0) S BPS("X")=$$ANFF^BPSECFM(BPS("X"),8) "DATA",9002313.91,189,30,0) ^9002313.9103^1^1^3030825^^^^ "DATA",9002313.91,189,30,1,0) S $P(^BPSC(BPS(9002313.02),520),U,4)=BPS("X") "DATA",9002313.91,191,0) 526^^ADDITIONAL MESSAGE INFORMATION^A/N^^^^40^A/N "DATA",9002313.91,191,1) "DATA",9002313.91,191,5) FQ^200 "DATA",9002313.91,191,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,191,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,192,0) 528^^CLINICAL SIGNIFICANCE CODE^A/N^^^^1^A/N "DATA",9002313.91,192,1) "DATA",9002313.91,192,5) FS^1 "DATA",9002313.91,192,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,192,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,193,0) 529^^OTHER PHARMACY INDICATOR^A/N^^^^1^N "DATA",9002313.91,193,1) "DATA",9002313.91,193,5) FT^1 "DATA",9002313.91,193,10,0) ^9002313.9101^1^1^3031212 "DATA",9002313.91,193,10,1,0) S BPS("X")="" "DATA",9002313.91,193,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,193,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,194,0) 530^^PREVIOUS DATE OF FILL^A/N^^^^8^N "DATA",9002313.91,194,1) "DATA",9002313.91,194,5) FU^8 "DATA",9002313.91,194,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,194,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,195,0) 531^^QUANTITY OF PREVIOUS FILL^N^^^^10^N "DATA",9002313.91,195,1) "DATA",9002313.91,195,5) FV^8 "DATA",9002313.91,195,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,195,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,196,0) 532^^DATABASE INDICATOR^A/N^^^^1^A/N "DATA",9002313.91,196,1) "DATA",9002313.91,196,5) FW^1 "DATA",9002313.91,196,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,196,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,197,0) 533^^OTHER PRESCRIBER INDICATOR^A/N^^^^1^N "DATA",9002313.91,197,1) "DATA",9002313.91,197,5) FX^1 "DATA",9002313.91,197,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,197,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,199,0) 544^^DUR FREE TEXT MESSAGE^A/N^^^^30^A/N "DATA",9002313.91,199,1) "DATA",9002313.91,199,5) FY^30 "DATA",9002313.91,199,10,0) ^9002313.9101^1^1^3101116^ "DATA",9002313.91,199,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,200,0) 545^^NETWORK REIMBURSEMENT ID^A/N^^^^10^A/N "DATA",9002313.91,200,1) "DATA",9002313.91,200,5) 2F^10 "DATA",9002313.91,200,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,200,10,1,0) S BPS("X")="" "DATA",9002313.91,200,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,200,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,201,0) 546^^REJECTED FLD OCCURRENCE INDCTR^A/N^^^^2^N "DATA",9002313.91,201,1) "DATA",9002313.91,201,5) 4F^2 "DATA",9002313.91,201,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,201,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,202,0) 547^^APPROVED MESSAGE CODE COUNT^A/N^^^^1^N "DATA",9002313.91,202,1) "DATA",9002313.91,202,5) 5F^1 "DATA",9002313.91,202,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,202,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,203,0) 548^^APPROVED MESSAGE CODE^A/N^^^^3^A/N "DATA",9002313.91,203,1) "DATA",9002313.91,203,5) 6F^3 "DATA",9002313.91,203,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,203,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,204,0) 549^^HELP DESK PHONE NUMBER QUAL^A/N^^^^2^A/N "DATA",9002313.91,204,1) "DATA",9002313.91,204,5) 7F^2 "DATA",9002313.91,204,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,204,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,205,0) 550^^HELP DESK PHONE NUMBER^A/N^^^^18^A/N "DATA",9002313.91,205,1) "DATA",9002313.91,205,5) 8F^18 "DATA",9002313.91,205,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,205,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,206,0) 551^^PREFERRED PRODUCT COUNT^A/N^^^^1^N "DATA",9002313.91,206,1) "DATA",9002313.91,206,5) 9F^1 "DATA",9002313.91,206,10,0) ^9002313.9101^1^1^3031216 "DATA",9002313.91,206,10,1,0) S BPS("X")="" "DATA",9002313.91,206,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,206,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,207,0) 552^^PREFERRED PRODUCT ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,207,1) "DATA",9002313.91,207,5) AP^2 "DATA",9002313.91,207,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,207,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,208,0) 553^^PREFERRED PRODUCT ID^A/N^^^^19^A/N "DATA",9002313.91,208,1) "DATA",9002313.91,208,5) AR^19 "DATA",9002313.91,208,10,0) ^9002313.9101^1^1^3101115^^ "DATA",9002313.91,208,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,209,0) 554^^PREFERRED PRODUCT INCENTIVE^A/N^^^^8^D "DATA",9002313.91,209,1) "DATA",9002313.91,209,5) AS^8 "DATA",9002313.91,209,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,209,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,210,0) 555^^PREF PRODUCT COST SHARE INCNTV^A/N^^^^8^D "DATA",9002313.91,210,1) "DATA",9002313.91,210,5) AT^8 "DATA",9002313.91,210,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,210,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,211,0) 556^^PREFERRED PRODUCT DESCRIPTION^A/N^^^^40^A/N "DATA",9002313.91,211,1) "DATA",9002313.91,211,5) AU^40 "DATA",9002313.91,211,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,211,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,212,0) 557^^TAX EXEMPT INDICATOR^A/N^^^^1^A/N "DATA",9002313.91,212,1) "DATA",9002313.91,212,5) AV^1 "DATA",9002313.91,212,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,212,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,213,0) 558^^FLAT SALES TAX AMOUNT PAID^A/N^^^^8^D "DATA",9002313.91,213,1) "DATA",9002313.91,213,5) AW^8 "DATA",9002313.91,213,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,213,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,214,0) 559^^PERCENTAGE SALES TAX AMT PAID^A/N^^^^8^D "DATA",9002313.91,214,1) "DATA",9002313.91,214,5) AX^8 "DATA",9002313.91,214,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,214,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,215,0) 560^^PERCENTAGE SALES TAX RATE PAID^A/N^^^^7^D "DATA",9002313.91,215,1) "DATA",9002313.91,215,5) AY^8 "DATA",9002313.91,215,10,0) ^9002313.9101^1^1^3040223 "DATA",9002313.91,215,10,1,0) S BPS("X")="" "DATA",9002313.91,215,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,215,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),7) "DATA",9002313.91,216,0) 561^^PERCENT SALES TAX BASIS PAID^A/N^^^^2^A/N "DATA",9002313.91,216,1) "DATA",9002313.91,216,5) AZ^8 "DATA",9002313.91,216,10,0) ^9002313.9101^1^1^3031212 "DATA",9002313.91,216,10,1,0) S BPS("X")="" "DATA",9002313.91,216,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,216,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,217,0) 562^^PROFESSIONAL SERVICE FEE PAID^A/N^^^^8^D "DATA",9002313.91,217,1) "DATA",9002313.91,217,5) J1^8 "DATA",9002313.91,217,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,217,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,218,0) 563^^OTHER AMOUNT PAID COUNT^N^^^^1^N "DATA",9002313.91,218,1) "DATA",9002313.91,218,5) J2^1 "DATA",9002313.91,218,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,218,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,219,0) 564^^OTHER AMOUNT PAID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,219,1) "DATA",9002313.91,219,5) J3^2 "DATA",9002313.91,219,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,219,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,220,0) 565^^OTHER AMOUNT PAID^A/N^^^^8^D "DATA",9002313.91,220,1) "DATA",9002313.91,220,5) J4^8 "DATA",9002313.91,220,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,220,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,221,0) 566^^OTHER PAYER AMOUNT RECOGNIZED^A/N^^^^8^D "DATA",9002313.91,221,1) "DATA",9002313.91,221,5) J5^8 "DATA",9002313.91,221,10,0) ^9002313.9101^1^1^3101115^^ "DATA",9002313.91,221,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,222,0) 567^^DUR/PPS RESPONSE CODE COUNTER^N^^^^1^N "DATA",9002313.91,222,1) "DATA",9002313.91,222,5) J6^1 "DATA",9002313.91,222,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,222,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,223,0) 568^^PAYER ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,223,1) "DATA",9002313.91,223,5) J7^2 "DATA",9002313.91,223,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,223,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,224,0) 569^^PAYER ID^A/N^^^^10^A/N "DATA",9002313.91,224,1) "DATA",9002313.91,224,5) J8^10 "DATA",9002313.91,224,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,224,10,1,0) ;This is Response-only field which does not use the GET FORMAT or SET code "DATA",9002313.91,225,0) 600^^UNIT OF MEASURE^A/N^^^^2^A/N "DATA",9002313.91,225,1) "DATA",9002313.91,225,5) 28^2 "DATA",9002313.91,225,10,0) ^9002313.9101^1^1^3070625 "DATA",9002313.91,225,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Unit of Measure")) "DATA",9002313.91,225,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,225,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,225,25,0) ^9002313.9104^1^1^3070620^ "DATA",9002313.91,225,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,225,30,0) ^9002313.9103^1^1^3070620^ "DATA",9002313.91,225,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),600),U,1)="" "DATA",9002313.91,240,0) 478^^OTHER AMT CLAIMED SBMTTD COUNT^N^^^^1^N "DATA",9002313.91,240,1) OTHER AMOUNT CLAIMED SUBMITTED COUNT "DATA",9002313.91,240,5) H7^1 "DATA",9002313.91,240,10,0) ^9002313.9101^1^1^3101006^^^ "DATA",9002313.91,240,10,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,240,20,0) ^9002313.9102^1^1^3101006^^^ "DATA",9002313.91,240,20,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,240,25,0) ^9002313.9104^1^1^3101006^^ "DATA",9002313.91,240,25,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,240,30,0) ^9002313.9103^1^1^3101006^^ "DATA",9002313.91,240,30,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,241,0) 479^^OTHER AMT CLAIMED SUBM QLFR^A/N^^^^2^A/N "DATA",9002313.91,241,1) OTHER AMOUNT CLAIMED SUBMITTED QUALIFIER "DATA",9002313.91,241,5) H8^2 "DATA",9002313.91,241,10,0) ^9002313.9101^1^1^3101006^^^ "DATA",9002313.91,241,10,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,241,20,0) ^9002313.9102^1^1^3101006^^^ "DATA",9002313.91,241,20,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,241,25,0) ^9002313.9104^1^1^3101006^^ "DATA",9002313.91,241,25,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,241,30,0) ^9002313.9103^1^1^3101006^^ "DATA",9002313.91,241,30,1,0) ; fields 478, 479, 480 handled by FLD480^BPSOSSG (see SET CODE in field 480) "DATA",9002313.91,242,0) 463^^INTERMEDIARY AUTH TYPE ID^N^^^^2^N "DATA",9002313.91,242,1) INTERMEDIARY AUTHORIZATION TYPE ID "DATA",9002313.91,242,5) EW^2 "DATA",9002313.91,242,10,0) ^^2^2^3110727^ "DATA",9002313.91,242,10,1,0) S BPS("X")=$G(BPS("Claim",BPS(9002313.0201),"Intermediary Auth Type ID")) "DATA",9002313.91,242,10,2,0) S:BPS("X")="" BPS("X")=0 "DATA",9002313.91,242,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,242,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,242,25,0) ^9002313.9104^1^1^3030823^^^^ "DATA",9002313.91,242,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,242,30,0) ^9002313.9103^1^1^3030823^^ "DATA",9002313.91,242,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),460),U,3)=BPS("X") "DATA",9002313.91,265,0) 451^^COMPOUND DISP UNIT FORM INDCTR^N^^^^1^N "DATA",9002313.91,265,1) COMPOUND DISPENSING UNIT FORM INDICATOR "DATA",9002313.91,265,5) EG^1 "DATA",9002313.91,265,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,265,10,1,0) S BPS("X")="" "DATA",9002313.91,265,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,265,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,265,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,265,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,266,0) 450^^COMPOUND DOSAGE FORM DESC CODE^A/N^^^^2^A/N "DATA",9002313.91,266,1) COMPOUND DOSAGE FORM DESCRIPTION CODE "DATA",9002313.91,266,5) EF^2 "DATA",9002313.91,266,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,266,10,1,0) S BPS("X")="" "DATA",9002313.91,266,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,266,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,266,25,0) ^9002313.9104^1^1^3040107^^^^ "DATA",9002313.91,266,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,266,30,0) ^9002313.9103^1^1^3040107^^^^ "DATA",9002313.91,266,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),440),U,10)=BPS("X") "DATA",9002313.91,267,0) 490^^COMP INGRED BASIS COST DETERM^A/N^^^^2^A/N "DATA",9002313.91,267,1) COMPOUND INGREDIENT BASIS OF COST DETERMINATION "DATA",9002313.91,267,5) UE^2 "DATA",9002313.91,267,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,267,10,1,0) S BPS("X")="" "DATA",9002313.91,267,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,267,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,267,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,267,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,268,0) 447^^COMPOUND INGREDIENT COMP COUNT^N^^^^2^N "DATA",9002313.91,268,1) COMPOUND INGREDIENT COMPONENT COUNT "DATA",9002313.91,268,5) EC^2 "DATA",9002313.91,268,10,0) ^9002313.9101^1^1^3101115^ "DATA",9002313.91,268,10,1,0) S BPS("X")="" "DATA",9002313.91,268,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,268,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,268,25,0) ^9002313.9104^1^1^3040107^^^^ "DATA",9002313.91,268,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,268,30,0) ^9002313.9103^1^1^3040107^^^^ "DATA",9002313.91,268,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),440),U,7)=BPS("X") "DATA",9002313.91,269,0) 449^^COMPOUND INGREDIENT DRUG COST^N^^^^8^D "DATA",9002313.91,269,1) "DATA",9002313.91,269,5) EE^8 "DATA",9002313.91,269,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,269,10,1,0) S BPS("X")="" "DATA",9002313.91,269,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,269,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,269,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,269,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,271,0) 489^^COMPOUND PRODUCT ID^A/N^^^^19^A/N "DATA",9002313.91,271,1) "DATA",9002313.91,271,5) TE^19 "DATA",9002313.91,271,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,271,10,1,0) S BPS("X")="" "DATA",9002313.91,271,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,271,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,271,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,271,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,272,0) 488^^COMPOUND PRODUCT ID QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,272,1) "DATA",9002313.91,272,5) RE^2 "DATA",9002313.91,272,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,272,10,1,0) S BPS("X")="" "DATA",9002313.91,272,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,272,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,272,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,272,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,273,0) 452^^COMPOUND ROUTE OF ADMIN^N^^^^2^N "DATA",9002313.91,273,1) "DATA",9002313.91,273,5) EH^2 "DATA",9002313.91,273,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,273,10,1,0) S BPS("X")="" "DATA",9002313.91,273,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,273,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,273,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,273,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,308,0) 448^^COMPOUND INGREDIENT QUANTITY^N^^^^10^N "DATA",9002313.91,308,1) "DATA",9002313.91,308,5) ED^10 "DATA",9002313.91,308,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,308,10,1,0) S BPS("X")="" "DATA",9002313.91,308,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,308,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,308,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,308,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,324,0) 494^^MEASUREMENT DATE^A/N^^^^8^N "DATA",9002313.91,324,1) "DATA",9002313.91,324,5) ZE^8 "DATA",9002313.91,324,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,324,10,1,0) S BPS("X")="" "DATA",9002313.91,324,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,324,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,324,25,0) ^9002313.9104^1^1^3040224^ "DATA",9002313.91,324,25,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,325,0) 496^^MEASUREMENT DIMENSION^A/N^^^^2^A/N "DATA",9002313.91,325,1) "DATA",9002313.91,325,5) H2^2 "DATA",9002313.91,325,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,325,10,1,0) S BPS("X")="" "DATA",9002313.91,325,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,325,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,325,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,325,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,326,0) 495^^MEASUREMENT TIME^N^^^^4^N "DATA",9002313.91,326,1) "DATA",9002313.91,326,5) H1^4 "DATA",9002313.91,326,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,326,10,1,0) S BPS("X")="" "DATA",9002313.91,326,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,326,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),4) "DATA",9002313.91,326,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,326,25,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),4) "DATA",9002313.91,327,0) 497^^MEASUREMENT UNIT^A/N^^^^2^A/N "DATA",9002313.91,327,1) "DATA",9002313.91,327,5) H3^2 "DATA",9002313.91,327,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,327,10,1,0) S BPS("X")="" "DATA",9002313.91,327,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,327,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,327,25,0) ^9002313.9104^1^1^3040224^^^^ "DATA",9002313.91,327,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,328,0) 499^^MEASUREMENT VALUE^A/N^^^^15^A/N "DATA",9002313.91,328,1) "DATA",9002313.91,328,5) H4^15 "DATA",9002313.91,328,10,0) ^9002313.9101^1^1^3040224 "DATA",9002313.91,328,10,1,0) S BPS("X")="" "DATA",9002313.91,328,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,328,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,328,25,0) ^9002313.9104^1^1^3040224^^^ "DATA",9002313.91,328,25,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,329,0) 990^^OTHER PAYER BIN NUMBER^N^^^^6^N "DATA",9002313.91,329,1) "DATA",9002313.91,329,5) MG^6 "DATA",9002313.91,329,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,329,10,1,0) S BPS("X")="" "DATA",9002313.91,329,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,329,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),6) "DATA",9002313.91,329,30,0) ^9002313.9103^1^1^3101101^ "DATA",9002313.91,329,30,1,0) S $P(^BPSC(BPS(9002313.02),980),U,10)="" "DATA",9002313.91,330,0) 991^^OTHER PAYER PROC CONTROL NUM^A/N^^^^10^A/N "DATA",9002313.91,330,1) OTHER PAYER PROCESSOR CONTROL NUMBER "DATA",9002313.91,330,5) MH^10 "DATA",9002313.91,330,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,330,10,1,0) S BPS("X")="" "DATA",9002313.91,330,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,330,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,330,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,330,30,1,0) S $P(^BPSC(BPS(9002313.02),990),U,1)="" "DATA",9002313.91,331,0) 356^^OTHER PAYER CARDHOLDER ID^A/N^^^^20^A/N "DATA",9002313.91,331,1) "DATA",9002313.91,331,5) NU^20 "DATA",9002313.91,331,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,331,10,1,0) S BPS("X")="" "DATA",9002313.91,331,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,331,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,331,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,331,30,1,0) S $P(^BPSC(BPS(9002313.02),350),U,6)="" "DATA",9002313.91,332,0) 992^^OTHER PAYER GROUP ID^A/N^^^^15^A/N "DATA",9002313.91,332,1) "DATA",9002313.91,332,5) MJ^15 "DATA",9002313.91,332,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,332,10,1,0) S BPS("X")="" "DATA",9002313.91,332,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,332,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,332,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,332,30,1,0) S $P(^BPSC(BPS(9002313.02),990),U,2)="" "DATA",9002313.91,333,0) 359^^MEDIGAP ID^A/N^^^^20^A/N "DATA",9002313.91,333,1) "DATA",9002313.91,333,5) 2A^20 "DATA",9002313.91,333,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,333,10,1,0) S BPS("X")="" "DATA",9002313.91,333,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,333,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,333,30,0) ^9002313.9103^1^1^3100923^^ "DATA",9002313.91,333,30,1,0) S $P(^BPSC(BPS(9002313.02),350),U,9)="" "DATA",9002313.91,334,0) 360^^MEDICAID INDICATOR^N^^^^2^A/N "DATA",9002313.91,334,1) "DATA",9002313.91,334,5) 2B^2 "DATA",9002313.91,334,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,334,10,1,0) S BPS("X")="" "DATA",9002313.91,334,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,334,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,334,30,0) ^9002313.9103^1^1^3101101^ "DATA",9002313.91,334,30,1,0) S $P(^BPSC(BPS(9002313.02),350),U,10)="" "DATA",9002313.91,335,0) 361^^PROVIDER ACCEPT ASSGNMT INDCTR^A/N^^^^1^A/N "DATA",9002313.91,335,1) PROVIDER ACCEPT ASSIGNMENT INDICATOR "DATA",9002313.91,335,5) 2D^1 "DATA",9002313.91,335,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,335,10,1,0) S BPS("X")="Y" "DATA",9002313.91,335,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,335,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,335,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,335,30,1,0) S $P(^BPSC(BPS(9002313.02),360),U,1)=$G(BPS("X")) "DATA",9002313.91,336,0) 997^^CMS PART D DEFND QLFD FACILITY^A/N^^^^1^A/N "DATA",9002313.91,336,1) CMS PART D DEFINED QUALIFIED FACILITY "DATA",9002313.91,336,5) G2^1 "DATA",9002313.91,336,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,336,10,1,0) S BPS("X")="N" "DATA",9002313.91,336,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,336,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,336,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,336,30,1,0) S $P(^BPSC(BPS(9002313.02),990),U,7)=$G(BPS("X")) "DATA",9002313.91,337,0) 115^^MEDICAID ID NUMBER^A/N^^^^20^A/N "DATA",9002313.91,337,1) "DATA",9002313.91,337,5) N5^20 "DATA",9002313.91,337,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,337,10,1,0) S BPS("X")="" "DATA",9002313.91,337,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,337,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,337,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,337,30,1,0) S $P(^BPSC(BPS(9002313.02),110),U,5)="" "DATA",9002313.91,338,0) 116^^MEDICAID AGENCY NUMBER^A/N^^^^15^A/N "DATA",9002313.91,338,1) "DATA",9002313.91,338,5) N6^15 "DATA",9002313.91,338,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,338,10,1,0) S BPS("X")="" "DATA",9002313.91,338,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,338,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,338,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,338,30,1,0) S $P(^BPSC(BPS(9002313.02),110),U,6)="" "DATA",9002313.91,339,0) 384^^PATIENT RESIDENCE^N^^^^2^N "DATA",9002313.91,339,1) "DATA",9002313.91,339,5) 4X^2 "DATA",9002313.91,339,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,339,10,1,0) S BPS("X")=$G(BPS("Patient","Patient Residence")) "DATA",9002313.91,339,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,339,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,339,30,0) ^9002313.9103^1^1^3101007^^^^ "DATA",9002313.91,339,30,1,0) S $P(^BPSC(BPS(9002313.02),380),U,4)=$G(BPS("X")) "DATA",9002313.91,340,0) 354^^SUBMISSION CLARIF CODE COUNT^N^^^^1^N "DATA",9002313.91,340,1) SUBMISSION CLARIFICATION CODE COUNT "DATA",9002313.91,340,5) NX^2 "DATA",9002313.91,340,10,0) ^9002313.9101^1^1^3101006^^ "DATA",9002313.91,340,10,1,0) ; fields 354 & 420 handled by FLD420^BPSOSSG (see SET CODE in field 420) "DATA",9002313.91,340,20,0) ^9002313.9102^1^1^3101006^^ "DATA",9002313.91,340,20,1,0) ; fields 354 & 420 handled by FLD420^BPSOSSG (see SET CODE in field 420) "DATA",9002313.91,340,25,0) ^9002313.9104^1^1^3101006^^ "DATA",9002313.91,340,25,1,0) ; fields 354 & 420 handled by FLD420^BPSOSSG (see SET CODE in field 420) "DATA",9002313.91,340,30,0) ^9002313.9103^1^1^3101006^^^^ "DATA",9002313.91,340,30,1,0) ; fields 354 & 420 handled by FLD420^BPSOSSG (see SET CODE in field 420) "DATA",9002313.91,341,0) 357^^DELAY REASON CODE^N^^^^2^N "DATA",9002313.91,341,1) "DATA",9002313.91,341,5) NV^2 "DATA",9002313.91,341,10,0) ^9002313.9101^1^1^3101007^^ "DATA",9002313.91,341,10,1,0) S BPS("X")=$G(BPS("Claim",BPS(9002313.0201),"Delay Reason Code")) "DATA",9002313.91,341,20,0) ^9002313.9102^1^1^3101012^ "DATA",9002313.91,341,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,341,30,0) ^9002313.9103^1^1^3101007^^ "DATA",9002313.91,341,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),350),U,7)=$S($G(BPS("X"))="NV00":"",1:$G(BPS("X"))) "DATA",9002313.91,342,0) 880^^TRANSACTION REFERENCE NUMBER^A/N^^^^10^A/N "DATA",9002313.91,342,1) "DATA",9002313.91,342,5) K5^10 "DATA",9002313.91,342,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,342,10,1,0) S BPS("X")="" "DATA",9002313.91,342,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,342,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),10) "DATA",9002313.91,342,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,342,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),870),U,10)="" "DATA",9002313.91,343,0) 391^^PATIENT ASSIGNMENT INDICATOR^A/N^^^^1^A/N "DATA",9002313.91,343,1) PATIENT ASSIGNMENT INDICATOR (DIRECT MEMBER REIMBURSEMENT INDICATOR) "DATA",9002313.91,343,5) MT^1 "DATA",9002313.91,343,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,343,10,1,0) S BPS("X")="Y" "DATA",9002313.91,343,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,343,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,343,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,343,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),390),U,1)=$G(BPS("X")) "DATA",9002313.91,344,0) 995^^ROUTE OF ADMINISTRATION^A/N^^^^11^A/N "DATA",9002313.91,344,1) "DATA",9002313.91,344,5) E2^1 "DATA",9002313.91,344,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,344,10,1,0) S BPS("X")="" "DATA",9002313.91,344,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,344,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,344,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,344,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),990),U,5)=$G(BPS("X")) "DATA",9002313.91,345,0) 996^^COMPOUND TYPE^A/N^^^^2^A/N "DATA",9002313.91,345,1) "DATA",9002313.91,345,5) G1^2 "DATA",9002313.91,345,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,345,10,1,0) S BPS("X")="" "DATA",9002313.91,345,20,0) ^9002313.9102^1^1^3101206^ "DATA",9002313.91,345,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,345,30,0) ^9002313.9103^1^1^3101206^^^ "DATA",9002313.91,345,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),990),U,6)=$G(BPS("X")) "DATA",9002313.91,346,0) 114^^MEDICAID SUBROGATION ICN/TCN^A/N^^^^20^A/N "DATA",9002313.91,346,1) MEDICAID SUBROGATION INTERNAL CONTROL NUMBER/TRANSACTION CONTROL NUMBER (ICN/TCN) "DATA",9002313.91,346,5) N4^20 "DATA",9002313.91,346,10,0) ^9002313.9101^1^1^3101110^ "DATA",9002313.91,346,10,1,0) S BPS("X")="" "DATA",9002313.91,346,20,0) ^9002313.9102^1^1^3101110^ "DATA",9002313.91,346,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,346,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,346,30,1,0) S $P(^BPSC(BPS(9002313.02),110),U,4)="" "DATA",9002313.91,347,0) 147^^PHARMACY SERVICE TYPE^N^^^^2^N "DATA",9002313.91,347,1) "DATA",9002313.91,347,5) U7^2 "DATA",9002313.91,347,10,0) ^9002313.9101^1^1^3101007^^ "DATA",9002313.91,347,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Pharmacy Service Type")) "DATA",9002313.91,347,20,0) ^9002313.9102^1^1^3101007^^ "DATA",9002313.91,347,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,347,30,0) ^9002313.9103^1^1^3101007^^^^ "DATA",9002313.91,347,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),140),U,7)=$G(BPS("X")) "DATA",9002313.91,348,0) 364^^PRESCRIBER FIRST NAME^A/N^^^^12^A/N "DATA",9002313.91,348,1) "DATA",9002313.91,348,5) 2J^12 "DATA",9002313.91,348,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,348,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber First Name")) "DATA",9002313.91,348,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,348,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),12) "DATA",9002313.91,348,30,0) ^9002313.9103^1^1^3101101^^^ "DATA",9002313.91,348,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,4)=$G(BPS("X")) "DATA",9002313.91,349,0) 365^^PRESCRIBER STREET ADDRESS^A/N^^^^30^A/N "DATA",9002313.91,349,1) "DATA",9002313.91,349,5) 2K^30 "DATA",9002313.91,349,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,349,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber Street Address")) "DATA",9002313.91,349,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,349,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,349,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,349,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,5)=$G(BPS("X")) "DATA",9002313.91,350,0) 366^^PRESCRIBER CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,350,1) "DATA",9002313.91,350,5) 2M^20 "DATA",9002313.91,350,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,350,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber City Address")) "DATA",9002313.91,350,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,350,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,350,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,350,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,6)=$G(BPS("X")) "DATA",9002313.91,351,0) 367^^PRESCRIBER STATE/PROV ADDRESS^A/N^^^^2^A/N "DATA",9002313.91,351,1) PRESCRIBER STATE/PROVINCE ADDRESS "DATA",9002313.91,351,5) 2N^2 "DATA",9002313.91,351,10,0) ^9002313.9101^1^1^3101029^^ "DATA",9002313.91,351,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber State/Province Address")) "DATA",9002313.91,351,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,351,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,351,30,0) ^9002313.9103^1^1^3101101^^^ "DATA",9002313.91,351,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,7)=$G(BPS("X")) "DATA",9002313.91,352,0) 368^^PRESCRIBER ZIP/POSTAL ZONE^A/N^^^^15^A/N "DATA",9002313.91,352,1) "DATA",9002313.91,352,5) 2P^2 "DATA",9002313.91,352,10,0) ^9002313.9101^1^1^3101029^ "DATA",9002313.91,352,10,1,0) S BPS("X")=$G(BPS("RX",BPS(9002313.0201),"Prescriber Zip/Postal Zone")) "DATA",9002313.91,352,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,352,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,352,30,0) ^9002313.9103^1^1^3101101^^ "DATA",9002313.91,352,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,8)=$G(BPS("X")) "DATA",9002313.91,353,0) 993^^INTERNAL CONTROL NUMBER^A/N^^^^30^A/N "DATA",9002313.91,353,1) "DATA",9002313.91,353,5) A7^30 "DATA",9002313.91,353,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,353,10,1,0) S BPS("X")="" "DATA",9002313.91,353,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,353,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,353,30,0) ^9002313.9103^1^1^3101029^ "DATA",9002313.91,353,30,1,0) ; This field currently not implemented "DATA",9002313.91,354,0) 392^^BENEFIT STAGE COUNT^N^^^^1^N "DATA",9002313.91,354,1) "DATA",9002313.91,354,5) MU^1 "DATA",9002313.91,354,10,0) ^^1^1^3110727^ "DATA",9002313.91,354,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,354,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,354,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,354,30,0) ^^1^1^3110727^ "DATA",9002313.91,354,30,1,0) D SET392^BPSFLD01 "DATA",9002313.91,355,0) 393^^BENEFIT STAGE QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,355,1) "DATA",9002313.91,355,5) MV^2 "DATA",9002313.91,355,10,0) ^^1^1^3110727^ "DATA",9002313.91,355,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,355,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,355,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,355,30,0) ^^1^1^3110727^ "DATA",9002313.91,355,30,1,0) D SET393^BPSFLD01 "DATA",9002313.91,356,0) 394^^BENEFIT STAGE AMOUNT^N^^^^8^D "DATA",9002313.91,356,1) "DATA",9002313.91,356,5) MW^8 "DATA",9002313.91,356,10,0) ^^1^1^3110727^ "DATA",9002313.91,356,10,1,0) ;GET code for this COB field is executed in COB^BPSOSHF "DATA",9002313.91,356,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,356,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,356,30,0) ^^1^1^3110727^ "DATA",9002313.91,356,30,1,0) D SET394^BPSFLD01 "DATA",9002313.91,357,0) 117^^BILLING ENTITY TYPE INDICATOR^N^^^^2^N "DATA",9002313.91,357,1) "DATA",9002313.91,357,5) TR^2 "DATA",9002313.91,357,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,357,10,1,0) S BPS("X")="" "DATA",9002313.91,357,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,357,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,357,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,357,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),110),U,7)="" "DATA",9002313.91,358,0) 118^^PAY TO QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,358,1) "DATA",9002313.91,358,5) TS^2 "DATA",9002313.91,358,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,358,10,1,0) S BPS("X")="" "DATA",9002313.91,358,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,358,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,358,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,358,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),110),U,8)="" "DATA",9002313.91,359,0) 119^^PAY TO ID^A/N^^^^15^A/N "DATA",9002313.91,359,1) "DATA",9002313.91,359,5) TT^15 "DATA",9002313.91,359,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,359,10,1,0) S BPS("X")="" "DATA",9002313.91,359,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,359,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,359,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,359,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),110),U,9)="" "DATA",9002313.91,360,0) 120^^PAY TO NAME^A/N^^^^20^A/N "DATA",9002313.91,360,1) "DATA",9002313.91,360,5) TU^20 "DATA",9002313.91,360,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,360,10,1,0) S BPS("X")="" "DATA",9002313.91,360,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,360,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,360,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,360,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),110),U,10)="" "DATA",9002313.91,361,0) 121^^PAY TO STREET ADDRESS^A/N^^^^30^A/N "DATA",9002313.91,361,1) "DATA",9002313.91,361,5) TV^30 "DATA",9002313.91,361,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,361,10,1,0) S BPS("X")="" "DATA",9002313.91,361,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,361,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,361,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,361,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),120),U,1)="" "DATA",9002313.91,362,0) 122^^PAY TO CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,362,1) "DATA",9002313.91,362,5) TW^20 "DATA",9002313.91,362,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,362,10,1,0) S BPS("X")="" "DATA",9002313.91,362,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,362,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,362,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,362,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),120),U,2)="" "DATA",9002313.91,363,0) 124^^PAY TO ZIP/POSTAL ADDRESS^A/N^^^^15^A/N "DATA",9002313.91,363,1) "DATA",9002313.91,363,5) TY^15 "DATA",9002313.91,363,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,363,10,1,0) S BPS("X")="" "DATA",9002313.91,363,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,363,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,363,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,363,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),120),U,4)="" "DATA",9002313.91,364,0) 125^^GENERIC EQUIV PROD ID QLFR^A/N^^^^2^A/N "DATA",9002313.91,364,1) GENERIC EQUIVALENT PRODUCT ID QUALIFIER "DATA",9002313.91,364,5) TZ^2 "DATA",9002313.91,364,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,364,10,1,0) S BPS("X")="" "DATA",9002313.91,364,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,364,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,364,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,364,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),120),U,5)="" "DATA",9002313.91,365,0) 126^^GENERIC EQUIVALENT PRODUCT ID^A/N^^^^19^A/N "DATA",9002313.91,365,1) "DATA",9002313.91,365,5) UA^19 "DATA",9002313.91,365,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,365,10,1,0) S BPS("X")="" "DATA",9002313.91,365,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,365,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),19) "DATA",9002313.91,365,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,365,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),120),U,6)="" "DATA",9002313.91,366,0) 113^^MEDICAID PAID AMOUNT^N^^^^8^D "DATA",9002313.91,366,1) "DATA",9002313.91,366,5) N3^8 "DATA",9002313.91,366,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,366,10,1,0) S BPS("X")="" "DATA",9002313.91,366,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,366,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,366,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,366,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),110),U,3)="" "DATA",9002313.91,367,0) 362^^COMPOUND INGRED MOD CODE CNT^N^^^^2^N "DATA",9002313.91,367,1) COMPOUND INGREDIENT MODIFIER CODE COUNT "DATA",9002313.91,367,5) 2G^2 "DATA",9002313.91,367,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,367,10,1,0) S BPS("X")="" "DATA",9002313.91,367,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,367,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,367,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,367,30,1,0) ; This field currently not implemented "DATA",9002313.91,368,0) 363^^COMPOUND INGRED MODIFIER CODE^A/N^^^^2^A/N "DATA",9002313.91,368,1) COMPOUND INGREDIENT MODIFIER CODE "DATA",9002313.91,368,5) 2H^2 "DATA",9002313.91,368,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,368,10,1,0) S BPS("X")="" "DATA",9002313.91,368,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,368,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,368,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,368,30,1,0) ; This field currently not implemented "DATA",9002313.91,369,0) 369^^ADDITIONAL DCMNTN TYPE ID^A/N^^^^3^A/N "DATA",9002313.91,369,1) ADDITIONAL DOCUMENTATION TYPE ID "DATA",9002313.91,369,5) 2Q^3 "DATA",9002313.91,369,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,369,10,1,0) S BPS("X")="" "DATA",9002313.91,369,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,369,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,369,30,0) ^9002313.9103^1^1^3101206^^ "DATA",9002313.91,369,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,9)="" "DATA",9002313.91,370,0) 370^^LENGTH OF NEED^N^^^^3^N "DATA",9002313.91,370,1) "DATA",9002313.91,370,5) 2R^3 "DATA",9002313.91,370,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,370,10,1,0) S BPS("X")="" "DATA",9002313.91,370,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,370,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,370,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,370,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),360),U,10)="" "DATA",9002313.91,371,0) 371^^LENGTH OF NEED QUALIFIER^N^^^^2^N "DATA",9002313.91,371,1) "DATA",9002313.91,371,5) 2S^3 "DATA",9002313.91,371,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,371,10,1,0) S BPS("X")="" "DATA",9002313.91,371,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,371,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,371,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,371,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),370),U,1)="" "DATA",9002313.91,372,0) 372^^PRESCRIBER/SUPPLIER DT SIGNED^N^^^^8^N "DATA",9002313.91,372,1) PRESCRIBER/SUPPLIER DATE SIGNED "DATA",9002313.91,372,5) 2T^9 "DATA",9002313.91,372,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,372,10,1,0) S BPS("X")="" "DATA",9002313.91,372,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,372,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,372,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,372,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),370),U,2)="" "DATA",9002313.91,373,0) 373^^REQUEST STATUS^A/N^^^^1^A/N "DATA",9002313.91,373,1) "DATA",9002313.91,373,5) 2U^1 "DATA",9002313.91,373,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,373,10,1,0) S BPS("X")="" "DATA",9002313.91,373,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,373,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),1) "DATA",9002313.91,373,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,373,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),370),U,3)="" "DATA",9002313.91,374,0) 374^^REQUEST PERIOD BEGIN DATE^N^^^^8^N "DATA",9002313.91,374,1) "DATA",9002313.91,374,5) 2V^8 "DATA",9002313.91,374,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,374,10,1,0) S BPS("X")="" "DATA",9002313.91,374,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,374,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,374,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,374,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),370),U,4)="" "DATA",9002313.91,375,0) 375^^REQ PERIOD RECERT/REVISED DT^N^^^^8^N "DATA",9002313.91,375,1) REQUEST PERIOD RECERT/REVISED DATE "DATA",9002313.91,375,5) 2W^8 "DATA",9002313.91,375,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,375,10,1,0) S BPS("X")="" "DATA",9002313.91,375,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,375,20,1,0) S BPS("X")=$$DTF1^BPSECFM($G(BPS("X"))) "DATA",9002313.91,375,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,375,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),370),U,5)="" "DATA",9002313.91,376,0) 376^^SUPPORTING DOCUMENTATION^A/N^^^^65^A/N "DATA",9002313.91,376,1) "DATA",9002313.91,376,5) 2X^65 "DATA",9002313.91,376,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,376,10,1,0) S BPS("X")="" "DATA",9002313.91,376,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,376,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),65) "DATA",9002313.91,376,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,376,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),370),U,6)="" "DATA",9002313.91,377,0) 377^^QUESTION NUMBER/LETTER COUNT^A/N^^^^2^N "DATA",9002313.91,377,1) "DATA",9002313.91,377,5) 2Z^65 "DATA",9002313.91,377,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,377,10,1,0) S BPS("X")="" "DATA",9002313.91,377,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,377,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,378,0) 378^^QUESTION NUMBER/LETTER^A/N^^^^3^A/N "DATA",9002313.91,378,1) "DATA",9002313.91,378,5) 4B^3 "DATA",9002313.91,378,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,378,10,1,0) S BPS("X")="" "DATA",9002313.91,378,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,378,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),3) "DATA",9002313.91,378,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,378,30,1,0) ; This field currently not implemented "DATA",9002313.91,379,0) 379^^QUESTION PERCENT RESPONSE^N^^^^5^N "DATA",9002313.91,379,1) "DATA",9002313.91,379,5) 4D^5 "DATA",9002313.91,379,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,379,10,1,0) S BPS("X")="" "DATA",9002313.91,379,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,379,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),5) "DATA",9002313.91,379,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,379,30,1,0) ; This field currently not implemented "DATA",9002313.91,380,0) 380^^QUESTION DATE RESPONSE^N^^^^8^N "DATA",9002313.91,380,1) "DATA",9002313.91,380,5) 4G^8 "DATA",9002313.91,380,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,380,10,1,0) S BPS("X")="" "DATA",9002313.91,380,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,380,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),8) "DATA",9002313.91,380,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,380,30,1,0) ; This field currently not implemented "DATA",9002313.91,381,0) 381^^QUESTION DOLLAR AMT RESPONSE^N^^^^11^D "DATA",9002313.91,381,1) QUESTION DOLLAR AMOUNT RESPONSE "DATA",9002313.91,381,5) 4H^9 "DATA",9002313.91,381,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,381,10,1,0) S BPS("X")="" "DATA",9002313.91,381,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,381,20,1,0) S BPS("X")=$$DFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,381,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,381,30,1,0) ; This field currently not implemented "DATA",9002313.91,382,0) 382^^QUESTION NUMERIC RESPONSE^N^^^^11^N "DATA",9002313.91,382,1) "DATA",9002313.91,382,5) 4J^11 "DATA",9002313.91,382,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,382,10,1,0) S BPS("X")="" "DATA",9002313.91,382,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,382,20,1,0) S BPS("X")=$$NFF^BPSECFM($G(BPS("X")),11) "DATA",9002313.91,382,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,382,30,1,0) ; This field currently not implemented "DATA",9002313.91,383,0) 383^^QUESTION ALPHANUMERIC RESPONSE^A/N^^^^30^A/N "DATA",9002313.91,383,1) "DATA",9002313.91,383,5) 4K^30 "DATA",9002313.91,383,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,383,10,1,0) S BPS("X")="" "DATA",9002313.91,383,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,383,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,383,30,0) ^9002313.9103^1^1^3101206^ "DATA",9002313.91,383,30,1,0) ; This field currently not implemented "DATA",9002313.91,384,0) 385^^FACILITY NAME^A/N^^^^30^A/N "DATA",9002313.91,384,1) "DATA",9002313.91,384,5) 3Q^30 "DATA",9002313.91,384,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,384,10,1,0) S BPS("X")="" "DATA",9002313.91,384,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,384,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,384,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,384,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),380),U,5)="" "DATA",9002313.91,385,0) 386^^FACILITY STREET ADDRESS^A/N^^^^30^A/N "DATA",9002313.91,385,1) "DATA",9002313.91,385,5) 3U^30 "DATA",9002313.91,385,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,385,10,1,0) S BPS("X")="" "DATA",9002313.91,385,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,385,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),30) "DATA",9002313.91,385,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,385,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),380),U,6)="" "DATA",9002313.91,386,0) 387^^FACILITY STATE/PROV ADDRESS^A/N^^^^2^A/N "DATA",9002313.91,386,1) FACILITY STATE/PROVINCE ADDRESS "DATA",9002313.91,386,5) 3V^2 "DATA",9002313.91,386,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,386,10,1,0) S BPS("X")="" "DATA",9002313.91,386,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,386,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,386,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,386,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),380),U,7)="" "DATA",9002313.91,387,0) 388^^FACILITY CITY ADDRESS^A/N^^^^20^A/N "DATA",9002313.91,387,1) "DATA",9002313.91,387,5) 5J^20 "DATA",9002313.91,387,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,387,10,1,0) S BPS("X")="" "DATA",9002313.91,387,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,387,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),20) "DATA",9002313.91,387,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,387,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),380),U,8)="" "DATA",9002313.91,388,0) 389^^FACILITY ZIP/POSTAL ZONE^A/N^^^^15^A/N "DATA",9002313.91,388,1) "DATA",9002313.91,388,5) 6D^16 "DATA",9002313.91,388,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,388,10,1,0) S BPS("X")="" "DATA",9002313.91,388,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,388,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),15) "DATA",9002313.91,388,30,0) ^9002313.9103^1^1^3100925^ "DATA",9002313.91,388,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),380),U,9)="" "DATA",9002313.91,389,0) 390^^NARRATIVE MESSAGE^A/N^^^^200^A/N "DATA",9002313.91,389,1) "DATA",9002313.91,389,5) BM^200 "DATA",9002313.91,389,10,0) ^9002313.9101^1^1^3101110^ "DATA",9002313.91,389,10,1,0) S BPS("X")="" "DATA",9002313.91,389,20,0) ^9002313.9102^1^1^3101110^ "DATA",9002313.91,389,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),200) "DATA",9002313.91,389,30,0) ^9002313.9103^1^1^3101110^^ "DATA",9002313.91,389,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),389),U,2)="" "DATA",9002313.91,390,0) 130^^ADDITIONAL MESSAGE INFO COUNT^N^^^^2^N "DATA",9002313.91,390,1) "DATA",9002313.91,390,5) UF^2 "DATA",9002313.91,390,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,390,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,391,0) 132^^ADDITIONAL MSG INFO QUALIFIER^A/N^^^^2^A/N "DATA",9002313.91,391,1) "DATA",9002313.91,391,5) UH^2 "DATA",9002313.91,391,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,391,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,392,0) 131^^ADDITIONAL MSG INFO CONTINUITY^N^^^^1^A/N "DATA",9002313.91,392,1) "DATA",9002313.91,392,5) UG^2 "DATA",9002313.91,392,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,392,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,393,0) 987^^URL^A/N^^^^255^A/N "DATA",9002313.91,393,1) "DATA",9002313.91,393,5) MA^255 "DATA",9002313.91,393,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,393,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,394,0) 571^^AMOUNT ATTRIB TO PROCESSOR FEE^N^^^^8^N "DATA",9002313.91,394,1) "DATA",9002313.91,394,5) NZ^8 "DATA",9002313.91,394,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,394,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,395,0) 575^^PATIENT SALES TAX^N^^^^8^N "DATA",9002313.91,395,1) "DATA",9002313.91,395,5) EQ^8 "DATA",9002313.91,395,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,395,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,396,0) 574^^PLAN SALES TAX AMOUNT^N^^^^8^N "DATA",9002313.91,396,1) "DATA",9002313.91,396,5) 2Y^8 "DATA",9002313.91,396,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,396,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,397,0) 572^^AMOUNT OF COINSURANCE^N^^^^8^N "DATA",9002313.91,397,1) "DATA",9002313.91,397,5) 4U^8 "DATA",9002313.91,397,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,397,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,398,0) 573^^BASIS OF CALC - COINSURANCE^A/N^^^^2^A/N "DATA",9002313.91,398,1) "DATA",9002313.91,398,5) 4V^2 "DATA",9002313.91,398,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,398,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,399,0) 577^^ESTIMATED GENERIC SAVINGS^N^^^^8^N "DATA",9002313.91,399,1) "DATA",9002313.91,399,5) G3^8 "DATA",9002313.91,399,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,399,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,400,0) 128^^SPENDING ACCOUNT AMT REMAINING^N^^^^8^N "DATA",9002313.91,400,1) "DATA",9002313.91,400,5) UC^8 "DATA",9002313.91,400,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,400,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,401,0) 129^^HEALTH PLAN-FUNDED ASSIST AMT^N^^^^8^N "DATA",9002313.91,401,1) "DATA",9002313.91,401,5) UD^8 "DATA",9002313.91,401,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,401,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,402,0) 133^^AMT ATTR TO PROV NETWORK SLCTN^N^^^^8^N "DATA",9002313.91,402,1) "DATA",9002313.91,402,5) UJ^8 "DATA",9002313.91,402,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,402,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,403,0) 134^^AMT ATTR TO PROD SEL BRND DRUG^N^^^^8^N "DATA",9002313.91,403,1) "DATA",9002313.91,403,5) UK^8 "DATA",9002313.91,403,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,403,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,404,0) 135^^AMT ATTR NON-PREF FRMLRY SEL^N^^^^8^N "DATA",9002313.91,404,1) "DATA",9002313.91,404,5) UM^8 "DATA",9002313.91,404,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,404,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,405,0) 136^^AMT ATTR TO N-PREF FRMLRY SEL^N^^^^8^N "DATA",9002313.91,405,1) "DATA",9002313.91,405,5) UN^8 "DATA",9002313.91,405,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,405,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,406,0) 137^^AMOUNT ATTR TO COVERAGE GAP^N^^^^8^N "DATA",9002313.91,406,1) "DATA",9002313.91,406,5) UP^8 "DATA",9002313.91,406,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,406,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,407,0) 148^^INGRED COST CNTRCTD REIMB AMT^N^^^^8^N "DATA",9002313.91,407,1) "DATA",9002313.91,407,5) U8^8 "DATA",9002313.91,407,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,407,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,408,0) 149^^DISP FEE CNTRCTD REIMB AMT^N^^^^8^N "DATA",9002313.91,408,1) "DATA",9002313.91,408,5) U9^8 "DATA",9002313.91,408,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,408,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,409,0) 570^^DUR ADDITIONAL TEXT^A/N^^^^100^A/N "DATA",9002313.91,409,1) "DATA",9002313.91,409,5) NS^100 "DATA",9002313.91,409,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,409,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,410,0) 355^^OTHER PAYER ID COUNT^N^^^^1^N "DATA",9002313.91,410,1) "DATA",9002313.91,410,5) NT^1 "DATA",9002313.91,410,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,410,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,411,0) 142^^OTHER PAYER PERSON CODE^A/N^^^^3^A/N "DATA",9002313.91,411,1) "DATA",9002313.91,411,5) UV^3 "DATA",9002313.91,411,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,411,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,412,0) 127^^OTHER PAYER HELP DESK PH NUM^A/N^^^^18^A/N "DATA",9002313.91,412,1) "DATA",9002313.91,412,5) UB^18 "DATA",9002313.91,412,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,412,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,413,0) 143^^OTHER PAYER PATIENT REL CODE^N^^^^1^N "DATA",9002313.91,413,1) "DATA",9002313.91,413,5) UW^1 "DATA",9002313.91,413,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,413,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,414,0) 144^^OTHER PAYER EFFECTIVE DATE^N^^^^8^N "DATA",9002313.91,414,1) "DATA",9002313.91,414,5) UX^8 "DATA",9002313.91,414,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,414,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,415,0) 145^^OTHER PAYER TERMINATION DATE^N^^^^8^N "DATA",9002313.91,415,1) "DATA",9002313.91,415,5) UY^8 "DATA",9002313.91,415,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,415,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,416,0) 139^^MEDICARE PART D COVERAGE CODE^N^^^^2^N "DATA",9002313.91,416,1) "DATA",9002313.91,416,5) UR^2 "DATA",9002313.91,416,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,416,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,417,0) 138^^CMS LICS LEVEL^A/N^^^^20^A/N "DATA",9002313.91,417,1) "DATA",9002313.91,417,5) UQ^20 "DATA",9002313.91,417,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,417,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,418,0) 240^^CONTRACT NUMBER^A/N^^^^8^A/N "DATA",9002313.91,418,1) "DATA",9002313.91,418,5) U1^8 "DATA",9002313.91,418,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,418,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,419,0) 926^^FORMULARY ID^A/N^^^^10^A/N "DATA",9002313.91,419,1) "DATA",9002313.91,419,5) FF^10 "DATA",9002313.91,419,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,419,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,420,0) 757^^BENEFIT ID^A/N^^^^15^A/N "DATA",9002313.91,420,1) "DATA",9002313.91,420,5) U6^15 "DATA",9002313.91,420,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,420,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,421,0) 140^^NEXT MEDICARE PART D EFF DATE^N^^^^8^N "DATA",9002313.91,421,1) "DATA",9002313.91,421,5) US^8 "DATA",9002313.91,421,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,421,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,422,0) 141^^NEXT MEDICARE PART D TERM DATE^N^^^^8^N "DATA",9002313.91,422,1) "DATA",9002313.91,422,5) UT^8 "DATA",9002313.91,422,10,0) ^9002313.9101^1^1^3101206^ "DATA",9002313.91,422,10,1,0) ; This is a response-only field which does not use the GET, FORMAT, or SET code "DATA",9002313.91,423,0) 123^^PAY TO STATE/PROVINCE ADDRESS^A/N^^^^2^A/N "DATA",9002313.91,423,1) PAY TO STATE/ PROVINCE ADDRESS "DATA",9002313.91,423,5) TX^2 "DATA",9002313.91,423,10,0) ^9002313.9101^1^1^3101101 "DATA",9002313.91,423,10,1,0) S BPS("X")="" "DATA",9002313.91,423,20,0) ^9002313.9102^1^1^3101101 "DATA",9002313.91,423,20,1,0) S BPS("X")=$$ANFF^BPSECFM($G(BPS("X")),2) "DATA",9002313.91,423,30,0) ^9002313.9103^1^1^3100924^ "DATA",9002313.91,423,30,1,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),120),U,3)="" "DATA",9002313.93,1,0) 01^M/I Bin Number "DATA",9002313.93,2,0) 02^M/I Version/Release Number "DATA",9002313.93,3,0) 03^M/I Transaction Code "DATA",9002313.93,4,0) 04^M/I Processor Control Number "DATA",9002313.93,5,0) 05^M/I Service Provider Number "DATA",9002313.93,6,0) 06^M/I Group ID "DATA",9002313.93,7,0) 07^M/I Cardholder ID "DATA",9002313.93,8,0) 08^M/I Person Code "DATA",9002313.93,9,0) 09^M/I Date Of Birth "DATA",9002313.93,10,0) 10^M/I Patient Gender Code "DATA",9002313.93,11,0) 11^M/I Patient Relationship Code "DATA",9002313.93,12,0) 12^M/I Place of Service "DATA",9002313.93,13,0) 13^M/I Other Coverage Code "DATA",9002313.93,14,0) 14^M/I Eligibility Clarification Code "DATA",9002313.93,15,0) 15^M/I Date of Service "DATA",9002313.93,16,0) 16^M/I Prescription/Service Reference Number "DATA",9002313.93,17,0) 17^M/I Fill Number "DATA",9002313.93,18,0) 18^M/I Metric Quantity "DATA",9002313.93,19,0) 19^M/I Days Supply "DATA",9002313.93,20,0) 20^M/I Compound Code "DATA",9002313.93,21,0) 21^M/I Product/Service ID "DATA",9002313.93,22,0) 22^M/I Dispense As Written (DAW)/Product Selection Code "DATA",9002313.93,23,0) 23^M/I Ingredient Cost Submitted "DATA",9002313.93,24,0) 24^M/I SALES TAX "DATA",9002313.93,25,0) 25^M/I Prescriber ID "DATA",9002313.93,26,0) 26^M/I Unit Of Measure "DATA",9002313.93,27,0) 27^(FUTURE USE) "DATA",9002313.93,28,0) 28^M/I Date Prescription Written "DATA",9002313.93,29,0) 29^M/I Number Of Refills Authorized "DATA",9002313.93,30,0) 30^M/I PA/MC Code And Number "DATA",9002313.93,31,0) 31^(FUTURE USE) "DATA",9002313.93,32,0) 32^M/I Level Of Service "DATA",9002313.93,33,0) 33^M/I Prescription Origin Code "DATA",9002313.93,34,0) 34^M/I Submission Clarification Code "DATA",9002313.93,35,0) 35^M/I Primary Care Provider ID "DATA",9002313.93,36,0) 36^M/I Clinic ID "DATA",9002313.93,37,0) 37^(FUTURE USE) "DATA",9002313.93,38,0) 38^M/I Basis Of Cost Determination "DATA",9002313.93,39,0) 39^M/I Diagnosis Code "DATA",9002313.93,40,0) 40^Pharmacy Not Contracted With Plan On Date Of Service "DATA",9002313.93,41,0) 41^Submit Bill To Other Processor Or Primary Payer "DATA",9002313.93,42,0) 42^(FUTURE USE) "DATA",9002313.93,43,0) 43^(FUTURE USE) "DATA",9002313.93,44,0) 44^(FUTURE USE) "DATA",9002313.93,45,0) 45^(FUTURE USE) "DATA",9002313.93,46,0) 46^(FUTURE USE) "DATA",9002313.93,47,0) 47^(FUTURE USE) "DATA",9002313.93,48,0) 48^(FUTURE USE) "DATA",9002313.93,49,0) 49^(FUTURE USE) "DATA",9002313.93,50,0) 50^Non-Matched Pharmacy Number "DATA",9002313.93,51,0) 51^Non-Matched Group ID "DATA",9002313.93,52,0) 52^Non-Matched Cardholder ID "DATA",9002313.93,53,0) 53^Non-Matched Person Code "DATA",9002313.93,54,0) 54^Non-Matched Product/Service ID Number "DATA",9002313.93,55,0) 55^Non-Matched Product Package Size "DATA",9002313.93,56,0) 56^Non-Matched Prescriber ID "DATA",9002313.93,57,0) 57^Non-Matched PA/MC Number "DATA",9002313.93,58,0) 58^Non-Matched Primary Prescriber "DATA",9002313.93,59,0) 59^Non-Matched Clinic ID "DATA",9002313.93,60,0) 60^Product/Service Not Covered For Patient Age "DATA",9002313.93,61,0) 61^Product/Service Not Covered For Patient Gender "DATA",9002313.93,62,0) 62^Patient/Card Holder ID Name Mismatch "DATA",9002313.93,63,0) 63^Institutionalized Patient Product/Service ID Not Covered "DATA",9002313.93,64,0) 64^Claim Submitted Does Not Match Prior Authorization "DATA",9002313.93,65,0) 65^Patient Is Not Covered "DATA",9002313.93,66,0) 66^Patient Age Exceeds Maximum Age "DATA",9002313.93,67,0) 67^Filled Before Coverage Effective "DATA",9002313.93,68,0) 68^Filled After Coverage Expired "DATA",9002313.93,69,0) 69^Filled After Coverage Terminated "DATA",9002313.93,70,0) 70^Product/Service Not Covered - Plan/Benefit Exclusion "DATA",9002313.93,71,0) 71^Prescriber Is Not Covered "DATA",9002313.93,72,0) 72^Primary Prescriber Is Not Covered "DATA",9002313.93,73,0) 73^Refills Are Not Covered "DATA",9002313.93,74,0) 74^Other Carrier Payment Meets Or Exceeds Payable "DATA",9002313.93,75,0) 75^Prior Authorization Required "DATA",9002313.93,76,0) 76^Plan Limitations Exceeded "DATA",9002313.93,77,0) 77^Discontinued Product/Service ID Number "DATA",9002313.93,78,0) 78^Cost Exceeds Maximum "DATA",9002313.93,79,0) 79^Refill Too Soon "DATA",9002313.93,80,0) 80^Drug-Diagnosis Mismatch "DATA",9002313.93,81,0) 81^Claim Too Old "DATA",9002313.93,82,0) 82^Claim Is Post-Dated "DATA",9002313.93,83,0) 83^Duplicate Paid/Captured Claim "DATA",9002313.93,84,0) 84^Claim Has Not Been Paid/Captured "DATA",9002313.93,85,0) 85^Claim Not Processed "DATA",9002313.93,86,0) 86^Submit Manual Reversal "DATA",9002313.93,87,0) 87^Reversal Not Processed "DATA",9002313.93,88,0) 88^DUR Reject Error "DATA",9002313.93,89,0) 89^Rejected Claim Fees Paid "DATA",9002313.93,90,0) 90^Host Hung Up "DATA",9002313.93,91,0) 91^Host Response Error "DATA",9002313.93,92,0) 92^System Unavailable/Host Unavailable "DATA",9002313.93,93,0) 93^Planned Unavailable "DATA",9002313.93,94,0) 94^Invalid Message "DATA",9002313.93,95,0) 95^Time Out "DATA",9002313.93,96,0) 96^Scheduled Downtime "DATA",9002313.93,97,0) 97^Payer Unavailable "DATA",9002313.93,98,0) 98^Connection To Payer Is Down "DATA",9002313.93,99,0) 99^Host Processing Error "DATA",9002313.93,100,0) CA^M/I Patient First Name "DATA",9002313.93,101,0) CB^M/I Patient Last Name "DATA",9002313.93,102,0) CC^M/I Cardholder First Name "DATA",9002313.93,103,0) CD^M/I Cardholder Last Name "DATA",9002313.93,104,0) CE^M/I Home Plan "DATA",9002313.93,105,0) CF^M/I Employer Name "DATA",9002313.93,106,0) CG^M/I Employer Street Address "DATA",9002313.93,107,0) CH^M/I Employer City Address "DATA",9002313.93,108,0) CI^M/I Employer State/Province Address "DATA",9002313.93,109,0) CJ^M/I Employer Zip Postal Zone "DATA",9002313.93,110,0) CK^M/I Employer Phone Number "DATA",9002313.93,111,0) CL^M/I Employer Contact Name "DATA",9002313.93,112,0) CM^M/I Patient Street Address "DATA",9002313.93,113,0) CN^M/I Patient City Address "DATA",9002313.93,114,0) CO^M/I Patient State/Province Address "DATA",9002313.93,115,0) CP^M/I Patient Zip/Postal Zone "DATA",9002313.93,116,0) CQ^M/I Patient Phone Number "DATA",9002313.93,117,0) CR^M/I Carrier ID "DATA",9002313.93,118,0) CT^Patient Social Security Number "DATA",9002313.93,119,0) DP^M/I DRUG TYPE OVERRIDE "DATA",9002313.93,120,0) DR^M/I Prescriber Last Name "DATA",9002313.93,121,0) DQ^M/I Usual And Customary Charge "DATA",9002313.93,122,0) DS^M/I Postage Amount Claimed "DATA",9002313.93,123,0) DT^M/I Special Packaging Indicator "DATA",9002313.93,124,0) DU^M/I Gross Amount Due "DATA",9002313.93,125,0) DV^M/I Other Payer Amount Paid "DATA",9002313.93,126,0) DW^M/I Basis Of Days Supply Determination "DATA",9002313.93,127,0) DX^M/I Patient Paid Amount Submitted "DATA",9002313.93,128,0) DY^M/I Date Of Injury "DATA",9002313.93,129,0) DZ^M/I Claim/Reference ID "DATA",9002313.93,130,0) E1^M/I Product/Service ID Qualifier "DATA",9002313.93,131,0) E2^M/I Route of Administration "DATA",9002313.93,132,0) E3^M/I Incentive Amount Submitted "DATA",9002313.93,133,0) E4^M/I Reason For Service Code "DATA",9002313.93,134,0) E5^M/I Professional Service Code "DATA",9002313.93,135,0) E6^M/I Result Of Service Code "DATA",9002313.93,136,0) E7^M/I Quantity Dispensed "DATA",9002313.93,137,0) E8^M/I Other Payer Date "DATA",9002313.93,138,0) M1^Patient Not Covered In This Aid Category "DATA",9002313.93,139,0) M2^Recipient Locked In "DATA",9002313.93,140,0) M3^Host PA/MC Error "DATA",9002313.93,141,0) M4^Prescription/Service Reference Number/Time Limit Exceeded "DATA",9002313.93,142,0) M5^Requires Manual Claim "DATA",9002313.93,143,0) M6^Host Eligibility Error "DATA",9002313.93,144,0) M7^Host Drug File Error "DATA",9002313.93,145,0) M8^Host Provider File Error "DATA",9002313.93,146,0) MZ^Error Overflow "DATA",9002313.93,147,0) 1C^M/I Smoker/Non-Smoker Code "DATA",9002313.93,148,0) 1E^M/I Prescriber Location Code "DATA",9002313.93,149,0) 2C^M/I Pregnancy Indicator "DATA",9002313.93,150,0) 2E^M/I Primary Care Provider ID Qualifier "DATA",9002313.93,151,0) 3A^M/I Request Type "DATA",9002313.93,152,0) 3B^M/I Request Period Date-Begin "DATA",9002313.93,153,0) 3C^M/I Request Period Date-End "DATA",9002313.93,154,0) 3D^M/I Basis Of Request "DATA",9002313.93,155,0) 3E^M/I Authorized Representative First Name "DATA",9002313.93,156,0) 3F^M/I Authorized Representative Last Name "DATA",9002313.93,157,0) 3G^M/I Authorized Representative Street Address "DATA",9002313.93,158,0) 3H^M/I Authorized Representative City Address "DATA",9002313.93,159,0) 3J^M/I Authorized Representative State/Province Address "DATA",9002313.93,160,0) 3K^M/I Authorized Representative Zip/Postal Zone "DATA",9002313.93,161,0) 3M^M/I Prescriber Phone Number "DATA",9002313.93,162,0) 3N^M/I Prior Authorized Number-Assigned "DATA",9002313.93,163,0) 3P^M/I Authorization Number "DATA",9002313.93,164,0) 3R^Prior Authorization Not Required "DATA",9002313.93,165,0) 3S^M/I Prior Authorization Supporting Documentation "DATA",9002313.93,166,0) 3T^Active Prior Auth Exists Resubmit At Expiration Of Prior Auth "DATA",9002313.93,167,0) 3W^Prior Authorization In Process "DATA",9002313.93,168,0) 3X^Authorization Number Not Found "DATA",9002313.93,169,0) 3Y^Prior Authorization Denied "DATA",9002313.93,170,0) 4C^M/I Coordination Of Benefits/Other Payments Count "DATA",9002313.93,171,0) 4E^M/I Primary Care Provider Last Name "DATA",9002313.93,172,0) 5C^M/I Other Payer Coverage Type "DATA",9002313.93,173,0) 5E^M/I Other Payer Reject Count "DATA",9002313.93,174,0) 6C^M/I Other Payer ID Qualifier "DATA",9002313.93,175,0) 6E^M/I Other Payer Reject Code "DATA",9002313.93,176,0) 7C^M/I Other Payer ID "DATA",9002313.93,177,0) 7E^M/I DUR/PPS Code Counter "DATA",9002313.93,178,0) 8C^M/I Facility ID "DATA",9002313.93,179,0) 8E^M/I DUR/PPS Level Of Effort "DATA",9002313.93,180,0) AA^Patient Spenddown Not Met "DATA",9002313.93,181,0) AB^Date Written Is After Date Filled "DATA",9002313.93,182,0) AC^Product Not Covered Non-Participating Manufacturer "DATA",9002313.93,183,0) AD^Billing Provider Not Eligible To Bill This Claim Type "DATA",9002313.93,184,0) AE^QMB (Qualified Medicare Beneficiary)-Bill Medicare "DATA",9002313.93,185,0) AF^Patient Enrolled Under Managed Care "DATA",9002313.93,186,0) AG^Days Supply Limitation For Product/Service "DATA",9002313.93,187,0) AH^Unit Dose Packaging Only Payable For Nursing Home Recipients "DATA",9002313.93,188,0) AJ^Generic Drug Required "DATA",9002313.93,189,0) AK^M/I Software Vendor/Certification ID "DATA",9002313.93,190,0) AM^M/I Segment Identification "DATA",9002313.93,191,0) A9^M/I Transaction Count "DATA",9002313.93,192,0) BE^M/I Professional Service Fee Submitted "DATA",9002313.93,193,0) B2^M/I Service Provider ID Qualifier "DATA",9002313.93,194,0) CW^M/I Alternate ID "DATA",9002313.93,195,0) CX^M/I Patient ID Qualifier "DATA",9002313.93,196,0) CY^M/I Patient ID "DATA",9002313.93,197,0) CZ^M/I Employer ID "DATA",9002313.93,198,0) DC^M/I Dispensing Fee Submitted "DATA",9002313.93,199,0) DN^M/I Basis Of Cost Determination "DATA",9002313.93,200,0) EA^M/I Originally Prescribed Product/Service Code "DATA",9002313.93,201,0) EB^M/I Originally Prescribed Quantity "DATA",9002313.93,202,0) EC^M/I Compound Ingredient Component Count "DATA",9002313.93,203,0) ED^M/I Compound Ingredient Quantity "DATA",9002313.93,204,0) EE^M/I Compound Ingredient Drug Cost "DATA",9002313.93,205,0) EF^M/I Compound Dosage Form Description Code "DATA",9002313.93,206,0) EG^M/I Compound Dispensing Unit Form Indicator "DATA",9002313.93,207,0) EH^M/I Compound Route of Administration "DATA",9002313.93,208,0) EJ^M/I Originally Prescribed Product/Service ID Qualifier "DATA",9002313.93,209,0) EK^M/I Scheduled Prescription ID Number "DATA",9002313.93,210,0) EM^M/I Prescription/Service Reference Number Qualifier "DATA",9002313.93,211,0) EN^M/I Associated Prescription/Service Reference Number "DATA",9002313.93,212,0) Ep^M/I Associated Prescription/Service Date "DATA",9002313.93,213,0) ER^M/I Procedure Modifier Code "DATA",9002313.93,214,0) ET^M/I Quantity Prescribed "DATA",9002313.93,215,0) EU^M/I Prior Authorization Type Code "DATA",9002313.93,216,0) EV^M/I Prior Authorization Number Submitted "DATA",9002313.93,217,0) EW^M/I Intermediary Authorization Type ID "DATA",9002313.93,218,0) EX^M/I Intermediary Authorization ID "DATA",9002313.93,219,0) EY^M/I Provider ID Qualifier "DATA",9002313.93,220,0) EZ^M/I Prescriber ID Qualifier "DATA",9002313.93,221,0) E9^M/I Provider ID "DATA",9002313.93,222,0) FO^M/I Plan ID "DATA",9002313.93,223,0) GE^M/I Percentage Sales Tax Amount Submitted "DATA",9002313.93,224,0) HA^M/I Flat Sales Tax Amount Submitted "DATA",9002313.93,225,0) HB^M/I Other Payer Amount Paid Count "DATA",9002313.93,226,0) HC^M/I Other Payer Amount Paid Qualifier "DATA",9002313.93,227,0) HD^M/I Dispensing Status "DATA",9002313.93,228,0) HE^M/I Percentage Sales Tax Rate Submitted "DATA",9002313.93,229,0) HF^M/I Quantity Intended To Be Dispensed "DATA",9002313.93,230,0) HG^M/I Days Supply Intended To Be Dispensed "DATA",9002313.93,231,0) H1^M/I Measurement Time "DATA",9002313.93,232,0) H2^M/I Measurement Dimension "DATA",9002313.93,233,0) H3^M/I Measurement Unit "DATA",9002313.93,234,0) H4^M/I Measurement Value "DATA",9002313.93,235,0) H5^M/I Primary Care Provider Location Code "DATA",9002313.93,236,0) H6^M/I DUR Co-Agent ID "DATA",9002313.93,237,0) H7^M/I Other Amount Claimed Submitted Count "DATA",9002313.93,238,0) H8^M/I Other Amount Claimed Submitted Qualifier "DATA",9002313.93,239,0) H9^M/I Other Amount Claimed Submitted "DATA",9002313.93,240,0) JE^M/I Percentage Sales Tax Basis Submitted "DATA",9002313.93,241,0) J9^M/I DUR Co-Agent ID Qualifier "DATA",9002313.93,242,0) KE^M/I Coupon Type "DATA",9002313.93,243,0) ME^M/I Coupon Number "DATA",9002313.93,244,0) NE^M/I Coupon Value Amount "DATA",9002313.93,245,0) NN^Transaction Rejected At Switch Or Intermediary "DATA",9002313.93,246,0) PA^PA Exhausted/Not Renewable "DATA",9002313.93,247,0) PB^Invalid Transaction Count For This Transaction Code "DATA",9002313.93,248,0) PC^M/I Request Claim Segment "DATA",9002313.93,249,0) PD^M/I Request Clinical Segment "DATA",9002313.93,250,0) PE^M/I Request Coordination Of Benefits/Other Payments Segment "DATA",9002313.93,251,0) PF^M/I Request Compound Segment "DATA",9002313.93,252,0) PG^M/I Request Coupon Segment "DATA",9002313.93,253,0) PH^M/I Request DUR/PPS Segment "DATA",9002313.93,254,0) PJ^M/I Request Insurance Segment "DATA",9002313.93,255,0) PK^M/I Request Patient Segment "DATA",9002313.93,256,0) PM^M/I Request Pharmacy Provider Segment "DATA",9002313.93,257,0) PN^M/I Request Prescriber Segment "DATA",9002313.93,258,0) PP^M/I Request Pricing Segment "DATA",9002313.93,259,0) PR^M/I Request Prior Authorization Segment "DATA",9002313.93,260,0) PS^M/I Transaction Header Segment "DATA",9002313.93,261,0) PT^M/I Request Worker's Compensation Segment "DATA",9002313.93,262,0) PV^Non-Matched Associated Prescription/Service Date "DATA",9002313.93,263,0) PW^Non-Matched Employer ID "DATA",9002313.93,264,0) PX^Non-Matched Other Payer ID "DATA",9002313.93,265,0) PY^Non-Matched Unit Form/Route of Administration "DATA",9002313.93,266,0) PZ^Non-Matched Unit Of Measure To Product/Service ID "DATA",9002313.93,267,0) P1^Associated Prescription/Service Reference Number Not Found "DATA",9002313.93,268,0) P2^Clinical Information Counter Out Of Sequence "DATA",9002313.93,269,0) P3^Compound Ingredient Component Count Doesn't Match # Of Repetitions "DATA",9002313.93,270,0) P4^COB/Other Payments Count Does Not Match Number Of Repetitions "DATA",9002313.93,271,0) P5^Coupon Expired "DATA",9002313.93,272,0) P6^Date Of Service Prior To Date Of Birth "DATA",9002313.93,273,0) P7^Diagnosis Code Count Does Not Match Number Of Repetitions "DATA",9002313.93,274,0) P8^DUR/PPS Code Counter Out Of Sequence "DATA",9002313.93,275,0) P9^Field Is Non-Repeatable "DATA",9002313.93,276,0) RA^PA Reversal Out Of Order "DATA",9002313.93,277,0) RB^Multiple Partials Not Allowed "DATA",9002313.93,278,0) RC^Different Drug Entity Between Partial & Completion "DATA",9002313.93,279,0) RD^Mismatched Cardholder/Group ID-Partial To Completion "DATA",9002313.93,280,0) RE^M/I Compound Product ID Qualifier "DATA",9002313.93,281,0) RF^Improper Order Of 'Dispensing Status' Code On Partial Fill Transaction "DATA",9002313.93,282,0) RG^M/I Associated Rx/Service Reference # On Completion Transaction "DATA",9002313.93,283,0) RH^M/I Associated Prescription/Service Date On Completion Transaction "DATA",9002313.93,284,0) RJ^Associated Partial Fill Transaction Not On File "DATA",9002313.93,285,0) RK^Partial Fill Transaction Not Supported "DATA",9002313.93,286,0) RM^Compl Trans Not Permitted With Same 'Date Of Service' As Partial Trans "DATA",9002313.93,287,0) RN^Plan Limits Exceeded On Intended Partial Fill Field Limitations "DATA",9002313.93,288,0) RP^Out Of Sequence 'P' Reversal On Partial Fill Transaction "DATA",9002313.93,289,0) RS^M/I Associated Prescription/Service Date On Partial Transaction "DATA",9002313.93,290,0) RT^M/I Associated Prescription/Service Reference Number On Partial Trans "DATA",9002313.93,291,0) RU^Mandatory Elements Must Occur Befr Optional Data Elements In Segment "DATA",9002313.93,292,0) R1^Other Amount Claimed Submitted Count Does Not Match # of Repetitions "DATA",9002313.93,293,0) R2^Other Payer Reject Count Does Not Match Number Of Repetitions "DATA",9002313.93,294,0) R3^Procedure Modifier Code Count Does Not Match Number Of Repetitions "DATA",9002313.93,295,0) R4^Procedure Modifier Code Invalid For Product/Service ID "DATA",9002313.93,296,0) R5^Product/Service ID Must Be Zero When Product/Service ID Qual Equals 06 "DATA",9002313.93,297,0) R6^Product/Service Not Appropriate For This Location "DATA",9002313.93,298,0) R7^Repeating Segment Not Allowed In Same Transaction "DATA",9002313.93,299,0) R8^Syntax Error "DATA",9002313.93,300,0) R9^Value In Gross Amount Due Does Not Follow Pricing Formulae "DATA",9002313.93,301,0) SE^M/I Procedure Modifier Code Count "DATA",9002313.93,302,0) TE^Missing/Invalid Compound Product ID "DATA",9002313.93,303,0) UE^M/I Compound Ingredient Basis Of Cost Determination "DATA",9002313.93,304,0) VE^M/I Diagnosis Code Count "DATA",9002313.93,305,0) WE^M/I Diagnosis Code Qualifier "DATA",9002313.93,306,0) XE^M/I Clinical Information Counter "DATA",9002313.93,307,0) ZE^M/I Measurement Date "DATA",9002313.93,308,0) *95^The Clearinghous did not respond in time "DATA",9002313.93,309,0) *96^Scheduled Downtime "DATA",9002313.93,310,0) *97^Payor Unavailable "DATA",9002313.93,311,0) *98^Connection To Payer Is Down "DATA",9002313.93,312,0) *95^The Clearinghouse Did Not Respond In Time. "DATA",9002313.93,313,0) *97^Payer Unavailable "DATA",9002313.93,314,0) 1R^Version/Release Not Supported "DATA",9002313.93,315,0) 1S^Transaction Code/Type Not Supported "DATA",9002313.93,316,0) 1T^PCN Must Contain Processor/Payer Assigned Value "DATA",9002313.93,317,0) 1U^Transaction Count Does Not Match Number of Transactions "DATA",9002313.93,318,0) 1V^Multiple Transactions Not Supported "DATA",9002313.93,319,0) 1W^Multi-Ingredient Compound Must Be A Single Transaction "DATA",9002313.93,320,0) 1X^Vendor Not Certified For Processor/Payer "DATA",9002313.93,321,0) 1Y^Claim Segment Required For Adjudication "DATA",9002313.93,322,0) 1Z^Clinical Segment Required For Adjudication "DATA",9002313.93,323,0) 2A^M/I Medigap ID "DATA",9002313.93,324,0) 2B^M/I Medicaid Indicator "DATA",9002313.93,325,0) 2D^M/I Provider Accept Assignment Indicator "DATA",9002313.93,326,0) 2G^M/I Compound Ingredient Modifier Code Count "DATA",9002313.93,327,0) 2H^M/I Compound Ingredient Modifier Code "DATA",9002313.93,328,0) 2J^M/I Prescriber First Name "DATA",9002313.93,329,0) 2K^M/I Prescriber Street Address "DATA",9002313.93,330,0) 2M^M/I Prescriber City Address "DATA",9002313.93,331,0) 2N^M/I Prescriber State/Province Address "DATA",9002313.93,332,0) 2P^M/I Prescriber Zip/Postal Zone "DATA",9002313.93,333,0) 2Q^M/I Additional Documentation Type ID "DATA",9002313.93,334,0) 2R^M/I Length of Need "DATA",9002313.93,335,0) 2S^M/I Length of Need Qualifier "DATA",9002313.93,336,0) 2T^M/I Prescriber/Supplier Date Signed "DATA",9002313.93,337,0) 2U^M/I Request Status "DATA",9002313.93,338,0) 2V^M/I Request Period Begin Date "DATA",9002313.93,339,0) 2W^M/I Request Period Recert/Revised Date "DATA",9002313.93,340,0) 2X^M/I Supporting Documentation "DATA",9002313.93,341,0) 2Z^M/I Question Number/Letter Count "DATA",9002313.93,342,0) 3Q^M/I Facility Name "DATA",9002313.93,343,0) 3U^M/I Facility Street Address "DATA",9002313.93,344,0) 3V^M/I Facility State/Province Address "DATA",9002313.93,345,0) 4B^M/I Question Number/Letter "DATA",9002313.93,346,0) 4D^M/I Question Percent Response "DATA",9002313.93,347,0) 4G^M/I Question Date Response "DATA",9002313.93,348,0) 4H^M/I Question Dollar Amount Response "DATA",9002313.93,349,0) 4J^M/I Question Numeric Response "DATA",9002313.93,350,0) 4K^M/I Question Alphanumeric Response "DATA",9002313.93,351,0) 4M^Compound Ingredient Modifier Code Count Doesn't Match # of Repetitions "DATA",9002313.93,352,0) 4N^Question Number/Letter Count Does Not Match Number of Repetitions "DATA",9002313.93,353,0) 4P^Question Number/Letter Not Valid for Identified Document "DATA",9002313.93,354,0) 4Q^Question Response Not Appropriate for Question Number/Letter "DATA",9002313.93,355,0) 4R^Required Question Num/Letter Response for Indicated Document Missing "DATA",9002313.93,356,0) 4S^Compound Product ID Requires a Modifier Code "DATA",9002313.93,357,0) 4T^M/I Additional Documentation Segment "DATA",9002313.93,358,0) 4W^Must Fill Through Specialty Pharmacy "DATA",9002313.93,359,0) 4X^M/I Patient Residence "DATA",9002313.93,360,0) 4Y^Patient Residence not supported by plan "DATA",9002313.93,361,0) 4Z^Place of Service Not Support By Plan "DATA",9002313.93,362,0) 5J^M/I Facility City Address "DATA",9002313.93,363,0) 6D^M/I Facility Zip/Postal Zone "DATA",9002313.93,364,0) 6G^COB/Other Payments Segment Required For Adjudication "DATA",9002313.93,365,0) 6H^Coupon Segment Required For Adjudication "DATA",9002313.93,366,0) 6J^Insurance Segment Required For Adjudication "DATA",9002313.93,367,0) 6K^Patient Segment Required For Adjudication "DATA",9002313.93,368,0) 6M^Pharmacy Provider Segment Required For Adjudication "DATA",9002313.93,369,0) 6N^Prescriber Segment Required For Adjudication "DATA",9002313.93,370,0) 6P^Pricing Segment Required For Adjudication "DATA",9002313.93,371,0) 6Q^Prior Authorization Segment Required For Adjudication "DATA",9002313.93,372,0) 6R^Worker's Compensation Segment Required For Adjudication "DATA",9002313.93,373,0) 6S^Transaction Segment Required For Adjudication "DATA",9002313.93,374,0) 6T^Compound Segment Required For Adjudication "DATA",9002313.93,375,0) 6U^Compound Segment Incorrectly Formatted "DATA",9002313.93,376,0) 6V^Multi-ingredient Compounds Not Supported "DATA",9002313.93,377,0) 6W^DUR/PPS Segment Required For Adjudication "DATA",9002313.93,378,0) 6X^DUR/PPS Segment Incorrectly Formatted "DATA",9002313.93,379,0) 6Y^Not Authorized To Submit Electronically "DATA",9002313.93,380,0) 6Z^Provider Not Eligible To Perform Service/Dispense Product "DATA",9002313.93,381,0) 7A^Provider Does Not Match Authorization On File "DATA",9002313.93,382,0) 7B^Service Provider ID Qualifier Value Not Supported For Processor/Payer "DATA",9002313.93,383,0) 7D^Non-Matched DOB "DATA",9002313.93,384,0) 7G^Future Date Not Allowed For DOB "DATA",9002313.93,385,0) 7H^Non-Matched Gender Code "DATA",9002313.93,386,0) 7J^Patient Relationship Code Not Supported "DATA",9002313.93,387,0) 7K^Discrepancy Between Other Coverage Code And Other Payer Amt "DATA",9002313.93,388,0) 7M^Discrepancy Between Other Coverage Code & Other Coverage Info On File "DATA",9002313.93,389,0) 7N^Patient ID Qualifier Submitted Not Supported "DATA",9002313.93,390,0) 7P^COB/Other Payments Count Exceeds Number of Supported Payers "DATA",9002313.93,391,0) 7Q^Other Payer ID Qualifier Not Supported "DATA",9002313.93,392,0) 7R^Other Payer Amount Paid Count Exceeds Number of Supported Groupings "DATA",9002313.93,393,0) 7S^Other Payer Amount Paid Qualifier Not Supported "DATA",9002313.93,394,0) 7T^Quantity Intended To Be Dispensed Required For Partial Fill Trans "DATA",9002313.93,395,0) 7U^Days Supply Intended To Be Dispensed Required For Partial Fill Trans "DATA",9002313.93,396,0) 7V^Duplicate Refills "DATA",9002313.93,397,0) 7W^Refills Exceed allowable Refills "DATA",9002313.93,398,0) 7X^Days Supply Exceeds Plan Limitation "DATA",9002313.93,399,0) 7Y^Compounds Not Covered "DATA",9002313.93,400,0) 7Z^Compound Requires Two Or More Ingredients "DATA",9002313.93,401,0) 8A^Compound Requires At Least One Covered Ingredient "DATA",9002313.93,402,0) 8B^Compound Segment Missing On A Compound Claim "DATA",9002313.93,403,0) 8D^Compound Segment Present On A Non-Compound Claim "DATA",9002313.93,404,0) 8G^Product/Service ID (407-D7) Must Be A Single Zero '0' For Compounds "DATA",9002313.93,405,0) 8H^Product/Service Only Covered On Compound Claim "DATA",9002313.93,406,0) 8J^Incorrect Product/Service ID For Processor/Payer "DATA",9002313.93,407,0) 8K^DAW Code Not Supported "DATA",9002313.93,408,0) 8M^Sum Of Compound Ingredient Costs Does Not Equal Ingredient Cost "DATA",9002313.93,409,0) 8N^Future Date Prescription Written Not Allowed "DATA",9002313.93,410,0) 8P^Date Written Different On Previous Filling "DATA",9002313.93,411,0) 8Q^Excessive Refills Authorized "DATA",9002313.93,412,0) 8R^Submission Clarification Code Not Supported "DATA",9002313.93,413,0) 8S^Basis Of Cost Not Supported "DATA",9002313.93,414,0) 8T^U&C Must Be Greater Than Zero "DATA",9002313.93,415,0) 8U^GAD Must Be Greater Than Zero "DATA",9002313.93,416,0) 8V^Negative Dollar Amount Is Not Supported In Other Payer Amount Paid "DATA",9002313.93,417,0) 8W^Discrepancy Between Other Coverage Code and Other Payer Amount Paid "DATA",9002313.93,418,0) 8X^Collection From Cardholder Not Allowed "DATA",9002313.93,419,0) 8Y^Excessive Amount Collected "DATA",9002313.93,420,0) 8Z^Product/Service ID Qualifier Value Not Supported "DATA",9002313.93,421,0) 9B^Reason For Service Code Value Not Supported "DATA",9002313.93,422,0) 9C^Professional Service Code Value Not Supported "DATA",9002313.93,423,0) 9D^Result Of Service Code Value Not Supported "DATA",9002313.93,424,0) 9E^Quantity Does Not Match Dispensing Unit "DATA",9002313.93,425,0) 9G^Quantity Dispensed Exceeds Maximum Allowed "DATA",9002313.93,426,0) 9H^Quantity Not Valid For Product/Service ID Submitted "DATA",9002313.93,427,0) 9J^Future Other Payer Date Not Allowed "DATA",9002313.93,428,0) 9K^Compound Ingredient Component Cnt Exceeds Num Of Ingredients Supported "DATA",9002313.93,429,0) 9M^Minimum Of Two Ingredients Required "DATA",9002313.93,430,0) 9N^Compound Ingredient Quantity Exceeds Maximum Allowed "DATA",9002313.93,431,0) 9P^Compound Ingredient Drug Cost Must Be Greater Than Zero "DATA",9002313.93,432,0) 9Q^Route Of Administration Submitted Not Covered "DATA",9002313.93,433,0) 9R^Prescription/Service Reference Number Qualifier Submitted Not Covered "DATA",9002313.93,434,0) 9S^Future Associated Prescription/Service Date Not Allowed "DATA",9002313.93,435,0) 9T^Prior Authorization Type Code Submitted Not Covered "DATA",9002313.93,436,0) 9U^Provider ID Qualifier Submitted Not Covered "DATA",9002313.93,437,0) 9V^Prescriber ID Qualifier Submitted Not Covered "DATA",9002313.93,438,0) 9W^DUR/PPS Code Counter Exceeds Number Of Occurrences Supported "DATA",9002313.93,439,0) 9X^Coupon Type Submitted Not Covered "DATA",9002313.93,440,0) 9Y^Compound Product ID Qualifier Submitted Not Covered "DATA",9002313.93,441,0) 9Z^Duplicate Product ID In Compound "DATA",9002313.93,442,0) AQ^M/I Facility Segment "DATA",9002313.93,443,0) A5^Not Covered Under Part D Law "DATA",9002313.93,444,0) A6^This Medication May Be Covered Under Part B "DATA",9002313.93,445,0) A7^M/I Internal Control Number "DATA",9002313.93,446,0) BA^Compound Basis of Cost Determination Submitted Not Covered "DATA",9002313.93,447,0) BB^Diagnosis Code Qualifier Submitted Not Covered "DATA",9002313.93,448,0) BC^Future Measurement Date Not Allowed "DATA",9002313.93,449,0) BD^Sender Not Authorized To Submit File Type "DATA",9002313.93,450,0) BF^M/I File Type "DATA",9002313.93,451,0) BG^Sender ID Not Certified For Processor/Payer "DATA",9002313.93,452,0) BH^M/I Sender ID "DATA",9002313.93,453,0) BJ^Transmission Type Submitted Not Supported "DATA",9002313.93,454,0) BK^M/I Transmission Type "DATA",9002313.93,455,0) BM^M/I Narrative Message "DATA",9002313.93,456,0) EP^M/I Associated Prescription/Service Date "DATA",9002313.93,457,0) G1^M/I Compound Type "DATA",9002313.93,458,0) G2^M/I CMS Part D Defined Qualified Facility "DATA",9002313.93,459,0) G4^Physician must contact plan "DATA",9002313.93,460,0) G5^Pharmacist must contact plan "DATA",9002313.93,461,0) G6^Pharmacy Not Contracted in Specialty Network "DATA",9002313.93,462,0) G7^Pharmacy Not Contracted in Home Infusion Network "DATA",9002313.93,463,0) G8^Pharmacy Not Contracted in Long Term Care Network "DATA",9002313.93,464,0) G9^Pharmacy Not Contracted in 90 Day Retail Network "DATA",9002313.93,465,0) HN^M/I Patient E-Mail Address "DATA",9002313.93,466,0) K5^M/I Transaction Reference Number "DATA",9002313.93,467,0) MG^M/I Other Payer BIN Number "DATA",9002313.93,468,0) MH^M/I Other Payer Processor Control Number "DATA",9002313.93,469,0) MJ^M/I Other Payer Group ID "DATA",9002313.93,470,0) MK^Non-Matched Other Payer BIN Number "DATA",9002313.93,471,0) MM^Non-Matched Other Payer Processor Control Number "DATA",9002313.93,472,0) MN^Non-Matched Other Payer Group ID "DATA",9002313.93,473,0) MP^Non-Matched Other Payer Cardholder ID "DATA",9002313.93,474,0) MR^Product Not On Formulary "DATA",9002313.93,475,0) MS^More than 1 Cardholder Found - Narrow Search Criteria "DATA",9002313.93,476,0) MT^M/I Patient Assignment Indicator "DATA",9002313.93,477,0) MU^M/I Benefit Stage Count "DATA",9002313.93,478,0) MV^M/I Benefit Stage Qualifier "DATA",9002313.93,479,0) MW^M/I Benefit Stage Amount "DATA",9002313.93,480,0) MX^Benefit Stage Count Does Not Match Number Of Repetitions "DATA",9002313.93,481,0) NP^M/I Other Payer-Patient Responsibility Amount Qualifier "DATA",9002313.93,482,0) NQ^M/I Other Payer-Patient Responsibility Amount "DATA",9002313.93,483,0) NR^M/I Other Payer-Patient Responsibility Amount Count "DATA",9002313.93,484,0) NU^M/I Other Payer Cardholder ID "DATA",9002313.93,485,0) NV^M/I Delay Reason Code "DATA",9002313.93,486,0) NX^M/I Submission Clarification Code Count "DATA",9002313.93,487,0) N1^No patient match found "DATA",9002313.93,488,0) N3^M/I Medicaid Paid Amount "DATA",9002313.93,489,0) N4^M/I Medicaid Subrogation Internal Ctrl Number/Transaction Ctrl Number "DATA",9002313.93,490,0) N5^M/I Medicaid ID Number "DATA",9002313.93,491,0) N6^M/I Medicaid Agency Number "DATA",9002313.93,492,0) N7^Use Prior Authorization Code Provided During Transition Period "DATA",9002313.93,493,0) N8^Use Prior Authorization Code Provided For Emergency Fill "DATA",9002313.93,494,0) N9^Use Prior Authorization Code Provided For Level of Care Change "DATA",9002313.93,495,0) PQ^M/I Narrative Segment "DATA",9002313.93,496,0) RL^Transitional Benefit/Resubmit Claim "DATA",9002313.93,497,0) RV^Multiple Reversals Per Transmission Not Supported "DATA",9002313.93,498,0) SF^Other Payer Amount Paid Count Does Not Match Number Of Repetitions "DATA",9002313.93,499,0) SG^Submission Clarification Code Count Doesn't Match # of Repetitions "DATA",9002313.93,500,0) SH^Other Payer-Patient Resp Amount Count Doesn't Match # of Repetitions "DATA",9002313.93,501,0) TN^Emergency Fill/Resubmit Claim "DATA",9002313.93,502,0) TP^Level of Care Change/Resubmit Claim "DATA",9002313.93,503,0) TQ^Dosage Exceeds Product Labeling Limit "DATA",9002313.93,504,0) TR^M/I Billing Entity Type Indicator "DATA",9002313.93,505,0) TS^M/I Pay To Qualifier "DATA",9002313.93,506,0) TT^M/I Pay To ID "DATA",9002313.93,507,0) TU^M/I Pay To Name "DATA",9002313.93,508,0) TV^M/I Pay To Street Address "DATA",9002313.93,509,0) TW^M/I Pay To City Address "DATA",9002313.93,510,0) TX^M/I Pay to State/Province Address "DATA",9002313.93,511,0) TY^M/I Pay To Zip/Postal Zone "DATA",9002313.93,512,0) TZ^M/I Generic Equivalent Product ID Qualifier "DATA",9002313.93,513,0) UA^M/I Generic Equivalent Product ID "DATA",9002313.93,514,0) UU^DAW 0 cannot be submitted on a multi-source drug w/available generics "DATA",9002313.93,515,0) UZ^Other Payer Coverage Type required on reversals to downstream payers "DATA",9002313.93,516,0) U7^M/I Pharmacy Service Type "DATA",9002313.93,517,0) VA^Pay To Qualifier Submitted Not Supported "DATA",9002313.93,518,0) VB^Generic Equivalent Product ID Qualifier Submitted Not Supported "DATA",9002313.93,519,0) VC^Pharmacy Service Type Submitted Not Supported "DATA",9002313.93,520,0) VD^Eligibility Search Time Frame Exceeded "DATA",9002313.93,521,0) ZA^The COB/Other Payments Segment is mandatory to a downstream payer "DATA",9002313.93,522,0) MY^M/I Address Count "DATA",9002313.93,523,0) NA^M/I Address Qualifier "DATA",9002313.93,524,0) NB^M/I Client Name "DATA",9002313.93,525,0) NC^M/I Discontinue Date Qualifier "DATA",9002313.93,526,0) ND^M/I Discontinue Date "DATA",9002313.93,527,0) NF^M/I Easy Open Cap Indicator "DATA",9002313.93,528,0) NG^M/I Effective Date "DATA",9002313.93,529,0) NH^M/I Expiration Date "DATA",9002313.93,530,0) NJ^M/I File Structure Type "DATA",9002313.93,531,0) NK^M/I Inactive Prescription Indicator "DATA",9002313.93,532,0) NM^M/I Label Directions "DATA",9002313.93,533,0) NW^M/I Most Recent Date Filled "DATA",9002313.93,534,0) NY^M/I Number Of Fills To-Date "DATA",9002313.93,535,0) PU^M/I Number Of Fills Remaining "DATA",9002313.93,536,0) P0^Non-zero Value Required for Vaccine Administration "DATA",9002313.93,537,0) RQ^M/I Original Dispensed Date "DATA",9002313.93,538,0) RR^M/I Patient ID Qualifier Count "DATA",9002313.93,539,0) RW^M/I Prescribed Drug Description "DATA",9002313.93,540,0) RX^M/I Prescriber ID Count "DATA",9002313.93,541,0) RY^M/I Prescriber Specialty "DATA",9002313.93,542,0) RZ^M/I Prescriber Specialty Count "DATA",9002313.93,543,0) R0^Professional Service Code Required For Vaccine Incentive Fee "DATA",9002313.93,544,0) S0^Accumulator Month Count Does Not Match Number of Repetitions "DATA",9002313.93,545,0) S1^M/I Accumulator Year "DATA",9002313.93,546,0) S2^M/I Transaction Identifier "DATA",9002313.93,547,0) S3^M/I Accumulated Patient True Out Of Pocket Amount "DATA",9002313.93,548,0) S4^M/I Accumulated Gross Covered Drug Cost Amount "DATA",9002313.93,549,0) S5^M/I DateTime "DATA",9002313.93,550,0) S6^M/I Accumulator Month "DATA",9002313.93,551,0) S7^M/I Accumulator Month Count "DATA",9002313.93,552,0) S8^Non-Matched Transaction Identifier "DATA",9002313.93,553,0) S9^M/I Financial Information Reporting Transaction Header Segment "DATA",9002313.93,554,0) SA^M/I Quantity Dispensed To Date "DATA",9002313.93,555,0) SB^M/I Record Delimiter "DATA",9002313.93,556,0) SC^M/I Remaining Quantity "DATA",9002313.93,557,0) SD^M/I Sender Name "DATA",9002313.93,558,0) SJ^M/I Total Number Of Sending And Receiving Pharmacy Records "DATA",9002313.93,559,0) SK^M/I Transfer Flag "DATA",9002313.93,560,0) SM^M/I Transfer Type "DATA",9002313.93,561,0) SN^M/I Package Acquisition Cost "DATA",9002313.93,562,0) SP^M/I Unique Record Identifier "DATA",9002313.93,563,0) SQ^M/I Unique Record Identifier Qualifier "DATA",9002313.93,564,0) SW^Accum Patient True Out of Pocket must be equal to or greater than zero "DATA",9002313.93,565,0) TD^M/I Pharmacist Initials "DATA",9002313.93,566,0) TG^Address Count Does Not Match Number Of Repetitions "DATA",9002313.93,567,0) TH^Patient ID Qualifier Count Does Not Match Number Of Repetitions "DATA",9002313.93,568,0) TJ^Prescriber ID Count Does Not Match Number Of Repetitions "DATA",9002313.93,569,0) TK^Prescriber Specialty Count Does Not Match Number Of Repetitions "DATA",9002313.93,570,0) TM^Telephone Number Count Does Not Match Number Of Repetitions "DATA",9002313.93,571,0) T0^Accumulator Month Count Exceeds Number of Occurrences Supported "DATA",9002313.93,572,0) T1^Request Financial Segment Required For Financial Information Reporting "DATA",9002313.93,573,0) T2^M/I Request Reference Segment "DATA",9002313.93,574,0) T3^Out of Order DateTime "DATA",9002313.93,575,0) T4^Duplicate DateTime "DATA",9002313.93,576,0) U0^M/I Sending Pharmacy ID "DATA",9002313.93,577,0) V0^M/I Telephone Number Count "DATA",9002313.93,578,0) W0^M/I Telephone Number Qualifier "DATA",9002313.93,579,0) W5^M/I Bed "DATA",9002313.93,580,0) W6^M/I Facility Unit "DATA",9002313.93,581,0) W7^M/I Hours of Administration "DATA",9002313.93,582,0) W8^M/I Room "DATA",9002313.93,583,0) W9^Accum Gross Cov Drug Cost Amt Must Be Equal To Or Greater Than Zero "DATA",9002313.93,584,0) X1^Accumulated Patient True Out of Pocket exceeds maximum "DATA",9002313.93,585,0) X2^Accumulated Gross Covered Drug Cost exceeds maximum "DATA",9002313.93,586,0) X3^Out of order Accumulator Months "DATA",9002313.93,587,0) X4^Accumulator Year not current or prior year "DATA",9002313.93,588,0) X5^M/I Financial Information Reporting Request Insurance Segment "DATA",9002313.93,589,0) X6^M/I Request Financial Segment "DATA",9002313.93,590,0) X7^Financial Info Reporting Req Ins Seg Required For Financial Reporting "DATA",9002313.93,591,0) X8^Procedure Modifier Code Count Exceeds Number Of Occurrences Supported "DATA",9002313.93,592,0) X9^Diagnosis Code Count Exceeds Number Of Occurrences Supported "DATA",9002313.93,593,0) YA^Compound Ingredient Mod Code Cnt Exceeds Num Of Occurrences Supported "DATA",9002313.93,594,0) YB^Other Amt Claimed Submitted Count Exceeds Num Of Occurrences Supported "DATA",9002313.93,595,0) YC^Other Payer Reject Count Exceeds Number Of Occurrences Supported "DATA",9002313.93,596,0) YD^Other Payer-Patient Resp Amt Cnt Exceeds Num Of Occurrences Supported "DATA",9002313.93,597,0) YE^Submission Clarification Code Cnt Exceeds Num of Occurrences Supported "DATA",9002313.93,598,0) YF^Question Number/Letter Count Exceeds Number Of Occurrences Supported "DATA",9002313.93,599,0) YG^Benefit Stage Count Exceeds Number Of Occurrences Supported "DATA",9002313.93,600,0) YH^Clinical Information Counter Exceeds Number of Occurrences Supported "DATA",9002313.93,601,0) YJ^Non-Matched Medicaid Agency Number "DATA",9002313.93,602,0) eT^TRICARE-DRUG NON BILLABLE "DATA",9002313.93,603,0) 201^Patient Segment is not used for this Transaction Code "DATA",9002313.93,604,0) 202^Insurance Segment is not used for this Transaction Code "DATA",9002313.93,605,0) 203^Claim Segment is not used for this Transaction Code "DATA",9002313.93,606,0) 204^Pharmacy Provider Segment is not used for this Transaction Code "DATA",9002313.93,607,0) 205^Prescriber Segment is not used for this Transaction Code "DATA",9002313.93,608,0) 206^COB/Other Payments Segment is not used for this Transaction Code "DATA",9002313.93,609,0) 207^Workers' Compensation Segment is not used for this Transaction Code "DATA",9002313.93,610,0) 208^DUR/PPS Segment is not used for this Transaction Code "DATA",9002313.93,611,0) 209^Pricing Segment is not used for this Transaction Code "DATA",9002313.93,612,0) 210^Coupon Segment is not used for this Transaction Code "DATA",9002313.93,613,0) 211^Compound Segment is not used for this Transaction Code "DATA",9002313.93,614,0) 212^Prior Authorization Segment is not used for this Transaction Code "DATA",9002313.93,615,0) 213^Clinical Segment is not used for this Transaction Code "DATA",9002313.93,616,0) 214^Additional Documentation Segment is not used for this Transaction Code "DATA",9002313.93,617,0) 215^Facility Segment is not used for this Transaction Code "DATA",9002313.93,618,0) 216^Narrative Segment is not used for this Transaction Code "DATA",9002313.93,619,0) 217^Purchaser Segment is not used for this Transaction Code "DATA",9002313.93,620,0) 218^Service Provider Segment is not used for this Transaction Code "DATA",9002313.93,621,0) 219^Patient ID Qualifier is not used for this Transaction Code "DATA",9002313.93,622,0) 220^Patient ID is not used for this Transaction Code "DATA",9002313.93,623,0) 221^Date of Birth is not used for this Transaction Code "DATA",9002313.93,624,0) 222^Patient Gender Code is not used for this Transaction Code "DATA",9002313.93,625,0) 223^Patient First Name is not used for this Transaction Code "DATA",9002313.93,626,0) 224^Patient Last Name is not used for this Transaction Code "DATA",9002313.93,627,0) 225^Patient Street Address is not used for this Transaction Code "DATA",9002313.93,628,0) 226^Patient City Address is not used for this Transaction Code "DATA",9002313.93,629,0) 227^Patient State/Province Address is not used for this Transaction Code "DATA",9002313.93,630,0) 228^Patient ZIP/Postal Zone is not used for this Transaction Code "DATA",9002313.93,631,0) 229^Patient Phone Number is not used for this Transaction Code "DATA",9002313.93,632,0) 230^Place of Service is not used for this Transaction Code "DATA",9002313.93,633,0) 231^Employer ID is not used for this Transaction Code "DATA",9002313.93,634,0) 232^Smoker/Non-Smoker Code is not used for this Transaction Code "DATA",9002313.93,635,0) 233^Pregnancy Indicator is not used for this Transaction Code "DATA",9002313.93,636,0) 234^Patient E-Mail Address is not used for this Transaction Code "DATA",9002313.93,637,0) 235^Patient Residence is not used for this Transaction Code "DATA",9002313.93,638,0) 236^Patient ID Assoc State/Province Address not used for this Trans Code "DATA",9002313.93,639,0) 237^Cardholder First Name is not used for this Transaction Code "DATA",9002313.93,640,0) 238^Cardholder Last Name is not used for this Transaction Code "DATA",9002313.93,641,0) 239^Home Plan is not used for this Transaction Code "DATA",9002313.93,642,0) 240^Plan ID is not used for this Transaction Code "DATA",9002313.93,643,0) 241^Eligibility Clarification Code is not used for this Transaction Code "DATA",9002313.93,644,0) 242^Group ID is not used for this Transaction Code "DATA",9002313.93,645,0) 243^Person Code is not used for this Transaction Code "DATA",9002313.93,646,0) 244^Patient Relationship Code is not used for this Transaction Code "DATA",9002313.93,647,0) 245^Other Payer BIN Number is not used for this Transaction Code "DATA",9002313.93,648,0) 246^Other Payer Processor Control Number is not used for this Trans Code "DATA",9002313.93,649,0) 247^Other Payer Cardholder ID is not used for this Transaction Code "DATA",9002313.93,650,0) 248^Other Payer Group ID is not used for this Transaction Code "DATA",9002313.93,651,0) 249^Medigap ID is not used for this Transaction Code "DATA",9002313.93,652,0) 250^Medicaid Indicator is not used for this Transaction Code "DATA",9002313.93,653,0) 251^Provider Accept Assignment Indicator is not used for this Trans Code "DATA",9002313.93,654,0) 252^CMS Part D Defined Qualified Facility is not used for this Trans Code "DATA",9002313.93,655,0) 253^Medicaid ID Number is not used for this Transaction Code "DATA",9002313.93,656,0) 254^Medicaid Agency Number is not used for this Transaction Code "DATA",9002313.93,657,0) 255^Associated Rx/Service Reference Number is not used for this Trans Code "DATA",9002313.93,658,0) 256^Associated Prescription/Service Date is not used for this Trans Code "DATA",9002313.93,659,0) 257^Procedure Modifier Code Count is not used for this Transaction Code "DATA",9002313.93,660,0) 258^Procedure Modifier Code is not used for this Transaction Code "DATA",9002313.93,661,0) 259^Quantity Dispensed is not used for this Transaction Code "DATA",9002313.93,662,0) 260^Fill Number is not used for this Transaction Code "DATA",9002313.93,663,0) 261^Days Supply is not used for this Transaction Code "DATA",9002313.93,664,0) 262^Compound Code is not used for this Transaction Code "DATA",9002313.93,665,0) 263^DAW/Product Selection Code is not used for this Trans Code "DATA",9002313.93,666,0) 264^Date Prescription Written is not used for this Transaction Code "DATA",9002313.93,667,0) 265^Number of Refills Authorized is not used for this Transaction Code "DATA",9002313.93,668,0) 266^Prescription Origin Code is not used for this Transaction Code "DATA",9002313.93,669,0) 267^Submission Clarification Code Count is not used for this Trans Code "DATA",9002313.93,670,0) 268^Submission Clarification Code is not used for this Transaction Code "DATA",9002313.93,671,0) 269^Quantity Prescribed is not used for this Transaction Code "DATA",9002313.93,672,0) 270^Other Coverage Code is not used for this Transaction Code "DATA",9002313.93,673,0) 271^Special Packaging Indicator is not used for this Transaction Code "DATA",9002313.93,674,0) 272^Originally Prescribed Prod/Serv ID Qual not used for this Trans Code "DATA",9002313.93,675,0) 273^Originally Prescribed Prod/Serv Code is not used for this Trans Code "DATA",9002313.93,676,0) 274^Originally Prescribed Quantity is not used for this Transaction Code "DATA",9002313.93,677,0) 275^Alternate ID is not used for this Transaction Code "DATA",9002313.93,678,0) 276^Scheduled Prescription ID Number is not used for this Transaction Code "DATA",9002313.93,679,0) 277^Unit of Measure is not used for this Transaction Code "DATA",9002313.93,680,0) 278^Level of Service is not used for this Transaction Code "DATA",9002313.93,681,0) 279^Prior Authorization Type Code is not used for this Transaction Code "DATA",9002313.93,682,0) 280^Prior Authorization Number Submitted is not used for this Trans Code "DATA",9002313.93,683,0) 281^Intermediary Authorization Type ID is not used for this Trans Code "DATA",9002313.93,684,0) 282^Intermediary Authorization ID is not used for this Transaction Code "DATA",9002313.93,685,0) 283^Dispensing Status is not used for this Transaction Code "DATA",9002313.93,686,0) 284^Quantity Intended to be Dispensed is not used for this Trans Code "DATA",9002313.93,687,0) 285^Days Supply Intended to be Dispensed is not used for this Trans Code "DATA",9002313.93,688,0) 286^Delay Reason Code is not used for this Transaction Code "DATA",9002313.93,689,0) 287^Transaction Reference Number is not used for this Transaction Code "DATA",9002313.93,690,0) 288^Patient Assignment Indicator is not used for this Trans Code "DATA",9002313.93,691,0) 289^Route of Administration is not used for this Transaction Code "DATA",9002313.93,692,0) 290^Compound Type is not used for this Transaction Code "DATA",9002313.93,693,0) 291^Medicaid Subrogation ICN/TCN is not used for this Transaction Code "DATA",9002313.93,694,0) 292^Pharmacy Service Type is not used for this Transaction Code "DATA",9002313.93,695,0) 293^Associated Rx/Service Provider ID Qual is not used for this Trans Code "DATA",9002313.93,696,0) 294^Associated Rx/Service Provider ID is not used for this Trans Code "DATA",9002313.93,697,0) 295^Associated Rx/Service Ref Num Qual is not used for this Trans Code "DATA",9002313.93,698,0) 296^Associated Rx/Service Ref Fill Number is not used for this Trans Code "DATA",9002313.93,699,0) 297^Time of Service is not used for this Transaction Code "DATA",9002313.93,700,0) 298^Sales Transaction ID is not used for this Transaction Code "DATA",9002313.93,701,0) 299^Reported Payment Type is not used for this Transaction Code "DATA",9002313.93,702,0) 300^Provider ID Qualifier is not used for this Transaction Code "DATA",9002313.93,703,0) 301^Provider ID is not used for this Transaction Code "DATA",9002313.93,704,0) 302^Prescriber ID Qualifier is not used for this Transaction Code "DATA",9002313.93,705,0) 303^Prescriber ID is not used for this Transaction Code "DATA",9002313.93,706,0) 304^Prescriber ID Assoc State/Prov Address not used for this Trans Code "DATA",9002313.93,707,0) 305^Prescriber Last Name is not used for this Transaction Code "DATA",9002313.93,708,0) 306^Prescriber Phone Number is not used for this Transaction Code "DATA",9002313.93,709,0) 307^Primary Care Provider ID Qualifier is not used for this Trans Code "DATA",9002313.93,710,0) 308^Primary Care Provider ID is not used for this Transaction Code "DATA",9002313.93,711,0) 309^Primary Care Provider Last Name is not used for this Transaction Code "DATA",9002313.93,712,0) 310^Prescriber First Name is not used for this Transaction Code "DATA",9002313.93,713,0) 311^Prescriber Street Address is not used for this Transaction Code "DATA",9002313.93,714,0) 312^Prescriber City Address is not used for this Transaction Code "DATA",9002313.93,715,0) 313^Prescriber State/Province Address is not used for this Trans Code "DATA",9002313.93,716,0) 314^Prescriber ZIP/Postal Zone is not used for this Transaction Code "DATA",9002313.93,717,0) 315^Prescriber Alternate ID Qualifier is not used for this Trans Code "DATA",9002313.93,718,0) 316^Prescriber Alternate ID is not used for this Transaction Code "DATA",9002313.93,719,0) 317^Prescriber Alt ID Assoc State/Prov Address not used for this Trans Cd "DATA",9002313.93,720,0) 318^Other Payer ID Qualifier is not used for this Transaction Code "DATA",9002313.93,721,0) 319^Other Payer ID is not used for this Transaction Code "DATA",9002313.93,722,0) 320^Other Payer Date is not used for this Transaction Code "DATA",9002313.93,723,0) 321^Internal Control Number is not used for this Transaction Code "DATA",9002313.93,724,0) 322^Other Payer Amount Paid Count is not used for this Transaction Code "DATA",9002313.93,725,0) 323^Other Payer Amount Paid Qualifier is not used for this Trans Code "DATA",9002313.93,726,0) 324^Other Payer Amount Paid is not used for this Transaction Code "DATA",9002313.93,727,0) 325^Other Payer Reject Count is not used for this Transaction Code "DATA",9002313.93,728,0) 326^Other Payer Reject Code is not used for this Transaction Code "DATA",9002313.93,729,0) 327^Other Payer-Patient Resp Amount Count is not used for this Trans Code "DATA",9002313.93,730,0) 328^Other Payer-Patient Resp Amount Qual is not used for this Trans Code "DATA",9002313.93,731,0) 329^Other Payer-Patient Resp Amount is not used for this Trans Code "DATA",9002313.93,732,0) 330^Benefit Stage Count is not used for this Transaction Code "DATA",9002313.93,733,0) 331^Benefit Stage Qualifier is not used for this Transaction Code "DATA",9002313.93,734,0) 332^Benefit Stage Amount is not used for this Transaction Code "DATA",9002313.93,735,0) 333^Employer Name is not used for this Transaction Code "DATA",9002313.93,736,0) 334^Employer Street Address is not used for this Transaction Code "DATA",9002313.93,737,0) 335^Employer City Address is not used for this Transaction Code "DATA",9002313.93,738,0) 336^Employer State/Province Address is not used for this Transaction Code "DATA",9002313.93,739,0) 337^Employer Zip/Postal Code is not used for this Transaction Code "DATA",9002313.93,740,0) 338^Employer Phone Number is not used for this Transaction Code "DATA",9002313.93,741,0) 339^Employer Contact Name is not used for this Transaction Code "DATA",9002313.93,742,0) 340^Carrier ID is not used for this Transaction Code "DATA",9002313.93,743,0) 341^Claim/Reference ID is not used for this Transaction Code "DATA",9002313.93,744,0) 342^Billing Entity Type Indicator is not used for this Transaction Code "DATA",9002313.93,745,0) 343^Pay To Qualifier is not used for this Transaction Code "DATA",9002313.93,746,0) 344^Pay To ID is not used for this Transaction Code "DATA",9002313.93,747,0) 345^Pay To Name is not used for this Transaction Code "DATA",9002313.93,748,0) 346^Pay To Street Address is not used for this Transaction Code "DATA",9002313.93,749,0) 347^Pay To City Address is not used for this Transaction Code "DATA",9002313.93,750,0) 348^Pay To State/Province Address is not used for this Transaction Code "DATA",9002313.93,751,0) 349^Pay To ZIP/Postal Zone is not used for this Transaction Code "DATA",9002313.93,752,0) 350^Generic Equivalent Product ID Qual is not used for this Trans Code "DATA",9002313.93,753,0) 351^Generic Equivalent Product ID is not used for this Transaction Code "DATA",9002313.93,754,0) 352^DUR/PPS Code Counter is not used for this Transaction Code "DATA",9002313.93,755,0) 353^Reason for Service Code is not used for this Transaction Code "DATA",9002313.93,756,0) 354^Professional Service Code is not used for this Transaction Code "DATA",9002313.93,757,0) 355^Result of Service Code is not used for this Transaction Code "DATA",9002313.93,758,0) 356^DUR/PPS Level of Effort is not used for this Transaction Code "DATA",9002313.93,759,0) 357^DUR Co-Agent ID Qualifier is not used for this Transaction Code "DATA",9002313.93,760,0) 358^DUR Co-Agent ID is not used for this Transaction Code "DATA",9002313.93,761,0) 359^Ingredient Cost Submitted is not used for this Transaction Code "DATA",9002313.93,762,0) 360^Dispensing Fee Submitted is not used for this Transaction Code "DATA",9002313.93,763,0) 361^Professional Service Fee Submitted is not used for this Trans Code "DATA",9002313.93,764,0) 362^Patient Paid Amount Submitted is not used for this Transaction Code "DATA",9002313.93,765,0) 363^Incentive Amount Submitted is not used for this Transaction Code "DATA",9002313.93,766,0) 364^Other Amount Claimed Submitted Count is not used for this Trans Code "DATA",9002313.93,767,0) 365^Other Amount Claimed Submitted Qual is not used for this Trans Code "DATA",9002313.93,768,0) 366^Other Amount Claimed Submitted is not used for this Transaction Code "DATA",9002313.93,769,0) 367^Flat Sales Tax Amount Submitted is not used for this Transaction Code "DATA",9002313.93,770,0) 368^Percentage Sales Tax Amount Submitted is not used for this Trans Code "DATA",9002313.93,771,0) 369^Percentage Sales Tax Rate Submitted is not used for this Trans Code "DATA",9002313.93,772,0) 370^Percentage Sales Tax Basis Submitted is not used for this Trans Code "DATA",9002313.93,773,0) 371^Usual and Customary Charge is not used for this Transaction Code "DATA",9002313.93,774,0) 372^Gross Amount Due is not used for this Transaction Code "DATA",9002313.93,775,0) 373^Basis of Cost Determination is not used for this Transaction Code "DATA",9002313.93,776,0) 374^Medicaid Paid Amount is not used for this Transaction Code "DATA",9002313.93,777,0) 375^Coupon Value Amount is not used for this Transaction Code "DATA",9002313.93,778,0) 376^Compound Ingredient Drug Cost is not used for this Transaction Code "DATA",9002313.93,779,0) 377^Compound Ingredient Basis of Cost Determ not used for this Trans Code "DATA",9002313.93,780,0) 378^Compound Ingredient Modifier Code Count not used for this Trans Code "DATA",9002313.93,781,0) 379^Compound Ingredient Modifier Code is not used for this Trans Code "DATA",9002313.93,782,0) 380^Authorized Representative First Name is not used for this Trans Code "DATA",9002313.93,783,0) 381^Authorized Rep. Last Name is not used for this Transaction Code "DATA",9002313.93,784,0) 382^Authorized Rep. Street Address is not used for this Transaction Code "DATA",9002313.93,785,0) 383^Authorized Rep. City is not used for this Transaction Code "DATA",9002313.93,786,0) 384^Authorized Rep. State/Province is not used for this Transaction Code "DATA",9002313.93,787,0) 385^Authorized Rep. Zip/Postal Code is not used for this Transaction Code "DATA",9002313.93,788,0) 386^Prior Authorization Number - Assigned is not used for this Trans Code "DATA",9002313.93,789,0) 387^Authorization Number is not used for this Transaction Code "DATA",9002313.93,790,0) 388^Prior Auth Supporting Documentation is not used for this Trans Code "DATA",9002313.93,791,0) 389^Diagnosis Code Count is not used for this Transaction Code "DATA",9002313.93,792,0) 390^Diagnosis Code Qualifier is not used for this Transaction Code "DATA",9002313.93,793,0) 391^Diagnosis Code is not used for this Transaction Code "DATA",9002313.93,794,0) 392^Clinical Information Counter is not used for this Transaction Code "DATA",9002313.93,795,0) 393^Measurement Date is not used for this Transaction Code "DATA",9002313.93,796,0) 394^Measurement Time is not used for this Transaction Code "DATA",9002313.93,797,0) 395^Measurement Dimension is not used for this Transaction Code "DATA",9002313.93,798,0) 396^Measurement Unit is not used for this Transaction Code "DATA",9002313.93,799,0) 397^Measurement Value is not used for this Transaction Code "DATA",9002313.93,800,0) 398^Request Period Begin Date is not used for this Transaction Code "DATA",9002313.93,801,0) 399^Request Period Recert/Revised Date is not used for this Trans Code "DATA",9002313.93,802,0) 400^Request Status is not used for this Transaction Code "DATA",9002313.93,803,0) 401^Length Of Need Qualifier is not used for this Transaction Code "DATA",9002313.93,804,0) 402^Length Of Need is not used for this Transaction Code "DATA",9002313.93,805,0) 403^Prescriber/Supplier Date Signed is not used for this Transaction Code "DATA",9002313.93,806,0) 404^Supporting Documentation is not used for this Transaction Code "DATA",9002313.93,807,0) 405^Question Number/Letter Count is not used for this Transaction Code "DATA",9002313.93,808,0) 406^Question Number/Letter is not used for this Transaction Code "DATA",9002313.93,809,0) 407^Question Percent Response is not used for this Transaction Code "DATA",9002313.93,810,0) 408^Question Date Response is not used for this Transaction Code "DATA",9002313.93,811,0) 409^Question Dollar Amount Response is not used for this Transaction Code "DATA",9002313.93,812,0) 410^Question Numeric Response is not used for this Transaction Code "DATA",9002313.93,813,0) 411^Question Alphanumeric Response is not used for this Transaction Code "DATA",9002313.93,814,0) 412^Facility ID is not used for this Transaction Code "DATA",9002313.93,815,0) 413^Facility Name is not used for this Transaction Code "DATA",9002313.93,816,0) 414^Facility Street Address is not used for this Transaction Code "DATA",9002313.93,817,0) 415^Facility City Address is not used for this Transaction Code "DATA",9002313.93,818,0) 416^Facility State/Province Address is not used for this Transaction Code "DATA",9002313.93,819,0) 417^Facility ZIP/Postal Zone is not used for this Transaction Code "DATA",9002313.93,820,0) 418^Purchaser ID Qualifier is not used for this Transaction Code "DATA",9002313.93,821,0) 419^Purchaser ID is not used for this Transaction Code "DATA",9002313.93,822,0) 420^Purchaser ID Associated State Code is not used for this Trans Code "DATA",9002313.93,823,0) 421^Purchase Date of Birth is not used for this Transaction Code "DATA",9002313.93,824,0) 422^Purchaser Gender Code is not used for this Transaction Code "DATA",9002313.93,825,0) 423^Purchaser First Name is not used for this Transaction Code "DATA",9002313.93,826,0) 424^Purchaser Last Name is not used for this Transaction Code "DATA",9002313.93,827,0) 425^Purchaser Street Address is not used for this Transaction Code "DATA",9002313.93,828,0) 426^Purchaser City Address is not used for this Transaction Code "DATA",9002313.93,829,0) 427^Purchaser State/Province Address is not used for this Transaction Code "DATA",9002313.93,830,0) 428^Purchaser ZIP/Postal Zone is not used for this Transaction Code "DATA",9002313.93,831,0) 429^Purchaser Country Code is not used for this Transaction Code "DATA",9002313.93,832,0) 430^Purchaser Relationship Code is not used for this Transaction Code "DATA",9002313.93,833,0) 431^Released Date is not used for this Transaction Code "DATA",9002313.93,834,0) 432^Released Time is not used for this Transaction Code "DATA",9002313.93,835,0) 433^Service Provider Name is not used for this Transaction Code "DATA",9002313.93,836,0) 434^Service Provider Street Address is not used for this Transaction Code "DATA",9002313.93,837,0) 435^Service Provider City Address is not used for this Transaction Code "DATA",9002313.93,838,0) 436^Service Prov State/Province Address is not used for this Trans Code "DATA",9002313.93,839,0) 437^Service Provider ZIP/Postal Zone is not used for this Transaction Code "DATA",9002313.93,840,0) 438^Seller ID Qualifier is not used for this Transaction Code "DATA",9002313.93,841,0) 439^Seller ID is not used for this Transaction Code "DATA",9002313.93,842,0) 440^Seller Initials is not used for this Transaction Code "DATA",9002313.93,843,0) 441^Other Amount Claimed Submitted Grouping Incorrect "DATA",9002313.93,844,0) 442^Other Payer Amount Paid Grouping Incorrect "DATA",9002313.93,845,0) 443^Other Payer-Patient Responsibility Amount Grouping Incorrect "DATA",9002313.93,846,0) 444^Benefit Stage Amount Grouping Incorrect "DATA",9002313.93,847,0) 445^Diagnosis Code Grouping Incorrect "DATA",9002313.93,848,0) 446^COB/Other Payments Segment Incorrectly Formatted "DATA",9002313.93,849,0) 447^Additional Documentation Segment Incorrectly Formatted "DATA",9002313.93,850,0) 448^Clinical Segment Incorrectly Formatted "DATA",9002313.93,851,0) 449^Patient Segment Incorrectly Formatted "DATA",9002313.93,852,0) 450^Insurance Segment Incorrectly Formatted "DATA",9002313.93,853,0) 451^Transaction Header Segment Incorrectly Formatted "DATA",9002313.93,854,0) 452^Claim Segment Incorrectly Formatted "DATA",9002313.93,855,0) 453^Pharmacy Provider Segment Incorrectly Formatted "DATA",9002313.93,856,0) 454^Prescriber Segment Incorrectly Formatted "DATA",9002313.93,857,0) 455^Workers' Compensation Segment Incorrectly Formatted "DATA",9002313.93,858,0) 456^Pricing Segment Incorrectly Formatted "DATA",9002313.93,859,0) 457^Coupon Segment Incorrectly Formatted "DATA",9002313.93,860,0) 458^Prior Authorization Segment Incorrectly Formatted "DATA",9002313.93,861,0) 459^Facility Segment Incorrectly Formatted "DATA",9002313.93,862,0) 460^Narrative Segment Incorrectly Formatted "DATA",9002313.93,863,0) 461^Purchaser Segment Incorrectly Formatted "DATA",9002313.93,864,0) 462^Service Provider Segment Incorrectly Formatted "DATA",9002313.93,865,0) 463^Pharmacy not contracted in Assisted Living Network "DATA",9002313.93,866,0) 464^Service Provider ID Qualifier Does Not Precede Service Provider ID "DATA",9002313.93,867,0) 465^Patient ID Qualifier Does Not Precede Patient ID "DATA",9002313.93,868,0) 466^Rx/Service Ref Number Qualifier Does Not Precede Rx/Service Ref Number "DATA",9002313.93,869,0) 467^Product/Service ID Qualifier Does Not Precede Product/Service ID "DATA",9002313.93,870,0) 468^Procedure Modifier Code Count Does Not Precede Procedure Modifier Code "DATA",9002313.93,871,0) 469^Submission Clarification Cd Cnt Follows Submission Clarification Code "DATA",9002313.93,872,0) 470^Orig Prscrbd Prod/Serv ID Qual Follows Orig Prscrbd Prod/Serv Code "DATA",9002313.93,873,0) 471^Oth Amt Claimed Submitted Cnt Follows Oth Amt Claimed Amt And/Or Qual "DATA",9002313.93,874,0) 472^Other Amt Claimed Submitted Qual Follows Other Amt Claimed Submitted "DATA",9002313.93,875,0) 473^Provider Id Qualifier Does Not Precede Provider ID "DATA",9002313.93,876,0) 474^Prescriber Id Qualifier Does Not Precede Prescriber ID "DATA",9002313.93,877,0) 475^Primary Care Prov ID Qual Does Not Precede Primary Care Provider ID "DATA",9002313.93,878,0) 476^COB/Other Payments Count Does Not Precede Other Payer Coverage Type "DATA",9002313.93,879,0) 477^Other Payer ID Does Not Precede Other Payer ID Data Fields "DATA",9002313.93,880,0) 478^Other Payer ID Qualifier Does Not Precede Other Payer ID "DATA",9002313.93,881,0) 479^Other Payer Amt Paid Count Follows Other Payer Amt Paid And/Or Qual "DATA",9002313.93,882,0) 480^Other Payer Amount Paid Qual Does Not Precede Other Payer Amount Paid "DATA",9002313.93,883,0) 481^Other Payer Reject Count Does Not Precede Other Payer Reject Code "DATA",9002313.93,884,0) 482^Oth Payer-Pat Resp Amt Cnt Follows Oth Payer-Pat Resp Amt and/or Qual "DATA",9002313.93,885,0) 483^Other Payer-Patient Resp Amt Qual Follows Other Payer-Patient Resp Amt "DATA",9002313.93,886,0) 484^Benefit Stage Count Does Not Precede Benefit Stage Amount and/or Qual "DATA",9002313.93,887,0) 485^Benefit Stage Qualifier Does Not Precede Benefit Stage Amount "DATA",9002313.93,888,0) 486^Pay To Qualifier Does Not Precede Pay To ID "DATA",9002313.93,889,0) 487^Generic Equivalent Prod Id Qual Follows Generic Equivalent Prod Id "DATA",9002313.93,890,0) 488^DUR/PPS Code Counter Does Not Precede DUR Data Fields "DATA",9002313.93,891,0) 489^DUR Co-Agent ID Qualifier Does Not Precede DUR Co-Agent ID "DATA",9002313.93,892,0) 490^Compound Ingredient Component Cnt Follows Compound Prod ID And/Or Qual "DATA",9002313.93,893,0) 491^Compound Product ID Qualifier Does Not Precede Compound Product ID "DATA",9002313.93,894,0) 492^Compound Ingredient Mod Code Cnt Follows Compound Ingredient Mod Code "DATA",9002313.93,895,0) 493^Diagnosis Code Count Does Not Precede Diagnosis Code And/Or Qualifier "DATA",9002313.93,896,0) 494^Diagnosis Code Qualifier Does Not Precede Diagnosis Code "DATA",9002313.93,897,0) 495^Clinical Info Counter Does Not Precede Clinical Measurement data "DATA",9002313.93,898,0) 496^Length Of Need Qualifier Does Not Precede Length Of Need "DATA",9002313.93,899,0) 497^Question Number/Letter Count Does Not Precede Question Number/Letter "DATA",9002313.93,900,0) 498^Accumulator Month Count Does Not Precede Accumulator Month "DATA",9002313.93,901,0) 499^Address Count Does Not Precede Address Data Fields "DATA",9002313.93,902,0) 500^Patient ID Qualifier Count Does Not Precede Patient ID Data Fields "DATA",9002313.93,903,0) 501^Prescriber ID Count Does Not Precede Prescriber ID Data Fields "DATA",9002313.93,904,0) 502^Prescriber Specialty Count Does Not Precede Prescriber Specialty "DATA",9002313.93,905,0) 503^Telephone Number Count Does Not Precede Telephone Number Data Fields "DATA",9002313.93,906,0) 504^Benefit Stage Qualifier Value Not Supported "DATA",9002313.93,907,0) 505^Other Payer Coverage Type Value Not Supported "DATA",9002313.93,908,0) 506^Prescription/Service Reference Number Qualifier Value Not Supported "DATA",9002313.93,909,0) 507^Additional Documentation Type ID Value Not Supported "DATA",9002313.93,910,0) 508^Authorized Representative State/Province Address Value Not Supported "DATA",9002313.93,911,0) 509^Basis Of Request Value Not Supported "DATA",9002313.93,912,0) 510^Billing Entity Type Indicator Value Not Supported "DATA",9002313.93,913,0) 511^CMS Part D Defined Qualified Facility Value Not Supported "DATA",9002313.93,914,0) 512^Compound Code Value Not Supported "DATA",9002313.93,915,0) 513^Compound Dispensing Unit Form Indicator Value Not Supported "DATA",9002313.93,916,0) 514^Compound Ingredient Basis of Cost Determination Value Not Supported "DATA",9002313.93,917,0) 515^Compound Product ID Qualifier Value Not Supported "DATA",9002313.93,918,0) 516^Compound Type Value Not Supported "DATA",9002313.93,919,0) 517^Coupon Type Value Not Supported "DATA",9002313.93,920,0) 518^DUR Co-Agent ID Qualifier Value Not Supported "DATA",9002313.93,921,0) 519^DUR/PPS Level Of Effort Value Not Supported "DATA",9002313.93,922,0) 520^Delay Reason Code Value Not Supported "DATA",9002313.93,923,0) 521^Diagnosis Code Qualifier Value Not Supported "DATA",9002313.93,924,0) 522^Dispensing Status Value Not Supported "DATA",9002313.93,925,0) 523^Eligibility Clarification Code Value Not Supported "DATA",9002313.93,926,0) 524^Employer State/Province Address Value Not Supported "DATA",9002313.93,927,0) 525^Facility State/Province Address Value Not Supported "DATA",9002313.93,928,0) 526^Header Response Status Value Not Supported "DATA",9002313.93,929,0) 527^Intermediary Authorization Type ID Value Not Supported "DATA",9002313.93,930,0) 528^Length of Need Qualifier Value Not Supported "DATA",9002313.93,931,0) 529^Level Of Service Value Not Supported "DATA",9002313.93,932,0) 530^Measurement Dimension Value Not Supported "DATA",9002313.93,933,0) 531^Measurement Unit Value Not Supported "DATA",9002313.93,934,0) 532^Medicaid Indicator Value Not Supported "DATA",9002313.93,935,0) 533^Originally Prescribed Product/Service ID Qualifier Value Not Supported "DATA",9002313.93,936,0) 534^Other Amount Claimed Submitted Qualifier Value Not Supported "DATA",9002313.93,937,0) 535^Other Coverage Code Value Not Supported "DATA",9002313.93,938,0) 536^Other Payer-Patient Responsibility Amount Qual Value Not Supported "DATA",9002313.93,939,0) 537^Patient Assignment Indicator Value Not Supported "DATA",9002313.93,940,0) 538^Patient Gender Code Value Not Supported "DATA",9002313.93,941,0) 539^Patient State/Province Address Value Not Supported "DATA",9002313.93,942,0) 540^Pay to State/Province Address Value Not Supported "DATA",9002313.93,943,0) 541^Percentage Sales Tax Basis Submitted Value Not Supported "DATA",9002313.93,944,0) 542^Pregnancy Indicator Value Not Supported "DATA",9002313.93,945,0) 543^Prescriber ID Qualifier Value Not Supported "DATA",9002313.93,946,0) 544^Prescriber State/Province Address Value Not Supported "DATA",9002313.93,947,0) 545^Prescription Origin Code Value Not Supported "DATA",9002313.93,948,0) 546^Primary Care Provider ID Qualifier Value Not Supported "DATA",9002313.93,949,0) 547^Prior Authorization Type Code Value Not Supported "DATA",9002313.93,950,0) 548^Provider Accept Assignment Indicator Value Not Supported "DATA",9002313.93,951,0) 549^Provider ID Qualifier Value Not Supported "DATA",9002313.93,952,0) 550^Request Status Value Not Supported "DATA",9002313.93,953,0) 551^Request Type Value Not Supported "DATA",9002313.93,954,0) 552^Route of Administration Value Not Supported "DATA",9002313.93,955,0) 553^Smoker/Non-Smoker Code Value Not Supported "DATA",9002313.93,956,0) 554^Special Packaging Indicator Value Not Supported "DATA",9002313.93,957,0) 555^Transaction Count Value Not Supported "DATA",9002313.93,958,0) 556^Unit Of Measure Value Not Supported "DATA",9002313.93,959,0) 557^COB Segment Present On A Non-COB Claim "DATA",9002313.93,960,0) 7F^Future date not allowed for Date of Birth "DATA",9002313.93,961,0) A1^ID Submitted is associated with a Sanctioned Prescriber "DATA",9002313.93,962,0) A2^ID Submitted is associated to a Deceased Prescriber "DATA",9002313.93,963,0) TF^M/I Technician Initials "DATA",9002313.93,964,0) X0^M/I Associated Prescription/Service Fill Number "DATA",9002313.93,965,0) XZ^M/I Associated Prescription/Service Reference Number Qualifier "DATA",9002313.93,966,0) Y0^M/I Purchaser Last Name "DATA",9002313.93,967,0) Y1^M/I Purchaser Street Address "DATA",9002313.93,968,0) Y2^M/I Purchaser City Address "DATA",9002313.93,969,0) Y3^M/I Purchaser State/Province Code "DATA",9002313.93,970,0) Y4^M/I Purchaser Zip/Postal Code "DATA",9002313.93,971,0) Y5^M/I Purchaser Country Code "DATA",9002313.93,972,0) Y6^M/I Time of Service "DATA",9002313.93,973,0) Y7^M/I Associated Prescription/Service Provider ID Qualifier "DATA",9002313.93,974,0) Y8^M/I Associated Prescription/Service Provider ID "DATA",9002313.93,975,0) Y9^M/I Seller ID "DATA",9002313.93,976,0) YK^M/I Service Provider Name "DATA",9002313.93,977,0) YM^M/I Service Provider Street Address "DATA",9002313.93,978,0) YN^M/I Service Provider City Address "DATA",9002313.93,979,0) YP^M/I Service Provider State/Province Code Address "DATA",9002313.93,980,0) YQ^M/I Service Provider Zip/Postal Code "DATA",9002313.93,981,0) YR^M/I Patient ID Associated State/Province Address "DATA",9002313.93,982,0) YS^M/I Purchaser Relationship Code "DATA",9002313.93,983,0) YT^M/I Seller Initials "DATA",9002313.93,984,0) YU^M/I Purchaser ID Qualifier "DATA",9002313.93,985,0) YV^M/I Purchaser ID "DATA",9002313.93,986,0) YW^M/I Purchaser ID Associated State/Province Code "DATA",9002313.93,987,0) YX^M/I Purchaser Date of Birth "DATA",9002313.93,988,0) YY^M/I Purchaser Gender Code "DATA",9002313.93,989,0) YZ^M/I Purchaser First Name "DATA",9002313.93,990,0) Z0^Purchaser Country Code Not Supported For Processor/Payer "DATA",9002313.93,991,0) Z1^Prescriber Alternate ID Qualifier Not Supported "DATA",9002313.93,992,0) Z2^M/I Purchaser Segment "DATA",9002313.93,993,0) Z3^Purchaser Segment Present On A Non-Controlled Sub Reporting Trans "DATA",9002313.93,994,0) Z4^Purchaser Segment Required On A Controlled Substance Reporting Trans "DATA",9002313.93,995,0) Z5^M/I Service Provider Segment "DATA",9002313.93,996,0) Z6^Service Prov Segment Present On A non-Controlled Sub Reporting Trans "DATA",9002313.93,997,0) Z7^Service Provider Segment Required On A Controlled Sub Reporting Trans "DATA",9002313.93,998,0) Z8^Purchaser Relationship Code Not Supported "DATA",9002313.93,999,0) Z9^Prescriber Alternate ID Not Covered "DATA",9002313.93,1000,0) ZB^M/I Seller ID Qualifier "DATA",9002313.93,1001,0) ZC^Assoc Rx/Service Prov ID Qual Value Not Supported For Processor/Payer "DATA",9002313.93,1002,0) ZD^Associated Rx/Service Reference Number Qualifier Submitted Not Covered "DATA",9002313.93,1003,0) ZF^M/I Sales Transaction ID "DATA",9002313.93,1004,0) ZK^M/I Prescriber ID Associated State/Province Address "DATA",9002313.93,1005,0) ZM^M/I Prescriber Alternate ID Qualifier "DATA",9002313.93,1006,0) ZN^Purchaser ID Qualifier Value Not Supported For Processor/Payer "DATA",9002313.93,1007,0) ZP^M/I Prescriber Alternate ID "DATA",9002313.93,1008,0) ZQ^M/I Prescriber Alternate ID Associated State/Province Address "DATA",9002313.93,1009,0) ZS^M/I Reported Payment Type "DATA",9002313.93,1010,0) ZT^M/I Released Date "DATA",9002313.93,1011,0) ZU^M/I Released Time "DATA",9002313.93,1012,0) ZV^Reported Payment Type Not Supported "DATA",9002313.93,1013,0) ZW^M/I Compound Preparation Time "DATA",9002313.93,1014,0) ZX^M/I CMS Part D Contract ID "DATA",9002313.93,1015,0) ZY^M/I Medicare Part D Plan Benefit Package (PBP) "DATA",9002313.93,1016,0) ZZ^Cardholder ID submitted is inactive. New Cardholder ID on file. "DATA",9002313.94,1,0) 108^^ "DATA",9002313.94,1,1,0) ^9002313.941A^12^12 "DATA",9002313.94,1,1,1,0) 00^UNSPECIFIED "DATA",9002313.94,1,1,1,1,0) ^9002313.9412SA^2^1 "DATA",9002313.94,1,1,1,1,2,0) 51 "DATA",9002313.94,1,1,2,0) 01^DELIVERY "DATA",9002313.94,1,1,2,1,0) ^9002313.9412SA^4^2 "DATA",9002313.94,1,1,2,1,3,0) D0 "DATA",9002313.94,1,1,2,1,4,0) 51 "DATA",9002313.94,1,1,3,0) 02^SHIPPING "DATA",9002313.94,1,1,3,1,0) ^9002313.9412SA^2^2 "DATA",9002313.94,1,1,3,1,1,0) 51 "DATA",9002313.94,1,1,3,1,2,0) D0 "DATA",9002313.94,1,1,4,0) 03^POSTAGE "DATA",9002313.94,1,1,4,1,0) ^9002313.9412SA^2^2 "DATA",9002313.94,1,1,4,1,1,0) 51 "DATA",9002313.94,1,1,4,1,2,0) D0 "DATA",9002313.94,1,1,5,0) 04^ADMINISTRATIVE "DATA",9002313.94,1,1,5,1,0) ^9002313.9412SA^2^2 "DATA",9002313.94,1,1,5,1,1,0) 51 "DATA",9002313.94,1,1,5,1,2,0) D0 "DATA",9002313.94,1,1,6,0) 05^INCENTIVE "DATA",9002313.94,1,1,6,1,0) ^9002313.9412SA^2^2 "DATA",9002313.94,1,1,6,1,1,0) 51 "DATA",9002313.94,1,1,6,1,2,0) D0 "DATA",9002313.94,1,1,7,0) 06^COGNITIVE SERVICE "DATA",9002313.94,1,1,7,1,0) ^9002313.9412SA^2^2 "DATA",9002313.94,1,1,7,1,1,0) 51 "DATA",9002313.94,1,1,7,1,2,0) D0 "DATA",9002313.94,1,1,8,0) 07^DRUG BENEFIT "DATA",9002313.94,1,1,8,1,0) ^9002313.9412SA^2^2 "DATA",9002313.94,1,1,8,1,1,0) 51 "DATA",9002313.94,1,1,8,1,2,0) D0 "DATA",9002313.94,1,1,9,0) 08^SUM OF ALL REIMBURSEMENT "DATA",9002313.94,1,1,9,1,0) ^9002313.9412SA^1^1 "DATA",9002313.94,1,1,9,1,1,0) 51^1 "DATA",9002313.94,1,1,10,0) 09^COMPOUNT PREPARATION COST "DATA",9002313.94,1,1,10,1,0) ^9002313.9412SA^1^1 "DATA",9002313.94,1,1,10,1,1,0) D0 "DATA",9002313.94,1,1,11,0) 10^SALES TAX "DATA",9002313.94,1,1,11,1,0) ^9002313.9412SA^1^1 "DATA",9002313.94,1,1,11,1,1,0) D0 "DATA",9002313.94,1,1,12,0) 98^COUPON "DATA",9002313.94,1,1,12,1,0) ^9002313.9412SA^1^1 "DATA",9002313.94,1,1,12,1,1,0) 51 "FIA",9002313.02) BPS CLAIMS "FIA",9002313.02,0) ^BPSC( "FIA",9002313.02,0,0) 9002313.02 "FIA",9002313.02,0,1) y^y^f^^^^n "FIA",9002313.02,0,10) "FIA",9002313.02,0,11) "FIA",9002313.02,0,"RLRO") "FIA",9002313.02,0,"VR") 1.0^BPS "FIA",9002313.02,9002313.02) 0 "FIA",9002313.02,9002313.0201) 0 "FIA",9002313.02,9002313.02354) 0 "FIA",9002313.02,9002313.023771) 0 "FIA",9002313.02,9002313.0401) 0 "FIA",9002313.02,9002313.0501) 0 "FIA",9002313.02,9002313.05011) 0 "FIA",9002313.02,9002313.0601) 0 "FIA",9002313.02,9002313.0701) 0 "FIA",9002313.02,9002313.0801) 0 "FIA",9002313.02,9002313.0901) 0 "FIA",9002313.02,9002313.1001) 0 "FIA",9002313.02,9002313.201459) 0 "FIA",9002313.02,9002313.29999) 0 "FIA",9002313.02,9002313.401342) 0 "FIA",9002313.02,9002313.401353) 0 "FIA",9002313.02,9002313.401392) 0 "FIA",9002313.02,9002313.401472) 0 "FIA",9002313.03) BPS RESPONSES "FIA",9002313.03,0) ^BPSR( "FIA",9002313.03,0,0) 9002313.03P "FIA",9002313.03,0,1) y^y^f^^^^n "FIA",9002313.03,0,10) "FIA",9002313.03,0,11) "FIA",9002313.03,0,"RLRO") "FIA",9002313.03,0,"VR") 1.0^BPS "FIA",9002313.03,9002313.03) 0 "FIA",9002313.03,9002313.0301) 0 "FIA",9002313.03,9002313.03511) 0 "FIA",9002313.03,9002313.035501) 0 "FIA",9002313.03,9002313.039201) 0 "FIA",9002313.03,9002313.1101) 0 "FIA",9002313.03,9002313.13001) 0 "FIA",9002313.03,9002313.1301) 0 "FIA",9002313.03,9002313.1401) 0 "FIA",9002313.03,9002313.301548) 0 "FIA",9002313.03,9002313.39999) 0 "FIA",9002313.15) BPS ASLEEP PAYERS "FIA",9002313.15,0) ^BPS(9002313.15, "FIA",9002313.15,0,0) 9002313.15P "FIA",9002313.15,0,1) y^y^p^^^^n^^n "FIA",9002313.15,0,10) "FIA",9002313.15,0,11) "FIA",9002313.15,0,"RLRO") "FIA",9002313.15,0,"VR") 1.0^BPS "FIA",9002313.15,9002313.15) 1 "FIA",9002313.15,9002313.15,.04) "FIA",9002313.19) BPS NCPDP PATIENT RELATIONSHIP CODE "FIA",9002313.19,0) ^BPS(9002313.19, "FIA",9002313.19,0,0) 9002313.19I "FIA",9002313.19,0,1) y^y^f^^n^^y^o^n "FIA",9002313.19,0,10) "FIA",9002313.19,0,11) "FIA",9002313.19,0,"RLRO") "FIA",9002313.19,0,"VR") 1.0^BPS "FIA",9002313.19,9002313.19) 0 "FIA",9002313.19,9002313.191) 0 "FIA",9002313.21) BPS NCPDP PROFESSIONAL SERVICE CODE "FIA",9002313.21,0) ^BPS(9002313.21, "FIA",9002313.21,0,0) 9002313.21I "FIA",9002313.21,0,1) y^y^f^^n^^y^o^n "FIA",9002313.21,0,10) "FIA",9002313.21,0,11) "FIA",9002313.21,0,"RLRO") "FIA",9002313.21,0,"VR") 1.0^BPS "FIA",9002313.21,9002313.21) 0 "FIA",9002313.22) BPS NCPDP RESULT OF SERVICE CODE "FIA",9002313.22,0) ^BPS(9002313.22, "FIA",9002313.22,0,0) 9002313.22I "FIA",9002313.22,0,1) y^y^f^^n^^y^o^n "FIA",9002313.22,0,10) "FIA",9002313.22,0,11) "FIA",9002313.22,0,"RLRO") "FIA",9002313.22,0,"VR") 1.0^BPS "FIA",9002313.22,9002313.22) 0 "FIA",9002313.23) BPS NCPDP REASON FOR SERVICE CODE "FIA",9002313.23,0) ^BPS(9002313.23, "FIA",9002313.23,0,0) 9002313.23I "FIA",9002313.23,0,1) y^y^f^^n^^y^o^n "FIA",9002313.23,0,10) "FIA",9002313.23,0,11) "FIA",9002313.23,0,"RLRO") "FIA",9002313.23,0,"VR") 1.0^BPS "FIA",9002313.23,9002313.23) 0 "FIA",9002313.24) BPS NCPDP DAW CODE "FIA",9002313.24,0) ^BPS(9002313.24, "FIA",9002313.24,0,0) 9002313.24I "FIA",9002313.24,0,1) y^y^f^^n^^y^o^n "FIA",9002313.24,0,10) "FIA",9002313.24,0,11) "FIA",9002313.24,0,"RLRO") "FIA",9002313.24,0,"VR") 1.0^BPS "FIA",9002313.24,9002313.24) 0 "FIA",9002313.26) BPS NCPDP PRIOR AUTHORIZATION TYPE CODE "FIA",9002313.26,0) ^BPS(9002313.26, "FIA",9002313.26,0,0) 9002313.26I "FIA",9002313.26,0,1) y^y^f^^n^^y^o^n "FIA",9002313.26,0,10) "FIA",9002313.26,0,11) "FIA",9002313.26,0,"RLRO") "FIA",9002313.26,0,"VR") 1.0^BPS "FIA",9002313.26,9002313.26) 0 "FIA",9002313.26,9002313.261) 0 "FIA",9002313.27) BPS NCPDP PATIENT RESIDENCE CODE "FIA",9002313.27,0) ^BPS(9002313.27, "FIA",9002313.27,0,0) 9002313.27I "FIA",9002313.27,0,1) y^y^f^^n^^y^o^n "FIA",9002313.27,0,10) "FIA",9002313.27,0,11) "FIA",9002313.27,0,"RLRO") "FIA",9002313.27,0,"VR") 1.0^BPS "FIA",9002313.27,9002313.27) 0 "FIA",9002313.27,9002313.271) 0 "FIA",9002313.28) BPS NCPDP PHARMACY SERVICE TYPE "FIA",9002313.28,0) ^BPS(9002313.28, "FIA",9002313.28,0,0) 9002313.28I "FIA",9002313.28,0,1) y^y^f^^n^^y^o^n "FIA",9002313.28,0,10) "FIA",9002313.28,0,11) "FIA",9002313.28,0,"RLRO") "FIA",9002313.28,0,"VR") 1.0^BPS "FIA",9002313.28,9002313.28) 0 "FIA",9002313.28,9002313.281) 0 "FIA",9002313.29) BPS NCPDP DELAY REASON CODE "FIA",9002313.29,0) ^BPS(9002313.29, "FIA",9002313.29,0,0) 9002313.29I "FIA",9002313.29,0,1) y^y^f^^n^^y^o^n "FIA",9002313.29,0,10) "FIA",9002313.29,0,11) "FIA",9002313.29,0,"RLRO") "FIA",9002313.29,0,"VR") 1.0^BPS "FIA",9002313.29,9002313.29) 0 "FIA",9002313.29,9002313.291) 0 "FIA",9002313.31) BPS CERTIFICATION "FIA",9002313.31,0) ^BPS(9002313.31, "FIA",9002313.31,0,0) 9002313.31 "FIA",9002313.31,0,1) y^y^p^^^^n^^n "FIA",9002313.31,0,10) "FIA",9002313.31,0,11) "FIA",9002313.31,0,"RLRO") "FIA",9002313.31,0,"VR") 1.0^BPS "FIA",9002313.31,9002313.31) 1 "FIA",9002313.31,9002313.31,.04) "FIA",9002313.31,9002313.31,.05) "FIA",9002313.31,9002313.31,.06) "FIA",9002313.31,9002313.31,.07) "FIA",9002313.31,9002313.31,.08) "FIA",9002313.31,9002313.312) 1 "FIA",9002313.31,9002313.312,2) "FIA",9002313.31,9002313.312,3) "FIA",9002313.31,9002313.312,4) "FIA",9002313.31,9002313.3122) 0 "FIA",9002313.31,9002313.3123) 0 "FIA",9002313.31,9002313.31231) 0 "FIA",9002313.31,9002313.31232) 0 "FIA",9002313.31,9002313.31233) 0 "FIA",9002313.31,9002313.31234) 0 "FIA",9002313.31,9002313.3124) 0 "FIA",9002313.32) BPS PAYER RESPONSE OVERRIDES "FIA",9002313.32,0) ^BPS(9002313.32, "FIA",9002313.32,0,0) 9002313.32 "FIA",9002313.32,0,1) y^y^p^^^^n^^n "FIA",9002313.32,0,10) "FIA",9002313.32,0,11) "FIA",9002313.32,0,"RLRO") "FIA",9002313.32,0,"VR") 1.0^BPS "FIA",9002313.32,9002313.32) 1 "FIA",9002313.32,9002313.32,.02) "FIA",9002313.32,9002313.32,.08) "FIA",9002313.57) BPS LOG OF TRANSACTIONS "FIA",9002313.57,0) ^BPSTL( "FIA",9002313.57,0,0) 9002313.57 "FIA",9002313.57,0,1) y^y^p^^^^n^^n "FIA",9002313.57,0,10) "FIA",9002313.57,0,11) "FIA",9002313.57,0,"RLRO") "FIA",9002313.57,0,"VR") 1.0^BPS "FIA",9002313.57,9002313.57) 1 "FIA",9002313.57,9002313.57,1.05) "FIA",9002313.57,9002313.57,19) "FIA",9002313.57,9002313.57,1201) "FIA",9002313.57,9002313.57902) 1 "FIA",9002313.57,9002313.57902,902.02) "FIA",9002313.57,9002313.57902,902.21) "FIA",9002313.57,9002313.57902,902.34) "FIA",9002313.57,9002313.57902,902.35) "FIA",9002313.57,9002313.57902,902.36) "FIA",9002313.58) BPS STATISTICS "FIA",9002313.58,0) ^BPSECX("S", "FIA",9002313.58,0,0) 9002313.58 "FIA",9002313.58,0,1) y^y^p^^^^n^^n "FIA",9002313.58,0,10) "FIA",9002313.58,0,11) "FIA",9002313.58,0,"RLRO") "FIA",9002313.58,0,"VR") 1.0^BPS "FIA",9002313.58,9002313.58) 1 "FIA",9002313.58,9002313.58,209) "FIA",9002313.58,9002313.58,210) "FIA",9002313.59) BPS TRANSACTION "FIA",9002313.59,0) ^BPST( "FIA",9002313.59,0,0) 9002313.59O "FIA",9002313.59,0,1) y^y^p^^^^n^^n "FIA",9002313.59,0,10) "FIA",9002313.59,0,11) "FIA",9002313.59,0,"RLRO") "FIA",9002313.59,0,"VR") 1.0^BPS "FIA",9002313.59,9002313.59) 1 "FIA",9002313.59,9002313.59,1.05) "FIA",9002313.59,9002313.59,19) "FIA",9002313.59,9002313.59,1201) "FIA",9002313.59,9002313.59902) 1 "FIA",9002313.59,9002313.59902,902.02) "FIA",9002313.59,9002313.59902,902.21) "FIA",9002313.59,9002313.59902,902.34) "FIA",9002313.59,9002313.59902,902.35) "FIA",9002313.59,9002313.59902,902.36) "FIA",9002313.77) BPS REQUESTS "FIA",9002313.77,0) ^BPS(9002313.77, "FIA",9002313.77,0,0) 9002313.77 "FIA",9002313.77,0,1) y^y^p^^^^n^^n "FIA",9002313.77,0,10) "FIA",9002313.77,0,11) "FIA",9002313.77,0,"RLRO") "FIA",9002313.77,0,"VR") 1.0^BPS "FIA",9002313.77,9002313.77) 1 "FIA",9002313.77,9002313.77,.01) "FIA",9002313.77,9002313.77,.02) "FIA",9002313.77,9002313.77,.06) "FIA",9002313.77,9002313.77,1.01) "FIA",9002313.77,9002313.77,1.02) "FIA",9002313.77,9002313.77,1.04) "FIA",9002313.77,9002313.77,1.13) "FIA",9002313.77,9002313.77,1.14) "FIA",9002313.77,9002313.77,1.15) "FIA",9002313.77,9002313.77,1.16) "FIA",9002313.77,9002313.77,2.01) "FIA",9002313.77,9002313.77,2.05) "FIA",9002313.77,9002313.77,2.1) "FIA",9002313.77,9002313.77,9.01) "FIA",9002313.78) BPS INSURER DATA "FIA",9002313.78,0) ^BPS(9002313.78, "FIA",9002313.78,0,0) 9002313.78 "FIA",9002313.78,0,1) y^y^p^^^^n^^n "FIA",9002313.78,0,10) "FIA",9002313.78,0,11) "FIA",9002313.78,0,"RLRO") "FIA",9002313.78,0,"VR") 1.0^BPS "FIA",9002313.78,9002313.78) 1 "FIA",9002313.78,9002313.78,.01) "FIA",9002313.78,9002313.78,.02) "FIA",9002313.78,9002313.78,.04) "FIA",9002313.78,9002313.78,.1) "FIA",9002313.78,9002313.78,.11) "FIA",9002313.78,9002313.78,2.07) "FIA",9002313.78,9002313.78,4.01) "FIA",9002313.78,9002313.78,4.03) "FIA",9002313.78,9002313.78,4.04) "FIA",9002313.91) BPS NCPDP FIELD DEFS "FIA",9002313.91,0) ^BPSF(9002313.91, "FIA",9002313.91,0,0) 9002313.91I "FIA",9002313.91,0,1) y^y^f^^n^^y^o^n "FIA",9002313.91,0,10) "FIA",9002313.91,0,11) "FIA",9002313.91,0,"RLRO") "FIA",9002313.91,0,"VR") 1.0^BPS "FIA",9002313.91,9002313.91) 0 "FIA",9002313.91,9002313.9101) 0 "FIA",9002313.91,9002313.9102) 0 "FIA",9002313.91,9002313.9103) 0 "FIA",9002313.91,9002313.9104) 0 "FIA",9002313.92) BPS NCPDP FORMATS "FIA",9002313.92,0) ^BPSF(9002313.92, "FIA",9002313.92,0,0) 9002313.92 "FIA",9002313.92,0,1) y^y^p^^^^n^^n "FIA",9002313.92,0,10) "FIA",9002313.92,0,11) "FIA",9002313.92,0,"RLRO") "FIA",9002313.92,0,"VR") 1.0^BPS "FIA",9002313.92,9002313.92) 1 "FIA",9002313.92,9002313.92,1.02) "FIA",9002313.92,9002313.92,100) "FIA",9002313.92,9002313.92,110) "FIA",9002313.92,9002313.92,120) "FIA",9002313.92,9002313.92,130) "FIA",9002313.92,9002313.92,140) "FIA",9002313.92,9002313.92,150) "FIA",9002313.92,9002313.92,160) "FIA",9002313.92,9002313.92,170) "FIA",9002313.92,9002313.92,180) "FIA",9002313.92,9002313.92,190) "FIA",9002313.92,9002313.92,200) "FIA",9002313.92,9002313.92,210) "FIA",9002313.92,9002313.92,220) "FIA",9002313.92,9002313.92,230) "FIA",9002313.92,9002313.92,240) "FIA",9002313.92,9002313.92,250) "FIA",9002313.92,9002313.92,260) "FIA",9002313.92,9002313.9205) 1 "FIA",9002313.92,9002313.9205,.01) "FIA",9002313.92,9002313.9205,1) "FIA",9002313.92,9002313.92051) 0 "FIA",9002313.92,9002313.9206) 1 "FIA",9002313.92,9002313.9206,.01) "FIA",9002313.92,9002313.9206,1) "FIA",9002313.92,9002313.92061) 0 "FIA",9002313.92,9002313.9207) 1 "FIA",9002313.92,9002313.9207,.01) "FIA",9002313.92,9002313.9207,1) "FIA",9002313.92,9002313.92071) 0 "FIA",9002313.92,9002313.9208) 1 "FIA",9002313.92,9002313.9208,.01) "FIA",9002313.92,9002313.9208,1) "FIA",9002313.92,9002313.92081) 0 "FIA",9002313.92,9002313.9209) 1 "FIA",9002313.92,9002313.9209,.01) "FIA",9002313.92,9002313.9209,1) "FIA",9002313.92,9002313.92091) 0 "FIA",9002313.92,9002313.921) 1 "FIA",9002313.92,9002313.921,.01) "FIA",9002313.92,9002313.921,1) "FIA",9002313.92,9002313.9211) 0 "FIA",9002313.92,9002313.9213) 1 "FIA",9002313.92,9002313.9213,.01) "FIA",9002313.92,9002313.9213,1) "FIA",9002313.92,9002313.92131) 0 "FIA",9002313.92,9002313.9214) 1 "FIA",9002313.92,9002313.9214,.01) "FIA",9002313.92,9002313.9214,1) "FIA",9002313.92,9002313.92141) 0 "FIA",9002313.92,9002313.9215) 1 "FIA",9002313.92,9002313.9215,.01) "FIA",9002313.92,9002313.9215,1) "FIA",9002313.92,9002313.92151) 0 "FIA",9002313.92,9002313.9216) 1 "FIA",9002313.92,9002313.9216,.01) "FIA",9002313.92,9002313.9216,1) "FIA",9002313.92,9002313.92161) 0 "FIA",9002313.92,9002313.9217) 1 "FIA",9002313.92,9002313.9217,.01) "FIA",9002313.92,9002313.9217,1) "FIA",9002313.92,9002313.92171) 0 "FIA",9002313.92,9002313.9218) 1 "FIA",9002313.92,9002313.9218,.01) "FIA",9002313.92,9002313.9218,1) "FIA",9002313.92,9002313.92181) 0 "FIA",9002313.92,9002313.9219) 1 "FIA",9002313.92,9002313.9219,.01) "FIA",9002313.92,9002313.9219,1) "FIA",9002313.92,9002313.92191) 0 "FIA",9002313.92,9002313.922) 1 "FIA",9002313.92,9002313.922,.01) "FIA",9002313.92,9002313.922,1) "FIA",9002313.92,9002313.9221) 0 "FIA",9002313.92,9002313.9223) 0 "FIA",9002313.92,9002313.92231) 0 "FIA",9002313.92,9002313.92232) 0 "FIA",9002313.92,9002313.9224) 0 "FIA",9002313.92,9002313.92241) 0 "FIA",9002313.92,9002313.92242) 0 "FIA",9002313.92,9002313.9225) 0 "FIA",9002313.92,9002313.92251) 0 "FIA",9002313.92,9002313.92252) 0 "FIA",9002313.93) BPS NCPDP REJECT CODES "FIA",9002313.93,0) ^BPSF(9002313.93, "FIA",9002313.93,0,0) 9002313.93I "FIA",9002313.93,0,1) y^y^f^^n^^y^o^n "FIA",9002313.93,0,10) "FIA",9002313.93,0,11) "FIA",9002313.93,0,"RLRO") "FIA",9002313.93,0,"VR") 1.0^BPS "FIA",9002313.93,9002313.93) 0 "FIA",9002313.94) BPS NCPDP FIELD CODES "FIA",9002313.94,0) ^BPS(9002313.94, "FIA",9002313.94,0,0) 9002313.94P "FIA",9002313.94,0,1) y^y^f^^n^^y^o^n "FIA",9002313.94,0,10) "FIA",9002313.94,0,11) "FIA",9002313.94,0,"RLRO") "FIA",9002313.94,0,"VR") 1.0^BPS "FIA",9002313.94,9002313.94) 0 "FIA",9002313.94,9002313.941) 0 "FIA",9002313.94,9002313.9412) 0 "FIA",9002313.99) BPS SETUP "FIA",9002313.99,0) ^BPS(9002313.99, "FIA",9002313.99,0,0) 9002313.99 "FIA",9002313.99,0,1) y^y^p^^^^n^^n "FIA",9002313.99,0,10) "FIA",9002313.99,0,11) "FIA",9002313.99,0,"RLRO") "FIA",9002313.99,0,"VR") 1.0^BPS "FIA",9002313.99,9002313.99) 1 "FIA",9002313.99,9002313.99,.08) "INI") PRE^BPS10PRE "INIT") POST^BPS10PST "IX",9002313.77,9002313.77,"AC",0) 9002313.77^AC^By the Process Flag^MU^^R^IR^I^9002313.77^^^^^S "IX",9002313.77,9002313.77,"AC",.1,0) ^^1^1^3080620^ "IX",9002313.77,9002313.77,"AC",.1,1,0) This index is used to retrieve entries with certain PROCESS FLAG value. "IX",9002313.77,9002313.77,"AC",1) S ^BPS(9002313.77,"AC",$E(X(1),1,30),$E(X(2),1,30),+$E(X(3),1,30),DA)=X(4) "IX",9002313.77,9002313.77,"AC",2) K ^BPS(9002313.77,"AC",$E(X(1),1,30),$E(X(2),1,30),+$E(X(3),1,30),DA) "IX",9002313.77,9002313.77,"AC",2.5) K ^BPS(9002313.77,"AC") "IX",9002313.77,9002313.77,"AC",11.1,0) ^.114IA^4^4 "IX",9002313.77,9002313.77,"AC",11.1,1,0) 1^F^9002313.77^.04^2^1^F "IX",9002313.77,9002313.77,"AC",11.1,2,0) 2^F^9002313.77^.01^10^2^F "IX",9002313.77,9002313.77,"AC",11.1,3,0) 3^F^9002313.77^.02^3^3^F "IX",9002313.77,9002313.77,"AC",11.1,4,0) 4^F^9002313.77^.03^^^F "IX",9002313.77,9002313.77,"AN",0) 9002313.77^AN^The Next Request^MU^^R^IR^I^9002313.77^^^^^S "IX",9002313.77,9002313.77,"AN",.1,0) ^^2^2^3080620^ "IX",9002313.77,9002313.77,"AN",.1,1,0) This index is used to determine the Next Request that needs to be "IX",9002313.77,9002313.77,"AN",.1,2,0) processed after the current is completed. "IX",9002313.77,9002313.77,"AN",1) I X(3)<3 S ^BPS(9002313.77,"AN",DA,$E(X(2),1,30))=X(3)_"^"_X(4)_"^"_X(5) "IX",9002313.77,9002313.77,"AN",2) K ^BPS(9002313.77,"AN",DA,$E(X(2),1,30)) "IX",9002313.77,9002313.77,"AN",2.5) K ^BPS(9002313.77,"AN") "IX",9002313.77,9002313.77,"AN",11.1,0) ^.114IA^5^5 "IX",9002313.77,9002313.77,"AN",11.1,1,0) 1^C^^^^1 "IX",9002313.77,9002313.77,"AN",11.1,1,1.5) S X=DA "IX",9002313.77,9002313.77,"AN",11.1,2,0) 2^F^9002313.77^.05^30^2^F "IX",9002313.77,9002313.77,"AN",11.1,3,0) 3^F^9002313.77^.04^2^^F "IX",9002313.77,9002313.77,"AN",11.1,4,0) 4^F^9002313.77^1.04^2^^F "IX",9002313.77,9002313.77,"AN",11.1,5,0) 5^F^9002313.77^.03^2^^F "IX",9002313.77,9002313.77,"D",0) 9002313.77^D^By Prescription #, Refill#, COB and Process Flag^R^^R^IR^I^9002313.77^^^^^LS "IX",9002313.77,9002313.77,"D",.1,0) ^^3^3^3080620^ "IX",9002313.77,9002313.77,"D",.1,1,0) This index is used to retrieve all requests by the Prescription #, the "IX",9002313.77,9002313.77,"D",.1,2,0) refill #, the type of the insurer (Primary/Secondary/Tertiary) and by the "IX",9002313.77,9002313.77,"D",.1,3,0) PROCESS FLAG value (request status). "IX",9002313.77,9002313.77,"D",1) S ^BPS(9002313.77,"D",X(1),X(2),X(3),X(4),DA)="" "IX",9002313.77,9002313.77,"D",2) K ^BPS(9002313.77,"D",X(1),X(2),X(3),X(4),DA) "IX",9002313.77,9002313.77,"D",2.5) K ^BPS(9002313.77,"D") "IX",9002313.77,9002313.77,"D",11.1,0) ^.114IA^4^4 "IX",9002313.77,9002313.77,"D",11.1,1,0) 1^F^9002313.77^.01^^1^F "IX",9002313.77,9002313.77,"D",11.1,2,0) 2^F^9002313.77^.02^^2^F "IX",9002313.77,9002313.77,"D",11.1,3,0) 3^F^9002313.77^.03^^3^F "IX",9002313.77,9002313.77,"D",11.1,4,0) 4^F^9002313.77^.04^^4^F "KRN",19,12248,-1) 2^2 "KRN",19,12248,0) BPS MENU RPT CLAIM STATUS^Claim Results and Status^^M^539^BPS REPORTS^^^^^^^^^^^1 "KRN",19,12248,10,0) ^19.01IP^32^32 "KRN",19,12248,10,32,0) 13425^SPA^93 "KRN",19,12248,10,32,"^") BPS RPT SPENDING ACCOUNT "KRN",19,12248,"U") CLAIM RESULTS AND STATUS "KRN",19,12851,-1) 0^4 "KRN",19,12851,0) BPS UNSTRAND SCREEN^View/Unstrand Submissions Not Completed^^R^^BPS MANAGER^^^^^^^^^ "KRN",19,12851,1,0) ^^7^7^3101006^ "KRN",19,12851,1,1,0) List Manager screen which permits users to see submissions that have not "KRN",19,12851,1,2,0) completed and have been in progress for one half hour or more. Users "KRN",19,12851,1,3,0) can then unstrand these submissions. In the case of billing "KRN",19,12851,1,4,0) requests and reversals, the submissions can be processed via the "KRN",19,12851,1,5,0) ECME user screen (i.e., reversed, resubmitted). For eligibility "KRN",19,12851,1,6,0) verification submissions, the submissions will unstrand to permit "KRN",19,12851,1,7,0) processing of subquent requests. "KRN",19,12851,15) "KRN",19,12851,25) EN^BPSUSCR "KRN",19,12851,99.1) 58154,30494 "KRN",19,12851,"U") VIEW/UNSTRAND SUBMISSIONS NOT "KRN",19,13425,-1) 0^1 "KRN",19,13425,0) BPS RPT SPENDING ACCOUNT^Spending Account Report^^R^^BPS REPORTS^^^^^^ "KRN",19,13425,1,0) ^^4^4^3110825^ "KRN",19,13425,1,1,0) This report lists ePharmacy claims sent to High Deductible Health Plans "KRN",19,13425,1,2,0) or plans with Health Spending Accounts. VA is not authorized to bill "KRN",19,13425,1,3,0) these types of plans. Please reverse the ePharmacy claims on this report "KRN",19,13425,1,4,0) and edit the Insurance file and mark the plan(s) "Will Not Reimburse". "KRN",19,13425,25) EN^BPSRPT0(8) "KRN",19,13425,"U") SPENDING ACCOUNT REPORT "KRN",101,35,-1) 0^4 "KRN",101,35,0) BPS PRTCL RSCH HIDDEN ACTIONS^ECME RESEARCH SCREEN HIDDEN ITEMS^^M^^^^^^^^ "KRN",101,35,4) 26^6 "KRN",101,35,10,0) ^101.01PA^18^18 "KRN",101,35,10,1,0) 442^+^11^ "KRN",101,35,10,1,"^") VALM NEXT SCREEN "KRN",101,35,10,2,0) 443^-^12^ "KRN",101,35,10,2,"^") VALM PREVIOUS SCREEN "KRN",101,35,10,3,0) 447^UP^13^ "KRN",101,35,10,3,"^") VALM UP ONE LINE "KRN",101,35,10,4,0) 448^DN^14^ "KRN",101,35,10,4,"^") VALM DOWN A LINE "KRN",101,35,10,5,0) 444^RD^24^ "KRN",101,35,10,5,"^") VALM REFRESH "KRN",101,35,10,6,0) 451^PS^25^ "KRN",101,35,10,6,"^") VALM PRINT SCREEN "KRN",101,35,10,7,0) 452^PL^26^ "KRN",101,35,10,7,"^") VALM PRINT LIST "KRN",101,35,10,8,0) 463^>^15^ "KRN",101,35,10,8,"^") VALM RIGHT "KRN",101,35,10,9,0) 464^<^16^ "KRN",101,35,10,9,"^") VALM LEFT "KRN",101,35,10,10,0) 454^ADPL^32^ "KRN",101,35,10,10,"^") VALM TURN ON/OFF MENUS "KRN",101,35,10,11,0) 456^SL^31^ "KRN",101,35,10,11,"^") VALM SEARCH LIST "KRN",101,35,10,12,0) 450^QU^34^ "KRN",101,35,10,12,"^") VALM QUIT "KRN",101,35,10,13,0) 445^LS^22^ "KRN",101,35,10,13,"^") VALM LAST SCREEN "KRN",101,35,10,14,0) 446^FS^21^ "KRN",101,35,10,14,"^") VALM FIRST SCREEN "KRN",101,35,10,15,0) 466^GO^23^ "KRN",101,35,10,15,"^") VALM GOTO PAGE "KRN",101,35,10,16,0) 44^ELIG^33^ "KRN",101,35,10,16,"^") BPS PRTCL RSCH ELIG INQ "KRN",101,35,10,17,0) 458^^35^ "KRN",101,35,10,17,"^") VALM BLANK 3 "KRN",101,35,10,18,0) 459^^36^ "KRN",101,35,10,18,"^") VALM BLANK 4 "KRN",101,35,99) 62097,65030 "KRN",101,44,-1) 0^5 "KRN",101,44,0) BPS PRTCL RSCH ELIG INQ^Eligibility Inquiry^^A^^^^^^^^E CLAIMS MGMT ENGINE "KRN",101,44,20) D RESED^BPSELG "KRN",101,44,99) 62097,65030 "KRN",101,442,-1) 0^6 "KRN",101,442,0) VALM NEXT SCREEN^Next Screen^^A^^^^^^^^LIST MANAGER "KRN",101,442,1,0) ^^2^2^2920519^^^ "KRN",101,442,1,1,0) This action will allow the user to view the next screen "KRN",101,442,1,2,0) of entries, if any exist. "KRN",101,442,2,0) ^101.02A^1^1 "KRN",101,442,2,1,0) NX "KRN",101,442,2,"B","NX",1) "KRN",101,442,15) "KRN",101,442,20) D NEXT^VALM4 "KRN",101,442,99) 62097,65030 "KRN",101,443,-1) 0^7 "KRN",101,443,0) VALM PREVIOUS SCREEN^Previous Screen^^A^^^^^^^^LIST MANAGER "KRN",101,443,1,0) ^^2^2^2920113^^ "KRN",101,443,1,1,0) This action will allow the user to view the previous screen "KRN",101,443,1,2,0) of entries, if any exist. "KRN",101,443,2,0) ^101.02A^3^2 "KRN",101,443,2,1,0) PR "KRN",101,443,2,2,0) BK "KRN",101,443,2,3,0) PR "KRN",101,443,2,"B","BK",2) "KRN",101,443,2,"B","PR",1) "KRN",101,443,2,"B","PR",3) "KRN",101,443,20) D PREV^VALM4 "KRN",101,443,99) 62097,65030 "KRN",101,444,-1) 0^10 "KRN",101,444,0) VALM REFRESH^Re-Display Screen^^A^^^^^^^^LIST MANAGER "KRN",101,444,1,0) ^^1^1^2911024^ "KRN",101,444,1,1,0) This actions allows the user to re-display the current screen. "KRN",101,444,2,0) ^101.02A^1^1 "KRN",101,444,2,1,0) RE "KRN",101,444,2,"B","RE",1) "KRN",101,444,10,0) ^101.01PA^0^0 "KRN",101,444,20) D RE^VALM4 "KRN",101,444,99) 62097,65030 "KRN",101,445,-1) 0^18 "KRN",101,445,0) VALM LAST SCREEN^Last Screen^^A^^^^^^^^LIST MANAGER "KRN",101,445,1,0) ^^1^1^2911026^ "KRN",101,445,1,1,0) The action will display the last items. "KRN",101,445,20) D LAST^VALM4 "KRN",101,445,99) 62097,65030 "KRN",101,446,-1) 0^19 "KRN",101,446,0) VALM FIRST SCREEN^First Screen^^A^^^^^^^^LIST MANAGER "KRN",101,446,1,0) ^^1^1^2960619^^ "KRN",101,446,1,1,0) This action will display the first screen. "KRN",101,446,15) "KRN",101,446,20) D FIRST^VALM4 "KRN",101,446,99) 62097,65030 "KRN",101,447,-1) 0^8 "KRN",101,447,0) VALM UP ONE LINE^Up a Line^^A^^^^^^^^LIST MANAGER "KRN",101,447,1,0) ^^1^1^2911027^ "KRN",101,447,1,1,0) Move up a line "KRN",101,447,20) D UP^VALM40 "KRN",101,447,99) 62097,65030 "KRN",101,448,-1) 0^9 "KRN",101,448,0) VALM DOWN A LINE^Down a Line^^A^^^^^^^^LIST MANAGER "KRN",101,448,1,0) ^^2^2^2950628^^ "KRN",101,448,1,1,0) Move down a line. "KRN",101,448,1,2,0) "KRN",101,448,3,0) ^101.03P^0^0 "KRN",101,448,20) D DOWN^VALM40 "KRN",101,448,99) 62097,65030 "KRN",101,450,-1) 0^17 "KRN",101,450,0) VALM QUIT^Quit^^A^^^^^^^^ "KRN",101,450,.1) "KRN",101,450,1,0) ^^1^1^2911105^ "KRN",101,450,1,1,0) This protocol can be used as a generic 'quit' action. "KRN",101,450,2,0) ^101.02A^2^2 "KRN",101,450,2,1,0) EXIT "KRN",101,450,2,2,0) QUIT "KRN",101,450,2,"B","EXIT",1) "KRN",101,450,2,"B","QUIT",2) "KRN",101,450,15) "KRN",101,450,20) Q "KRN",101,450,99) 62097,65030 "KRN",101,451,-1) 0^11 "KRN",101,451,0) VALM PRINT SCREEN^Print Screen^^A^^^^^^^^LIST MANAGER "KRN",101,451,1,0) ^^3^3^2920113^^ "KRN",101,451,1,1,0) This action allows the user to print the current List Manager "KRN",101,451,1,2,0) display screen. The header and the current portion of the "KRN",101,451,1,3,0) list are printed. "KRN",101,451,20) D PRT^VALM1 "KRN",101,451,99) 62097,65030 "KRN",101,452,-1) 0^12 "KRN",101,452,0) VALM PRINT LIST^Print List^^A^^^^^^^^LIST MANAGER "KRN",101,452,1,0) ^^2^2^2920113^ "KRN",101,452,1,1,0) This action allws the user to print the entire list of "KRN",101,452,1,2,0) entries currently being displayed. "KRN",101,452,20) D PRTL^VALM1 "KRN",101,452,99) 62097,65030 "KRN",101,454,-1) 0^15 "KRN",101,454,0) VALM TURN ON/OFF MENUS^Auto-Display(On/Off)^^A^^^^^^^^LIST MANAGER "KRN",101,454,20) D MENU^VALM2 "KRN",101,454,99) 62097,65030 "KRN",101,456,-1) 0^16 "KRN",101,456,0) VALM SEARCH LIST^Search List^^A^^^^^^^^LIST MANAGER "KRN",101,456,1,0) ^^1^1^2920303^^ "KRN",101,456,1,1,0) Finds text in list of entries. "KRN",101,456,20) D FIND^VALM40 "KRN",101,456,99) 62097,65030 "KRN",101,458,-1) 0^21 "KRN",101,458,0) VALM BLANK 3^^^A^^^^^^^^ "KRN",101,458,1,0) ^^1^1^2920203^ "KRN",101,458,1,1,0) This protocol is used to format spaces in menu lists. "KRN",101,459,-1) 0^22 "KRN",101,459,0) VALM BLANK 4^^^A^^^^^^^^ "KRN",101,459,1,0) ^^1^1^2920203^ "KRN",101,459,1,1,0) This protocol is used to format spaces in menu lists. "KRN",101,463,-1) 0^13 "KRN",101,463,0) VALM RIGHT^Shift View to Right^^A^^^^^^^^LIST MANAGER "KRN",101,463,20) D RIGHT^VALM40(XQORNOD(0)) "KRN",101,463,99) 62097,65030 "KRN",101,464,-1) 0^14 "KRN",101,464,0) VALM LEFT^Shift View to Left^^A^^^^^^^^LIST MANAGER "KRN",101,464,20) D LEFT^VALM40(XQORNOD(0)) "KRN",101,464,99) 62097,65030 "KRN",101,466,-1) 0^20 "KRN",101,466,0) VALM GOTO PAGE^Go to Page^^A^^^^^^^^LIST MANAGER "KRN",101,466,1,0) ^^1^1^2930113^ "KRN",101,466,1,1,0) "KRN",101,466,20) D GOTO^VALM40 "KRN",101,466,99) 62097,65030 "KRN",101,4003,-1) 0^1 "KRN",101,4003,0) BPS PRTCL UNSTRAND ALL^Unstrand Current Submissions^^A^^^^^^^^ "KRN",101,4003,2,0) ^101.02A^1^1 "KRN",101,4003,2,1,0) ALL "KRN",101,4003,2,"B","ALL",1) "KRN",101,4003,15) S VALMBCK="R" "KRN",101,4003,20) D ALL^BPSUSCR1 "KRN",101,4003,99) 62097,65033 "KRN",101,4004,-1) 0^3 "KRN",101,4004,0) BPS PRTCL UNSTRAND SELECT^Select Submissions to Unstrand^^A^^^^^^^^ "KRN",101,4004,2,0) ^101.02A^1^1 "KRN",101,4004,2,1,0) SEL "KRN",101,4004,2,"B","SEL",1) "KRN",101,4004,10,0) ^101.01PA^^0 "KRN",101,4004,15) S VALMBCK="R" "KRN",101,4004,20) D SELECT^BPSUSCR1 "KRN",101,4004,99) 62097,65033 "KRN",101,4005,-1) 0^2 "KRN",101,4005,0) BPS PRTCL UNSTRAND PRINT^Print Current Submissions^^A^^^^^^^^ "KRN",101,4005,15) S VALMBCK="R" "KRN",101,4005,20) D PRINT^BPSUSCR1 "KRN",101,4005,99) 62097,65033 "KRN",409.61,795,-1) 0^3 "KRN",409.61,795,0) BPS LSTMN ECME USRSCR^1^^80^6^18^0^1^LM template for User Screen^BPS PRTCL ECME USRSCR^PHARMACY ECME^1^^1 "KRN",409.61,795,1) ^BPS PRTCL USRSCR HIDDEN ACTIONS "KRN",409.61,795,"ARRAY") ^TMP("BPSSCR",$J,"VALM") "KRN",409.61,795,"COL",0) ^409.621^2^2 "KRN",409.61,795,"COL",1,0) CAPTION^5^76^PATIENT/DRUG/COMMENTS INSURANCE/NDC/FILL/RX#/ECME# STATUS/LOC/TYP/RXINF^^0 "KRN",409.61,795,"COL",2,0) LINENO^1^5^## "KRN",409.61,795,"COL","AIDENT",0,1) "KRN",409.61,795,"COL","B","CAPTION",1) "KRN",409.61,795,"COL","B","LINENO",2) "KRN",409.61,795,"FNL") D EXIT^BPSSCR "KRN",409.61,795,"HDR") D HDR^BPSSCR "KRN",409.61,795,"HLP") D HELP^BPSSCR "KRN",409.61,795,"INIT") D INIT^BPSSCR "KRN",409.61,796,-1) 0^4 "KRN",409.61,796,0) BPS LSTMN RSCH MENU^1^^80^6^18^0^1^LM template for research menu^BPS PRTCL RSCH MENU^FURTHER RESEARCH SCREEN^1^^1 "KRN",409.61,796,1) ^BPS PRTCL RSCH HIDDEN ACTIONS "KRN",409.61,796,"ARRAY") ^TMP("BPSSCR",$J,"VALM") "KRN",409.61,796,"COL",0) ^409.621^2^2 "KRN",409.61,796,"COL",1,0) LINENO^1^5^## "KRN",409.61,796,"COL",2,0) CAPTION^5^76^PATIENT/DRUG/COMMENTS INSURANCE/NDC/FILL/RX#/ECME# STATUS/LOC/TYP/RXINF "KRN",409.61,796,"COL","B","CAPTION",2) "KRN",409.61,796,"COL","B","LINENO",1) "KRN",409.61,796,"FNL") D EXIT^BPSRSM "KRN",409.61,796,"HDR") D HDR^BPSRSM "KRN",409.61,796,"HLP") D HELP^BPSRSM "KRN",409.61,796,"INIT") D INIT^BPSRSM "KRN",409.61,822,-1) 0^1 "KRN",409.61,822,0) BPS LSTMN ECME UNSTRAND^1^^150^6^18^0^1^LM Unstrand Screen Template^BPS PRTCL UNSTRAND^ECME UNSTRAND SUBMISSIONS^1^^1 "KRN",409.61,822,1) ^VALM HIDDEN ACTIONS "KRN",409.61,822,"ARRAY") ^TMP("BPSUSCR",$J) "KRN",409.61,822,"COL",0) ^409.621^8^8 "KRN",409.61,822,"COL",1,0) LINENO^1^3^ ##^^0 "KRN",409.61,822,"COL",2,0) TRANDT^5^10^Trans DT^^0 "KRN",409.61,822,"COL",3,0) PATNAME^16^20^Patient Name^^0 "KRN",409.61,822,"COL",4,0) PT ID^37^6^ID^^0 "KRN",409.61,822,"COL",5,0) RX#^42^12^Extern RX # "KRN",409.61,822,"COL",6,0) REFILL^55^2^RF^^0 "KRN",409.61,822,"COL",7,0) DOS^58^8^DOS^^0 "KRN",409.61,822,"COL",8,0) INSCO^69^20^Ins Co^^0 "KRN",409.61,822,"COL","AIDENT",0,1) "KRN",409.61,822,"COL","AIDENT",0,2) "KRN",409.61,822,"COL","AIDENT",0,3) "KRN",409.61,822,"COL","AIDENT",0,4) "KRN",409.61,822,"COL","AIDENT",0,6) "KRN",409.61,822,"COL","AIDENT",0,7) "KRN",409.61,822,"COL","AIDENT",0,8) "KRN",409.61,822,"COL","B","DOS",7) "KRN",409.61,822,"COL","B","INSCO",8) "KRN",409.61,822,"COL","B","LINENO",1) "KRN",409.61,822,"COL","B","PATNAME",3) "KRN",409.61,822,"COL","B","PT ID",4) "KRN",409.61,822,"COL","B","REFILL",6) "KRN",409.61,822,"COL","B","RX#",5) "KRN",409.61,822,"COL","B","TRANDT",2) "KRN",409.61,822,"FNL") D EXIT^BPSUSCR "KRN",409.61,822,"HDR") D HDR^BPSUSCR "KRN",409.61,822,"HLP") D HELP^BPSUSCR "KRN",409.61,822,"INIT") D INIT^BPSUSCR Q:$D(DUOUT) "KRN",409.61,844,-1) 0^2 "KRN",409.61,844,0) BPS LSTMN ECME REOPEN^1^^80^5^18^0^1^LM template for Reopen screen^BPS PRTCL REOPEN MENU^REOPEN CLOSED CLAIM^1^^1 "KRN",409.61,844,1) ^VALM HIDDEN ACTIONS "KRN",409.61,844,"ARRAY") ^TMP("BPSREOP",$J,"VALM") "KRN",409.61,844,"COL",0) ^409.621^2^2 "KRN",409.61,844,"COL",1,0) CAPTION^5^76^ DRUG NDC FILL RX# REF/ECME# LOC RX INFO "KRN",409.61,844,"COL",2,0) LINENO^1^5^## "KRN",409.61,844,"COL","B","CAPTION",1) "KRN",409.61,844,"COL","B","LINENO",2) "KRN",409.61,844,"FNL") D EXIT^BPSREOP "KRN",409.61,844,"HDR") D HDR^BPSREOP "KRN",409.61,844,"HLP") D HELP^BPSREOP "KRN",409.61,844,"INIT") D INIT^BPSREOP "MBREQ") 1 "ORD",0,9.8) 9.8;;1;RTNF^XPDTA;RTNE^XPDTA "ORD",0,9.8,0) ROUTINE "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",570,-1) 1^1 "PKG",570,0) E CLAIMS MGMT ENGINE^BPS^ELECTRONIC CLAIMS MGT "PKG",570,20,0) ^9.402P^^ "PKG",570,22,0) ^9.49I^1^1 "PKG",570,22,1,0) 1.0^3041008^3041108^66481 "PKG",570,22,1,"PAH",1,0) 10^3110830 "PKG",570,22,1,"PAH",1,1,0) ^^1^1^3110830 "PKG",570,22,1,"PAH",1,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 88 "RTN","BPS10PRE") 0^^B110781269 "RTN","BPS10PRE",1,0) BPS10PRE ;ALB/DMB - Pre-install for BPS*1.0*10 ;09/20/2010 "RTN","BPS10PRE",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**10**;JUN 2004;Build 27 "RTN","BPS10PRE",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPS10PRE",4,0) ; "RTN","BPS10PRE",5,0) Q "RTN","BPS10PRE",6,0) ; "RTN","BPS10PRE",7,0) PRE ; Entry Point for pre-install "RTN","BPS10PRE",8,0) D MES^XPDUTL(" Starting pre-install of BPS*1*10") "RTN","BPS10PRE",9,0) ; "RTN","BPS10PRE",10,0) ; Delete data dictionary structures "RTN","BPS10PRE",11,0) ; Update dictionaries with new identifiers to prevent duplicate IENs "RTN","BPS10PRE",12,0) D DICT,DFIELDS,FIELDS("NFLDS"),REJECTS("NRJCT"),RFIELDS "RTN","BPS10PRE",13,0) ; "RTN","BPS10PRE",14,0) D MES^XPDUTL(" Finished pre-install of BPS*1*10") "RTN","BPS10PRE",15,0) Q "RTN","BPS10PRE",16,0) ; "RTN","BPS10PRE",17,0) DICT ;Delete data dictionaries so that corrected ones can be installed in their place "RTN","BPS10PRE",18,0) N DIU "RTN","BPS10PRE",19,0) D MES^XPDUTL(" - Removing files that will be rebuilt") "RTN","BPS10PRE",20,0) S DIU=9002313.02,DIU(0)="" D EN^DIU2 K DIU ; BPS Claims "RTN","BPS10PRE",21,0) S DIU=9002313.03,DIU(0)="" D EN^DIU2 K DIU ; BPS Responses "RTN","BPS10PRE",22,0) D MES^XPDUTL(" - Done with files") "RTN","BPS10PRE",23,0) D MES^XPDUTL(" ") "RTN","BPS10PRE",24,0) Q "RTN","BPS10PRE",25,0) ; "RTN","BPS10PRE",26,0) DFIELDS ;Update changed dictionary entries "RTN","BPS10PRE",27,0) N LINE,DATA,NUM,NAME,DA,DIE,DR,CNT,DCT,FLDNUM "RTN","BPS10PRE",28,0) D MES^XPDUTL(" - Updating dictionaries values") "RTN","BPS10PRE",29,0) S CNT=0 "RTN","BPS10PRE",30,0) F LINE=1:1 S DATA=$P($T(DFLDS+LINE),";;",2,99) Q:DATA="" D "RTN","BPS10PRE",31,0) . S NUM=$P(DATA,";",1),DCT=$P(DATA,";",3),FLDNUM=$P(DATA,";",4) "RTN","BPS10PRE",32,0) . S DA=$O(^BPS(DCT,"B",NUM,"")) "RTN","BPS10PRE",33,0) . I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q "RTN","BPS10PRE",34,0) . S DIE=DCT,NAME=$P(DATA,";",2),DR=FLDNUM_"////"_NAME,CNT=CNT+1 "RTN","BPS10PRE",35,0) . D ^DIE "RTN","BPS10PRE",36,0) D MES^XPDUTL(" - "_CNT_" entries updated") "RTN","BPS10PRE",37,0) D MES^XPDUTL(" - Done with updating dictionaries values") "RTN","BPS10PRE",38,0) D MES^XPDUTL(" ") "RTN","BPS10PRE",39,0) Q "RTN","BPS10PRE",40,0) ; "RTN","BPS10PRE",41,0) DFLDS ; "RTN","BPS10PRE",42,0) ;;9;SUBSTITUTION ALLOWED BY PRESCRIBER BUT PLAN REQUESTS BRAND;9002313.24;1 "RTN","BPS10PRE",43,0) ;;4;EXEMPT FROM COPAY/COINSURANCE;9002313.26;.02 "RTN","BPS10PRE",44,0) ;;DA;DRUG-ALLERGY;9002313.23;1 "RTN","BPS10PRE",45,0) ;;DC;DRUG-DISEASE (INFERRED);9002313.23;1 "RTN","BPS10PRE",46,0) ;;DS;TOBACCO USE;9002313.23;1 "RTN","BPS10PRE",47,0) ;;ER;OVERUSE;9002313.23;1 "RTN","BPS10PRE",48,0) ;;HD;HIGH DOSE;9002313.23;1 "RTN","BPS10PRE",49,0) ;;IC;IATROGENIC CONDITION;9002313.23;1 "RTN","BPS10PRE",50,0) ;;LD;LOW DOSE;9002313.23;1 "RTN","BPS10PRE",51,0) ;;LR;UNDERUSE;9002313.23;1 "RTN","BPS10PRE",52,0) ;;MC;DRUG-DISEASE (REPORTED);9002313.23;1 "RTN","BPS10PRE",53,0) ;;MN;INSUFFICIENT DURATION;9002313.23;1 "RTN","BPS10PRE",54,0) ;;MX;EXCESSIVE DURATION;9002313.23;1 "RTN","BPS10PRE",55,0) ;;OH;ALCOHOL CONFLICT;9002313.23;1 "RTN","BPS10PRE",56,0) ;;PA;DRUG-AGE;9002313.23;1 "RTN","BPS10PRE",57,0) ;;PG;DRUG-PREGNANCY;9002313.23;1 "RTN","BPS10PRE",58,0) ;;PR;PRIOR ADVERSE REACTION;9002313.23;1 "RTN","BPS10PRE",59,0) ;;SE;SIDE EFFECT;9002313.23;1 "RTN","BPS10PRE",60,0) ;;SX;DRUG-GENDER;9002313.23;1 "RTN","BPS10PRE",61,0) ;;TD;THERAPEUTIC;9002313.23;1 "RTN","BPS10PRE",62,0) ;;3H;FOLLOW-UP/REPORT;9002313.22;1 "RTN","BPS10PRE",63,0) ;;1;PROOF OF ELIGIBILITY UNKNOWN;9002313.29;.02 "RTN","BPS10PRE",64,0) ;;3;AUTHORIZATION DELAYS;9002313.29;.02 "RTN","BPS10PRE",65,0) ;;4;DELAY IN CERTIFYING PROVIDER;9002313.29;.02 "RTN","BPS10PRE",66,0) ;;5;DELAY - BILLING FORMS;9002313.29;.02 "RTN","BPS10PRE",67,0) ;;6;DELAY - CUSTOM-MADE APPLIANCES;9002313.29;.02 "RTN","BPS10PRE",68,0) ;;7;THIRD PARTY PROCESSING DELAY;9002313.29;.02 "RTN","BPS10PRE",69,0) ;;9;ORIGINAL CLAIMS REJECTED;9002313.29;.02 "RTN","BPS10PRE",70,0) ;;10;ADMIN DELAY IN PRIOR APPROVAL;9002313.29;.02 "RTN","BPS10PRE",71,0) ;;12;RECEIVED LATE W/ NO EXCEPTIONS;9002313.29;.02 "RTN","BPS10PRE",72,0) ;;13;DAMAGE TO PROVIDER RECORDS;9002313.29;.02 "RTN","BPS10PRE",73,0) ;;14;THEFT/OTHER ACTS BY EMPLOYEE;9002313.29;.02 "RTN","BPS10PRE",74,0) ;;4;ASSISTED LIVING FACILITY;9002313.27;.02 "RTN","BPS10PRE",75,0) ;;5;CUSTODIAL CARE FACILITY;9002313.27;.02 "RTN","BPS10PRE",76,0) ;;6;GROUP HOME;9002313.27;.02 "RTN","BPS10PRE",77,0) ;;7;INPATIENT PSYCHIATRIC FACILITY;9002313.27;.02 "RTN","BPS10PRE",78,0) ;;9;INTERMEDIATE CARE FACILITY;9002313.27;.02 "RTN","BPS10PRE",79,0) ;;10;SUBSTANCE ABUSE FACILITY;9002313.27;.02 "RTN","BPS10PRE",80,0) ;;13;INPATIENT REHAB FACILITY;9002313.27;.02 "RTN","BPS10PRE",81,0) ;;15;CORRECTIONAL INSTITUTION;9002313.27;.02 "RTN","BPS10PRE",82,0) ;;1;COMMUNITY/RETAIL;9002313.28;.02 "RTN","BPS10PRE",83,0) ;;3;HOME INFUSION THERAPY;9002313.28;.02 "RTN","BPS10PRE",84,0) ;;5;LONG TERM CARE;9002313.28;.02 "RTN","BPS10PRE",85,0) ;;7;MANAGED CARE ORGANIZATION;9002313.28;.02 "RTN","BPS10PRE",86,0) ;;8;SPECIALTY CARE;9002313.28;.02 "RTN","BPS10PRE",87,0) ;; "RTN","BPS10PRE",88,0) ; "RTN","BPS10PRE",89,0) FIELDS(LABEL) ; Update Field Defs with new descriptions "RTN","BPS10PRE",90,0) N LINE,DATA,NUM,NAME,DA,DIE,DR,CNT "RTN","BPS10PRE",91,0) D MES^XPDUTL(" - Updating BPS NCPDP FIELD DEFS") "RTN","BPS10PRE",92,0) S CNT=0 "RTN","BPS10PRE",93,0) F LINE=1:1 S DATA=$P($T(@LABEL+LINE),";;",2,99) Q:DATA="" D "RTN","BPS10PRE",94,0) . S NUM=$P(DATA,";",1) "RTN","BPS10PRE",95,0) . S DA=$O(^BPSF(9002313.91,"B",NUM,"")) "RTN","BPS10PRE",96,0) . I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q "RTN","BPS10PRE",97,0) . S DIE=9002313.91,NAME=$P(DATA,";",2),DR=".03////^S X=NAME",CNT=CNT+1 "RTN","BPS10PRE",98,0) . D ^DIE "RTN","BPS10PRE",99,0) D MES^XPDUTL(" - "_CNT_" entries updated") "RTN","BPS10PRE",100,0) D MES^XPDUTL(" - Done with BPS NCPDP FIELD DEFS") "RTN","BPS10PRE",101,0) D MES^XPDUTL(" ") "RTN","BPS10PRE",102,0) Q "RTN","BPS10PRE",103,0) ; "RTN","BPS10PRE",104,0) NFLDS ; New field names "RTN","BPS10PRE",105,0) ;;301;GROUP ID "RTN","BPS10PRE",106,0) ;;302;CARDHOLDER ID "RTN","BPS10PRE",107,0) ;;305;PATIENT GENDER CODE "RTN","BPS10PRE",108,0) ;;306;PATIENT RELATIONSHIP CODE "RTN","BPS10PRE",109,0) ;;307;PLACE OF SERVICE "RTN","BPS10PRE",110,0) ;;318;EMPLOYER STATE/PROV ADDRESS "RTN","BPS10PRE",111,0) ;;319;EMPLOYER ZIP/POSTAL ZONE "RTN","BPS10PRE",112,0) ;;323;PATIENT CITY ADDRESS "RTN","BPS10PRE",113,0) ;;324;PATIENT STATE/PROVINCE ADDRESS "RTN","BPS10PRE",114,0) ;;325;PATIENT ZIP/POSTAL ZONE "RTN","BPS10PRE",115,0) ;;327;CARRIER ID "RTN","BPS10PRE",116,0) ;;330;ALTERNATE ID "RTN","BPS10PRE",117,0) ;;337;COB/OTHER PAYMENTS COUNT "RTN","BPS10PRE",118,0) ;;342;OTHER PAYER AMT PAID QUALIFIER "RTN","BPS10PRE",119,0) ;;346;BASIS OF CALC - DISPENSING FEE "RTN","BPS10PRE",120,0) ;;349;BASIS OF CALC - % SALES TAX "RTN","BPS10PRE",121,0) ;;351;OTHER PAYER-PAT RESP AMT QLFR "RTN","BPS10PRE",122,0) ;;401;DATE OF SERVICE "RTN","BPS10PRE",123,0) ;;402;PRESCRIPTION/SERVICE REF NO "RTN","BPS10PRE",124,0) ;;403;FILL NUMBER "RTN","BPS10PRE",125,0) ;;408;DAW PRODUCT SELECTION CODE "RTN","BPS10PRE",126,0) ;;415;NUMBER OF REFILLS AUTHORIZED "RTN","BPS10PRE",127,0) ;;420;SUBMISSION CLARIFICATION CODE "RTN","BPS10PRE",128,0) ;;421;PRIMARY CARE PROVIDER ID "RTN","BPS10PRE",129,0) ;;426;USUAL AND CUSTOMARY CHARGE "RTN","BPS10PRE",130,0) ;;429;SPECIAL PACKAGING INDICATOR "RTN","BPS10PRE",131,0) ;;435;CLAIM/REFERENCE ID "RTN","BPS10PRE",132,0) ;;436;PRODUCT/SERVICE ID QUALIFIER "RTN","BPS10PRE",133,0) ;;439;REASON FOR SERVICE CODE "RTN","BPS10PRE",134,0) ;;440;PROFESSIONAL SERVICE CODE "RTN","BPS10PRE",135,0) ;;441;RESULT OF SERVICE CODE "RTN","BPS10PRE",136,0) ;;443;OTHER PAYER DATE "RTN","BPS10PRE",137,0) ;;446;ORIGINALLY PRESCRIBED QUANTITY "RTN","BPS10PRE",138,0) ;;447;COMPOUND INGREDIENT COMP COUNT "RTN","BPS10PRE",139,0) ;;448;COMPOUND INGREDIENT QUANTITY "RTN","BPS10PRE",140,0) ;;449;COMPOUND INGREDIENT DRUG COST "RTN","BPS10PRE",141,0) ;;450;COMPOUND DOSAGE FORM DESC CODE "RTN","BPS10PRE",142,0) ;;451;COMPOUND DISP UNIT FORM INDCTR "RTN","BPS10PRE",143,0) ;;452;COMPOUND ROUTE OF ADMIN "RTN","BPS10PRE",144,0) ;;455;PRESCRIPTION/SERV REF NO QLFR "RTN","BPS10PRE",145,0) ;;456;ASSOC PRESCRIPTION/SERV REF NO "RTN","BPS10PRE",146,0) ;;457;ASSOC PRESCRIPTION/SERV DATE "RTN","BPS10PRE",147,0) ;;462;PRIOR AUTH NUMBER SUBMITTED "RTN","BPS10PRE",148,0) ;;463;INTERMEDIARY AUTH TYPE ID "RTN","BPS10PRE",149,0) ;;468;PRIMARY CARE PROVIDER ID QLFR "RTN","BPS10PRE",150,0) ;;477;PROF SERVICE FEE SUBMITTED "RTN","BPS10PRE",151,0) ;;478;OTHER AMT CLAIMED SBMTTD COUNT "RTN","BPS10PRE",152,0) ;;479;OTHER AMT CLAIMED SUBM QLFR "RTN","BPS10PRE",153,0) ;;480;OTHER AMT CLAIMED SUBMITTED "RTN","BPS10PRE",154,0) ;;481;FLAT SALES TAX AMT SUBMITTED "RTN","BPS10PRE",155,0) ;;482;PERCENT SALES TAX AMT SBMTTD "RTN","BPS10PRE",156,0) ;;483;PERCENT SALES TAX RATE SBMTTD "RTN","BPS10PRE",157,0) ;;484;PERCENT SALES TAX BASIS SBMTTD "RTN","BPS10PRE",158,0) ;;488;COMPOUND PRODUCT ID QUALIFIER "RTN","BPS10PRE",159,0) ;;489;COMPOUND PRODUCT ID "RTN","BPS10PRE",160,0) ;;490;COMP INGRED BASIS COST DETERM "RTN","BPS10PRE",161,0) ;;494;MEASUREMENT DATE "RTN","BPS10PRE",162,0) ;;495;MEASUREMENT TIME "RTN","BPS10PRE",163,0) ;;496;MEASUREMENT DIMENSION "RTN","BPS10PRE",164,0) ;;497;MEASUREMENT UNIT "RTN","BPS10PRE",165,0) ;;498.05;AUTHORIZED REP FIRST NAME "RTN","BPS10PRE",166,0) ;;498.07;AUTHORIZED REP STREET ADDRESS "RTN","BPS10PRE",167,0) ;;498.09;AUTHORIZED REP STATE/PROV ADDR "RTN","BPS10PRE",168,0) ;;498.11;AUTHORIZED REP ZIP/POSTAL ZONE "RTN","BPS10PRE",169,0) ;;498.13;PRIOR AUTH SUPPORTING DOCUMENT "RTN","BPS10PRE",170,0) ;;498.14;PRIOR AUTH NUMBER-ASSIGNED "RTN","BPS10PRE",171,0) ;;498.52;PRIOR AUTH EFFECTIVE DATE "RTN","BPS10PRE",172,0) ;;498.53;PRIOR AUTH EXPIRATION DATE "RTN","BPS10PRE",173,0) ;;498.54;PRIOR AUTH NO REFILLS AUTH "RTN","BPS10PRE",174,0) ;;498.55;PRIOR AUTH QTY ACCUMULATED "RTN","BPS10PRE",175,0) ;;498.57;PRIOR AUTHORIZATION QUANTITY "RTN","BPS10PRE",176,0) ;;498.58;PRIOR AUTH DOLLARS AUTHORIZED "RTN","BPS10PRE",177,0) ;;499;MEASUREMENT VALUE "RTN","BPS10PRE",178,0) ;;503;AUTHORIZATION NUMBER "RTN","BPS10PRE",179,0) ;;512;ACCUMULATED DEDUCTIBLE AMOUNT "RTN","BPS10PRE",180,0) ;;513;REMAINING DEDUCTIBLE AMOUNT "RTN","BPS10PRE",181,0) ;;514;REMAINING BENEFIT AMOUNT "RTN","BPS10PRE",182,0) ;;517;AMT APPLIED TO PERIODIC DEDUCT "RTN","BPS10PRE",183,0) ;;518;AMOUNT OF COPAY "RTN","BPS10PRE",184,0) ;;519;AMT ATTRIBUTED TO PRODUCT SEL "RTN","BPS10PRE",185,0) ;;520;AMOUNT EXCEEDING PERIODIC MAX "RTN","BPS10PRE",186,0) ;;522;BASIS OF REIMB DETERMINATION "RTN","BPS10PRE",187,0) ;;523;AMOUNT ATTRIBUTED TO SALES TAX "RTN","BPS10PRE",188,0) ;;526;ADDITIONAL MESSAGE INFORMATION "RTN","BPS10PRE",189,0) ;;546;REJECTED FLD OCCURRENCE INDCTR "RTN","BPS10PRE",190,0) ;;555;PREF PRODUCT COST SHARE INCNTV "RTN","BPS10PRE",191,0) ;;559;PERCENTAGE SALES TAX AMT PAID "RTN","BPS10PRE",192,0) ;;560;PERCENTAGE SALES TAX RATE PAID "RTN","BPS10PRE",193,0) ;;561;PERCENT SALES TAX BASIS PAID "RTN","BPS10PRE",194,0) ;;600;UNIT OF MEASURE "RTN","BPS10PRE",195,0) ;; "RTN","BPS10PRE",196,0) ; "RTN","BPS10PRE",197,0) REJECTS(LABEL) ; Update Reject Codes with new explanations "RTN","BPS10PRE",198,0) N LINE,DATA,NUM,NAME,DA,DIE,DR,CNT "RTN","BPS10PRE",199,0) D MES^XPDUTL(" - Updating BPS NCPDP REJECT CODES") "RTN","BPS10PRE",200,0) S CNT=0 "RTN","BPS10PRE",201,0) F LINE=1:1 S DATA=$P($T(@LABEL+LINE),";;",2,99) Q:DATA="" D "RTN","BPS10PRE",202,0) . S DIE=9002313.93,NUM=$P(DATA,";",1) "RTN","BPS10PRE",203,0) . S DA=$O(^BPSF(DIE,"B",NUM,"")) "RTN","BPS10PRE",204,0) . I 'DA Q ; quit if no IEN found for entry "RTN","BPS10PRE",205,0) . S NAME=$P(DATA,";",2),DR=".02////^S X=NAME",CNT=CNT+1 "RTN","BPS10PRE",206,0) . D ^DIE "RTN","BPS10PRE",207,0) D MES^XPDUTL(" - "_CNT_" entries updated") "RTN","BPS10PRE",208,0) D MES^XPDUTL(" - Done with BPS NCPDP REJECT CODES") "RTN","BPS10PRE",209,0) D MES^XPDUTL(" ") "RTN","BPS10PRE",210,0) Q "RTN","BPS10PRE",211,0) ; "RTN","BPS10PRE",212,0) NRJCT ; New reject explanations "RTN","BPS10PRE",213,0) ;;70;Product/Service Not Covered - Plan/Benefit Exclusion "RTN","BPS10PRE",214,0) ;;232;Smoker/Non-Smoker Code is not used for this Transaction Code "RTN","BPS10PRE",215,0) ;;288;Patient Assignment Indicator is not used for this Trans Code "RTN","BPS10PRE",216,0) ;;474;Prescriber Id Qualifier Does Not Precede Prescriber ID "RTN","BPS10PRE",217,0) ;;489;DUR Co-Agent ID Qualifier Does Not Precede DUR Co-Agent ID "RTN","BPS10PRE",218,0) ;;491;Compound Product ID Qualifier Does Not Precede Compound Product ID "RTN","BPS10PRE",219,0) ;;537;Patient Assignment Indicator Value Not Supported "RTN","BPS10PRE",220,0) ;;553;Smoker/Non-Smoker Code Value Not Supported "RTN","BPS10PRE",221,0) ;;557;COB Segment Present On A Non-COB Claim "RTN","BPS10PRE",222,0) ;;4R;Required Question Num/Letter Response for Indicated Document Missing "RTN","BPS10PRE",223,0) ;;6G;COB/Other Payments Segment Required For Adjudication "RTN","BPS10PRE",224,0) ;;7M;Discrepancy Between Other Coverage Code & Other Coverage Info On File "RTN","BPS10PRE",225,0) ;;7P;COB/Other Payments Count Exceeds Number of Supported Payers "RTN","BPS10PRE",226,0) ;;7T;Quantity Intended To Be Dispensed Required For Partial Fill Trans "RTN","BPS10PRE",227,0) ;;7U;Days Supply Intended To Be Dispensed Required For Partial Fill Trans "RTN","BPS10PRE",228,0) ;;8B;Compound Segment Missing On A Compound Claim "RTN","BPS10PRE",229,0) ;;8E;M/I DUR/PPS Level Of Effort "RTN","BPS10PRE",230,0) ;;8G;Product/Service ID (407-D7) Must Be A Single Zero '0' For Compounds "RTN","BPS10PRE",231,0) ;;9K;Compound Ingredient Component Cnt Exceeds Num Of Ingredients Supported "RTN","BPS10PRE",232,0) ;;G9;Pharmacy Not Contracted in 90 Day Retail Network "RTN","BPS10PRE",233,0) ;;MR;Product Not On Formulary "RTN","BPS10PRE",234,0) ;;N4;M/I Medicaid Subrogation Internal Ctrl Number/Transaction Ctrl Number "RTN","BPS10PRE",235,0) ;;RM;Compl Trans Not Permitted With Same 'Date Of Service' As Partial Trans "RTN","BPS10PRE",236,0) ;;RT;M/I Associated Prescription/Service Reference Number On Partial Trans "RTN","BPS10PRE",237,0) ;;T0;Accumulator Month Count Exceeds Number of Occurrences Supported "RTN","BPS10PRE",238,0) ;;UU;DAW 0 cannot be submitted on a multi-source drug w/available generics "RTN","BPS10PRE",239,0) ;;X3;Out of order Accumulator Months "RTN","BPS10PRE",240,0) ;;YA;Compound Ingredient Mod Code Cnt Exceeds Num Of Occurrences Supported "RTN","BPS10PRE",241,0) ;;YH;Clinical Information Counter Exceeds Number of Occurrences Supported "RTN","BPS10PRE",242,0) ;;Z6;Service Prov Segment Present On A non-Controlled Sub Reporting Trans "RTN","BPS10PRE",243,0) ;; "RTN","BPS10PRE",244,0) ; "RTN","BPS10PRE",245,0) RFIELDS ;Remove obsolete PROFESSIONAL SERVICE CODE "RTN","BPS10PRE",246,0) N LINE,DATA,NUM,DA,DIK,CNT,DCT "RTN","BPS10PRE",247,0) D MES^XPDUTL(" Deleting obsolete dictionary values") "RTN","BPS10PRE",248,0) S CNT=0 "RTN","BPS10PRE",249,0) F LINE=1:1 S DATA=$P($T(RFLDS+LINE),";;",2,99) Q:DATA="" D "RTN","BPS10PRE",250,0) . S NUM=$P(DATA,";",1),DIK=$P(DATA,";",2),DCT=$P(DATA,";",3) "RTN","BPS10PRE",251,0) . S DA=$O(^BPS(DCT,"B",NUM,"")) "RTN","BPS10PRE",252,0) . I 'DA D MES^XPDUTL(" - No IEN found for entry "_NUM) Q "RTN","BPS10PRE",253,0) . D ^DIK "RTN","BPS10PRE",254,0) . S CNT=CNT+1 "RTN","BPS10PRE",255,0) D MES^XPDUTL(" - "_CNT_" entries updated") "RTN","BPS10PRE",256,0) D MES^XPDUTL(" - Done with deleting obsolete dictionary values") "RTN","BPS10PRE",257,0) D MES^XPDUTL(" ") "RTN","BPS10PRE",258,0) Q "RTN","BPS10PRE",259,0) ; "RTN","BPS10PRE",260,0) RFLDS ; "RTN","BPS10PRE",261,0) ;;PF;^BPS(9002313.21,;9002313.21 "RTN","BPS10PRE",262,0) ;; "RTN","BPS10PRE",263,0) ; "RTN","BPS10PST") 0^^B73830145 "RTN","BPS10PST",1,0) BPS10PST ;ALB/DMB - Post-install for BPS*1.0*10 ;09/20/2010 "RTN","BPS10PST",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**10**;JUN 2004;Build 27 "RTN","BPS10PST",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPS10PST",4,0) ; "RTN","BPS10PST",5,0) ; Reference to ^DIK supported by IA 10013 "RTN","BPS10PST",6,0) ; Reference to VFIELD^DILFD supported by IA 2205 "RTN","BPS10PST",7,0) ; Reference to FILESEC^DDMOD supported by IA 2916 "RTN","BPS10PST",8,0) Q "RTN","BPS10PST",9,0) ; "RTN","BPS10PST",10,0) POST ; Entry Point for post-install "RTN","BPS10PST",11,0) D MES^XPDUTL(" Starting post-install of BPS*1*10") "RTN","BPS10PST",12,0) ; "RTN","BPS10PST",13,0) ; Update BPS Requests, BPS Claims, BPS Responses, and BPS NCPDP Formats "RTN","BPS10PST",14,0) ; Update Vitria Interface Version and do registration "RTN","BPS10PST",15,0) D REQUESTS,INSURER,CLAIMS,RESPONSE,TRANLOG,FORMATS,VERSION,DDSCRTY,CERTSUB,ASLEEP "RTN","BPS10PST",16,0) ; "RTN","BPS10PST",17,0) D MES^XPDUTL(" Finished post-install of BPS*1*10") "RTN","BPS10PST",18,0) Q "RTN","BPS10PST",19,0) ; "RTN","BPS10PST",20,0) REQUESTS ; Update BPS Requests "RTN","BPS10PST",21,0) D MES^XPDUTL(" - Updating BPS REQUESTS") "RTN","BPS10PST",22,0) N IEN,CNT,RXI,FILL,TYPE,SCC "RTN","BPS10PST",23,0) S CNT=0 "RTN","BPS10PST",24,0) S IEN=0 F S IEN=$O(^BPS(9002313.77,IEN)) Q:'IEN D "RTN","BPS10PST",25,0) . S RXI=$P($G(^BPS(9002313.77,IEN,0)),U,1) "RTN","BPS10PST",26,0) . S FILL=$P($G(^BPS(9002313.77,IEN,0)),U,2) "RTN","BPS10PST",27,0) . S TYPE=$P($G(^BPS(9002313.77,IEN,1)),U,4) "RTN","BPS10PST",28,0) . S SCC=$P($G(^BPS(9002313.77,IEN,2)),U,5) "RTN","BPS10PST",29,0) . I TYPE'="E" D "RTN","BPS10PST",30,0) .. S CNT=CNT+1 "RTN","BPS10PST",31,0) .. I SCC]"",$P($G(^BPS(9002313.77,IEN,1)),U,13)="" S $P(^BPS(9002313.77,IEN,2),U,5)=$P($G(^BPS(9002313.25,SCC,0)),U,1) "RTN","BPS10PST",32,0) .. S $P(^BPS(9002313.77,IEN,1),U,13,14)=RXI_U_FILL "RTN","BPS10PST",33,0) .. I $P(^BPS(9002313.77,IEN,1),U,15)="",RXI S $P(^BPS(9002313.77,IEN,1),U,15)=$$RXAPI1^BPSUTIL1(RXI,2,"I") "RTN","BPS10PST",34,0) .. I $P(^BPS(9002313.77,IEN,1),U,2)="",RXI,FILL'="" S $P(^BPS(9002313.77,IEN,1),U,2)=$$GETSITE^BPSOSRX8(RXI,FILL) "RTN","BPS10PST",35,0) D MES^XPDUTL(" ..."_CNT_" entries updated") "RTN","BPS10PST",36,0) D MES^XPDUTL(" - Done with BPS REQUESTS") "RTN","BPS10PST",37,0) D MES^XPDUTL(" ") "RTN","BPS10PST",38,0) Q "RTN","BPS10PST",39,0) ; "RTN","BPS10PST",40,0) INSURER ; Update BPS Insurer Data "RTN","BPS10PST",41,0) D MES^XPDUTL(" - Updating BPS INSURER DATA") "RTN","BPS10PST",42,0) N IEN,CNT "RTN","BPS10PST",43,0) S CNT=0 "RTN","BPS10PST",44,0) S IEN=0 F S IEN=$O(^BPS(9002313.78,IEN)) Q:'IEN D "RTN","BPS10PST",45,0) . S CNT=CNT+1 "RTN","BPS10PST",46,0) . S $P(^BPS(9002313.78,IEN,0),U,2)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,1)) "RTN","BPS10PST",47,0) . S $P(^BPS(9002313.78,IEN,0),U,3)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,2)) "RTN","BPS10PST",48,0) . S $P(^BPS(9002313.78,IEN,0),U,4)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,3)) "RTN","BPS10PST",49,0) . S $P(^BPS(9002313.78,IEN,0),U,10)=$$PAYIEN($P($G(^BPS(9002313.78,IEN,4)),U,4)) "RTN","BPS10PST",50,0) D MES^XPDUTL(" ..."_CNT_" entries updated") "RTN","BPS10PST",51,0) D MES^XPDUTL(" - Done with BPS INSURER DATA") "RTN","BPS10PST",52,0) D MES^XPDUTL(" ") "RTN","BPS10PST",53,0) Q "RTN","BPS10PST",54,0) ; "RTN","BPS10PST",55,0) PAYIEN(X) ; Get Payer Sheet IEN from the "B" X-ref "RTN","BPS10PST",56,0) ; Use reverse $O in case there is more than one (which should not happen) so "RTN","BPS10PST",57,0) ; we will get the one with the highest IEN "RTN","BPS10PST",58,0) I $G(X)="" Q "" "RTN","BPS10PST",59,0) Q $O(^BPSF(9002313.92,"B",X,""),-1) "RTN","BPS10PST",60,0) ; "RTN","BPS10PST",61,0) CLAIMS ; convert BPS CLAIMS (#9002313.02) "RTN","BPS10PST",62,0) ; "RTN","BPS10PST",63,0) D MES^XPDUTL(" - Converting data in BPS CLAIMS "_$$HTE^XLFDT($H)) "RTN","BPS10PST",64,0) N BPSCONV,BPSD0,BPSD1,BPSFDBCK,BPSTOTAL,C,DA,DIK,X "RTN","BPS10PST",65,0) S BPSD0=0,BPSCONV=0,BPSTOTAL=0,BPSFDBCK=0 "RTN","BPS10PST",66,0) F S BPSD0=$O(^BPSC(BPSD0)) Q:'BPSD0 D "RTN","BPS10PST",67,0) .S BPSTOTAL=BPSTOTAL+1,BPSD1=0,BPSFDBCK=BPSFDBCK+1 "RTN","BPS10PST",68,0) .F S BPSD1=$O(^BPSC(BPSD0,400,BPSD1)) Q:'BPSD1 S X=$P($G(^(BPSD1,400)),U,20) D:X]"" "RTN","BPS10PST",69,0) ..Q:$D(^BPSC(BPSD0,400,BPSD1,354.01,0)) ; already converted "RTN","BPS10PST",70,0) ..S $P(^BPSC(BPSD0,400,BPSD1,350),U,4)=1 ; (#354) SUBM CLARIFICATION CODE COUNT "RTN","BPS10PST",71,0) ..S ^BPSC(BPSD0,400,BPSD1,354.01,0)="^9002313.02354^1^1" ; (#354.01) SUBMISSION CLARIFICATION MLTPL "RTN","BPS10PST",72,0) ..S ^BPSC(BPSD0,400,BPSD1,354.01,1,0)=1,^(1)=X "RTN","BPS10PST",73,0) ..K DA S DIK="^BPSC("_BPSD0_",400,"_BPSD1_",354.01,",DA=1,DA(1)=BPSD1,DA(2)=BPSD0 D IX1^DIK "RTN","BPS10PST",74,0) ..S BPSCONV=BPSCONV+1 "RTN","BPS10PST",75,0) .; "RTN","BPS10PST",76,0) .I BPSFDBCK>4999 S BPSFDBCK=0 D MES^XPDUTL(" - Claim Entries Checked: "_$FN(BPSTOTAL,",")_" "_$$HTE^XLFDT($H)) "RTN","BPS10PST",77,0) ; "RTN","BPS10PST",78,0) S X=$FN(BPSTOTAL,",")_" Claim"_$E("s",BPSTOTAL'=1)_" checked and "_$FN(BPSCONV,",")_" converted." "RTN","BPS10PST",79,0) D MES^XPDUTL(" - "_$$HTE^XLFDT($H)),MES^XPDUTL(" - "_X) "RTN","BPS10PST",80,0) D MES^XPDUTL(" - done with BPS CLAIMS") "RTN","BPS10PST",81,0) D MES^XPDUTL(" ") "RTN","BPS10PST",82,0) ; "RTN","BPS10PST",83,0) Q "RTN","BPS10PST",84,0) ; "RTN","BPS10PST",85,0) RESPONSE ; convert BPS RESPONSES (#9002313.03) "RTN","BPS10PST",86,0) ; "RTN","BPS10PST",87,0) ; ^BPSR(D0,1000,D1,130.01,0)=^9002313.13001A^^ (#130.01) ADDITIONAL MESSAGE MLTPL "RTN","BPS10PST",88,0) ; ^BPSR(D0,1000,D1,130.01,D2,0)= (#.01) ADDITIONAL MESSAGE COUNTER [1N] ^ (#131) ADDITIONAL MSG INFO CONTINUITY [2F] ^ (#132) ADDITIONAL MSG INFO QUALIFIER [3F] ^ "RTN","BPS10PST",89,0) ; "RTN","BPS10PST",90,0) D MES^XPDUTL(" - Converting data in BPS RESPONSES "_$$HTE^XLFDT($H)) "RTN","BPS10PST",91,0) N BPSD0,BPSD1,BPSFDBCK,BPSRESP,BPSTOTAL,BPSX,DA,DIK,X,Y "RTN","BPS10PST",92,0) ; "RTN","BPS10PST",93,0) S BPSD0=0,BPSRESP=0,BPSTOTAL=0,BPSFDBCK=0 "RTN","BPS10PST",94,0) ; "RTN","BPS10PST",95,0) F S BPSD0=$O(^BPSR(BPSD0)) Q:'BPSD0 D "RTN","BPS10PST",96,0) .S BPSTOTAL=BPSTOTAL+1,BPSD1=0,BPSFDBCK=BPSFDBCK+1 "RTN","BPS10PST",97,0) .F S BPSD1=$O(^BPSR(BPSD0,1000,BPSD1)) Q:'BPSD1 S X=$P($G(^(BPSD1,526)),U) D:X]"" ; ADDITIONAL MESSAGE INFORMATION "RTN","BPS10PST",98,0) ..Q:$D(^BPSR(BPSD0,1000,BPSD1,130.01,0)) ; already converted "RTN","BPS10PST",99,0) ..; (#130.01) ADDITIONAL MESSAGE MLTPL "RTN","BPS10PST",100,0) ..S ^BPSR(BPSD0,1000,BPSD1,130.01,0)="^9002313.13001A^1^1" "RTN","BPS10PST",101,0) ..S ^BPSR(BPSD0,1000,BPSD1,130.01,1,0)="1^^01" ; NCPDP field 132-UH Additional Message Information Qualifier "RTN","BPS10PST",102,0) ..S ^BPSR(BPSD0,1000,BPSD1,130.01,1,1)=X ; ^BPSR(D0,1000,D1,130.01,D2,1)= (#526) ADDITIONAL MESSAGE INFO [1F] ^ "RTN","BPS10PST",103,0) ..K DA ; rebuild DA every time "RTN","BPS10PST",104,0) ..S DIK="^BPSR("_BPSD0_",1000,"_BPSD1_",130.01,",DA=1,DA(1)=BPSD1,DA(2)=BPSD0 "RTN","BPS10PST",105,0) ..D IX1^DIK "RTN","BPS10PST",106,0) ..; field #130 ADDITIONAL MESSAGE INFO COUNT "RTN","BPS10PST",107,0) ..; NCPDP field 130-UF Additional Message Information Count "RTN","BPS10PST",108,0) ..S $P(^BPSR(BPSD0,1000,BPSD1,120),U,10)=1 "RTN","BPS10PST",109,0) ..S BPSRESP=BPSRESP+1 ; total converted "RTN","BPS10PST",110,0) .; "RTN","BPS10PST",111,0) .I BPSFDBCK>4999 S BPSFDBCK=0 D MES^XPDUTL(" - Response Entries Checked: "_$FN(BPSTOTAL,",")_" "_$$HTE^XLFDT($H)) "RTN","BPS10PST",112,0) ; "RTN","BPS10PST",113,0) D MES^XPDUTL(" - "_$$HTE^XLFDT($H)) "RTN","BPS10PST",114,0) D MES^XPDUTL(" - "_$FN(BPSTOTAL,",")_" Response"_$E("s",BPSTOTAL'=1)_" checked") "RTN","BPS10PST",115,0) D MES^XPDUTL(" - Additional Message Info fields converted: "_$FN(BPSRESP,",")) "RTN","BPS10PST",116,0) D MES^XPDUTL(" - done with BPS RESPONSES") "RTN","BPS10PST",117,0) D MES^XPDUTL(" ") "RTN","BPS10PST",118,0) ; "RTN","BPS10PST",119,0) Q "RTN","BPS10PST",120,0) ; "RTN","BPS10PST",121,0) TRANLOG ; "RTN","BPS10PST",122,0) D MES^XPDUTL(" - Updating BPS LOG OF TRANSACTIONS") "RTN","BPS10PST",123,0) K ^BPSTL("NON-FILEMAN","RXIRXR") "RTN","BPS10PST",124,0) D MES^XPDUTL(" - Done with BPS LOG OF TRANSACTIONS") "RTN","BPS10PST",125,0) D MES^XPDUTL(" ") "RTN","BPS10PST",126,0) Q "RTN","BPS10PST",127,0) ; "RTN","BPS10PST",128,0) FORMATS ; Remove data from deleted fields "RTN","BPS10PST",129,0) ; Removing the following fields and deleting the data associated with the fields: "RTN","BPS10PST",130,0) ; 1.03 - MAXIMUM RX PER CLAIM "RTN","BPS10PST",131,0) ; 1.07 - FORMAT IS FOR REVERSAL "RTN","BPS10PST",132,0) ; 1.13 - SOFTWARE VENDOR CERT ID "RTN","BPS10PST",133,0) ; 1001 - REVERSAL FORMAT "RTN","BPS10PST",134,0) ; "RTN","BPS10PST",135,0) D MES^XPDUTL(" - Updating BPS NCPDP FORMATS") "RTN","BPS10PST",136,0) ; "RTN","BPS10PST",137,0) ; Check if the fields have already been removed "RTN","BPS10PST",138,0) ; IA 2205 "RTN","BPS10PST",139,0) I '$$VFIELD^DILFD(9002313.92,1.03),'$$VFIELD^DILFD(9002313.92,1.07),'$$VFIELD^DILFD(9002313.92,1.13),'$$VFIELD^DILFD(9002313.92,1001) D MES^XPDUTL(" ... Data and Fields already removed. No further action.") G FEND "RTN","BPS10PST",140,0) ; "RTN","BPS10PST",141,0) ; Delete the data first "RTN","BPS10PST",142,0) N IEN,PIECE,DIK,DA "RTN","BPS10PST",143,0) S IEN=0 "RTN","BPS10PST",144,0) F S IEN=$O(^BPSF(9002313.92,IEN)) Q:'IEN D "RTN","BPS10PST",145,0) . ; Remove Max Transactions, Reversal Format, and Certification ID "RTN","BPS10PST",146,0) . F PIECE=3,7,13 S $P(^BPSF(9002313.92,IEN,1),U,PIECE)="" "RTN","BPS10PST",147,0) . ; Remove Reversal Format Field. Kill entire node as this is the only field "RTN","BPS10PST",148,0) . ; on the node "RTN","BPS10PST",149,0) . K ^BPSF(9002313.92,IEN,"REVERSAL") "RTN","BPS10PST",150,0) ; "RTN","BPS10PST",151,0) ; Delete the fields from the data defintion "RTN","BPS10PST",152,0) ; IA 10013 "RTN","BPS10PST",153,0) S DIK="^DD(9002313.92," "RTN","BPS10PST",154,0) S DA(1)=9002313.92 "RTN","BPS10PST",155,0) F DA=1.03,1.07,1.13,1001 D ^DIK "RTN","BPS10PST",156,0) ; "RTN","BPS10PST",157,0) D MES^XPDUTL(" - Done with BPS NCPDP FORMATS") "RTN","BPS10PST",158,0) FEND ; "RTN","BPS10PST",159,0) D MES^XPDUTL(" ") "RTN","BPS10PST",160,0) Q "RTN","BPS10PST",161,0) ; "RTN","BPS10PST",162,0) VERSION ; Update Vitria Interface Version and do automatic registration "RTN","BPS10PST",163,0) D MES^XPDUTL(" Updating Interface Version and running registration") "RTN","BPS10PST",164,0) S $P(^BPS(9002313.99,1,"VITRIA"),U,3)=4 "RTN","BPS10PST",165,0) D TASKMAN^BPSJAREG "RTN","BPS10PST",166,0) D MES^XPDUTL(" ") "RTN","BPS10PST",167,0) Q "RTN","BPS10PST",168,0) ; "RTN","BPS10PST",169,0) DDSCRTY ; update the Data Dictionary Security "RTN","BPS10PST",170,0) ; "RTN","BPS10PST",171,0) D MES^XPDUTL(" - updating file security for BPS* files") "RTN","BPS10PST",172,0) N BPSCRTY,BPSERR,BPSFILE,BPSL,V,X "RTN","BPS10PST",173,0) S BPSFILE=9002313.77 ; BPS REQUESTS, update all security "RTN","BPS10PST",174,0) S BPSCRTY("DD")="@" "RTN","BPS10PST",175,0) S BPSCRTY("RD")="Pp" "RTN","BPS10PST",176,0) S BPSCRTY("WR")="@" "RTN","BPS10PST",177,0) S BPSCRTY("DEL")="@" "RTN","BPS10PST",178,0) S BPSCRTY("LAYGO")="@" "RTN","BPS10PST",179,0) S BPSCRTY("AUDIT")="@" "RTN","BPS10PST",180,0) D FILESEC^DDMOD(BPSFILE,.BPSCRTY,"BPSERR") "RTN","BPS10PST",181,0) I $D(BPSERR) D "RTN","BPS10PST",182,0) .D MES^XPDUTL(" - error returned while updating File Security, file #"_BPSFILE) "RTN","BPS10PST",183,0) .S V="BPSERR" F S V=$Q(@V) Q:V="" D MES^XPDUTL(" - error message: "_@V) "RTN","BPS10PST",184,0) ; "RTN","BPS10PST",185,0) ; update Read access for existing BPS files "RTN","BPS10PST",186,0) F BPSL=1:1 S X=$P($T(DDSECFL+BPSL),";;",2) Q:X="" D "RTN","BPS10PST",187,0) .K BPSERR,BPSCRTY "RTN","BPS10PST",188,0) .S BPSFILE=$P(X,";"),BPSCRTY("RD")="Pp" "RTN","BPS10PST",189,0) .D FILESEC^DDMOD(BPSFILE,.BPSCRTY,"BPSERR") Q:'$D(BPSERR) "RTN","BPS10PST",190,0) .D MES^XPDUTL(" - error returned while updating File Security, file #"_BPSFILE) "RTN","BPS10PST",191,0) .S V="BPSERR" F S V=$Q(@V) Q:V="" D MES^XPDUTL(" - error message: "_@V) "RTN","BPS10PST",192,0) ; "RTN","BPS10PST",193,0) D MES^XPDUTL(" - done updating file security") "RTN","BPS10PST",194,0) ; "RTN","BPS10PST",195,0) Q "RTN","BPS10PST",196,0) ; "RTN","BPS10PST",197,0) DDSECFL ; files to update security "RTN","BPS10PST",198,0) ;;9002313.21;BPS NCPDP PROFESSIONAL SERVICE CODE "RTN","BPS10PST",199,0) ;;9002313.22;BPS NCPDP RESULT OF SERVICE CODE "RTN","BPS10PST",200,0) ;;9002313.23;BPS NCPDP REASON FOR SERVICE CODE "RTN","BPS10PST",201,0) ;;9002313.24;BPS NCPDP DAW CODE "RTN","BPS10PST",202,0) ;;9002313.32;BPS PAYER RESPONSE OVERRIDES "RTN","BPS10PST",203,0) ;;9002313.78;BPS INSURER DATA "RTN","BPS10PST",204,0) ; "RTN","BPS10PST",205,0) CERTSUB ; remove a subfile DD from the BPS CERTIFICATION FILE - esg 1/4/11 "RTN","BPS10PST",206,0) D MES^XPDUTL(" - Updating BPS CERTIFICATION FILE") "RTN","BPS10PST",207,0) N DIU "RTN","BPS10PST",208,0) S DIU=9002313.31902 ; subfile# for (#902) VA PINS MULTIPLE "RTN","BPS10PST",209,0) S DIU(0)="DS" ; delete subfile data dictionary and any data that might exist "RTN","BPS10PST",210,0) D EN^DIU2 "RTN","BPS10PST",211,0) D MES^XPDUTL(" - Done with BPS CERTIFICATION FILE") "RTN","BPS10PST",212,0) D MES^XPDUTL(" ") "RTN","BPS10PST",213,0) Q "RTN","BPS10PST",214,0) ; "RTN","BPS10PST",215,0) ASLEEP ; Convert pointer to BPS Requests to BPS Transactions "RTN","BPS10PST",216,0) D MES^XPDUTL(" - Updating BPS ASLEEP PAYERS file") "RTN","BPS10PST",217,0) N IEN,CNT,PTR,X0,KEY1,KEY2,COB "RTN","BPS10PST",218,0) S CNT=0 "RTN","BPS10PST",219,0) S IEN=0 F S IEN=$O(^BPS(9002313.15,IEN)) Q:'IEN D "RTN","BPS10PST",220,0) . S PTR=$P($G(^BPS(9002313.15,IEN,0)),U,4) "RTN","BPS10PST",221,0) . I PTR["." Q ; Already converted "RTN","BPS10PST",222,0) . I 'PTR Q "RTN","BPS10PST",223,0) . S X0=$G(^BPS(9002313.77,PTR,0)) ; Get BPS Request data "RTN","BPS10PST",224,0) . I X0="" Q "RTN","BPS10PST",225,0) . S KEY1=$P(X0,U,1),KEY2=$P(X0,U,2),COB=$P(X0,U,3) "RTN","BPS10PST",226,0) . I 'KEY1!(KEY2="")!'COB Q "RTN","BPS10PST",227,0) . S $P(^BPS(9002313.15,IEN,0),U,4)=$$IEN59^BPSOSRX(KEY1,KEY2,COB) "RTN","BPS10PST",228,0) . S CNT=CNT+1 "RTN","BPS10PST",229,0) D MES^XPDUTL(" ..."_CNT_" entries updated") "RTN","BPS10PST",230,0) D MES^XPDUTL(" - Done with BPS ASLEEP PAYERS file") "RTN","BPS10PST",231,0) D MES^XPDUTL(" ") "RTN","BPS10PST",232,0) Q "RTN","BPS10PST",233,0) ; "RTN","BPSBUTL") 0^79^B55262641 "RTN","BPSBUTL",1,0) BPSBUTL ;BHAM ISC/MFR/VA/DLF - IB Communication Utilities ;06/01/2004 "RTN","BPSBUTL",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,8,9,10**;JUN 2004;Build 27 "RTN","BPSBUTL",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSBUTL",4,0) ;Reference to STORESP^IBNCPDP supported by DBIA 4299 "RTN","BPSBUTL",5,0) Q "RTN","BPSBUTL",6,0) ; "RTN","BPSBUTL",7,0) ;CLAIM - pointer to #9002313.02 "RTN","BPSBUTL",8,0) ;TRNDX - ptr to #9002313.59 "RTN","BPSBUTL",9,0) ;REASON - text name of the close reason "RTN","BPSBUTL",10,0) ;PAPER - 1=drop to paper "RTN","BPSBUTL",11,0) ;RELCOP - 1 (Yes) or 0 (No) release copay or not? "RTN","BPSBUTL",12,0) ;COMMENT - comment "RTN","BPSBUTL",13,0) ;ERROR - array by reference for error details "RTN","BPSBUTL",14,0) ; "RTN","BPSBUTL",15,0) CLOSE(CLAIM,TRNDX,REASON,PAPER,RELCOP,COMMENT,ERROR) ; Send IB an update on the CLAIM status for a Closed Claim "RTN","BPSBUTL",16,0) N DFN,BPSARRY,BILLNUM,CLAIMNFO,FILLNUM,RXIEN,TRANINFO "RTN","BPSBUTL",17,0) ; "RTN","BPSBUTL",18,0) ; - Data gathering "RTN","BPSBUTL",19,0) D GETS^DIQ("9002313.59",TRNDX,"1.11;9","I","TRANINFO") "RTN","BPSBUTL",20,0) S RXIEN=TRANINFO(9002313.59,TRNDX_",",1.11,"I") "RTN","BPSBUTL",21,0) I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q "RTN","BPSBUTL",22,0) S BPSARRY("FILL NUMBER")=TRANINFO(9002313.59,TRNDX_",",9,"I") "RTN","BPSBUTL",23,0) D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;403;426","","CLAIMNFO") "RTN","BPSBUTL",24,0) S BPSARRY("FILL DATE")=$$EXT2FM^BPSOSU1(CLAIMNFO("9002313.0201","1,"_CLAIM_",","401")) "RTN","BPSBUTL",25,0) S FILLNUM=+BPSARRY("FILL NUMBER") "RTN","BPSBUTL",26,0) S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I") "RTN","BPSBUTL",27,0) S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I") "RTN","BPSBUTL",28,0) S BPSARRY("PRESCRIPTION")=RXIEN "RTN","BPSBUTL",29,0) S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2)) "RTN","BPSBUTL",30,0) S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2) "RTN","BPSBUTL",31,0) S BPSARRY("PLAN")=$P(^BPST(TRNDX,10,1,0),"^") "RTN","BPSBUTL",32,0) S BPSARRY("STATUS")="CLOSED" "RTN","BPSBUTL",33,0) S BPSARRY("PAID")=0 "RTN","BPSBUTL",34,0) S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I")) "RTN","BPSBUTL",35,0) S BPSARRY("USER")=DUZ "RTN","BPSBUTL",36,0) S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I") "RTN","BPSBUTL",37,0) S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX) "RTN","BPSBUTL",38,0) I REASON'="" D "RTN","BPSBUTL",39,0) . S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0)) "RTN","BPSBUTL",40,0) . S BPSARRY("DROP TO PAPER")=+$G(PAPER) "RTN","BPSBUTL",41,0) . S BPSARRY("RELEASE COPAY")=+$G(RELCOP) "RTN","BPSBUTL",42,0) I $G(COMMENT)]"" S BPSARRY("CLOSE COMMENT")=COMMENT "RTN","BPSBUTL",43,0) ; "RTN","BPSBUTL",44,0) ; If dropped to Paper, increment the counter in BPS Statistics "RTN","BPSBUTL",45,0) I BPSARRY("DROP TO PAPER")=1 D INCSTAT^BPSOSUD("R",8) "RTN","BPSBUTL",46,0) ; "RTN","BPSBUTL",47,0) ; Call IB "RTN","BPSBUTL",48,0) S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSBUTL",49,0) Q "RTN","BPSBUTL",50,0) ; Send IB an update on the CLAIM status for a restocked or deleted prescription "RTN","BPSBUTL",51,0) CLOSE2(RXIEN,BFILL,BWHERE) ; "RTN","BPSBUTL",52,0) N IEN59,BPSARRY,DFN,BILLNUM,FILL,REASON "RTN","BPSBUTL",53,0) N CLAIMNFO "RTN","BPSBUTL",54,0) N DIE,DA,DR "RTN","BPSBUTL",55,0) ; "RTN","BPSBUTL",56,0) ; Check parameters "RTN","BPSBUTL",57,0) I '$G(RXIEN) S ERROR="No prescription parameter" Q "RTN","BPSBUTL",58,0) ; "RTN","BPSBUTL",59,0) I $$RXAPI1^BPSUTIL1(RXIEN,.01)="" S ERROR="Prescription not found." Q "RTN","BPSBUTL",60,0) I ",DDED,DE,RS,"'[(","_BWHERE_",") S ERROR="Invalid BWHERE parameter" Q "RTN","BPSBUTL",61,0) ; "RTN","BPSBUTL",62,0) ; Calculate the transaction IEN and see that it exists "RTN","BPSBUTL",63,0) S FILL=".0000"_+BFILL "RTN","BPSBUTL",64,0) S IEN59=RXIEN_"."_$E(FILL,$L(FILL)-3,$L(FILL))_"1" "RTN","BPSBUTL",65,0) I '$D(^BPST(IEN59,0)) Q "RTN","BPSBUTL",66,0) ; "RTN","BPSBUTL",67,0) ; Get claim data "RTN","BPSBUTL",68,0) S CLAIM=$P(^BPST(IEN59,0),"^",4) "RTN","BPSBUTL",69,0) D GETS^DIQ("9002313.02",CLAIM,"400*;401;402;426","","CLAIMNFO") "RTN","BPSBUTL",70,0) S BPSARRY("FILL NUMBER")=+BFILL "RTN","BPSBUTL",71,0) S BPSARRY("FILL DATE")=$$EXT2FM^BPSOSU1(CLAIMNFO("9002313.0201","1,"_CLAIM_",","401")) "RTN","BPSBUTL",72,0) ; "RTN","BPSBUTL",73,0) ; Get prescription data "RTN","BPSBUTL",74,0) S FILLNUM=BPSARRY("FILL NUMBER") "RTN","BPSBUTL",75,0) S DFN=$$RXAPI1^BPSUTIL1(RXIEN,2,"I") "RTN","BPSBUTL",76,0) S BPSARRY("FILLED BY")=$$RXAPI1^BPSUTIL1(RXIEN,16,"I") "RTN","BPSBUTL",77,0) S BPSARRY("PRESCRIPTION")=RXIEN "RTN","BPSBUTL",78,0) S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM($P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","426"),"DQ",2)) "RTN","BPSBUTL",79,0) S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIM_",","402"),"D2",2) "RTN","BPSBUTL",80,0) S BPSARRY("PLAN")=$P(^BPST(IEN59,10,1,0),"^") "RTN","BPSBUTL",81,0) S BPSARRY("STATUS")="CLOSED" "RTN","BPSBUTL",82,0) S BPSARRY("PAID")=0 "RTN","BPSBUTL",83,0) S BPSARRY("RELEASE DATE")=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I")) "RTN","BPSBUTL",84,0) S BPSARRY("USER")=.5 "RTN","BPSBUTL",85,0) S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,IEN59,1.07,"I") "RTN","BPSBUTL",86,0) S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(IEN59) "RTN","BPSBUTL",87,0) ; "RTN","BPSBUTL",88,0) ; Determine the reversal reason based on the BWHERE value "RTN","BPSBUTL",89,0) I BWHERE="RS" S REASON="PRESCRIPTION NOT RELEASED" "RTN","BPSBUTL",90,0) I BWHERE="DE"!(BWHERE="DDED") S REASON="PRESCRIPTION DELETED" "RTN","BPSBUTL",91,0) I REASON]"" S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",REASON,0)) "RTN","BPSBUTL",92,0) ; "RTN","BPSBUTL",93,0) ;if a refill was deleted while RX is still active (not deleted) then send DELETION OF REFILL comment for CT record "RTN","BPSBUTL",94,0) I BWHERE="DE",$$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE" "RTN","BPSBUTL",95,0) ; "RTN","BPSBUTL",96,0) ; "RTN","BPSBUTL",97,0) ; Update IB "RTN","BPSBUTL",98,0) S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSBUTL",99,0) ; "RTN","BPSBUTL",100,0) ; Update the claim file that the claim is closed and the reason why. "RTN","BPSBUTL",101,0) S DIE="^BPSC(",DA=CLAIM "RTN","BPSBUTL",102,0) S DR="901///1;902///"_$$NOW^XLFDT()_";903////.5;904///"_BPSARRY("CLOSE REASON") "RTN","BPSBUTL",103,0) D ^DIE "RTN","BPSBUTL",104,0) Q "RTN","BPSBUTL",105,0) ; "RTN","BPSBUTL",106,0) ; Function to return Transaction, claim, and response IENs "RTN","BPSBUTL",107,0) ; Parameters: "RTN","BPSBUTL",108,0) ; RXI: Prescription IEN "RTN","BPSBUTL",109,0) ; RXR: Fill Number "RTN","BPSBUTL",110,0) ; COB: COB Indicator "RTN","BPSBUTL",111,0) ; Returns: "RTN","BPSBUTL",112,0) ; IEN59^Claim IEN^Response IEN^Reversal Claim IEN^Reversal Response IEN^Prescription/Service Ref Number from BPS CLAIMS file "RTN","BPSBUTL",113,0) CLAIM(RXI,RXR,COB) ; "RTN","BPSBUTL",114,0) N IEN59,CLAIMIEN,RESPIEN,REVCLAIM,REVRESP,ECMENUM "RTN","BPSBUTL",115,0) I '$G(RXI) Q "" "RTN","BPSBUTL",116,0) ; Note that IEN59 will treat RXR="" as the original fill (0) "RTN","BPSBUTL",117,0) ; and COB="" as primary (1) "RTN","BPSBUTL",118,0) S IEN59=$$IEN59^BPSOSRX(RXI,$G(RXR),$G(COB)) "RTN","BPSBUTL",119,0) I '$D(^BPST(IEN59,0)) Q "" "RTN","BPSBUTL",120,0) S CLAIMIEN=$P(^BPST(IEN59,0),"^",4),RESPIEN=$P(^BPST(IEN59,0),"^",5) "RTN","BPSBUTL",121,0) S REVCLAIM=$P($G(^BPST(IEN59,4)),"^",1),REVRESP=$P($G(^BPST(IEN59,4)),"^",2) "RTN","BPSBUTL",122,0) S ECMENUM=$$ECMENUM^BPSSCRU2(IEN59) "RTN","BPSBUTL",123,0) Q IEN59_U_CLAIMIEN_U_RESPIEN_U_REVCLAIM_U_REVRESP_U_ECMENUM "RTN","BPSBUTL",124,0) ; "RTN","BPSBUTL",125,0) ; NABP - Return the value in the Service Provider ID (201-B1) field "RTN","BPSBUTL",126,0) ; of the claim. Note that as of the NPI release (BPS*1*2), this "RTN","BPSBUTL",127,0) ; API may return NPI instead of NABP/NCPDP "RTN","BPSBUTL",128,0) NABP(RXP,BFILL) ; "RTN","BPSBUTL",129,0) I '$G(RXP) Q "" "RTN","BPSBUTL",130,0) I $G(BFILL)="" S BFILL=0 "RTN","BPSBUTL",131,0) N BPSTIEN,BPSCIEN,DFILL,NABP "RTN","BPSBUTL",132,0) S DFILL=$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4) "RTN","BPSBUTL",133,0) S BPSTIEN=RXP_"."_DFILL_"1" "RTN","BPSBUTL",134,0) I 'BPSTIEN Q "" "RTN","BPSBUTL",135,0) S BPSCIEN=$P($G(^BPST(BPSTIEN,0)),U,4) "RTN","BPSBUTL",136,0) I 'BPSCIEN Q "" "RTN","BPSBUTL",137,0) S NABP=$P($G(^BPSC(BPSCIEN,200)),U) "RTN","BPSBUTL",138,0) Q NABP "RTN","BPSBUTL",139,0) ; "RTN","BPSBUTL",140,0) ; DIVNCPDP - For a specific outpatient site, return the NPI & NCPDP. "RTN","BPSBUTL",141,0) ; Note that the procedure name is misleading but when originally "RTN","BPSBUTL",142,0) ; coded, this procedure only returned NCPDP. "RTN","BPSBUTL",143,0) ; "RTN","BPSBUTL",144,0) ; Input "RTN","BPSBUTL",145,0) ; BPSDIV - Outpatient Site (#59) "RTN","BPSBUTL",146,0) ; Output "RTN","BPSBUTL",147,0) ; "" - No BPSDIV passed in "RTN","BPSBUTL",148,0) ; NCPDP and NPI separated by a caret "RTN","BPSBUTL",149,0) DIVNCPDP(BPSDIV) ; "RTN","BPSBUTL",150,0) N BPSPHARM,NPI,NCPDP "RTN","BPSBUTL",151,0) I '$G(BPSDIV) Q "^" "RTN","BPSBUTL",152,0) ; "RTN","BPSBUTL",153,0) ; Get the NCPDP "RTN","BPSBUTL",154,0) S NCPDP="" "RTN","BPSBUTL",155,0) S BPSPHARM=$$GETPHARM^BPSUTIL(BPSDIV) "RTN","BPSBUTL",156,0) I BPSPHARM S NCPDP=$$GET1^DIQ(9002313.56,BPSPHARM_",",.02) "RTN","BPSBUTL",157,0) ; "RTN","BPSBUTL",158,0) ; Get the NPI and validate it "RTN","BPSBUTL",159,0) S NPI=+$$NPI^BPSNPI("Pharmacy_ID",BPSDIV) "RTN","BPSBUTL",160,0) I NPI=-1 S NPI="" "RTN","BPSBUTL",161,0) ; "RTN","BPSBUTL",162,0) Q NCPDP_"^"_NPI "RTN","BPSBUTL",163,0) ; "RTN","BPSBUTL",164,0) ;ADDCOMM - Add a comment to a ECME claim "RTN","BPSBUTL",165,0) ;Input: "RTN","BPSBUTL",166,0) ; BPRX - ien in file #52 "RTN","BPSBUTL",167,0) ; BPREF - refill number (0,1,2,...) "RTN","BPSBUTL",168,0) ; BPRCMNT - comment text "RTN","BPSBUTL",169,0) ;Output: "RTN","BPSBUTL",170,0) ; 1 - okay "RTN","BPSBUTL",171,0) ; -1 - failed "RTN","BPSBUTL",172,0) ADDCOMM(BPRX,BPREF,BPRCMNT) ; "RTN","BPSBUTL",173,0) N IEN59,BPNOW,BPREC,BPDA,BPERR "RTN","BPSBUTL",174,0) ; Check parameters "RTN","BPSBUTL",175,0) I '$G(BPRX) Q -1 "RTN","BPSBUTL",176,0) I $G(BPRCMNT)="" Q -1 "RTN","BPSBUTL",177,0) ; Get BPS Transaction number, if needed, and check for existance "RTN","BPSBUTL",178,0) S IEN59=$$IEN59^BPSOSRX(BPRX,$G(BPREF),1) "RTN","BPSBUTL",179,0) I IEN59="" Q -1 "RTN","BPSBUTL",180,0) I '$D(^BPST(IEN59)) Q -1 "RTN","BPSBUTL",181,0) ; Lock record and quit if you cannot get the lock "RTN","BPSBUTL",182,0) L +^BPST(9002313.59111,+IEN59):10 "RTN","BPSBUTL",183,0) I '$T Q -1 "RTN","BPSBUTL",184,0) ; Create record and file data "RTN","BPSBUTL",185,0) S BPNOW=$$NOW^XLFDT "RTN","BPSBUTL",186,0) D INSITEM^BPSCMT01(9002313.59111,+IEN59,BPNOW) "RTN","BPSBUTL",187,0) S BPREC=$O(^BPST(IEN59,11,"B",BPNOW,99999999),-1) "RTN","BPSBUTL",188,0) I BPREC>0 D "RTN","BPSBUTL",189,0) . S BPDA(9002313.59111,BPREC_","_IEN59_",",.02)=+$G(DUZ) "RTN","BPSBUTL",190,0) . S BPDA(9002313.59111,BPREC_","_IEN59_",",.03)=$E($G(BPRCMNT),1,63) "RTN","BPSBUTL",191,0) . D FILE^DIE("","BPDA","BPERR") "RTN","BPSBUTL",192,0) L -^BPST(9002313.59111,+IEN59) "RTN","BPSBUTL",193,0) ; Quit with result "RTN","BPSBUTL",194,0) I BPREC>0,'$D(BPERR) Q 1 "RTN","BPSBUTL",195,0) Q -1 "RTN","BPSBUTL",196,0) ; "RTN","BPSBUTL",197,0) ;REOPEN - Reopen closed claim "RTN","BPSBUTL",198,0) ;Input: "RTN","BPSBUTL",199,0) ; BP59 - ien in BPS TRANSACTION file "RTN","BPSBUTL",200,0) ; BP02 - ien in BPS CLAIMS file "RTN","BPSBUTL",201,0) ; BPREOPDT - reopen date/time "RTN","BPSBUTL",202,0) ; BPDUZ - user DUZ (#200 ien) "RTN","BPSBUTL",203,0) ; BPCOMM - reopen comment text "RTN","BPSBUTL",204,0) ;Output: "RTN","BPSBUTL",205,0) ; 0^message_error - error "RTN","BPSBUTL",206,0) ; 1 - success "RTN","BPSBUTL",207,0) REOPEN(BP59,BP02,BPREOPDT,BPDUZ,BPCOMM) ; "RTN","BPSBUTL",208,0) N RECIENS,BPDA,ERRARR,BPREFNO,BPRXIEN,BPFILLDT,BPCLMID,BPZ,BPSARRY,BPDFN,BPRETVAL,BPZ1 "RTN","BPSBUTL",209,0) S BPDFN=$P($G(^BPST(BP59,0)),U,6) "RTN","BPSBUTL",210,0) S BPREFNO=$P($G(^BPST(BP59,1)),U) "RTN","BPSBUTL",211,0) I BPREFNO="" Q "0^Null Fill Number" "RTN","BPSBUTL",212,0) S BPRXIEN=$P($G(^BPST(BP59,1)),U,11) "RTN","BPSBUTL",213,0) I BPRXIEN="" Q "0^Null RX ien Number" "RTN","BPSBUTL",214,0) ;in VA there is only one med/claim but in some cases it can different than "1" "RTN","BPSBUTL",215,0) ;so take the latest one "RTN","BPSBUTL",216,0) S BPZ=$O(^BPSC(BP02,400,9999999),-1) "RTN","BPSBUTL",217,0) I BPRXIEN="" Q "0^Database Error" "RTN","BPSBUTL",218,0) S BPFILLDT=$$YMD2FM^BPSSCRU6(+$P($G(^BPSC(BP02,400,+BPZ,400)),U)) "RTN","BPSBUTL",219,0) S BPCLMID=$$CONVCLID^BPSSCRU6($P($G(^BPSC(BP02,400,+BPZ,400)),U,2)) "RTN","BPSBUTL",220,0) ;============ "RTN","BPSBUTL",221,0) ;Now update ECME database "RTN","BPSBUTL",222,0) S BPRETVAL=$$UPDREOP^BPSREOP1(BP02,0,BPREOPDT,BPDUZ,BPCOMM) "RTN","BPSBUTL",223,0) I +BPRETVAL=0 D Q BPRETVAL "RTN","BPSBUTL",224,0) . ;try to reverse it in case it was done partially "RTN","BPSBUTL",225,0) . I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@") "RTN","BPSBUTL",226,0) ;============ "RTN","BPSBUTL",227,0) ;Now call IB API for "REOPEN" event "RTN","BPSBUTL",228,0) S BPSARRY("STATUS")="REOPEN" "RTN","BPSBUTL",229,0) S BPSARRY("FILL DATE")=BPFILLDT "RTN","BPSBUTL",230,0) S BPSARRY("FILL NUMBER")=BPREFNO "RTN","BPSBUTL",231,0) S BPSARRY("PRESCRIPTION")=BPRXIEN "RTN","BPSBUTL",232,0) S BPSARRY("CLAIMID")=BPCLMID "RTN","BPSBUTL",233,0) S BPSARRY("DRUG")=$$DRUGIEN^BPSSCRU6(BPRXIEN,BPDFN) "RTN","BPSBUTL",234,0) S BPSARRY("PLAN")=$P($G(^BPST(BP59,10,1,0)),"^") "RTN","BPSBUTL",235,0) S BPSARRY("USER")=BPDUZ "RTN","BPSBUTL",236,0) S BPSARRY("REOPEN COMMENT")=BPCOMM "RTN","BPSBUTL",237,0) S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,BP59,1.07,"I") "RTN","BPSBUTL",238,0) S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(BP59) "RTN","BPSBUTL",239,0) S BPRETVAL=$$STORESP^IBNCPDP(BPDFN,.BPSARRY) "RTN","BPSBUTL",240,0) ;if successful "RTN","BPSBUTL",241,0) I +BPRETVAL>0 Q "1^ReOpening Claim: "_$P($G(^BPSC(BP02,0)),U)_" ... OK" "RTN","BPSBUTL",242,0) ;=========== "RTN","BPSBUTL",243,0) ;if it was unsuccessful "RTN","BPSBUTL",244,0) ;reverse ECME database (keep the user who made the attempt) "RTN","BPSBUTL",245,0) I $$UPDREOP^BPSREOP1(BP02,1,"@",+BPDUZ,"@") "RTN","BPSBUTL",246,0) ;return IB error message "RTN","BPSBUTL",247,0) Q BPRETVAL "RTN","BPSCT") 0^80^B1444523 "RTN","BPSCT",1,0) BPSCT ;BHAM ISC/SS - ECME CT EDIT SCREEN ;05-APR-05 "RTN","BPSCT",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,10**;JUN 2004;Build 27 "RTN","BPSCT",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSCT",4,0) ; "RTN","BPSCT",5,0) ; Reference to CT^IBNCPDPC supported by DBIA 4693 "RTN","BPSCT",6,0) ; "RTN","BPSCT",7,0) Q "RTN","BPSCT",8,0) CT ;to run from research menu "RTN","BPSCT",9,0) N BPRET,BPSEL,BP59,BPZ "RTN","BPSCT",10,0) I '$D(@(VALMAR)) Q "RTN","BPSCT",11,0) D FULL^VALM1 "RTN","BPSCT",12,0) W !,"Please select a SINGLE Rx Line item when accessing Claims Tracking." "RTN","BPSCT",13,0) S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE RX line.") "RTN","BPSCT",14,0) I BPSEL<1 S VALMBCK="R" Q "RTN","BPSCT",15,0) ; "RTN","BPSCT",16,0) S BP59=+$P(BPSEL,U,4) "RTN","BPSCT",17,0) S BPZ=$$RXREF^BPSSCRU2(BP59) "RTN","BPSCT",18,0) D CT^IBNCPDPC(+$P(BPZ,U,1),+$P(BPZ,U,2)) ; call IB with Rx ien and fill# (IA 4693) "RTN","BPSCT",19,0) S VALMBCK="R" "RTN","BPSCT",20,0) Q "RTN","BPSCT",21,0) ; "RTN","BPSECA1") 0^72^B13940777 "RTN","BPSECA1",1,0) BPSECA1 ;BHAM ISC/FCS/DRS/VA/DLF - Assemble formatted claim ;05/14/2004 "RTN","BPSECA1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10**;JUN 2004;Build 27 "RTN","BPSECA1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECA1",4,0) ;---------------------------------------------------------------------- "RTN","BPSECA1",5,0) ; Assemble ASCII formatted claim submission record "RTN","BPSECA1",6,0) ; "RTN","BPSECA1",7,0) ; Input Variables: "RTN","BPSECA1",8,0) ; CLAIMIEN - pointer into 9002313.02 "RTN","BPSECA1",9,0) ; MSG - Array passed by reference - This will have the claim packet "RTN","BPSECA1",10,0) ; "RTN","BPSECA1",11,0) ; NCPDP 5.1 changes "RTN","BPSECA1",12,0) ; 5.1 has 14 claim segments (header, patient, insurance, claim "RTN","BPSECA1",13,0) ; pharmacy provider, prescriber, "RTN","BPSECA1",14,0) ; COB, workers comp, DUR, Pricing, "RTN","BPSECA1",15,0) ; coupon, compound, prior auth, "RTN","BPSECA1",16,0) ; clinical) "RTN","BPSECA1",17,0) ; 5.1 requires field identifiers and separators on all fields "RTN","BPSECA1",18,0) ; other than the header "RTN","BPSECA1",19,0) ; 5.1 Segment separators are required prior to each segment "RTN","BPSECA1",20,0) ; following the header "RTN","BPSECA1",21,0) ; 5.1 Group separators appear at the end of each "RTN","BPSECA1",22,0) ; transaction (prescription) "RTN","BPSECA1",23,0) ; "RTN","BPSECA1",24,0) ; Adjustments were also made to the reversal logic as well. "RTN","BPSECA1",25,0) ; "RTN","BPSECA1",26,0) ; NCPDP D.0 changes "RTN","BPSECA1",27,0) ; D.0 added 3 new request segments (additional documentation, "RTN","BPSECA1",28,0) ; facility, narrative) "RTN","BPSECA1",29,0) ; "RTN","BPSECA1",30,0) ASCII(CLAIMIEN,MSG) ;EP - from BPSOSQG "RTN","BPSECA1",31,0) N IEN,RECORD,BPS,UERETVAL,DET51,WP "RTN","BPSECA1",32,0) ; "RTN","BPSECA1",33,0) ; Quit if no Claim IEN "RTN","BPSECA1",34,0) I '$G(CLAIMIEN) Q "RTN","BPSECA1",35,0) I '$D(^BPSC(CLAIMIEN,0)) Q "RTN","BPSECA1",36,0) ; "RTN","BPSECA1",37,0) ; Setup IEN variables (used when executing format code) "RTN","BPSECA1",38,0) S IEN(9002313.02)=CLAIMIEN "RTN","BPSECA1",39,0) ; "RTN","BPSECA1",40,0) ; Get Payer Sheet pointer "RTN","BPSECA1",41,0) S IEN(9002313.92)=$P($G(^BPSC(IEN(9002313.02),0)),U,2) "RTN","BPSECA1",42,0) ; "RTN","BPSECA1",43,0) ; Quit if the payer sheet pointer is missing "RTN","BPSECA1",44,0) I 'IEN(9002313.92) Q "RTN","BPSECA1",45,0) ; "RTN","BPSECA1",46,0) ; Quit if the payer sheet does not exist "RTN","BPSECA1",47,0) I '$D(^BPSF(9002313.92,+IEN(9002313.92),0)) Q "RTN","BPSECA1",48,0) ; "RTN","BPSECA1",49,0) ; Retrieve claim submission record (used when executing format code) "RTN","BPSECA1",50,0) D GETBPS2^BPSECX0(IEN(9002313.02),.BPS) "RTN","BPSECA1",51,0) ; "RTN","BPSECA1",52,0) ; Assemble required claim header and optional format sections "RTN","BPSECA1",53,0) S RECORD="" "RTN","BPSECA1",54,0) ; "RTN","BPSECA1",55,0) ; Do non-repeating claim segments "RTN","BPSECA1",56,0) D XLOOP^BPSOSH2("100^110^120",.IEN,.BPS,.RECORD) "RTN","BPSECA1",57,0) ; "RTN","BPSECA1",58,0) ; Set list of repeating claim segments "RTN","BPSECA1",59,0) S DET51="130^140^150^160^170^180^190^200^210^220^230^240^250^260" "RTN","BPSECA1",60,0) ; "RTN","BPSECA1",61,0) ; Loop through prescription multiple and get create repeation segments "RTN","BPSECA1",62,0) S IEN(9002313.0201)=0 "RTN","BPSECA1",63,0) F S IEN(9002313.0201)=$O(^BPSC(IEN(9002313.02),400,IEN(9002313.0201))) Q:'IEN(9002313.0201) D "RTN","BPSECA1",64,0) . ; "RTN","BPSECA1",65,0) . ;Retrieve prescription information (used when executing format code) "RTN","BPSECA1",66,0) . K BPS(9002313.0201) "RTN","BPSECA1",67,0) . D GETBPS3^BPSECX0(IEN(9002313.02),IEN(9002313.0201),.BPS) "RTN","BPSECA1",68,0) . ; "RTN","BPSECA1",69,0) . ; Handle the DUR repeating flds "RTN","BPSECA1",70,0) . D DURVALUE "RTN","BPSECA1",71,0) . ; "RTN","BPSECA1",72,0) . ; Handle the COB flds "RTN","BPSECA1",73,0) . D COBFLDS "RTN","BPSECA1",74,0) . ; "RTN","BPSECA1",75,0) . ; If not eligibility verification transmission, append group separator character "RTN","BPSECA1",76,0) . I $G(BPS(9002313.02,+$G(IEN(9002313.02)),103,"I"))'="E1" S RECORD=RECORD_$C(29) "RTN","BPSECA1",77,0) . ; "RTN","BPSECA1",78,0) . ; Assemble claim information required and optional sections "RTN","BPSECA1",79,0) . D XLOOP^BPSOSH2(DET51,.IEN,.BPS,.RECORD) "RTN","BPSECA1",80,0) ; "RTN","BPSECA1",81,0) ; Need to store by segment due to HL7 constraints. Had to change field, group, "RTN","BPSECA1",82,0) ; and segment separators to control characters for Vitria/AAC processing as well as "RTN","BPSECA1",83,0) ; shortening the length of the xmit. "RTN","BPSECA1",84,0) ; DMB 11/27/2006 - If the first NNODES has $C(30), this will bomb since OREC will not "RTN","BPSECA1",85,0) ; have a value. Need to look into this. "RTN","BPSECA1",86,0) N NNODES,INDEX,ONE,TWO,OREC "RTN","BPSECA1",87,0) S NNODES=0 F S NNODES=$O(RECORD(NNODES)) Q:NNODES="" D "RTN","BPSECA1",88,0) . I RECORD(NNODES)[$C(30) D "RTN","BPSECA1",89,0) .. S ONE=$P(RECORD(NNODES),($C(30)_$C(28)),1),TWO=$P(RECORD(NNODES),($C(30)_$C(28)),2) "RTN","BPSECA1",90,0) .. S RECORD(OREC)=RECORD(OREC)_ONE_$C(30)_$C(28),RECORD(NNODES)=TWO "RTN","BPSECA1",91,0) . S OREC=NNODES "RTN","BPSECA1",92,0) ; "RTN","BPSECA1",93,0) ; Put claim packet into local array to be passed back to calling routine "RTN","BPSECA1",94,0) S NNODES="" "RTN","BPSECA1",95,0) S INDEX=1 F S NNODES=$O(RECORD(NNODES)) Q:NNODES="" D "RTN","BPSECA1",96,0) . S MSG("HLS",INDEX)=RECORD(NNODES) "RTN","BPSECA1",97,0) . S WP(INDEX/100+1,0)=RECORD(NNODES) "RTN","BPSECA1",98,0) . S INDEX=INDEX+1 "RTN","BPSECA1",99,0) S MSG("HLS",0)=INDEX-1 "RTN","BPSECA1",100,0) ; "RTN","BPSECA1",101,0) ; Store raw data into the BPS Claims record "RTN","BPSECA1",102,0) D WP^DIE(9002313.02,CLAIMIEN_",",9999,"","WP") "RTN","BPSECA1",103,0) Q "RTN","BPSECA1",104,0) ; "RTN","BPSECA1",105,0) ; DURVALUE - This subroutine will loop through the DUR/PPS repeating "RTN","BPSECA1",106,0) ; fields and load their values into the BPS array for the claim "RTN","BPSECA1",107,0) ; generation process "RTN","BPSECA1",108,0) DURVALUE ; "RTN","BPSECA1",109,0) N DURCNT,DUR "RTN","BPSECA1",110,0) ; "RTN","BPSECA1",111,0) K BPS(9002313.1001) "RTN","BPSECA1",112,0) ; "RTN","BPSECA1",113,0) ; Get the number of DUR records "RTN","BPSECA1",114,0) S DURCNT=$P($G(^BPSC(IEN(9002313.02),400,IEN(9002313.0201),473.01,0)),U,4) "RTN","BPSECA1",115,0) ; "RTN","BPSECA1",116,0) ; Loop through DURS and get the data "RTN","BPSECA1",117,0) F DUR=1:1:DURCNT D "RTN","BPSECA1",118,0) . D GETBPS4^BPSECX0(IEN(9002313.02),IEN(9002313.0201),DUR,.BPS) "RTN","BPSECA1",119,0) Q "RTN","BPSECA1",120,0) ; COBFLDS - This subroutine will loop through the COB OTHER PAYMENTS repeating "RTN","BPSECA1",121,0) ; fields and load their values into the BPS array for the claim "RTN","BPSECA1",122,0) ; generation process "RTN","BPSECA1",123,0) COBFLDS ; "RTN","BPSECA1",124,0) N BPCOBCNT,BPSCOB "RTN","BPSECA1",125,0) ; "RTN","BPSECA1",126,0) K BPS(9002313.0401) "RTN","BPSECA1",127,0) ; "RTN","BPSECA1",128,0) ; Get the number of COB records "RTN","BPSECA1",129,0) S BPCOBCNT=$P($G(^BPSC(IEN(9002313.02),400,IEN(9002313.0201),337,0)),U,4) "RTN","BPSECA1",130,0) ; "RTN","BPSECA1",131,0) ; Loop through COB and get the data "RTN","BPSECA1",132,0) F BPSCOB=1:1:BPCOBCNT D "RTN","BPSECA1",133,0) . D GETBPS5^BPSECX0(IEN(9002313.02),IEN(9002313.0201),BPSCOB,.BPS) "RTN","BPSECA1",134,0) Q "RTN","BPSECA8") 0^18^B20615528 "RTN","BPSECA8",1,0) BPSECA8 ;BHAM ISC/FCS/DRS/VA/DLF - construct a claim reversal ;05/17/04 "RTN","BPSECA8",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSECA8",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECA8",4,0) Q "RTN","BPSECA8",5,0) ; REVERSE - The way we build the claim reversal is to take the "RTN","BPSECA8",6,0) ; source data from the original claim (CLAIMIEN) and position therein (POS). "RTN","BPSECA8",7,0) ; "RTN","BPSECA8",8,0) ; Remember, you have two 401 fields - one in header, one in prescription. "RTN","BPSECA8",9,0) ; "RTN","BPSECA8",10,0) ; 5.1 Updates "RTN","BPSECA8",11,0) ; There are new fields to consider in the 5.1 reversal process, in "RTN","BPSECA8",12,0) ; addition to a new value for the transaction code (B2) "RTN","BPSECA8",13,0) ; "RTN","BPSECA8",14,0) ; Input "RTN","BPSECA8",15,0) ; IEN59 - Transaction number "RTN","BPSECA8",16,0) ; Returns REVIEN of the reversal claim created "RTN","BPSECA8",17,0) ; "RTN","BPSECA8",18,0) REVERSE(IEN59) ; function, return reversal IEN or zero on failure, from BPSOSRB "RTN","BPSECA8",19,0) Q:$G(IEN59)="" 0 ; required "RTN","BPSECA8",20,0) ; "RTN","BPSECA8",21,0) N BPS,BPSFORM,C,CLAIM,CLAIMIEN,DA,DIC,DIE,DIQ,DLAYGO,DR,I,L,POS,REVIEN,RXMULT,TMP,UERETVAL "RTN","BPSECA8",22,0) N VERSION,FLD402,X,Y,COB,REC,FN,FDA,MSG,IENS "RTN","BPSECA8",23,0) ; "RTN","BPSECA8",24,0) S CLAIM=9002313.02,RXMULT=9002313.0201 "RTN","BPSECA8",25,0) ; "RTN","BPSECA8",26,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSECA8",27,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Gathering claim information") "RTN","BPSECA8",28,0) ; "RTN","BPSECA8",29,0) ; Get Claim and multiple POS "RTN","BPSECA8",30,0) S CLAIMIEN=$P(^BPST(IEN59,0),U,4) "RTN","BPSECA8",31,0) I CLAIMIEN="" Q 0 "RTN","BPSECA8",32,0) S POS=$O(^BPSC(CLAIMIEN,400,0)) "RTN","BPSECA8",33,0) I POS="" Q 0 "RTN","BPSECA8",34,0) ; "RTN","BPSECA8",35,0) ; Get reversal payer sheet. If missing, quit "RTN","BPSECA8",36,0) S BPSFORM=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",","902.19","I") "RTN","BPSECA8",37,0) I BPSFORM="" Q 0 "RTN","BPSECA8",38,0) ; "RTN","BPSECA8",39,0) ; Get payer sheet version "RTN","BPSECA8",40,0) S VERSION=$P(^BPSF(9002313.92,BPSFORM,1),"^",2) "RTN","BPSECA8",41,0) I VERSION="" S VERSION="D0" "RTN","BPSECA8",42,0) ; "RTN","BPSECA8",43,0) ; Get data from original claim request "RTN","BPSECA8",44,0) S DR="**",DIQ="TMP",DIQ(0)="I" "RTN","BPSECA8",45,0) D GETS^DIQ(CLAIM,CLAIMIEN,DR,DIQ(0),DIQ) "RTN","BPSECA8",46,0) ; "RTN","BPSECA8",47,0) ; Update CLAIMIEN to match CLAIMIEN format in TMP "RTN","BPSECA8",48,0) S CLAIMIEN=CLAIMIEN_"," "RTN","BPSECA8",49,0) ; "RTN","BPSECA8",50,0) ; Execute special code in reversal payer sheets "RTN","BPSECA8",51,0) D REFORM^BPSOSHR(BPSFORM,CLAIMIEN,POS) "RTN","BPSECA8",52,0) ; "RTN","BPSECA8",53,0) ; Create a new claim record and use function to get the Claim ID "RTN","BPSECA8",54,0) R2 S DIC=CLAIM,DIC(0)="LX",DLAYGO=CLAIM "RTN","BPSECA8",55,0) S X=$$CLAIMID^BPSECX1(IEN59) "RTN","BPSECA8",56,0) I X="" Q 0 "RTN","BPSECA8",57,0) D ^DIC "RTN","BPSECA8",58,0) S REVIEN=+Y "RTN","BPSECA8",59,0) I REVIEN<1 Q 0 "RTN","BPSECA8",60,0) ; "RTN","BPSECA8",61,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSECA8",62,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Created claim ID "_X_" ("_REVIEN_")") "RTN","BPSECA8",63,0) ; "RTN","BPSECA8",64,0) ; Create a new transaction multiple for the claim "RTN","BPSECA8",65,0) R4 S DIC="^BPSC("_REVIEN_",400,",DIC(0)="LX" "RTN","BPSECA8",66,0) S DIC("P")=$P(^DD(CLAIM,400,0),U,2) "RTN","BPSECA8",67,0) S DA(1)=REVIEN,DLAYGO=RXMULT,X=1 "RTN","BPSECA8",68,0) D ^DIC "RTN","BPSECA8",69,0) I +Y'=1 D G:UERETVAL R4 "RTN","BPSECA8",70,0) . S UERETVAL=$$IMPOSS^BPSOSUE("FM,P",,"call to ^DIC","for multiple",,$T(+0)) "RTN","BPSECA8",71,0) ; "RTN","BPSECA8",72,0) ; Update claim with new values "RTN","BPSECA8",73,0) S DIE=CLAIM,DA=REVIEN,DR="",C=0 "RTN","BPSECA8",74,0) F I=.03,.04,1.01,1.04,101,104,110,201,202,301,302,304,305,310,311,331,332,359,401 D "RTN","BPSECA8",75,0) .S C=C+1,$P(DR,";",C)=I_"////"_$G(TMP(CLAIM,CLAIMIEN,I,"I")) "RTN","BPSECA8",76,0) ; "RTN","BPSECA8",77,0) ; Add fields that do not come from the claim "RTN","BPSECA8",78,0) ; Payer sheet is the reversal sheet, Created On is current date/time "RTN","BPSECA8",79,0) ; Transaction Code is B2 and Transaction Count is 1 "RTN","BPSECA8",80,0) S DR=DR_";.02////"_BPSFORM_";.06////"_$$NOWFM^BPSOSU1_";102////"_VERSION_";103////B2;109////1" "RTN","BPSECA8",81,0) D ^DIE "RTN","BPSECA8",82,0) ; "RTN","BPSECA8",83,0) ; Convert the 402-D2 (Prescription/Service Ref Number) to the proper length based on the NCPDP version "RTN","BPSECA8",84,0) S FLD402=$G(TMP(RXMULT,POS_","_CLAIMIEN,402,"I")),L=$S(VERSION=51:6,1:11) "RTN","BPSECA8",85,0) S TMP(RXMULT,POS_","_CLAIMIEN,402,"I")=$E(FLD402,1,2)_$E($E(FLD402,3,99)+1000000000000,13-L,13) "RTN","BPSECA8",86,0) ; "RTN","BPSECA8",87,0) ; Update transaction multiple with values "RTN","BPSECA8",88,0) S DIE="^BPSC("_REVIEN_",400,",DA(1)=REVIEN,DA=1,DR="",C=0 "RTN","BPSECA8",89,0) F I=.03,.04,.05,147,308,337,401,402,403,407,418,430,436,438,455 D "RTN","BPSECA8",90,0) .S C=C+1,$P(DR,";",C)=I_"////"_$G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I")) "RTN","BPSECA8",91,0) D ^DIE "RTN","BPSECA8",92,0) ; "RTN","BPSECA8",93,0) ; Add Submission Clarification Code to the reversal record "RTN","BPSECA8",94,0) ; Note that this is only valid for version 5.1 and 5.1 is a single-value "RTN","BPSECA8",95,0) ; field, so we only need the first occurrence "RTN","BPSECA8",96,0) I VERSION=51,$G(^BPSC(+CLAIMIEN,400,POS,354.01,1,1))]"" D "RTN","BPSECA8",97,0) . K FDA,MSG,IENS "RTN","BPSECA8",98,0) . S FN=9002313.02354,IENS="+1,"_POS_","_REVIEN_",",IENS(1)=1 "RTN","BPSECA8",99,0) . S FDA(FN,IENS,.01)=1 "RTN","BPSECA8",100,0) . S FDA(FN,IENS,420)=^BPSC(+CLAIMIEN,400,POS,354.01,1,1) "RTN","BPSECA8",101,0) . D UPDATE^DIE("","FDA","IENS","MSG") "RTN","BPSECA8",102,0) . I '$D(MSG) S $P(^BPSC(REVIEN,400,POS,350),U,4)="NX"_$$NFF^BPSECFM(1,1) "RTN","BPSECA8",103,0) . I $D(MSG) D "RTN","BPSECA8",104,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-Clarification fields did not file") "RTN","BPSECA8",105,0) .. D LOG^BPSOSL(IEN59,"REC="_REC) "RTN","BPSECA8",106,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSECA8",107,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSECA8",108,0) .. D LOG^BPSOSL(IEN59,"IENS Array:") "RTN","BPSECA8",109,0) .. D LOGARRAY^BPSOSL(IEN59,"IENS") "RTN","BPSECA8",110,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSECA8",111,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSECA8",112,0) ; "RTN","BPSECA8",113,0) ; Create COB multiple if it exists in the claim record "RTN","BPSECA8",114,0) S COB=0 "RTN","BPSECA8",115,0) F S COB=$O(^BPSC(+CLAIMIEN,400,POS,337,COB)) Q:'COB D "RTN","BPSECA8",116,0) . S REC=$G(^BPSC(+CLAIMIEN,400,POS,337,COB,0)) "RTN","BPSECA8",117,0) . I $P(REC,U,1)=""!($P(REC,U,2)="") Q "RTN","BPSECA8",118,0) . K FDA,MSG,IENS "RTN","BPSECA8",119,0) . S FN=9002313.0401,IENS="+1,"_POS_","_REVIEN_",",IENS(1)=COB "RTN","BPSECA8",120,0) . S FDA(FN,IENS,.01)=$P(REC,U,1) "RTN","BPSECA8",121,0) . S FDA(FN,IENS,338)=$P(REC,U,2) "RTN","BPSECA8",122,0) . D UPDATE^DIE("","FDA","IENS","MSG") "RTN","BPSECA8",123,0) . I $D(MSG) D "RTN","BPSECA8",124,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-COB fields did not file, COB="_COB) "RTN","BPSECA8",125,0) .. D LOG^BPSOSL(IEN59,"REC="_REC) "RTN","BPSECA8",126,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSECA8",127,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSECA8",128,0) .. D LOG^BPSOSL(IEN59,"IENS Array:") "RTN","BPSECA8",129,0) .. D LOGARRAY^BPSOSL(IEN59,"IENS") "RTN","BPSECA8",130,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSECA8",131,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSECA8",132,0) ; "RTN","BPSECA8",133,0) Q REVIEN "RTN","BPSECA8",134,0) ; "RTN","BPSECFM") 0^75^B9768202 "RTN","BPSECFM",1,0) BPSECFM ;BHAM ISC/FCS/DRS/VA/DLF - NCPDP Field Format Functions ;3/12/08 13:01 "RTN","BPSECFM",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,7,10**;JUN 2004;Build 27 "RTN","BPSECFM",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECFM",4,0) ; "RTN","BPSECFM",5,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",6,0) ;NCPDP Field Format Functions "RTN","BPSECFM",7,0) ; These are all $$ functions called from the FORMAT CODE/D0 FORMAT "RTN","BPSECFM",8,0) ; CODE fields of BPS NCPDP FIELD DEFS, output transforms, and from "RTN","BPSECFM",9,0) ; routines "RTN","BPSECFM",10,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",11,0) ;Numeric Format Function "RTN","BPSECFM",12,0) NFF(X,L) ;EP - "RTN","BPSECFM",13,0) Q $E($TR($J("",L-$L(X))," ","0")_X,1,L) "RTN","BPSECFM",14,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",15,0) ;Signed Numeric Field Format "RTN","BPSECFM",16,0) DFF(X,L) ; "RTN","BPSECFM",17,0) N FNUMBER,DOLLAR,CENTS,SVALUE "RTN","BPSECFM",18,0) I $G(X)="" S X=0 "RTN","BPSECFM",19,0) S DOLLAR=+$TR($P(X,".",1),"-","") "RTN","BPSECFM",20,0) S CENTS=$E($P(X,".",2),1,2) "RTN","BPSECFM",21,0) S:$L(CENTS)=0 CENTS="00" "RTN","BPSECFM",22,0) S:$L(CENTS)=1 CENTS=CENTS_"0" "RTN","BPSECFM",23,0) S SVALUE=$S(X<0:"}JKLMNOPQR",1:"{ABCDEFGHI") "RTN","BPSECFM",24,0) S $E(CENTS,2)=$E(SVALUE,$E(CENTS,2)+1) "RTN","BPSECFM",25,0) Q $E($TR($J("",L-$L(DOLLAR_CENTS))," ","0")_DOLLAR_CENTS,1,L) "RTN","BPSECFM",26,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",27,0) ;Converts Signed Numeric Field to Decimal Value "RTN","BPSECFM",28,0) DFF2EXT(X) ;EP - "RTN","BPSECFM",29,0) N LCHAR "RTN","BPSECFM",30,0) S LCHAR=$E(X,$L(X)) "RTN","BPSECFM",31,0) S X=$TR(X,"{ABCDEFGHI","0123456789") "RTN","BPSECFM",32,0) S X=$TR(X,"}JKLMNOPQR","0123456789") "RTN","BPSECFM",33,0) S X=X*.01 "RTN","BPSECFM",34,0) I "}JKLMNOPQR"[LCHAR S X=X*-1 "RTN","BPSECFM",35,0) Q $J(+X,$L(+X),2) "RTN","BPSECFM",36,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",37,0) ;Alpha-Numeric Field Format "RTN","BPSECFM",38,0) ANFF(X,L) ;EP "RTN","BPSECFM",39,0) Q $E(X_$J("",L-$L(X)),1,L) "RTN","BPSECFM",40,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",41,0) ;Convert FileManager date into CCYYMMDD format "RTN","BPSECFM",42,0) DTF1(X) ;EP - "RTN","BPSECFM",43,0) N Y,%DT "RTN","BPSECFM",44,0) ;Q:X'["." X "RTN","BPSECFM",45,0) S X=$P(X,".",1) "RTN","BPSECFM",46,0) Q:X="" "00000000" "RTN","BPSECFM",47,0) S Y=X D DD^%DT "RTN","BPSECFM",48,0) S X=Y,%DT="X" D ^%DT "RTN","BPSECFM",49,0) Q:Y=-1 "00000000" "RTN","BPSECFM",50,0) S X=Y+17000000 "RTN","BPSECFM",51,0) Q X "RTN","BPSECFM",52,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",53,0) ;Reformats NDC number "RTN","BPSECFM",54,0) NDCF(X) ;EP - "RTN","BPSECFM",55,0) S X=$TR(X,"-","") "RTN","BPSECFM",56,0) I X?11N Q X ; no reformatting needed "RTN","BPSECFM",57,0) I $L(X)<11 F I=1:1:(11-$L(X)) S X="0"_X "RTN","BPSECFM",58,0) I $L(X)>11 S X=$E(X,2,12) "RTN","BPSECFM",59,0) S X=$E(X,1,5)_"-"_$E(X,6,9)_"-"_$E(X,10,11) "RTN","BPSECFM",60,0) N Y,I "RTN","BPSECFM",61,0) F I=1:1:3 S Y(I)=$P(X,"-",I) "RTN","BPSECFM",62,0) S X=$$RJZF(Y(1),5)_$$RJZF(Y(2),4)_$$RJZF(Y(3),2) "RTN","BPSECFM",63,0) Q X "RTN","BPSECFM",64,0) ;---------------------------------------------------------------------- "RTN","BPSECFM",65,0) ;Right justify and zero fill X in a string of length L "RTN","BPSECFM",66,0) RJZF(X,L) ; "RTN","BPSECFM",67,0) I $L(X)0 D RXSUBF^BPSUTIL1(RXIEN,52,52.1,FILLNUM,".01;1;1.1;11","RFINFO","E") ; esg - 4/28/10 - add Rx QTY (*8) "RTN","BPSECMP2",78,0) ; "RTN","BPSECMP2",79,0) ; Fill Date "RTN","BPSECMP2",80,0) S BPSARRY("FILL DATE")=CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","401") "RTN","BPSECMP2",81,0) S %DT="X",X=BPSARRY("FILL DATE") D ^%DT S:Y'=-1 BPSARRY("FILL DATE")=Y "RTN","BPSECMP2",82,0) ; "RTN","BPSECMP2",83,0) ; Information needed for PAID/BILLING event "RTN","BPSECMP2",84,0) S BPSARRY("PAID")=0 "RTN","BPSECMP2",85,0) I RESPONSE="PAYABLE" D "RTN","BPSECMP2",86,0) . S BPSARRY("PAID")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",509,"I")) "RTN","BPSECMP2",87,0) . S BPSARRY("COPAY")=$$DFF2EXT^BPSECFM(RESPNFO(9002313.0301,"1,"_RESPIEN_",",518,"I")) "RTN","BPSECMP2",88,0) . S BPSARRY("AUTH #")=RESPNFO(9002313.0301,"1,"_RESPIEN_",",503,"I") "RTN","BPSECMP2",89,0) . S BPSARRY("RX NO")=RXINFO(52,RXIEN,.01,"E") "RTN","BPSECMP2",90,0) . S BPSARRY("DRUG")=$$RXAPI1^BPSUTIL1(RXIEN,6,"I") "RTN","BPSECMP2",91,0) . I FILLNUM<1 D "RTN","BPSECMP2",92,0) .. S BPSARRY("DAYS SUPPLY")=RXINFO(52,RXIEN,8,"E") "RTN","BPSECMP2",93,0) .. S BPSARRY("QTY")=RXINFO(52,RXIEN,7,"E") ; Rx fill quantity "RTN","BPSECMP2",94,0) . E D "RTN","BPSECMP2",95,0) .. S BPSARRY("DAYS SUPPLY")=$G(RFINFO(52.1,FILLNUM,1.1,"E")) "RTN","BPSECMP2",96,0) .. S BPSARRY("QTY")=$G(RFINFO(52.1,FILLNUM,1,"E")) ; Rx refill quantity "RTN","BPSECMP2",97,0) ; "RTN","BPSECMP2",98,0) ; Get primary IB bill# and prior payment amount "RTN","BPSECMP2",99,0) I $D(^BPST(TRNDX,10,1,2)) D "RTN","BPSECMP2",100,0) . S BPSARRY("PRIMARY BILL")=$P(^BPST(TRNDX,10,1,2),U,8) "RTN","BPSECMP2",101,0) . S BPSARRY("PRIOR PAYMENT")=$P(^BPST(TRNDX,10,1,2),U,9) "RTN","BPSECMP2",102,0) ; "RTN","BPSECMP2",103,0) ; Setup miscellaneous values "RTN","BPSECMP2",104,0) S BPSARRY("RXCOB")=$$COB59^BPSUTIL2(TRNDX) "RTN","BPSECMP2",105,0) S BPSARRY("NDC")=$$GETNDC^PSONDCUT(RXIEN,FILLNUM) "RTN","BPSECMP2",106,0) S BPSARRY("FILL NUMBER")=FILLNUM "RTN","BPSECMP2",107,0) S BPSARRY("FILLED BY")=RXINFO(52,RXIEN,16,"I") "RTN","BPSECMP2",108,0) S BPSARRY("PRESCRIPTION")=RXIEN "RTN","BPSECMP2",109,0) S BPSARRY("BILLED")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","426"),"DQ",2) "RTN","BPSECMP2",110,0) S BPSARRY("BILLED")=$$DFF2EXT^BPSECFM(BPSARRY("BILLED")) "RTN","BPSECMP2",111,0) S BPSARRY("CLAIMID")=$P(CLAIMNFO("9002313.0201","1,"_CLAIMIEN_",","402"),"D2",2) "RTN","BPSECMP2",112,0) S RELDATE=$S(FILLNUM=0:$$RXAPI1^BPSUTIL1(RXIEN,31,"I"),1:$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,FILLNUM,17,"I")) "RTN","BPSECMP2",113,0) S BPSARRY("RELEASE DATE")=$P(RELDATE,".") "RTN","BPSECMP2",114,0) S BPSARRY("RESPONSE")=RESPONSE "RTN","BPSECMP2",115,0) S BPSARRY("EPHARM")=$$GET1^DIQ(9002313.59,TRNDX,1.07,"I") "RTN","BPSECMP2",116,0) ; "RTN","BPSECMP2",117,0) ; For reversals, get reversal reason and check for closed reason "RTN","BPSECMP2",118,0) ; Call IB with Reversal Event "RTN","BPSECMP2",119,0) ; If there is a close reason, call IB with CLOSE event "RTN","BPSECMP2",120,0) ; and update BPS Claim with close information "RTN","BPSECMP2",121,0) I EVENT="",$$ISREVERS^BPSOSU(CLAIMIEN) D Q "RTN","BPSECMP2",122,0) . S REQCLAIM=TRANINFO("9002313.59",TRNDX_",",3,"I") "RTN","BPSECMP2",123,0) . S BPSARRY("REVERSAL REASON")=TRANINFO("9002313.59",TRNDX_",",404,"I") "RTN","BPSECMP2",124,0) . S BPSARRY("RTS-DEL")=0 "RTN","BPSECMP2",125,0) . ; Get RX action, which determine close event "RTN","BPSECMP2",126,0) . I RXACT="RS" S CLREAS="PRESCRIPTION NOT RELEASED",BPSARRY("RTS-DEL")=1 "RTN","BPSECMP2",127,0) . I RXACT="DE" D "RTN","BPSECMP2",128,0) . . S CLREAS="PRESCRIPTION DELETED",BPSARRY("RTS-DEL")=1 "RTN","BPSECMP2",129,0) . . ; check whether RX was in fact deleted in Pharmacy "RTN","BPSECMP2",130,0) . . ; if not then the refill was deleted "RTN","BPSECMP2",131,0) . . I $$RXSTATUS^BPSSCRU2(RXIEN)'=13 S BPSARRY("CLOSE COMMENT")="DELETION OF REFILL ONLY - ORIGINAL RX MAY REMAIN ACTIVE" "RTN","BPSECMP2",132,0) . ; If accepted inpatient autoreversal, then close the claim "RTN","BPSECMP2",133,0) . I RXACT="AREV",RESPONSE="ACCEPTED",REQCLAIM,$P($G(^BPSC(REQCLAIM,0)),U,7)=2 D "RTN","BPSECMP2",134,0) .. S CLREAS="OTHER",BPSARRY("CLOSE COMMENT")="INPATIENT PRESCRIPTION" "RTN","BPSECMP2",135,0) . I $D(CLREAS) S BPSARRY("CLOSE REASON")=$O(^IBE(356.8,"B",CLREAS,0)) "RTN","BPSECMP2",136,0) . ; "RTN","BPSECMP2",137,0) . ; Call IB for Reversal Event "RTN","BPSECMP2",138,0) . S BPSARRY("STATUS")="REVERSED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",139,0) . ; If there is no close reason, quit "RTN","BPSECMP2",140,0) . I '$D(BPSARRY("CLOSE REASON")) Q "RTN","BPSECMP2",141,0) . ; Call IB for CLOSE event "RTN","BPSECMP2",142,0) . ; Note for close, user is always postmaster (.5) "RTN","BPSECMP2",143,0) . S BPSARRY("STATUS")="CLOSED",BPSARRY("USER")=.5 "RTN","BPSECMP2",144,0) . S BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",145,0) . ; "RTN","BPSECMP2",146,0) . ; Populate the original claim request with the close reason "RTN","BPSECMP2",147,0) . I REQCLAIM D "RTN","BPSECMP2",148,0) .. S DIE="^BPSC(",DA=REQCLAIM "RTN","BPSECMP2",149,0) .. S DR="901///1;902///"_$$NOW^XLFDT()_";903////.5;904///"_BPSARRY("CLOSE REASON") "RTN","BPSECMP2",150,0) .. D ^DIE "RTN","BPSECMP2",151,0) ; "RTN","BPSECMP2",152,0) ; If we got here, then it is not a reversal "RTN","BPSECMP2",153,0) ; If EVENT is set, send Submit event "RTN","BPSECMP2",154,0) I EVENT="" S BPSARRY("STATUS")="SUBMITTED",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",155,0) ; "RTN","BPSECMP2",156,0) ; Sent Paid (Billable) event is the claim was paid and released or EVENT is BILL "RTN","BPSECMP2",157,0) ; Note: User is always postmaster except for BackBilling (BB) "RTN","BPSECMP2",158,0) I EVENT="BILL"!(RESPONSE="PAYABLE"&(BPSARRY("RELEASE DATE")]"")) D "RTN","BPSECMP2",159,0) . I RXACT'="BB" S BPSARRY("USER")=.5 "RTN","BPSECMP2",160,0) . ;set reject flag and store primary plan to serve secondary billing when primary claim was rejected "RTN","BPSECMP2",161,0) . I BPSARRY("RXCOB")=2 I $P($$STATUS^BPSOSRX(RXIEN,FILLNUM,,,1),U)["E REJECTED" D "RTN","BPSECMP2",162,0) . . N REJS "RTN","BPSECMP2",163,0) . . S BPSARRY("PRIMREJ")=1,BPSARRY("PRIMPLAN")=$P(^BPST(+$$IEN59^BPSOSRX(RXIEN,FILLNUM,1),10,1,0),U) "RTN","BPSECMP2",164,0) . . D DUR1^BPSNCPD3(RXIEN,FILLNUM,.REJS,"",1) "RTN","BPSECMP2",165,0) . . S BPSARRY("REJ CODE LST")=$G(REJS(1,"REJ CODE LST")) "RTN","BPSECMP2",166,0) . . M BPSARRY("REJ CODES")=REJS(1,"REJ CODES") "RTN","BPSECMP2",167,0) . ; "RTN","BPSECMP2",168,0) . S BPSARRY("STATUS")="PAID",BILLNUM=$$STORESP^IBNCPDP(DFN,.BPSARRY) "RTN","BPSECMP2",169,0) Q "RTN","BPSECMP2",170,0) ; "RTN","BPSECMP2",171,0) ; Synch DURs between ECME and PSO "RTN","BPSECMP2",172,0) ; Parameters: "RTN","BPSECMP2",173,0) ; IEN59 is the BPS Transaction IEN "RTN","BPSECMP2",174,0) DURSYNC(IEN59) ; "RTN","BPSECMP2",175,0) N RXIEN,RXFILL "RTN","BPSECMP2",176,0) ; "RTN","BPSECMP2",177,0) ; Check Parameter "RTN","BPSECMP2",178,0) I IEN59="" Q "RTN","BPSECMP2",179,0) ; "RTN","BPSECMP2",180,0) ; Get Prescription and Fill number "RTN","BPSECMP2",181,0) S RXIEN=$$GET1^DIQ(9002313.59,IEN59_",",1.11,"I") "RTN","BPSECMP2",182,0) S RXFILL=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",",902.17,"E") "RTN","BPSECMP2",183,0) I RXIEN=""!(RXFILL="") Q "RTN","BPSECMP2",184,0) ; "RTN","BPSECMP2",185,0) ; Call PSO to sync reject codes "RTN","BPSECMP2",186,0) D SYNC^PSOREJUT(RXIEN,RXFILL,"",$$COB59^BPSUTIL2(IEN59)) "RTN","BPSECMP2",187,0) Q "RTN","BPSECMP2",188,0) ; "RTN","BPSECMP2",189,0) ; Process Other Paid Amount Grouping from the Pricing Segment "RTN","BPSECMP2",190,0) ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed "RTN","BPSECMP2",191,0) ; and initialized by BPSECMPS "RTN","BPSECMP2",192,0) PROCOTH ; "RTN","BPSECMP2",193,0) Q:$G(FDATA(TRANSACT,563))="" "RTN","BPSECMP2",194,0) N NNDX,FILE,ROOT,FDATA3,FLDNUM "RTN","BPSECMP2",195,0) S FILE="9002313.1401" "RTN","BPSECMP2",196,0) S ROOT="FDATA3(9002313.1401)" "RTN","BPSECMP2",197,0) S NNDX="" "RTN","BPSECMP2",198,0) F S NNDX=$O(FDATA(TRANSACT,564,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",199,0) .S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT) "RTN","BPSECMP2",200,0) .F FLDNUM=564,565 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT) "RTN","BPSECMP2",201,0) D UPDATE^DIE("S","FDATA3(9002313.1401)") "RTN","BPSECMP2",202,0) Q "RTN","BPSECMP2",203,0) ; "RTN","BPSECMP2",204,0) ; Process the Benefits Stage fields from the Pricing Segment "RTN","BPSECMP2",205,0) ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed "RTN","BPSECMP2",206,0) ; and initialized by BPSECMPS "RTN","BPSECMP2",207,0) PROCBEN ; "RTN","BPSECMP2",208,0) Q:$G(FDATA(TRANSACT,392))="" "RTN","BPSECMP2",209,0) N NNDX,FILE,ROOT,FDATA3,FLDNUM "RTN","BPSECMP2",210,0) S FILE="9002313.039201" "RTN","BPSECMP2",211,0) S ROOT="FDATA3(9002313.039201)" "RTN","BPSECMP2",212,0) S NNDX="" "RTN","BPSECMP2",213,0) F S NNDX=$O(FDATA(TRANSACT,393,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",214,0) .S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT) "RTN","BPSECMP2",215,0) .F FLDNUM=393,394 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT) "RTN","BPSECMP2",216,0) D UPDATE^DIE("S","FDATA3(9002313.039201)") "RTN","BPSECMP2",217,0) Q "RTN","BPSECMP2",218,0) ; "RTN","BPSECMP2",219,0) ; Process the Additional Message Information Multiple from the Status Segment "RTN","BPSECMP2",220,0) ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed "RTN","BPSECMP2",221,0) ; and initialized by BPSECMPS "RTN","BPSECMP2",222,0) PROCADM ; "RTN","BPSECMP2",223,0) N NNDX,FILE,ROOT,FDATA3,FLDNUM,FDATA03,FILE03,ROOT03 "RTN","BPSECMP2",224,0) S FILE="9002313.13001",ROOT="FDATA3(9002313.13001)" "RTN","BPSECMP2",225,0) S FILE03="9002313.0301",ROOT03="FDATA03(9002313.0301)" "RTN","BPSECMP2",226,0) S NNDX="" "RTN","BPSECMP2",227,0) ; D.0 Processing: 526 is in a multiple with the group 132 "RTN","BPSECMP2",228,0) I $O(FDATA(TRANSACT,132,0))]"" D Q "RTN","BPSECMP2",229,0) . F S NNDX=$O(FDATA(TRANSACT,526,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",230,0) . . S FLDNUM=.01 D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT) "RTN","BPSECMP2",231,0) . . F FLDNUM=131,132,526 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT) "RTN","BPSECMP2",232,0) . D UPDATE^DIE("S","FDATA3(9002313.13001)") "RTN","BPSECMP2",233,0) ; "RTN","BPSECMP2",234,0) ; 5.1 Processing: 526 is not in a group but is stored in one "RTN","BPSECMP2",235,0) I $O(FDATA(TRANSACT,526,0))]"" D Q "RTN","BPSECMP2",236,0) . F S NNDX=$O(FDATA(TRANSACT,526,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",237,0) . . S FLDNUM=.01 D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",1,ROOT) "RTN","BPSECMP2",238,0) . . S FLDNUM=132 D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"","01",ROOT) "RTN","BPSECMP2",239,0) . . D FDA^DILF(FILE,"+1,"_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),526,"",$G(FDATA(TRANSACT,526,NNDX)),ROOT) "RTN","BPSECMP2",240,0) . D UPDATE^DIE("S","FDATA3(9002313.13001)") "RTN","BPSECMP2",241,0) . ; Set Additional Message Information Count field "RTN","BPSECMP2",242,0) . D FDA^DILF(FILE03,"+"_TRANSACT_","_FDAIEN(TRANSACT),130,"",1,ROOT03) "RTN","BPSECMP2",243,0) . D UPDATE^DIE("S","FDATA03(9002313.0301)") "RTN","BPSECMP2",244,0) Q "RTN","BPSECMP2",245,0) ; "RTN","BPSECMP2",246,0) ; Process DUR Response Segment "RTN","BPSECMP2",247,0) ; Note that FDATA, TRANSACT, FDAIEN, and FDAIEN03 are newed "RTN","BPSECMP2",248,0) ; and initialized by BPSECMPS "RTN","BPSECMP2",249,0) PROCDUR ; "RTN","BPSECMP2",250,0) Q:$O(FDATA(TRANSACT,567,0))="" "RTN","BPSECMP2",251,0) N NNDX,FILE,ROOT,FDAT1101,FLDNUM "RTN","BPSECMP2",252,0) S FILE="9002313.1101" "RTN","BPSECMP2",253,0) S ROOT="FDAT1101(9002313.1101)" "RTN","BPSECMP2",254,0) S NNDX="" "RTN","BPSECMP2",255,0) F S NNDX=$O(FDATA(TRANSACT,567,NNDX)) Q:NNDX="" D "RTN","BPSECMP2",256,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,567,NNDX),ROOT) "RTN","BPSECMP2",257,0) .F FLDNUM=439,528,529,530,531,532,533,544,570 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,FLDNUM,NNDX),ROOT) "RTN","BPSECMP2",258,0) D UPDATE^DIE("S","FDAT1101(9002313.1101)") "RTN","BPSECMP2",259,0) Q "RTN","BPSECMPS") 0^20^B98920700 "RTN","BPSECMPS",1,0) BPSECMPS ;BHAM ISC/FCS/DRS - Parse Claim Response ;3/10/08 12:31 "RTN","BPSECMPS",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,6,7,10**;JUN 2004;Build 27 "RTN","BPSECMPS",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECMPS",4,0) ; "RTN","BPSECMPS",5,0) ; references to UPDATE^DIE and WP^DIE supported by DBIA 2053 "RTN","BPSECMPS",6,0) ; reference to FDA^DILF supported by DBIA 2054 "RTN","BPSECMPS",7,0) ; "RTN","BPSECMPS",8,0) PARSE(RREC,CLAIMIEN,RESPIEN) ; "RTN","BPSECMPS",9,0) ; "RTN","BPSECMPS",10,0) N FDAIEN,FDAIEN03,FDATA,FILE,FS,GS,ROOT,SS,TRANSACT,TRANSCNT "RTN","BPSECMPS",11,0) ; "RTN","BPSECMPS",12,0) ; RREC and CLAIMIEN are required "RTN","BPSECMPS",13,0) Q:$G(RREC)="" "RTN","BPSECMPS",14,0) Q:$G(CLAIMIEN)="" "RTN","BPSECMPS",15,0) ; "RTN","BPSECMPS",16,0) ;group and field separator characters "RTN","BPSECMPS",17,0) S GS="\X1D\",FS="\X1C\",SS="\X1E\" "RTN","BPSECMPS",18,0) S FILE="9002313.03",ROOT="FDATA(9002313.03)" "RTN","BPSECMPS",19,0) D TRANSMSN ; process transmission level data, transaction count in TRANSCNT (from PARSEH) "RTN","BPSECMPS",20,0) D TRANSACT ; process transaction level data "RTN","BPSECMPS",21,0) ; "RTN","BPSECMPS",22,0) ; If test system and test active, call the override routine "RTN","BPSECMPS",23,0) ; IEN59 and TRANTYPE are set in BPSECMC2 "RTN","BPSECMPS",24,0) ; "RTN","BPSECMPS",25,0) I $$CHECK^BPSTEST D SETOVER^BPSTEST(IEN59,TRANTYPE,.FDATA) "RTN","BPSECMPS",26,0) D UPDATE^DIE("S","FDATA(9002313.03)","FDAIEN") "RTN","BPSECMPS",27,0) F TRANSACT=1:1:TRANSCNT D "RTN","BPSECMPS",28,0) .D PROCRESP "RTN","BPSECMPS",29,0) .D PROCREJ "RTN","BPSECMPS",30,0) .D PROCAPP "RTN","BPSECMPS",31,0) .D PROCPPR "RTN","BPSECMPS",32,0) .D PROCCOB "RTN","BPSECMPS",33,0) .D PROCOTH^BPSECMP2 "RTN","BPSECMPS",34,0) .D PROCBEN^BPSECMP2 "RTN","BPSECMPS",35,0) .D PROCADM^BPSECMP2 "RTN","BPSECMPS",36,0) .D PROCDUR^BPSECMP2 "RTN","BPSECMPS",37,0) S RESPIEN=FDAIEN(1) "RTN","BPSECMPS",38,0) ; This should be called for each transaction but the IBSEND is not "RTN","BPSECMPS",39,0) ; setup correctly so currently it is only called for each claim/response "RTN","BPSECMPS",40,0) ; If we ever bundle claims, we will need to fix IBSEND and move this code "RTN","BPSECMPS",41,0) ; to the FOR loop above. "RTN","BPSECMPS",42,0) D IBSEND^BPSECMP2(CLAIMIEN,RESPIEN,"","") "RTN","BPSECMPS",43,0) D RAW(RESPIEN,RREC) "RTN","BPSECMPS",44,0) ; "RTN","BPSECMPS",45,0) Q "RTN","BPSECMPS",46,0) ; "RTN","BPSECMPS",47,0) TRANSMSN ;This subroutine will work through the transmission level information "RTN","BPSECMPS",48,0) ; "RTN","BPSECMPS",49,0) N RHEADER,RTRANM,SEG,SEGID,SEGMENT "RTN","BPSECMPS",50,0) ; "RTN","BPSECMPS",51,0) ;Parse response transmission level from ascii record "RTN","BPSECMPS",52,0) S RTRANM=$P(RREC,GS,1) "RTN","BPSECMPS",53,0) ; "RTN","BPSECMPS",54,0) ; get just the header segment "RTN","BPSECMPS",55,0) S RHEADER=$P(RTRANM,SS,1) ;header- required/fixed length "RTN","BPSECMPS",56,0) D PARSEH "RTN","BPSECMPS",57,0) ; "RTN","BPSECMPS",58,0) ; There are 2 optional segments on the transmission level - message "RTN","BPSECMPS",59,0) ; and insurance. We'll check for both and parse what we find. "RTN","BPSECMPS",60,0) F SEG=2:1:3 D "RTN","BPSECMPS",61,0) . S SEGMENT=$P(RTRANM,SS,SEG) "RTN","BPSECMPS",62,0) . Q:SEGMENT="" "RTN","BPSECMPS",63,0) . S SEGID=$P(SEGMENT,FS,2) "RTN","BPSECMPS",64,0) . I $E(SEGID,1,2)="AM" D ; segment identification "RTN","BPSECMPS",65,0) .. S SEGFID=$E(SEGID,3,4) "RTN","BPSECMPS",66,0) .. D:(SEGFID=20)!(SEGFID=25) PARSETM "RTN","BPSECMPS",67,0) ; "RTN","BPSECMPS",68,0) Q "RTN","BPSECMPS",69,0) ; "RTN","BPSECMPS",70,0) TRANSACT ;This subroutine will work through the transaction level information "RTN","BPSECMPS",71,0) ; "RTN","BPSECMPS",72,0) N GRP,MEDN,RTRAN,SEG,SEGMENT "RTN","BPSECMPS",73,0) S MEDN=0 "RTN","BPSECMPS",74,0) ; "RTN","BPSECMPS",75,0) F GRP=2:1 D Q:RTRAN="" "RTN","BPSECMPS",76,0) . S RTRAN=$P(RREC,GS,GRP) ;get the next transaction (could be 4) "RTN","BPSECMPS",77,0) . Q:RTRAN="" ;we're done if it's empty "RTN","BPSECMPS",78,0) . S MEDN=MEDN+1 ;transaction counter "RTN","BPSECMPS",79,0) . ; "RTN","BPSECMPS",80,0) . F SEG=2:1 D Q:SEGMENT="" ;break the record down by segments "RTN","BPSECMPS",81,0) .. S SEGMENT=$P(RTRAN,SS,SEG) ;get the segment "RTN","BPSECMPS",82,0) .. Q:SEGMENT="" "RTN","BPSECMPS",83,0) .. D PARSETN ;get the fields "RTN","BPSECMPS",84,0) Q "RTN","BPSECMPS",85,0) ; "RTN","BPSECMPS",86,0) PARSEH ; parse the header record, required on all responses, and is fixed length "RTN","BPSECMPS",87,0) ; It's the only record that is fixed length. "RTN","BPSECMPS",88,0) ; "RTN","BPSECMPS",89,0) D FDA^DILF(FILE,"+1",.01,"",CLAIMIEN,ROOT) ; CLAIM ID "RTN","BPSECMPS",90,0) D FDA^DILF(FILE,"+1",.02,"",$$NOWFM^BPSOSU1,ROOT) ; DATE RESPONSE RECEIVED "RTN","BPSECMPS",91,0) D FDA^DILF(FILE,"+1",102,"",$E(RHEADER,33,34),ROOT) ; VERSION RELEASE NUMBER "RTN","BPSECMPS",92,0) D FDA^DILF(FILE,"+1",103,"",$E(RHEADER,35,36),ROOT) ; TRANSACTION CODE "RTN","BPSECMPS",93,0) D FDA^DILF(FILE,"+1",109,"",$E(RHEADER,37,37),ROOT) ; TRANSACTION COUNT "RTN","BPSECMPS",94,0) S TRANSCNT=$E(RHEADER,37,37) "RTN","BPSECMPS",95,0) D FDA^DILF(FILE,"+1",501,"",$E(RHEADER,38,38),ROOT) ; response status header "RTN","BPSECMPS",96,0) D FDA^DILF(FILE,"+1",202,"",$E(RHEADER,39,40),ROOT) ; SERVICE PROVIDER ID Qualifier "RTN","BPSECMPS",97,0) D FDA^DILF(FILE,"+1",201,"",$E(RHEADER,41,55),ROOT) ; SERVICE PROVIDER ID "RTN","BPSECMPS",98,0) D FDA^DILF(FILE,"+1",401,"",$E(RHEADER,56,63),ROOT) ; DATE OF SERVICE "RTN","BPSECMPS",99,0) ; "RTN","BPSECMPS",100,0) Q "RTN","BPSECMPS",101,0) ; "RTN","BPSECMPS",102,0) PARSETM ; parse the variable portions of the transmission "RTN","BPSECMPS",103,0) ; "RTN","BPSECMPS",104,0) N FIELD,FLDNUM,PC "RTN","BPSECMPS",105,0) ; "RTN","BPSECMPS",106,0) F PC=3:1 D Q:FIELD="" ;skip the seg id -already know its value "RTN","BPSECMPS",107,0) . S FIELD=$P(SEGMENT,FS,PC) ;piece through the record "RTN","BPSECMPS",108,0) . Q:FIELD="" ;stop - we hit the end "RTN","BPSECMPS",109,0) . S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage "RTN","BPSECMPS",110,0) . Q:FLDNUM="" ;shouldn't happen - but let's skip "RTN","BPSECMPS",111,0) . S FIELD=$E(FIELD,3,999) "RTN","BPSECMPS",112,0) . D FDA^DILF(FILE,"+1",FLDNUM,"",FIELD,ROOT) "RTN","BPSECMPS",113,0) Q "RTN","BPSECMPS",114,0) ; "RTN","BPSECMPS",115,0) PARSETN ; parse the transaction level segments "RTN","BPSECMPS",116,0) ; "RTN","BPSECMPS",117,0) ; Possible values of the SEGFID field: "RTN","BPSECMPS",118,0) ; 21 = Response Status Segment "RTN","BPSECMPS",119,0) ; 22 = Response Claim Segment "RTN","BPSECMPS",120,0) ; 23 = Response Pricing Segment "RTN","BPSECMPS",121,0) ; 24 = Response DUR/PPS Segment "RTN","BPSECMPS",122,0) ; 26 = Response Prior Authorization Segment "RTN","BPSECMPS",123,0) ; 28 = Response Coordination of Benefits/Other Payers Segment "RTN","BPSECMPS",124,0) ; "RTN","BPSECMPS",125,0) N CKRPT,FIELD,FLDNUM,PC,RCNT,REPEAT,RPTFLD,SEGFID,SEGID,GRPCNT,GRPFLDS "RTN","BPSECMPS",126,0) ; "RTN","BPSECMPS",127,0) S RPTFLD="" "RTN","BPSECMPS",128,0) S SEGID=$P(SEGMENT,FS,2) ; this should be the segment id "RTN","BPSECMPS",129,0) Q:SEGID="" ; don't process without a Seg id "RTN","BPSECMPS",130,0) Q:$E(SEGID,1,2)'="AM" ; don't know what we have - skip "RTN","BPSECMPS",131,0) ; "RTN","BPSECMPS",132,0) S SEGFID=$E(SEGID,3,4) ; this should be the field ID "RTN","BPSECMPS",133,0) S GRPCNT=0,GRPFLDS="" "RTN","BPSECMPS",134,0) ; "RTN","BPSECMPS",135,0) ; setup the repeating flds based on the segment "RTN","BPSECMPS",136,0) I SEGFID=21 D ;status segment "RTN","BPSECMPS",137,0) . S RPTFLD=",548,511,546,132,526,131," "RTN","BPSECMPS",138,0) . S (RCNT(548),RCNT(511),RCNT(546),RCNT(132),RCNT(526),RCNT(131))=0 "RTN","BPSECMPS",139,0) . S GRPCNT=0 "RTN","BPSECMPS",140,0) . S GRPFLDS=",511,548,132," "RTN","BPSECMPS",141,0) ; "RTN","BPSECMPS",142,0) I SEGFID=22 D ;claim segment "RTN","BPSECMPS",143,0) . S RPTFLD=",552,553,554,555,556," "RTN","BPSECMPS",144,0) . S (RCNT(552),RCNT(553),RCNT(554),RCNT(555),RCNT(556))=0 "RTN","BPSECMPS",145,0) . S GRPCNT=0 "RTN","BPSECMPS",146,0) . S GRPFLDS=",552," "RTN","BPSECMPS",147,0) ; "RTN","BPSECMPS",148,0) I SEGFID=23 D ;pricing segment "RTN","BPSECMPS",149,0) . S RPTFLD=",564,565,393,394," "RTN","BPSECMPS",150,0) . S (RCNT(564),RCNT(565),RCNT(393),RCNT(394))=0 "RTN","BPSECMPS",151,0) . S GRPCNT=0 "RTN","BPSECMPS",152,0) . S GRPFLDS=",564,393," "RTN","BPSECMPS",153,0) ; "RTN","BPSECMPS",154,0) I SEGFID=24 D ;DUR/PPS segment "RTN","BPSECMPS",155,0) . S RPTFLD=",439,528,529,530,531,532,533,544,567,570" "RTN","BPSECMPS",156,0) . S (RCNT(439),RCNT(528),RCNT(529),RCNT(530),RCNT(531))=0 "RTN","BPSECMPS",157,0) . S (RCNT(532),RCNT(533),RCNT(567),RCNT(544),RCNT(570))=0 "RTN","BPSECMPS",158,0) . S GRPCNT=0 "RTN","BPSECMPS",159,0) . S GRPFLDS=",567," "RTN","BPSECMPS",160,0) ; "RTN","BPSECMPS",161,0) I SEGFID=28 D ;COB/Other Payers segment "RTN","BPSECMPS",162,0) . S RPTFLD=",127,142,143,144,145,338,339,340,356,991,992," "RTN","BPSECMPS",163,0) . S (RCNT(127),RCNT(142),RCNT(143),RCNT(144),RCNT(145),RCNT(338))=0 "RTN","BPSECMPS",164,0) . S (RCNT(339),RCNT(340),RCNT(356),RCNT(991),RCNT(992))=0 "RTN","BPSECMPS",165,0) . S GRPCNT=0 "RTN","BPSECMPS",166,0) . S GRPFLDS=",338," "RTN","BPSECMPS",167,0) ; "RTN","BPSECMPS",168,0) ; now let's parse out the fields "RTN","BPSECMPS",169,0) ; "RTN","BPSECMPS",170,0) F PC=3:1 D Q:FIELD="" ;skip the seg id -jump to the other flds "RTN","BPSECMPS",171,0) . S FIELD=$P(SEGMENT,FS,PC) ;piece through the record "RTN","BPSECMPS",172,0) . Q:FIELD="" ;stop - we hit the end "RTN","BPSECMPS",173,0) . S FLDNUM=$$GETNUM(FIELD) ;get the field number used for storage "RTN","BPSECMPS",174,0) . Q:FLDNUM="" ;shouldn't happen - but let's skip "RTN","BPSECMPS",175,0) . S REPEAT=0 ;for this segment, let's figure "RTN","BPSECMPS",176,0) . S CKRPT=","_FLDNUM_"," ;out if the field is a repeating "RTN","BPSECMPS",177,0) . S:RPTFLD[CKRPT REPEAT=1 ;field "RTN","BPSECMPS",178,0) . ; Increment the group counter if first field of group. "RTN","BPSECMPS",179,0) . S:GRPFLDS[CKRPT GRPCNT=GRPCNT+1 "RTN","BPSECMPS",180,0) . ; if rptg, store with a group counter "RTN","BPSECMPS",181,0) . S:REPEAT FDATA(MEDN,FLDNUM,GRPCNT)=$E(FIELD,3,$L(FIELD)) "RTN","BPSECMPS",182,0) . ; not rptg, store without counter "RTN","BPSECMPS",183,0) . S:'REPEAT FDATA(MEDN,FLDNUM)=$E(FIELD,3,$L(FIELD)) "RTN","BPSECMPS",184,0) ; "RTN","BPSECMPS",185,0) Q "RTN","BPSECMPS",186,0) ; "RTN","BPSECMPS",187,0) GETNUM(FIELD) ; function, return field number for a field I "RTN","BPSECMPS",188,0) ; use BPS NCPDP FIELD DEFS (#9002313.91) "D" cross ref for lookup "RTN","BPSECMPS",189,0) ; field number is used to store the data in the correct field in BPS RESPONSES (#9002313.03) "RTN","BPSECMPS",190,0) ; "RTN","BPSECMPS",191,0) N FLDID,FLDIEN,FLDNUM "RTN","BPSECMPS",192,0) S FLDID=$E(FIELD,1,2),FLDNUM="" "RTN","BPSECMPS",193,0) Q:FLDID="" FLDNUM ; FLDID = field identifier "RTN","BPSECMPS",194,0) ; "RTN","BPSECMPS",195,0) S FLDIEN=$O(^BPSF(9002313.91,"D",FLDID,0)) ; ien for fld # "RTN","BPSECMPS",196,0) S:FLDIEN FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,0)),U) ;fld number "RTN","BPSECMPS",197,0) Q FLDNUM "RTN","BPSECMPS",198,0) ; "RTN","BPSECMPS",199,0) PROCRESP ; add data to RESPONSES SUB-FIELD (#9002313.0301) "RTN","BPSECMPS",200,0) ; "RTN","BPSECMPS",201,0) N FDATA03,FIELD,FILE,FLDNUM,ROOT "RTN","BPSECMPS",202,0) ; "RTN","BPSECMPS",203,0) S FILE=9002313.0301,ROOT="FDATA03(9002313.0301)" "RTN","BPSECMPS",204,0) ; field 501 is HEADER RESPONSE STATUS, 112 is TRANSACTION RESPONSE STATUS "RTN","BPSECMPS",205,0) I '$D(FDATA(TRANSACT,501)) S FDATA(TRANSACT,501)=FDATA(TRANSACT,112) "RTN","BPSECMPS",206,0) I '$D(FDATA(TRANSACT,112)) S FDATA(TRANSACT,112)=FDATA(TRANSACT,501) "RTN","BPSECMPS",207,0) ; "RTN","BPSECMPS",208,0) S FLDNUM=".01" D FDA^DILF(FILE,"+1,"_FDAIEN(TRANSACT),FLDNUM,"",TRANSACT,ROOT) "RTN","BPSECMPS",209,0) S FIELD="" "RTN","BPSECMPS",210,0) F S FIELD=$O(FDATA(TRANSACT,FIELD)) Q:FIELD="" D ;set all the non-repeating fields for 9002313.0301 "RTN","BPSECMPS",211,0) .Q:$G(FDATA(TRANSACT,FIELD))="" ; no data to process "RTN","BPSECMPS",212,0) .; field 402 is PRESCRIPTION/SERVICE REF. NO. "RTN","BPSECMPS",213,0) .I FIELD=402 S FDATA(TRANSACT,FIELD)=$TR(FDATA(TRANSACT,FIELD),"\","") ;REMOVE EXTRANEOUS "\" "RTN","BPSECMPS",214,0) .D FDA^DILF(FILE,"+"_TRANSACT_","_FDAIEN(TRANSACT),FIELD,"",FDATA(TRANSACT,FIELD),ROOT) "RTN","BPSECMPS",215,0) ; "RTN","BPSECMPS",216,0) D UPDATE^DIE("S","FDATA03(9002313.0301)","FDAIEN03") "RTN","BPSECMPS",217,0) ; "RTN","BPSECMPS",218,0) Q "RTN","BPSECMPS",219,0) ; "RTN","BPSECMPS",220,0) PROCREJ ; add data to REJECT CODE SUB-FIELD (#9002313.03511) "RTN","BPSECMPS",221,0) Q:$G(FDATA(TRANSACT,510))="" "RTN","BPSECMPS",222,0) ; "RTN","BPSECMPS",223,0) N FDAT3511,FILE,FLDNUM,NNDX,NUMREJS,ROOT,REJCODE "RTN","BPSECMPS",224,0) ; "RTN","BPSECMPS",225,0) S FILE="9002313.03511",ROOT="FDAT3511(9002313.03511)",NUMREJS=FDATA(TRANSACT,510),NNDX="" "RTN","BPSECMPS",226,0) F S NNDX=$O(FDATA(TRANSACT,511,NNDX)) Q:NNDX="" D ;set all the non-repeating fields for 9002313.03511 rejections "RTN","BPSECMPS",227,0) .S REJCODE=$$TRIM^XLFSTR(FDATA(TRANSACT,511,NNDX),"R") "RTN","BPSECMPS",228,0) .S REJCODE=$TR(REJCODE,"\","") Q:REJCODE']"" "RTN","BPSECMPS",229,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",REJCODE,ROOT) "RTN","BPSECMPS",230,0) D UPDATE^DIE("S","FDAT3511(9002313.03511)") "RTN","BPSECMPS",231,0) ; "RTN","BPSECMPS",232,0) Q "RTN","BPSECMPS",233,0) ; "RTN","BPSECMPS",234,0) PROCAPP ; APPROVED MESSAGE CODE SUB-FIELD (#9002313.301548) "RTN","BPSECMPS",235,0) Q:$O(FDATA(TRANSACT,548,0))="" "RTN","BPSECMPS",236,0) ; "RTN","BPSECMPS",237,0) N FDAT1548,FILE,FLDNUM,NNDX,ROOT "RTN","BPSECMPS",238,0) ; "RTN","BPSECMPS",239,0) S FILE="9002313.301548",ROOT="FDAT1548(9002313.301548)",NNDX="" "RTN","BPSECMPS",240,0) F S NNDX=$O(FDATA(TRANSACT,548,NNDX)) Q:NNDX="" D "RTN","BPSECMPS",241,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",FDATA(TRANSACT,548,NNDX),ROOT) "RTN","BPSECMPS",242,0) D UPDATE^DIE("S","FDAT1548(9002313.301548)") "RTN","BPSECMPS",243,0) ; "RTN","BPSECMPS",244,0) Q "RTN","BPSECMPS",245,0) ; "RTN","BPSECMPS",246,0) PROCPPR ; PREFERRED PRODUCT REPEATING SUB-FIELD (#9002313.1301) "RTN","BPSECMPS",247,0) ; "RTN","BPSECMPS",248,0) Q:$O(FDATA(TRANSACT,552,0))="" "RTN","BPSECMPS",249,0) ; "RTN","BPSECMPS",250,0) N FDAT1301,FILE,FLDNUM,NNDX,ROOT "RTN","BPSECMPS",251,0) ; "RTN","BPSECMPS",252,0) S FILE="9002313.1301",ROOT="FDAT1301(9002313.1301)",NNDX="" "RTN","BPSECMPS",253,0) F S NNDX=$O(FDATA(TRANSACT,552,NNDX)) Q:NNDX="" D "RTN","BPSECMPS",254,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT) "RTN","BPSECMPS",255,0) .F FLDNUM=552,553,554,555,556 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT) "RTN","BPSECMPS",256,0) D UPDATE^DIE("S","FDAT1301(9002313.1301)") "RTN","BPSECMPS",257,0) ; "RTN","BPSECMPS",258,0) Q "RTN","BPSECMPS",259,0) PROCCOB ; OTHER PAYER ID MLTPL SUB-FIELD (#9002313.035501) "RTN","BPSECMPS",260,0) ; "RTN","BPSECMPS",261,0) Q:$O(FDATA(TRANSACT,338,0))="" "RTN","BPSECMPS",262,0) ; "RTN","BPSECMPS",263,0) N FDAT35501,FILE,FLDNUM,NNDX,ROOT "RTN","BPSECMPS",264,0) ; "RTN","BPSECMPS",265,0) S FILE="9002313.035501",ROOT="FDAT35501(9002313.035501)",NNDX="" "RTN","BPSECMPS",266,0) F S NNDX=$O(FDATA(TRANSACT,338,NNDX)) Q:NNDX="" D "RTN","BPSECMPS",267,0) .S FLDNUM=".01" D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",NNDX,ROOT) "RTN","BPSECMPS",268,0) .F FLDNUM=127,142,143,144,145,338,339,340,356,991,992 I $D(FDATA(TRANSACT,FLDNUM,NNDX)) D FDA^DILF(FILE,"+"_NNDX_","_FDAIEN03(TRANSACT)_","_FDAIEN(TRANSACT),FLDNUM,"",$G(FDATA(TRANSACT,FLDNUM,NNDX)),ROOT) "RTN","BPSECMPS",269,0) D UPDATE^DIE("S","FDAT35501(9002313.035501)") "RTN","BPSECMPS",270,0) ; "RTN","BPSECMPS",271,0) Q "RTN","BPSECMPS",272,0) ; "RTN","BPSECMPS",273,0) RAW(RESPIEN,RREC) ; store raw data received from the payer "RTN","BPSECMPS",274,0) ; pass in the response IEN (9002313.03) and the raw data to be stored. "RTN","BPSECMPS",275,0) N X,CNT "RTN","BPSECMPS",276,0) K ^TMP($J,"WP") "RTN","BPSECMPS",277,0) S CNT=0 F X=1:79:$L(RREC) S CNT=CNT+1 S ^TMP($J,"WP",CNT,0)=$E(RREC,X,X+78) "RTN","BPSECMPS",278,0) D WP^DIE(9002313.03,RESPIEN_",",9999,"K","^TMP($J,""WP"")") "RTN","BPSECMPS",279,0) K ^TMP($J,"WP") "RTN","BPSECMPS",280,0) Q "RTN","BPSECMPS",281,0) ; "RTN","BPSECX0") 0^61^B35429385 "RTN","BPSECX0",1,0) BPSECX0 ;BHAM ISC/FCS/DRS/VA/DLF - Retrieve Claim submission record ;05/17/2004 "RTN","BPSECX0",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10**;JUN 2004;Build 27 "RTN","BPSECX0",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSECX0",4,0) ; "RTN","BPSECX0",5,0) ; This routine is used to pull data from BPS Claims and its multiples "RTN","BPSECX0",6,0) ; GETBPS2 - BPS Claims level "RTN","BPSECX0",7,0) ; GETBPS3 - Transaction subfile "RTN","BPSECX0",8,0) ; GETBPS4 - DUR subfile "RTN","BPSECX0",9,0) ; GETBPS5 - COB subfile. This calls GETBPS6 and GETBPS7 to get the data "RTN","BPSECX0",10,0) ; from the subfiles within COB "RTN","BPSECX0",11,0) ; "RTN","BPSECX0",12,0) Q "RTN","BPSECX0",13,0) ; "RTN","BPSECX0",14,0) ; Retrieve BPS CLAIMS data "RTN","BPSECX0",15,0) ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02) "RTN","BPSECX0",16,0) ; BPS - Passed by reference "RTN","BPSECX0",17,0) ; returns: BPS(9002313.02,CLAIMIEN,field #,"I") = internal format value "RTN","BPSECX0",18,0) GETBPS2(CLAIMIEN,BPS) ; called from BPSECA1 > BPSOSQG > BPSOSQ2 "RTN","BPSECX0",19,0) ; "RTN","BPSECX0",20,0) Q:$G(CLAIMIEN)="" ; must have claim IEN "RTN","BPSECX0",21,0) ; "RTN","BPSECX0",22,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",23,0) ; "RTN","BPSECX0",24,0) S DIC=9002313.02,DR="101:899;980:997" ; all fields from 101-899 and 990-997, skip 901-908 (used for BPS overhead) "RTN","BPSECX0",25,0) S DA=CLAIMIEN,DIQ="BPS",DIQ(0)="I" ; "I" for internal format "RTN","BPSECX0",26,0) D EN^DIQ1 "RTN","BPSECX0",27,0) Q "RTN","BPSECX0",28,0) ; "RTN","BPSECX0",29,0) ; "RTN","BPSECX0",30,0) ;Retrieve data in TRANSACTIONS multiple in BPS CLAIMS "RTN","BPSECX0",31,0) ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02) "RTN","BPSECX0",32,0) ; TRXIEN = ien in TRANSACTIONS (#9002313.0201) "RTN","BPSECX0",33,0) ; BPS - Passed by reference "RTN","BPSECX0",34,0) ; returns: BPS(9002313.0201,TRXIEN,field #,"I") = internal format value "RTN","BPSECX0",35,0) GETBPS3(CLAIMIEN,TRXIEN,BPS) ;called from BPSECA1 "RTN","BPSECX0",36,0) ; "RTN","BPSECX0",37,0) Q:$G(CLAIMIEN)="" Q:$G(TRXIEN)="" ; must have both "RTN","BPSECX0",38,0) ; "RTN","BPSECX0",39,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",40,0) ; "RTN","BPSECX0",41,0) S DIC=9002313.02,DR="400",DR(9002313.0201)="113:996" ; all TRANSACTION fields "RTN","BPSECX0",42,0) S DA=CLAIMIEN,DA(9002313.0201)=TRXIEN ; IEN and sub-file IEN "RTN","BPSECX0",43,0) S DIQ="BPS",DIQ(0)="I" ; "I" for internal format "RTN","BPSECX0",44,0) D EN^DIQ1 "RTN","BPSECX0",45,0) ; "RTN","BPSECX0",46,0) ; Copy Prescriber Phone Number (498.12) to field 498 as this is where BPSOSH2 "RTN","BPSECX0",47,0) ; expects to find it. This works for now but if we implement the Prior Auth "RTN","BPSECX0",48,0) ; segment (which has multiple field labelled 498), a more complete solution "RTN","BPSECX0",49,0) ; will need to be found "RTN","BPSECX0",50,0) S BPS(9002313.0201,TRXIEN,498,"I")=$G(BPS(9002313.0201,TRXIEN,498.12,"I")) "RTN","BPSECX0",51,0) Q "RTN","BPSECX0",52,0) ; "RTN","BPSECX0",53,0) ; "RTN","BPSECX0",54,0) ; "RTN","BPSECX0",55,0) ;Retrieve DUR/PPS multiple data "RTN","BPSECX0",56,0) ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02) "RTN","BPSECX0",57,0) ; TRXIEN = ien in TRANSACTIONS (#9002313.0201) "RTN","BPSECX0",58,0) ; CDURIEN= DUR/PPS Multiple IEN (9002313.1001) "RTN","BPSECX0",59,0) ; BPS - Passed by reference "RTN","BPSECX0",60,0) ; returns: BPS(9002313.1001,CDURIEN,field #,"I") = Value "RTN","BPSECX0",61,0) GETBPS4(CLAIMIEN,TRXIEN,CDURIEN,BPS) ;EP - from BPSECA1 "RTN","BPSECX0",62,0) ; "RTN","BPSECX0",63,0) ;Make sure input variables are defined "RTN","BPSECX0",64,0) Q:$G(CLAIMIEN)="" "RTN","BPSECX0",65,0) Q:$G(TRXIEN)="" "RTN","BPSECX0",66,0) Q:$G(CDURIEN)="" "RTN","BPSECX0",67,0) ; "RTN","BPSECX0",68,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",69,0) S DIC=9002313.02 "RTN","BPSECX0",70,0) S DR="400",DR(9002313.0201)=473.01 ;fields "RTN","BPSECX0",71,0) S DR(9002313.1001)=".01;439;440;441;474;475;476" ;fields "RTN","BPSECX0",72,0) S DA=CLAIMIEN,DA(9002313.0201)=TRXIEN,DA(9002313.1001)=CDURIEN "RTN","BPSECX0",73,0) S DIQ="BPS",DIQ(0)="I" "RTN","BPSECX0",74,0) D EN^DIQ1 "RTN","BPSECX0",75,0) ; "RTN","BPSECX0",76,0) Q "RTN","BPSECX0",77,0) ; "RTN","BPSECX0",78,0) ; "RTN","BPSECX0",79,0) ;Retrieve COB OTHER PAYMENTS multiple data "RTN","BPSECX0",80,0) ; CLAIMIEN = ien in BPS CLAIMS (#9002313.02) "RTN","BPSECX0",81,0) ; TRXIEN = ien in TRANSACTIONS (#9002313.0201) "RTN","BPSECX0",82,0) ; BPCOBIEN= ien in COB OTHER PAYMENTS (#9002313.0401) "RTN","BPSECX0",83,0) ; BPS - Passed by reference "RTN","BPSECX0",84,0) ; Output: BPS(9002313.0401,BPCOBIEN,field #,"I") = Value "RTN","BPSECX0",85,0) GETBPS5(CLAIMIEN,TRXIEN,BPCOBIEN,BPS) ;EP - from BPSECA1 "RTN","BPSECX0",86,0) ; "RTN","BPSECX0",87,0) Q:$G(CLAIMIEN)="" Q:$G(TRXIEN)="" Q:$G(BPCOBIEN)="" "RTN","BPSECX0",88,0) ; "RTN","BPSECX0",89,0) N BPREJCT,BPSCNT,BPSPAMT,BPSOTHR,D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",90,0) ; "RTN","BPSECX0",91,0) S DIC=9002313.02 "RTN","BPSECX0",92,0) S DA=CLAIMIEN "RTN","BPSECX0",93,0) S DA(9002313.0201)=TRXIEN "RTN","BPSECX0",94,0) S DA(9002313.0401)=BPCOBIEN "RTN","BPSECX0",95,0) S DR="400" ; field (#400) TRANSACTIONS "RTN","BPSECX0",96,0) S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS "RTN","BPSECX0",97,0) S DR(9002313.0401)=".01;338;339;340;341;443;471;353;392" ; fields "RTN","BPSECX0",98,0) S DIQ="BPS",DIQ(0)="I" "RTN","BPSECX0",99,0) D EN^DIQ1 "RTN","BPSECX0",100,0) ; "RTN","BPSECX0",101,0) ; Loop through PAYER AMT and get the data "RTN","BPSECX0",102,0) S BPSPAMT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,1,0)),U,4) "RTN","BPSECX0",103,0) F BPSCNT=1:1:BPSPAMT D GETBPS6(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS) "RTN","BPSECX0",104,0) ; "RTN","BPSECX0",105,0) ; Loop through OTHER PAYER REJECT CODE multiple and get the data "RTN","BPSECX0",106,0) S BPREJCT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,2,0)),U,4) "RTN","BPSECX0",107,0) F BPSCNT=1:1:BPREJCT D GETBPS7(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS) "RTN","BPSECX0",108,0) ; "RTN","BPSECX0",109,0) ; Loop through PAYER-PATIENT RESP and get the data "RTN","BPSECX0",110,0) S BPSPAMT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,3,0)),U,4) "RTN","BPSECX0",111,0) F BPSCNT=1:1:BPSPAMT D GETBPS8(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS) "RTN","BPSECX0",112,0) ; "RTN","BPSECX0",113,0) ; Loop through BENEFIT STAGES and get the data "RTN","BPSECX0",114,0) S BPSPAMT=$P($G(^BPSC(CLAIMIEN,400,TRXIEN,337,BPCOBIEN,4,0)),U,4) "RTN","BPSECX0",115,0) F BPSCNT=1:1:BPSPAMT D GETBPS9(CLAIMIEN,TRXIEN,BPCOBIEN,BPSCNT,.BPS) "RTN","BPSECX0",116,0) Q "RTN","BPSECX0",117,0) ; "RTN","BPSECX0",118,0) ; Other Payer Amt Paid multiple (#9002313.401342) "RTN","BPSECX0",119,0) GETBPS6(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5 "RTN","BPSECX0",120,0) ; "RTN","BPSECX0",121,0) ;Make sure input variables are defined "RTN","BPSECX0",122,0) Q:$G(CLAIMIEN)="" "RTN","BPSECX0",123,0) Q:$G(TRXIEN)="" "RTN","BPSECX0",124,0) Q:$G(BPCOBIEN)="" "RTN","BPSECX0",125,0) Q:$G(BPPAYAMT)="" "RTN","BPSECX0",126,0) ; "RTN","BPSECX0",127,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",128,0) S DIC=9002313.02 "RTN","BPSECX0",129,0) S DA=CLAIMIEN "RTN","BPSECX0",130,0) S DA(9002313.0201)=TRXIEN "RTN","BPSECX0",131,0) S DA(9002313.0401)=BPCOBIEN "RTN","BPSECX0",132,0) S DA(9002313.401342)=BPPAYAMT "RTN","BPSECX0",133,0) S DR="400" ; field (#400) TRANSACTIONS "RTN","BPSECX0",134,0) S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS "RTN","BPSECX0",135,0) S DR(9002313.0401)=342 ;(#342) OTHER PAYER AMT PAID MULTIPLE "RTN","BPSECX0",136,0) S DR(9002313.401342)=".01;431" ;fields "RTN","BPSECX0",137,0) S DIQ="BPS",DIQ(0)="I" "RTN","BPSECX0",138,0) D EN^DIQ1 "RTN","BPSECX0",139,0) ; "RTN","BPSECX0",140,0) Q "RTN","BPSECX0",141,0) ; "RTN","BPSECX0",142,0) ; Other Payer Reject Code multiple (#9002313.401472) "RTN","BPSECX0",143,0) GETBPS7(CLAIMIEN,TRXIEN,BPCOBIEN,BPREJCT,BPS) ;EP - from GETBPS5 "RTN","BPSECX0",144,0) ; "RTN","BPSECX0",145,0) ;Make sure input variables are defined "RTN","BPSECX0",146,0) Q:$G(CLAIMIEN)="" "RTN","BPSECX0",147,0) Q:$G(TRXIEN)="" "RTN","BPSECX0",148,0) Q:$G(BPCOBIEN)="" "RTN","BPSECX0",149,0) Q:$G(BPREJCT)="" "RTN","BPSECX0",150,0) ; "RTN","BPSECX0",151,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",152,0) ; "RTN","BPSECX0",153,0) S DIC=9002313.02 "RTN","BPSECX0",154,0) S DA=CLAIMIEN "RTN","BPSECX0",155,0) S DA(9002313.0201)=TRXIEN "RTN","BPSECX0",156,0) S DA(9002313.0401)=BPCOBIEN "RTN","BPSECX0",157,0) S DA(9002313.401472)=BPREJCT "RTN","BPSECX0",158,0) S DR="400" ; field (#400) TRANSACTIONS "RTN","BPSECX0",159,0) S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS "RTN","BPSECX0",160,0) S DR(9002313.0401)=472 ;(#472) OTHER PAYER REJECT CODE MLTPL "RTN","BPSECX0",161,0) S DR(9002313.401472)=".01" ;fields "RTN","BPSECX0",162,0) S DIQ="BPS",DIQ(0)="I" "RTN","BPSECX0",163,0) D EN^DIQ1 "RTN","BPSECX0",164,0) Q "RTN","BPSECX0",165,0) ; "RTN","BPSECX0",166,0) ; Other Payer-Patient Resp Amt multiple (#9002313.401353) "RTN","BPSECX0",167,0) GETBPS8(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5 "RTN","BPSECX0",168,0) ; "RTN","BPSECX0",169,0) ;Make sure input variables are defined "RTN","BPSECX0",170,0) Q:$G(CLAIMIEN)="" "RTN","BPSECX0",171,0) Q:$G(TRXIEN)="" "RTN","BPSECX0",172,0) Q:$G(BPCOBIEN)="" "RTN","BPSECX0",173,0) Q:$G(BPPAYAMT)="" "RTN","BPSECX0",174,0) ; "RTN","BPSECX0",175,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",176,0) S DIC=9002313.02 "RTN","BPSECX0",177,0) S DA=CLAIMIEN "RTN","BPSECX0",178,0) S DA(9002313.0201)=TRXIEN "RTN","BPSECX0",179,0) S DA(9002313.0401)=BPCOBIEN "RTN","BPSECX0",180,0) S DA(9002313.401353)=BPPAYAMT "RTN","BPSECX0",181,0) S DR="400" ; field (#400) TRANSACTIONS "RTN","BPSECX0",182,0) S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS "RTN","BPSECX0",183,0) S DR(9002313.0401)=353.01 ;field (#353.01) OTHER PAYER-PATIENT RESP MLTPL "RTN","BPSECX0",184,0) S DR(9002313.401353)=".01;351;352" ;fields "RTN","BPSECX0",185,0) S DIQ="BPS",DIQ(0)="I" "RTN","BPSECX0",186,0) D EN^DIQ1 "RTN","BPSECX0",187,0) ; "RTN","BPSECX0",188,0) ; Benefit Stages multiple (#9002313.401392) "RTN","BPSECX0",189,0) GETBPS9(CLAIMIEN,TRXIEN,BPCOBIEN,BPPAYAMT,BPS) ;EP - from GETBPS5 "RTN","BPSECX0",190,0) ; "RTN","BPSECX0",191,0) ;Make sure input variables are defined "RTN","BPSECX0",192,0) Q:$G(CLAIMIEN)="" "RTN","BPSECX0",193,0) Q:$G(TRXIEN)="" "RTN","BPSECX0",194,0) Q:$G(BPCOBIEN)="" "RTN","BPSECX0",195,0) Q:$G(BPPAYAMT)="" "RTN","BPSECX0",196,0) ; "RTN","BPSECX0",197,0) N D0,DA,DIC,DIQ,DIQ2,DR "RTN","BPSECX0",198,0) S DIC=9002313.02 "RTN","BPSECX0",199,0) S DA=CLAIMIEN "RTN","BPSECX0",200,0) S DA(9002313.0201)=TRXIEN "RTN","BPSECX0",201,0) S DA(9002313.0401)=BPCOBIEN "RTN","BPSECX0",202,0) S DA(9002313.401392)=BPPAYAMT "RTN","BPSECX0",203,0) S DR="400" ; field (#400) TRANSACTIONS "RTN","BPSECX0",204,0) S DR(9002313.0201)=337.01 ;field (#337.01) COB OTHER PAYMENTS "RTN","BPSECX0",205,0) S DR(9002313.0401)=392.01 ;field (#392.01) BENEFIT STAGE MLTPL "RTN","BPSECX0",206,0) S DR(9002313.401392)=".01;393;394" ;fields "RTN","BPSECX0",207,0) S DIQ="BPS",DIQ(0)="I" "RTN","BPSECX0",208,0) D EN^DIQ1 "RTN","BPSECX0",209,0) ; "RTN","BPSECX0",210,0) Q "RTN","BPSELG") 0^71^B36086244 "RTN","BPSELG",1,0) BPSELG ;ALB/DRF - ECME SCREEN ELIGIBILITY VERIFICATION SUBMIT ;8/13/10 21:14 "RTN","BPSELG",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**10**;JUN 2004;Build 27 "RTN","BPSELG",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSELG",4,0) ; "RTN","BPSELG",5,0) ; reference to ^DIR supported by DBIA 10026 "RTN","BPSELG",6,0) ; references to FULL^VALM1 and PAUSE^VALM1 supported by DBIA 10016 "RTN","BPSELG",7,0) ; reference to $$FMTE^XLFDT supported by DBIA 10103 "RTN","BPSELG",8,0) ; "RTN","BPSELG",9,0) ;ECME Eligibility Verification w/EDITS Protocol (Hidden) - Called by [BPS USER SCREEN] "RTN","BPSELG",10,0) ; "RTN","BPSELG",11,0) RESED N BPSEL "RTN","BPSELG",12,0) ; "RTN","BPSELG",13,0) I '$D(@(VALMAR)) G XRESED "RTN","BPSELG",14,0) D FULL^VALM1 "RTN","BPSELG",15,0) ; "RTN","BPSELG",16,0) ;Select the claim to submit "RTN","BPSELG",17,0) W !,"Enter the line number for the claim to be submitted for Eligibility Verification" "RTN","BPSELG",18,0) S BPSEL=$$ASKLINE("Select item","Please select a SINGLE claim only when using the Eligibility action option.") "RTN","BPSELG",19,0) I BPSEL<1 S VALMBCK="R" G XRESED "RTN","BPSELG",20,0) ; "RTN","BPSELG",21,0) ;Attempt to submit the claim for eligibility "RTN","BPSELG",22,0) D DOSELCTD(BPSEL) "RTN","BPSELG",23,0) S VALMBCK="R" "RTN","BPSELG",24,0) ; "RTN","BPSELG",25,0) XRESED Q "RTN","BPSELG",26,0) ; "RTN","BPSELG",27,0) ;Attempt to Edit and Submit Selected Claim for Eligibility "RTN","BPSELG",28,0) ; "RTN","BPSELG",29,0) ; Input Value -> BPRXI - Entry with ptr to BPS TRANSACTION file "RTN","BPSELG",30,0) ; "RTN","BPSELG",31,0) ; Return Value -> 0 - Claim was not submitted "RTN","BPSELG",32,0) ; 1 - Claim was submitted "RTN","BPSELG",33,0) ; "RTN","BPSELG",34,0) DOSELCTD(BPRXI) ; "RTN","BPSELG",35,0) N BP02,BP59,BPRSLT,BPCLTOT,BPDFN,BPDOSDT,BPOVRIEN,BPQ,BPRXIEN,BPRXR,BPSTATUS,BPSELG,BPPROMPT,BPPSNCD,BPRELCD,BPUPDFLG "RTN","BPSELG",36,0) S (BPQ)="" "RTN","BPSELG",37,0) S (BPCLTOT,BPUPDFLG,BPRSLT)=0 "RTN","BPSELG",38,0) ; "RTN","BPSELG",39,0) ;Pull BPS TRANSACTION/BPS CLAIMS entries "RTN","BPSELG",40,0) S BP59=$P(BPRXI,U,4) I BP59="" W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",! G XRES "RTN","BPSELG",41,0) S BP02=+$P($G(^BPST(BP59,0)),U,4) I 'BP02 W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",! G XRES "RTN","BPSELG",42,0) ; "RTN","BPSELG",43,0) ;Write Form Feed "RTN","BPSELG",44,0) W @IOF "RTN","BPSELG",45,0) ; "RTN","BPSELG",46,0) ;Display selected claim and ask to submit "RTN","BPSELG",47,0) S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSELG",48,0) W !,"You've chosen to VERIFY Eligibility of the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13) "RTN","BPSELG",49,0) W !,@VALMAR@(+$P(BPRXI,U,5),0) "RTN","BPSELG",50,0) S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)") "RTN","BPSELG",51,0) I BPQ'=1 S BPQ="^" G XRES "RTN","BPSELG",52,0) ; "RTN","BPSELG",53,0) ;Check to make sure claim can be Submitted for Eligibility "RTN","BPSELG",54,0) S BPRXIEN=$P(BP59,".") "RTN","BPSELG",55,0) S BPRXR=+$E($P(BP59,".",2),1,4) "RTN","BPSELG",56,0) I $$RXDEL^BPSOS($P(BP59,".",1),+$E($P(BP59,".",2),1,4)) W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"cannot be Submitted for Eligibility because it has been deleted in Pharmacy.",! G XRES "RTN","BPSELG",57,0) S BPSTATUS=$P($$CLAIMST^BPSSCRU3(BP59),U) "RTN","BPSELG",58,0) I BPSTATUS["IN PROGRESS" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is still In Progress and cannot be Submitted for Eligibility Verification",! G XRES "RTN","BPSELG",59,0) I BPSTATUS'["E REJECTED" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is NOT Rejected and cannot be Submitted for Eligibility Verification",! G XRES "RTN","BPSELG",60,0) ;can't resubmit a closed claim. The user must reopen first. "RTN","BPSELG",61,0) I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is Closed and cannot be Submitted for Eligibility.",! G XRES "RTN","BPSELG",62,0) ; "RTN","BPSELG",63,0) ;Prompt for EDIT Information "RTN","BPSELG",64,0) S BPPROMPT=$$PROMPTS(BP02,.BPDOSDT,.BPRELCD,.BPPSNCD) I BPPROMPT=-1 G XRES "RTN","BPSELG",65,0) ; "RTN","BPSELG",66,0) ;Send eligibility verification "RTN","BPSELG",67,0) S BPSELG("PLAN")=$P($G(^BPST(BP59,10,1,0)),U,1) ;IEN to the GROUP INSURANCE PLAN (#355.3) file "RTN","BPSELG",68,0) S BPSELG("FILL DATE")=BPDOSDT ;Date of Service entered by the user "RTN","BPSELG",69,0) S BPSELG("IEN")=+$P($G(^BPST(BP59,1)),U,11) ;Prescription, if available "RTN","BPSELG",70,0) S BPSELG("FILL NUMBER")=+$P($G(^BPST(BP59,1)),U,1) ;Fill Number, if available "RTN","BPSELG",71,0) S BPSELG("REL CODE")=BPRELCD "RTN","BPSELG",72,0) S BPSELG("PERSON CODE")=BPPSNCD "RTN","BPSELG",73,0) S BPRSLT=$$EN^BPSNCPD9(BPDFN,.BPSELG) "RTN","BPSELG",74,0) ; "RTN","BPSELG",75,0) ;Print Return Value Message "RTN","BPSELG",76,0) W !! "RTN","BPSELG",77,0) W $P(BPRSLT,U,2) "RTN","BPSELG",78,0) ; "RTN","BPSELG",79,0) XRES ; "RTN","BPSELG",80,0) D PAUSE^VALM1 "RTN","BPSELG",81,0) Q "RTN","BPSELG",82,0) ; "RTN","BPSELG",83,0) ; Input Values -> BP02 - The BPS CLAIMS entry "RTN","BPSELG",84,0) ; "RTN","BPSELG",85,0) ; Output Value -> BPQ - -1 - The user chose to quit "RTN","BPSELG",86,0) ; "" - The user completed the EDITS "RTN","BPSELG",87,0) ; BPDOSDT - Effective Date of Eligibility Verification transaction "RTN","BPSELG",88,0) ; BPRELCD - Patient Relationship Code from file #9002313.19 "RTN","BPSELG",89,0) ; BPPSNCD - Person Code assigned by payer. 1 - 3 characters free text "RTN","BPSELG",90,0) ; "RTN","BPSELG",91,0) PROMPTS(BP02,BPDOSDT,BPRELCD,BPPSNCD) ; "RTN","BPSELG",92,0) I '$G(BP02) S BPQ=-1 G XPROMPTS "RTN","BPSELG",93,0) N %,BP300,BPFDA,BPFLD,BPMED,BPMSG,BPQ,DIC,DIR,DIROUT,DTOUT,DUOUT,X,Y,DIRUT "RTN","BPSELG",94,0) S BPQ="" "RTN","BPSELG",95,0) ; "RTN","BPSELG",96,0) ;Pull Information from Claim "RTN","BPSELG",97,0) S BP300=$G(^BPSC(BP02,300)) "RTN","BPSELG",98,0) S BPRELCD=$TR($E($P(BP300,U,6),3,99)," ") "RTN","BPSELG",99,0) S BPPSNCD=$TR($E($P(BP300,U,3),3,99)," ") "RTN","BPSELG",100,0) S BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR) "RTN","BPSELG",101,0) ; "RTN","BPSELG",102,0) ;Effective Date "RTN","BPSELG",103,0) S DIR(0)="DO",DIR("A")="Effective Date" "RTN","BPSELG",104,0) K DIR("?") S DIR("?")="Enter the effective date for the Eligibility Verification transaction" "RTN","BPSELG",105,0) S DIR("B")=$$FMTE^XLFDT(BPDOSDT,"5ZD") "RTN","BPSELG",106,0) D ^DIR "RTN","BPSELG",107,0) I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS "RTN","BPSELG",108,0) S BPDOSDT=Y "RTN","BPSELG",109,0) ; "RTN","BPSELG",110,0) ;Relationship Code "RTN","BPSELG",111,0) N X,DIC,Y "RTN","BPSELG",112,0) S DIC("B")=BPRELCD "RTN","BPSELG",113,0) S DIC(0)="QEAM",DIC=9002313.19,DIC("A")="Relationship Code: " "RTN","BPSELG",114,0) D ^DIC "RTN","BPSELG",115,0) ;Check for "^" or timeout "RTN","BPSELG",116,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSELG",117,0) S BPRELCD=$P(Y,U,2) "RTN","BPSELG",118,0) K X,DIC,Y "RTN","BPSELG",119,0) ; "RTN","BPSELG",120,0) ;Person Code "RTN","BPSELG",121,0) K DIR("?") S DIR(0)="FO^1:3",DIR("A")="Person Code",DIR("?")="Enter the Specific Person Code Assigned to the Patient by the Payer" "RTN","BPSELG",122,0) S DIR("B")=BPPSNCD "RTN","BPSELG",123,0) D ^DIR "RTN","BPSELG",124,0) I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS "RTN","BPSELG",125,0) S BPPSNCD=Y "RTN","BPSELG",126,0) ; "RTN","BPSELG",127,0) ;Ask to proceed "RTN","BPSELG",128,0) W ! S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)") "RTN","BPSELG",129,0) I BPQ'=1 S BPQ=-1 G XPROMPTS "RTN","BPSELG",130,0) ; "RTN","BPSELG",131,0) XPROMPTS ; "RTN","BPSELG",132,0) Q BPQ "RTN","BPSELG",133,0) ; "RTN","BPSELG",134,0) ;Prompt User for Claim to Resubmit (w/EDITS) "RTN","BPSELG",135,0) ; "RTN","BPSELG",136,0) ; Input values -> BPROMPT - prompt string "RTN","BPSELG",137,0) ; BPERRMES - the message to display when the user tries "RTN","BPSELG",138,0) ; to make multi line selection (optional) "RTN","BPSELG",139,0) ; Piece "RTN","BPSELG",140,0) ;output values -> 1 - 1 = okay, <0 = errors, 0 = quit "RTN","BPSELG",141,0) ; 2 - patient ien #2 "RTN","BPSELG",142,0) ; 3 - insurance ien #36 "RTN","BPSELG",143,0) ; 4 - ptr to #9002313.59 "RTN","BPSELG",144,0) ; 5 - 1st line for index(es) in LM "VALM" array "RTN","BPSELG",145,0) ; 6 - patient's index "RTN","BPSELG",146,0) ; 7 - claim's index "RTN","BPSELG",147,0) ; "RTN","BPSELG",148,0) ASKLINE(BPROMPT,BPERRMES) ; "RTN","BPSELG",149,0) N BPRET,BPCNT "RTN","BPSELG",150,0) S BPRET="",BPCNT=0 "RTN","BPSELG",151,0) F S BPRET=$$SELLINE^BPSSCRU4(BPROMPT,"C",VALMAR,"") Q:BPRET'<0 D "RTN","BPSELG",152,0) . I BPCNT<1 S BPCNT=BPCNT+1 W ! "RTN","BPSELG",153,0) . E S BPCNT=0 D RE^VALM4 "RTN","BPSELG",154,0) . I BPRET=-1 W "Invalid line number" ; (invalid Patient summary line)" "RTN","BPSELG",155,0) . I BPRET=-8 W $S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number") "RTN","BPSELG",156,0) . I BPRET=-4 W "Invalid line number" ; (invalid RX line)" "RTN","BPSELG",157,0) . I BPRET=-2 W "Please select Patient's summary line." "RTN","BPSELG",158,0) . I BPRET=-3 W "Please specify RX line." "RTN","BPSELG",159,0) . I ",-1,-8,-4,-2,-3,"'[(","_BPRET_",") W "Incorrect format." ; Corrupted array (",BPRET,")" "RTN","BPSELG",160,0) Q BPRET "RTN","BPSFLD01") 0^81^B16636556 "RTN","BPSFLD01",1,0) BPSFLD01 ;ALB/SS - ePharmacy secondary billing - COB fields processing ;27-FEB-09 "RTN","BPSFLD01",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**8,10**;JUN 2004;Build 27 "RTN","BPSFLD01",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSFLD01",4,0) ; "RTN","BPSFLD01",5,0) SET337 ; 337-4C Other Payments Count "RTN","BPSFLD01",6,0) ; This field is used twice. "RTN","BPSFLD01",7,0) ; The total count is stored in 9002313.0201,337. BPSOPIEN is not defined for this case. "RTN","BPSFLD01",8,0) ; The individual counter is stored in 9002313.0401,.01 where BPSOPIEN is defined. "RTN","BPSFLD01",9,0) ; "RTN","BPSFLD01",10,0) I '$G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),330),U,7)=BPS("X") Q "RTN","BPSFLD01",11,0) ; "RTN","BPSFLD01",12,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,1)=BPS("X") "RTN","BPSFLD01",13,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,"B",BPS("X"),BPSOPIEN)="" "RTN","BPSFLD01",14,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,0)="^9002313.0401A^"_BPSOPIEN_U_BPSOPIEN "RTN","BPSFLD01",15,0) Q "RTN","BPSFLD01",16,0) ; "RTN","BPSFLD01",17,0) SET338 ; 338-5C Other Payer Coverage Type "RTN","BPSFLD01",18,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,2)=BPS("X") "RTN","BPSFLD01",19,0) Q "RTN","BPSFLD01",20,0) ; "RTN","BPSFLD01",21,0) SET339 ; 339-6C Other Payer ID Qualifier "RTN","BPSFLD01",22,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,3)=BPS("X") "RTN","BPSFLD01",23,0) Q "RTN","BPSFLD01",24,0) ; "RTN","BPSFLD01",25,0) SET340 ; 340-7C Other Payer ID "RTN","BPSFLD01",26,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,4)=BPS("X") "RTN","BPSFLD01",27,0) Q "RTN","BPSFLD01",28,0) ; "RTN","BPSFLD01",29,0) SET443 ; 443-E8 Other Payer Date "RTN","BPSFLD01",30,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,5)=BPS("X") "RTN","BPSFLD01",31,0) Q "RTN","BPSFLD01",32,0) ; "RTN","BPSFLD01",33,0) SET341 ; 341-HB Other Payer Amount Paid Count "RTN","BPSFLD01",34,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,6)=BPS("X") "RTN","BPSFLD01",35,0) Q "RTN","BPSFLD01",36,0) ; "RTN","BPSFLD01",37,0) SET471 ; 471-5E Other Payer Reject Count "RTN","BPSFLD01",38,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,7)=BPS("X") "RTN","BPSFLD01",39,0) Q "RTN","BPSFLD01",40,0) ; "RTN","BPSFLD01",41,0) SET342 ; 342-HC Other Payer Amount Paid Qualifier "RTN","BPSFLD01",42,0) ; .01 field in the 9002313.401342 sub-file "RTN","BPSFLD01",43,0) I '$G(BPSOPIEN)!'$G(BPSOAIEN) Q "RTN","BPSFLD01",44,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,1,BPSOAIEN,0),U,1)=BPS("X") "RTN","BPSFLD01",45,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,1,"B",BPS("X"),BPSOAIEN)="" "RTN","BPSFLD01",46,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,1,0)="^9002313.401342A^"_BPSOAIEN_U_BPSOAIEN "RTN","BPSFLD01",47,0) Q "RTN","BPSFLD01",48,0) ; "RTN","BPSFLD01",49,0) SET431 ; 431-DV Other Payer Amount Paid "RTN","BPSFLD01",50,0) I '$G(BPSOPIEN)!'$G(BPSOAIEN) Q "RTN","BPSFLD01",51,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,1,BPSOAIEN,0),U,2)=BPS("X") "RTN","BPSFLD01",52,0) ; This is an old field, probably not needed anymore "RTN","BPSFLD01",53,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),430),U,1)=BPS("X") "RTN","BPSFLD01",54,0) Q "RTN","BPSFLD01",55,0) ; "RTN","BPSFLD01",56,0) SET472 ; 472-6E Other Payer Reject Code "RTN","BPSFLD01",57,0) ; .01 field in the 9002313.401472 sub-file "RTN","BPSFLD01",58,0) I '$G(BPSOPIEN)!'$G(BPSORIEN) Q "RTN","BPSFLD01",59,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,2,BPSORIEN,0),U,1)=BPS("X") "RTN","BPSFLD01",60,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,2,"B",BPS("X"),BPSORIEN)="" "RTN","BPSFLD01",61,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,2,0)="^9002313.401472A^"_BPSORIEN_U_BPSORIEN "RTN","BPSFLD01",62,0) Q "RTN","BPSFLD01",63,0) ; "RTN","BPSFLD01",64,0) SET353 ; 353-NR Other Payer-Patient Responsibility Amount Count "RTN","BPSFLD01",65,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,8)=BPS("X") "RTN","BPSFLD01",66,0) Q "RTN","BPSFLD01",67,0) ; "RTN","BPSFLD01",68,0) SET351 ; 351-NP Other Payer-Patient Responsibility Amount Qualifier "RTN","BPSFLD01",69,0) I '$G(BPSOPIEN)!'$G(BPSOAIEN) Q "RTN","BPSFLD01",70,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,3,BPSOAIEN,0),U,1,2)=BPSOAIEN_U_BPS("X") "RTN","BPSFLD01",71,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,3,"B",BPSOAIEN,BPSOAIEN)="" "RTN","BPSFLD01",72,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,3,0)="^9002313.401353A^"_BPSOAIEN_U_BPSOAIEN "RTN","BPSFLD01",73,0) Q "RTN","BPSFLD01",74,0) ; "RTN","BPSFLD01",75,0) SET352 ; 352-NQ Other Payer-Patient Responsibility Amount Paid "RTN","BPSFLD01",76,0) I '$G(BPSOPIEN)!'$G(BPSOAIEN) Q "RTN","BPSFLD01",77,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,3,BPSOAIEN,0),U,3)=BPS("X") "RTN","BPSFLD01",78,0) Q "RTN","BPSFLD01",79,0) ; "RTN","BPSFLD01",80,0) SET392 ; 392-MU Benefit Stage Count "RTN","BPSFLD01",81,0) I $G(BPSOPIEN) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,0),U,9)=BPS("X") "RTN","BPSFLD01",82,0) Q "RTN","BPSFLD01",83,0) ; "RTN","BPSFLD01",84,0) SET393 ; 393-MV Benefit Stage Qualifier "RTN","BPSFLD01",85,0) I '$G(BPSOPIEN)!'$G(BPSOAIEN) Q "RTN","BPSFLD01",86,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,4,BPSOAIEN,0),U,1,2)=BPSOAIEN_U_BPS("X") "RTN","BPSFLD01",87,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,4,"B",BPSOAIEN,BPSOAIEN)="" "RTN","BPSFLD01",88,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,4,0)="^9002313.401392^"_BPSOAIEN_U_BPSOAIEN "RTN","BPSFLD01",89,0) Q "RTN","BPSFLD01",90,0) ; "RTN","BPSFLD01",91,0) SET394 ; 394-MW Benefit Stage Amount "RTN","BPSFLD01",92,0) I '$G(BPSOPIEN)!'$G(BPSOAIEN) Q "RTN","BPSFLD01",93,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),337,BPSOPIEN,4,BPSOAIEN,0),U,3)=BPS("X") "RTN","BPSFLD01",94,0) Q "RTN","BPSJHLT") 0^12^B56892816 "RTN","BPSJHLT",1,0) BPSJHLT ;BHAM ISC/LJF - HL7 Process Incoming MFN Messages ;05-NOV-2003 "RTN","BPSJHLT",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,10**;JUN 2004;Build 27 "RTN","BPSJHLT",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSJHLT",4,0) ; "RTN","BPSJHLT",5,0) ;**Program Description** "RTN","BPSJHLT",6,0) ; This program will process incoming MFN messages and "RTN","BPSJHLT",7,0) ; update the appropriate tables "RTN","BPSJHLT",8,0) ; "RTN","BPSJHLT",9,0) ; Direct entry not allowed "RTN","BPSJHLT",10,0) Q "RTN","BPSJHLT",11,0) ; "RTN","BPSJHLT",12,0) PKY(PKYNM,PKYROOT,ADD) ;Lookup ien or add using PKYNM "RTN","BPSJHLT",13,0) N DA,DO,DIC,DIE,DINUM,DLAYGO,DTOUT,DUOUT,Y,X "RTN","BPSJHLT",14,0) I $G(PKYNM)]"",$G(PKYROOT)]"" S ADD=+$G(ADD) "RTN","BPSJHLT",15,0) E Q 0 "RTN","BPSJHLT",16,0) S X=PKYNM,DIC=PKYROOT "RTN","BPSJHLT",17,0) I 'ADD S DIC(0)="X" D ^DIC "RTN","BPSJHLT",18,0) I ADD S DIC(0)="L",DLAYGO=PKYROOT D FILE^DICN "RTN","BPSJHLT",19,0) Q +Y "RTN","BPSJHLT",20,0) ; "RTN","BPSJHLT",21,0) EN(HL) ; Entry Point "RTN","BPSJHLT",22,0) ; "RTN","BPSJHLT",23,0) N BPSJACT,BPSJPKY,BPSJADT,BPSZPRER,BPSJROOT,PSIEN,APPACK "RTN","BPSJHLT",24,0) N ZPRS,BPSJSEG,HCT,ERRFLAG,NAFLG,NPFLG,SEG,MSG,MCT,FLN,FILE "RTN","BPSJHLT",25,0) N RBSTART,RBEND,RBCNT,ZPSNNAME,ZPRCNT,BPSETID,RCODE,MAXRX "RTN","BPSJHLT",26,0) N FS,CS,PSHTVER,NCPDPVER,NCPDPCK,BPSFILE,BPSJCNT,BPSJDEVN "RTN","BPSJHLT",27,0) N BPSJPROD,BPSJNAME,DIK,TCH "RTN","BPSJHLT",28,0) ; "RTN","BPSJHLT",29,0) S FS=$G(HL("FS")) I FS="" S FS="|" ; field separator "RTN","BPSJHLT",30,0) S CS=$E($G(HL("ECH"))) I CS="" S CS="^" ; component separator "RTN","BPSJHLT",31,0) ; "RTN","BPSJHLT",32,0) K ^TMP($J,"BPSJ-RBACK"),^TMP($J,"BPSJ-ERROR") "RTN","BPSJHLT",33,0) ; "RTN","BPSJHLT",34,0) D INITZPRS^BPSJZPR(.ZPRS) "RTN","BPSJHLT",35,0) S BPSFILE=9002313.92,BPSJROOT=$$ROOT^DILFD(BPSFILE) "RTN","BPSJHLT",36,0) S RBSTART=100,RBEND=260,NCPDPCK=",51,D0," "RTN","BPSJHLT",37,0) S (ZPSNNAME,BPSJPROD,NCPDPVER,BPSJACT,BPSJADT,BPSJPKY)="" "RTN","BPSJHLT",38,0) ; "RTN","BPSJHLT",39,0) ; Initialize some Application Acknowledgement data "RTN","BPSJHLT",40,0) D DGAPPACK^BPSJACK "RTN","BPSJHLT",41,0) S APPACK("MSA",1)="AE" ; Assume error "RTN","BPSJHLT",42,0) S APPACK("MSA",2)=$G(HL("MID")) ; Message ID "RTN","BPSJHLT",43,0) S APPACK("MFA",4,1)="U" ; Set flag type of "unsuccessful event" "RTN","BPSJHLT",44,0) S APPACK("MFA",6)="ST" "RTN","BPSJHLT",45,0) S APPACK("MFI",6)="NE" "RTN","BPSJHLT",46,0) ; "RTN","BPSJHLT",47,0) ; Init encoding char array "RTN","BPSJHLT",48,0) S TCH("\F\")="|",TCH("\R\")="~" "RTN","BPSJHLT",49,0) S TCH("\E\")="\",TCH("\T\")="&" "RTN","BPSJHLT",50,0) ; "RTN","BPSJHLT",51,0) S HCT=1,(MCT,NAFLG,NPFLG,ERRFLAG,ZPRCNT,MAXRX)=0 "RTN","BPSJHLT",52,0) F D Q:'HCT I ERRFLAG Q "RTN","BPSJHLT",53,0) . K BPSJSEG S HCT=$O(^TMP($J,"BPSJHLI",HCT)) "RTN","BPSJHLT",54,0) . D SPAR^BPSJUTL(.HL,.BPSJSEG,HCT) S SEG=$G(BPSJSEG(1)) "RTN","BPSJHLT",55,0) . ; "RTN","BPSJHLT",56,0) . ; ; payer sheet detail (multiple) "RTN","BPSJHLT",57,0) . I SEG="ZPR" D Q ; Record #5+ (MSH is record #1) "RTN","BPSJHLT",58,0) .. ; "RTN","BPSJHLT",59,0) .. I ERRFLAG Q ; Fatal Error "RTN","BPSJHLT",60,0) .. S ZPRCNT=ZPRCNT+1,BPSETID=$G(BPSJSEG(2)) "RTN","BPSJHLT",61,0) .. ;-If not numeric equivalent the warp engines are offline, Captain "RTN","BPSJHLT",62,0) .. I BPSETID'=ZPRCNT D FAKEREC(ZPRCNT) "RTN","BPSJHLT",63,0) .. D EN^BPSJZPR(PSIEN,.BPSJSEG,BPSJROOT,BPSFILE) "RTN","BPSJHLT",64,0) . ; "RTN","BPSJHLT",65,0) . I SEG="MFI" D Q ; Record #2 "RTN","BPSJHLT",66,0) .. ; "RTN","BPSJHLT",67,0) .. ;-Required Field checks "RTN","BPSJHLT",68,0) .. D ERRMSG(0,"MFI","1,2,3",.BPSJSEG) "RTN","BPSJHLT",69,0) .. ; "RTN","BPSJHLT",70,0) .. S APPACK("MFI",1,1)=$P($G(BPSJSEG(2)),CS) "RTN","BPSJHLT",71,0) .. S APPACK("MFI",1,2)=$P($G(BPSJSEG(2)),CS,2) "RTN","BPSJHLT",72,0) .. I APPACK("MFI",1,1)]"",APPACK("MFI",1,2)]"" "RTN","BPSJHLT",73,0) .. E D "RTN","BPSJHLT",74,0) ... ; hard code these for Version 1.0 of s/w "RTN","BPSJHLT",75,0) ... D FILE^DID(BPSFILE,,"NAME","BPSJNAME") "RTN","BPSJHLT",76,0) ... I APPACK("MFI",1,1)="" S APPACK("MFI",1,1)=BPSFILE "RTN","BPSJHLT",77,0) ... I APPACK("MFI",1,2)="" S APPACK("MFI",1,2)=$G(BPSJNAME("NAME")) "RTN","BPSJHLT",78,0) ... K BPSJNAME "RTN","BPSJHLT",79,0) ... ; "RTN","BPSJHLT",80,0) .. S APPACK("MFI",3)=$G(BPSJSEG(4)) "RTN","BPSJHLT",81,0) . ; "RTN","BPSJHLT",82,0) . I SEG="MFE" D Q ; Record #3 "RTN","BPSJHLT",83,0) .. ; "RTN","BPSJHLT",84,0) .. ;-Required Field checks "RTN","BPSJHLT",85,0) .. D ERRMSG(0,"MFE","1,2,4,5",.BPSJSEG) "RTN","BPSJHLT",86,0) .. ; "RTN","BPSJHLT",87,0) .. S BPSJADT=$$NOW^XLFDT() "RTN","BPSJHLT",88,0) .. S (BPSJACT,APPACK("MFA",1))=$G(BPSJSEG(2)) ; Action type "RTN","BPSJHLT",89,0) .. I $L(BPSJACT)=3,"^MAD^MUP^MDC^"[(U_BPSJACT_U) "RTN","BPSJHLT",90,0) .. E D ERRMSG(1,"MFE","1^INVALID EVENT CODE") "RTN","BPSJHLT",91,0) .. ; "RTN","BPSJHLT",92,0) .. S APPACK("MFA",2)=$G(BPSJSEG(3)) ; MFN Control ID "RTN","BPSJHLT",93,0) .. ; "RTN","BPSJHLT",94,0) .. ; Old/Current Sheet name "RTN","BPSJHLT",95,0) .. S (BPSJPKY,APPACK("MFA",5))=$G(BPSJSEG(5)) "RTN","BPSJHLT",96,0) .. S APPACK("MFA",4,2)="Payer Sheet "_BPSJPKY "RTN","BPSJHLT",97,0) .. S BPSJPKY=$$DECODE^BPSJZPR(BPSJPKY,.TCH) "RTN","BPSJHLT",98,0) .. ; "RTN","BPSJHLT",99,0) .. ;-Get ien using sheet name, if one exists "RTN","BPSJHLT",100,0) .. S PSIEN=$$PKY(BPSJPKY,BPSJROOT) "RTN","BPSJHLT",101,0) .. ; "RTN","BPSJHLT",102,0) .. I PSIEN=0 D ERRMSG(91,"Fileman error") Q "RTN","BPSJHLT",103,0) .. ; "RTN","BPSJHLT",104,0) .. I PSIEN>0 D ; Exists: save current data for rollback "RTN","BPSJHLT",105,0) ... S APPACK("MFA",4,1)="P" ;Set flag type to "P"rior version "RTN","BPSJHLT",106,0) ... M ^TMP($J,"BPSJ-RBACK",PSIEN)=^BPSF(9002313.92,PSIEN) "RTN","BPSJHLT",107,0) ... ;-Kill appropriate existing Payer Sheet fields "RTN","BPSJHLT",108,0) ... F RBCNT=RBSTART:10:RBEND K ^BPSF(9002313.92,PSIEN,RBCNT) "RTN","BPSJHLT",109,0) .. ; "RTN","BPSJHLT",110,0) .. ;-Create development sheet "RTN","BPSJHLT",111,0) .. I PSIEN<0 S BPSJCNT=0 F S BPSJCNT=1+BPSJCNT D Q:PSIEN>0 "RTN","BPSJHLT",112,0) ... S BPSJDEVN="BPSJ-DEV-"_$J_"-"_BPSJCNT "RTN","BPSJHLT",113,0) ... S PSIEN=$$PKY(BPSJDEVN,BPSJROOT) ; see if dev sheet exists "RTN","BPSJHLT",114,0) ... I PSIEN>-1 S PSIEN=0 Q "RTN","BPSJHLT",115,0) ... S PSIEN=$$PKY(BPSJDEVN,BPSJROOT,1) ; add new one "RTN","BPSJHLT",116,0) .. ; "RTN","BPSJHLT",117,0) .. I PSIEN=0 D ERRMSG(92,"Fileman error") Q "RTN","BPSJHLT",118,0) .. ; "RTN","BPSJHLT",119,0) .. ;-Flag the sheet as being in development by this process "RTN","BPSJHLT",120,0) .. K DA,DIE,DR S DA=PSIEN,DIE=BPSJROOT "RTN","BPSJHLT",121,0) .. S DR="1.06////1."_$J ;FOR DEVELOPMENT "RTN","BPSJHLT",122,0) .. D ^DIE "RTN","BPSJHLT",123,0) . ; "RTN","BPSJHLT",124,0) . ;payer sheet header "RTN","BPSJHLT",125,0) . I SEG="ZPS" D Q ; Record #4 "RTN","BPSJHLT",126,0) .. ; "RTN","BPSJHLT",127,0) .. ;-Required Field checks "RTN","BPSJHLT",128,0) .. D ERRMSG(0,"ZPS","1,2,3,4,5,6,7",.BPSJSEG) "RTN","BPSJHLT",129,0) .. ; "RTN","BPSJHLT",130,0) .. ;-New sheet name, production status and Payer Sheet and NCPDP versions "RTN","BPSJHLT",131,0) .. S ZPSNNAME=$$DECODE^BPSJZPR($G(BPSJSEG(4)),.TCH) K TCH "RTN","BPSJHLT",132,0) .. I ZPSNNAME="" S ZPSNNAME=$G(BPSJPKY) "RTN","BPSJHLT",133,0) .. ;Cannot rename an existing worksheet to a different but already existing name BPS*1*10 "RTN","BPSJHLT",134,0) .. I ZPSNNAME]"",ZPSNNAME'=$G(BPSJPKY),$$PKY(ZPSNNAME,BPSJROOT)]"" S ^TMP($J,"BPSJ-ERROR","ZPS",3)="" "RTN","BPSJHLT",135,0) .. S BPSJPROD=$G(BPSJSEG(8)) I BPSJPROD'="P" S BPSJPROD="T" "RTN","BPSJHLT",136,0) .. S PSHTVER=$G(BPSJSEG(5)) I PSHTVER'=(PSHTVER\1) S ^TMP($J,"BPSJ-ERROR","ZPS",4)="" "RTN","BPSJHLT",137,0) .. S NCPDPVER=$G(BPSJSEG(6)) I NCPDPVER=""!(NCPDPCK'[NCPDPVER) S ^TMP($J,"BPSJ-ERROR","ZPS",5)="" "RTN","BPSJHLT",138,0) ; "RTN","BPSJHLT",139,0) I '$D(^TMP($J,"BPSJ-ERROR")) D "RTN","BPSJHLT",140,0) . S APPACK("MFA",4,1)="S" ; flag success "RTN","BPSJHLT",141,0) . S DR=".01////"_ZPSNNAME ; set the name "RTN","BPSJHLT",142,0) . S DA=PSIEN,DIE=BPSJROOT D ^DIE "RTN","BPSJHLT",143,0) . ; "RTN","BPSJHLT",144,0) . I BPSJACT="MDC" S BPSJACT=0 ;Disabled "RTN","BPSJHLT",145,0) . E D I 'BPSJACT S BPSJACT=0 "RTN","BPSJHLT",146,0) .. I BPSJPROD="P" S BPSJACT=3 ;Production "RTN","BPSJHLT",147,0) .. I BPSJPROD="T" S BPSJACT=2 ;Testing "RTN","BPSJHLT",148,0) . S DR="1.06////"_BPSJACT,DA=PSIEN,DIE=BPSJROOT D ^DIE "RTN","BPSJHLT",149,0) . ; NCPDP Version "RTN","BPSJHLT",150,0) . S DR="1.02////"_NCPDPVER,DA=PSIEN,DIE=BPSJROOT D ^DIE "RTN","BPSJHLT",151,0) . ; Payer Sheet Version "RTN","BPSJHLT",152,0) . S DR="1.14////"_PSHTVER,DA=PSIEN,DIE=BPSJROOT D ^DIE "RTN","BPSJHLT",153,0) E I $G(PSIEN) D ;-Roll back "RTN","BPSJHLT",154,0) . ;-Remove if no prior existence "RTN","BPSJHLT",155,0) . I $G(^TMP($J,"BPSJ-RBACK",PSIEN,0))="" D Q "RTN","BPSJHLT",156,0) .. S DIK=BPSJROOT,DA=PSIEN D ^DIK "RTN","BPSJHLT",157,0) . ; "RTN","BPSJHLT",158,0) . ; Restore old data "RTN","BPSJHLT",159,0) . S ^BPSF(9002313.92,PSIEN,0)=$G(^TMP($J,"BPSJ-RBACK",PSIEN,0)) "RTN","BPSJHLT",160,0) . S ^BPSF(9002313.92,PSIEN,1)=$G(^TMP($J,"BPSJ-RBACK",PSIEN,1)) "RTN","BPSJHLT",161,0) . F RBCNT=RBSTART:10:RBEND D "RTN","BPSJHLT",162,0) .. K ^BPSF(9002313.92,PSIEN,RBCNT) "RTN","BPSJHLT",163,0) .. M ^BPSF(9002313.92,PSIEN,RBCNT)=^TMP($J,"BPSJ-RBACK",PSIEN,RBCNT) "RTN","BPSJHLT",164,0) ; "RTN","BPSJHLT",165,0) D APPACK^BPSJACK(.HL,.APPACK,PSIEN) "RTN","BPSJHLT",166,0) ; "RTN","BPSJHLT",167,0) K ^TMP($J,"BPSJ-RBACK"),^TMP($J,"BPSJ-ERROR") "RTN","BPSJHLT",168,0) ; "RTN","BPSJHLT",169,0) Q "RTN","BPSJHLT",170,0) ; "RTN","BPSJHLT",171,0) FAKEREC(REF) ; Setup a fake Record ID (Set ID) "RTN","BPSJHLT",172,0) N IX "RTN","BPSJHLT",173,0) ; "RTN","BPSJHLT",174,0) S REF=+$G(REF) "RTN","BPSJHLT",175,0) S IX=$G(BPSJSEG(2)),BPSJSEG(2)=REF "RTN","BPSJHLT",176,0) I IX="" D Q ; Missing "RTN","BPSJHLT",177,0) . S ^TMP($J,"BPSJ-ERROR","ZPR",REF,1)="V631-1,"_REF "RTN","BPSJHLT",178,0) ; "RTN","BPSJHLT",179,0) I IX=+IX,IX'=0 "RTN","BPSJHLT",180,0) E D Q ; Invalid "RTN","BPSJHLT",181,0) . S ^TMP($J,"BPSJ-ERROR","ZPR",REF,1)="V631-2,"_REF "RTN","BPSJHLT",182,0) ; "RTN","BPSJHLT",183,0) ; We have a valid numeric to work with, but: "RTN","BPSJHLT",184,0) ; "RTN","BPSJHLT",185,0) ; Duplicate "RTN","BPSJHLT",186,0) I $G(^TMP($J,"BPSJ-ERROR","ZPR",IX))=IX D Q "RTN","BPSJHLT",187,0) . S ^TMP($J,"BPSJ-ERROR","ZPR",REF,1)="V631-4,"_REF "RTN","BPSJHLT",188,0) ; "RTN","BPSJHLT",189,0) ; Out Of Sequence "RTN","BPSJHLT",190,0) S ^TMP($J,"BPSJ-ERROR","ZPR",REF,1)="V631-3,"_REF "RTN","BPSJHLT",191,0) S ^TMP($J,"BPSJ-ERROR","ZPR",REF)=IX "RTN","BPSJHLT",192,0) ; "RTN","BPSJHLT",193,0) Q "RTN","BPSJHLT",194,0) ; "RTN","BPSJHLT",195,0) ERRMSG(SPECIAL,SEG,REQFLDS,BPSJSEG) ; "RTN","BPSJHLT",196,0) N FCNT,FNO,FIELD,C "RTN","BPSJHLT",197,0) S C=",",SPECIAL=+$G(SPECIAL),SEG=$G(SEG),REQFLDS=$G(REQFLDS) "RTN","BPSJHLT",198,0) I 'SPECIAL D Q "RTN","BPSJHLT",199,0) . ;-Evaluate required fields for non ZPR segs "RTN","BPSJHLT",200,0) . S FNO=$J(REQFLDS,C) "RTN","BPSJHLT",201,0) . F FCNT=1:1:FNO S FIELD=$P(REQFLDS,C,FCNT) I FIELD D "RTN","BPSJHLT",202,0) .. ;-Set flag for empty required field "RTN","BPSJHLT",203,0) .. I $G(BPSJSEG(FIELD+1))="" S ^TMP($J,"BPSJ-ERROR",SEG,FIELD)="" "RTN","BPSJHLT",204,0) ; "RTN","BPSJHLT",205,0) ;-"Special" handler "RTN","BPSJHLT",206,0) I SPECIAL=1 D Q "RTN","BPSJHLT",207,0) . ;-Set flag that field contains invalid value "RTN","BPSJHLT",208,0) . S ^TMP($J,"BPSJ-ERROR",SEG,+REQFLDS)=REQFLDS "RTN","BPSJHLT",209,0) ; "RTN","BPSJHLT",210,0) I SPECIAL>90 S ERRFLAG=1 "RTN","BPSJHLT",211,0) Q "RTN","BPSJPAY") 1^49 "RTN","BPSJZPR") 0^55^B64959398 "RTN","BPSJZPR",1,0) BPSJZPR ;BHAM ISC/CMW/LJF - Process Incoming HL7 ZPR Message ;01-DEC-2003 "RTN","BPSJZPR",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,10**;JUN 2004;Build 27 "RTN","BPSJZPR",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSJZPR",4,0) ; "RTN","BPSJZPR",5,0) ; Description: "RTN","BPSJZPR",6,0) ; Process incoming HL7 ZPR Messages "RTN","BPSJZPR",7,0) ; Update Payer Sheet File (9002313.92) "RTN","BPSJZPR",8,0) ; "RTN","BPSJZPR",9,0) Q "RTN","BPSJZPR",10,0) ; "RTN","BPSJZPR",11,0) ; Entry point "RTN","BPSJZPR",12,0) EN(BPSJEN,BPSJSEG,BPSJROOT,BPSFILE) ; "RTN","BPSJZPR",13,0) ; "RTN","BPSJZPR",14,0) N BPRCODE,BPSF,BPSFDIC,BPSEGID,BPORDER,BPMODE,BPNOTES,BPSETID "RTN","BPSJZPR",15,0) N FLN,FLNSC,FLNPN,FLNSPEC "RTN","BPSJZPR",16,0) N DIE,DIC,DLAYGO,DR,DA,DINUM "RTN","BPSJZPR",17,0) N C,X,Y,NCNT,BPND "RTN","BPSJZPR",18,0) ; "RTN","BPSJZPR",19,0) I $G(BPSJEN),$G(BPSJROOT)]"",$G(BPSFILE)]"",$D(BPSJSEG) "RTN","BPSJZPR",20,0) E Q ; invalid info "RTN","BPSJZPR",21,0) ; "RTN","BPSJZPR",22,0) S BPRCODE=$$ZPR(),DIE=$G(BPSJROOT),C="," "RTN","BPSJZPR",23,0) ; "RTN","BPSJZPR",24,0) I BPRCODE,BPSEGID,BPORDER "RTN","BPSJZPR",25,0) E Q "RTN","BPSJZPR",26,0) ; "RTN","BPSJZPR",27,0) S BPSF=DIE_BPSJEN_C_BPSEGID_",0)" "RTN","BPSJZPR",28,0) I '$D(@BPSF) D "RTN","BPSJZPR",29,0) . S FLNSPEC=$$GET1^DID(BPSFILE,BPSEGID,"","SPECIFIER") "RTN","BPSJZPR",30,0) . S @BPSF=U_FLNSPEC_U_U "RTN","BPSJZPR",31,0) ; "RTN","BPSJZPR",32,0) S (X,DINUM)=BPORDER "RTN","BPSJZPR",33,0) S DA(1)=BPSJEN,DIC=DIE_BPSJEN_C_BPSEGID_C "RTN","BPSJZPR",34,0) S DIC(0)="L",(DIC("P"),DLAYGO)=FLN "RTN","BPSJZPR",35,0) D ^DIC "RTN","BPSJZPR",36,0) ; "RTN","BPSJZPR",37,0) S DA=+Y "RTN","BPSJZPR",38,0) S DIE=DIC "RTN","BPSJZPR",39,0) S DR=".02////"_BPRCODE_";.03////"_BPMODE "RTN","BPSJZPR",40,0) D ^DIE "RTN","BPSJZPR",41,0) ; "RTN","BPSJZPR",42,0) S BPSFDIC=DIC ; save dictionary ID "RTN","BPSJZPR",43,0) ; NOTES "RTN","BPSJZPR",44,0) I $D(BPSJSEG(8)) D "RTN","BPSJZPR",45,0) . S DIC=BPSFDIC,DIE=BPSFDIC_BPORDER_",2,",BPSF=DIE_"0)" "RTN","BPSJZPR",46,0) . I '$D(@BPSF) S @BPSF=U_FLNPN_U_U "RTN","BPSJZPR",47,0) . S BPND="BPSJSEG(7,99)",NCNT=0 "RTN","BPSJZPR",48,0) . F S BPND=$Q(@BPND) Q:BPND="" I $G(@BPND)]"" D "RTN","BPSJZPR",49,0) .. S DIC=BPSFDIC,DIE=BPSFDIC_BPORDER_",2,",BPSF=DIE_"0)" "RTN","BPSJZPR",50,0) .. K DA S DA(4)=BPSJEN,DA(3)=BPSEGID,DA(2)=BPORDER,DA(1)=2,(NCNT,DA)=NCNT+1 "RTN","BPSJZPR",51,0) .. K DR S DR=".01////"_@BPND "RTN","BPSJZPR",52,0) .. D ^DIE "RTN","BPSJZPR",53,0) K BPSJSEG(8) ; kill 8 so $Q of 7 won't find it "RTN","BPSJZPR",54,0) ; "RTN","BPSJZPR",55,0) ; Special Code "RTN","BPSJZPR",56,0) I $D(BPSJSEG(7)) D "RTN","BPSJZPR",57,0) . S DIC=BPSFDIC,DIE=BPSFDIC_BPORDER_",1,",BPSF=DIE_"0)" "RTN","BPSJZPR",58,0) . I '$D(@BPSF) S @BPSF=U_FLNSC_U_U "RTN","BPSJZPR",59,0) . S BPND="BPSJSEG(6,99)",NCNT=0 "RTN","BPSJZPR",60,0) . F S BPND=$Q(@BPND) Q:BPND="" I $G(@BPND)]"" D "RTN","BPSJZPR",61,0) .. S DIC=BPSFDIC,DIE=BPSFDIC_BPORDER_",1,",BPSF=DIE_"0)" "RTN","BPSJZPR",62,0) .. K DA S DA(4)=BPSJEN,DA(3)=BPSEGID,DA(2)=BPORDER,DA(1)=1,(NCNT,DA)=NCNT+1 "RTN","BPSJZPR",63,0) .. K DR S DR=".01////"_@BPND "RTN","BPSJZPR",64,0) .. D ^DIE "RTN","BPSJZPR",65,0) Q "RTN","BPSJZPR",66,0) ; "RTN","BPSJZPR",67,0) ZPR() ; Validate Fields and Initialize ZPR variables "RTN","BPSJZPR",68,0) N RCODE,WDATA "RTN","BPSJZPR",69,0) ; "RTN","BPSJZPR",70,0) ; Reject reasons: 1=Missing ,2=Invalid "RTN","BPSJZPR",71,0) ; ^TMP($J,"BPSJ-ERROR" is killed before and after it is used in BPSJHLT "RTN","BPSJZPR",72,0) ; "RTN","BPSJZPR",73,0) S BPSETID=$G(BPSJSEG(2)) "RTN","BPSJZPR",74,0) ; "RTN","BPSJZPR",75,0) S BPSEGID=$G(BPSJSEG(3)) "RTN","BPSJZPR",76,0) I BPSEGID="" S BPSEGID=0 D "RTN","BPSJZPR",77,0) . S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,2)="V632-1,"_BPSETID "RTN","BPSJZPR",78,0) E S BPSEGID=$G(ZPRS(BPSEGID)) D "RTN","BPSJZPR",79,0) . I 'BPSEGID S BPSEGID=0 D Q "RTN","BPSJZPR",80,0) .. S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,2)="V632-2,"_BPSETID "RTN","BPSJZPR",81,0) . ; "RTN","BPSJZPR",82,0) . S FLN=$P(BPSEGID,U,2) "RTN","BPSJZPR",83,0) . S FLNSC=$P(BPSEGID,U,3) "RTN","BPSJZPR",84,0) . S FLNPN=$P(BPSEGID,U,4) "RTN","BPSJZPR",85,0) . S BPSEGID=+BPSEGID "RTN","BPSJZPR",86,0) ; "RTN","BPSJZPR",87,0) S RCODE=$$GETPTR($$TRIM^XLFSTR($G(BPSJSEG(4)))) "RTN","BPSJZPR",88,0) I 'RCODE S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,3)="V633-2,"_BPSETID "RTN","BPSJZPR",89,0) I $G(BPSJSEG(4))="" S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,3)="V633-1,"_BPSETID "RTN","BPSJZPR",90,0) ; "RTN","BPSJZPR",91,0) S BPORDER=$G(BPSJSEG(5)) "RTN","BPSJZPR",92,0) I BPORDER="" S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,4)="V634,"_BPSETID "RTN","BPSJZPR",93,0) ; "RTN","BPSJZPR",94,0) S BPMODE=$G(BPSJSEG(6)) "RTN","BPSJZPR",95,0) ; "RTN","BPSJZPR",96,0) I BPMODE'="X",BPMODE'="S" D "RTN","BPSJZPR",97,0) . S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,5)="V635,"_BPSETID "RTN","BPSJZPR",98,0) ; "RTN","BPSJZPR",99,0) I '$L($G(BPSJSEG(7))),$D(BPSJSEG(7))'>1 K BPSJSEG(7) "RTN","BPSJZPR",100,0) E D ;NOTES(.BPSJSEG(7)) "RTN","BPSJZPR",101,0) . K WDATA M WDATA(7)=BPSJSEG(7) D NOTES(.WDATA) "RTN","BPSJZPR",102,0) . K BPSJSEG(7) M BPSJSEG(7)=WDATA K WDATA "RTN","BPSJZPR",103,0) ; "RTN","BPSJZPR",104,0) ; flag error if processing mode="X" and no special code "RTN","BPSJZPR",105,0) I BPMODE="X",'$D(BPSJSEG(7)) S ^TMP($J,"BPSJ-ERROR","ZPR",BPSETID,6)="V636,"_BPSETID "RTN","BPSJZPR",106,0) ; "RTN","BPSJZPR",107,0) I '$L($G(BPSJSEG(8))),$D(BPSJSEG(8))'>1 K BPSJSEG(8) "RTN","BPSJZPR",108,0) E D ;NOTES(.BPSJSEG(8)) "RTN","BPSJZPR",109,0) . K WDATA M WDATA(8)=BPSJSEG(8) D NOTES(.WDATA) "RTN","BPSJZPR",110,0) . K BPSJSEG(8) M BPSJSEG(8)=WDATA K WDATA "RTN","BPSJZPR",111,0) ; "RTN","BPSJZPR",112,0) Q RCODE "RTN","BPSJZPR",113,0) ; "RTN","BPSJZPR",114,0) NOTES(ARRAYIN,TRCH) ; fProgrammer Notes - Special Code handler "RTN","BPSJZPR",115,0) ; "RTN","BPSJZPR",116,0) N II,ODAT,NODENM "RTN","BPSJZPR",117,0) N ISDATA,ISDATA1,ISDATA2,ISDATA3 "RTN","BPSJZPR",118,0) ; "RTN","BPSJZPR",119,0) I '$D(TRCH) D ; apply standard Vista/Vitria "Free Text" de-encoding "RTN","BPSJZPR",120,0) . S TRCH("\F\")="|",TRCH("\R\")="~",TRCH("\E\")="\" "RTN","BPSJZPR",121,0) . S TRCH("\T\")="&",TRCH("\S\")="^" "RTN","BPSJZPR",122,0) . S TRCH("\.b")=1,TRCH("\.br\")=1 "RTN","BPSJZPR",123,0) ; "RTN","BPSJZPR",124,0) S NODENM="ARRAYIN" "RTN","BPSJZPR",125,0) ; "RTN","BPSJZPR",126,0) S (ODAT,ISDATA1)="" "RTN","BPSJZPR",127,0) F S NODENM=$Q(@NODENM) Q:NODENM="" S ISDATA=@NODENM D "RTN","BPSJZPR",128,0) . ; clean up partial string if any "RTN","BPSJZPR",129,0) . I $L(ISDATA1) D I '$L(ISDATA) Q "RTN","BPSJZPR",130,0) .. S ISDATA1=ISDATA1_$E(ISDATA,1,10) "RTN","BPSJZPR",131,0) .. S ISDATA3=$$DECODE(ISDATA1,.TRCH,.ODAT,.ISDATA2) "RTN","BPSJZPR",132,0) .. S $E(ISDATA,1,10)=ISDATA2 "RTN","BPSJZPR",133,0) . ; "RTN","BPSJZPR",134,0) . S ISDATA2=$$DECODE(ISDATA,.TRCH,.ODAT,.ISDATA1) "RTN","BPSJZPR",135,0) ; "RTN","BPSJZPR",136,0) S ODAT=ODAT_ISDATA1 D NWNODE(.ODAT) K ARRAYIN M ARRAYIN=ODAT "RTN","BPSJZPR",137,0) Q "RTN","BPSJZPR",138,0) ; "RTN","BPSJZPR",139,0) NWNODE(FREERAY) ; build free text array "RTN","BPSJZPR",140,0) N CNT "RTN","BPSJZPR",141,0) S CNT=1+$O(FREERAY(""),-1),FREERAY(CNT)=FREERAY,FREERAY="" "RTN","BPSJZPR",142,0) Q "RTN","BPSJZPR",143,0) ; "RTN","BPSJZPR",144,0) DECODE(INSTR,TCH,WDAT,INSTR1) ; "RTN","BPSJZPR",145,0) ; INSTR - Input string "RTN","BPSJZPR",146,0) ; TCH - translation array "RTN","BPSJZPR",147,0) ; WDAT - Output in a Vista compliant "Free Text" array "RTN","BPSJZPR",148,0) ; INSTR1 - Remainder of text when last or "RTN","BPSJZPR",149,0) ; second to last INSTR char = "\" "RTN","BPSJZPR",150,0) ;Development Note: "RTN","BPSJZPR",151,0) ;\.br\ - removed and new node created "RTN","BPSJZPR",152,0) ;\E\.br\E\ = \.br\ - (no further translation) "RTN","BPSJZPR",153,0) ;non-printable character translation not supported "RTN","BPSJZPR",154,0) ;Output Array nodes will contain no more than 200 characters each "RTN","BPSJZPR",155,0) ; "RTN","BPSJZPR",156,0) N II,CH "RTN","BPSJZPR",157,0) S INSTR1="",WDAT=$G(WDAT) "RTN","BPSJZPR",158,0) F II=1:1:$L(INSTR) S CH=$E(INSTR,II) D:CH="\" S WDAT=WDAT_CH I $L(WDAT)>199 D NWNODE(.WDAT) "RTN","BPSJZPR",159,0) . ; "RTN","BPSJZPR",160,0) . ; Partial TCH string, if \.br\ (CR-LF) translation allowed "RTN","BPSJZPR",161,0) . I $L($E(INSTR,II,II+2))<3,$G(TCH("\.br\")) D Q "RTN","BPSJZPR",162,0) .. S INSTR1=$E(INSTR,II,II+2),II=$L(INSTR),CH="" "RTN","BPSJZPR",163,0) . ; "RTN","BPSJZPR",164,0) . I '$D(TCH($E(INSTR,II,II+2))) Q ; not one we're interested in "RTN","BPSJZPR",165,0) . I +$G(TCH($E(INSTR,II,II+2))) D Q ; \.br\ to conversion "RTN","BPSJZPR",166,0) .. I (II+4)>$L(INSTR) S INSTR1=$E(INSTR,II,$L(INSTR)),II=$L(INSTR),CH="" Q "RTN","BPSJZPR",167,0) .. I +$G(TCH($E(INSTR,II,II+4))) S II=II+4,CH="" D NWNODE(.WDAT) "RTN","BPSJZPR",168,0) . ; "RTN","BPSJZPR",169,0) . S CH=TCH($E(INSTR,II,II+2)),II=II+2 ; std conversion "RTN","BPSJZPR",170,0) Q WDAT ; Return top node of WDAT - for strings less than 200 characters "RTN","BPSJZPR",171,0) ; "RTN","BPSJZPR",172,0) GETPTR(BPDAT) ; Get pointer into BPS NCPDP FIELD DEFS "RTN","BPSJZPR",173,0) N BPSFNM,BPSFNO,BPSIX,BPSIXALT,BPSFX,BPNAMIX,BPNUMIX,BPSFNOCK "RTN","BPSJZPR",174,0) ; "RTN","BPSJZPR",175,0) S BPSFNM=$P($G(BPDAT),"-",2),BPSFNO=+$G(BPDAT) "RTN","BPSJZPR",176,0) I BPSFNM]"",BPSFNO S (BPSIX,BPSIXALT)=0,BPSFX=BPSFNO_U_BPSFNM "RTN","BPSJZPR",177,0) E Q 0 "RTN","BPSJZPR",178,0) S BPNAMIX=$O(^BPSF(9002313.91,"D",BPSFNM,"")) "RTN","BPSJZPR",179,0) S BPNUMIX=$O(^BPSF(9002313.91,"B",BPSFNO,"")) "RTN","BPSJZPR",180,0) ; "RTN","BPSJZPR",181,0) ;-if NAME and NUMBER point to the same IEN (but not 0) "RTN","BPSJZPR",182,0) I BPNAMIX,BPNUMIX=BPNAMIX Q BPNAMIX "RTN","BPSJZPR",183,0) ; "RTN","BPSJZPR",184,0) ;-else might be in another node of the "D" x-ref "RTN","BPSJZPR",185,0) I BPNAMIX,BPNUMIX F D Q:BPSIX Q:'BPNAMIX "RTN","BPSJZPR",186,0) . S BPNAMIX=$O(^BPSF(9002313.91,"D",BPSFNM,BPNAMIX)) "RTN","BPSJZPR",187,0) . I BPNUMIX=BPNAMIX S BPSIX=BPNAMIX "RTN","BPSJZPR",188,0) ; "RTN","BPSJZPR",189,0) ;-If not found, try "B" x-ref value "RTN","BPSJZPR",190,0) I 'BPSIX,BPNUMIX D "RTN","BPSJZPR",191,0) . I $P($G(^BPSF(9002313.91,BPNUMIX,5)),U)=BPSFNM S BPSIX=BPNUMIX Q "RTN","BPSJZPR",192,0) . I 'BPSIXALT,$P($G(^BPSF(9002313.91,BPNUMIX,0)),U,1,2)=BPSFX S BPSIXALT=BPNUMIX Q "RTN","BPSJZPR",193,0) . ; "RTN","BPSJZPR",194,0) . ;-try additional "B" x-ref's for this NUMBER "RTN","BPSJZPR",195,0) . F D Q:BPSIX Q:'BPNUMIX "RTN","BPSJZPR",196,0) .. S BPNUMIX=$O(^BPSF(9002313.91,"B",BPSFNO,BPNUMIX)) "RTN","BPSJZPR",197,0) .. I BPNUMIX D "RTN","BPSJZPR",198,0) ... I $P($G(^BPSF(9002313.91,BPNUMIX,5)),U)=BPSFNM S BPSIX=BPNUMIX "RTN","BPSJZPR",199,0) ... I 'BPSIXALT,$P($G(^BPSF(9002313.91,BPNUMIX,0)),U,1,2)=BPSFX S BPSIXALT=BPNUMIX "RTN","BPSJZPR",200,0) ; "RTN","BPSJZPR",201,0) ;-Last resort - go through all iens' "RTN","BPSJZPR",202,0) I 'BPSIX S BPNUMIX=0 F D Q:BPSIX Q:'BPNUMIX "RTN","BPSJZPR",203,0) . S BPNUMIX=$O(^BPSF(9002313.91,BPNUMIX)) "RTN","BPSJZPR",204,0) . I BPNUMIX,+$G(^BPSF(9002313.91,BPNUMIX,0))[BPSFNO D "RTN","BPSJZPR",205,0) .. S BPSFNOCK=+$G(^BPSF(9002313.91,BPNUMIX,0)) "RTN","BPSJZPR",206,0) .. ; Note: Special coding included for BPSFNO of 498 (498.nn) "RTN","BPSJZPR",207,0) .. I BPSFNOCK'=BPSFNO,$P(BPSFNOCK,".")'=498 Q "RTN","BPSJZPR",208,0) .. I $P($G(^BPSF(9002313.91,BPNUMIX,5)),U)=BPSFNM S BPSIX=BPNUMIX "RTN","BPSJZPR",209,0) .. I 'BPSIXALT,$P($G(^BPSF(9002313.91,BPNUMIX,0)),U,1,2)=BPSFX S BPSIXALT=BPNUMIX "RTN","BPSJZPR",210,0) ; "RTN","BPSJZPR",211,0) Q BPSIX "RTN","BPSJZPR",212,0) ; "RTN","BPSJZPR",213,0) INITZPRS(ZPRS) ;BPSEGID^FLN^FLNSC^FLNPN "RTN","BPSJZPR",214,0) S ZPRS(0)="100^9002313.9205^9002313.92051^9002313.92052" "RTN","BPSJZPR",215,0) S ZPRS(1)="110^9002313.9206^9002313.92061^9002313.92062" "RTN","BPSJZPR",216,0) S ZPRS(2)="140^9002313.9209^9002313.92091^9002313.92092" "RTN","BPSJZPR",217,0) S ZPRS(3)="150^9002313.921^9002313.9211^9002313.9212" "RTN","BPSJZPR",218,0) S ZPRS(4)="120^9002313.9207^9002313.92071^9002313.92072" "RTN","BPSJZPR",219,0) S ZPRS(5)="160^9002313.9213^9002313.92131^9002313.92132" "RTN","BPSJZPR",220,0) S ZPRS(6)="170^9002313.9214^9002313.92141^9002313.92142" "RTN","BPSJZPR",221,0) S ZPRS(7)="130^9002313.9208^9002313.92081^9002313.92082" "RTN","BPSJZPR",222,0) S ZPRS(8)="180^9002313.9215^9002313.92151^9002313.92152" "RTN","BPSJZPR",223,0) S ZPRS(9)="200^9002313.9217^9002313.92171^9002313.92172" "RTN","BPSJZPR",224,0) S ZPRS(10)="210^9002313.9218^9002313.92181^9002313.92182" "RTN","BPSJZPR",225,0) S ZPRS(11)="190^9002313.9216^9002313.92161^9002313.92162" "RTN","BPSJZPR",226,0) S ZPRS(12)="220^9002313.9219^9002313.92191^9002313.92192" "RTN","BPSJZPR",227,0) S ZPRS(13)="230^9002313.922^9002313.9221^9002313.9222" "RTN","BPSJZPR",228,0) S ZPRS(14)="240^9002313.9223^9002313.92231^9002313.92232" "RTN","BPSJZPR",229,0) S ZPRS(15)="250^9002313.9224^9002313.92241^9002313.92242" "RTN","BPSJZPR",230,0) S ZPRS(16)="260^9002313.9225^9002313.92251^9002313.92252" "RTN","BPSJZPR",231,0) Q "RTN","BPSMHDR") 0^9^B3502481 "RTN","BPSMHDR",1,0) BPSMHDR ;BHAM ISC/FCS/DRS - MENUS HEADERS ;06/01/2004 "RTN","BPSMHDR",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSMHDR",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSMHDR",4,0) ; "RTN","BPSMHDR",5,0) ; reference to IX^DIC for PACKAGE file (#9.4) supported by DBIA 10048 "RTN","BPSMHDR",6,0) ; reference to $$GET1^DIQ for INSTITUTION file (#4) supported by DBIA 10090 "RTN","BPSMHDR",7,0) ; reference to $$SITE^VASITE supported by DBIA 10112 "RTN","BPSMHDR",8,0) ; reference to ENDR^%ZISS supported by DBIA 10088 "RTN","BPSMHDR",9,0) ; "RTN","BPSMHDR",10,0) ; XQY0 from MenuMan in various BPS options "RTN","BPSMHDR",11,0) HDR ;EP - Screen header "RTN","BPSMHDR",12,0) N A,BPSMT,BPSPNV,BPSHDR,D,DIC,F,L,N,W,X,Y "RTN","BPSMHDR",13,0) I '$D(IOM) S IOP="" D ^%ZIS "RTN","BPSMHDR",14,0) I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS "RTN","BPSMHDR",15,0) ; PACKAGE file (#9.4) lookup "RTN","BPSMHDR",16,0) S U="^",D="C",DIC="^DIC(9.4,",X="BPS",DIC(0)="" D IX^DIC "RTN","BPSMHDR",17,0) S F=+Y,BPSPNV=$S(F>0:" v"_$$GET1^DIQ(9.4,F,13,1),1:"") "RTN","BPSMHDR",18,0) ; "RTN","BPSMHDR",19,0) S BPSPNV="Electronic Claims Management Engine (ECME)"_BPSPNV "RTN","BPSMHDR",20,0) S A=$P($G(XQY0),U),BPSMT=$S(A="BPSMENU":"Main Menu",A]"":A,1:"BPS option") "RTN","BPSMHDR",21,0) ; W is the width "RTN","BPSMHDR",22,0) S W=51,BPSHDR(1)=$TR($J("",W)," ","*") ; row of asterisks "RTN","BPSMHDR",23,0) S L=W-2-$L(BPSPNV)\2,X="*"_$J("",L)_BPSPNV,BPSHDR(2)=X_$J("",W-$L(X)-1)_"*" ; version "RTN","BPSMHDR",24,0) S A=$$LOC,L=W-2-$L(A)\2,X="*"_$J("",L)_A,BPSHDR(3)=X_$J("",W-$L(X)-1)_"*" ; location "RTN","BPSMHDR",25,0) S L=W-2-$L(BPSMT)\2,X="*"_$J("",L),L=$L(X)+$L(BPSMT) "RTN","BPSMHDR",26,0) S BPSHDR(4)=X_$G(IORVON)_BPSMT_$G(IORVOFF)_$J("",W-L-1)_"*" ; menu option "RTN","BPSMHDR",27,0) S L=IOM-W\2 W @IOF,! "RTN","BPSMHDR",28,0) F N=1:1:4,1 W !,$J("",L)_BPSHDR(N) ; repeat 1st line at end "RTN","BPSMHDR",29,0) W ! "RTN","BPSMHDR",30,0) Q "RTN","BPSMHDR",31,0) ; "RTN","BPSMHDR",32,0) ; "RTN","BPSMHDR",33,0) LOC() ;EP - Return location name from file 4 based on DUZ(2). "RTN","BPSMHDR",34,0) N LOC S LOC="" "RTN","BPSMHDR",35,0) S:$G(DUZ(2)) LOC=$$GET1^DIQ(4,DUZ(2),.01,"E") "RTN","BPSMHDR",36,0) Q $S(LOC]"":LOC,1:$P($$SITE^VASITE,"^",2)) ; DBIA 10112 "RTN","BPSMHDR",37,0) ; "RTN","BPSNCPD1") 0^88^B45414191 "RTN","BPSNCPD1",1,0) BPSNCPD1 ;BHAM ISC/LJE - Pharmacy API part 2 ;06/16/2004 "RTN","BPSNCPD1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,6,7,8,9,10**;JUN 2004;Build 27 "RTN","BPSNCPD1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD1",4,0) ; "RTN","BPSNCPD1",5,0) ; Procedure STARRAY - Retrieve information for API call to IB and store in BPSARRY "RTN","BPSNCPD1",6,0) ; Incoming Parameters "RTN","BPSNCPD1",7,0) ; BRXIEN - Prescription IEN "RTN","BPSNCPD1",8,0) ; BFILL - Fill Number "RTN","BPSNCPD1",9,0) ; BWHERE - RX action "RTN","BPSNCPD1",10,0) ; BPSARRY - Array that is built (passed by reference) "RTN","BPSNCPD1",11,0) ; BPSITE - OUTPATIENT SITE file #59 ien "RTN","BPSNCPD1",12,0) ; background parameters: "RTN","BPSNCPD1",13,0) ; DFN - patient's IEN "RTN","BPSNCPD1",14,0) ; BILLNDC - NDC "RTN","BPSNCPD1",15,0) ; BFILLDAT - fill date "RTN","BPSNCPD1",16,0) STARRAY(BRXIEN,BFILL,BWHERE,BPSARRY,BPSITE) ; "RTN","BPSNCPD1",17,0) N DRUGIEN,BPARR,BPSARR,QTY "RTN","BPSNCPD1",18,0) D RXAPI^BPSUTIL1(BRXIEN,"6;7;8;17;31","BPARR","I") "RTN","BPSNCPD1",19,0) I BFILL>0 D RXSUBF^BPSUTIL1(BRXIEN,52,52.1,BFILL,"1;1.1;1.2;17","BPARR","I") "RTN","BPSNCPD1",20,0) S BPSARRY("DFN")=DFN "RTN","BPSNCPD1",21,0) S BPSARRY("DAYS SUPPLY")=$S(BFILL=0:$G(BPARR(52,BRXIEN,8,"I")),1:$G(BPARR(52.1,BFILL,1.1,"I"))) "RTN","BPSNCPD1",22,0) S BPSARRY("IEN")=BRXIEN "RTN","BPSNCPD1",23,0) S BPSARRY("FILL NUMBER")=BFILL "RTN","BPSNCPD1",24,0) S BPSARRY("NDC")=BILLNDC "RTN","BPSNCPD1",25,0) S (BPSARRY("DRUG"),DRUGIEN)=BPARR(52,BRXIEN,6,"I") "RTN","BPSNCPD1",26,0) S BPSARRY("DEA")=$$DRUGDIE^BPSUTIL1(DRUGIEN,3) "RTN","BPSNCPD1",27,0) S BPSARRY("COST")=$S(BFILL=0:$G(BPARR(52,BRXIEN,17,"I")),1:$G(BPARR(52.1,BFILL,1.2,"I"))) "RTN","BPSNCPD1",28,0) S QTY=$S(BFILL=0:$G(BPARR(52,BRXIEN,7,"I")),1:$G(BPARR(52.1,BFILL,1,"I"))) "RTN","BPSNCPD1",29,0) S BPSARRY("QTY")=QTY ; esg - 4/28/10 - use the Rx QTY at this point (*8) "RTN","BPSNCPD1",30,0) S BPSARRY("FILL DATE")=BFILLDAT "RTN","BPSNCPD1",31,0) S BPSARRY("RELEASE DATE")=$P($S(BFILL=0:$G(BPARR(52,BRXIEN,31,"I")),1:$G(BPARR(52.1,BFILL,17,"I"))),".") "RTN","BPSNCPD1",32,0) S BPSARRY("SC/EI OVR")=0 "RTN","BPSNCPD1",33,0) ;determine BPS PHARMACY "RTN","BPSNCPD1",34,0) I $G(BPSITE)>0 S BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(BPSITE) "RTN","BPSNCPD1",35,0) ; "RTN","BPSNCPD1",36,0) ; Add user so that it is stored correctly in the IB Event Log "RTN","BPSNCPD1",37,0) ; Note: Auto-Reversals (AREV) and CMOP/OPAI (CR*/PC/RL) use postmaster (.5) "RTN","BPSNCPD1",38,0) I ",AREV,CRLB,CRLX,CRLR,PC,RL,"[(","_BWHERE_",") S BPSARRY("USER")=.5 "RTN","BPSNCPD1",39,0) E S BPSARRY("USER")=DUZ "RTN","BPSNCPD1",40,0) Q "RTN","BPSNCPD1",41,0) ; "RTN","BPSNCPD1",42,0) ; Called by BPSNCPDP to display progress of claim "RTN","BPSNCPD1",43,0) ; BRXIEN = Prescription IEN "RTN","BPSNCPD1",44,0) ; BFILL = Fill Number "RTN","BPSNCPD1",45,0) ; REBILL = rebill flag "RTN","BPSNCPD1",46,0) ; REVONLY = reversal only flag "RTN","BPSNCPD1",47,0) ; BPSTART = date/time "RTN","BPSNCPD1",48,0) ; BWHERE = RX Action (see BPSNCPDP comments above for details) "RTN","BPSNCPD1",49,0) ; BPREQIEN = the BPS REQUESTS (#9002313.77) IEN "RTN","BPSNCPD1",50,0) STATUS(BRXIEN,BFILL,REBILL,REVONLY,BPSTART,BWHERE,BPREQIEN,BPSCOB) ; "RTN","BPSNCPD1",51,0) ; Initialization "RTN","BPSNCPD1",52,0) N TRANSIEN,CERTUSER,BPSTO,END,IBSEQ,BPQ,BP77OLD,BP77,BPQQ "RTN","BPSNCPD1",53,0) N CLMSTAT,OCLMSTAT,RESFL,BPACTTYP "RTN","BPSNCPD1",54,0) S BPACTTYP=$$ACTTYPE^BPSOSRX5(BWHERE) "RTN","BPSNCPD1",55,0) S (CLMSTAT,OCLMSTAT)=0 "RTN","BPSNCPD1",56,0) ; "RTN","BPSNCPD1",57,0) ; Set CERTUSER to true if this user is the certifier "RTN","BPSNCPD1",58,0) S CERTUSER=^BPS(9002313.99,1,"CERTIFIER")=DUZ "RTN","BPSNCPD1",59,0) ; "RTN","BPSNCPD1",60,0) ; Build Transaction IEN "RTN","BPSNCPD1",61,0) S TRANSIEN=BRXIEN_"."_$E($TR($J("",4-$L(BFILL))," ","0")_BFILL,1,4)_1 "RTN","BPSNCPD1",62,0) ; "RTN","BPSNCPD1",63,0) ; Write Rebill and Status Messages "RTN","BPSNCPD1",64,0) ; "RTN","BPSNCPD1",65,0) W !!,"Claim Status: " "RTN","BPSNCPD1",66,0) I REBILL,BPACTTYP="UC" W !,"Reversing and Rebilling a previously submitted claim..." ;,!,"Reversing..." "RTN","BPSNCPD1",67,0) I REBILL,BPACTTYP="U" W !,"Reversing..." "RTN","BPSNCPD1",68,0) ; "RTN","BPSNCPD1",69,0) ; Get the ECME Timeout and set the display timeout "RTN","BPSNCPD1",70,0) S BPSTO=$$GET1^DIQ(9002313.99,"1,",3.01),END=$S(CERTUSER:50,$G(BPSTO)]"":BPSTO,1:5) "RTN","BPSNCPD1",71,0) ; "RTN","BPSNCPD1",72,0) ; For remaining time, loop through and display status "RTN","BPSNCPD1",73,0) S (BPQ,RESFL,BP77OLD)=0 "RTN","BPSNCPD1",74,0) F IBSEQ=1:1:END D Q:BPQ=1 "RTN","BPSNCPD1",75,0) . H 1 "RTN","BPSNCPD1",76,0) . ; "RTN","BPSNCPD1",77,0) . ; Get status of resubmit, last update, and claim status "RTN","BPSNCPD1",78,0) . S CLMSTAT=$$STATUS^BPSOSRX(BRXIEN,BFILL,1,$G(BPREQIEN),BPSCOB) "RTN","BPSNCPD1",79,0) . ; "RTN","BPSNCPD1",80,0) . ; Format status message "RTN","BPSNCPD1",81,0) . S CLMSTAT=$P(CLMSTAT,"^",1)_$S($P(CLMSTAT,"^",1)["IN PROGRESS":"-"_$P(CLMSTAT,"^",3),1:"") "RTN","BPSNCPD1",82,0) . ; "RTN","BPSNCPD1",83,0) . ;If the status has changed, display the new message "RTN","BPSNCPD1",84,0) . I OCLMSTAT'=CLMSTAT W !,CLMSTAT S OCLMSTAT=CLMSTAT I CLMSTAT="E REJECTED",$G(BPSELIG)'="V" D "RTN","BPSNCPD1",85,0) .. N BPSRTEXT,BPSRESP,BPSPOS,X "RTN","BPSNCPD1",86,0) .. S BPSRESP=$P($G(^BPST(IEN59,0)),"^",5) Q:'BPSRESP "RTN","BPSNCPD1",87,0) .. S BPSPOS=+$O(^BPSR(BPSRESP,1000,":"),-1) Q:'BPSPOS "RTN","BPSNCPD1",88,0) .. D REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT) "RTN","BPSNCPD1",89,0) .. S X=0 F S X=$O(BPSRTEXT(X)) Q:'X W !?4,$P(BPSRTEXT(X),":")," - ",$P(BPSRTEXT(X),":",2) "RTN","BPSNCPD1",90,0) . ; "RTN","BPSNCPD1",91,0) . ; If the status is not IN PROGRESS, then we are done "RTN","BPSNCPD1",92,0) . I CLMSTAT'["IN PROGRESS",'$D(^BPS(9002313.77,"D",BRXIEN,BFILL,BPSCOB)) S BPQ=1 "RTN","BPSNCPD1",93,0) W ! "RTN","BPSNCPD1",94,0) Q "RTN","BPSNCPD1",95,0) ; "RTN","BPSNCPD1",96,0) ; Bulletin to the OPECC "RTN","BPSNCPD1",97,0) ; BPST=Tricare flag 1 is Tricare Related "RTN","BPSNCPD1",98,0) BULL(RXI,RXR,SITE,DFN,PATNAME,BPST,BPSERTXT,BPSRESP) ; "RTN","BPSNCPD1",99,0) N BTXT,XMSUB,XMY,XMTEXT,XMDUZ "RTN","BPSNCPD1",100,0) N SSN,X,SITENM "RTN","BPSNCPD1",101,0) I $G(SITE) D "RTN","BPSNCPD1",102,0) . K ^TMP($J,"BPSARR") "RTN","BPSNCPD1",103,0) . D PSS^PSO59(SITE,,"BPSARR") "RTN","BPSNCPD1",104,0) . S SITENM=$G(^TMP($J,"BPSARR",SITE,.01)) "RTN","BPSNCPD1",105,0) I $G(DFN) D "RTN","BPSNCPD1",106,0) . S X=$P($G(^DPT(DFN,0)),U,9) "RTN","BPSNCPD1",107,0) . S SSN=$E(X,$L(X)-3,$L(X)) "RTN","BPSNCPD1",108,0) ; "RTN","BPSNCPD1",109,0) ; Need to do in the background "RTN","BPSNCPD1",110,0) ; Mailman calls CMOP which calls EN^BPSNCPDP. "RTN","BPSNCPD1",111,0) ; If BPSNCPDP* (same process) then calls mailman, it gets confused. "RTN","BPSNCPD1",112,0) N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC "RTN","BPSNCPD1",113,0) N %,%H,%I,X "RTN","BPSNCPD1",114,0) D NOW^%DTC "RTN","BPSNCPD1",115,0) S ZTIO="",ZTDTH=%,ZTDESC="IN PROGRESS BULLETIN" "RTN","BPSNCPD1",116,0) S (ZTSAVE("RXR"),ZTSAVE("RXI"),ZTSAVE("BPSERTXT"))="",ZTSAVE("BPSRESP")="" "RTN","BPSNCPD1",117,0) S (ZTSAVE("SITENM"),ZTSAVE("PATNAME"),ZTSAVE("SSN"),ZTSAVE("BPST"))="" "RTN","BPSNCPD1",118,0) S ZTRTN="BULL1^BPSNCPD1" "RTN","BPSNCPD1",119,0) D ^%ZTLOAD "RTN","BPSNCPD1",120,0) Q "RTN","BPSNCPD1",121,0) ; "RTN","BPSNCPD1",122,0) ; "RTN","BPSNCPD1",123,0) BULL1 ; "RTN","BPSNCPD1",124,0) N BPSRX,BPSL,XMDUZ,XMY,BPSX,XMZ,XMSUB "RTN","BPSNCPD1",125,0) S BPSL=0,BPSRX=$$RXAPI1^BPSUTIL1(RXI,.01,"E") "RTN","BPSNCPD1",126,0) S XMSUB=$S($G(BPST):"TRICARE ",1:"")_"RX not processed for site "_$G(SITENM) "RTN","BPSNCPD1",127,0) I $G(BPST) D "RTN","BPSNCPD1",128,0) . S BPSL=BPSL+1,BPSX(BPSL)="Prescription "_BPSRX_" for fill number "_(+RXR)_" could not be filled because of a" "RTN","BPSNCPD1",129,0) . S BPSL=BPSL+1,BPSX(BPSL)="delay in processing the third party claim. The Rx was placed on suspense" "RTN","BPSNCPD1",130,0) . S BPSL=BPSL+1,BPSX(BPSL)="because TRICARE Rx's may not be filled unless they have a payable third" "RTN","BPSNCPD1",131,0) . S BPSL=BPSL+1,BPSX(BPSL)="party claim." "RTN","BPSNCPD1",132,0) . S BPSL=BPSL+1,BPSX(BPSL)=" " "RTN","BPSNCPD1",133,0) . S BPSL=BPSL+1,BPSX(BPSL)="Please monitor the progress of the claim. If the claim is eventually" "RTN","BPSNCPD1",134,0) . S BPSL=BPSL+1,BPSX(BPSL)="returned as payable, the Rx label will be printed when Print from Suspense" "RTN","BPSNCPD1",135,0) . S BPSL=BPSL+1,BPSX(BPSL)="occurs or it may be Pulled Early from Suspense. If a reject occurs, the" "RTN","BPSNCPD1",136,0) . S BPSL=BPSL+1,BPSX(BPSL)="Rx will be placed in the REFILL TOO SOON/DUR REJECTS (Third Party) section" "RTN","BPSNCPD1",137,0) . S BPSL=BPSL+1,BPSX(BPSL)="of the medication profile and placed on the Pharmacy Reject Worklist." "RTN","BPSNCPD1",138,0) ; "RTN","BPSNCPD1",139,0) ; "RTN","BPSNCPD1",140,0) I $G(BPSERTXT)'="" S BPSL=BPSL+1,BPSX(BPSL)=BPSERTXT "RTN","BPSNCPD1",141,0) S BPSL=BPSL+1,BPSX(BPSL)=" " "RTN","BPSNCPD1",142,0) I $G(BPSRESP)'=4 D "RTN","BPSNCPD1",143,0) . S BPSL=BPSL+1,BPSX(BPSL)="For more information on this prescription's activity, please view the ECME" "RTN","BPSNCPD1",144,0) . S BPSL=BPSL+1,BPSX(BPSL)="log within the View Prescription (VP) option on the Further Research (FR)" "RTN","BPSNCPD1",145,0) . S BPSL=BPSL+1,BPSX(BPSL)="menu of the ECME user screen." "RTN","BPSNCPD1",146,0) . S BPSL=BPSL+1,BPSX(BPSL)=" " "RTN","BPSNCPD1",147,0) S BPSL=BPSL+1,BPSX(BPSL)=$S($G(BPST):"TRICARE ",1:"")_"Patient Name: "_$G(PATNAME)_" ("_$G(SSN)_")" "RTN","BPSNCPD1",148,0) S BPSL=BPSL+1,BPSX(BPSL)="Prescription: "_BPSRX_" Fill: "_(+RXR) "RTN","BPSNCPD1",149,0) S BPSL=BPSL+1,BPSX(BPSL)="Drug Name: "_$$RXAPI1^BPSUTIL1(RXI,6,"E") "RTN","BPSNCPD1",150,0) ; "RTN","BPSNCPD1",151,0) S XMDUZ="BPS PACKAGE",XMTEXT="BPSX(" "RTN","BPSNCPD1",152,0) ; "RTN","BPSNCPD1",153,0) ;****add by bld on 7/25/2010 for tricare enhancement 10 **** "RTN","BPSNCPD1",154,0) I $G(BPST) S XMY("G.BPS TRICARE")="" "RTN","BPSNCPD1",155,0) E S XMY("G.BPS OPECC")="" "RTN","BPSNCPD1",156,0) ;******************************* "RTN","BPSNCPD1",157,0) ; "RTN","BPSNCPD1",158,0) I $G(DUZ)'<1 S XMY(DUZ)="" "RTN","BPSNCPD1",159,0) D ^XMD "RTN","BPSNCPD1",160,0) I $G(BPST),$G(XMZ) D PRIORITY^XMXEDIT(XMZ) "RTN","BPSNCPD1",161,0) Q "RTN","BPSNCPD2") 0^32^B62016998 "RTN","BPSNCPD2",1,0) BPSNCPD2 ;BHAM ISC/LJE - Continuation of BPSNCPDP (IB Billing Determination) ;11/7/07 16:01 "RTN","BPSNCPD2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6,7,8,10**;JUN 2004;Build 27 "RTN","BPSNCPD2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD2",4,0) ;External reference $$RX^IBNCPDP supported by DBIA 4299 "RTN","BPSNCPD2",5,0) ;External reference to $$NCPDPQTY^PSSBPSUT supported by IA4992 "RTN","BPSNCPD2",6,0) ; "RTN","BPSNCPD2",7,0) ; "RTN","BPSNCPD2",8,0) ; EN - Call IB Billing Determination. If good to go, update MOREDATA array "RTN","BPSNCPD2",9,0) ; Notes about variables "RTN","BPSNCPD2",10,0) ;Input: "RTN","BPSNCPD2",11,0) ; DFN - PATIENT file #2 ien "RTN","BPSNCPD2",12,0) ; BWHERE - Where the code is called from and what needs to be done "RTN","BPSNCPD2",13,0) ; MOREDATA - Initialized by BPSNCPDP and more data is added here. "RTN","BPSNCPD2",14,0) ; Should be passed by reference. "RTN","BPSNCPD2",15,0) ; BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination "RTN","BPSNCPD2",16,0) ; IB - Returned to calling routine. Should be passed by reference. "RTN","BPSNCPD2",17,0) ; 1 = Billable "RTN","BPSNCPD2",18,0) ; 0 or 2 - Not Billable "RTN","BPSNCPD2",19,0) ; "RTN","BPSNCPD2",20,0) ; Variable used/needed but not passed in as a parameter "RTN","BPSNCPD2",21,0) ; CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP "RTN","BPSNCPD2",22,0) ; BPJOBFLG - Not passed in but newed/set in BPSNCPCP "RTN","BPSNCPD2",23,0) ; "RTN","BPSNCPD2",24,0) EN(DFN,BWHERE,MOREDATA,BPSARRY,IB) ; "RTN","BPSNCPD2",25,0) I '$G(CERTIEN) D I IB=2 Q "RTN","BPSNCPD2",26,0) . ; "RTN","BPSNCPD2",27,0) . ;For NCPDP IB call to see if we need to 3rd Party Bill and if so, get insurance/payer sheet info "RTN","BPSNCPD2",28,0) . S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;IB CALL "RTN","BPSNCPD2",29,0) . Q:'$D(MOREDATA("BILL")) "RTN","BPSNCPD2",30,0) . ; "RTN","BPSNCPD2",31,0) . ; If calling program is the ECME user screen and we can't bill because of NEEDS SC DETERMINATION "RTN","BPSNCPD2",32,0) . ; or EI, then prompt the user to see if they want to bill "RTN","BPSNCPD2",33,0) . I BWHERE="ERES",$P(MOREDATA("BILL"),U,1)=0,$G(BPSARRY("SC/EI NO ANSW"))]"",$G(BPJOBFLG)'="B" D "RTN","BPSNCPD2",34,0) .. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,I,BPEISC "RTN","BPSNCPD2",35,0) .. F I=1:1:$L($G(BPSARRY("SC/EI NO ANSW")),",") S BPEISC=$P($G(BPSARRY("SC/EI NO ANSW")),",",I) I BPEISC]"" D "RTN","BPSNCPD2",36,0) ... W !,"The prescription is potentially ",BPEISC,"-related and needs ",BPEISC," determination." "RTN","BPSNCPD2",37,0) ... W !,"Prescriptions related to ",BPEISC," cannot be billed to Third Party Insurance.",! "RTN","BPSNCPD2",38,0) .. S DIR(0)="Y",DIR("A")="Are you sure you want to bill this prescription" "RTN","BPSNCPD2",39,0) .. S DIR("B")="NO" "RTN","BPSNCPD2",40,0) .. S DIR("?")="If you want to bill this prescription, enter 'Yes' - otherwise, enter 'No'" "RTN","BPSNCPD2",41,0) .. W ! D ^DIR K DIR "RTN","BPSNCPD2",42,0) .. I '+Y Q "RTN","BPSNCPD2",43,0) .. S BPSARRY("SC/EI OVR")=1 "RTN","BPSNCPD2",44,0) .. S MOREDATA("BILL")=$$RX^IBNCPDP(DFN,.BPSARRY) ;Call IB again "RTN","BPSNCPD2",45,0) . ; "RTN","BPSNCPD2",46,0) . ; Quit if no response from IB call "RTN","BPSNCPD2",47,0) . Q:'$D(MOREDATA("BILL")) "RTN","BPSNCPD2",48,0) . S MOREDATA("ELIG")=$P(MOREDATA("BILL"),"^",3) "RTN","BPSNCPD2",49,0) . I $P(MOREDATA("BILL"),U,1)=0 S IB=2 Q ;IB says not to bill "RTN","BPSNCPD2",50,0) . ; "RTN","BPSNCPD2",51,0) . ; esg - 4/28/10 - after the above $$RX^IBNCPDP calls to billing, now get the NCPDP quantity and units for ECME (*8) "RTN","BPSNCPD2",52,0) . N QTY "RTN","BPSNCPD2",53,0) . S QTY=$$NCPDPQTY^PSSBPSUT($G(BPSARRY("DRUG")),$G(BPSARRY("QTY"))) ; DBIA# 4992 "RTN","BPSNCPD2",54,0) . S BPSARRY("QTY")=$P(QTY,U,1) ; NCPDP BILLING QUANTITY "RTN","BPSNCPD2",55,0) . S BPSARRY("UNITS")=$P(QTY,U,2) ; NCPDP DISPENSE UNIT "RTN","BPSNCPD2",56,0) . ; "RTN","BPSNCPD2",57,0) . S IB=1 "RTN","BPSNCPD2",58,0) . M MOREDATA("IBDATA")=BPSARRY("INS") "RTN","BPSNCPD2",59,0) . S MOREDATA("PATIENT")=$G(DFN) "RTN","BPSNCPD2",60,0) . S MOREDATA("RX")=$G(BPSARRY("IEN")) "RTN","BPSNCPD2",61,0) . S $P(MOREDATA("BPSDATA",1),U,1)=$G(BPSARRY("QTY")) "RTN","BPSNCPD2",62,0) . S $P(MOREDATA("BPSDATA",1),U,2)=$G(BPSARRY("COST")) "RTN","BPSNCPD2",63,0) . S $P(MOREDATA("BPSDATA",1),U,3)=$G(BPSARRY("NDC")) "RTN","BPSNCPD2",64,0) . S $P(MOREDATA("BPSDATA",1),U,4)=$G(BPSARRY("FILL NUMBER")) "RTN","BPSNCPD2",65,0) . S $P(MOREDATA("BPSDATA",1),U,5)="" ; Certify Mode "RTN","BPSNCPD2",66,0) . S $P(MOREDATA("BPSDATA",1),U,6)="" ; Cert IEN "RTN","BPSNCPD2",67,0) . S $P(MOREDATA("BPSDATA",1),U,7)=$G(BPSARRY("UNITS")) "RTN","BPSNCPD2",68,0) ; "RTN","BPSNCPD2",69,0) ; If certification mode on and no IB result (somewhat redundant since IB is not called "RTN","BPSNCPD2",70,0) ; for certification), get data from BPS Certification table "RTN","BPSNCPD2",71,0) I $G(CERTIEN),'$G(IB) D "RTN","BPSNCPD2",72,0) . N NODE,FLD,NFLD,CERTARY "RTN","BPSNCPD2",73,0) . S MOREDATA("IBDATA",1,1)="",MOREDATA("IBDATA",1,2)="" "RTN","BPSNCPD2",74,0) . S MOREDATA("IBDATA",1,3)="",MOREDATA("BPSDATA",1)="" "RTN","BPSNCPD2",75,0) . S MOREDATA("BILL")="1^^V",IB=1 "RTN","BPSNCPD2",76,0) . S MOREDATA("PATIENT")=$$GET1^DIQ(9002313.31,CERTIEN,903,"I") ;Patient from certification record "RTN","BPSNCPD2",77,0) . I 'MOREDATA("PATIENT") S MOREDATA("PATIENT")=$G(DFN) ; Patient "RTN","BPSNCPD2",78,0) . S MOREDATA("RX")=$G(BPSARRY("IEN")) ; RX "RTN","BPSNCPD2",79,0) . S MOREDATA("ELIG")="V" ; Eligibility "RTN","BPSNCPD2",80,0) . S $P(MOREDATA("BPSDATA",1),U,5)=1 ;Certify Mode "RTN","BPSNCPD2",81,0) . S $P(MOREDATA("BPSDATA",1),U,6)=CERTIEN ;Cert IEN "RTN","BPSNCPD2",82,0) . S $P(MOREDATA("IBDATA",1,1),U,1)=1 ;Plan IEN "RTN","BPSNCPD2",83,0) . S $P(MOREDATA("IBDATA",1,1),U,4)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"E") ;Billing Payer Sheet Name "RTN","BPSNCPD2",84,0) . S $P(MOREDATA("IBDATA",1,1),U,10)="01" ;Home State Plan "RTN","BPSNCPD2",85,0) . S $P(MOREDATA("IBDATA",1,1),U,11)=$$GET1^DIQ(9002313.31,CERTIEN,.05,"E") ;Reversal Payer Sheet Name "RTN","BPSNCPD2",86,0) . S $P(MOREDATA("IBDATA",1,1),U,12)="" ;Rebill Payer Sheet Name "RTN","BPSNCPD2",87,0) . S $P(MOREDATA("IBDATA",1,1),U,14)="" ;Plan Name "RTN","BPSNCPD2",88,0) . S $P(MOREDATA("IBDATA",1,1),U,15)=$$GET1^DIQ(9002313.31,CERTIEN,.08,"E") ;Eligibility Payer Sheet Name "RTN","BPSNCPD2",89,0) . S $P(MOREDATA("IBDATA",1,1),U,16)=$$GET1^DIQ(9002313.31,CERTIEN,.04,"I") ;Billing Payer Sheet IEN "RTN","BPSNCPD2",90,0) . S $P(MOREDATA("IBDATA",1,1),U,17)=$$GET1^DIQ(9002313.31,CERTIEN,.05,"I") ;Reversal Payer Sheet IEN "RTN","BPSNCPD2",91,0) . S $P(MOREDATA("IBDATA",1,1),U,18)="" ; Rebill Payer Sheet IEN "RTN","BPSNCPD2",92,0) . S $P(MOREDATA("IBDATA",1,1),U,19)=$$GET1^DIQ(9002313.31,CERTIEN,.08,"I") ; Eligibility Payer Sheet IEN "RTN","BPSNCPD2",93,0) . S $P(MOREDATA("IBDATA",1,2),U,5)=0 ;Admin Fee "RTN","BPSNCPD2",94,0) . S $P(MOREDATA("IBDATA",1,3),U,1)="" ;Group Name "RTN","BPSNCPD2",95,0) . S $P(MOREDATA("IBDATA",1,3),U,2)="" ;Insurance Company Phone Number "RTN","BPSNCPD2",96,0) . S $P(MOREDATA("IBDATA",1,3),U,3)="T00010" ;Plan ID "RTN","BPSNCPD2",97,0) . S $P(MOREDATA("IBDATA",1,3),U,4)="V" ;Plan Type "RTN","BPSNCPD2",98,0) . S $P(MOREDATA("IBDATA",1,3),U,5)="" ;Insurance Company IEN "RTN","BPSNCPD2",99,0) . S $P(MOREDATA("IBDATA",1,3),U,6)=$$GET1^DIQ(9002313.31,CERTIEN,.07,"I") ;COB Indicator "RTN","BPSNCPD2",100,0) . I $P(MOREDATA("IBDATA",1,3),U,6)="" S $P(MOREDATA("IBDATA",1,3),U,6)=1 "RTN","BPSNCPD2",101,0) . S $P(MOREDATA("IBDATA",1,3),U,7)=1 ;Policy Number (needed for eligibility transmissions) "RTN","BPSNCPD2",102,0) . S $P(MOREDATA("IBDATA",1,3),U,8)=1 ;Maximum Transactions "RTN","BPSNCPD2",103,0) . ; "RTN","BPSNCPD2",104,0) . ;Get data from non-multiple fields and add to MOREDATA "RTN","BPSNCPD2",105,0) . K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","1*","","CERTARY") "RTN","BPSNCPD2",106,0) . S NODE="" F S NODE=$O(CERTARY(9002313.311,NODE)) Q:NODE="" D "RTN","BPSNCPD2",107,0) .. S FLD="" F S FLD=$O(CERTARY(9002313.311,NODE,FLD)) Q:FLD="" D "RTN","BPSNCPD2",108,0) ... I FLD=.01 S NFLD=CERTARY(9002313.311,NODE,FLD) D "RTN","BPSNCPD2",109,0) .... I NFLD=101 S $P(MOREDATA("IBDATA",1,1),U,2)=CERTARY(9002313.311,NODE,.02) ;BIN "RTN","BPSNCPD2",110,0) .... I NFLD=104 S $P(MOREDATA("IBDATA",1,1),U,3)=CERTARY(9002313.311,NODE,.02) ;PCN "RTN","BPSNCPD2",111,0) .... I NFLD=110 S $P(MOREDATA("IBDATA",1,1),U,13)=CERTARY(9002313.311,NODE,.02) ;Certification ID "RTN","BPSNCPD2",112,0) . ; "RTN","BPSNCPD2",113,0) . ;Get data from multiple fields and add to MOREDATA "RTN","BPSNCPD2",114,0) . K CERTARY D GETS^DIQ(9002313.31,CERTIEN_",","2*","","CERTARY") "RTN","BPSNCPD2",115,0) . S NODE="" F S NODE=$O(CERTARY(9002313.3121,NODE)) Q:NODE="" D "RTN","BPSNCPD2",116,0) .. S FLD="" F S FLD=$O(CERTARY(9002313.3121,NODE,FLD)) Q:FLD="" D "RTN","BPSNCPD2",117,0) ... I FLD=.01 S NFLD=CERTARY(9002313.3121,NODE,FLD) D "RTN","BPSNCPD2",118,0) .... I NFLD=301 S $P(MOREDATA("IBDATA",1,1),U,5)=CERTARY(9002313.3121,NODE,.02) ;Group ID "RTN","BPSNCPD2",119,0) .... I NFLD=302 S $P(MOREDATA("IBDATA",1,1),U,6)=CERTARY(9002313.3121,NODE,.02) ;Cardholder ID "RTN","BPSNCPD2",120,0) .... I NFLD=306 S $P(MOREDATA("IBDATA",1,1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Patient Rel Code "RTN","BPSNCPD2",121,0) .... I NFLD=312 S $P(MOREDATA("IBDATA",1,1),U,8)=CERTARY(9002313.3121,NODE,.02) ;Cardholder First Name "RTN","BPSNCPD2",122,0) .... I NFLD=313 S $P(MOREDATA("IBDATA",1,1),U,9)=CERTARY(9002313.3121,NODE,.02) ;Cardholder Last Name "RTN","BPSNCPD2",123,0) .... I NFLD=412 S $P(MOREDATA("IBDATA",1,2),U,1)=CERTARY(9002313.3121,NODE,.02) ;Dispensing Fee "RTN","BPSNCPD2",124,0) .... I NFLD=423 S $P(MOREDATA("IBDATA",1,2),U,2)=CERTARY(9002313.3121,NODE,.02) ;Basis of Cost Determination "RTN","BPSNCPD2",125,0) .... I NFLD=426 S $P(MOREDATA("IBDATA",1,2),U,3)=CERTARY(9002313.3121,NODE,.02) ;Usual & Customary - Base Price "RTN","BPSNCPD2",126,0) .... I NFLD=430 S $P(MOREDATA("IBDATA",1,2),U,4)=CERTARY(9002313.3121,NODE,.02) ;Gross Amt Due "RTN","BPSNCPD2",127,0) .... I NFLD=442 S $P(MOREDATA("BPSDATA",1),U,1)=CERTARY(9002313.3121,NODE,.02) ;Qty "RTN","BPSNCPD2",128,0) .... I NFLD=409 S $P(MOREDATA("BPSDATA",1),U,2)=CERTARY(9002313.3121,NODE,.02) ;Unit Cost "RTN","BPSNCPD2",129,0) .... I NFLD=407 S $P(MOREDATA("BPSDATA",1),U,3)=CERTARY(9002313.3121,NODE,.02) ;NDC "RTN","BPSNCPD2",130,0) .... I NFLD=403 S $P(MOREDATA("BPSDATA",1),U,4)=+CERTARY(9002313.3121,NODE,.02) ;Fill # "RTN","BPSNCPD2",131,0) .... I NFLD=600 S $P(MOREDATA("BPSDATA",1),U,7)=CERTARY(9002313.3121,NODE,.02) ;Unit of Measure "RTN","BPSNCPD2",132,0) . ; "RTN","BPSNCPD2",133,0) . ; If Gross Amt Due is missing, use Usual and Customary "RTN","BPSNCPD2",134,0) . I $P(MOREDATA("IBDATA",1,2),U,4)="" S $P(MOREDATA("IBDATA",1,2),U,4)=$P(MOREDATA("IBDATA",1,2),U,3) "RTN","BPSNCPD2",135,0) ; "RTN","BPSNCPD2",136,0) ; The code below checks if Sequence one is missing and move the next number down if needed. "RTN","BPSNCPD2",137,0) ; This can happen when the COB indicator in IB has multiple insurances assigned as secondary but none are "RTN","BPSNCPD2",138,0) ; assigned as primary "RTN","BPSNCPD2",139,0) I '$D(MOREDATA("IBDATA",1)) D "RTN","BPSNCPD2",140,0) . N WW "RTN","BPSNCPD2",141,0) . S WW=$O(MOREDATA("IBDATA","")) "RTN","BPSNCPD2",142,0) . I WW'="" M MOREDATA("IBDATA",1)=MOREDATA("IBDATA",WW) K MOREDATA("IBDATA",WW) "RTN","BPSNCPD2",143,0) ; "RTN","BPSNCPD2",144,0) ; Uppercase the IBDATA "RTN","BPSNCPD2",145,0) ; DMB - Existing Code. Not sure if it is needed. "RTN","BPSNCPD2",146,0) S MOREDATA("IBDATA",1,1)=$TR($G(MOREDATA("IBDATA",1,1)),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSNCPD2",147,0) S MOREDATA("IBDATA",1,2)=$TR($G(MOREDATA("IBDATA",1,2)),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSNCPD2",148,0) S MOREDATA("BPSDATA",1)=$TR($G(MOREDATA("BPSDATA",1)),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSNCPD2",149,0) ; "RTN","BPSNCPD2",150,0) Q "RTN","BPSNCPD3") 0^2^B48711811 "RTN","BPSNCPD3",1,0) BPSNCPD3 ;BHAM ISC/LJE - Continuation of BPSNCPDP - DUR HANDLING ;06/16/2004 "RTN","BPSNCPD3",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,6,7,8,10**;JUN 2004;Build 27 "RTN","BPSNCPD3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD3",4,0) ; "RTN","BPSNCPD3",5,0) ; Due to space considerations, these comments were moved from BPSNPCPD "RTN","BPSNCPD3",6,0) ; to this routine. "RTN","BPSNCPD3",7,0) ; "RTN","BPSNCPD3",8,0) ; ------------------ Beginning of BPSNCPDP comments ------------------ "RTN","BPSNCPD3",9,0) ;Input "RTN","BPSNCPD3",10,0) ; BRXIEN = Prescription IEN "RTN","BPSNCPD3",11,0) ; BFILL = Fill Number "RTN","BPSNCPD3",12,0) ; BFILLDAT = Fill Date of current prescription and fill number "RTN","BPSNCPD3",13,0) ; BWHERE (RX Action) "RTN","BPSNCPD3",14,0) ; ARES = Resubmit for an auto-reversed claim was released while waiting "RTN","BPSNCPD3",15,0) ; for the payer response "RTN","BPSNCPD3",16,0) ; AREV = Auto-Reversal "RTN","BPSNCPD3",17,0) ; BB = Back Billing "RTN","BPSNCPD3",18,0) ; CRLB = CMOP Release & Rebill "RTN","BPSNCPD3",19,0) ; CRLR = CMOP Release & Reverse (successful release) "RTN","BPSNCPD3",20,0) ; CRLX = CMOP unsuccessful release & reverse "RTN","BPSNCPD3",21,0) ; DC = Discontinue - only reverse un-released PAYABLE DC's, release date check "RTN","BPSNCPD3",22,0) ; should be in calling routine. "RTN","BPSNCPD3",23,0) ; DDED = Delete in edit "RTN","BPSNCPD3",24,0) ; DE = Delete "RTN","BPSNCPD3",25,0) ; ED = Edit "RTN","BPSNCPD3",26,0) ; ERES = Resubmit from ECME user screen "RTN","BPSNCPD3",27,0) ; EREV = Reversal from ECME user screen "RTN","BPSNCPD3",28,0) ; HLD = Put prescription on Hold "RTN","BPSNCPD3",29,0) ; OF = Original Fill "RTN","BPSNCPD3",30,0) ; PC = Pull CMOPs "RTN","BPSNCPD3",31,0) ; PE = Pull early from suspense "RTN","BPSNCPD3",32,0) ; PL = Pull local from suspense "RTN","BPSNCPD3",33,0) ; PP = PP from Patient Prescription Processing option "RTN","BPSNCPD3",34,0) ; RF = Refill "RTN","BPSNCPD3",35,0) ; RL = Release Rx NDC check - Rebill if billed NDC doesn't match release NDC "RTN","BPSNCPD3",36,0) ; RN = Renew "RTN","BPSNCPD3",37,0) ; RRL = Original claim rejected, submit another claim, no reversal "RTN","BPSNCPD3",38,0) ; RS = Return-to-Stock "RTN","BPSNCPD3",39,0) ; BILLNDC = Valid NDC# with format 5-4-2 "RTN","BPSNCPD3",40,0) ; REVREAS = Reversal Reason "RTN","BPSNCPD3",41,0) ; DURREC = String of DUR info - Three "^" pieces "RTN","BPSNCPD3",42,0) ; Professional Service Code "RTN","BPSNCPD3",43,0) ; Reason for Service Code "RTN","BPSNCPD3",44,0) ; Result of Service Code "RTN","BPSNCPD3",45,0) ; BPOVRIEN = Pointer to BPS NCPDP OVERIDE file. This parameter will "RTN","BPSNCPD3",46,0) ; only be passed if there are overrides entered by the "RTN","BPSNCPD3",47,0) ; user via the Resubmit with Edits (RED) option in the "RTN","BPSNCPD3",48,0) ; user screen. "RTN","BPSNCPD3",49,0) ; BPSAUTH = pre-authorization code (preauth. code^preauth number) "RTN","BPSNCPD3",50,0) ; BPSCLARF = Submission Clarification Code (external value from #9002313.25), entered by "RTN","BPSNCPD3",51,0) ; pharmacist and passed by Outpatient Pharmacy to ECME to put into the claim "RTN","BPSNCPD3",52,0) ; BPCOBIND = (optional, default is Primary) for COB indicators - so when the API is called for the particular "RTN","BPSNCPD3",53,0) ; COB claim the BPSNCPDP can handle it. "RTN","BPSNCPD3",54,0) ; BPJOBFLG = (optional, default is "F") B - if is called by unqueueing logic in background, F - by other (foreground) process, "RTN","BPSNCPD3",55,0) ; BPREQIEN = (optional) ien of BPS REQUEST file record, that needs to be unqueued "RTN","BPSNCPD3",56,0) ; BPSCLOSE = (optional) local array used with BWHERE="EREV" only, if the user had chosen to close the claim after reversal "RTN","BPSNCPD3",57,0) ; if claim needs to be closed then "RTN","BPSNCPD3",58,0) ; BPSCLOSE("CLOSE AFT REV")=1 "RTN","BPSNCPD3",59,0) ; BPSCLOSE("CLOSE AFT REV REASON")=<#356.8 ien> "RTN","BPSNCPD3",60,0) ; BPSCLOSE("CLOSE AFT REV COMMENT")= "RTN","BPSNCPD3",61,0) ; BPSPLAN = (optional) IEN of the entry in the GROUP INSURANCE PLAN file (#355.3) "RTN","BPSNCPD3",62,0) ; BPSPRDAT = (optional) local array passed by reference. Contains primary claim data needed to submit a secondary claim. "RTN","BPSNCPD3",63,0) ; Format: BPSPRDAT(NCPDP field) "RTN","BPSNCPD3",64,0) ; BPSRTYPE = (optional) rate type ( ien of the file #399.3) "RTN","BPSNCPD3",65,0) ; BPSDELAY = Delay Reason Code (IEN of BPS NCPDP DELAY REASON CODE (#9002313.29), entered by the user "RTN","BPSNCPD3",66,0) ; in the Back Billing option of Claims Tracking and passed to ECME to put into the claim. "RTN","BPSNCPD3",67,0) ; "RTN","BPSNCPD3",68,0) ;Output (RESPONSE^MESSAGE^ELIGIBILITY^CLAIMSTATUS^COB^RXCOB^INSURANCE) "RTN","BPSNCPD3",69,0) ; RESPONSE "RTN","BPSNCPD3",70,0) ; 0 Submitted through ECME "RTN","BPSNCPD3",71,0) ; 1 No submission through ECME "RTN","BPSNCPD3",72,0) ; 2 IB not billable "RTN","BPSNCPD3",73,0) ; 3 Claim was closed, not submitted (RTS/Deletes) "RTN","BPSNCPD3",74,0) ; 4 Unable to queue claim "RTN","BPSNCPD3",75,0) ; 5 Incorrect information supplied to ECME "RTN","BPSNCPD3",76,0) ; 6 Inactive ECME - Primarily used for Tricare to say ok to process rx "RTN","BPSNCPD3",77,0) ; 10 Reversal but no resubmit "RTN","BPSNCPD3",78,0) ; MESSAGE = Message associated with the response (error/submitted) "RTN","BPSNCPD3",79,0) ; ELIGIBILITY = V - VA, T - Tricare "RTN","BPSNCPD3",80,0) ; CLAIMSTATUS = claim status (null or IN PROGRESS/E PAYABLE/etc...) "RTN","BPSNCPD3",81,0) ; COB = Coordination Of Benefit indicator of the insurance as it is stored in the PATIENT file: 1- primary, 2 -secondary, 3 -tertiary "RTN","BPSNCPD3",82,0) ; RXCOB = the payer sequence indicator of the claim which was sent to the payer as a result of this call: 1- primary, 2 -secondary) "RTN","BPSNCPD3",83,0) ; INSURANCE = Name of the insurance company that was billed as a result of this call "RTN","BPSNCPD3",84,0) ; "RTN","BPSNCPD3",85,0) ; ----------------- End of BPSNCPDP comments ---------------------- "RTN","BPSNCPD3",86,0) ; "RTN","BPSNCPD3",87,0) ; ----------------- DUR1 ------------------------------------------ "RTN","BPSNCPD3",88,0) ; DUR1 is called by PSO to get the reject information "RTN","BPSNCPD3",89,0) ; "RTN","BPSNCPD3",90,0) ; "RTN","BPSNCPD3",91,0) ; IA 4560 supports OP's use of this procedure "RTN","BPSNCPD3",92,0) ; "RTN","BPSNCPD3",93,0) ; Function call for DUR INFORMATION "RTN","BPSNCPD3",94,0) ; Parameters: BRXIEN = Prescription IEN "RTN","BPSNCPD3",95,0) ; BFILL = fill number "RTN","BPSNCPD3",96,0) ; DUR = DUR info passed back "RTN","BPSNCPD3",97,0) ; ERROR = error passed back "RTN","BPSNCPD3",98,0) ; BPRXCOB = payer sequence "RTN","BPSNCPD3",99,0) ; Note: "RTN","BPSNCPD3",100,0) ; DUR("BILLED")=0 if ecme off for pharmacy or no transaction in ECME "RTN","BPSNCPD3",101,0) ; DUR(,"BILLED")=1 if billed through ecme "RTN","BPSNCPD3",102,0) DUR1(BRXIEN,BFILL,DUR,ERROR,BPRXCOB) ; "RTN","BPSNCPD3",103,0) N SITE,IEN59,DUR1,DURIEN "RTN","BPSNCPD3",104,0) I '$G(BRXIEN) S DUR("BILLED")=0 Q "RTN","BPSNCPD3",105,0) I $G(BFILL)="" S DUR("BILLED")=0 Q "RTN","BPSNCPD3",106,0) S BPRXCOB=+$G(BPRXCOB) "RTN","BPSNCPD3",107,0) I BPRXCOB=0 S BPRXCOB=1 ;default is Primary "RTN","BPSNCPD3",108,0) ; "RTN","BPSNCPD3",109,0) ; Get Site info and check is ECME is turned on "RTN","BPSNCPD3",110,0) ; If not, set DUR("BILLED")=0 and quit "RTN","BPSNCPD3",111,0) I '$G(BFILL) S SITE=$$RXAPI1^BPSUTIL1(BRXIEN,20,"I") "RTN","BPSNCPD3",112,0) I $G(BFILL) S SITE=$$RXSUBF1^BPSUTIL1(BRXIEN,52,52.1,BFILL,8,"I") "RTN","BPSNCPD3",113,0) I '$$ECMEON^BPSUTIL(SITE) S DUR("BILLED")=0 Q "RTN","BPSNCPD3",114,0) ; "RTN","BPSNCPD3",115,0) ; Set up the Transaction IEN "RTN","BPSNCPD3",116,0) S IEN59=$$IEN59^BPSOSRX(BRXIEN,BFILL,BPRXCOB) "RTN","BPSNCPD3",117,0) I IEN59="" S DUR("BILLED")=0 Q "RTN","BPSNCPD3",118,0) ; "RTN","BPSNCPD3",119,0) ; If the transaction record does not exist, set DUR("BILLED")=0 and quit "RTN","BPSNCPD3",120,0) I '$D(^BPST(IEN59)) S DUR("BILLED")=0 Q "RTN","BPSNCPD3",121,0) ; "RTN","BPSNCPD3",122,0) S DUR(BPRXCOB,"BILLED")=1 "RTN","BPSNCPD3",123,0) ; "RTN","BPSNCPD3",124,0) S DUR(BPRXCOB,"ELIGBLT")=$P($G(^BPST(IEN59,9)),U,4) "RTN","BPSNCPD3",125,0) ; Get Insurance Info and set into DUR array "RTN","BPSNCPD3",126,0) D GETS^DIQ(9002313.59902,"1,"_IEN59_",","902.05;902.06;902.24;902.25;902.26","E","DUR1","ERROR") "RTN","BPSNCPD3",127,0) S DUR(BPRXCOB,"INSURANCE NAME")=$G(DUR1(9002313.59902,"1,"_IEN59_",",902.24,"E")) ; Insurance Company Name "RTN","BPSNCPD3",128,0) S DUR(BPRXCOB,"GROUP NUMBER")=$G(DUR1(9002313.59902,"1,"_IEN59_",",902.05,"E")) ; Insurance Group Number "RTN","BPSNCPD3",129,0) S DUR(BPRXCOB,"GROUP NAME")=$G(DUR1(9002313.59902,"1,"_IEN59_",",902.25,"E")) ; Insurance Group Name "RTN","BPSNCPD3",130,0) S DUR(BPRXCOB,"PLAN CONTACT")=$G(DUR1(9002313.59902,"1,"_IEN59_",",902.26,"E")) ; Insurance Contact Number "RTN","BPSNCPD3",131,0) S DUR(BPRXCOB,"CARDHOLDER ID")=$G(DUR1(9002313.59902,"1,"_IEN59_",",902.06,"E")) ; Cardholder ID "RTN","BPSNCPD3",132,0) ; "RTN","BPSNCPD3",133,0) ; Get Response IEN and Data "RTN","BPSNCPD3",134,0) S DURIEN="",DURIEN=$P(^BPST(IEN59,0),"^",5) "RTN","BPSNCPD3",135,0) D DURRESP(DURIEN,.DUR,BPRXCOB) ; Note: In the future, we may need to get/store DURIEN for each COB "RTN","BPSNCPD3",136,0) Q "RTN","BPSNCPD3",137,0) ; "RTN","BPSNCPD3",138,0) DURRESP(DURIEN,DUR,BPRXCOB) ; "RTN","BPSNCPD3",139,0) I '$G(DURIEN) Q "RTN","BPSNCPD3",140,0) S BPRXCOB=+$G(BPRXCOB) "RTN","BPSNCPD3",141,0) I BPRXCOB=0 S BPRXCOB=1 ;default is Primary "RTN","BPSNCPD3",142,0) N ADDMESS,I,DUR1 "RTN","BPSNCPD3",143,0) S DUR(BPRXCOB,"RESPONSE IEN")=DURIEN "RTN","BPSNCPD3",144,0) ; "RTN","BPSNCPD3",145,0) ; Get the Transmission specific data (Message) "RTN","BPSNCPD3",146,0) S DUR(BPRXCOB,"MESSAGE")=$$GET1^DIQ(9002313.03,DURIEN_",",504,"E") "RTN","BPSNCPD3",147,0) ; "RTN","BPSNCPD3",148,0) ; Get the Additional Message Information from the transaction "RTN","BPSNCPD3",149,0) D ADDMESS^BPSSCRLG(DURIEN,1,.ADDMESS) "RTN","BPSNCPD3",150,0) M DUR(BPRXCOB,"PAYER MESSAGE")=ADDMESS "RTN","BPSNCPD3",151,0) ; "RTN","BPSNCPD3",152,0) ; Get the other transaction level data "RTN","BPSNCPD3",153,0) D GETS^DIQ(9002313.0301,"1,"_DURIEN_",","501;567.01*","E","DUR1","ERROR") "RTN","BPSNCPD3",154,0) S DUR(BPRXCOB,"STATUS")=$G(DUR1(9002313.0301,"1,"_DURIEN_",",501,"E")) ;Status of Response "RTN","BPSNCPD3",155,0) ; "RTN","BPSNCPD3",156,0) ; The following four fields are redundant with the fields in the DUR PPS "RTN","BPSNCPD3",157,0) ; multiple but are needed for backwards compatibility with the OP code "RTN","BPSNCPD3",158,0) S DUR(BPRXCOB,"REASON")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",439,"E")) ;Reason for Service Code "RTN","BPSNCPD3",159,0) S DUR(BPRXCOB,"PREV FILL DATE")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",530,"E")) ;Previous Date of Fill "RTN","BPSNCPD3",160,0) S DUR(BPRXCOB,"DUR FREE TEXT DESC")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",544,"E")) ;DUR Free Text Message from Payer "RTN","BPSNCPD3",161,0) S DUR(BPRXCOB,"DUR ADD MSG TEXT")=$G(DUR1(9002313.1101,"1,1,"_DURIEN_",",570,"E")) ;DUR Additional Message Text from Payer "RTN","BPSNCPD3",162,0) ; "RTN","BPSNCPD3",163,0) ; Get DUR PPS RESPONSE multiple values "RTN","BPSNCPD3",164,0) S DUR(BPRXCOB,"DUR PPS RESPONSE")="" "RTN","BPSNCPD3",165,0) F I=1:1 Q:'$D(DUR1(9002313.1101,I_",1,"_DURIEN_",",.01)) D "RTN","BPSNCPD3",166,0) . S DUR(BPRXCOB,"DUR PPS RESPONSE")=I "RTN","BPSNCPD3",167,0) . S DUR(BPRXCOB,"DUR PPS",I,"DUR PPS RESPONSE")=DUR1(9002313.1101,I_",1,"_DURIEN_",",.01,"E") "RTN","BPSNCPD3",168,0) . S DUR(BPRXCOB,"DUR PPS",I,"REASON FOR SERVICE CODE")=DUR1(9002313.1101,I_",1,"_DURIEN_",",439,"E") "RTN","BPSNCPD3",169,0) . S DUR(BPRXCOB,"DUR PPS",I,"CLINICAL SIGNIFICANCE CODE")=DUR1(9002313.1101,I_",1,"_DURIEN_",",528,"E") "RTN","BPSNCPD3",170,0) . S DUR(BPRXCOB,"DUR PPS",I,"OTHER PHARMACY INDICATOR")=DUR1(9002313.1101,I_",1,"_DURIEN_",",529,"E") "RTN","BPSNCPD3",171,0) . S DUR(BPRXCOB,"DUR PPS",I,"PREVIOUS DATE OF FILL")=DUR1(9002313.1101,I_",1,"_DURIEN_",",530,"E") "RTN","BPSNCPD3",172,0) . S DUR(BPRXCOB,"DUR PPS",I,"QUANTITY OF PREVIOUS FILL")=DUR1(9002313.1101,I_",1,"_DURIEN_",",531,"E") "RTN","BPSNCPD3",173,0) . S DUR(BPRXCOB,"DUR PPS",I,"DATABASE INDICATOR")=DUR1(9002313.1101,I_",1,"_DURIEN_",",532,"E") "RTN","BPSNCPD3",174,0) . S DUR(BPRXCOB,"DUR PPS",I,"OTHER PRESCRIBER INDICATOR")=DUR1(9002313.1101,I_",1,"_DURIEN_",",533,"E") "RTN","BPSNCPD3",175,0) . S DUR(BPRXCOB,"DUR PPS",I,"DUR FREE TEXT MESSAGE")=DUR1(9002313.1101,I_",1,"_DURIEN_",",544,"E") "RTN","BPSNCPD3",176,0) . S DUR(BPRXCOB,"DUR PPS",I,"DUR ADDITIONAL TEXT")=DUR1(9002313.1101,I_",1,"_DURIEN_",",570,"E") "RTN","BPSNCPD3",177,0) ; "RTN","BPSNCPD3",178,0) ; Get DUR reject codes and description and store in DUR "RTN","BPSNCPD3",179,0) D GETS^DIQ(9002313.0301,"1,"_DURIEN_",","511*","I","DUR1","ERROR") ;get DUR codes and descriptions "RTN","BPSNCPD3",180,0) S DUR(BPRXCOB,"REJ CODE LST")="" "RTN","BPSNCPD3",181,0) F I=1:1 Q:'$D(DUR1(9002313.03511,I_",1,"_DURIEN_",")) D "RTN","BPSNCPD3",182,0) . S DUR(BPRXCOB,"REJ CODES",I,DUR1(9002313.03511,I_",1,"_DURIEN_",",.01,"I"))=$$GET1^DIQ(9002313.93,DUR1(9002313.03511,I_",1,"_DURIEN_",",.01,"I"),".02") "RTN","BPSNCPD3",183,0) . S DUR(BPRXCOB,"REJ CODE LST")=DUR(BPRXCOB,"REJ CODE LST")_","_DUR1(9002313.03511,I_",1,"_DURIEN_",",.01,"I") "RTN","BPSNCPD3",184,0) S DUR(BPRXCOB,"REJ CODE LST")=$E(DUR(BPRXCOB,"REJ CODE LST"),2,9999) "RTN","BPSNCPD3",185,0) Q "RTN","BPSNCPD3",186,0) ; "RTN","BPSNCPD4") 0^44^B45568614 "RTN","BPSNCPD4",1,0) BPSNCPD4 ;OAK/ELZ - Extension of BPSNCPDP ;4/16/08 17:07 "RTN","BPSNCPD4",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**6,7,8,10**;JUN 2004;Build 27 "RTN","BPSNCPD4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD4",4,0) ; "RTN","BPSNCPD4",5,0) ; "RTN","BPSNCPD4",6,0) ; Certification Testing "RTN","BPSNCPD4",7,0) CERTTEST(CERTIEN) ; "RTN","BPSNCPD4",8,0) N DIC,Y,X,DTOUT,DUOUT "RTN","BPSNCPD4",9,0) S CERTIEN="" "RTN","BPSNCPD4",10,0) ; "RTN","BPSNCPD4",11,0) ; If the current user is not the Certification User, quit "RTN","BPSNCPD4",12,0) I $G(^BPS(9002313.99,1,"CERTIFIER"))'=DUZ Q 0 "RTN","BPSNCPD4",13,0) ; "RTN","BPSNCPD4",14,0) ; Ask for the Certification record "RTN","BPSNCPD4",15,0) W ! "RTN","BPSNCPD4",16,0) S DIC=9002313.31,DIC(0)="AEQ" "RTN","BPSNCPD4",17,0) D ^DIC "RTN","BPSNCPD4",18,0) I $G(DUOUT) Q "1^User terminated input at the certification question" "RTN","BPSNCPD4",19,0) I Y'=-1 S CERTIEN=+Y ; If user entered a response, set in CERTIEN variable "RTN","BPSNCPD4",20,0) Q 0 "RTN","BPSNCPD4",21,0) ; "RTN","BPSNCPD4",22,0) ;== reversal+resubmit for payables "RTN","BPSNCPD4",23,0) ;returns: "RTN","BPSNCPD4",24,0) ; 0 - Submitted through ECME "RTN","BPSNCPD4",25,0) ; or "RTN","BPSNCPD4",26,0) ; RESPONSE code^CLAMSTAT^D(display message)^number of seconds to hang^additional info "RTN","BPSNCPD4",27,0) ; see EN^BPSNCPD4 for RESPONSE values "RTN","BPSNCPD4",28,0) REVRESUB(BPREVREQ,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPJOBFLG,IEN59,DFN,BPSTART,BPREQIEN,OLDRESP,BPSELIG,BPSRTYPE,BPSPLAN,BPSPRDAT) ; "RTN","BPSNCPD4",29,0) N BPSITE,BPECMOFF,BPSARRY,MOREDATA,IB,BPRETV,BPZRET,BPCLMST,BPONLREV,BPRETVAL,BPUSRMSG,CERTIEN,BPRESP,BPRETUNC "RTN","BPSNCPD4",30,0) I BPJOBFLG'="F",BPJOBFLG'="B" D LOG(IEN59,"Job Flag missing") Q "5^Job Flag missing" ;RESPONSE^CLMSTAT "RTN","BPSNCPD4",31,0) I BPJOBFLG="B" D LOG(IEN59,"Reversal+Resubmit cannot be done in background") Q "5^Reversal+Resubmit cannot be done in background" ;RESPONSE^CLMSTAT "RTN","BPSNCPD4",32,0) S BPCLMST="",BPONLREV=0,BPRESP="" "RTN","BPSNCPD4",33,0) ; "RTN","BPSNCPD4",34,0) S BPSITE=+$$GETSITE^BPSOSRX8(BRXIEN,BFILL) "RTN","BPSNCPD4",35,0) ; "RTN","BPSNCPD4",36,0) ;populate MOREDATA with basic data "RTN","BPSNCPD4",37,0) D BASICMOR^BPSOSRX8(BWHERE,BFILLDAT,BPSITE,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,.MOREDATA) "RTN","BPSNCPD4",38,0) I BPCOBIND=2 D MORE4SEC^BPSPRRX2(.MOREDATA,.BPSPRDAT) S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD4",39,0) ; "RTN","BPSNCPD4",40,0) ;Certification Testing "RTN","BPSNCPD4",41,0) ;sets: "RTN","BPSNCPD4",42,0) ; BILLNDC which is used in STARRAY^BPSNCPD1 "RTN","BPSNCPD4",43,0) ; CERTIEN which is used in BILLABLE "RTN","BPSNCPD4",44,0) S BPRESP=$$CERTTEST(.CERTIEN) I +BPRESP=1 Q BPRESP "RTN","BPSNCPD4",45,0) ;populate BPSARRY "RTN","BPSNCPD4",46,0) ;Note: "RTN","BPSNCPD4",47,0) ;the following is passed as backdoor parameters "RTN","BPSNCPD4",48,0) ; DFN - patient's IEN "RTN","BPSNCPD4",49,0) ; BILLNDC - NDC "RTN","BPSNCPD4",50,0) ; BFILLDAT - fill date "RTN","BPSNCPD4",51,0) D STARRAY^BPSNCPD1(BRXIEN,BFILL,BWHERE,.BPSARRY,BPSITE) "RTN","BPSNCPD4",52,0) S BPSARRY("RXCOB")=BPCOBIND "RTN","BPSNCPD4",53,0) I BPCOBIND=2 S BPSARRY("PLAN")=$G(BPSPLAN),BPSARRY("RTYPE")=$G(BPSRTYPE) ;for secondary billing, to be used by RX^IBNCPDP "RTN","BPSNCPD4",54,0) ;Billing determination "RTN","BPSNCPD4",55,0) S IB=$$BILLABLE(DFN,BWHERE,.MOREDATA,.BPSARRY,CERTIEN,.BPSELIG) "RTN","BPSNCPD4",56,0) ;if no response from IB "RTN","BPSNCPD4",57,0) I +IB=0 Q $P(IB,U,2,5) "RTN","BPSNCPD4",58,0) ;if non-billable "RTN","BPSNCPD4",59,0) I +IB=2 S BPONLREV=1 ;set "ONLY REVERSAL IS POSSIBLE" flag "RTN","BPSNCPD4",60,0) ;Set the User message if necessary "RTN","BPSNCPD4",61,0) S BPUSRMSG=$S(BPONLREV=1:"Claim Will Be Reversed But Will Not Be Resubmitted",1:"") "RTN","BPSNCPD4",62,0) I BPONLREV=1 D LOG(IEN59,$P($G(MOREDATA("BILL")),"^",2)_" - "_BPUSRMSG) "RTN","BPSNCPD4",63,0) ;check IB data if it is billable "RTN","BPSNCPD4",64,0) I BPONLREV'=1 S BPRETV=$$IBDATAOK^BPSOSRX8(.MOREDATA,$G(BPSARRY("NO ECME INSURANCE"))) I BPRETV>0 Q BPRETV "RTN","BPSNCPD4",65,0) ; "RTN","BPSNCPD4",66,0) ;schedule request(s) "RTN","BPSNCPD4",67,0) ; "RTN","BPSNCPD4",68,0) ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPD4",69,0) I $$CHECK^BPSTEST D "RTN","BPSNCPD4",70,0) . I BPONLREV=1 D GETOVER^BPSTEST(BRXIEN,BFILL,OLDRESP,BWHERE,"R",BPCOBIND) Q "RTN","BPSNCPD4",71,0) . ;if it is billable and we will doing resubmit "RTN","BPSNCPD4",72,0) . D GETOVER^BPSTEST(BRXIEN,BFILL,OLDRESP,BWHERE,"S",BPCOBIND) "RTN","BPSNCPD4",73,0) ; "RTN","BPSNCPD4",74,0) ;.... Step 1, Schedule a Reversal "RTN","BPSNCPD4",75,0) ; Log message to ECME log "RTN","BPSNCPD4",76,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPD4",77,0) D LOG(IEN59,"Before Submit of Reversal") "RTN","BPSNCPD4",78,0) S BPSTART=$$STTM() "RTN","BPSNCPD4",79,0) ; "RTN","BPSNCPD4",80,0) ;schedule an UNCLAIM request "RTN","BPSNCPD4",81,0) S BPRETV=$$REQST^BPSOSRX("U",BRXIEN,BFILL,.MOREDATA,BPCOBIND,IEN59,$G(BILLNDC)) "RTN","BPSNCPD4",82,0) S BPREVREQ=+$P(BPRETV,U,2) ;BPS REQUEST ien of the reversal "RTN","BPSNCPD4",83,0) ;if error "RTN","BPSNCPD4",84,0) I +BPRETV=0 D Q $$RSPCLMS^BPSOSRX8("UC",4,.MOREDATA,$P(BPRETV,U,2)) "RTN","BPSNCPD4",85,0) . D LOG(IEN59,"Create request error: "_$P(BPRETV,U,2)_". Claim Will Not Be submitted.") "RTN","BPSNCPD4",86,0) . L -^BPST "RTN","BPSNCPD4",87,0) ;if ok "RTN","BPSNCPD4",88,0) D LOG(IEN59,"The request "_BPREVREQ_" has been created") "RTN","BPSNCPD4",89,0) ;if "Reversal only not resubmit" return appropriate RESPONSE and CLMSTAT, "RTN","BPSNCPD4",90,0) ;store MOREDATA("BILL" for the "final CLMSTAT" "RTN","BPSNCPD4",91,0) ;and quit "RTN","BPSNCPD4",92,0) I BPONLREV=1 D Q $$RSPCLMS^BPSOSRX8("UC",10,.MOREDATA)_U_$P($G(MOREDATA("BILL")),U,2) "RTN","BPSNCPD4",93,0) . ;activate the scheduled UNCLAIM request "RTN","BPSNCPD4",94,0) . S BPRETUNC=$$ACTIVATE(BPREVREQ,"U") "RTN","BPSNCPD4",95,0) ; "RTN","BPSNCPD4",96,0) ;.... Step 2, Schedule a Resubmit "RTN","BPSNCPD4",97,0) ; Log message to ECME log "RTN","BPSNCPD4",98,0) D LOG(IEN59,"Before submit of claim") "RTN","BPSNCPD4",99,0) S BPRETV=$$REQST^BPSOSRX("C",BRXIEN,BFILL,.MOREDATA,BPCOBIND,IEN59,$G(BILLNDC)) "RTN","BPSNCPD4",100,0) ; if error "RTN","BPSNCPD4",101,0) I +BPRETV=0 D Q $$RSPCLMS^BPSOSRX8("C",4,.MOREDATA)_U_BPUSRMSG "RTN","BPSNCPD4",102,0) . ;activate the scheduled UNCLAIM request "RTN","BPSNCPD4",103,0) . S BPRETUNC=$$ACTIVATE(BPREVREQ,"U") "RTN","BPSNCPD4",104,0) . D LOG(IEN59,"Create request error: "_$P(BPRETV,U,2)_". Claim Will Not Be submitted.") "RTN","BPSNCPD4",105,0) . ;Set the User message if necessary "RTN","BPSNCPD4",106,0) . I +BPRETUNC=0 S BPUSRMSG="Cannot schedule resubmit: Claim Will Be Reversed But Will Not Be Resubmitted " "RTN","BPSNCPD4",107,0) ;if ok "RTN","BPSNCPD4",108,0) D LOG(IEN59,"BPS REQUEST: "_+$P(BPRETV,U,2)_" has been created") "RTN","BPSNCPD4",109,0) ; "RTN","BPSNCPD4",110,0) I +$$NXTREQST^BPSOSRX6(BPREVREQ,+$P(BPRETV,U,2))=0 D Q $$RSPCLMS^BPSOSRX8("C",4,.MOREDATA)_U_BPUSRMSG "RTN","BPSNCPD4",111,0) . ;activate the scheduled UNCLAIM request "RTN","BPSNCPD4",112,0) . S BPRETUNC=$$ACTIVATE(BPREVREQ,"U") "RTN","BPSNCPD4",113,0) . D LOG(IEN59,"Cannot make "_+$P(BPRETV,U,2)_"as a NEXT REQUEST in "_BPREVREQ) "RTN","BPSNCPD4",114,0) . I +BPRETUNC=0 S BPUSRMSG="Cannot schedule resubmit: Claim Will Be Reversed But Will Not Be Resubmitted " "RTN","BPSNCPD4",115,0) ; "RTN","BPSNCPD4",116,0) ;activate the scheduled UNCLAIM request "RTN","BPSNCPD4",117,0) S BPRETUNC=$$ACTIVATE(BPREVREQ,"U") "RTN","BPSNCPD4",118,0) ; save RETVAL for the 2st step "RTN","BPSNCPD4",119,0) S BPRETVAL=$$RSPCLMS^BPSOSRX8("UC",+BPRETUNC,.MOREDATA)_U_$P(BPRETUNC,U,2) "RTN","BPSNCPD4",120,0) Q BPRETVAL_U_BPUSRMSG "RTN","BPSNCPD4",121,0) ; "RTN","BPSNCPD4",122,0) ; "RTN","BPSNCPD4",123,0) ; "RTN","BPSNCPD4",124,0) ;display submission results "RTN","BPSNCPD4",125,0) ;BPRETVAL - RESPONSE ^ CLAIMSTAT ^ flag:D-display on the screen ^ Hang time "RTN","BPSNCPD4",126,0) DISPL(WFLG,BPRETVAL,BPELIGIB) ; "RTN","BPSNCPD4",127,0) N BPHANG "RTN","BPSNCPD4",128,0) ;if Tricare then shall print messages to the screen "RTN","BPSNCPD4",129,0) I $G(BPELIGIB)="T" S WFLG=1 "RTN","BPSNCPD4",130,0) I WFLG=0 Q "RTN","BPSNCPD4",131,0) I $P(BPRETVAL,U,3)'="D" Q "RTN","BPSNCPD4",132,0) W !!,$P(BPRETVAL,U,2) "RTN","BPSNCPD4",133,0) W:+BPRETVAL'=0 ! "RTN","BPSNCPD4",134,0) S BPHANG=+$P(BPRETVAL,U,4) "RTN","BPSNCPD4",135,0) I BPHANG>0 H BPHANG "RTN","BPSNCPD4",136,0) Q "RTN","BPSNCPD4",137,0) ;IB (billing) determination "RTN","BPSNCPD4",138,0) ;input: "RTN","BPSNCPD4",139,0) ;DFN - PATIENT file #2 ien "RTN","BPSNCPD4",140,0) ;BWHERE - shows where the code is called from and what needs to be done "RTN","BPSNCPD4",141,0) ;the following should be passed by reference: "RTN","BPSNCPD4",142,0) ;MOREDATA - Initialized by BPSNCPDP and more data is added here "RTN","BPSNCPD4",143,0) ;BPSARRY - Created by STARRAY^BPSNCPD1 and used for IB Determination "RTN","BPSNCPD4",144,0) ;CERTIEN - BPS Certification IEN - Not passed but newed/set in BPSNCPDP, is used by EN^BPSNCPD2 as a backdoor parameter "RTN","BPSNCPD4",145,0) ;BPSELIG - to return eligibility, by ref "RTN","BPSNCPD4",146,0) ;output: "RTN","BPSNCPD4",147,0) ;if billable :1 "RTN","BPSNCPD4",148,0) ;no response : 0^RESPONSE code=2 or 6^CLMSTAT message^D(display message)^seconds to hang "RTN","BPSNCPD4",149,0) ;non billable : 2^RESPONSE code=2 or 6^CLMSTAT message "RTN","BPSNCPD4",150,0) BILLABLE(DFN,BWHERE,MOREDATA,BPSARRY,CERTIEN,BPSELIG) ; "RTN","BPSNCPD4",151,0) N IB S IB=0 "RTN","BPSNCPD4",152,0) D EN^BPSNCPD2(DFN,BWHERE,.MOREDATA,.BPSARRY,.IB) "RTN","BPSNCPD4",153,0) S BPSELIG=$G(MOREDATA("ELIG")) "RTN","BPSNCPD4",154,0) I IB=2 Q $S($G(BPSARRY("NO ECME INSURANCE")):"2^6^",1:"2^2^")_$P(MOREDATA("BILL"),"^",2) "RTN","BPSNCPD4",155,0) I (IB=0)!('$G(MOREDATA("BILL"))) Q $S($G(BPSARRY("NO ECME INSURANCE")):"0^6^",1:"0^2^")_"Flagged by IB to not 3rd Party Insurance bill through ECME.^D^2" "RTN","BPSNCPD4",156,0) Q 1 "RTN","BPSNCPD4",157,0) ;activate the request "RTN","BPSNCPD4",158,0) ;returns: "RTN","BPSNCPD4",159,0) ; 0 - Submitted through ECME "RTN","BPSNCPD4",160,0) ; or "RTN","BPSNCPD4",161,0) ; RESPONSE code^message^D(display message)^seconds to hang "RTN","BPSNCPD4",162,0) ; see EN^BPSNCPD4 for RESPONSE values "RTN","BPSNCPD4",163,0) ACTIVATE(BPIEN77,BPACTYP) ; "RTN","BPSNCPD4",164,0) I +$G(BPIEN77)=0 Q "4^There is no request to activate" "RTN","BPSNCPD4",165,0) S BPACTYP=$S($G(BPACTYP)="C":"CLAIM",$G(BPACTYP)="U":"UNCLAIM",$G(BPACTYP)="E":"ELIGIBILITY",1:"") "RTN","BPSNCPD4",166,0) ;if there is no existing requests for the RX/RF then simply activate the new request "RTN","BPSNCPD4",167,0) I +$$ACTIVATE^BPSOSRX4(BPIEN77)=0 D INACTIVE^BPSOSRX4(BPIEN77,"Could not activate the request") D Q "4^Cannot ACTIVATE the scheduled """_BPACTYP_""" request^D^2" "RTN","BPSNCPD4",168,0) . D LOG(IEN59,"BPS REQUEST: "_+BPIEN77_" Cannot ACTIVATE the scheduled """_BPACTYP_""" request, it has been inactivated") "RTN","BPSNCPD4",169,0) Q "0" "RTN","BPSNCPD4",170,0) ; "RTN","BPSNCPD4",171,0) ;======== end of API "RTN","BPSNCPD4",172,0) LOG(IEN59,MSG,BPDTFLG) ; "RTN","BPSNCPD4",173,0) D LOG^BPSOSL(IEN59,$T(+0)_"-"_MSG,$G(BPDTFLG)) "RTN","BPSNCPD4",174,0) Q "RTN","BPSNCPD4",175,0) STTM() ; "RTN","BPSNCPD4",176,0) Q $$NOW^XLFDT "RTN","BPSNCPD4",177,0) ; "RTN","BPSNCPD5") 0^50^B79985749 "RTN","BPSNCPD5",1,0) BPSNCPD5 ;ALB/SS - Pharmacy API part 5 ;10-JAN-08 "RTN","BPSNCPD5",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSNCPD5",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD5",4,0) ; "RTN","BPSNCPD5",5,0) ;schedule a reversal for the future "RTN","BPSNCPD5",6,0) ; BPNEWREQ -by ref to return new BPS REQUEST ien "RTN","BPSNCPD5",7,0) ; BRXIEN - #52 ien "RTN","BPSNCPD5",8,0) ; BFILL -refill no "RTN","BPSNCPD5",9,0) ; BFILLDAT - Date of service "RTN","BPSNCPD5",10,0) ; BWHERE - see "RTN","BPSNCPD5",11,0) ; BILLNDC "RTN","BPSNCPD5",12,0) ; REVREAS "RTN","BPSNCPD5",13,0) ; DURREC "RTN","BPSNCPD5",14,0) ; BPOVRIEN "RTN","BPSNCPD5",15,0) ; BPSCLARF "RTN","BPSNCPD5",16,0) ; BPSAUTH "RTN","BPSNCPD5",17,0) ; IEN59 "RTN","BPSNCPD5",18,0) ; BPCOBIND "RTN","BPSNCPD5",19,0) ; BPREVREQ - ien of the previous BPS REQUEST "RTN","BPSNCPD5",20,0) ; BPACTTYP - U - unclaim(reversal request), UC - reversal+resubmit, C - claim request "RTN","BPSNCPD5",21,0) ; BPSCLS - BPSCLOSE parameter of EN^BPSNCPDP "RTN","BPSNCPD5",22,0) ;returns: "RTN","BPSNCPD5",23,0) ; RESPONSE code^CLAMSTAT message^D(display message)^number of seconds to hang^IEN of the new request "RTN","BPSNCPD5",24,0) ; RESPONSE code = 0 - Submitted through ECME "RTN","BPSNCPD5",25,0) ; see EN^BPSNCPD4 for other RESPONSE values; "RTN","BPSNCPD5",26,0) SCHREQ(BPNEWREQ,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BPREVREQ,BPACTTYP,BPSCLS,BPSRTYPE,BPSPLAN,BPSPRDAT) ; "RTN","BPSNCPD5",27,0) N RESP,RESPONSE,MOREDATA,BPRETV "RTN","BPSNCPD5",28,0) N BPUSRMSG "RTN","BPSNCPD5",29,0) ;populate MOREDATA with basic data "RTN","BPSNCPD5",30,0) D BASICMOR^BPSOSRX8(BWHERE,BFILLDAT,"",REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,.MOREDATA) "RTN","BPSNCPD5",31,0) I BPCOBIND=2 D MORE4SEC^BPSPRRX2(.MOREDATA,.BPSPRDAT) S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD5",32,0) ; if the user has chosen to close the claim after reversal "RTN","BPSNCPD5",33,0) ; BPSCLS contains the value of the BPSCLOSE parameter of EN^BPSNCPDP "RTN","BPSNCPD5",34,0) I $G(BPSCLS("CLOSE AFT REV"))=1 M MOREDATA=BPSCLS "RTN","BPSNCPD5",35,0) ; "RTN","BPSNCPD5",36,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPD5",37,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Before Submit of Reversal") "RTN","BPSNCPD5",38,0) S BPSTART=$$STTM^BPSNCPD4() "RTN","BPSNCPD5",39,0) ;schedule a request "RTN","BPSNCPD5",40,0) S BPRETV=$$REQST^BPSOSRX(BPACTTYP,BRXIEN,BFILL,.MOREDATA,BPCOBIND,IEN59,$G(BILLNDC),1) "RTN","BPSNCPD5",41,0) S BPNEWREQ=+$P(BPRETV,U,2) "RTN","BPSNCPD5",42,0) ;if error "RTN","BPSNCPD5",43,0) I +BPRETV=0 D Q $$RSPCLMS^BPSOSRX8(BPACTTYP,4,.MOREDATA) "RTN","BPSNCPD5",44,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-Create request error: "_$P(BPRETV,U,2)_". Claim Will Not Be submitted.") "RTN","BPSNCPD5",45,0) . L -^BPST "RTN","BPSNCPD5",46,0) ;if ok "RTN","BPSNCPD5",47,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-BPS REQUEST: "_BPNEWREQ_" has been created") "RTN","BPSNCPD5",48,0) ;determine the last request "RTN","BPSNCPD5",49,0) I +$$NXTREQST^BPSOSRX6(BPREVREQ,BPNEWREQ)=0 D Q $$RSPCLMS^BPSOSRX8("C",4,.MOREDATA) "RTN","BPSNCPD5",50,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-Cannot make "_BPNEWREQ_"as a NEXT REQUEST in "_BPREVREQ) "RTN","BPSNCPD5",51,0) Q $$RSPCLMS^BPSOSRX8(BPACTTYP,0,.MOREDATA)_U_BPNEWREQ "RTN","BPSNCPD5",52,0) ; "RTN","BPSNCPD5",53,0) ;====== Schedule a reversal "RTN","BPSNCPD5",54,0) ;BPSCLS - BPSCLOSE parameter of EN^BPSNCPDP "RTN","BPSNCPD5",55,0) REVERSAL(BPNEWREQ,BRXIEN,BFILL,OLDRESP,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BPJOBFLG,BPACTTYP,BPSTART,BPREQIEN,BPSCLS,BPSRTYPE,BPSPRDAT) ; "RTN","BPSNCPD5",56,0) N RESP,RESPONSE,MOREDATA,BPRETV "RTN","BPSNCPD5",57,0) ;populate MOREDATA with basic data "RTN","BPSNCPD5",58,0) D BASICMOR^BPSOSRX8(BWHERE,BFILLDAT,"",REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,.MOREDATA) "RTN","BPSNCPD5",59,0) I BPCOBIND=2 D MORE4SEC^BPSPRRX2(.MOREDATA,.BPSPRDAT) S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD5",60,0) ; if the user has chosen to close the claim after reversal "RTN","BPSNCPD5",61,0) ; BPSCLS contains the value of the BPSCLOSE parameter of EN^BPSNCPDP "RTN","BPSNCPD5",62,0) I $G(BPSCLS("CLOSE AFT REV"))=1 M MOREDATA=BPSCLS "RTN","BPSNCPD5",63,0) ; "RTN","BPSNCPD5",64,0) ; Do a reversal for the appropriate actions "RTN","BPSNCPD5",65,0) ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPD5",66,0) ; "RTN","BPSNCPD5",67,0) I $$CHECK^BPSTEST D GETOVER^BPSTEST(BRXIEN,BFILL,OLDRESP,BWHERE,"R",BPCOBIND) "RTN","BPSNCPD5",68,0) ; "RTN","BPSNCPD5",69,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPD5",70,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Before Submit of Reversal") "RTN","BPSNCPD5",71,0) S BPSTART=$$STTM^BPSNCPD4() "RTN","BPSNCPD5",72,0) ;if background job "RTN","BPSNCPD5",73,0) I BPJOBFLG="B" S BPRETV=$$ACTIVATE^BPSNCPD4(BPREQIEN,"U") Q $$RSPCLMS^BPSOSRX8(BPACTTYP,+BPRETV,.MOREDATA)_U_$P(BPRETV,U,2) "RTN","BPSNCPD5",74,0) ;if foreground job then schedule an UNCLAIM request "RTN","BPSNCPD5",75,0) S BPRETV=$$REQST^BPSOSRX("U",BRXIEN,BFILL,.MOREDATA,BPCOBIND,IEN59,$G(BILLNDC)) "RTN","BPSNCPD5",76,0) S BPNEWREQ=+$P(BPRETV,U,2) "RTN","BPSNCPD5",77,0) ;if error "RTN","BPSNCPD5",78,0) I +BPRETV=0 D Q $$RSPCLMS^BPSOSRX8(BPACTTYP,4,.MOREDATA) "RTN","BPSNCPD5",79,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-Create request error: "_$P(BPRETV,U,2)_". Claim Will Not Be submitted.") "RTN","BPSNCPD5",80,0) . L -^BPST "RTN","BPSNCPD5",81,0) ;if ok "RTN","BPSNCPD5",82,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-BPS REQUEST: "_BPNEWREQ_" has been created") "RTN","BPSNCPD5",83,0) ;activate the scheduled request "RTN","BPSNCPD5",84,0) S BPRETV=$$ACTIVATE^BPSNCPD4(BPNEWREQ,"U") "RTN","BPSNCPD5",85,0) Q $$RSPCLMS^BPSOSRX8(BPACTTYP,+BPRETV,.MOREDATA)_U_BPNEWREQ "RTN","BPSNCPD5",86,0) ; "RTN","BPSNCPD5",87,0) ;====== Process a brand new RX/RF, which never was processed by ECME yet "RTN","BPSNCPD5",88,0) ;returns: "RTN","BPSNCPD5",89,0) ; 0 - Submitted through ECME "RTN","BPSNCPD5",90,0) ; or "RTN","BPSNCPD5",91,0) ; RESPONSE code^CLAMSTAT^D(display message)^number of seconds to hang^additional info "RTN","BPSNCPD5",92,0) ; see EN^BPSNCPD1 for RESPONSE values "RTN","BPSNCPD5",93,0) NEWCLM(BPNEWREQ,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPJOBFLG,IEN59,BPACTTYP,DFN,BPSTART,BPREQIEN,BPSELIG,BPSRTYPE,BPSPLAN,BPSPRDAT) ; "RTN","BPSNCPD5",94,0) N BPSITE,BPECMOFF,BPSARRY,MOREDATA,IB,BPRETV,BPZRET,BPCLMST,CERTIEN,BPRESP "RTN","BPSNCPD5",95,0) I BPJOBFLG'="F",BPJOBFLG'="B" D LOG^BPSNCPD6(IEN59,$T(+0)_"-Job Flag missing") Q "5^Job Flag missing" ;RESPONSE^CLMSTAT "RTN","BPSNCPD5",96,0) S BPCLMST="" "RTN","BPSNCPD5",97,0) I BPACTTYP'="C" Q "1^Prescription not previously billed through ECME. Cannot Reverse claim.^D^2" "RTN","BPSNCPD5",98,0) S BPSITE=+$$GETSITE^BPSOSRX8(BRXIEN,BFILL) "RTN","BPSNCPD5",99,0) ;check ECME availability "RTN","BPSNCPD5",100,0) S BPECMOFF=$$ECMESITE^BPSOSRX5(BPSITE) I +BPECMOFF=1 Q BPECMOFF "RTN","BPSNCPD5",101,0) ;populate MOREDATA with basic data "RTN","BPSNCPD5",102,0) D BASICMOR^BPSOSRX8(BWHERE,BFILLDAT,BPSITE,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,.MOREDATA) "RTN","BPSNCPD5",103,0) I BPCOBIND=2 D MORE4SEC^BPSPRRX2(.MOREDATA,.BPSPRDAT) S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD5",104,0) I $G(BPSRTYPE)'="" S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD5",105,0) ;Certification Testing "RTN","BPSNCPD5",106,0) ;sets: "RTN","BPSNCPD5",107,0) ; BILLNDC which is used in STARRAY^BPSNCPD1 "RTN","BPSNCPD5",108,0) ; CERTIEN which is used in BILLABLE "RTN","BPSNCPD5",109,0) S BPRESP=$$CERTTEST^BPSNCPD4(.CERTIEN) I +BPRESP=1 Q BPRESP "RTN","BPSNCPD5",110,0) ;populate BPSARRY "RTN","BPSNCPD5",111,0) ;Note: "RTN","BPSNCPD5",112,0) ;the following is passed as backdoor parameters "RTN","BPSNCPD5",113,0) ; DFN - patient's IEN "RTN","BPSNCPD5",114,0) ; BILLNDC - NDC "RTN","BPSNCPD5",115,0) ; BFILLDAT - fill date "RTN","BPSNCPD5",116,0) D STARRAY^BPSNCPD1(BRXIEN,BFILL,BWHERE,.BPSARRY,BPSITE) "RTN","BPSNCPD5",117,0) S BPSARRY("RXCOB")=BPCOBIND "RTN","BPSNCPD5",118,0) S BPSARRY("PLAN")=$G(BPSPLAN),BPSARRY("RTYPE")=$G(BPSRTYPE) ;for secondary and Tricare/dual eligibility billing, to be used by RX^IBNCPDP "RTN","BPSNCPD5",119,0) ;Billing determination "RTN","BPSNCPD5",120,0) S IB=$$BILLABLE^BPSNCPD4(DFN,BWHERE,.MOREDATA,.BPSARRY,CERTIEN,.BPSELIG) "RTN","BPSNCPD5",121,0) ;if non-billable or no response from IB "RTN","BPSNCPD5",122,0) I +IB'=1 Q $P(IB,U,2,5)_"^D^" "RTN","BPSNCPD5",123,0) ;check IB data "RTN","BPSNCPD5",124,0) S BPRETV=$$IBDATAOK^BPSOSRX8(.MOREDATA,$G(BPSARRY("NO ECME INSURANCE"))) I BPRETV>0 Q BPRETV "RTN","BPSNCPD5",125,0) ; Log message to ECME log "RTN","BPSNCPD5",126,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPD5",127,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Before submit of claim") "RTN","BPSNCPD5",128,0) S BPSTART=$$STTM^BPSNCPD4() "RTN","BPSNCPD5",129,0) ;if background job "RTN","BPSNCPD5",130,0) I BPJOBFLG="B",+$G(BPREQIEN)=0 D Q "5^BPS REQUEST IEN missing" ;should never happen "RTN","BPSNCPD5",131,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-BPS REQUEST IEN missing for background job. Claim cannot be processed.") "RTN","BPSNCPD5",132,0) I BPJOBFLG="B" D Q $$RSPCLMS^BPSOSRX8(BPACTTYP,+BPRETV,.MOREDATA)_U_BPREQIEN "RTN","BPSNCPD5",133,0) . ;Update IB data "RTN","BPSNCPD5",134,0) . D UPDINSDT^BPSOSRX7(BPREQIEN,.MOREDATA,IEN59) ; "RTN","BPSNCPD5",135,0) . S BPRETV=$$ACTIVATE^BPSNCPD4(BPREQIEN,"C") "RTN","BPSNCPD5",136,0) ;if foreground job then schedule a CLAIM request "RTN","BPSNCPD5",137,0) ; "RTN","BPSNCPD5",138,0) ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPD5",139,0) I $$CHECK^BPSTEST D GETOVER^BPSTEST(BRXIEN,BFILL,"",BWHERE,"S",BPCOBIND) "RTN","BPSNCPD5",140,0) ; "RTN","BPSNCPD5",141,0) S BPRETV=$$REQST^BPSOSRX("C",BRXIEN,BFILL,.MOREDATA,BPCOBIND,IEN59,$G(BILLNDC)) "RTN","BPSNCPD5",142,0) S BPNEWREQ=+$P(BPRETV,U,2) "RTN","BPSNCPD5",143,0) ;if error "RTN","BPSNCPD5",144,0) I +BPRETV=0 D Q $$RSPCLMS^BPSOSRX8(BPACTTYP,4,.MOREDATA,$P(BPRETV,U,2)) "RTN","BPSNCPD5",145,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-Create request error: "_$P(BPRETV,U,2)_". Claim Will Not Be submitted.") "RTN","BPSNCPD5",146,0) ;if ok "RTN","BPSNCPD5",147,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-BPS REQUEST: "_BPNEWREQ_" has been created") "RTN","BPSNCPD5",148,0) ;activate the scheduled request "RTN","BPSNCPD5",149,0) S BPRETV=$$ACTIVATE^BPSNCPD4(BPNEWREQ,"C") "RTN","BPSNCPD5",150,0) Q $$RSPCLMS^BPSOSRX8(BPACTTYP,+BPRETV,.MOREDATA)_U_BPNEWREQ "RTN","BPSNCPD5",151,0) ; "RTN","BPSNCPD5",152,0) ;Process RX/RF resubmit OR reversal+resubmit for non-payables "RTN","BPSNCPD5",153,0) ;returns: "RTN","BPSNCPD5",154,0) ; 0 - Submitted through ECME "RTN","BPSNCPD5",155,0) ; or "RTN","BPSNCPD5",156,0) ; RESPONSE code^CLAMSTAT^D(display message)^number of seconds to hang^additional info "RTN","BPSNCPD5",157,0) ; see EN^BPSNCPDP for RESPONSE values "RTN","BPSNCPD5",158,0) REVRESNP(BPNEWREQ,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPJOBFLG,IEN59,BPACTTYP,DFN,BPSTART,BPREQIEN,OLDRESP,BPSELIG,BPSRTYPE,BPSPLAN,BPSPRDAT) ; "RTN","BPSNCPD5",159,0) N BPSITE,BPECMOFF,BPSARRY,MOREDATA,IB,BPRETV,BPZRET,BPCLMST,CERTIEN,BPRESP "RTN","BPSNCPD5",160,0) I BPJOBFLG'="F",BPJOBFLG'="B" D LOG^BPSNCPD6(IEN59,$T(+0)_"-Job Flag missing") Q "5^Job Flag missing" ;RESPONSE^CLMSTAT "RTN","BPSNCPD5",161,0) S BPCLMST="" "RTN","BPSNCPD5",162,0) I BPACTTYP="U" Q "1^Prescription is not payable. Cannot Reverse claim.^D^2" "RTN","BPSNCPD5",163,0) S BPSITE=+$$GETSITE^BPSOSRX8(BRXIEN,BFILL) "RTN","BPSNCPD5",164,0) ;check ECME availability "RTN","BPSNCPD5",165,0) S BPECMOFF=$$ECMESITE^BPSOSRX5(BPSITE) I +BPECMOFF=1 Q BPECMOFF "RTN","BPSNCPD5",166,0) ; "RTN","BPSNCPD5",167,0) ;populate MOREDATA with basic data "RTN","BPSNCPD5",168,0) D BASICMOR^BPSOSRX8(BWHERE,BFILLDAT,BPSITE,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,.MOREDATA) "RTN","BPSNCPD5",169,0) I BPCOBIND=2 D MORE4SEC^BPSPRRX2(.MOREDATA,.BPSPRDAT) S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD5",170,0) I $G(BPSRTYPE)'="" S MOREDATA("RTYPE")=$G(BPSRTYPE) "RTN","BPSNCPD5",171,0) ;Certification Testing "RTN","BPSNCPD5",172,0) ;sets: "RTN","BPSNCPD5",173,0) ; BILLNDC which is used in STARRAY^BPSNCPD1 "RTN","BPSNCPD5",174,0) ; CERTIEN which is used in BILLABLE "RTN","BPSNCPD5",175,0) S BPRESP=$$CERTTEST^BPSNCPD4(.CERTIEN) I +BPRESP=1 Q BPRESP "RTN","BPSNCPD5",176,0) ;populate BPSARRY "RTN","BPSNCPD5",177,0) ;Note: "RTN","BPSNCPD5",178,0) ;the following is passed as backdoor parameters "RTN","BPSNCPD5",179,0) ; DFN - patient's IEN "RTN","BPSNCPD5",180,0) ; BILLNDC - NDC "RTN","BPSNCPD5",181,0) ; BFILLDAT - fill date "RTN","BPSNCPD5",182,0) D STARRAY^BPSNCPD1(BRXIEN,BFILL,BWHERE,.BPSARRY,BPSITE) "RTN","BPSNCPD5",183,0) S BPSARRY("RXCOB")=BPCOBIND "RTN","BPSNCPD5",184,0) S BPSARRY("PLAN")=$G(BPSPLAN),BPSARRY("RTYPE")=$G(BPSRTYPE) ;for secondary and Tricare/dual eligibility billing, to be used by RX^IBNCPDP "RTN","BPSNCPD5",185,0) ;set BPSARRY("SC/EI OVR") flag for scheduled requests "RTN","BPSNCPD5",186,0) I $G(BPJOBFLG)="B",$G(BPREQIEN) S BPSARRY("SC/EI OVR")=$P($G(^BPS(9002313.77,+$G(BPREQIEN),2)),U,9) "RTN","BPSNCPD5",187,0) ;Billing determination "RTN","BPSNCPD5",188,0) S IB=$$BILLABLE^BPSNCPD4(DFN,BWHERE,.MOREDATA,.BPSARRY,CERTIEN,.BPSELIG) "RTN","BPSNCPD5",189,0) ;if non-billable or no response from IB "RTN","BPSNCPD5",190,0) I +IB'=1 Q $P(IB,U,2,5)_"^D^" "RTN","BPSNCPD5",191,0) ;check IB data "RTN","BPSNCPD5",192,0) S BPRETV=$$IBDATAOK^BPSOSRX8(.MOREDATA,$G(BPSARRY("NO ECME INSURANCE"))) I BPRETV>0 Q BPRETV "RTN","BPSNCPD5",193,0) ; Log message to ECME log "RTN","BPSNCPD5",194,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSNCPD5",195,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Before submit of claim") "RTN","BPSNCPD5",196,0) S BPSTART=$$STTM^BPSNCPD4() "RTN","BPSNCPD5",197,0) ;if background job "RTN","BPSNCPD5",198,0) I BPJOBFLG="B" D Q $$RSPCLMS^BPSOSRX8(BPACTTYP,+BPRETV,.MOREDATA)_U_$P(BPRETV,U,2) "RTN","BPSNCPD5",199,0) . ;Update IB data "RTN","BPSNCPD5",200,0) . D UPDINSDT^BPSOSRX7(BPREQIEN,.MOREDATA,IEN59) ; "RTN","BPSNCPD5",201,0) . S BPRETV=$$ACTIVATE^BPSNCPD4(BPREQIEN,"C") "RTN","BPSNCPD5",202,0) ;if foreground job then schedule a CLAIM request "RTN","BPSNCPD5",203,0) ; "RTN","BPSNCPD5",204,0) ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPD5",205,0) I $$CHECK^BPSTEST D GETOVER^BPSTEST(BRXIEN,BFILL,OLDRESP,BWHERE,"S",BPCOBIND) "RTN","BPSNCPD5",206,0) ; "RTN","BPSNCPD5",207,0) S BPRETV=$$REQST^BPSOSRX("C",BRXIEN,BFILL,.MOREDATA,BPCOBIND,IEN59,$G(BILLNDC)) "RTN","BPSNCPD5",208,0) S BPNEWREQ=+$P(BPRETV,U,2) "RTN","BPSNCPD5",209,0) ;if error "RTN","BPSNCPD5",210,0) I +BPRETV=0 D Q $$RSPCLMS^BPSOSRX8(BPACTTYP,4,.MOREDATA,$P(BPRETV,U,2)) "RTN","BPSNCPD5",211,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-Create request error: "_$P(BPRETV,U,2)_". Claim Will Not Be submitted.") "RTN","BPSNCPD5",212,0) ;if ok "RTN","BPSNCPD5",213,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-BPS REQUEST: "_BPNEWREQ_" has been created") "RTN","BPSNCPD5",214,0) ;activate the scheduled request "RTN","BPSNCPD5",215,0) S BPRETV=$$ACTIVATE^BPSNCPD4(BPNEWREQ,"C") "RTN","BPSNCPD5",216,0) Q $$RSPCLMS^BPSOSRX8(BPACTTYP,+BPRETV,.MOREDATA)_U_BPNEWREQ "RTN","BPSNCPD5",217,0) ; "RTN","BPSNCPD6") 0^78^B28619607 "RTN","BPSNCPD6",1,0) BPSNCPD6 ;ALB/SS - Pharmacy API part 6 ;10-JAN-08 "RTN","BPSNCPD6",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSNCPD6",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD6",4,0) ; "RTN","BPSNCPD6",5,0) ;All of the entry points in this routine except LOOK77 and LOG were "RTN","BPSNCPD6",6,0) ; created from code that was copied from BPSNCPDP because BPSNCPDP "RTN","BPSNCPD6",7,0) ; was too big. The variables are newed in BPSNCPDP and returned back "RTN","BPSNCPD6",8,0) ; to BPSNCPDP "RTN","BPSNCPD6",9,0) ;== New Claim "RTN","BPSNCPD6",10,0) NEWCLAIM ; "RTN","BPSNCPD6",11,0) S BPRETV=$$NEWCLM^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPJOBFLG,IEN59,BPACTTYP,DFN,.BPSTART,$G(BPREQIEN),.BPSELIG,$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPD6",12,0) S RESPONSE=+BPRETV "RTN","BPSNCPD6",13,0) ;to make LOG backward compatible "RTN","BPSNCPD6",14,0) D LOG(IEN59,$T(+0)_"-After Submit of Claim. Return Value: "_$S(RESPONSE=0:1,1:0)) "RTN","BPSNCPD6",15,0) S CLMSTAT=$P(BPRETV,U,2) "RTN","BPSNCPD6",16,0) D DISPL^BPSNCPD4(WFLG,BPRETV,$G(BPSELIG)) "RTN","BPSNCPD6",17,0) I RESPONSE=0 Q "RTN","BPSNCPD6",18,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",19,0) Q "RTN","BPSNCPD6",20,0) ; "RTN","BPSNCPD6",21,0) ;== Reversals for Payable claims "RTN","BPSNCPD6",22,0) ;(Note: BPSCLOSE parameter of EN^BPSNCPDP can be used in this case) "RTN","BPSNCPD6",23,0) RVPAID ; "RTN","BPSNCPD6",24,0) S BPRETV=$$REVERSAL^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,OLDRESP,BFILLDAT,BWHERE,$G(BILLNDC),REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BPJOBFLG,BPACTTYP,.BPSTART,$G(BPREQIEN),.BPSCLOSE,$G(BPSRTYPE),.BPSPRDAT) "RTN","BPSNCPD6",25,0) S RESPONSE=+BPRETV "RTN","BPSNCPD6",26,0) ;to make LOG backward compatible "RTN","BPSNCPD6",27,0) D LOG(IEN59,$T(+0)_"-After Submit of Reversal. Return Value: "_$S(RESPONSE=0:1,1:0)) "RTN","BPSNCPD6",28,0) S CLMSTAT=$P(BPRETV,U,2) "RTN","BPSNCPD6",29,0) I BWHERE'="EREV" D DISPL^BPSNCPD4(WFLG,BPRETV,$G(BPSELIG)) "RTN","BPSNCPD6",30,0) I RESPONSE=0 Q "RTN","BPSNCPD6",31,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",32,0) Q "RTN","BPSNCPD6",33,0) ; "RTN","BPSNCPD6",34,0) ;== Reversals+Resubmits for Payable claims "RTN","BPSNCPD6",35,0) RVRSPAID ; "RTN","BPSNCPD6",36,0) S BPRETV=$$REVRESUB^BPSNCPD4(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPJOBFLG,IEN59,DFN,.BPSTART,$G(BPREQIEN),OLDRESP,.BPSELIG,$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPD6",37,0) S RESPONSE=+BPRETV "RTN","BPSNCPD6",38,0) ;if "Reversal only not resubmit" - display a message for the user "RTN","BPSNCPD6",39,0) I RESPONSE=10 D DISPL^BPSNCPD4(WFLG,"10^Claim Will Be Reversed But Will Not Be Resubmitted^D^2",$G(BPSELIG)) "RTN","BPSNCPD6",40,0) ;to make LOG backward compatible "RTN","BPSNCPD6",41,0) D LOG(IEN59,$T(+0)_"-After Submit of Reversal. Return Value: "_$S(RESPONSE=0:1,1:0)) "RTN","BPSNCPD6",42,0) D DISPL^BPSNCPD4(WFLG,BPRETV,$G(BPSELIG)) "RTN","BPSNCPD6",43,0) I RESPONSE=10 S CLMSTAT=$P(BPRETV,U,5) Q "RTN","BPSNCPD6",44,0) S CLMSTAT=$P(BPRETV,U,2) "RTN","BPSNCPD6",45,0) I RESPONSE=0 Q "RTN","BPSNCPD6",46,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",47,0) Q "RTN","BPSNCPD6",48,0) ; "RTN","BPSNCPD6",49,0) ;== Resubmits for Payable claims - DO NOT resubmit "RTN","BPSNCPD6",50,0) RSPAID ; "RTN","BPSNCPD6",51,0) S RESPONSE=1 "RTN","BPSNCPD6",52,0) ; Message varies depending the the previous response "RTN","BPSNCPD6",53,0) ; Reversal Accepted would not get here so this must be rejected, stranded, or other "RTN","BPSNCPD6",54,0) I OLDRESP["REVERSAL" S CLMSTAT="Can not resubmit a rejected or stranded reversal" "RTN","BPSNCPD6",55,0) E S CLMSTAT="Previously billed through ECME: "_OLDRESP "RTN","BPSNCPD6",56,0) D DISPL^BPSNCPD4(WFLG,RESPONSE_U_CLMSTAT_"^D^2",$G(BPSELIG)) "RTN","BPSNCPD6",57,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",58,0) Q "RTN","BPSNCPD6",59,0) ;== Reversals for Non-Payable claims - DO NOT reverse "RTN","BPSNCPD6",60,0) RVNPAID ; "RTN","BPSNCPD6",61,0) ;if this is return to stock OR delete - close the claim "RTN","BPSNCPD6",62,0) I ",RS,DE,"[(","_BWHERE_",") D Q "RTN","BPSNCPD6",63,0) . D CLOSE2^BPSBUTL(BRXIEN,BFILL,BWHERE) "RTN","BPSNCPD6",64,0) . S RESPONSE=3 "RTN","BPSNCPD6",65,0) . S CLMSTAT="Claim was not payable so it has been closed. No ECME claim created." "RTN","BPSNCPD6",66,0) . D DISPL^BPSNCPD4(WFLG,RESPONSE_U_CLMSTAT_"^D^2",$G(BPSELIG)) "RTN","BPSNCPD6",67,0) . D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",68,0) S RESPONSE=1 "RTN","BPSNCPD6",69,0) S CLMSTAT="Claim has status "_OLDRESP_". Not reversed." "RTN","BPSNCPD6",70,0) D DISPL^BPSNCPD4(WFLG,RESPONSE_U_CLMSTAT_"^D^2",$G(BPSELIG)) "RTN","BPSNCPD6",71,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",72,0) Q "RTN","BPSNCPD6",73,0) ;== Resubmits AND Reversals+Resubmits for Non-Payable claims "RTN","BPSNCPD6",74,0) RVRSNPD ; "RTN","BPSNCPD6",75,0) ; resubmit a claim "RTN","BPSNCPD6",76,0) S BPRETV=$$REVRESNP^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPJOBFLG,IEN59,BPACTTYP,DFN,.BPSTART,$G(BPREQIEN),OLDRESP,.BPSELIG,$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPD6",77,0) S RESPONSE=+BPRETV "RTN","BPSNCPD6",78,0) ;to make LOG backward compatible "RTN","BPSNCPD6",79,0) D LOG(IEN59,$T(+0)_"-After Submit of Reversal. Return Value: "_$S(RESPONSE=0:1,1:0)) "RTN","BPSNCPD6",80,0) S CLMSTAT=$P(BPRETV,U,2) "RTN","BPSNCPD6",81,0) D DISPL^BPSNCPD4(WFLG,BPRETV,$G(BPSELIG)) "RTN","BPSNCPD6",82,0) I RESPONSE=0 Q "RTN","BPSNCPD6",83,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",84,0) Q "RTN","BPSNCPD6",85,0) ; "RTN","BPSNCPD6",86,0) ; if Back Billing "RTN","BPSNCPD6",87,0) BB ; "RTN","BPSNCPD6",88,0) S RESPONSE=1 "RTN","BPSNCPD6",89,0) S CLMSTAT="Previously billed through ECME: "_OLDRESP "RTN","BPSNCPD6",90,0) D DISPL^BPSNCPD4(WFLG,RESPONSE_U_CLMSTAT_"^D^2",$G(BPSELIG)) "RTN","BPSNCPD6",91,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",92,0) Q "RTN","BPSNCPD6",93,0) ; "RTN","BPSNCPD6",94,0) ; if we do not have a status for pre-existing claim AND this is a reversal request - DO NOT reverse "RTN","BPSNCPD6",95,0) RVNEW ; "RTN","BPSNCPD6",96,0) S RESPONSE=1 "RTN","BPSNCPD6",97,0) S CLMSTAT="Prescription not previously billed through ECME. Cannot Reverse claim." "RTN","BPSNCPD6",98,0) D DISPL^BPSNCPD4(WFLG,RESPONSE_U_CLMSTAT_"^D^2",$G(BPSELIG)) "RTN","BPSNCPD6",99,0) D LOG(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPD6",100,0) Q "RTN","BPSNCPD6",101,0) ; "RTN","BPSNCPD6",102,0) LOG(IEN59,MSG,BPDTFLG) ; "RTN","BPSNCPD6",103,0) D LOG^BPSOSL(IEN59,MSG,$G(BPDTFLG)) "RTN","BPSNCPD6",104,0) Q "RTN","BPSNCPD6",105,0) ; "RTN","BPSNCPD6",106,0) ; This was meant to called by BPSSCR04 to collect requests for the User Screen that don't have BPS TRANSACTION records "RTN","BPSNCPD6",107,0) ; However, it is currently not called. This is still here in case, it is needed in the future. The call that should "RTN","BPSNCPD6",108,0) ; be used is D LOOK77^BPSNCPD6(BPBDT,BPEDT,BPTMP1) "RTN","BPSNCPD6",109,0) LOOK77(BPBEGDT,BPENDDT,BPTMP) ; "RTN","BPSNCPD6",110,0) N BPLDT77,BP77,BP59,BPRXRF "RTN","BPSNCPD6",111,0) S BPLDT77=BPBEGDT-0.00001 "RTN","BPSNCPD6",112,0) F S BPLDT77=+$O(^BPS(9002313.77,"E",BPLDT77)) Q:BPLDT77=0!(BPLDT77>BPENDDT) D "RTN","BPSNCPD6",113,0) . S BP77=0 F S BP77=$O(^BPS(9002313.77,"E",BPLDT77,BP77)) Q:+BP77=0 D "RTN","BPSNCPD6",114,0) . . S BPRXRF=$P($G(^BPS(9002313.77,BP77,0)),U,1,2) "RTN","BPSNCPD6",115,0) . . S BP59=$$IEN59^BPSOSRX(+BPRXRF,$P(BPRXRF,U,2)) ;calculate BPS TRANSACTION ien (even if it doesn't exist yet) "RTN","BPSNCPD6",116,0) . . I $D(@BPTMP@(BP59)) Q ;don't create an entry if the claim is already there "RTN","BPSNCPD6",117,0) . . S @BPTMP@(BP59)=(BPLDT77\1)_"^77-" "RTN","BPSNCPD6",118,0) Q "RTN","BPSNCPD6",119,0) ; "RTN","BPSNCPD9") 0^45^B36538508 "RTN","BPSNCPD9",1,0) BPSNCPD9 ;ALB/DMB - Eligibility Verification Entry Point ;09/21/2010 "RTN","BPSNCPD9",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**10**;JUN 2004;Build 27 "RTN","BPSNCPD9",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPD9",4,0) ; "RTN","BPSNCPD9",5,0) Q "RTN","BPSNCPD9",6,0) ; Main entry point for eligibility verification claims "RTN","BPSNCPD9",7,0) ; Input Parameters: "RTN","BPSNCPD9",8,0) ; DFN - Patient "RTN","BPSNCPD9",9,0) ; BPSARRY - Array of values "RTN","BPSNCPD9",10,0) ; "PLAN" - IEN to the GROUP INSURANCE PLAN (#355.3) file "RTN","BPSNCPD9",11,0) ; "FILL DATE" - Date of Service "RTN","BPSNCPD9",12,0) ; "IEN" - Prescription IEN "RTN","BPSNCPD9",13,0) ; "FILL NUMBER" - Fill Number "RTN","BPSNCPD9",14,0) ; "REL CODE" - Relationship Code "RTN","BPSNCPD9",15,0) ; "PERSON CODE" - Person Code "RTN","BPSNCPD9",16,0) ; Output "RTN","BPSNCPD9",17,0) ; RESULT "RTN","BPSNCPD9",18,0) ; Piece 1 - 0: Not submitted or 1: Submitted "RTN","BPSNCPD9",19,0) ; Piece 2 - Message "RTN","BPSNCPD9",20,0) ; "RTN","BPSNCPD9",21,0) EN(DFN,BPSARRY) ; "RTN","BPSNCPD9",22,0) ; Validate Incoming Parameters "RTN","BPSNCPD9",23,0) I '$G(DFN) Q "0^Invalid Patient IEN" "RTN","BPSNCPD9",24,0) I '$G(BPSARRY("PLAN")) Q "0^Invalid Plan" "RTN","BPSNCPD9",25,0) I '$G(BPSARRY("FILL DATE")) Q "0^Invalid Date of Service" "RTN","BPSNCPD9",26,0) S BPSARRY("IEN")=$G(BPSARRY("IEN")) "RTN","BPSNCPD9",27,0) S BPSARRY("FILL NUMBER")=$G(BPSARRY("FILL NUMBER")) "RTN","BPSNCPD9",28,0) S BPSARRY("REL CODE")=$G(BPSARRY("REL CODE")) "RTN","BPSNCPD9",29,0) S BPSARRY("PERSON CODE")=$G(BPSARRY("PERSON CODE")) "RTN","BPSNCPD9",30,0) ; "RTN","BPSNCPD9",31,0) N PHARM,SITE,ERR,MOREDATA,IEN59,RXACT,POLICY,RETV,NEWREQ,IB "RTN","BPSNCPD9",32,0) N PREVREQ,REQLIST,MSG,CERTIEN "RTN","BPSNCPD9",33,0) S ERR="" "RTN","BPSNCPD9",34,0) ; "RTN","BPSNCPD9",35,0) ; Get division "RTN","BPSNCPD9",36,0) ; If there is an RX/Fill, get the division from the Rx "RTN","BPSNCPD9",37,0) I BPSARRY("IEN"),BPSARRY("FILL NUMBER")]"" D I 'SITE Q 0_U_"The RX is missing the Division" "RTN","BPSNCPD9",38,0) . S SITE=$$GETSITE^BPSOSRX8(BPSARRY("IEN"),BPSARRY("FILL NUMBER")) "RTN","BPSNCPD9",39,0) ; "RTN","BPSNCPD9",40,0) ; If no RX/Fill, get the default pharmacy from the ECME SETUP file and then "RTN","BPSNCPD9",41,0) ; the associated division "RTN","BPSNCPD9",42,0) I 'BPSARRY("IEN")!(BPSARRY("FILL NUMBER")="") D I ERR]"" Q 0_U_ERR "RTN","BPSNCPD9",43,0) . S PHARM=$$GET1^DIQ(9002313.99,1,.08,"I") "RTN","BPSNCPD9",44,0) . I 'PHARM S ERR="Default Pharmacy not defined in ECME Setup" Q "RTN","BPSNCPD9",45,0) . I '$$BPSACTV^BPSUTIL(PHARM) S ERR="Default Pharmacy not active" Q "RTN","BPSNCPD9",46,0) . S SITE=$O(^BPS(9002313.56,PHARM,"OPSITE",0)) "RTN","BPSNCPD9",47,0) . I 'SITE S ERR="No division associated with the default Pharmacy" Q "RTN","BPSNCPD9",48,0) . S SITE=$P($G(^BPS(9002313.56,PHARM,"OPSITE",SITE,0)),U,1) "RTN","BPSNCPD9",49,0) . I 'SITE S ERR="No division associated with the default Pharmacy" Q "RTN","BPSNCPD9",50,0) ; "RTN","BPSNCPD9",51,0) ; Check that the division is active "RTN","BPSNCPD9",52,0) I '$$ECMEON^BPSUTIL(SITE) Q 0_U_"ECME switch is not on for the site" "RTN","BPSNCPD9",53,0) ; "RTN","BPSNCPD9",54,0) ; Call billing determination "RTN","BPSNCPD9",55,0) K MOREDATA "RTN","BPSNCPD9",56,0) S RXACT="ELIG" "RTN","BPSNCPD9",57,0) D BASICMOR^BPSOSRX8(RXACT,BPSARRY("FILL DATE"),SITE,"","","","","","",.MOREDATA) "RTN","BPSNCPD9",58,0) S BPSARRY("DFN")=DFN "RTN","BPSNCPD9",59,0) S BPSARRY("EPHARM")=$$GETPHARM^BPSUTIL(SITE) "RTN","BPSNCPD9",60,0) S BPSARRY("USER")=DUZ "RTN","BPSNCPD9",61,0) S BPSARRY("RX ACTION")=RXACT "RTN","BPSNCPD9",62,0) S BPSARRY("DIVISION")=SITE "RTN","BPSNCPD9",63,0) I +$$CERTTEST^BPSNCPD4(.CERTIEN)=1 Q 0_U_"Certification question not answered" "RTN","BPSNCPD9",64,0) D EN^BPSNCPD2(DFN,RXACT,.MOREDATA,.BPSARRY,.IB) "RTN","BPSNCPD9",65,0) I +MOREDATA("BILL")'=1 Q 0_U_"Not submittable: "_$P(MOREDATA("BILL"),U,2) "RTN","BPSNCPD9",66,0) I '$P($G(MOREDATA("IBDATA",1,3)),U,7) Q 0_U_"Not submittable: No Policy Information returned" "RTN","BPSNCPD9",67,0) ; "RTN","BPSNCPD9",68,0) ; Create the IEN for the BPS Transaction record and initialize the log "RTN","BPSNCPD9",69,0) S POLICY=9000+$P($G(MOREDATA("IBDATA",1,3)),U,7) "RTN","BPSNCPD9",70,0) S IEN59=$$IEN59^BPSOSRX(DFN,POLICY,1) "RTN","BPSNCPD9",71,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Start of eligibility verification","DT") "RTN","BPSNCPD9",72,0) ; "RTN","BPSNCPD9",73,0) ; If override flag is set, prompt for override values - TEST ONLY "RTN","BPSNCPD9",74,0) I $$CHECK^BPSTEST D GETOVER^BPSTEST(DFN,POLICY,"",RXACT,"E",1) W ! "RTN","BPSNCPD9",75,0) ; "RTN","BPSNCPD9",76,0) ; If there is a person code or relationship code, create the Override record for the Person Code and Relationship code "RTN","BPSNCPD9",77,0) ; Quit if error occurs "RTN","BPSNCPD9",78,0) S ERR="" "RTN","BPSNCPD9",79,0) I BPSARRY("REL CODE")!BPSARRY("PERSON CODE") D I ERR]"" Q ERR "RTN","BPSNCPD9",80,0) . N BPFLD,BPOVRIEN,BPFDA,BPSMSG "RTN","BPSNCPD9",81,0) . S BPFDA(9002313.511,"+1,",.01)=IEN59 "RTN","BPSNCPD9",82,0) . S BPFDA(9002313.511,"+1,",.02)=$$NOW^BPSOSRX() "RTN","BPSNCPD9",83,0) . S BPFLD=$O(^BPSF(9002313.91,"B",303,"")) I BPFLD]"" S BPFDA(9002313.5111,"+2,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+2,+1,",.02)=BPSARRY("PERSON CODE") "RTN","BPSNCPD9",84,0) . S BPFLD=$O(^BPSF(9002313.91,"B",306,"")) I BPFLD]"" S BPFDA(9002313.5111,"+3,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+3,+1,",.02)=BPSARRY("REL CODE") "RTN","BPSNCPD9",85,0) . D UPDATE^DIE("","BPFDA","BPOVRIEN","BPSMSG") "RTN","BPSNCPD9",86,0) . I $D(BPSMSG("DIERR"))!($G(BPOVRIEN(1))="") D Q "RTN","BPSNCPD9",87,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-Override Record could not be created") "RTN","BPSNCPD9",88,0) .. D LOG^BPSOSL(IEN59,"BPOVRIEN Array:") "RTN","BPSNCPD9",89,0) .. D LOGARRAY^BPSOSL(IEN59,"BPOVRIEN") "RTN","BPSNCPD9",90,0) .. D LOG^BPSOSL(IEN59,"BPSMSG Array:") "RTN","BPSNCPD9",91,0) .. D LOGARRAY^BPSOSL(IEN59,"BPSMSG") "RTN","BPSNCPD9",92,0) .. S ERR=0_U_"Could Not Save Person Code or Relationship Code" "RTN","BPSNCPD9",93,0) . S MOREDATA("BPOVRIEN")=BPOVRIEN(1) "RTN","BPSNCPD9",94,0) ; "RTN","BPSNCPD9",95,0) ; Call CHKREQST^BPSOSRX7 to see if there are other requests on the queue. "RTN","BPSNCPD9",96,0) ; If the return value is negative, quit with error. "RTN","BPSNCPD9",97,0) S PREVREQ=$$CHKREQST^BPSOSRX7(DFN,POLICY,.REQLIST) "RTN","BPSNCPD9",98,0) I PREVREQ<-1 D Q 0_U_"There was a queueing issue and the request could not be submitted" "RTN","BPSNCPD9",99,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-CHKREQST~BPSOSRX7 returned an error: "_PREVREQ_". Request not submitted.") "RTN","BPSNCPD9",100,0) ; "RTN","BPSNCPD9",101,0) ; Create the request "RTN","BPSNCPD9",102,0) S RETV=$$REQST^BPSOSRX("E",DFN,POLICY,.MOREDATA,1,IEN59) "RTN","BPSNCPD9",103,0) S NEWREQ=+$P(RETV,U,2) "RTN","BPSNCPD9",104,0) ; "RTN","BPSNCPD9",105,0) ; If error, log error and quit "RTN","BPSNCPD9",106,0) I +RETV=0 D Q 0_U_ERR "RTN","BPSNCPD9",107,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Create request error: "_RETV_". Request Will Not Be submitted.") "RTN","BPSNCPD9",108,0) . S ERR="Eligibility Request not created - "_$P(RETV,U,2) "RTN","BPSNCPD9",109,0) ; "RTN","BPSNCPD9",110,0) ; Update log with successful request "RTN","BPSNCPD9",111,0) D LOG^BPSOSL(IEN59,$T(+0)_"-BPS REQUEST "_NEWREQ_" has been created") "RTN","BPSNCPD9",112,0) ; "RTN","BPSNCPD9",113,0) ; The rest of processing is based on the return value of the call to CHKREQST above. "RTN","BPSNCPD9",114,0) ; If positive, need to link the current request to the previous request on the queue. "RTN","BPSNCPD9",115,0) ; Check the result of trying to link the requests "RTN","BPSNCPD9",116,0) I PREVREQ>1 D Q +RETV_U_MSG "RTN","BPSNCPD9",117,0) . S RETV=$$NXTREQST^BPSOSRX6(PREVREQ,NEWREQ) "RTN","BPSNCPD9",118,0) . ; If 1 is returned, all is good, log message and quit "RTN","BPSNCPD9",119,0) . I +RETV=1 D Q "RTN","BPSNCPD9",120,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-Request "_NEWREQ_" linked to "_PREVREQ) "RTN","BPSNCPD9",121,0) .. S MSG="Request submitted but will not be processed until previous request finishes" "RTN","BPSNCPD9",122,0) . ; "RTN","BPSNCPD9",123,0) . ; If we got here, we were not able to link the request "RTN","BPSNCPD9",124,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-NXTREQST~BPSOSRX6 returned an error: "_RETV_". Request not submitted.") "RTN","BPSNCPD9",125,0) . S MSG="There was a queueing issue and the request could not be created" "RTN","BPSNCPD9",126,0) ; "RTN","BPSNCPD9",127,0) ; If we got to here, CHKREQST returned 0 so we need to activate the request "RTN","BPSNCPD9",128,0) S RETV=$$ACTIVATE^BPSNCPD4(NEWREQ,"E") "RTN","BPSNCPD9",129,0) ; "RTN","BPSNCPD9",130,0) ; If error, log error and quit "RTN","BPSNCPD9",131,0) I RETV'=0 D Q 0_U_ERR "RTN","BPSNCPD9",132,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Activation error: "_RETV_". Request Will Not Be submitted.") "RTN","BPSNCPD9",133,0) . S ERR="Eligibility Request not submitted - "_$P(RETV,U,2) "RTN","BPSNCPD9",134,0) ; "RTN","BPSNCPD9",135,0) ; Log activation "RTN","BPSNCPD9",136,0) D LOG^BPSOSL(IEN59,$T(+0)_"-BPS REQUEST: "_NEWREQ_" has been activated") "RTN","BPSNCPD9",137,0) ; "RTN","BPSNCPD9",138,0) ; Start filer to process queue requests "RTN","BPSNCPD9",139,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Start RUNNING^BPSOSRX") "RTN","BPSNCPD9",140,0) D RUNNING^BPSOSRX() "RTN","BPSNCPD9",141,0) ; "RTN","BPSNCPD9",142,0) Q 1_U_"Request successfully submitted to ECME" "RTN","BPSNCPD9",143,0) ; "RTN","BPSNCPDP") 0^1^B79480311 "RTN","BPSNCPDP",1,0) BPSNCPDP ;BHAM ISC/LJE/SS - API to submit a claim to ECME ;11/7/07 16:58 "RTN","BPSNCPDP",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,4,2,5,6,7,8,10**;JUN 2004;Build 27 "RTN","BPSNCPDP",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSNCPDP",4,0) ; "RTN","BPSNCPDP",5,0) ; Reference to $$PROD^XUPROD supported by DBIA 4440 "RTN","BPSNCPDP",6,0) ; Reference to $$GETNDC^PSSNDCUT supported by DBIA 4707 "RTN","BPSNCPDP",7,0) ; Reference to Patient file (#2) supported by DBIA 10035 "RTN","BPSNCPDP",8,0) ; "RTN","BPSNCPDP",9,0) ; For comments regarding this API, see routine BPSNCPD3. "RTN","BPSNCPDP",10,0) ; "RTN","BPSNCPDP",11,0) EN(BRXIEN,BFILL,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPCOBIND,BPJOBFLG,BPREQIEN,BPSCLOSE,BPSPLAN,BPSPRDAT,BPSRTYPE,BPSDELAY) ; "RTN","BPSNCPDP",12,0) N BPRETV,CLMSTAT,BRX,RESPONSE,BPSCOB,IEN59,DFN,PNAME,WFLG,BPLCK,BPACTTYP,BPRET,BPSQUIT,SITE "RTN","BPSNCPDP",13,0) N BPNEWCLM,OLDRESP,BPPAYABL,BPSTART,BPRESLT,BPSELIG,BP77NEW,BPTODAY,BPPREVRQ,BPSSTAT "RTN","BPSNCPDP",14,0) ; test not ecme active "RTN","BPSNCPDP",15,0) I '$$PROD^XUPROD,'$P($G(^BPS(9002313.99,1,0)),"^",3) Q "1^ECME switch is not on for the site" "RTN","BPSNCPDP",16,0) ;== Set default values and other required vars "RTN","BPSNCPDP",17,0) ; default is foreground ("F") "RTN","BPSNCPDP",18,0) S BPJOBFLG=$S($G(BPJOBFLG)="":"F",1:$G(BPJOBFLG)) "RTN","BPSNCPDP",19,0) S RESPONSE="",CLMSTAT="",BP77NEW=0 "RTN","BPSNCPDP",20,0) S BPLCK=0 ;0 - default for "B" jobs "RTN","BPSNCPDP",21,0) S REVREAS=$G(REVREAS),DURREC=$G(DURREC),BPSCLARF=$G(BPSCLARF),BPSAUTH=$G(BPSAUTH),BPOVRIEN=$G(BPOVRIEN),BPSDELAY=$G(BPSDELAY) "RTN","BPSNCPDP",22,0) ; BPCOBIND will be used as a flag to indicate the following "RTN","BPSNCPDP",23,0) ; If BPCOBIND>0 then the API is called for the particular COB claim "RTN","BPSNCPDP",24,0) ; if BPCOBIND=0 then the API is called for a whole RX/RF - Outpatient Pharmacy doesn't care about COB "RTN","BPSNCPDP",25,0) ; when the pharmacy user enters, deletes or edits RX/refills "RTN","BPSNCPDP",26,0) S BPCOBIND=+$G(BPCOBIND) "RTN","BPSNCPDP",27,0) ; "RTN","BPSNCPDP",28,0) ; BPSCOB variable will be used to store COB value (default is PRIMARY) in this function only "RTN","BPSNCPDP",29,0) S BPSCOB=$S(BPCOBIND>0:BPCOBIND,1:1) "RTN","BPSNCPDP",30,0) ; default is original fill "RTN","BPSNCPDP",31,0) I '$G(BFILL) S BFILL=0 "RTN","BPSNCPDP",32,0) ; Get prescription number "RTN","BPSNCPDP",33,0) S BRX=$$RXAPI1^BPSUTIL1(BRXIEN,.01,"I") "RTN","BPSNCPDP",34,0) ; Make sure fill date is not in the future or empty "RTN","BPSNCPDP",35,0) S BPTODAY=$$TODAY^BPSOSRX5() I '$G(BFILLDAT)!($G(BFILLDAT)>BPTODAY) S BFILLDAT=BPTODAY "RTN","BPSNCPDP",36,0) ; Get the NDC if it was not passed in "RTN","BPSNCPDP",37,0) I $G(BILLNDC)="" S BILLNDC=$$GETNDC^PSONDCUT(BRXIEN,BFILL) "RTN","BPSNCPDP",38,0) ; Patient Info "RTN","BPSNCPDP",39,0) S DFN=$$RXAPI1^BPSUTIL1(BRXIEN,2,"I"),PNAME=$$GET1^DIQ(2,DFN,.01) "RTN","BPSNCPDP",40,0) ; "RTN","BPSNCPDP",41,0) ; Check parameters and vars "RTN","BPSNCPDP",42,0) S BPRETV=$$CHCKPAR^BPSOSRX8($G(BRXIEN),$G(BRX),$G(BWHERE),$G(DFN),$G(PNAME),$G(BILLNDC)) I +BPRETV=0 S CLMSTAT=$P(BPRETV,U,2),RESPONSE=5 G END "RTN","BPSNCPDP",43,0) ; "RTN","BPSNCPDP",44,0) ; Calculate IEN59 "RTN","BPSNCPDP",45,0) S IEN59=$$IEN59^BPSOSRX(BRXIEN,BFILL,BPSCOB) I IEN59="" S CLMSTAT="BPS Transaction IEN could not be calculated",RESPONSE=1 G END "RTN","BPSNCPDP",46,0) ; "RTN","BPSNCPDP",47,0) ;populate COB fields from BPS TRANSACTION to resubmit secondary claims from the User Screen "RTN","BPSNCPDP",48,0) ;if $G(BPSPRDAT("NEW COB DATA"))=1 then the resubmit requested from the BPS COB PROCESS SECOND TRICARE and the user can change the data "RTN","BPSNCPDP",49,0) I BPSCOB=2,$$ACTTYPE^BPSOSRX5(BWHERE)="UC",'$G(BPSPRDAT("NEW COB DATA")) N:$D(BPSRTYPE)=0 BPSRTYPE N:$D(BPSPLAN)=0 BPSPLAN N:$D(BPSPRDAT)=0 BPSPRDAT I $$RES2NDCL^BPSPRRX6(IEN59,.BPSPLAN,.BPSPRDAT,.BPSRTYPE)=0 D G END "RTN","BPSNCPDP",50,0) . S CLMSTAT="Insufficient data to resubmit the secondary claim, use Process Secondary/Tricare Rx to ECME option.",RESPONSE=5 "RTN","BPSNCPDP",51,0) ; "RTN","BPSNCPDP",52,0) ; Initialize log "RTN","BPSNCPDP",53,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Start of claim","DT") "RTN","BPSNCPDP",54,0) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Job flag = "_BPJOBFLG_$S(BPJOBFLG="B":" BPS REQUEST ien = "_$G(BPREQIEN),1:"")) "RTN","BPSNCPDP",55,0) ; "RTN","BPSNCPDP",56,0) ; Check if we need to print the messages to the screen (WFLG=1 : YES) "RTN","BPSNCPDP",57,0) S WFLG=0 "RTN","BPSNCPDP",58,0) S:BPJOBFLG="F" WFLG=$$PRINTSCR^BPSOSRX8(BWHERE) "RTN","BPSNCPDP",59,0) ; "RTN","BPSNCPDP",60,0) ; Lock the Rx and Fill while putting it on the queue to prevent two jobs from being "RTN","BPSNCPDP",61,0) ; activated at the same time. This is only for foreground jobs. "RTN","BPSNCPDP",62,0) ; Background jobs are called from REQST99^BPSOSRX5 and the RX/RF should be already locked by this point. "RTN","BPSNCPDP",63,0) I BPJOBFLG="F" D I 'BPLCK G END "RTN","BPSNCPDP",64,0) . S BPLCK=$$LOCKRF^BPSOSRX(BRXIEN,BFILL,10,$G(IEN59),$T(+0)) "RTN","BPSNCPDP",65,0) . I 'BPLCK S RESPONSE=4,CLMSTAT="Unable to acquire the lock needed to put the RX and fill on the queue" "RTN","BPSNCPDP",66,0) ; "RTN","BPSNCPDP",67,0) ; Determine the action type "RTN","BPSNCPDP",68,0) ; If foreground job then can be C,U and UC actions types "RTN","BPSNCPDP",69,0) S BPACTTYP="" "RTN","BPSNCPDP",70,0) I BPJOBFLG="F" S BPACTTYP=$$ACTTYPE^BPSOSRX5(BWHERE) "RTN","BPSNCPDP",71,0) ;if background/unqueueing job then only two action types are allowed - C and U "RTN","BPSNCPDP",72,0) I BPJOBFLG="B" D I RESPONSE=5 G END "RTN","BPSNCPDP",73,0) . S BPACTTYP=$P($G(^BPS(9002313.77,+$G(BPREQIEN),1)),U,4) "RTN","BPSNCPDP",74,0) . I BPACTTYP="" S RESPONSE=5,CLMSTAT="Unknown Action type in BPS REQUEST ien="_BPREQIEN "RTN","BPSNCPDP",75,0) ; "RTN","BPSNCPDP",76,0) ;code to handle "general" submit/reversal as opposed to processing a claim for a specific payer sequence (primary, secondary) "RTN","BPSNCPDP",77,0) ;ECME and IB always know the payer sequence and always should set the proper BPCOBIND parameter "RTN","BPSNCPDP",78,0) ;thus if BPCOBIND=0 then the API is called by Pharmacy. If so then the CLAIM action (not reversal) should be done for primary only. "RTN","BPSNCPDP",79,0) S BPSQUIT=0 "RTN","BPSNCPDP",80,0) I BPCOBIND=0 D I BPSQUIT=1 S CLMSTAT="The secondary claim needs to be reversed first.",RESPONSE=5 G END "RTN","BPSNCPDP",81,0) . I BPACTTYP=""!(BPACTTYP="C") S BPCOBIND=1 Q "RTN","BPSNCPDP",82,0) . ;code to handle "general" reversal "RTN","BPSNCPDP",83,0) . N BPSECLM "RTN","BPSNCPDP",84,0) . ;check if there is the secondary e-claim "RTN","BPSNCPDP",85,0) . S BPSECLM=$$FINDECLM^BPSPRRX5(BRXIEN,BFILL,2) "RTN","BPSNCPDP",86,0) . ;quit if we have secondary claim and it is payable or in progress - it needs to be reversed first "RTN","BPSNCPDP",87,0) . I BPSECLM=1!(BPSECLM=3) S BPSQUIT=1 "RTN","BPSNCPDP",88,0) . S BPCOBIND=1 "RTN","BPSNCPDP",89,0) ; "RTN","BPSNCPDP",90,0) ;== IF BPJOBFLG="F" THEN determine if there are any scheduled/active/in process requests for the RX/RF "RTN","BPSNCPDP",91,0) ;CHKREQST^BPSOSRX7 returns "RTN","BPSNCPDP",92,0) ; negative number^message : cannot be accepted for some reason "RTN","BPSNCPDP",93,0) ; 0 : can be accepted because there are NO requests for this RX/RF, "RTN","BPSNCPDP",94,0) ; we will create a new record in BPS REQUEST for it and ACTIVATE it. "RTN","BPSNCPDP",95,0) ; 1 : there are ACTIVATED/IN PROCESS requests already for this RX/RF "RTN","BPSNCPDP",96,0) S BPPREVRQ="-10^Background queuing." ;default "RTN","BPSNCPDP",97,0) I BPJOBFLG="F" D I BPPREVRQ'=0 G STATUS:RESPONSE=0,END:RESPONSE>0 "RTN","BPSNCPDP",98,0) . S BPPREVRQ=$$CHKREQST^BPSOSRX7(BRXIEN,BFILL,.BPRESLT) "RTN","BPSNCPDP",99,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-CHKREQ^BPSOSRX7 result: "_BPPREVRQ) "RTN","BPSNCPDP",100,0) . ;if error "RTN","BPSNCPDP",101,0) . I BPPREVRQ<0 S RESPONSE=4,CLMSTAT=$P(BPPREVRQ,U,2) D LOG^BPSNCPD6(IEN59,$T(+0)_"- - Cannot be accepted because of issues with already scheduled requests") "RTN","BPSNCPDP",102,0) . ;if there are prior requests for the RX/RF in the queue already then schedule additional request(s) "RTN","BPSNCPDP",103,0) . ;for the future and quit since we do not know the result of prior requests "RTN","BPSNCPDP",104,0) . I BPPREVRQ>0 D "RTN","BPSNCPDP",105,0) . . D LOG^BPSNCPD6(IEN59,$T(+0)_"-There are requests in the queue, do not process - schedule additional request(s)") "RTN","BPSNCPDP",106,0) . . I BPACTTYP="U" S BPRET=$$SCHREQ^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,$G(BILLNDC),REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BPPREVRQ,"U",.BPSCLOSE,$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPDP",107,0) . . I BPACTTYP="UC" D "RTN","BPSNCPDP",108,0) . . . S BPRET=$$SCHREQ^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,$G(BILLNDC),REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BPPREVRQ,"U",$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPDP",109,0) . . . I +BPRET=0 S BPRET=$$SCHREQ^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,$G(BILLNDC),REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BP77NEW,"C",$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPDP",110,0) . . I BPACTTYP="C" S BPRET=$$SCHREQ^BPSNCPD5(.BP77NEW,BRXIEN,BFILL,BFILLDAT,BWHERE,$G(BILLNDC),REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,IEN59,BPCOBIND,BPPREVRQ,"C",$G(BPSRTYPE),$G(BPSPLAN),.BPSPRDAT) "RTN","BPSNCPDP",111,0) . . I +BPRET=0 S RESPONSE=0,CLMSTAT=$P(BPRET,U,2) D LOG^BPSNCPD6(IEN59,$T(+0)_"-The new request(s) scheduled. The last one for the RX/RF now is: "_(BP77NEW)) Q "RTN","BPSNCPDP",112,0) . . I +BPRET>0 S RESPONSE=+BPRET,CLMSTAT=$P(BPRET,U,2) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Cannot create request(s)") "RTN","BPSNCPDP",113,0) ; "RTN","BPSNCPDP",114,0) ;== So we can continue only if either "RTN","BPSNCPDP",115,0) ; BPJOBFLG="B" "RTN","BPSNCPDP",116,0) ; or "RTN","BPSNCPDP",117,0) ; BPJOBFLG="F" and BPPREVRQ=0 "RTN","BPSNCPDP",118,0) ; "RTN","BPSNCPDP",119,0) ; If a new RX/RF - i.e. RX/RF was never processed thru ECME - process and quit "RTN","BPSNCPDP",120,0) S BPNEWCLM=$S(+$G(^BPST(IEN59,0)):0,1:1) "RTN","BPSNCPDP",121,0) ; get pre-existing RX/RFs status "RTN","BPSNCPDP",122,0) ;S OLDRESP=$P($$STATUS^BPSOSRX(BRXIEN,BFILL,0),U,1) "RTN","BPSNCPDP",123,0) S OLDRESP=$P($$STATUS^BPSOSRX(BRXIEN,BFILL,0,,BPSCOB),U,1) "RTN","BPSNCPDP",124,0) ; check if the payer IS going to PAY according the last response "RTN","BPSNCPDP",125,0) S BPPAYABL=$$PAYABLE^BPSOSRX5(OLDRESP) "RTN","BPSNCPDP",126,0) ; set starttime "RTN","BPSNCPDP",127,0) S BPSTART=$$STTM^BPSNCPD4() "RTN","BPSNCPDP",128,0) ; "RTN","BPSNCPDP",129,0) ; if this is a new RX/RF "RTN","BPSNCPDP",130,0) I BPNEWCLM D NEWCLAIM^BPSNCPD6 G STATUS:RESPONSE=0,END:RESPONSE>0 "RTN","BPSNCPDP",131,0) ; "RTN","BPSNCPDP",132,0) ; if we do not have a status for the previous claim AND this is not a reversal request - treat it as a new claim "RTN","BPSNCPDP",133,0) I (OLDRESP=""),(BPACTTYP'="U") D NEWCLAIM^BPSNCPD6 G STATUS:RESPONSE=0,END:RESPONSE>0 "RTN","BPSNCPDP",134,0) ; "RTN","BPSNCPDP",135,0) ; if we do not have a status for the pre-existing claim AND this is a reversal request - DO NOT reverse "RTN","BPSNCPDP",136,0) I (OLDRESP=""),(BPACTTYP="U") D RVNEW^BPSNCPD6 G END "RTN","BPSNCPDP",137,0) ; "RTN","BPSNCPDP",138,0) ;== Further below - all claims with some response (i.e. OLDRESP]""=1) "RTN","BPSNCPDP",139,0) ; "RTN","BPSNCPDP",140,0) ; if Back Billing - impossible "RTN","BPSNCPDP",141,0) I BWHERE="BB" D BB^BPSNCPD6 G END "RTN","BPSNCPDP",142,0) ; "RTN","BPSNCPDP",143,0) ; If returning to stock or deleting and the previous claim was not paid, then no reversal is needed "RTN","BPSNCPDP",144,0) ; so close the prescription and quit "RTN","BPSNCPDP",145,0) ; Note: this is inherited "fuzzy logic" - "RTN","BPSNCPDP",146,0) ; it checks only two statuses to determine that the claim "was not paid" "RTN","BPSNCPDP",147,0) I OLDRESP'["E PAYABLE",OLDRESP'["E REVERSAL REJECTED",(",RS,DE,"[(","_BWHERE_",")) D G END "RTN","BPSNCPDP",148,0) . D CLOSE2^BPSBUTL(BRXIEN,BFILL,BWHERE) "RTN","BPSNCPDP",149,0) . S RESPONSE=3 "RTN","BPSNCPDP",150,0) . S CLMSTAT="Claim was not payable so it has been closed. No ECME claim created." "RTN","BPSNCPDP",151,0) . D DISPL^BPSNCPD4(WFLG,RESPONSE_U_CLMSTAT_"^D^2",$G(BPSELIG)) "RTN","BPSNCPDP",152,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-"_CLMSTAT) "RTN","BPSNCPDP",153,0) ; "RTN","BPSNCPDP",154,0) ; Reversals for Payable claims "RTN","BPSNCPDP",155,0) ; (Note: BPSCLOSE can be used in this case only) "RTN","BPSNCPDP",156,0) I BPPAYABL,BPACTTYP="U" D RVPAID^BPSNCPD6 G STATUS:RESPONSE=0,END:RESPONSE>0 "RTN","BPSNCPDP",157,0) ; "RTN","BPSNCPDP",158,0) ; Reversals+Resubmits for Payable claims "RTN","BPSNCPDP",159,0) I BPPAYABL,BPACTTYP="UC" D RVRSPAID^BPSNCPD6 G STATUS:((RESPONSE=0)!(RESPONSE=10)),END:RESPONSE>0 "RTN","BPSNCPDP",160,0) ; "RTN","BPSNCPDP",161,0) ; Resubmits for Payable claims - DO NOT resubmit "RTN","BPSNCPDP",162,0) I BPPAYABL,BPACTTYP="C" D RSPAID^BPSNCPD6 G END "RTN","BPSNCPDP",163,0) ; "RTN","BPSNCPDP",164,0) ; Reversals for Non-Payable claims - DO NOT reverse "RTN","BPSNCPDP",165,0) I 'BPPAYABL,BPACTTYP="U" D RVNPAID^BPSNCPD6 G END "RTN","BPSNCPDP",166,0) ; "RTN","BPSNCPDP",167,0) ; Resubmits AND Reversals+Resubmits for Non-Payable claims "RTN","BPSNCPDP",168,0) I 'BPPAYABL,((BPACTTYP="C")!(BPACTTYP="UC")) D RVRSNPD^BPSNCPD6 G STATUS:RESPONSE=0,END:RESPONSE>0 "RTN","BPSNCPDP",169,0) ; "RTN","BPSNCPDP",170,0) S RESPONSE=5,CLMSTAT="Unknown error" "RTN","BPSNCPDP",171,0) G END "RTN","BPSNCPDP",172,0) ; "RTN","BPSNCPDP",173,0) ;== Display status "RTN","BPSNCPDP",174,0) STATUS ; "RTN","BPSNCPDP",175,0) ;if successful scheduling or/and activation of the request then make sure the background job is running "RTN","BPSNCPDP",176,0) I BPJOBFLG="F",BPLCK D UNLCKRF^BPSOSRX(BRXIEN,BFILL,$G(IEN59),$T(+0)) S BPLCK=0 ;to prevent unlocking in END "RTN","BPSNCPDP",177,0) I (RESPONSE=0)!(RESPONSE=10) D LOG^BPSNCPD6(IEN59,$T(+0)_"-Call RUNNING^BPSOSRX") D RUNNING^BPSOSRX() "RTN","BPSNCPDP",178,0) ;if Tricare then shall print messages to the screen "RTN","BPSNCPDP",179,0) I $G(BPSELIG)="T" S WFLG=1 "RTN","BPSNCPDP",180,0) W:WFLG !!,"Processing ",$S(BPSCOB=1:"Primary claim...",BPSCOB=2:"Secondary claim...",1:"claim with Unknown Payer Sequence...") ;this can be deleted after testing "RTN","BPSNCPDP",181,0) I BPJOBFLG="F" D "RTN","BPSNCPDP",182,0) . I 'WFLG H 1 "RTN","BPSNCPDP",183,0) . E D STATUS^BPSNCPD1(BRXIEN,BFILL,+$G(BPPAYABL),$S(BPACTTYP="U":1,1:0),BPSTART,BWHERE,$G(BP77NEW),BPSCOB) "RTN","BPSNCPDP",184,0) ; "RTN","BPSNCPDP",185,0) ;== Clean up and quit "RTN","BPSNCPDP",186,0) END ; "RTN","BPSNCPDP",187,0) I BPJOBFLG="F",BPLCK D UNLCKRF^BPSOSRX(BRXIEN,BFILL,$G(IEN59),$T(+0)) S BPLCK=0 "RTN","BPSNCPDP",188,0) ; Get Site in case we send a Bulletin "RTN","BPSNCPDP",189,0) S SITE=$$GETSITE^BPSOSRX8(BRXIEN,BFILL) "RTN","BPSNCPDP",190,0) ;if foreground AND we can't schedule request for any reason AND this is not OP - send bulletin "RTN","BPSNCPDP",191,0) D:BPJOBFLG="F" SENDBUL^BPSOSRX8(RESPONSE,BWHERE,BRXIEN,BFILL,SITE,$G(DFN),$G(PNAME),$G(CLMSTAT),$G(RESPONSE)) "RTN","BPSNCPDP",192,0) I $G(BPSELIG)="" S BPSELIG="" "RTN","BPSNCPDP",193,0) ;I $G(BPSELIG)="" S BPSELIG=$$ELIG^BPSOSRX7(+$G(DFN)) "RTN","BPSNCPDP",194,0) ; need to look up current status and return (mm if tricare in progress) "RTN","BPSNCPDP",195,0) S BPSSTAT=$S($G(BRXIEN):$P($$STATUS^BPSOSRX(BRXIEN,BFILL,,,BPSCOB),U),1:"") "RTN","BPSNCPDP",196,0) I BPSELIG="T",BPSSTAT="IN PROGRESS",$G(DURREC)'="RX RELEASE-NDC CHANGE" D BULL^BPSNCPD1(BRXIEN,BFILL,SITE,$G(DFN),$G(PNAME),1) "RTN","BPSNCPDP",197,0) ; "RTN","BPSNCPDP",198,0) S:'$D(RESPONSE) RESPONSE=1 "RTN","BPSNCPDP",199,0) K BRXIEN,BFILL,BFILLDAT,BWHERE,MOREDATA "RTN","BPSNCPDP",200,0) I $G(IEN59) D "RTN","BPSNCPDP",201,0) . N MSG "RTN","BPSNCPDP",202,0) . S MSG="Foreground Process Complete-RESPONSE="_$G(RESPONSE) "RTN","BPSNCPDP",203,0) . I $G(RESPONSE)'=0 S MSG=MSG_", CLMSTAT="_$G(CLMSTAT) "RTN","BPSNCPDP",204,0) . D LOG^BPSNCPD6(IEN59,$T(+0)_"-"_MSG) "RTN","BPSNCPDP",205,0) Q RESPONSE_U_$G(CLMSTAT)_U_BPSELIG_U_BPSSTAT_U_$$CLMINFO^BPSUTIL2(+$G(IEN59)) "RTN","BPSNCPDP",206,0) ; "RTN","BPSNCPDP",207,0) ;BPSNCPDP "RTN","BPSOS03") 0^86^B9935989 "RTN","BPSOS03",1,0) BPSOS03 ;BHAM ISC/FCS/DRS - 9002313.03 utilities ;06/01/2004 "RTN","BPSOS03",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOS03",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOS03",4,0) ; "RTN","BPSOS03",5,0) Q "RTN","BPSOS03",6,0) ; General utilities for retrieval from 9002313.03, Claim Response "RTN","BPSOS03",7,0) ; $$INSPAID is used by BPSOSQL "RTN","BPSOS03",8,0) INSPAID(N) ;EP - from BPSOSQL - total amount paid by insurer "RTN","BPSOS03",9,0) N RX,TOT,X S (TOT,RX)=0 "RTN","BPSOS03",10,0) F S RX=$O(^BPSR(N,1000,RX)) Q:'RX D "RTN","BPSOS03",11,0) . ; Try Gross Amount Due, and if that's zero, Usual and Customary "RTN","BPSOS03",12,0) . S X=$$INSPAID1(N,RX) "RTN","BPSOS03",13,0) . S TOT=TOT+X "RTN","BPSOS03",14,0) Q TOT "RTN","BPSOS03",15,0) INSPAID1(N,RX) ;EP - "RTN","BPSOS03",16,0) N X S X=$$509(N,RX) Q X "RTN","BPSOS03",17,0) NETPAID1(N,RX) ; EP - computed field in 9002313.57 and 9002313.59 "RTN","BPSOS03",18,0) N X S X=$$509(N,RX) ; X = (#509) Total Amount Paid "RTN","BPSOS03",19,0) N SUB S SUB=1 ; Do we need to subtract (#505) Patient Pay Amount? "RTN","BPSOS03",20,0) N IEN02,INS,FMT S IEN02=$P(^BPSR(RESP,0),U) "RTN","BPSOS03",21,0) I IEN02 D "RTN","BPSOS03",22,0) . S INS=$P($G(^BPSC(IEN02,0)),U,2) Q:'INS ;IHS/SD/lwj 9/11/02 "RTN","BPSOS03",23,0) . S FMT=INS "RTN","BPSOS03",24,0) . N X S X=$P(^BPSF(9002313.92,FMT,1),U,10) "RTN","BPSOS03",25,0) . I X S SUB=0 ; Total paid means total paid by insurance "RTN","BPSOS03",26,0) I SUB S X=X-$$505(N,RX) "RTN","BPSOS03",27,0) I X<0,SUB D ; apparently this format is supposed to be excl. "RTN","BPSOS03",28,0) . Q:'$G(FMT) "RTN","BPSOS03",29,0) . S $P(^BPSF(9002313.92,FMT,1),U,10)=1 "RTN","BPSOS03",30,0) . S X=X+$$505(N,RX) ;*1.26*1* "RTN","BPSOS03",31,0) Q X "RTN","BPSOS03",32,0) REJTEXT(RESP,POS,ARR) ; EP - fills array (passed by ref) "RTN","BPSOS03",33,0) K ARR "RTN","BPSOS03",34,0) N A,I,X,R S (A,I)=0 "RTN","BPSOS03",35,0) F S A=$O(^BPSR(RESP,1000,POS,511,A)) Q:'A D "RTN","BPSOS03",36,0) . S R=$P(^BPSR(RESP,1000,POS,511,A,0),U) "RTN","BPSOS03",37,0) . Q:R="" "RTN","BPSOS03",38,0) . N S S S=$O(^BPSF(9002313.93,"B",R,0)) "RTN","BPSOS03",39,0) . I S S X=$TR($G(^BPSF(9002313.93,S,0)),U,":") "RTN","BPSOS03",40,0) . E S X=R_" unrecognized reject code" "RTN","BPSOS03",41,0) . S I=I+1,ARR(I)=X "RTN","BPSOS03",42,0) Q "RTN","BPSOS03",43,0) MESSAGE(RESP,POS,N) ; EP - get additional message from response "RTN","BPSOS03",44,0) I '$G(RESP) Q "" "RTN","BPSOS03",45,0) I '$G(POS) S POS=1 "RTN","BPSOS03",46,0) I $G(N)=1 Q $P($G(^BPSR(RESP,504)),U) "RTN","BPSOS03",47,0) I $G(N)=2 N MSG S MSG="" D Q MSG "RTN","BPSOS03",48,0) . N ADDMESS,N "RTN","BPSOS03",49,0) . D ADDMESS^BPSSCRLG(RESP,POS,.ADDMESS) "RTN","BPSOS03",50,0) . S N="" F S N=$O(ADDMESS(N)) Q:'N S MSG=MSG_$S(N=1:"",1:"~")_ADDMESS(N) "RTN","BPSOS03",51,0) Q $$MESSAGE(RESP,POS,1)_$$MESSAGE(RESP,POS,2) "RTN","BPSOS03",52,0) ; "RTN","BPSOS03",53,0) DFF2EXT(X) Q $$DFF2EXT^BPSECFM(X) "RTN","BPSOS03",54,0) 505(M,N) Q $$500(M,N,5) ; Patient Pay Amount "RTN","BPSOS03",55,0) 506(M,N) Q $$500(M,N,6) ; Ingredient Cost Paid "RTN","BPSOS03",56,0) 507(M,N) Q $$500(M,N,7) ; Contract Fee Paid "RTN","BPSOS03",57,0) 508(M,N) Q $$500(M,N,8) ; Sales Tax Paid "RTN","BPSOS03",58,0) 509(M,N) Q $$500(M,N,9) ; Total Amount Paid "RTN","BPSOS03",59,0) 512(M,N) Q $$500(M,N,12) ; Accumulated Deductible Amount "RTN","BPSOS03",60,0) 513(M,N) Q $$500(M,N,13) ; Remaining Deductible Amount "RTN","BPSOS03",61,0) 514(M,N) Q $$500(M,N,14) ; Remaining Benefit Amount "RTN","BPSOS03",62,0) 517(M,N) Q $$500(M,N,17) ; Amt Applied to Periodic Deduct "RTN","BPSOS03",63,0) 518(M,N) Q $$500(M,N,18) ; Amount of Copay/CoInsurance "RTN","BPSOS03",64,0) 519(M,N) Q $$500(M,N,19) ; Amt Attrib to Prod Selection "RTN","BPSOS03",65,0) 520(M,N) Q $$500(M,N,20) ; Amt Exceed Per Benefit Max "RTN","BPSOS03",66,0) 521(M,N) Q $$500(M,N,21) ; Incentive Fee Paid "RTN","BPSOS03",67,0) 523(M,N) Q $$500(M,N,23) ; Amount Attributed to Sales Tax "RTN","BPSOS03",68,0) 500(M,N,J) ; field #500+J signed numeric "RTN","BPSOS03",69,0) Q:'M!'N "" "RTN","BPSOS03",70,0) N X S X=$P($G(^BPSR(M,1000,N,500)),U,J) "RTN","BPSOS03",71,0) I $E(X,1,2)?2U S X=$E(X,3,$L(X)) "RTN","BPSOS03",72,0) S X=$$DFF2EXT(X) "RTN","BPSOS03",73,0) Q X "RTN","BPSOS2B") 0^43^B2413052 "RTN","BPSOS2B",1,0) BPSOS2B ;BHAM ISC/FCS/DRS/DLF - BPSOS2 continuation ;06/01/2004 "RTN","BPSOS2B",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOS2B",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOS2B",4,0) Q "RTN","BPSOS2B",5,0) VALUES ;EP - from BPSOS2 "RTN","BPSOS2B",6,0) ; note! This must correspond with the LABELS code in BPSOS2C "RTN","BPSOS2B",7,0) N I,R,C,X,X2,X3 "RTN","BPSOS2B",8,0) ; "RTN","BPSOS2B",9,0) ; Display In Progress Stats "RTN","BPSOS2B",10,0) S R=1,C=29 "RTN","BPSOS2B",11,0) F I=0,10,30,40,50,60,70,90 D "RTN","BPSOS2B",12,0) . S R=R+1,X=+$G(CHG("STAT",I)),X2=0,X3=3 D COM "RTN","BPSOS2B",13,0) ; "RTN","BPSOS2B",14,0) ; Display Completed Stats "RTN","BPSOS2B",15,0) S R=1,C=65 "RTN","BPSOS2B",16,0) F I=203,202,208,204,205,206,207,209,210,201 D "RTN","BPSOS2B",17,0) . S R=R+1,X=+$G(CHG("COMM",I)),X2=0,X3=7 D COM "RTN","BPSOS2B",18,0) Q "RTN","BPSOS2B",19,0) ; "RTN","BPSOS2B",20,0) COM ; Copied from COMMA^%DTC with NEWs added "RTN","BPSOS2B",21,0) ; Input X=value to format "RTN","BPSOS2B",22,0) ; X2=# decimal digits opt. followed by "$" "RTN","BPSOS2B",23,0) ; X3=len of desired output "RTN","BPSOS2B",24,0) N %,D,L "RTN","BPSOS2B",25,0) I $D(X3) S X3=X3+1 ; make room for the trailing space we'll get rid of "RTN","BPSOS2B",26,0) S D=X<0 S:D X=-X S %=$S($D(X2):+X2,1:2),X=$J(X,1,%),%=$L(X)-3-$E(23456789,%),L=$S($D(X3):X3,1:12) "RTN","BPSOS2B",27,0) F %=%:-3 Q:$E(X,%)="" S X=$E(X,1,%)_","_$E(X,%+1,99) "RTN","BPSOS2B",28,0) S:$D(X2) X=$E("$",X2["$")_X S X=$J($E("(",D)_X_$E(" )",D+1),L) "RTN","BPSOS2B",29,0) I $E(X,$L(X))=" " S X=$E(X,1,$L(X)-1) "RTN","BPSOS2B",30,0) ; "RTN","BPSOS2B",31,0) ; given R=row,C=col,X=string "RTN","BPSOS2B",32,0) D SET^VALM10(R,$$SETSTR^VALM1(X,$G(@VALMAR@(R,0)),C,$L(X))) "RTN","BPSOS2B",33,0) I $$VISIBLE(R) D WRITE^VALM10(R) "RTN","BPSOS2B",34,0) Q "RTN","BPSOS2B",35,0) ; "RTN","BPSOS2B",36,0) VISIBLE(R) ;EP - "RTN","BPSOS2B",37,0) I $G(NODISPLY) Q 0 "RTN","BPSOS2B",38,0) I '$G(VALMBG) Q 0 "RTN","BPSOS2B",39,0) I R(VALMBG+(18-3)) Q 0 "RTN","BPSOS2B",41,0) Q 1 "RTN","BPSOS2C") 0^42^B1693824 "RTN","BPSOS2C",1,0) BPSOS2C ;BHAM ISC/FCS/DRS/DLF - BPSOS2 continuation ;06/01/2004 "RTN","BPSOS2C",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOS2C",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOS2C",4,0) Q "RTN","BPSOS2C",5,0) LABELS ;EP - from BPSOS2 ; set up the labels display "RTN","BPSOS2C",6,0) N R,C,X,R1,I "RTN","BPSOS2C",7,0) ; "RTN","BPSOS2C",8,0) ; Display Headers for In Progress claims "RTN","BPSOS2C",9,0) S R=1,C=3,X="* CLAIM STATUS *" D L1 "RTN","BPSOS2C",10,0) F I=0,10,30,40,50,60,70,90 S R=R+1,X=$$STATI^BPSOSU(I) D L1 "RTN","BPSOS2C",11,0) S R1=R "RTN","BPSOS2C",12,0) ; "RTN","BPSOS2C",13,0) ; Display Headers for Completed claims "RTN","BPSOS2C",14,0) S R=1,C=40,X="* CLAIM RESULTS *" D L1 "RTN","BPSOS2C",15,0) F I=1:1:10 S R=R+1,X=$P($T(HDR+I),";",3) D L1 "RTN","BPSOS2C",16,0) ; "RTN","BPSOS2C",17,0) ; Update Line Counter to side with highest number of rows "RTN","BPSOS2C",18,0) S VALMCNT=$S(R>R1:R,1:R1) "RTN","BPSOS2C",19,0) Q "RTN","BPSOS2C",20,0) L1 ; given R=row,C=col,X=string "RTN","BPSOS2C",21,0) ; Duplicate of L1^BPSOS2B "RTN","BPSOS2C",22,0) D SET^VALM10(R,$$SETSTR^VALM1(X,$G(@VALMAR@(R,0)),C,$L(X))) "RTN","BPSOS2C",23,0) I $$VISIBLE^BPSOS2B(R) D WRITE^VALM10(R) "RTN","BPSOS2C",24,0) Q "RTN","BPSOS2C",25,0) HDR ;; "RTN","BPSOS2C",26,0) ;;Paid claims "RTN","BPSOS2C",27,0) ;;Rejected claims "RTN","BPSOS2C",28,0) ;;Dropped to Paper "RTN","BPSOS2C",29,0) ;;Duplicate claims "RTN","BPSOS2C",30,0) ;;Captured claims "RTN","BPSOS2C",31,0) ;;Accepted Reversals "RTN","BPSOS2C",32,0) ;;Rejected Reversals "RTN","BPSOS2C",33,0) ;;Accepted Eligibility "RTN","BPSOS2C",34,0) ;;Rejected Eligibility "RTN","BPSOS2C",35,0) ;;Errors "RTN","BPSOS57") 0^77^B15079066 "RTN","BPSOS57",1,0) BPSOS57 ;BHAM ISC/FCS/DRS/FLS - BPS Log of Transactions Utils ;06/01/2004 "RTN","BPSOS57",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOS57",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOS57",4,0) Q "RTN","BPSOS57",5,0) ; Numerous BPS Log of Transaction functions are here "RTN","BPSOS57",6,0) ; Each assumes that IEN57 is defined "RTN","BPSOS57",7,0) ; Originally copied from BPSOSQ "RTN","BPSOS57",8,0) ; "RTN","BPSOS57",9,0) DRGDFN() ; EP - BPS Log of Transaction field "RTN","BPSOS57",10,0) N RXI "RTN","BPSOS57",11,0) S RXI=$$RXI "RTN","BPSOS57",12,0) I 'RXI Q "" "RTN","BPSOS57",13,0) Q $$RXAPI1^BPSUTIL1(RXI,6,"I") ; Given IEN57, return DRGDFN "RTN","BPSOS57",14,0) DRGNAME() ; EP - BPS Log of Transaction field "RTN","BPSOS57",15,0) N RXI "RTN","BPSOS57",16,0) S RXI=$$RXI "RTN","BPSOS57",17,0) I 'RXI Q "" "RTN","BPSOS57",18,0) Q $$RXAPI1^BPSUTIL1(RXI,6,"E") ; Given IEN57, return DRGNAME "RTN","BPSOS57",19,0) RELDATE() ;EP - BPS Log of Transaction field "RTN","BPSOS57",20,0) N RXI,RXR "RTN","BPSOS57",21,0) S RXI=$$RXI,RXR=$$RXR "RTN","BPSOS57",22,0) I 'RXI Q "" "RTN","BPSOS57",23,0) I RXR Q $$REFAPI1^BPSUTIL1(RXI,RXR,17,"I") "RTN","BPSOS57",24,0) Q $$RXAPI1^BPSUTIL1(RXI,31,"I") "RTN","BPSOS57",25,0) RXI() Q $P(^BPSTL(IEN57,1),U,11) ; Given IEN57, return RXI "RTN","BPSOS57",26,0) RXR() Q $P(^BPSTL(IEN57,1),U,1) ; Given IEN57, return RXR "RTN","BPSOS57",27,0) NDC() Q $P(^BPSTL(IEN57,1),U,2) "RTN","BPSOS57",28,0) QTY() Q $P(^BPSTL(IEN57,5),U) ; Given IEN57, return quantity "RTN","BPSOS57",29,0) AMT() Q $P(^BPSTL(IEN57,5),U,5) ; return total $amount "RTN","BPSOS57",30,0) CHG() Q $P(^BPSTL(IEN57,5),U,5) ; Given IEN57, ret total charge "RTN","BPSOS57",31,0) INSIEN() Q $P(^BPSTL(IEN57,1),U,6) "RTN","BPSOS57",32,0) PATIENT() Q $P(^BPSTL(IEN57,0),U,6) "RTN","BPSOS57",33,0) HRN() ; Health record number and facility abbreviation "RTN","BPSOS57",34,0) ; Called by BPS Log of Transaction field "RTN","BPSOS57",35,0) Q 0 "RTN","BPSOS57",36,0) USER() N X S X=$P(^BPSTL(IEN57,0),U,10) S:'X X=$G(DUZ) Q X "RTN","BPSOS57",37,0) NOW() N %,%H,%I,X D NOW^%DTC Q % "RTN","BPSOS57",38,0) ISREVERS(N) ;EP - BPSOSIY "RTN","BPSOS57",39,0) ; Returns reversal claim #, else false "RTN","BPSOS57",40,0) N X S X=$G(^BPSTL(N,4)) Q:X="" 0 "RTN","BPSOS57",41,0) I X Q $P(X,U) ; reversal of electronic claim "RTN","BPSOS57",42,0) Q 0 "RTN","BPSOS57",43,0) REVACC(N) ;EP - BPSOSIY "RTN","BPSOS57",44,0) ; was this an accepted reversal? return true or false "RTN","BPSOS57",45,0) ; Treat Duplicate of Accepted Reversal ("S") as accepted "RTN","BPSOS57",46,0) N X "RTN","BPSOS57",47,0) S X=$$REVRESP(N) "RTN","BPSOS57",48,0) Q X="A"!(X="S") "RTN","BPSOS57",49,0) REVRESP(N) ; "RTN","BPSOS57",50,0) N RESP S RESP=$P(^BPSTL(N,4),U,2) "RTN","BPSOS57",51,0) I 'RESP Q "?" "RTN","BPSOS57",52,0) N X S X=$$RESP500^BPSOSQ4(RESP,"I") "RTN","BPSOS57",53,0) Q X ; Should be "A" or "R" - can be "S" (Duplicate of Accepted Reversal) "RTN","BPSOS57",54,0) ; "RTN","BPSOS57",55,0) POSITION() ; return pointer to position within claim (D1) "RTN","BPSOS57",56,0) Q $P($G(^BPSTL(IEN57,0)),U,9) "RTN","BPSOS57",57,0) IEN02() ; return pointer to claim "RTN","BPSOS57",58,0) Q $P($G(^BPSTL(IEN57,0)),U,4) "RTN","BPSOS57",59,0) IEN03() ; return pointer to response "RTN","BPSOS57",60,0) Q $P($G(^BPSTL(IEN57,0)),U,5) "RTN","BPSOS57",61,0) REVIEN02() ; return pointer to reversal claim "RTN","BPSOS57",62,0) Q $P($G(^BPSTL(IEN57,4)),U) "RTN","BPSOS57",63,0) REVIEN03() ; return pointer to reversal response "RTN","BPSOS57",64,0) Q $P($G(^BPSTL(IEN57,4)),U,2) "RTN","BPSOS57",65,0) FIELD(F,REV) ; EP - BPS Log of Transaction fields "RTN","BPSOS57",66,0) ; Retrieve field F from claim or response - Given IEN57 "RTN","BPSOS57",67,0) ; Returns value "RTN","BPSOS57",68,0) ; Special for reject codes: F=511 gets ","-delimited string of codes "RTN","BPSOS57",69,0) ; F=511.01 gets first code, F=511.02 gets second one, etc. "RTN","BPSOS57",70,0) N X,IEN02,IEN03,POS,IEN57 S IEN57=D0 "RTN","BPSOS57",71,0) S POS=$$POSITION,IEN02=$$IEN02,IEN03=$$IEN03 "RTN","BPSOS57",72,0) I $G(REV) S IEN02=$$REVIEN02,IEN03=$$REVIEN03 "RTN","BPSOS57",73,0) ; "RTN","BPSOS57",74,0) ; Validate IENs "RTN","BPSOS57",75,0) I 'IEN02 Q "" "RTN","BPSOS57",76,0) I 'POS,F=308!(F>400) Q "" "RTN","BPSOS57",77,0) I 'IEN03,F>500 Q "" "RTN","BPSOS57",78,0) ; "RTN","BPSOS57",79,0) ; Get Data "RTN","BPSOS57",80,0) I F<400,F'=308 S X=$$GET1^DIQ(9002313.02,IEN02_",",F,"I") "RTN","BPSOS57",81,0) E I F=308!(F>400&(F<500)) S X=$$GET1^DIQ(9002313.0201,POS_","_IEN02_",",F,"I") "RTN","BPSOS57",82,0) E I F=501!(F=524) S X=$$GET1^DIQ(9002313.03,IEN03_",",F,"I") "RTN","BPSOS57",83,0) E I F\1=511 D REJCODES S:F#1 X=$G(X(F#1*100)) "RTN","BPSOS57",84,0) E S X=$$GET1^DIQ(9002313.0301,POS_","_IEN03_",",F,"I") "RTN","BPSOS57",85,0) ; "RTN","BPSOS57",86,0) ; Do format conversions "RTN","BPSOS57",87,0) F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1) "RTN","BPSOS57",88,0) D STRIPID ; strip field ID, if any "RTN","BPSOS57",89,0) D MONEY ; money fields, where appropriate "RTN","BPSOS57",90,0) D OTHER ; other special conversions "RTN","BPSOS57",91,0) Q X "RTN","BPSOS57",92,0) ; "RTN","BPSOS57",93,0) REJCODES ; rejection codes for IEN03 "RTN","BPSOS57",94,0) ; X = ","-delimited string of two-char codes "RTN","BPSOS57",95,0) ; X(j)=code_" "_description "RTN","BPSOS57",96,0) K X S X="" "RTN","BPSOS57",97,0) N I,J S (I,J)=0 "RTN","BPSOS57",98,0) F S I=$O(^BPSR(IEN03,1000,POS,511,I)) Q:'I D "RTN","BPSOS57",99,0) . N A S A=$P(^BPSR(IEN03,1000,POS,511,I,0),U) Q:'A "RTN","BPSOS57",100,0) . S A=$O(^BPSF(9002313.93,"B",A,0)) Q:'A "RTN","BPSOS57",101,0) . S A=^BPSF(9002313.93,A,0) "RTN","BPSOS57",102,0) . S:X]"" X=X_"," S X=X_$P(A,U) "RTN","BPSOS57",103,0) . S J=J+1,X(J)=$P(A,U)_" "_$P(A,U,2) "RTN","BPSOS57",104,0) Q "RTN","BPSOS57",105,0) ; "RTN","BPSOS57",106,0) STRIPID ; some fields have two-character field ID "RTN","BPSOS57",107,0) ; and first eliminate all those that don't: "RTN","BPSOS57",108,0) Q:F<307 Q:F=308 "RTN","BPSOS57",109,0) I F>400,F<500 Q:F<410 Q:F=411 Q:F=414 Q:F=415 Q:F=419 Q:F=420 Q:F=426 "RTN","BPSOS57",110,0) ;IHS/DSD/lwj 10/02 nxt line changed on behalf of David Slauenwhite "RTN","BPSOS57",111,0) I F>500 Q:F<512 Q:F=525 Q:F=526 ;DS 10/11/01 "RTN","BPSOS57",112,0) S X=$E(X,3,$L(X)) "RTN","BPSOS57",113,0) Q "RTN","BPSOS57",114,0) MONEY ; some fields are money fields in signed overpunch format "RTN","BPSOS57",115,0) Q:F<400 "RTN","BPSOS57",116,0) ;IHS/DSD/lwj 10/02 nxt line changed on behalf of David Slauenwhite "RTN","BPSOS57",117,0) I F>400,F<500 I F'=409,F'=410,F'=426,F'=430,F'=431,F'=433,F'=438,F'=428,F'=412 Q "RTN","BPSOS57",118,0) I F>500 Q:F<505 Q:F=510 Q:F\1=511 Q:F=522 Q:F>523 "RTN","BPSOS57",119,0) S X=+$$DFF2EXT^BPSECFM(X) "RTN","BPSOS57",120,0) I X=0 S X="" ; so [CAPTIONED] doesn't print it "RTN","BPSOS57",121,0) Q "RTN","BPSOS57",122,0) OTHER ; other special conversions "RTN","BPSOS57",123,0) I F=442 S X=X/1000 Q ; metric decimal quantity "RTN","BPSOS57",124,0) Q "RTN","BPSOSC2") 0^68^B59488348 "RTN","BPSOSC2",1,0) BPSOSC2 ;BHAM ISC/FCS/DRS - Certification testing ;06/01/2004 "RTN","BPSOSC2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10**;JUN 2004;Build 27 "RTN","BPSOSC2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSC2",4,0) ; "RTN","BPSOSC2",5,0) Q "RTN","BPSOSC2",6,0) ; SETBPS - Overwrite BPS array with values from BPS Certification file "RTN","BPSOSC2",7,0) ; Input "RTN","BPSOSC2",8,0) ; ENTRY - IEN for BPS Certification (#9002313.31) "RTN","BPSOSC2",9,0) ; Output "RTN","BPSOSC2",10,0) ; BPS Array - This is newed in BPSOSCA and is shared by all BPSOSC* routines "RTN","BPSOSC2",11,0) ; and others "RTN","BPSOSC2",12,0) SETBPS(ENTRY) ; "RTN","BPSOSC2",13,0) ; "RTN","BPSOSC2",14,0) I $G(ENTRY)="" Q "RTN","BPSOSC2",15,0) ; "RTN","BPSOSC2",16,0) ; Initialize some variables "RTN","BPSOSC2",17,0) N A,B,N,X,DUR,FIELD,CNT,CNT2 "RTN","BPSOSC2",18,0) ; "RTN","BPSOSC2",19,0) ; If there is a payer in the Certification File, reset transaction header "RTN","BPSOSC2",20,0) ; values based on this payer sheet "RTN","BPSOSC2",21,0) I $P(^BPS(9002313.31,ENTRY,0),"^",4) D "RTN","BPSOSC2",22,0) . S BPS("NCPDP","IEN")=$P(^BPS(9002313.31,ENTRY,0),"^",4) "RTN","BPSOSC2",23,0) . S BPS("NCPDP","Version")=$P($G(^BPSF(9002313.92,BPS("NCPDP","IEN"),1)),U,2) "RTN","BPSOSC2",24,0) ; "RTN","BPSOSC2",25,0) ; Get the Maximum claims per transmission "RTN","BPSOSC2",26,0) S BPS("NCPDP","# Meds/Claim")=+$P($G(^BPS(9002313.31,ENTRY,0)),U,6) "RTN","BPSOSC2",27,0) I BPS("NCPDP","# Meds/Claim")=0 S BPS("NCPDP","# Meds/Claim")=1 "RTN","BPSOSC2",28,0) ; "RTN","BPSOSC2",29,0) ; Loop through claim header fields "RTN","BPSOSC2",30,0) S A=0,N=1 "RTN","BPSOSC2",31,0) F S A=$O(^BPS(9002313.31,ENTRY,1,A)) Q:'A D "RTN","BPSOSC2",32,0) . S X=^BPS(9002313.31,ENTRY,1,A,0) "RTN","BPSOSC2",33,0) . S FIELD=$P(^BPSF(9002313.91,$P(X,U),0),U) "RTN","BPSOSC2",34,0) . D SETBPS1(FIELD,$P(X,U,2)) "RTN","BPSOSC2",35,0) ; "RTN","BPSOSC2",36,0) ; Loop through prescription fields "RTN","BPSOSC2",37,0) ; Set variable DUR for first DUR record "RTN","BPSOSC2",38,0) S N=0,DUR=1 "RTN","BPSOSC2",39,0) F S N=$O(^BPS(9002313.31,ENTRY,2,N)) Q:'N D "RTN","BPSOSC2",40,0) . S A=0 "RTN","BPSOSC2",41,0) . F S A=$O(^BPS(9002313.31,ENTRY,2,N,1,A)) Q:'A D "RTN","BPSOSC2",42,0) .. S X=^BPS(9002313.31,ENTRY,2,N,1,A,0) "RTN","BPSOSC2",43,0) .. S FIELD=$P(^BPSF(9002313.91,$P(X,U),0),U) "RTN","BPSOSC2",44,0) .. D SETBPS1(FIELD,$P(X,U,2),N) "RTN","BPSOSC2",45,0) . ; "RTN","BPSOSC2",46,0) . ; Submission Clarification Codes "RTN","BPSOSC2",47,0) . K BPS("RX",N,"Submission Clarif Code") "RTN","BPSOSC2",48,0) . S A=0,CNT=0 "RTN","BPSOSC2",49,0) . F S A=$O(^BPS(9002313.31,ENTRY,2,N,2,A)) Q:'A D "RTN","BPSOSC2",50,0) .. S X=^BPS(9002313.31,ENTRY,2,N,2,A,0) "RTN","BPSOSC2",51,0) .. I X]"" S CNT=CNT+1,BPS("RX",N,"Submission Clarif Code",CNT)=X "RTN","BPSOSC2",52,0) . ; "RTN","BPSOSC2",53,0) . ; Other Amount Claimed "RTN","BPSOSC2",54,0) . K BPS("Insurer","Other Amt Qual") "RTN","BPSOSC2",55,0) . S A=0,CNT=0 "RTN","BPSOSC2",56,0) . F S A=$O(^BPS(9002313.31,ENTRY,2,N,4,A)) Q:'A D "RTN","BPSOSC2",57,0) .. S X=^BPS(9002313.31,ENTRY,2,N,4,A,0) "RTN","BPSOSC2",58,0) .. I X]"" D "RTN","BPSOSC2",59,0) ... S CNT=CNT+1 "RTN","BPSOSC2",60,0) ... S BPS("Insurer","Other Amt Value",CNT)=$P(X,U,1) "RTN","BPSOSC2",61,0) ... S BPS("Insurer","Other Amt Qual",CNT)=$P(X,U,2) "RTN","BPSOSC2",62,0) . ; "RTN","BPSOSC2",63,0) . ; COB data "RTN","BPSOSC2",64,0) . K BPS("RX",N,"OTHER PAYER") "RTN","BPSOSC2",65,0) . S A=0,CNT=0 "RTN","BPSOSC2",66,0) . F S A=$O(^BPS(9002313.31,ENTRY,2,N,3,A)) Q:'A D "RTN","BPSOSC2",67,0) .. S CNT=CNT+1 "RTN","BPSOSC2",68,0) .. S BPS("RX",N,"OTHER PAYER",CNT,0)=$G(^BPS(9002313.31,ENTRY,2,N,3,A,0)) "RTN","BPSOSC2",69,0) .. ; Other Payer Paid Amounts "RTN","BPSOSC2",70,0) .. S B=0,CNT2=0 "RTN","BPSOSC2",71,0) .. F S B=$O(^BPS(9002313.31,ENTRY,2,N,3,A,1,B)) Q:'B D "RTN","BPSOSC2",72,0) ... S CNT2=CNT2+1 "RTN","BPSOSC2",73,0) ... S BPS("RX",N,"OTHER PAYER",CNT,"P",CNT2,0)=$G(^BPS(9002313.31,ENTRY,2,N,3,A,1,B,0)) "RTN","BPSOSC2",74,0) .. I CNT2'=0 S $P(BPS("RX",N,"OTHER PAYER",CNT,0),U,6)=CNT2 "RTN","BPSOSC2",75,0) .. ; Other Payer Reject Codes "RTN","BPSOSC2",76,0) .. S B=0,CNT2=0 "RTN","BPSOSC2",77,0) .. F S B=$O(^BPS(9002313.31,ENTRY,2,N,3,A,2,B)) Q:'B D "RTN","BPSOSC2",78,0) ... S CNT2=CNT2+1 "RTN","BPSOSC2",79,0) ... S BPS("RX",N,"OTHER PAYER",CNT,"R",CNT2,0)=$G(^BPS(9002313.31,ENTRY,2,N,3,A,2,B,0)) "RTN","BPSOSC2",80,0) .. I CNT2'=0 S $P(BPS("RX",N,"OTHER PAYER",CNT,0),U,7)=CNT2 "RTN","BPSOSC2",81,0) .. ; Other Payer-Patient Paid Amounts "RTN","BPSOSC2",82,0) .. S B=0,CNT2=0 "RTN","BPSOSC2",83,0) .. F S B=$O(^BPS(9002313.31,ENTRY,2,N,3,A,3,B)) Q:'B D "RTN","BPSOSC2",84,0) ... S CNT2=CNT2+1 "RTN","BPSOSC2",85,0) ... S BPS("RX",N,"OTHER PAYER",CNT,"PP",CNT2,0)=$G(^BPS(9002313.31,ENTRY,2,N,3,A,3,B,0)) "RTN","BPSOSC2",86,0) .. I CNT2'=0 S $P(BPS("RX",N,"OTHER PAYER",CNT,0),U,8)=CNT2 "RTN","BPSOSC2",87,0) .. ; Benefit Stages "RTN","BPSOSC2",88,0) .. S B=0,CNT2=0 "RTN","BPSOSC2",89,0) .. F S B=$O(^BPS(9002313.31,ENTRY,2,N,3,A,4,B)) Q:'B D "RTN","BPSOSC2",90,0) ... S CNT2=CNT2+1 "RTN","BPSOSC2",91,0) ... S BPS("RX",N,"OTHER PAYER",CNT,"BS",CNT2,0)=$G(^BPS(9002313.31,ENTRY,2,N,3,A,4,B,0)) "RTN","BPSOSC2",92,0) .. I CNT2'=0 S $P(BPS("RX",N,"OTHER PAYER",CNT,0),U,9)=CNT2 "RTN","BPSOSC2",93,0) . S BPS("RX",N,"OTHER PAYER",0)=CNT "RTN","BPSOSC2",94,0) ; "RTN","BPSOSC2",95,0) ; Construct a few other fields that weren't already set "RTN","BPSOSC2",96,0) ; Patient Name is needed by BPSOSCE "RTN","BPSOSC2",97,0) S BPS("Patient","Name")=$G(BPS("Patient","Last Name"))_","_$G(BPS("Patient","First Name")) "RTN","BPSOSC2",98,0) Q "RTN","BPSOSC2",99,0) ; "RTN","BPSOSC2",100,0) ; Overwrite BPS array values "RTN","BPSOSC2",101,0) SETBPS1(FIELD,VALUE,N) ; "RTN","BPSOSC2",102,0) N OK S OK=0 "RTN","BPSOSC2",103,0) N I F I=1:1 Q:$T(TABLE+I)[";;*" D Q:OK "RTN","BPSOSC2",104,0) . N X S X=$T(TABLE+I) "RTN","BPSOSC2",105,0) . I $P(X,";",3)'=FIELD Q "RTN","BPSOSC2",106,0) . S @("BPS("_$P(X,";",4)_")=VALUE") "RTN","BPSOSC2",107,0) . S OK=1 "RTN","BPSOSC2",108,0) Q "RTN","BPSOSC2",109,0) ; "RTN","BPSOSC2",110,0) TABLE ;; "RTN","BPSOSC2",111,0) ;;101;"NCPDP","BIN Number" "RTN","BPSOSC2",112,0) ;;102;"NCPDP","Version" "RTN","BPSOSC2",113,0) ;;103;"Transaction Code" "RTN","BPSOSC2",114,0) ;;104;"NCPDP","PCN" "RTN","BPSOSC2",115,0) ;;109;"Transaction Count" "RTN","BPSOSC2",116,0) ;;110;"NCPDP","Software Vendor/Cert ID" "RTN","BPSOSC2",117,0) ;;115;"Insurer","Medicaid ID Number" "RTN","BPSOSC2",118,0) ;;201;"Site","NPI" "RTN","BPSOSC2",119,0) ;;202;"Service Provider ID Qual" "RTN","BPSOSC2",120,0) ;;301;"Insurer","Group #" "RTN","BPSOSC2",121,0) ;;302;"Insurer","Policy #" "RTN","BPSOSC2",122,0) ;;303;"Insurer","Person Code" "RTN","BPSOSC2",123,0) ;;304;"Patient","DOB" "RTN","BPSOSC2",124,0) ;;305;"Patient","Sex" "RTN","BPSOSC2",125,0) ;;306;"Insurer","Relationship" "RTN","BPSOSC2",126,0) ;;307;"Patient","Place of Service" "RTN","BPSOSC2",127,0) ;;308;"Patient","Other Coverage Code" "RTN","BPSOSC2",128,0) ;;309;"Insurer","Eligibility Clarification Code" "RTN","BPSOSC2",129,0) ;;310;"Patient","First Name" "RTN","BPSOSC2",130,0) ;;311;"Patient","Last Name" "RTN","BPSOSC2",131,0) ;;312;"Cardholder","First Name" "RTN","BPSOSC2",132,0) ;;313;"Cardholder","Last Name" "RTN","BPSOSC2",133,0) ;;314;"Home Plan" "RTN","BPSOSC2",134,0) ;;322;"Patient","Street Address" "RTN","BPSOSC2",135,0) ;;323;"Patient","City" "RTN","BPSOSC2",136,0) ;;324;"Patient","State" "RTN","BPSOSC2",137,0) ;;325;"Patient","Zip" "RTN","BPSOSC2",138,0) ;;326;"Patient","Phone #" "RTN","BPSOSC2",139,0) ;;331;"Patient","Patient ID Qualifier" "RTN","BPSOSC2",140,0) ;;332;"Patient","SSN" "RTN","BPSOSC2",141,0) ;;344;"RX",N,"Quantity Intended" "RTN","BPSOSC2",142,0) ;;345;"RX",N,"Days Supply Intended" "RTN","BPSOSC2",143,0) ;;350;"Patient","Patient E-Mail Address" "RTN","BPSOSC2",144,0) ;;357;"Claim",N,"Delay Reason Code" "RTN","BPSOSC2",145,0) ;;359;"Insurer","Medigap ID" "RTN","BPSOSC2",146,0) ;;360;"Insurer","Medigap Indicator" "RTN","BPSOSC2",147,0) ;;361;"Insurer","Provider Accept Assign Ind" "RTN","BPSOSC2",148,0) ;;364;"RX",N,"Prescriber First Name" "RTN","BPSOSC2",149,0) ;;365;"RX",N,"Prescriber Street Address" "RTN","BPSOSC2",150,0) ;;366;"RX",N,"Prescriber City Address" "RTN","BPSOSC2",151,0) ;;367;"RX",N,"Prescriber State/Province Address" "RTN","BPSOSC2",152,0) ;;368;"RX",N,"Prescriber Zip/Postal Zone" "RTN","BPSOSC2",153,0) ;;384;"Patient","Patient Residence" "RTN","BPSOSC2",154,0) ;;391;"Claim",N,"Patient Assignment Indicator" "RTN","BPSOSC2",155,0) ;;401;"RX",N,"Date Filled" "RTN","BPSOSC2",156,0) ;;402;"RX",N,"RX IEN" "RTN","BPSOSC2",157,0) ;;403;"RX",N,"Refill #" "RTN","BPSOSC2",158,0) ;;405;"RX",N,"Days Supply" "RTN","BPSOSC2",159,0) ;;406;"RX",N,"Compound Code" "RTN","BPSOSC2",160,0) ;;407;"RX",N,"NDC" "RTN","BPSOSC2",161,0) ;;408;"RX",N,"DAW" "RTN","BPSOSC2",162,0) ;;409;"RX",N,"Gross Amount Due" "RTN","BPSOSC2",163,0) ;;411;"RX",N,"Prescriber NPI" "RTN","BPSOSC2",164,0) ;;412;"RX",N,"Dispensing Fee" "RTN","BPSOSC2",165,0) ;;414;"RX",N,"Date Written" "RTN","BPSOSC2",166,0) ;;415;"RX",N,"# Refills" "RTN","BPSOSC2",167,0) ;;418;"RX",N,"Level of Service" "RTN","BPSOSC2",168,0) ;;419;"RX",N,"Origin Code" "RTN","BPSOSC2",169,0) ;;421;"RX",N,"Primary Care Provider NPI" "RTN","BPSOSC2",170,0) ;;423;"RX",N,"Basis of Cost Determination" "RTN","BPSOSC2",171,0) ;;424;"RX",N,"Diagnosis Code" "RTN","BPSOSC2",172,0) ;;426;"RX",N,"Usual & Customary" "RTN","BPSOSC2",173,0) ;;427;"RX",N,"Prescriber Last Name" "RTN","BPSOSC2",174,0) ;;429;"RX",N,"Unit Dose Indicator" "RTN","BPSOSC2",175,0) ;;430;"RX",N,"Gross Amount Due" "RTN","BPSOSC2",176,0) ;;433;"RX",N,"Patient Paid Amount" "RTN","BPSOSC2",177,0) ;;436;"RX",N,"Alt. Product Type" "RTN","BPSOSC2",178,0) ;;438;"RX",N,"Incentive Amount" "RTN","BPSOSC2",179,0) ;;439;"RX",N,"DUR",DUR,439 "RTN","BPSOSC2",180,0) ;;440;"RX",N,"DUR",DUR,440 "RTN","BPSOSC2",181,0) ;;441;"RX",N,"DUR",DUR,441 "RTN","BPSOSC2",182,0) ;;442;"RX",N,"Quantity" "RTN","BPSOSC2",183,0) ;;444;"RX",N,"Provider NPI" "RTN","BPSOSC2",184,0) ;;445;"Claim",N,"Original Product Code" "RTN","BPSOSC2",185,0) ;;453;"Claim",N,"Original Product ID Qual" "RTN","BPSOSC2",186,0) ;;455;"RX",N,"Rx/Service Ref Num Qual" "RTN","BPSOSC2",187,0) ;;460;"RX",N,"Quantity Prescribed" "RTN","BPSOSC2",188,0) ;;461;"Claim",N,"Prior Auth Type" "RTN","BPSOSC2",189,0) ;;462;"Claim",N,"Prior Auth Num Sub" "RTN","BPSOSC2",190,0) ;;463;"Claim",N,"Intermediary Auth Type ID" "RTN","BPSOSC2",191,0) ;;464;"Claim",N,"Intermediary Auth ID" "RTN","BPSOSC2",192,0) ;;465;"RX",N,"Provider ID Qualifier" "RTN","BPSOSC2",193,0) ;;466;"RX",N,"Prescriber ID Qualifier" "RTN","BPSOSC2",194,0) ;;467;"RX",N,"Prescriber Billing Location" "RTN","BPSOSC2",195,0) ;;468;"RX",N,"Primary Care Prov ID Qual" "RTN","BPSOSC2",196,0) ;;469;"Patient","Primary Care Prov Location Code" "RTN","BPSOSC2",197,0) ;;470;"RX",N,"Primary Care Prov Last Name" "RTN","BPSOSC2",198,0) ;;473;"RX",N,"DUR",DUR,473 "RTN","BPSOSC2",199,0) ;;474;"RX",N,"DUR",DUR,474 "RTN","BPSOSC2",200,0) ;;475;"RX",N,"DUR",DUR,475 "RTN","BPSOSC2",201,0) ;;476;"RX",N,"DUR",DUR,476 "RTN","BPSOSC2",202,0) ;;481;"Insurer","Flat Sales Tax Amt Sub" "RTN","BPSOSC2",203,0) ;;482;"Insurer","Percentage Sales Tax Amt Sub" "RTN","BPSOSC2",204,0) ;;483;"Insurer","Percent Sales Tax Rate Sub" "RTN","BPSOSC2",205,0) ;;484;"Insurer","Percent Sales Tax Basis Sub" "RTN","BPSOSC2",206,0) ;;498;"RX",N,"Prescriber Phone #" "RTN","BPSOSC2",207,0) ;;524;"Insurer","Plan ID" "RTN","BPSOSC2",208,0) ;;600;"RX",N,"Unit of Measure" "RTN","BPSOSC2",209,0) ;;* "RTN","BPSOSCA") 0^57^B9122453 "RTN","BPSOSCA",1,0) BPSOSCA ;BHAM ISC/FCS/DRS - Create BPS Claims entries ;06/01/2004 "RTN","BPSOSCA",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOSCA",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSCA",4,0) ; "RTN","BPSOSCA",5,0) Q "RTN","BPSOSCA",6,0) ; Create BPS Claims entries for TRANLIST(*) claims. "RTN","BPSOSCA",7,0) ; Called from PACKET^BPSOSQG "RTN","BPSOSCA",8,0) ; "RTN","BPSOSCA",9,0) ; Input: "RTN","BPSOSCA",10,0) ; TRANLIST(IEN59) - Array of pointers to 9002313.59 "RTN","BPSOSCA",11,0) ; A list of transactions for the same visit/patient/etc. "RTN","BPSOSCA",12,0) ; to be bundled into one or more 9002313.02 claims "RTN","BPSOSCA",13,0) ; "RTN","BPSOSCA",14,0) ; Outputs: "RTN","BPSOSCA",15,0) ; CLAIMIEN(CLAIMIEN)="", pointers to the ^BPSC(CLAIMIEN, "RTN","BPSOSCA",16,0) ; claim records created. "RTN","BPSOSCA",17,0) ; ERROR "RTN","BPSOSCA",18,0) ; "RTN","BPSOSCA",19,0) ; BPSOSCA calls: "RTN","BPSOSCA",20,0) ; BPSOSCB to build BPS(*) array "RTN","BPSOSCA",21,0) ; (and BPSOSCB calls BPSOSCC and BPSOSCD) "RTN","BPSOSCA",22,0) ; BPSOSCE to build the ^BPSC( entry "RTN","BPSOSCA",23,0) ; "RTN","BPSOSCA",24,0) EN(CLAIMIEN) ;EP - from BPSOSQG "RTN","BPSOSCA",25,0) I $D(TRANLIST)<10 D Q "306^No TRANLIST defined" "RTN","BPSOSCA",26,0) . N RETVAL S RETVAL=$$IMPOSS^BPSOSUE("P","TI","Bad TRANLIST",,,$T(+0)) "RTN","BPSOSCA",27,0) . D LOG2LIST^BPSOSL($T(+0)_"-No TRANLIST passed into BPSOSCA") "RTN","BPSOSCA",28,0) ; "RTN","BPSOSCA",29,0) ; Manage local variables "RTN","BPSOSCA",30,0) N BPS,START,END,TOTAL,NCLAIMS,CLAIMN,ERROR "RTN","BPSOSCA",31,0) S ERROR=$$BPS^BPSOSCB() "RTN","BPSOSCA",32,0) I ERROR D LOG2LIST^BPSOSL($T(+0)_"-$$BPS^BPSOSCB(.BPS) returned "_ERROR) "RTN","BPSOSCA",33,0) I $G(BPS("RX",0))="" S:'ERROR ERROR="301^BPS(""RX"" not created" Q ERROR "RTN","BPSOSCA",34,0) I $G(BPS("NCPDP","# Meds/Claim"))="" Q "302^Number of Meds not returned" "RTN","BPSOSCA",35,0) ; "RTN","BPSOSCA",36,0) ; Calculate number of claim records to be generated for Billing Item "RTN","BPSOSCA",37,0) S NCLAIMS=((BPS("RX",0)-1)\BPS("NCPDP","# Meds/Claim"))+1 "RTN","BPSOSCA",38,0) I NCLAIMS=0 Q "303^Number of claims is zero" "RTN","BPSOSCA",39,0) ; "RTN","BPSOSCA",40,0) ;Generate claim submission records "RTN","BPSOSCA",41,0) F CLAIMN=1:1:NCLAIMS D Q:$G(ERROR) "RTN","BPSOSCA",42,0) . S START=((CLAIMN-1)*BPS("NCPDP","# Meds/Claim"))+1 "RTN","BPSOSCA",43,0) . S END=START+BPS("NCPDP","# Meds/Claim")-1 "RTN","BPSOSCA",44,0) . S:END>BPS("RX",0) END=BPS("RX",0) "RTN","BPSOSCA",45,0) . S TOTAL=END-START+1 "RTN","BPSOSCA",46,0) . S ERROR=$$NEWCLAIM^BPSOSCE(START,END,TOTAL) "RTN","BPSOSCA",47,0) . I ERROR]"" Q "RTN","BPSOSCA",48,0) . S CLAIMIEN=BPS(9002313.02) "RTN","BPSOSCA",49,0) . S CLAIMIEN(CLAIMIEN)="" "RTN","BPSOSCA",50,0) . ; Mark each of the .59s with the claim number and position within "RTN","BPSOSCA",51,0) . F I=START:1:END D "RTN","BPSOSCA",52,0) .. ; "RTN","BPSOSCA",53,0) .. ; IEN59 handling 06/23/2000. The ELSE should never happen again. "RTN","BPSOSCA",54,0) .. ; and the $G() can probably be gotten rid of, safely. "RTN","BPSOSCA",55,0) .. N IEN59 S IEN59=$G(BPS("RX",I,"IEN59")) "RTN","BPSOSCA",56,0) .. I IEN59 D "RTN","BPSOSCA",57,0) ... N DIE,DA,DR S DIE=9002313.59 "RTN","BPSOSCA",58,0) ... ; "RTN","BPSOSCA",59,0) ... ; Field #3-CLAIM, #14-POSITION "RTN","BPSOSCA",60,0) ... ; POSITION: Not the relative position within the packet, "RTN","BPSOSCA",61,0) ... ; but the index in BPS("RX",n,.... This is the position in which "RTN","BPSOSCA",62,0) ... ; it will be stored in ^BPSC(ien,400,POSITION "RTN","BPSOSCA",63,0) ... ; and likewise for 9002313.03 when the response comes in. "RTN","BPSOSCA",64,0) ... S DA=IEN59,DR=3_"////"_CLAIMIEN_";14////"_I N I D ^DIE "RTN","BPSOSCA",65,0) .. E D "RTN","BPSOSCA",66,0) ... S $P(^BPST(BPS("RX",I,"RX IEN"),0),"^",4)=CLAIMIEN "RTN","BPSOSCA",67,0) ... S ^BPST("AE",CLAIMIEN,BPS("RX",I,"RX IEN"))="" "RTN","BPSOSCA",68,0) ... S $P(^BPST(BPS("RX",I,"RX IEN"),0),"^",9)=I "RTN","BPSOSCA",69,0) Q ERROR "RTN","BPSOSCB") 0^58^B2769935 "RTN","BPSOSCB",1,0) BPSOSCB ;BHAM ISC/FCS/DRS/DLF - Prep for building BPS array ;06/01/2004 "RTN","BPSOSCB",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOSCB",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSCB",4,0) ;---------------------------------------------------------------------- "RTN","BPSOSCB",5,0) ; Called from BPSOSCA from BPSOSQG from BPSOSQ2 "RTN","BPSOSCB",6,0) ; Setup BPS() array which contains all pertinent data to create "RTN","BPSOSCB",7,0) ; claim Submission Records for the current Billing Item Record: "RTN","BPSOSCB",8,0) ; "RTN","BPSOSCB",9,0) ; Input: "RTN","BPSOSCB",10,0) ; TRANLIST needs to be defined - List of Transactions "RTN","BPSOSCB",11,0) ; Returns "RTN","BPSOSCB",12,0) ; BPS Formatted array containing data required to create claim "RTN","BPSOSCB",13,0) ; submission records. This array is shared by all BPSOSC* "RTN","BPSOSCB",14,0) ; routines and some of the BPSOSH routines as well. "RTN","BPSOSCB",15,0) ;---------------------------------------------------------------------- "RTN","BPSOSCB",16,0) ; "RTN","BPSOSCB",17,0) Q "RTN","BPSOSCB",18,0) BPS() ; "RTN","BPSOSCB",19,0) N IEN59,IEN5902,INDEX,ENTRY,VAINFO "RTN","BPSOSCB",20,0) ; "RTN","BPSOSCB",21,0) ; Set up some basic variables from first transaction "RTN","BPSOSCB",22,0) S IEN59=$O(TRANLIST("")) "RTN","BPSOSCB",23,0) I IEN59="" Q "320^BPS Transaction not found in TRANLIST" "RTN","BPSOSCB",24,0) ; "RTN","BPSOSCB",25,0) S IEN5902=$P(^BPST(IEN59,9),U,1) "RTN","BPSOSCB",26,0) I IEN5902="" Q "321^VA Insurer not determined" "RTN","BPSOSCB",27,0) ; "RTN","BPSOSCB",28,0) ; Set transaction multiple into VAINFO array and get top node of multiple "RTN","BPSOSCB",29,0) D GETS^DIQ(9002313.59,IEN59_",","902*","I","VAINFO") "RTN","BPSOSCB",30,0) ; "RTN","BPSOSCB",31,0) ; Set up BPS array for Patient, Insurer, Site and NCPDP record format data "RTN","BPSOSCB",32,0) D GETINFO^BPSOSCC(IEN59,IEN5902) "RTN","BPSOSCB",33,0) ; "RTN","BPSOSCB",34,0) ; Get transaction-level data for each transaction "RTN","BPSOSCB",35,0) S IEN59="" "RTN","BPSOSCB",36,0) F INDEX=1:1 S IEN59=$O(TRANLIST(IEN59)) Q:'IEN59 D "RTN","BPSOSCB",37,0) . S IEN5902=$P(^BPST(IEN59,9),U,1) "RTN","BPSOSCB",38,0) . D MEDINFO^BPSOSCD(IEN59,IEN5902,INDEX) "RTN","BPSOSCB",39,0) ; "RTN","BPSOSCB",40,0) ; Set up BPS("RX",0) "RTN","BPSOSCB",41,0) S BPS("RX",0)=INDEX-1 "RTN","BPSOSCB",42,0) I BPS("RX",0)=0 Q "322^No claims in TRANLIST" "RTN","BPSOSCB",43,0) ; "RTN","BPSOSCB",44,0) ; If certification, get certification overrides "RTN","BPSOSCB",45,0) S IEN59=$O(TRANLIST("")),IEN5902=$P(^BPST(IEN59,9),U,1) "RTN","BPSOSCB",46,0) S ENTRY=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",",902.23,"I") "RTN","BPSOSCB",47,0) I ENTRY,$D(^BPS(9002313.31,ENTRY)) D SETBPS^BPSOSC2(ENTRY) "RTN","BPSOSCB",48,0) ; "RTN","BPSOSCB",49,0) ; Quit with no error "RTN","BPSOSCB",50,0) Q 0 "RTN","BPSOSCC") 0^16^B25822348 "RTN","BPSOSCC",1,0) BPSOSCC ;BHAM ISC/FCS/DRS/DLF - Set up BPS() ;06/01/2004 "RTN","BPSOSCC",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,8,10**;JUN 2004;Build 27 "RTN","BPSOSCC",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSCC",4,0) ; "RTN","BPSOSCC",5,0) ; GETINFO - Create BPS array for non-repeating data "RTN","BPSOSCC",6,0) ; IEN59 - Pointer to BPS Transactions "RTN","BPSOSCC",7,0) ; IEN5902 - IEN for Insurance multiple of BPS Transactions "RTN","BPSOSCC",8,0) ; "RTN","BPSOSCC",9,0) ; BPS array is shared by all of the BPSOSC* routines, created in BPSOSCA "RTN","BPSOSCC",10,0) ; VAINFO is created in BPSOSCB "RTN","BPSOSCC",11,0) Q "RTN","BPSOSCC",12,0) ; "RTN","BPSOSCC",13,0) GETINFO(IEN59,IEN5902) ; EP - BPSOSCB "RTN","BPSOSCC",14,0) ; both parameters required "RTN","BPSOSCC",15,0) Q:$G(IEN59)="" Q:$G(IEN5902)="" "RTN","BPSOSCC",16,0) ; "RTN","BPSOSCC",17,0) N BPPAYSEQ,DFN,FLAG,IENS,NPI,SITE,VADM,VAPA,X,ADFEE "RTN","BPSOSCC",18,0) ; "RTN","BPSOSCC",19,0) S BPPAYSEQ=$$COB59^BPSUTIL2(IEN59) ; COB payer sequence "RTN","BPSOSCC",20,0) ; Setup IENS for transaction multiple "RTN","BPSOSCC",21,0) S IENS=IEN5902_","_IEN59_"," "RTN","BPSOSCC",22,0) ; Site Information "RTN","BPSOSCC",23,0) S SITE=$P($G(^BPST(IEN59,1)),U,4) "RTN","BPSOSCC",24,0) S NPI=$$NPI^BPSNPI("Pharmacy_ID",SITE) "RTN","BPSOSCC",25,0) I +NPI=-1 S NPI="" "RTN","BPSOSCC",26,0) S BPS("Site","NPI")=$P(NPI,U) "RTN","BPSOSCC",27,0) ; "RTN","BPSOSCC",28,0) ; Get Transaction Code "RTN","BPSOSCC",29,0) S BPS("Transaction Code")=$S($P($G(^BPST(IEN59,0)),U,15)="E":"E1",1:"B1") "RTN","BPSOSCC",30,0) ; "RTN","BPSOSCC",31,0) ; Transaction Header Data "RTN","BPSOSCC",32,0) S BPS("NCPDP","IEN")=$G(VAINFO(9002313.59902,IENS,$S(BPS("Transaction Code")="E1":902.34,1:902.02),"I")) "RTN","BPSOSCC",33,0) S BPS("NCPDP","BIN Number")=$G(VAINFO(9002313.59902,IENS,902.03,"I")) "RTN","BPSOSCC",34,0) S BPS("NCPDP","PCN")=$G(VAINFO(9002313.59902,IENS,902.04,"I")) "RTN","BPSOSCC",35,0) S BPS("NCPDP","Software Vendor/Cert ID")=$G(VAINFO(9002313.59902,IENS,902.18,"I")) "RTN","BPSOSCC",36,0) I BPS("NCPDP","IEN")="" D IMPOSS^BPSOSUE("P","TI","Payer Sheet pointer missing from multiple",,1,$T(+0)) "RTN","BPSOSCC",37,0) I BPS("NCPDP","IEN") S BPS("NCPDP","Version")=$P($G(^BPSF(9002313.92,BPS("NCPDP","IEN"),1)),U,2) "RTN","BPSOSCC",38,0) I $G(BPS("NCPDP","Version"))="" D IMPOSS^BPSOSUE("DB","TI","Payer sheet version missing.",,2,$T(+0)) "RTN","BPSOSCC",39,0) S BPS("NCPDP","# Meds/Claim")=$G(VAINFO(9002313.59902,IENS,902.32,"I")) "RTN","BPSOSCC",40,0) I BPS("Transaction Code")="E1"!('BPS("NCPDP","# Meds/Claim")) S BPS("NCPDP","# Meds/Claim")=1 "RTN","BPSOSCC",41,0) ; "RTN","BPSOSCC",42,0) ; Patient Data "RTN","BPSOSCC",43,0) S DFN=$P(^BPST(IEN59,0),U,6) "RTN","BPSOSCC",44,0) I 'DFN D IMPOSS^BPSOSUE("DB","TI","DFN",,,$T(+0)) "RTN","BPSOSCC",45,0) I DFN,'$D(^DPT(DFN,0)) D IMPOSS^BPSOSUE("DB","TI","^DPT(DFN)",,,$T(+0)) "RTN","BPSOSCC",46,0) D DEM^VADPT,ADD^VADPT "RTN","BPSOSCC",47,0) S BPS("Patient","IEN")=DFN "RTN","BPSOSCC",48,0) S (X,BPS("Patient","Name"))=$G(VADM(1)) "RTN","BPSOSCC",49,0) D NAMECOMP^XLFNAME(.X) "RTN","BPSOSCC",50,0) S BPS("Patient","Last Name")=$G(X("FAMILY")) "RTN","BPSOSCC",51,0) S BPS("Patient","First Name")=$G(X("GIVEN")) "RTN","BPSOSCC",52,0) S BPS("Patient","Sex")=$P($G(VADM(5)),"^",1) "RTN","BPSOSCC",53,0) S X=$P($G(VADM(3)),"^") ; date of birth, FM format "RTN","BPSOSCC",54,0) S BPS("Patient","DOB")=($E(X,1,3)+1700)_$E(X,4,7) "RTN","BPSOSCC",55,0) S BPS("Patient","SSN")=$P($G(VADM(2)),"^",1) "RTN","BPSOSCC",56,0) S BPS("Patient","State")=$P($G(VAPA(5)),"^",1) "RTN","BPSOSCC",57,0) I BPS("Patient","State")'="" S BPS("Patient","State")=$P($G(^DIC(5,BPS("Patient","State"),0)),"^",2) "RTN","BPSOSCC",58,0) S BPS("Patient","Street Address")=$G(VAPA(1)) "RTN","BPSOSCC",59,0) S BPS("Patient","City")=$G(VAPA(4)) "RTN","BPSOSCC",60,0) S BPS("Patient","Zip")=$G(VAPA(6)) "RTN","BPSOSCC",61,0) S BPS("Patient","Phone #")=$TR($P($G(VAPA(8)),"^",1),"()-/*# ") "RTN","BPSOSCC",62,0) S BPS("Patient","Place of Service")=$S($G(BPS("NCPDP","Version"))=51:0,1:1) ; NCPDP field 307-C7 default to 1 for vD.0 "RTN","BPSOSCC",63,0) S BPS("Patient","Patient Residence")=1 ; NCPDP field 384-4X, 1 for "Home" "RTN","BPSOSCC",64,0) S BPS("Patient","Patient E-Mail Address")=$$GET1^DIQ(2,DFN,.133) ; NCPDP field 350-HN "RTN","BPSOSCC",65,0) ; "RTN","BPSOSCC",66,0) ; Insurer Data "RTN","BPSOSCC",67,0) S BPS("Insurer","IEN")=$G(VAINFO(9002313.59902,IENS,.01,"I")) "RTN","BPSOSCC",68,0) S BPS("Insurer","Relationship")=$G(VAINFO(9002313.59902,IENS,902.07,"I")) "RTN","BPSOSCC",69,0) S ADFEE=+$G(VAINFO(9002313.59902,IENS,902.16,"I")) "RTN","BPSOSCC",70,0) I ADFEE'=0 D "RTN","BPSOSCC",71,0) . S BPS("Insurer","Other Amt Qual",1)="04" "RTN","BPSOSCC",72,0) . S BPS("Insurer","Other Amt Value",1)=ADFEE "RTN","BPSOSCC",73,0) S:BPS("Insurer","Relationship")="" BPS("Insurer","Relationship")=0 ; if null set to unspecified "RTN","BPSOSCC",74,0) S BPS("Patient","Primary Care Prov Location Code")=$G(VAINFO(9002313.59902,IENS,902.11,"I")) "RTN","BPSOSCC",75,0) S FLAG=BPS("Insurer","Relationship") "RTN","BPSOSCC",76,0) S BPS("Insurer","Person Code")=$S(FLAG=1:"01",FLAG=2:"02",FLAG=3:"03",1:"") "RTN","BPSOSCC",77,0) S BPS("Insurer","Plan ID")=$G(VAINFO(9002313.59902,IENS,902.24,"I")) "RTN","BPSOSCC",78,0) S BPS("Insurer","Group #")=$G(VAINFO(9002313.59902,IENS,902.05,"I")) "RTN","BPSOSCC",79,0) S BPS("Insurer","Policy #")=$G(VAINFO(9002313.59902,IENS,902.06,"I")) ;CARDHOLDER ID "RTN","BPSOSCC",80,0) S BPS("Insurer","Full Policy #")=BPS("Insurer","Policy #") "RTN","BPSOSCC",81,0) S BPS("Insurer","Percent Sales Tax Rate Sub")="" ; 483-HE Percentage Sales Tax Rate Submitted "RTN","BPSOSCC",82,0) S BPS("Insurer","Percent Sales Tax Basis Sub")="" ; 484-JE Percentage Sales Tax Basis Submitted "RTN","BPSOSCC",83,0) S BPS("Insurer","Percentage Sales Tax Amt Sub")=0 ; 482-GE Percentage Sales Tax Amount Submitted "RTN","BPSOSCC",84,0) S BPS("Insurer","Flat Sales Tax Amount Sub")=0 ; 481-HA Flat Sales Tax Amount Submitted "RTN","BPSOSCC",85,0) ; "RTN","BPSOSCC",86,0) ; Cardholder Data "RTN","BPSOSCC",87,0) S BPS("Cardholder","First Name")=$G(VAINFO(9002313.59902,IENS,902.08,"I")) "RTN","BPSOSCC",88,0) S BPS("Cardholder","Last Name")=$G(VAINFO(9002313.59902,IENS,902.09,"I")) "RTN","BPSOSCC",89,0) S BPS("Home Plan")=$G(VAINFO(9002313.59902,IENS,902.11,"I")) "RTN","BPSOSCC",90,0) ; "RTN","BPSOSCC",91,0) ; set additional fields for secondary claim "RTN","BPSOSCC",92,0) S:BPPAYSEQ>1 BPS("Patient","Other Coverage Code")=$P($G(^BPST(IEN59,12)),U,5) ; NCPDP field 308-C8 Other Coverage Code "RTN","BPSOSCC",93,0) ; "RTN","BPSOSCC",94,0) Q "RTN","BPSOSCC",95,0) ; "RTN","BPSOSCD") 0^17^B76120342 "RTN","BPSOSCD",1,0) BPSOSCD ;BHAM ISC/FCS/DRS/DLF - Set BPS() "RX" nodes for current medication ;06/01/2004 "RTN","BPSOSCD",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,2,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSCD",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSCD",4,0) ; "RTN","BPSOSCD",5,0) ; reference to $$ACPHONE^IBNCPDPI supported by DBIA 4721 "RTN","BPSOSCD",6,0) ; reference to $$MADD^XUAF4 supported by DBIA 2171 "RTN","BPSOSCD",7,0) ; reference to $$GET1^DIQ(200,field) supported by DBIA 10060 "RTN","BPSOSCD",8,0) ; reference to $$GET1^DIQ(5,field) supported by DBIA 10056 "RTN","BPSOSCD",9,0) ; reference to PSS^PSO59 supported by DBIA 4827 "RTN","BPSOSCD",10,0) ; "RTN","BPSOSCD",11,0) Q "RTN","BPSOSCD",12,0) ; "RTN","BPSOSCD",13,0) ;MEDINFO, Set BPS("RX)" nodes for current medication "RTN","BPSOSCD",14,0) ; Called from BPSOSCA for every transaction in the multiple "RTN","BPSOSCD",15,0) ; IEN59 = IEN in BPS TRANSACTION (#9002313.59) "RTN","BPSOSCD",16,0) ; IEN5902 = IEN for Insurance multiple of BPS Transactions "RTN","BPSOSCD",17,0) ; MEDN = Index number of medication being processed "RTN","BPSOSCD",18,0) ; BPS array shared by all of the BPSOSC* routines, created in BPSOSCA "RTN","BPSOSCD",19,0) ; VAINFO created in BPSOSCB "RTN","BPSOSCD",20,0) MEDINFO(IEN59,IEN5902,MEDN) ; "RTN","BPSOSCD",21,0) ; Verify Parameters "RTN","BPSOSCD",22,0) I $G(IEN59)="" Q "RTN","BPSOSCD",23,0) I $G(IEN5902)="" Q "RTN","BPSOSCD",24,0) I $G(MEDN)="" Q "RTN","BPSOSCD",25,0) ; "RTN","BPSOSCD",26,0) N %,BPS0,DRUGIEN,FILLDT,IENS,J,NDC,NPI,OSITEIEN,PRICING,PROVIEN,RTN,RXI,RXIEN,RXRFIEN,VANATURE,VAOIEN,X "RTN","BPSOSCD",27,0) ; "RTN","BPSOSCD",28,0) ;RXIEN=Rx IEN, RXRFIEN=Fill Number, IENS=FileMan style IENS "RTN","BPSOSCD",29,0) S BPS0=$G(^BPST(IEN59,1)),RXIEN=$P(BPS0,U,11),RXRFIEN=$P(BPS0,U,1),IENS=IEN5902_","_IEN59_"," "RTN","BPSOSCD",30,0) ; "RTN","BPSOSCD",31,0) S RTN=$T(+0) ; for log "RTN","BPSOSCD",32,0) ; Get any user-entered overrides stored in BPS NCPDP OVERRIDES "RTN","BPSOSCD",33,0) D OVERRIDE(IEN59,MEDN) "RTN","BPSOSCD",34,0) ; "RTN","BPSOSCD",35,0) ; Retrieve DUR values "RTN","BPSOSCD",36,0) D DURVALUE(IEN59,MEDN) "RTN","BPSOSCD",37,0) ; "RTN","BPSOSCD",38,0) ; Build COB array for secondary claims "RTN","BPSOSCD",39,0) I $$COB59^BPSUTIL2(IEN59)>1 D COB(IEN59,MEDN) "RTN","BPSOSCD",40,0) ; "RTN","BPSOSCD",41,0) ; Basic RX info "RTN","BPSOSCD",42,0) S BPS("RX",MEDN,"IEN59")=IEN59 "RTN","BPSOSCD",43,0) S BPS("RX",MEDN,"RX IEN")=RXIEN "RTN","BPSOSCD",44,0) S BPS("RX",MEDN,"RX Number")=RXIEN "RTN","BPSOSCD",45,0) ; "RTN","BPSOSCD",46,0) ; Get/format Service Date from BPS TRANSACTION, if null use $$DOSDATE^BPSSCRRS "RTN","BPSOSCD",47,0) S FILLDT=$P($G(^BPST(IEN59,12)),U,2) "RTN","BPSOSCD",48,0) ; Note that $$DOSDATE returns the current date if RXIEN and RXRIEN are null so this works "RTN","BPSOSCD",49,0) ; for Eligibility even if there is no RX/Fill. "RTN","BPSOSCD",50,0) I FILLDT="" S FILLDT=$$DOSDATE^BPSSCRRS(RXIEN,RXRFIEN) D LOG^BPSOSL(IEN59,RTN_"-Fill Date sent as "_FILLDT) "RTN","BPSOSCD",51,0) S BPS("RX",MEDN,"Date Filled")=$$FMTHL7^XLFDT(FILLDT) "RTN","BPSOSCD",52,0) ; "RTN","BPSOSCD",53,0) ; Stop if the transaction code is "E1" and there is no Prescription IEN "RTN","BPSOSCD",54,0) I BPS("Transaction Code")="E1",RXIEN="" Q "RTN","BPSOSCD",55,0) ; "RTN","BPSOSCD",56,0) ; Get Provider Info "RTN","BPSOSCD",57,0) S PROVIEN=+$$RXAPI1^BPSUTIL1(RXIEN,4,"I") "RTN","BPSOSCD",58,0) S BPS("RX",MEDN,"Prescriber IEN")=PROVIEN "RTN","BPSOSCD",59,0) I PROVIEN'="" D "RTN","BPSOSCD",60,0) .S X=$$GET1^DIQ(200,PROVIEN,.01) "RTN","BPSOSCD",61,0) .D NAMECOMP^XLFNAME(.X) "RTN","BPSOSCD",62,0) .S BPS("RX",MEDN,"Prescriber Last Name")=X("FAMILY") "RTN","BPSOSCD",63,0) .S BPS("RX",MEDN,"Prescriber First Name")=X("GIVEN") ; NCPDP field 364-2J "RTN","BPSOSCD",64,0) .S BPS("RX",MEDN,"Prescriber Phone #")=$$ACPHONE^IBNCPDPI ; DBIA 4721, Agent Cashier Phone Number "RTN","BPSOSCD",65,0) .S BPS("RX",MEDN,"Prescriber Billing Location")="" "RTN","BPSOSCD",66,0) .S NPI=$$NPI^BPSNPI("Individual_ID",+PROVIEN) "RTN","BPSOSCD",67,0) .I NPI<0 S NPI="" "RTN","BPSOSCD",68,0) .S BPS("RX",MEDN,"Prescriber NPI")=$P(NPI,U) "RTN","BPSOSCD",69,0) .S BPS("RX",MEDN,"Primary Care Provider NPI")=$P(NPI,U) "RTN","BPSOSCD",70,0) .S BPS("RX",MEDN,"Provider NPI")=$P(NPI,U) "RTN","BPSOSCD",71,0) .; "RTN","BPSOSCD",72,0) .S X=$$PRVADRS(IEN59,PROVIEN) ; provide address info "RTN","BPSOSCD",73,0) .S BPS("RX",MEDN,"Prescriber Street Address")=$P(X,U) ; NCPDP field 365-2K "RTN","BPSOSCD",74,0) .S BPS("RX",MEDN,"Prescriber City Address")=$P(X,U,2) ; NCPDP field 366-2M "RTN","BPSOSCD",75,0) .S BPS("RX",MEDN,"Prescriber State/Province Address")=$P(X,U,3) ; NCPDP field 367-2N "RTN","BPSOSCD",76,0) .S BPS("RX",MEDN,"Prescriber Zip/Postal Zone")=$TR($P(X,U,4)," -") ; NCPDP field 368-2P "RTN","BPSOSCD",77,0) ; "RTN","BPSOSCD",78,0) ; Stop if Eligibility as we do not need any of the claim data below "RTN","BPSOSCD",79,0) I BPS("Transaction Code")="E1" Q "RTN","BPSOSCD",80,0) ; "RTN","BPSOSCD",81,0) ; Basic Prescription Info "RTN","BPSOSCD",82,0) S BPS("RX",MEDN,"Date Written")=$$RXAPI1^BPSUTIL1(RXIEN,1,"I") "RTN","BPSOSCD",83,0) S BPS("RX",MEDN,"New/Refill")=$S(RXRFIEN="":"N",1:"R") "RTN","BPSOSCD",84,0) S BPS("RX",MEDN,"# Refills")=$$RXAPI1^BPSUTIL1(RXIEN,9,"I") "RTN","BPSOSCD",85,0) S BPS("RX",MEDN,"Refill #")=+RXRFIEN "RTN","BPSOSCD",86,0) S BPS("RX",MEDN,"Pharmacy Service Type")="01" ; 147-U7 Pharmacy Service Type, 1=Community/Retail Pharmacy Services "RTN","BPSOSCD",87,0) ; "RTN","BPSOSCD",88,0) ; PreAuth and Prior Authorization "RTN","BPSOSCD",89,0) ; #1.09 Prior Authorization Number, #1.15 Prior Auth Type Code "RTN","BPSOSCD",90,0) S X=$G(^BPST(IEN59,1)) "RTN","BPSOSCD",91,0) S BPS("RX",MEDN,"Preauth #")=$P(X,U,15)_$P(X,U,9) "RTN","BPSOSCD",92,0) S BPS("Claim",MEDN,"Prior Auth Type")=$P(X,U,15) "RTN","BPSOSCD",93,0) S BPS("Claim",MEDN,"Prior Auth Num Sub")=$P(X,U,9) "RTN","BPSOSCD",94,0) ; "RTN","BPSOSCD",95,0) ; delay reason code not sent unless user specifies a code "RTN","BPSOSCD",96,0) S BPS("Claim",MEDN,"Delay Reason Code")="" ; 357-NV Delay Reason Code "RTN","BPSOSCD",97,0) ; "RTN","BPSOSCD",98,0) ; NDC = NDC number drug, try transaction 1st, if null get it from Rx/refill "RTN","BPSOSCD",99,0) S NDC=$P(^BPST(IEN59,1),U,2) "RTN","BPSOSCD",100,0) I NDC="" S NDC=$$GETNDC^PSONDCUT(RXIEN,RXRFIEN) D LOG^BPSOSL(IEN59,RTN_"-NDC sent as "_NDC) "RTN","BPSOSCD",101,0) S BPS("RX",MEDN,"NDC")=NDC "RTN","BPSOSCD",102,0) ; "RTN","BPSOSCD",103,0) ; Prescription Data dependent on original vs. refill "RTN","BPSOSCD",104,0) D:'RXRFIEN ; 1st fill "RTN","BPSOSCD",105,0) .S BPS("RX",MEDN,"Days Supply")=$$RXAPI1^BPSUTIL1(RXIEN,8,"I") "RTN","BPSOSCD",106,0) .S BPS("RX",MEDN,"DAW")=$$RXAPI1^BPSUTIL1(RXIEN,81,"I") "RTN","BPSOSCD",107,0) D:RXRFIEN ; refill "RTN","BPSOSCD",108,0) .S BPS("RX",MEDN,"Days Supply")=$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,RXRFIEN,1.1,"I") "RTN","BPSOSCD",109,0) .S BPS("RX",MEDN,"DAW")=$$RXSUBF1^BPSUTIL1(RXIEN,52,52.1,RXRFIEN,81,"I") "RTN","BPSOSCD",110,0) ; "RTN","BPSOSCD",111,0) ; Origin Code, VAOIEN=PLACER ORDER # from file 52, VANATURE=NATURE OF ORDER in sub-file 100.008 "RTN","BPSOSCD",112,0) S VAOIEN=+$$RXAPI1^BPSUTIL1(RXIEN,39.3,"I"),VANATURE=$$GET1^DIQ(100.008,"1,"_VAOIEN_",","12") "RTN","BPSOSCD",113,0) S BPS("RX",MEDN,"Origin Code")=$S(VANATURE="AUTO":2,VANATURE["ELECTRONIC":3,VANATURE="DUPLICATE":0,VANATURE["TELEPHONE":2,1:1) "RTN","BPSOSCD",114,0) ; "RTN","BPSOSCD",115,0) ; NCPDP field 420-DK Submission Clarification Code, default to "01" for vD.0, "00" for v5.1 "RTN","BPSOSCD",116,0) ; note: this is a multiple (#9002313.02354), additional codes may be added by other routines "RTN","BPSOSCD",117,0) S %=$P($G(^BPST(IEN59,12)),U,3),BPS("RX",MEDN,"Submission Clarif Code",1)=$S(%]"":%,$G(BPS("NCPDP","Version"))=51:"00",1:"01") "RTN","BPSOSCD",118,0) ; "RTN","BPSOSCD",119,0) ; Drug Info "RTN","BPSOSCD",120,0) S DRUGIEN=$$RXAPI1^BPSUTIL1(RXIEN,6,"I") "RTN","BPSOSCD",121,0) D:DRUGIEN'="" "RTN","BPSOSCD",122,0) .S BPS("RX",MEDN,"Drug IEN")=DRUGIEN "RTN","BPSOSCD",123,0) .S BPS("RX",MEDN,"Drug Name")=$$DRUGDIE^BPSUTIL1(DRUGIEN,.01,"E") "RTN","BPSOSCD",124,0) ; "RTN","BPSOSCD",125,0) ; Pricing Info "RTN","BPSOSCD",126,0) S BPS("RX",MEDN,"Alt. Product Type")="03" "RTN","BPSOSCD",127,0) S BPS("RX",MEDN,"Gross Amount Due")=$G(VAINFO(9002313.59902,IENS,902.15,"I")) "RTN","BPSOSCD",128,0) S BPS("RX",MEDN,"Usual & Customary")=$G(VAINFO(9002313.59902,IENS,902.14,"I")) "RTN","BPSOSCD",129,0) S BPS("RX",MEDN,"Basis of Cost Determination")=$G(VAINFO(9002313.59902,IENS,902.13,"I")) "RTN","BPSOSCD",130,0) ; "RTN","BPSOSCD",131,0) ; More pricing info "RTN","BPSOSCD",132,0) S PRICING=$G(^BPST(IEN59,5)) "RTN","BPSOSCD",133,0) S BPS("RX",MEDN,"Quantity")=$P(PRICING,U) ; 01/31/2001 "RTN","BPSOSCD",134,0) S BPS("RX",MEDN,"Unit Price")=$P(PRICING,U,2) "RTN","BPSOSCD",135,0) S BPS("RX",MEDN,"Ingredient Cost")=$J($P(PRICING,U,2),0,2) "RTN","BPSOSCD",136,0) S BPS("RX",MEDN,"Dispensing Fee")=$J($P(PRICING,U,4),0,2) "RTN","BPSOSCD",137,0) S BPS("Site","Dispensing Fee")=BPS("RX",MEDN,"Dispensing Fee") "RTN","BPSOSCD",138,0) S BPS("RX",MEDN,"Usual & Customary")=$P(PRICING,U,5) "RTN","BPSOSCD",139,0) S BPS("RX",MEDN,"Unit of Measure")=$P(PRICING,U,8) "RTN","BPSOSCD",140,0) S:$G(BPS("NCPDP","Add Disp. Fee to Ingr. Cost")) BPS("RX",MEDN,"Ingredient Cost")=BPS("RX",MEDN,"Ingredient Cost")+BPS("RX",MEDN,"Dispensing Fee") "RTN","BPSOSCD",141,0) ; "RTN","BPSOSCD",142,0) Q "RTN","BPSOSCD",143,0) ; "RTN","BPSOSCD",144,0) ; OVERRIDE - Retrieve OVERRIDE nodes and put into BPS array "RTN","BPSOSCD",145,0) ; They will be fetched from BPS("OVERRIDE" "RTN","BPSOSCD",146,0) ; during low-level construction of the actual encoded claim packet. "RTN","BPSOSCD",147,0) ; BPS("OVERRIDE",field)=value for fields 101-401 "RTN","BPSOSCD",148,0) ; BPS("OVERRIDE","RX",MEDN,field) for med #N, fields 402+ "RTN","BPSOSCD",149,0) ; Note that if you have multiple transactions bundled, the "RTN","BPSOSCD",150,0) ; union of overrides from 101-401 apply to all; and if there's a "RTN","BPSOSCD",151,0) ; conflict, the last one overwrites the previous ones. "RTN","BPSOSCD",152,0) OVERRIDE(IEN59,MEDN) ; "RTN","BPSOSCD",153,0) N IEN511,RETVAL "RTN","BPSOSCD",154,0) S IEN511=$P(^BPST(IEN59,1),U,13) Q:'IEN511 "RTN","BPSOSCD",155,0) S RETVAL=$$GET511^BPSOSO2(IEN511,"BPS(""OVERRIDE"")","BPS(""OVERRIDE"",""RX"","_MEDN_")") "RTN","BPSOSCD",156,0) Q "RTN","BPSOSCD",157,0) ; "RTN","BPSOSCD",158,0) ; DURVALUE - Will read in the DUR data from the DUR multiple "RTN","BPSOSCD",159,0) ; in BPS Transactions and store the values into BPS("RX",MEDN,DUR,....) "RTN","BPSOSCD",160,0) ; NOTE - unlike most values, these fields are stored by their "RTN","BPSOSCD",161,0) ; field number. Since they are repeating, it will ease the "RTN","BPSOSCD",162,0) ; retrieval of them, when we populate the claim. "RTN","BPSOSCD",163,0) DURVALUE(IEN59,MEDN) ; "RTN","BPSOSCD",164,0) N DUR,DCNT,DURREC "RTN","BPSOSCD",165,0) ; "RTN","BPSOSCD",166,0) S (DUR,DCNT)=0 "RTN","BPSOSCD",167,0) F S DCNT=$O(^BPST(IEN59,13,DCNT)) Q:'DCNT D "RTN","BPSOSCD",168,0) .S DURREC=$G(^BPST(IEN59,13,DCNT,0)) "RTN","BPSOSCD",169,0) .I DURREC="" Q "RTN","BPSOSCD",170,0) .S DUR=DUR+1 "RTN","BPSOSCD",171,0) .S BPS("RX",MEDN,"DUR",DUR,473)=DUR ;473-7E DUR/PPS Code Counter "RTN","BPSOSCD",172,0) .S BPS("RX",MEDN,"DUR",DUR,439)=$P(DURREC,U,3) ;439-E4 Reason For Service Code "RTN","BPSOSCD",173,0) .S BPS("RX",MEDN,"DUR",DUR,440)=$P(DURREC,U,2) ;440-E5 Professional Service Code "RTN","BPSOSCD",174,0) .S BPS("RX",MEDN,"DUR",DUR,441)=$P(DURREC,U,4) ;441-E6 Result of Service Code "RTN","BPSOSCD",175,0) .S BPS("RX",MEDN,"DUR",DUR,474)="" ;474-8E DUR/PPS Level Of Effort "RTN","BPSOSCD",176,0) .Q:$G(BPS("NCPDP","Version"))'=51 ; fields 475&476 not used in vD.0 "RTN","BPSOSCD",177,0) .S BPS("RX",MEDN,"DUR",DUR,475)="" ;475-J9 DUR Co-Agent ID Qualifier "RTN","BPSOSCD",178,0) .S BPS("RX",MEDN,"DUR",DUR,476)="" ;476-H6 DUR Co-Agent ID "RTN","BPSOSCD",179,0) ; "RTN","BPSOSCD",180,0) Q "RTN","BPSOSCD",181,0) ; "RTN","BPSOSCD",182,0) COB(IEN59,MEDN) ; process the COB fields and build the COB array "RTN","BPSOSCD",183,0) ; Code for Payer-Patient Responsibility and Benefit Stages multiples "RTN","BPSOSCD",184,0) ; not implemented yet (except by certification) "RTN","BPSOSCD",185,0) ; "RTN","BPSOSCD",186,0) ; build array of COB secondary claim data from the BPS Transaction file - esg - 6/16/10 "RTN","BPSOSCD",187,0) N COBPIEN,APDIEN,REJIEN "RTN","BPSOSCD",188,0) K BPS("RX",MEDN,"OTHER PAYER") "RTN","BPSOSCD",189,0) ; "RTN","BPSOSCD",190,0) ; Field 337-4C COB OTHER PAYMENTS COUNT (9002313.59,1204) moved into [1] below "RTN","BPSOSCD",191,0) S BPS("RX",MEDN,"OTHER PAYER",0)=$P($G(^BPST(IEN59,12)),U,4) "RTN","BPSOSCD",192,0) ; "RTN","BPSOSCD",193,0) S COBPIEN=0 F S COBPIEN=$O(^BPST(IEN59,14,COBPIEN)) Q:'COBPIEN D "RTN","BPSOSCD",194,0) . ; Note that this will set pieces 1-7. Piece 8 is reserved for "RTN","BPSOSCD",195,0) . ; Payer-Patient Responsibility Count and is set by the certification code "RTN","BPSOSCD",196,0) . S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,0)=$G(^BPST(IEN59,14,COBPIEN,0)) "RTN","BPSOSCD",197,0) . ; "RTN","BPSOSCD",198,0) . ; retrieve data from other payer amount paid multiple "RTN","BPSOSCD",199,0) . S APDIEN=0 F S APDIEN=$O(^BPST(IEN59,14,COBPIEN,1,APDIEN)) Q:'APDIEN D "RTN","BPSOSCD",200,0) .. S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,"P",APDIEN,0)=$G(^BPST(IEN59,14,COBPIEN,1,APDIEN,0)) "RTN","BPSOSCD",201,0) .. Q "RTN","BPSOSCD",202,0) . ; "RTN","BPSOSCD",203,0) . ; retrieve data from other payer reject multiple "RTN","BPSOSCD",204,0) . S REJIEN=0 F S REJIEN=$O(^BPST(IEN59,14,COBPIEN,2,REJIEN)) Q:'REJIEN D "RTN","BPSOSCD",205,0) .. S BPS("RX",MEDN,"OTHER PAYER",COBPIEN,"R",REJIEN,0)=$G(^BPST(IEN59,14,COBPIEN,2,REJIEN,0)) "RTN","BPSOSCD",206,0) Q "RTN","BPSOSCD",207,0) ; "RTN","BPSOSCD",208,0) PRVADRS(IEN59,PRVIEN) ; site address for a provider "RTN","BPSOSCD",209,0) ; returns "street address^city^st^zip" "RTN","BPSOSCD",210,0) ; IEN59=BPS TRANSACTION (#9002313.59) ien "RTN","BPSOSCD",211,0) ; PRVIEN=provider IEN in NEW PERSON file (#200) "RTN","BPSOSCD",212,0) ; "RTN","BPSOSCD",213,0) N BPSND,F,IPTR,J,OPSITE,PRVADDR,PRVNVA,RSLT,X "RTN","BPSOSCD",214,0) S RSLT="" "RTN","BPSOSCD",215,0) ; "RTN","BPSOSCD",216,0) S PRVNVA=+$$GET1^DIQ(200,PRVIEN_",",53.91,"I") ; NON-VA PRESCRIBER "RTN","BPSOSCD",217,0) ; "RTN","BPSOSCD",218,0) ; if false, it's a VA prescriber - address data found in file 4 for the VA pharmacy "RTN","BPSOSCD",219,0) I 'PRVNVA D G PRVADX "RTN","BPSOSCD",220,0) .S OPSITE=$P($G(^BPST(IEN59,1)),U,4) ; OUTPATIENT SITE ptr "RTN","BPSOSCD",221,0) .Q:'OPSITE "RTN","BPSOSCD",222,0) .S BPSND="BPS59" K ^TMP($J,BPSND) "RTN","BPSOSCD",223,0) .D PSS^PSO59(OPSITE,"",BPSND) "RTN","BPSOSCD",224,0) .S IPTR=$P($G(^TMP($J,BPSND,OPSITE,101)),U) ; INSTITUTION ptr "RTN","BPSOSCD",225,0) .S:IPTR RSLT=$$MADD^XUAF4(IPTR) "RTN","BPSOSCD",226,0) .K ^TMP($J,BPSND) "RTN","BPSOSCD",227,0) ; "RTN","BPSOSCD",228,0) ; non-VA prescriber - address data found in file 200 "RTN","BPSOSCD",229,0) F F=.111,.112,.113,.114,.115,.116 S PRVADDR(F)=$$GET1^DIQ(200,PRVIEN_",",F) "RTN","BPSOSCD",230,0) S PRVADDR(.115,"ABBR")="",X=PRVADDR(.115) ; state abbreviation "RTN","BPSOSCD",231,0) S:X]"" J=$$GET1^DIQ(200,PRVIEN_",",.115,"I"),PRVADDR(.115,"ABBR")=$$GET1^DIQ(5,J_",",1) "RTN","BPSOSCD",232,0) S X=PRVADDR(.111) F F=.112,.113 I PRVADDR(F)]"" S X=X_$S(X]"":" ",1:"")_PRVADDR(F) ; street address "RTN","BPSOSCD",233,0) S RSLT=X_U_PRVADDR(.114)_U_PRVADDR(.115,"ABBR")_U_PRVADDR(.116) "RTN","BPSOSCD",234,0) ; "RTN","BPSOSCD",235,0) PRVADX ; "RTN","BPSOSCD",236,0) Q RSLT "RTN","BPSOSCD",237,0) ; "RTN","BPSOSCE") 0^15^B12883469 "RTN","BPSOSCE",1,0) BPSOSCE ;BHAM ISC/FCS/DRS/DLF - New entry in 9002313.02 ;06/01/2004 "RTN","BPSOSCE",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSCE",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSCE",4,0) ; "RTN","BPSOSCE",5,0) ;Create an Electronic Claim Submission record "RTN","BPSOSCE",6,0) ; the BPS array is shared by all of the BPSOSC* routines "RTN","BPSOSCE",7,0) ; BPS is created in BPSOSCA "RTN","BPSOSCE",8,0) ; "RTN","BPSOSCE",9,0) Q "RTN","BPSOSCE",10,0) ; "RTN","BPSOSCE",11,0) ;NEWCLAIM^BPSOSCE called from BPSOSCA from BPSOSQG from BPSOSQ2 "RTN","BPSOSCE",12,0) ; create /update an entry in BPS CLAIMS (#9002313.02) "RTN","BPSOSCE",13,0) ; then call the code that populates the entry "RTN","BPSOSCE",14,0) ; START = START Medication Number "RTN","BPSOSCE",15,0) ; END = END Medication Number "RTN","BPSOSCE",16,0) ; TOTAL = TOTAL Medications in Claim "RTN","BPSOSCE",17,0) ; process from BPS("RX",START) through BPS("RX",END) "RTN","BPSOSCE",18,0) NEWCLAIM(START,END,TOTAL) ; function, returns null on success, else error "RTN","BPSOSCE",19,0) ; "RTN","BPSOSCE",20,0) N CLAIMID,COUNT,DA,DIC,DIK,DLAYGO,ERROR,INDEX,NODE0,ROU,SEG,X,Y "RTN","BPSOSCE",21,0) S ROU=$T(+0),START=+$G(START),END=+$G(END),TOTAL=+$G(TOTAL) "RTN","BPSOSCE",22,0) ; "RTN","BPSOSCE",23,0) ;Create new record in Claim Submission File (9002313.02) "RTN","BPSOSCE",24,0) ; try for exclusive access for 1 min. before logging error "RTN","BPSOSCE",25,0) F L +^XTMP(ROU,"NEWCLAIM"):60 Q:$T D "RTN","BPSOSCE",26,0) .N A S A=$$IMPOSS^BPSOSUE("L","RTI","Single-threaded routine",,,ROU) "RTN","BPSOSCE",27,0) ; Generate Claim ID "RTN","BPSOSCE",28,0) S CLAIMID=$$CLAIMID^BPSECX1($G(BPS("RX",START,"IEN59"))) "RTN","BPSOSCE",29,0) I CLAIMID="" D "RTN","BPSOSCE",30,0) .S ERROR="320^VA Claim ID not created" "RTN","BPSOSCE",31,0) .D LOG(ROU_"-Failed to create Claim ID") "RTN","BPSOSCE",32,0) ; "RTN","BPSOSCE",33,0) ; Create claim record "RTN","BPSOSCE",34,0) D:'$G(ERROR) "RTN","BPSOSCE",35,0) .S DLAYGO=9002313.02,DIC="^BPSC(",DIC(0)="LXZ",X=CLAIMID "RTN","BPSOSCE",36,0) .D ^DIC Q:Y>0 ; less than zero is error "RTN","BPSOSCE",37,0) .S ERROR="321^Failed to create claim record" "RTN","BPSOSCE",38,0) .D LOG(ROU_"-Failed to create an entry in file 9002313.02") "RTN","BPSOSCE",39,0) ; "RTN","BPSOSCE",40,0) L -^XTMP(ROU,"NEWCLAIM") "RTN","BPSOSCE",41,0) ; "RTN","BPSOSCE",42,0) Q:$G(ERROR) ERROR "RTN","BPSOSCE",43,0) ; "RTN","BPSOSCE",44,0) ; Update BPS and Log it "RTN","BPSOSCE",45,0) S BPS(9002313.02)=+Y "RTN","BPSOSCE",46,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSOSCE",47,0) D LOG(ROU_"-Created claim ID "_CLAIMID_" (IEN "_BPS(9002313.02)_")") "RTN","BPSOSCE",48,0) ; "RTN","BPSOSCE",49,0) ; Update zero node of the claim "RTN","BPSOSCE",50,0) S NODE0=$G(^BPSC(BPS(9002313.02),0)) "RTN","BPSOSCE",51,0) S $P(NODE0,U,2)=$G(BPS("NCPDP","IEN")) ; Electronic Payor (Payer Sheet) "RTN","BPSOSCE",52,0) S $P(NODE0,U,4)=2 ; Transmit Flag - 2 is 'Yes (Point of Sale)' "RTN","BPSOSCE",53,0) S $P(NODE0,U,6)=$$NOWFM^BPSOSU1() ; Created On "RTN","BPSOSCE",54,0) S ^BPSC(BPS(9002313.02),0)=NODE0 "RTN","BPSOSCE",55,0) ; "RTN","BPSOSCE",56,0) ; Update Patient Name "RTN","BPSOSCE",57,0) S $P(^BPSC(BPS(9002313.02),1),U,1)=$G(BPS("Patient","Name")) "RTN","BPSOSCE",58,0) S $P(^BPSC(BPS(9002313.02),1),U,4)=$G(BPS("Insurer","IEN")) "RTN","BPSOSCE",59,0) ; Update TRANSACTION field "RTN","BPSOSCE",60,0) S $P(^BPSC(BPS(9002313.02),0),U,8)=$G(BPS("RX",START,"IEN59")) "RTN","BPSOSCE",61,0) ; "RTN","BPSOSCE",62,0) ; Count of meds in claim "RTN","BPSOSCE",63,0) S BPS("Transaction Count")=TOTAL "RTN","BPSOSCE",64,0) ; "RTN","BPSOSCE",65,0) ; Process the 'non-multiple' segments (Header, Patient, Cardholder) "RTN","BPSOSCE",66,0) F SEG=100:10:120 D XLOOP^BPSOSCF(BPS("NCPDP","IEN"),SEG) "RTN","BPSOSCE",67,0) ; "RTN","BPSOSCE",68,0) ; zero node for MEDICATIONS SUB-FIELD (#9002313.0201) "RTN","BPSOSCE",69,0) S:'$D(^BPSC(BPS(9002313.02),400,0)) ^(0)="^9002313.0201PA^^" "RTN","BPSOSCE",70,0) S COUNT=0 F INDEX=START:1:END D "RTN","BPSOSCE",71,0) .; Create zero node for entry in multiple "RTN","BPSOSCE",72,0) .S COUNT=COUNT+1,NODE0="" "RTN","BPSOSCE",73,0) .S $P(NODE0,U)=INDEX,$P(NODE0,U,4)=$G(BPS("RX",INDEX,"Drug Name")),$P(NODE0,U,5)=$G(BPS("RX",INDEX,"RX IEN")) "RTN","BPSOSCE",74,0) .S ^BPSC(BPS(9002313.02),400,INDEX,0)=NODE0 "RTN","BPSOSCE",75,0) .S $P(^BPSC(BPS(9002313.02),400,INDEX,400),U,1)=BPS("RX",INDEX,"Date Filled") "RTN","BPSOSCE",76,0) .S BPS(9002313.0201)=INDEX ;07/28/96. "RTN","BPSOSCE",77,0) .; Process entries in medication multiple "RTN","BPSOSCE",78,0) .F SEG=130:10:260 D XLOOP^BPSOSCF(BPS("NCPDP","IEN"),SEG,INDEX) "RTN","BPSOSCE",79,0) .; Update the indices "RTN","BPSOSCE",80,0) .S ^BPSC(BPS(9002313.02),400,"B",INDEX,INDEX)="" "RTN","BPSOSCE",81,0) .; Update top-level node of the multiple "RTN","BPSOSCE",82,0) .S NODE0=$G(^BPSC(BPS(9002313.02),400,0)) "RTN","BPSOSCE",83,0) .S $P(NODE0,U,3)=COUNT,$P(NODE0,U,4)=COUNT,^BPSC(BPS(9002313.02),400,0)=NODE0 "RTN","BPSOSCE",84,0) ; "RTN","BPSOSCE",85,0) ; Cross-Reference Claim Submission Record "RTN","BPSOSCE",86,0) S DIK="^BPSC(",DA=BPS(9002313.02) D IX1^DIK "RTN","BPSOSCE",87,0) ; "RTN","BPSOSCE",88,0) Q "" ; Return null on success "RTN","BPSOSCE",89,0) ; "RTN","BPSOSCE",90,0) LOG(MSG) ;log the message for all the transactions in this 9002313.02 claim "RTN","BPSOSCE",91,0) N I,IEN59 "RTN","BPSOSCE",92,0) F I=START:1:END S IEN59=$G(BPS("RX",I,"IEN59")) D:IEN59 LOG^BPSOSL(IEN59,MSG) "RTN","BPSOSCE",93,0) Q "RTN","BPSOSCE",94,0) ; "RTN","BPSOSCF") 0^21^B30098289 "RTN","BPSOSCF",1,0) BPSOSCF ;BHAM ISC/FCS/DRS/DLF - Low-level format of .02 ;06/01/2004 "RTN","BPSOSCF",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10**;JUN 2004;Build 27 "RTN","BPSOSCF",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSCF",4,0) ; "RTN","BPSOSCF",5,0) ; "RTN","BPSOSCF",6,0) ; 100 (Transaction Header Segment) "RTN","BPSOSCF",7,0) ; 110 (Patient Segment) "RTN","BPSOSCF",8,0) ; 120 (Insurance Segment) "RTN","BPSOSCF",9,0) ; 130 (Claim Segment) "RTN","BPSOSCF",10,0) ; 140 (Pharmacy Provider Segment) "RTN","BPSOSCF",11,0) ; 150 (Prescriber Segment) "RTN","BPSOSCF",12,0) ; 160 (COB/Other Payments Segment) "RTN","BPSOSCF",13,0) ; 170 (Worker's Compensation Segment) "RTN","BPSOSCF",14,0) ; 180 (DUR/PPS Segment) "RTN","BPSOSCF",15,0) ; 190 (Pricing Segment) "RTN","BPSOSCF",16,0) ; 200 (Coupon Segment) "RTN","BPSOSCF",17,0) ; 210 (Compound Segment) "RTN","BPSOSCF",18,0) ; 220 (Prior Authorization Segment) "RTN","BPSOSCF",19,0) ; 230 (Clinical Segment) "RTN","BPSOSCF",20,0) ; 240 (Additional Documentation Segment) "RTN","BPSOSCF",21,0) ; 250 (Facility Segment) "RTN","BPSOSCF",22,0) ; 260 (Narrative Segment) "RTN","BPSOSCF",23,0) ; "RTN","BPSOSCF",24,0) ; FORMAT = IEN in BPS NCPDP FORMATS (#9002313.92) "RTN","BPSOSCF",25,0) ; NODE = Segment Node "RTN","BPSOSCF",26,0) ; MEDN = Transaction multiple in BPS Claims "RTN","BPSOSCF",27,0) XLOOP(FORMAT,NODE,MEDN) ; format claim record "RTN","BPSOSCF",28,0) ; "RTN","BPSOSCF",29,0) Q:$G(FORMAT)="" Q:$G(NODE)="" ; FORMAT, NODE required "RTN","BPSOSCF",30,0) ; "RTN","BPSOSCF",31,0) N FLAG,FLDIEN,FLDINFO,MDATA,NCPVERS,ORDER,OVERRIDE,PMODE,RECMIEN,X "RTN","BPSOSCF",32,0) ; quit If the payer sheet doesn't have the segment "RTN","BPSOSCF",33,0) I '$D(^BPSF(9002313.92,FORMAT,NODE,0)) Q "RTN","BPSOSCF",34,0) ; "RTN","BPSOSCF",35,0) ; VA doesn't do these segments "RTN","BPSOSCF",36,0) I ",260,250,240,230,220,210,200,170,140,"[(","_NODE_",") Q "RTN","BPSOSCF",37,0) ; "RTN","BPSOSCF",38,0) ; Per NCPDP standard, eligibility doesn't support segments listed below "RTN","BPSOSCF",39,0) I BPS("Transaction Code")="E1",",260,250,230,220,210,200,190,180,170,160,130,"[(","_NODE_",") Q "RTN","BPSOSCF",40,0) ; "RTN","BPSOSCF",41,0) ; For COB, if the payer sequence is primary, then quit and don't output the COB fields "RTN","BPSOSCF",42,0) I NODE=160,$$COB59^BPSUTIL2(+$G(BPS("RX",BPS(9002313.0201),"IEN59")))=1 Q "RTN","BPSOSCF",43,0) ; "RTN","BPSOSCF",44,0) ; COB processing is handled differently "RTN","BPSOSCF",45,0) I NODE=160 D COB^BPSOSHF(FORMAT,NODE,MEDN) Q "RTN","BPSOSCF",46,0) ; "RTN","BPSOSCF",47,0) ; DUR is handled differently since it is repeating "RTN","BPSOSCF",48,0) I NODE=180 D DURPPS^BPSOSHF(FORMAT,NODE,MEDN) Q "RTN","BPSOSCF",49,0) ; "RTN","BPSOSCF",50,0) ; Loop through the fields in the segment "RTN","BPSOSCF",51,0) S ORDER=0 "RTN","BPSOSCF",52,0) F S ORDER=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER)) Q:'ORDER D "RTN","BPSOSCF",53,0) . ; Get the pointer to the BPS NCPDP FIELD DEFS table "RTN","BPSOSCF",54,0) . S RECMIEN=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0)) "RTN","BPSOSCF",55,0) . I 'RECMIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$T(+0)) Q "RTN","BPSOSCF",56,0) . S MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0),FLDIEN=$P(MDATA,U,2) "RTN","BPSOSCF",57,0) .; Corrupt or erroneous format file "RTN","BPSOSCF",58,0) . I 'FLDIEN Q "RTN","BPSOSCF",59,0) . S FLDINFO=$G(^BPSF(9002313.91,FLDIEN,0)) ; BPS NCPDP FIELD DEFS (#9002313.91) "RTN","BPSOSCF",60,0) . I FLDINFO="" D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XLOOP",$T(+0)) Q "RTN","BPSOSCF",61,0) .; Quit for 111-AM Segment Identification "RTN","BPSOSCF",62,0) .; 478-H7 Other Amount Claimed Submitted Count "RTN","BPSOSCF",63,0) .; 479-H8 Other Amount Claimed Submitted Qualifier "RTN","BPSOSCF",64,0) .; 478 and 479 are handled by 480 and 111 is standard field for each segment "RTN","BPSOSCF",65,0) . S X=$P(FLDINFO,U) I ",111,478,479,"[(","_X_",") Q "RTN","BPSOSCF",66,0) .; "RTN","BPSOSCF",67,0) .; Set override value (may not be defined so override will be null) "RTN","BPSOSCF",68,0) . I $D(MEDN) S OVERRIDE=$G(BPS("OVERRIDE","RX",MEDN,FLDIEN)) "RTN","BPSOSCF",69,0) . E S OVERRIDE=$G(BPS("OVERRIDE",FLDIEN)) "RTN","BPSOSCF",70,0) .; "RTN","BPSOSCF",71,0) .; Get processing mode (S-Standard (default), X-Special Code) "RTN","BPSOSCF",72,0) . S PMODE=$P(MDATA,U,3) "RTN","BPSOSCF",73,0) . I PMODE="" S PMODE="S" ;default it "RTN","BPSOSCF",74,0) .; "RTN","BPSOSCF",75,0) .; Default FLAG and value being computed "RTN","BPSOSCF",76,0) . S FLAG="GFS" "RTN","BPSOSCF",77,0) . S BPS("X")="" "RTN","BPSOSCF",78,0) . ; "RTN","BPSOSCF",79,0) . ; If there is an override, set BPS("X") to it and "RTN","BPSOSCF",80,0) . ; only do Format and Set code "RTN","BPSOSCF",81,0) . I OVERRIDE]"" S FLAG="FS",BPS("X")=OVERRIDE "RTN","BPSOSCF",82,0) . ; "RTN","BPSOSCF",83,0) . ; If Special Code mode is set, execute special code instead "RTN","BPSOSCF",84,0) . ; of field's Get code and change Flag to FS so Format and "RTN","BPSOSCF",85,0) . ; Set code is still done but not GET code "RTN","BPSOSCF",86,0) . I PMODE="X",OVERRIDE="" D "RTN","BPSOSCF",87,0) .. S FLAG="FS" "RTN","BPSOSCF",88,0) .. D XSPCCODE(FORMAT,NODE,RECMIEN) "RTN","BPSOSCF",89,0) . ; "RTN","BPSOSCF",90,0) . ; Call XFLDCODE to do processing based on FLAG setting "RTN","BPSOSCF",91,0) . D XFLDCODE(NODE,FLDIEN,FLAG) "RTN","BPSOSCF",92,0) ; "RTN","BPSOSCF",93,0) Q "RTN","BPSOSCF",94,0) ; "RTN","BPSOSCF",95,0) ; "RTN","BPSOSCF",96,0) ; Execute Get, Format and/or Set MUMPS code for NCPDP Field "RTN","BPSOSCF",97,0) ; "RTN","BPSOSCF",98,0) ; Parameters: NODE - Segment Node "RTN","BPSOSCF",99,0) ; FLDIEN - NCPDP Field Definitions IEN "RTN","BPSOSCF",100,0) ; FLAG - If variable contains: "RTN","BPSOSCF",101,0) ; "G" - Execute Get Code "RTN","BPSOSCF",102,0) ; "F" - Execute Format Code "RTN","BPSOSCF",103,0) ; "S" - Execute S Code "RTN","BPSOSCF",104,0) ; "RTN","BPSOSCF",105,0) ; When called by the DURPPS^BPSOSHF, DUR is also set and used "RTN","BPSOSCF",106,0) ; by the SET logic for the DUR fields. This variable is newed "RTN","BPSOSCF",107,0) ; by the calling routine "RTN","BPSOSCF",108,0) XFLDCODE(NODE,FLDIEN,FLAG) ;EP "RTN","BPSOSCF",109,0) ; 5.1 loops through the 10, 25, 30 nodes "RTN","BPSOSCF",110,0) ; "RTN","BPSOSCF",111,0) N FNODE,INDEX,MCODE,NCPVERS,X "RTN","BPSOSCF",112,0) ; "RTN","BPSOSCF",113,0) ; Check if record exists and FLAG variable is set correctly "RTN","BPSOSCF",114,0) ; Changed from Q: to give fatal error - 10/18/2000 "RTN","BPSOSCF",115,0) I 'FLDIEN D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XFLDCODE",$T(+0)) Q "RTN","BPSOSCF",116,0) I FLAG="" D IMPOSS^BPSOSUE("DB,P","TI","FLAG null",,"XFLDCODE",$T(+0)) Q "RTN","BPSOSCF",117,0) ; get NCPDP version, default to vD.0 "RTN","BPSOSCF",118,0) S NCPVERS=$G(BPS("NCPDP","Version")) S:NCPVERS="" NCPVERS="D0" "RTN","BPSOSCF",119,0) ; Loop through GET CODE, D0 FORMAT (or FORMAT), SET CODE w-p fields and execute code "RTN","BPSOSCF",120,0) F FNODE=10,20,25,30 D "RTN","BPSOSCF",121,0) .I FNODE=25,NCPVERS="D0" Q ; node 25 is FORMAT CODE for versions before D.0 "RTN","BPSOSCF",122,0) .I FNODE=20,NCPVERS'="D0" Q ; node 20 is FORMAT CODE for vD.0 "RTN","BPSOSCF",123,0) .I FLAG'[$S(FNODE=10:"G",FNODE=25!(FNODE=20):"F",FNODE=30:"S",1:"") Q "RTN","BPSOSCF",124,0) .I '$D(^BPSF(9002313.91,FLDIEN,FNODE,0)) D IMPOSS^BPSOSUE("DB","TI","FLDIEN="_FLDIEN,"FNODE="_FNODE,"XFLDCODE",$T(+0)) "RTN","BPSOSCF",125,0) .; Loop through the W-P field and execute each line "RTN","BPSOSCF",126,0) .S INDEX=0 "RTN","BPSOSCF",127,0) .F S INDEX=$O(^BPSF(9002313.91,FLDIEN,FNODE,INDEX)) Q:'INDEX D "RTN","BPSOSCF",128,0) ..; If doing SET code and if this is not the header segment, add the ID prefix "RTN","BPSOSCF",129,0) ..I FNODE=30,NODE'=100 S BPS("X")=$P($G(^BPSF(9002313.91,FLDIEN,5)),U,1)_BPS("X") "RTN","BPSOSCF",130,0) ..; Get the code and xecute "RTN","BPSOSCF",131,0) ..S MCODE=$G(^BPSF(9002313.91,FLDIEN,FNODE,INDEX,0)) "RTN","BPSOSCF",132,0) ..Q:MCODE="" Q:$E(MCODE,1)=";" ; no M code or comment "RTN","BPSOSCF",133,0) ..X MCODE "RTN","BPSOSCF",134,0) ; "RTN","BPSOSCF",135,0) Q "RTN","BPSOSCF",136,0) ; "RTN","BPSOSCF",137,0) ; "RTN","BPSOSCF",138,0) ; Execute Special Code (for NCPDP Field within NCPDP Record) "RTN","BPSOSCF",139,0) ; FORMAT = NCPDP Record Format IEN (9002313.92) "RTN","BPSOSCF",140,0) ; NODE = Global node value (100,110,120,130,140) "RTN","BPSOSCF",141,0) ; RECMIEN = Field Multiple IEN "RTN","BPSOSCF",142,0) XSPCCODE(FORMAT,NODE,RECMIEN) ;EP - Above and BPSOSHR "RTN","BPSOSCF",143,0) ; BPS NCPDP FORMATS (#9002313.92) "RTN","BPSOSCF",144,0) I '$D(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)) D IMPOSS^BPSOSUE("DB,P","TI","no special code there to XECUTE","FORMAT="_FORMAT,"XSPCCODE",$T(+0)) Q "RTN","BPSOSCF",145,0) N INDEX,MCODE "RTN","BPSOSCF",146,0) S INDEX=0 "RTN","BPSOSCF",147,0) F S INDEX=$O(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX)) Q:'INDEX D "RTN","BPSOSCF",148,0) . S MCODE=$G(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX,0)) "RTN","BPSOSCF",149,0) . Q:MCODE="" "RTN","BPSOSCF",150,0) . Q:$E(MCODE,1)=";" "RTN","BPSOSCF",151,0) . X MCODE "RTN","BPSOSCF",152,0) Q "RTN","BPSOSCF",153,0) ; "RTN","BPSOSH2") 0^22^B136482600 "RTN","BPSOSH2",1,0) BPSOSH2 ;BHAM ISC/SD/lwj/DLF - Assemble formatted claim ;06/01/2004 "RTN","BPSOSH2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10**;JUN 2004;Build 27 "RTN","BPSOSH2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSH2",4,0) ; "RTN","BPSOSH2",5,0) ; Changes for NCPDP 5.1 "RTN","BPSOSH2",6,0) ; 5.1 has 14 claim segments (header, patient, insurance, claim "RTN","BPSOSH2",7,0) ; pharmacy provider, prescriber, "RTN","BPSOSH2",8,0) ; COB, workers comp, DUR, Pricing, "RTN","BPSOSH2",9,0) ; coupon, compound, prior auth, "RTN","BPSOSH2",10,0) ; clinical) "RTN","BPSOSH2",11,0) ; 5.1 requires field identifiers and separators on all fields "RTN","BPSOSH2",12,0) ; other than the header "RTN","BPSOSH2",13,0) ; 5.1 segment separators are required prior to each segment "RTN","BPSOSH2",14,0) ; following the header "RTN","BPSOSH2",15,0) ; 5.1 Group separators appear at the end of each "RTN","BPSOSH2",16,0) ; transaction (prescription) "RTN","BPSOSH2",17,0) ; 5.1 we only want to send segments that have data - a new "RTN","BPSOSH2",18,0) ; segment record will hold the data until we are sure "RTN","BPSOSH2",19,0) ; we have something to send "RTN","BPSOSH2",20,0) ; "RTN","BPSOSH2",21,0) ; Changes for NCPDP D.0 "RTN","BPSOSH2",22,0) ; D.0 added 3 new request segments (additional documentation, "RTN","BPSOSH2",23,0) ; facility, narrative) "RTN","BPSOSH2",24,0) ; "RTN","BPSOSH2",25,0) ; "RTN","BPSOSH2",26,0) ;Put together ascii formatted record via NCPDP Record definition "RTN","BPSOSH2",27,0) ; "RTN","BPSOSH2",28,0) ; Input: "RTN","BPSOSH2",29,0) ; NODES = "100^110^120" or "130^140^150^160^170^180^190^200^210^220^230^240^250^260" "RTN","BPSOSH2",30,0) ; passed by Ref: "RTN","BPSOSH2",31,0) ; .IEN = Internal Entry Number array "RTN","BPSOSH2",32,0) ; .BPS = Formatted Data Array with claim and transaction data "RTN","BPSOSH2",33,0) ; .REC - Formatted Ascii record (result) "RTN","BPSOSH2",34,0) XLOOP(NODES,IEN,BPS,REC) ;EP - from BPSECA1 "RTN","BPSOSH2",35,0) ; "RTN","BPSOSH2",36,0) N DATAFND,FDATA,FLAG,FLDDATA,FLDID,FLDIEN,FLDNUM,INDEX,MDATA,NODE,ORDER,PMODE,RECMIEN,SEGREC "RTN","BPSOSH2",37,0) N VER,TYPE "RTN","BPSOSH2",38,0) ; "RTN","BPSOSH2",39,0) ; Get payer sheet version and transaction type "RTN","BPSOSH2",40,0) S VER=$P($G(^BPSF(9002313.92,+$G(IEN(9002313.92)),1)),U,2) "RTN","BPSOSH2",41,0) S TYPE=$G(BPS(9002313.02,+$G(IEN(9002313.02)),103,"I")) "RTN","BPSOSH2",42,0) ; "RTN","BPSOSH2",43,0) ; Loop through the NODES variable delimited by U "RTN","BPSOSH2",44,0) F INDEX=1:1:$L(NODES,U) D "RTN","BPSOSH2",45,0) . S NODE=$P(NODES,U,INDEX) Q:NODE="" "RTN","BPSOSH2",46,0) . ; "RTN","BPSOSH2",47,0) . ; VA does not support these nodes "RTN","BPSOSH2",48,0) . Q:",260,250,240,230,220,210,200,170,140,"[NODE "RTN","BPSOSH2",49,0) . ; "RTN","BPSOSH2",50,0) . ; Quit if the payer sheet does not have the node "RTN","BPSOSH2",51,0) . Q:'$D(^BPSF(9002313.92,+IEN(9002313.92),NODE,0)) "RTN","BPSOSH2",52,0) . ; "RTN","BPSOSH2",53,0) . ; Per NCPDP standard, reversals do not support segments listed below "RTN","BPSOSH2",54,0) . I TYPE="B2",",260,250,240,230,220,210,200,170,150,140,"[NODE Q "RTN","BPSOSH2",55,0) . I TYPE="B2",VER=51,NODE=160 Q ;COB segment not supported in a 51 reversal "RTN","BPSOSH2",56,0) . I TYPE="B2",VER="D0",NODE=110 Q ;Patient segment not supported in a D0 reversal "RTN","BPSOSH2",57,0) . ; "RTN","BPSOSH2",58,0) . ; Per NCPDP standard, eligibility does not support segments listed below "RTN","BPSOSH2",59,0) . I TYPE="E1",",260,250,230,220,210,200,190,180,170,160,130,"[NODE Q "RTN","BPSOSH2",60,0) . ; "RTN","BPSOSH2",61,0) . S DATAFND=0 ; indicates if data is on the segment for us to send "RTN","BPSOSH2",62,0) . S SEGREC="" ; segment's information "RTN","BPSOSH2",63,0) . ; "RTN","BPSOSH2",64,0) . D:NODE=180 PROCDUR "RTN","BPSOSH2",65,0) . ; "RTN","BPSOSH2",66,0) . ;COB fields "RTN","BPSOSH2",67,0) . D:NODE=160 PROCCOB "RTN","BPSOSH2",68,0) . ; "RTN","BPSOSH2",69,0) . S ORDER="" "RTN","BPSOSH2",70,0) . F D Q:'ORDER "RTN","BPSOSH2",71,0) .. ; "RTN","BPSOSH2",72,0) .. Q:NODE=180 ; DUR/PPS section (repeating), already processed "RTN","BPSOSH2",73,0) .. Q:NODE=160 ; COB data processed earlier "RTN","BPSOSH2",74,0) .. S ORDER=$O(^BPSF(9002313.92,+IEN(9002313.92),NODE,"B",ORDER)) "RTN","BPSOSH2",75,0) .. Q:'ORDER "RTN","BPSOSH2",76,0) .. S RECMIEN="" "RTN","BPSOSH2",77,0) .. S RECMIEN=$O(^BPSF(9002313.92,+IEN(9002313.92),NODE,"B",ORDER,RECMIEN)) "RTN","BPSOSH2",78,0) .. Q:RECMIEN="" "RTN","BPSOSH2",79,0) .. ; "RTN","BPSOSH2",80,0) .. S MDATA=$G(^BPSF(9002313.92,+IEN(9002313.92),NODE,RECMIEN,0)) "RTN","BPSOSH2",81,0) .. Q:MDATA="" "RTN","BPSOSH2",82,0) .. ; "RTN","BPSOSH2",83,0) .. S FLDIEN=$P(MDATA,U,2) "RTN","BPSOSH2",84,0) .. Q:FLDIEN="" "RTN","BPSOSH2",85,0) .. ; "RTN","BPSOSH2",86,0) .. S FDATA=$G(^BPSF(9002313.91,FLDIEN,0)) "RTN","BPSOSH2",87,0) .. Q:FDATA="" "RTN","BPSOSH2",88,0) .. S FLDNUM=$P(FDATA,U,1) "RTN","BPSOSH2",89,0) .. Q:FLDNUM="" "RTN","BPSOSH2",90,0) .. ; "RTN","BPSOSH2",91,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",92,0) .. ; "RTN","BPSOSH2",93,0) .. ;header data "RTN","BPSOSH2",94,0) .. S:NODE<130 FLDDATA=$G(BPS(9002313.02,IEN(9002313.02),FLDNUM,"I")) "RTN","BPSOSH2",95,0) .. ; "RTN","BPSOSH2",96,0) .. ;transaction data "RTN","BPSOSH2",97,0) .. S:NODE>120 FLDDATA=$G(BPS(9002313.0201,IEN(9002313.0201),FLDNUM,"I")) "RTN","BPSOSH2",98,0) .. ; "RTN","BPSOSH2",99,0) .. I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the field empty? "RTN","BPSOSH2",100,0) .. ; "RTN","BPSOSH2",101,0) .. ;check if this is the seg id - call this after fld chk since "RTN","BPSOSH2",102,0) .. ;we don't want to send the segment if this is all there is "RTN","BPSOSH2",103,0) .. I (NODE>100)&(FLDNUM=111) S FLDDATA=$$SEGID(NODE) "RTN","BPSOSH2",104,0) .. ; "RTN","BPSOSH2",105,0) .. ; Special code to handle the Submission Clarification Code (420), "RTN","BPSOSH2",106,0) .. ; which is a repeating group in version D.0 "RTN","BPSOSH2",107,0) .. I FLDNUM=420 D SUBCLAR(.DATAFND,.IEN,.SEGREC) Q "RTN","BPSOSH2",108,0) .. ; "RTN","BPSOSH2",109,0) .. ; Special code to handle the Other Amount Claimed repeating group "RTN","BPSOSH2",110,0) .. I FLDNUM=480 D OAMTCLMD(.DATAFND,.IEN,.SEGREC) Q "RTN","BPSOSH2",111,0) .. I FLDNUM=479 Q ; fields 479 & 480 handled as a pair in OAMTCLMD "RTN","BPSOSH2",112,0) .. ; "RTN","BPSOSH2",113,0) .. Q:FLDDATA="" ;lje;7/23/03; don't want extra field separators when field is blank for testing for WebMD. "RTN","BPSOSH2",114,0) .. ; "RTN","BPSOSH2",115,0) .. S:NODE=100 SEGREC=SEGREC_FLDDATA ;no FS on the header rec "RTN","BPSOSH2",116,0) .. S:NODE>100 SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",117,0) ..; "RTN","BPSOSH2",118,0) . I (DATAFND)&(NODE=100) S REC(NODE)=SEGREC ;no SS when it's the header "RTN","BPSOSH2",119,0) . I (DATAFND)&(NODE>100) D "RTN","BPSOSH2",120,0) .. I '$D(REC(NODE)) S REC(NODE)=REC I REC[$C(29) S REC="" "RTN","BPSOSH2",121,0) .. S REC(NODE)=REC(NODE)_$C(30)_SEGREC ;SS before the seg "RTN","BPSOSH2",122,0) ; "RTN","BPSOSH2",123,0) Q "RTN","BPSOSH2",124,0) ; "RTN","BPSOSH2",125,0) SEGID(ND) ; function, returns Segment ID "RTN","BPSOSH2",126,0) ; Field 111 is the Segment Identifier - for each segment, other than "RTN","BPSOSH2",127,0) ; the header, a unique value must be sent in this field "RTN","BPSOSH2",128,0) ; to identify which segment is being sent. This value is not stored "RTN","BPSOSH2",129,0) ; in the claim - as it changes with each of the 13 segments. The "RTN","BPSOSH2",130,0) ; field does appear as part of the NCPDP Format, but is simply not stored. "RTN","BPSOSH2",131,0) ; 01 = Patient 02 = Pharmacy Provider 03 = Prescriber "RTN","BPSOSH2",132,0) ; 04 = Insurance 05 = COB/Other Payment 06 = Workers' Comp "RTN","BPSOSH2",133,0) ; 07 = Claim 08 = DUR/PPS 09 = Coupon "RTN","BPSOSH2",134,0) ; 10 = Compound 11 = Pricing 12 = Prior Auth "RTN","BPSOSH2",135,0) ; 13 = Clinical 14 = Additional Doc 15 = Facility "RTN","BPSOSH2",136,0) ; 16 = Narrative "RTN","BPSOSH2",137,0) ; "RTN","BPSOSH2",138,0) N FLD "RTN","BPSOSH2",139,0) ; "RTN","BPSOSH2",140,0) S FLD=$S(ND=110:"01",ND=120:"04",ND=130:"07",ND=140:"02",ND=150:"03",ND=160:"05",ND=170:"06",ND=180:"08",ND=190:11,ND=200:"09",ND=210:10,ND=220:12,ND=230:13,ND=240:14,ND=250:15,ND=260:16,1:"00") "RTN","BPSOSH2",141,0) S FLD="AM"_$$NFF^BPSECFM(FLD,2) "RTN","BPSOSH2",142,0) ; "RTN","BPSOSH2",143,0) Q FLD "RTN","BPSOSH2",144,0) ; "RTN","BPSOSH2",145,0) PROCDUR ; The DUR/PPS segment can repeat itself for any given "RTN","BPSOSH2",146,0) ; transaction within a claim. This means we have to have special "RTN","BPSOSH2",147,0) ; programming to handle the repeating fields. "RTN","BPSOSH2",148,0) ; "RTN","BPSOSH2",149,0) ; Input Data "RTN","BPSOSH2",150,0) ; BPS array - Set in BPSOSC* routines "RTN","BPSOSH2",151,0) ; IEN array - Contain IEN information for the BPS NCPDP FORMAT file "RTN","BPSOSH2",152,0) ; NODE - Multiple of the BPS NCPDP FORMAT file "RTN","BPSOSH2",153,0) ; Input/Output Data "RTN","BPSOSH2",154,0) ; SEGREC - This is data for the segment being created "RTN","BPSOSH2",155,0) ; DATAFND - Flag indicating if there is legitimate data for the segment "RTN","BPSOSH2",156,0) ; "RTN","BPSOSH2",157,0) N FIELD,DUR,FLD,ORD,FLDIEN,FLDID,FLDDATA "RTN","BPSOSH2",158,0) ; "RTN","BPSOSH2",159,0) ; If there isn't any data in this segment then quit "RTN","BPSOSH2",160,0) Q:'$D(BPS(9002313.1001)) "RTN","BPSOSH2",161,0) ; "RTN","BPSOSH2",162,0) ; Second thing - create the 111 field entry as it is not repeating "RTN","BPSOSH2",163,0) S FLDDATA=$$SEGID(NODE) "RTN","BPSOSH2",164,0) S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",165,0) ; "RTN","BPSOSH2",166,0) ; Next- let's look to the format to see which DUR/PPS fields are "RTN","BPSOSH2",167,0) ; needed (remember - ALL fields on the DUR/PPS segment are optional) "RTN","BPSOSH2",168,0) D GETFLDS^BPSOSHF(+IEN(9002313.92),NODE,.FIELD) "RTN","BPSOSH2",169,0) ; "RTN","BPSOSH2",170,0) ; Finally -loop through and process the fields for as many times "RTN","BPSOSH2",171,0) ; as they appear "RTN","BPSOSH2",172,0) S DUR=0 "RTN","BPSOSH2",173,0) F S DUR=$O(BPS(9002313.1001,DUR)) Q:DUR="" D "RTN","BPSOSH2",174,0) . S ORD=0 "RTN","BPSOSH2",175,0) . F S ORD=$O(FIELD(ORD)) Q:ORD="" D "RTN","BPSOSH2",176,0) .. S FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSH2",177,0) .. S FLD=$P(FIELD(ORD),U,2) "RTN","BPSOSH2",178,0) .. S:FLD=473 FLD=.01 ;473 value stored in the .01 field "RTN","BPSOSH2",179,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",180,0) .. ; Transaction data "RTN","BPSOSH2",181,0) .. S FLDDATA=$G(BPS(9002313.1001,DUR,FLD,"I")) "RTN","BPSOSH2",182,0) .. I FLDDATA="" Q "RTN","BPSOSH2",183,0) .. ; "RTN","BPSOSH2",184,0) .. I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty? "RTN","BPSOSH2",185,0) .. ; "RTN","BPSOSH2",186,0) .. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",187,0) ; "RTN","BPSOSH2",188,0) Q "RTN","BPSOSH2",189,0) ; "RTN","BPSOSH2",190,0) PROCCOB ;The COB OTHER PAYMENTS segment can repeat itself for any given "RTN","BPSOSH2",191,0) ; transaction within a claim. This means we have to have special "RTN","BPSOSH2",192,0) ; programming to handle the repeating fields. "RTN","BPSOSH2",193,0) ; "RTN","BPSOSH2",194,0) ; Note that BPS array is set in BPSOSC* routines "RTN","BPSOSH2",195,0) ; "RTN","BPSOSH2",196,0) N FIELD,BPCOB,FLD,ORD "RTN","BPSOSH2",197,0) ; "RTN","BPSOSH2",198,0) ; If there isn't any data in this segment quit "RTN","BPSOSH2",199,0) Q:'$D(BPS(9002313.0401)) "RTN","BPSOSH2",200,0) ; "RTN","BPSOSH2",201,0) ; create the 111 field entry as it is not repeating "RTN","BPSOSH2",202,0) S FLDDATA=$$SEGID(NODE) "RTN","BPSOSH2",203,0) S SEGREC=SEGREC_$C(28)_FLDDATA ; FS always proceeds fld "RTN","BPSOSH2",204,0) ; "RTN","BPSOSH2",205,0) ; look to the format to see which COB fields are needed "RTN","BPSOSH2",206,0) D GETFLDS^BPSOSHF(+IEN(9002313.92),NODE,.FIELD) "RTN","BPSOSH2",207,0) ; "RTN","BPSOSH2",208,0) ; loop through and process fields for as many times as they appear "RTN","BPSOSH2",209,0) S BPCOB=0 "RTN","BPSOSH2",210,0) F S BPCOB=$O(BPS(9002313.0401,BPCOB)) Q:BPCOB="" D "RTN","BPSOSH2",211,0) . S ORD=0 "RTN","BPSOSH2",212,0) . F S ORD=$O(FIELD(ORD)) Q:ORD="" D "RTN","BPSOSH2",213,0) .. S FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSH2",214,0) .. S FLD=$P(FIELD(ORD),U,2) "RTN","BPSOSH2",215,0) .. S:FLD=337 FLD=.01 ; 473-7E value stored in the .01 field "RTN","BPSOSH2",216,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",217,0) .. ; Transaction data "RTN","BPSOSH2",218,0) .. S FLDDATA=$G(BPS(9002313.0401,BPCOB,FLD,"I")) "RTN","BPSOSH2",219,0) .. ; "RTN","BPSOSH2",220,0) .. Q:FLDDATA="" "RTN","BPSOSH2",221,0) .. I $TR(FLDDATA,"0 {}")="HB" Q "RTN","BPSOSH2",222,0) .. I $TR(FLDDATA,"0 {}")="5E" Q "RTN","BPSOSH2",223,0) ..; "RTN","BPSOSH2",224,0) ..I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty? "RTN","BPSOSH2",225,0) ..S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",226,0) ..; handle repeating fields "RTN","BPSOSH2",227,0) ..I FLD=471 D REJCODES ; (#471) OTHER PAYER REJECT COUNT "RTN","BPSOSH2",228,0) ..I FLD=341 D AMTPAID ; (#341) OTHER PAYER AMOUNT PAID COUNT "RTN","BPSOSH2",229,0) ..I FLD=353 D PATPAID ; (#353) OTHER PAYER-PATIENT RESPONSIBILITY COUNT "RTN","BPSOSH2",230,0) ..I FLD=392 D BENSTAGE ; (#392) BENEFIT STAGE COUNT "RTN","BPSOSH2",231,0) ; "RTN","BPSOSH2",232,0) Q "RTN","BPSOSH2",233,0) ; "RTN","BPSOSH2",234,0) AMTPAID ; (#342) OTHER PAYER AMT PAID QUALIFIER multiple "RTN","BPSOSH2",235,0) N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA "RTN","BPSOSH2",236,0) S BPCOB=0 "RTN","BPSOSH2",237,0) F S BPCOB=$O(BPS(9002313.401342,BPCOB)) Q:BPCOB="" D "RTN","BPSOSH2",238,0) . S ORD=0 "RTN","BPSOSH2",239,0) . F S ORD=$O(FIELD(ORD)) Q:ORD="" D "RTN","BPSOSH2",240,0) .. S FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSH2",241,0) .. S FLD=$P(FIELD(ORD),U,2) "RTN","BPSOSH2",242,0) .. S:FLD=342 FLD=.01 ;342 value stored in the .01 field "RTN","BPSOSH2",243,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",244,0) .. ; Transaction data "RTN","BPSOSH2",245,0) .. S FLDDATA=$G(BPS(9002313.401342,BPCOB,FLD,"I")) "RTN","BPSOSH2",246,0) .. ; "RTN","BPSOSH2",247,0) .. ;quit if null or blank "RTN","BPSOSH2",248,0) .. Q:FLDDATA="" "RTN","BPSOSH2",249,0) .. I FLDID'="HC",FLDID=$TR(FLDDATA," ") Q ; blanks are ok for 342-HC, but not for 431-DV "RTN","BPSOSH2",250,0) .. ; "RTN","BPSOSH2",251,0) .. S DATAFND=1 "RTN","BPSOSH2",252,0) .. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",253,0) Q "RTN","BPSOSH2",254,0) ; "RTN","BPSOSH2",255,0) REJCODES ; (#472) OTHER PAYER REJECT CODE "RTN","BPSOSH2",256,0) N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA "RTN","BPSOSH2",257,0) S BPCOB=0 "RTN","BPSOSH2",258,0) F S BPCOB=$O(BPS(9002313.401472,BPCOB)) Q:BPCOB="" D "RTN","BPSOSH2",259,0) . S ORD=0 "RTN","BPSOSH2",260,0) . F S ORD=$O(FIELD(ORD)) Q:ORD="" D "RTN","BPSOSH2",261,0) .. S FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSH2",262,0) .. S FLD=$P(FIELD(ORD),U,2) "RTN","BPSOSH2",263,0) .. S:FLD=472 FLD=.01 ;472 value stored in the .01 field "RTN","BPSOSH2",264,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",265,0) .. ; Transaction data "RTN","BPSOSH2",266,0) .. S FLDDATA=$G(BPS(9002313.401472,BPCOB,FLD,"I")) "RTN","BPSOSH2",267,0) .. ; "RTN","BPSOSH2",268,0) .. ;quit if null or blank "RTN","BPSOSH2",269,0) .. Q:FLDDATA="" "RTN","BPSOSH2",270,0) .. I FLDID=$TR(FLDDATA,"0 {}") Q "RTN","BPSOSH2",271,0) .. ; "RTN","BPSOSH2",272,0) .. I FLDID'=$TR(FLDDATA,"0 {}") S DATAFND=1 ;fld chk-is the fld empty? "RTN","BPSOSH2",273,0) .. ; "RTN","BPSOSH2",274,0) .. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",275,0) Q "RTN","BPSOSH2",276,0) ; "RTN","BPSOSH2",277,0) PATPAID ; (#353.01) OTHER PAYER-PATIENT RESPONSIBILITY multiple "RTN","BPSOSH2",278,0) N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA "RTN","BPSOSH2",279,0) S BPCOB=0 "RTN","BPSOSH2",280,0) F S BPCOB=$O(BPS(9002313.401353,BPCOB)) Q:BPCOB="" D "RTN","BPSOSH2",281,0) . S ORD=0 "RTN","BPSOSH2",282,0) . F S ORD=$O(FIELD(ORD)) Q:ORD="" D "RTN","BPSOSH2",283,0) .. S FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSH2",284,0) .. S FLD=$P(FIELD(ORD),U,2) "RTN","BPSOSH2",285,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",286,0) .. ; Transaction data "RTN","BPSOSH2",287,0) .. S FLDDATA=$G(BPS(9002313.401353,BPCOB,FLD,"I")) "RTN","BPSOSH2",288,0) .. ; "RTN","BPSOSH2",289,0) .. ;quit if null or blank "RTN","BPSOSH2",290,0) .. I FLDDATA=""!(FLDID=$TR(FLDDATA," ")) Q ; Check for missing data or only field ID "RTN","BPSOSH2",291,0) .. ; "RTN","BPSOSH2",292,0) .. S DATAFND=1 "RTN","BPSOSH2",293,0) .. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",294,0) Q "RTN","BPSOSH2",295,0) ; "RTN","BPSOSH2",296,0) BENSTAGE ; (#392.01) BENEFIT STAGE MLTPL multiple "RTN","BPSOSH2",297,0) ; "RTN","BPSOSH2",298,0) N BPCOB,ORD,FLD,FLDID,FLDIEN,FLDDATA "RTN","BPSOSH2",299,0) S BPCOB=0 "RTN","BPSOSH2",300,0) F S BPCOB=$O(BPS(9002313.401392,BPCOB)) Q:BPCOB="" D "RTN","BPSOSH2",301,0) . S ORD=0 "RTN","BPSOSH2",302,0) . F S ORD=$O(FIELD(ORD)) Q:ORD="" D "RTN","BPSOSH2",303,0) .. S FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSH2",304,0) .. S FLD=$P(FIELD(ORD),U,2) "RTN","BPSOSH2",305,0) .. S FLDID=$P($G(^BPSF(9002313.91,FLDIEN,5)),U) ; BPS NCPDP FIELD DEFS, (#.06) ID "RTN","BPSOSH2",306,0) .. ; Transaction data "RTN","BPSOSH2",307,0) .. S FLDDATA=$G(BPS(9002313.401392,BPCOB,FLD,"I")) "RTN","BPSOSH2",308,0) .. ; "RTN","BPSOSH2",309,0) .. ;quit if null or blank "RTN","BPSOSH2",310,0) .. I FLDDATA=""!(FLDID=$TR(FLDDATA," ")) Q ; Check for missing data or only field ID "RTN","BPSOSH2",311,0) .. ; "RTN","BPSOSH2",312,0) .. S DATAFND=1 "RTN","BPSOSH2",313,0) .. S SEGREC=SEGREC_$C(28)_FLDDATA ;FS always proceeds fld "RTN","BPSOSH2",314,0) Q "RTN","BPSOSH2",315,0) ; "RTN","BPSOSH2",316,0) SUBCLAR(DATAFND,BPSIEN,SEGREC) ; "RTN","BPSOSH2",317,0) ; BPSIEN, SEGREC passed by ref., SEGREC is updated with repeating fields "RTN","BPSOSH2",318,0) ; 420-DK Submission Clarification Code, a repeating group in D.0 "RTN","BPSOSH2",319,0) ; For 5.1, we are storing the data in the subfile even though it is a single value field in 5.1 "RTN","BPSOSH2",320,0) ; "RTN","BPSOSH2",321,0) Q:'$G(BPSIEN(9002313.02)) ; BPS CLAIMS ien "RTN","BPSOSH2",322,0) Q:'$G(BPSIEN(9002313.0201)) ; TRANSACTIONS ien (sub-file 9002313.0201) "RTN","BPSOSH2",323,0) ; "RTN","BPSOSH2",324,0) N BPSD0,BPSD1,BPSD2,X1,X4 "RTN","BPSOSH2",325,0) ; "RTN","BPSOSH2",326,0) S BPSD0=BPSIEN(9002313.02),BPSD1=BPSIEN(9002313.0201),BPSD2=0 "RTN","BPSOSH2",327,0) ; "RTN","BPSOSH2",328,0) S X4=$P($G(^BPSC(BPSD0,400,BPSD1,350)),U,4) ; (#354) SUBM CLARIFICATION CODE COUNT "RTN","BPSOSH2",329,0) ; "RTN","BPSOSH2",330,0) I X4=""!($TR(X4,"0 {}")="NX") Q ; Quit if the count is missing is only the ID "RTN","BPSOSH2",331,0) ; "RTN","BPSOSH2",332,0) F S BPSD2=$O(^BPSC(BPSD0,400,BPSD1,354.01,BPSD2)) Q:'BPSD2 D "RTN","BPSOSH2",333,0) .S X1=$P($G(^BPSC(BPSD0,400,BPSD1,354.01,BPSD2,1)),U,1) "RTN","BPSOSH2",334,0) .I X1=""!($TR(X1," {}")="DK") Q ; Quit if the code is missing or only the ID "RTN","BPSOSH2",335,0) .S SEGREC=SEGREC_$C(28)_X1 ; FS always proceeds fld "RTN","BPSOSH2",336,0) .S DATAFND=1 ; data found, result is true "RTN","BPSOSH2",337,0) ; "RTN","BPSOSH2",338,0) Q "RTN","BPSOSH2",339,0) ; "RTN","BPSOSH2",340,0) OAMTCLMD(DATAFND,BPSIEN,SEGREC) ; "RTN","BPSOSH2",341,0) ; BPSIEN, SEGREC passed by ref., SEGREC updated with pairs of repeating fields "RTN","BPSOSH2",342,0) ; (#478.01) OTHER AMT CLAIMED MULTIPLE (sub-file 9002313.0601) "RTN","BPSOSH2",343,0) ; "RTN","BPSOSH2",344,0) Q:'$G(BPSIEN(9002313.02)) ; BPS CLAIMS ien "RTN","BPSOSH2",345,0) Q:'$G(BPSIEN(9002313.0201)) ; TRANSACTIONS ien (sub-file 9002313.0201) "RTN","BPSOSH2",346,0) ; "RTN","BPSOSH2",347,0) N BPSD0,BPSD1,BPSD2,X,X2,X3 "RTN","BPSOSH2",348,0) ; "RTN","BPSOSH2",349,0) S BPSD0=BPSIEN(9002313.02),BPSD1=BPSIEN(9002313.0201),BPSD2=0 "RTN","BPSOSH2",350,0) ; "RTN","BPSOSH2",351,0) F S BPSD2=$O(^BPSC(BPSD0,400,BPSD1,478.01,BPSD2)) Q:'BPSD2 D "RTN","BPSOSH2",352,0) .S X=$G(^BPSC(BPSD0,400,BPSD1,478.01,BPSD2,0)) "RTN","BPSOSH2",353,0) .I X="" Q ; Quit if the node is missing "RTN","BPSOSH2",354,0) .S X2=$P(X,U,2) ; (#479) OTHER AMT CLAIMED SUBMTTD QLFR "RTN","BPSOSH2",355,0) .S X3=$P(X,U,3) ; (#480) OTHER AMOUNT CLAIMED SUBMITTED "RTN","BPSOSH2",356,0) .I X2=""!($TR(X2,"0 {}")="H8") Q ; Quit if the qualifier is missing or just the ID "RTN","BPSOSH2",357,0) .I X3=""!($TR(X3,"0 {}")="H9") Q ; Quit if the amount is missing or just the ID "RTN","BPSOSH2",358,0) .S SEGREC=SEGREC_$C(28)_X2_$C(28)_X3 ; FS always proceeds fld "RTN","BPSOSH2",359,0) .S DATAFND=1 ; data found, result is true "RTN","BPSOSH2",360,0) ; "RTN","BPSOSH2",361,0) Q "RTN","BPSOSH2",362,0) ; "RTN","BPSOSHF") 0^82^B48018870 "RTN","BPSOSHF",1,0) BPSOSHF ;BHAM ISC/SD/lwj/DLF - Get/Format/Set value for repeating segments ;06/01/2004 "RTN","BPSOSHF",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8,10**;JUN 2004;Build 27 "RTN","BPSOSHF",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSHF",4,0) ; "RTN","BPSOSHF",5,0) ; This routine is an addendum to BPSOSCF. Its purpose is to handle "RTN","BPSOSHF",6,0) ; some of the repeating fields that now exist in NCPDP 5.1. "RTN","BPSOSHF",7,0) ; The logic was put in here rather than BPSOSCF to keep the original "RTN","BPSOSHF",8,0) ; routine (BPSOSCF) from growing too large and too cumbersome to "RTN","BPSOSHF",9,0) ; maintain. "RTN","BPSOSHF",10,0) ; "RTN","BPSOSHF",11,0) DURPPS(FORMAT,NODE,MEDN) ;EP called from BPSOSCF "RTN","BPSOSHF",12,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",13,0) ;NCPDP 5.1 changes "RTN","BPSOSHF",14,0) ; Processing of the 5.1 DUR/PPS segment is much different than the "RTN","BPSOSHF",15,0) ; conventional segments of 3.2, simply because all of its fields "RTN","BPSOSHF",16,0) ; are optional, and repeating. The repeating portion of this "RTN","BPSOSHF",17,0) ; causes us to have yet another index we have to account for, and "RTN","BPSOSHF",18,0) ; we must be able to tell which of the fields really needs to be "RTN","BPSOSHF",19,0) ; populated. The population of this segment is based on those "RTN","BPSOSHF",20,0) ; values found for the prescription or refill in the BPS DUR/PPS "RTN","BPSOSHF",21,0) ; file. The file's values are temporarily stored in the "RTN","BPSOSHF",22,0) ; BPS("RX",MEDN,DUR....) array for easy access and reference. "RTN","BPSOSHF",23,0) ; (Special note - Overrides are not allowed on this multiple since "RTN","BPSOSHF",24,0) ; they can simply update the DUR/PPS filed directly. For the same "RTN","BPSOSHF",25,0) ; reason, "special" code is not accounted for either. "RTN","BPSOSHF",26,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",27,0) ; "RTN","BPSOSHF",28,0) ; first order of business - check the BPS("RX",MEDN,"DUR") array "RTN","BPSOSHF",29,0) ; for values - if there aren't any, we don't need to write this "RTN","BPSOSHF",30,0) ; segment "RTN","BPSOSHF",31,0) ; "RTN","BPSOSHF",32,0) N FIELD,RECCNT,DUR,FLD,OVERRIDE,FLAG,ORD,FLDIEN,FLDNUM,FLDNUMB,FOUND "RTN","BPSOSHF",33,0) S FLAG="FS" "RTN","BPSOSHF",34,0) ; "RTN","BPSOSHF",35,0) Q:'$D(BPS("RX",MEDN,"DUR")) "RTN","BPSOSHF",36,0) ; "RTN","BPSOSHF",37,0) ;next we need to figure out which fields on this format are really "RTN","BPSOSHF",38,0) ; needed, then we will loop through and populate them "RTN","BPSOSHF",39,0) ; "RTN","BPSOSHF",40,0) D GETFLDS(FORMAT,NODE,.FIELD) "RTN","BPSOSHF",41,0) ; "RTN","BPSOSHF",42,0) ; now lets get, format and set the field "RTN","BPSOSHF",43,0) S (ORD,RECCNT,DUR)=0 "RTN","BPSOSHF",44,0) S RECCNT=RECCNT+1 "RTN","BPSOSHF",45,0) F S DUR=$O(BPS("RX",MEDN,"DUR",DUR)) Q:DUR="" D "RTN","BPSOSHF",46,0) . S FLDNUM="" F S FLDNUM=$O(BPS("RX",MEDN,"DUR",DUR,FLDNUM)) Q:FLDNUM="" D "RTN","BPSOSHF",47,0) .. S ORD="",FOUND=0 "RTN","BPSOSHF",48,0) .. F S ORD=$O(FIELD(ORD)) Q:ORD="" D Q:FOUND "RTN","BPSOSHF",49,0) ... S FLDNUMB="",FLDNUMB=$P(FIELD(ORD),U,2) Q:FLDNUMB'=FLDNUM "RTN","BPSOSHF",50,0) ... S FLDIEN="",FLDIEN=$P(FIELD(ORD),U) "RTN","BPSOSHF",51,0) ... S BPS("X")=BPS("RX",MEDN,"DUR",DUR,FLDNUM) "RTN","BPSOSHF",52,0) ... S FOUND=1 "RTN","BPSOSHF",53,0) ... D XFLDCODE^BPSOSCF(NODE,FLDIEN,FLAG) ;format/set "RTN","BPSOSHF",54,0) ; "RTN","BPSOSHF",55,0) ; this sets the record count and last record on the subfile "RTN","BPSOSHF",56,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,0)="^9002313.1001A^"_RECCNT_"^"_RECCNT "RTN","BPSOSHF",57,0) ; "RTN","BPSOSHF",58,0) Q "RTN","BPSOSHF",59,0) ; "RTN","BPSOSHF",60,0) COB(FORMAT,NODE,MEDN) ; COB fields processing, NODE=160 "RTN","BPSOSHF",61,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",62,0) ; The COB data is stored in the following local array: "RTN","BPSOSHF",63,0) ; "RTN","BPSOSHF",64,0) ; BPS("RX",MEDN,"OTHER PAYER",..... "RTN","BPSOSHF",65,0) ; "RTN","BPSOSHF",66,0) ; Array built in routine BPSOSCD. "RTN","BPSOSHF",67,0) ; Special note - Overrides are not allowed on this multiple. "RTN","BPSOSHF",68,0) ; "Special" code is not accounted for either. "RTN","BPSOSHF",69,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",70,0) ; "RTN","BPSOSHF",71,0) N FIELD,FLD,OVERRIDE,FLAG,ORD,NCPFLD,BPD,BPD1,BPD2,PCE,BPSOPIEN,BPSOAIEN,BPSORIEN "RTN","BPSOSHF",72,0) S FLAG="FS" "RTN","BPSOSHF",73,0) ; "RTN","BPSOSHF",74,0) ; Quit if there is no data in the array "RTN","BPSOSHF",75,0) Q:'$D(BPS("RX",MEDN,"OTHER PAYER")) "RTN","BPSOSHF",76,0) ; "RTN","BPSOSHF",77,0) ; next we need to figure out which fields on this format are really "RTN","BPSOSHF",78,0) ; needed, then we will loop through and populate them "RTN","BPSOSHF",79,0) ; "RTN","BPSOSHF",80,0) D GETFLDS(FORMAT,NODE,.FIELD) "RTN","BPSOSHF",81,0) ; "RTN","BPSOSHF",82,0) ; re-sort this list by the NCPDP field# "RTN","BPSOSHF",83,0) ; NCPFLD(NCPDP FIELD#) = internal field# "RTN","BPSOSHF",84,0) K NCPFLD S ORD=0 F S ORD=$O(FIELD(ORD)) Q:'ORD S FLD=$P(FIELD(ORD),U,2) I FLD'="" S NCPFLD(FLD)=+FIELD(ORD) "RTN","BPSOSHF",85,0) ; "RTN","BPSOSHF",86,0) ; see if 337-4C is needed "RTN","BPSOSHF",87,0) S FLD=337 "RTN","BPSOSHF",88,0) I $D(NCPFLD(FLD)) D "RTN","BPSOSHF",89,0) . S BPS("X")=$P($G(BPS("RX",MEDN,"OTHER PAYER",0)),U,1) ; get "RTN","BPSOSHF",90,0) . I BPS("X")="" Q "RTN","BPSOSHF",91,0) . D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set "RTN","BPSOSHF",92,0) . Q "RTN","BPSOSHF",93,0) ; "RTN","BPSOSHF",94,0) ; now lets get, format and set the rest of the COB fields "RTN","BPSOSHF",95,0) S BPSOPIEN=0 F S BPSOPIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN)) Q:'BPSOPIEN D "RTN","BPSOSHF",96,0) . S BPD=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,0)) "RTN","BPSOSHF",97,0) . ; Note that pieces 8 (Payer-Patient Responsibility Count) and 9 (Benefit Stage Count) are only set "RTN","BPSOSHF",98,0) . ; by Certification Code "RTN","BPSOSHF",99,0) . F PCE=1:1:9 D "RTN","BPSOSHF",100,0) .. S FLD=$S(PCE=1:337,PCE=2:338,PCE=3:339,PCE=4:340,PCE=5:443,PCE=6:341,PCE=7:471,PCE=8:353,PCE=9:392,1:0) Q:'FLD "RTN","BPSOSHF",101,0) .. I '$D(NCPFLD(FLD)) Q ; field not needed "RTN","BPSOSHF",102,0) .. I $P(BPD,U,PCE)="" Q ; data is nil "RTN","BPSOSHF",103,0) .. S BPS("X")=$P(BPD,U,PCE) ; get "RTN","BPSOSHF",104,0) .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set "RTN","BPSOSHF",105,0) .. Q "RTN","BPSOSHF",106,0) . ; "RTN","BPSOSHF",107,0) . ; Now look at the other payer amount paid fields "RTN","BPSOSHF",108,0) . S BPSOAIEN=0 F S BPSOAIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"P",BPSOAIEN)) Q:'BPSOAIEN D "RTN","BPSOSHF",109,0) .. S BPD1=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"P",BPSOAIEN,0)) "RTN","BPSOSHF",110,0) .. F PCE=1,2 D "RTN","BPSOSHF",111,0) ... S FLD=$S(PCE=1:431,PCE=2:342,1:0) Q:'FLD "RTN","BPSOSHF",112,0) ... I '$D(NCPFLD(FLD)) Q ; field not needed "RTN","BPSOSHF",113,0) ... I $P(BPD1,U,PCE)="" Q ; data is nil "RTN","BPSOSHF",114,0) ... S BPS("X")=$P(BPD1,U,PCE) ; get "RTN","BPSOSHF",115,0) ... D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set "RTN","BPSOSHF",116,0) .. Q "RTN","BPSOSHF",117,0) . ; "RTN","BPSOSHF",118,0) . ; Now look at the other payer reject code fields "RTN","BPSOSHF",119,0) . S BPSORIEN=0 F S BPSORIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"R",BPSORIEN)) Q:'BPSORIEN D "RTN","BPSOSHF",120,0) .. S BPD2=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"R",BPSORIEN,0)) "RTN","BPSOSHF",121,0) .. S FLD=472 "RTN","BPSOSHF",122,0) .. I '$D(NCPFLD(FLD)) Q ; field not needed "RTN","BPSOSHF",123,0) .. I BPD2="" Q ; data is nil "RTN","BPSOSHF",124,0) .. S BPS("X")=BPD2 ; get "RTN","BPSOSHF",125,0) .. D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set "RTN","BPSOSHF",126,0) .. Q "RTN","BPSOSHF",127,0) . ; "RTN","BPSOSHF",128,0) . ; Now look at the other payer-patient amount paid fields "RTN","BPSOSHF",129,0) . ; Currently, this multiple is only set by certification code "RTN","BPSOSHF",130,0) . S BPSOAIEN=0 F S BPSOAIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"PP",BPSOAIEN)) Q:'BPSOAIEN D "RTN","BPSOSHF",131,0) .. S BPD1=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"PP",BPSOAIEN,0)) "RTN","BPSOSHF",132,0) .. F PCE=1,2 D "RTN","BPSOSHF",133,0) ... S FLD=$S(PCE=1:352,PCE=2:351,1:0) Q:'FLD "RTN","BPSOSHF",134,0) ... I '$D(NCPFLD(FLD)) Q ; field not needed "RTN","BPSOSHF",135,0) ... I $P(BPD1,U,PCE)="" Q ; data is nil "RTN","BPSOSHF",136,0) ... S BPS("X")=$P(BPD1,U,PCE) ; get "RTN","BPSOSHF",137,0) ... D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set "RTN","BPSOSHF",138,0) .. Q "RTN","BPSOSHF",139,0) . ; "RTN","BPSOSHF",140,0) . ; Now look at the Benefit Stages fields "RTN","BPSOSHF",141,0) . ; Currently, this multiple is only set by certification code "RTN","BPSOSHF",142,0) . S BPSOAIEN=0 F S BPSOAIEN=$O(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"BS",BPSOAIEN)) Q:'BPSOAIEN D "RTN","BPSOSHF",143,0) .. S BPD1=$G(BPS("RX",MEDN,"OTHER PAYER",BPSOPIEN,"BS",BPSOAIEN,0)) "RTN","BPSOSHF",144,0) .. F PCE=1,2 D "RTN","BPSOSHF",145,0) ... S FLD=$S(PCE=1:394,PCE=2:393,1:0) Q:'FLD "RTN","BPSOSHF",146,0) ... I '$D(NCPFLD(FLD)) Q ; field not needed "RTN","BPSOSHF",147,0) ... I $P(BPD1,U,PCE)="" Q ; data is nil "RTN","BPSOSHF",148,0) ... S BPS("X")=$P(BPD1,U,PCE) ; get "RTN","BPSOSHF",149,0) ... D XFLDCODE^BPSOSCF(NODE,NCPFLD(FLD),FLAG) ; format/set "RTN","BPSOSHF",150,0) .. Q "RTN","BPSOSHF",151,0) . Q "RTN","BPSOSHF",152,0) ; "RTN","BPSOSHF",153,0) COBX ; "RTN","BPSOSHF",154,0) Q "RTN","BPSOSHF",155,0) ; "RTN","BPSOSHF",156,0) GETFLDS(FORMAT,NODE,FIELD) ;EP NCPDP 5.1 "RTN","BPSOSHF",157,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",158,0) ;This routine will get the list of repeating fields that must be "RTN","BPSOSHF",159,0) ; be worked with separately "RTN","BPSOSHF",160,0) ; (This was originally coded for the DUR/PPS segment - I'm not "RTN","BPSOSHF",161,0) ; 100% sure how and if it will work for the other repeating "RTN","BPSOSHF",162,0) ; fields that exist within a segment.) "RTN","BPSOSHF",163,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",164,0) ; Coming in: "RTN","BPSOSHF",165,0) ; FORMAT = BPSF(9002313.92 's format IEN "RTN","BPSOSHF",166,0) ; NODE = which segment we are processing (i.e. 180 - DUR/PPS) "RTN","BPSOSHF",167,0) ; .FIELD = array to store the values in "RTN","BPSOSHF",168,0) ; "RTN","BPSOSHF",169,0) ; Exitting: "RTN","BPSOSHF",170,0) ; .FIELD array will look like: "RTN","BPSOSHF",171,0) ; FIELD(ord)=int^ext "RTN","BPSOSHF",172,0) ; Where: ext = external field number from BPSF(9002313.91 "RTN","BPSOSHF",173,0) ; int = internal field number from BPSF(9002313.91 "RTN","BPSOSHF",174,0) ; ord = the order of the field - used in creating clm "RTN","BPSOSHF",175,0) ;--------------------------------------------------------------- "RTN","BPSOSHF",176,0) ; "RTN","BPSOSHF",177,0) N ORDER,RECMIEN,MDATA,FLDIEN,FLDNUM,DUR "RTN","BPSOSHF",178,0) ; "RTN","BPSOSHF",179,0) S ORDER=0 "RTN","BPSOSHF",180,0) ; "RTN","BPSOSHF",181,0) F D Q:'ORDER "RTN","BPSOSHF",182,0) . ; "RTN","BPSOSHF",183,0) . ; let's order through the format file for this node "RTN","BPSOSHF",184,0) . ; "RTN","BPSOSHF",185,0) . S ORDER=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER)) Q:'ORDER "RTN","BPSOSHF",186,0) . S RECMIEN=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0)) "RTN","BPSOSHF",187,0) . I 'RECMIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$T(+0)) "RTN","BPSOSHF",188,0) . S MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0) "RTN","BPSOSHF",189,0) . S FLDIEN=$P(MDATA,U,2) "RTN","BPSOSHF",190,0) . I 'FLDIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"RECMIEN="_RECMIEN,3,$T(+0)) ; corrupt or erroneous format file "RTN","BPSOSHF",191,0) . I '$D(^BPSF(9002313.91,FLDIEN,0)) D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"DURPPS",$T(+0)) ;incomplete field definition "RTN","BPSOSHF",192,0) . ; "RTN","BPSOSHF",193,0) . ;lets create a list of fields we need "RTN","BPSOSHF",194,0) . S FLDNUM=$P($G(^BPSF(9002313.91,FLDIEN,0)),U) "RTN","BPSOSHF",195,0) . S:FLDNUM'=111 FIELD(ORDER)=FLDIEN_"^"_FLDNUM "RTN","BPSOSHF",196,0) ; "RTN","BPSOSHF",197,0) ; "RTN","BPSOSHF",198,0) Q "RTN","BPSOSIY") 0^29^B68639944 "RTN","BPSOSIY",1,0) BPSOSIY ;BHAM ISC/FCS/DRS/DLF - Updating BPS Transaction record ;11/7/07 17:29 "RTN","BPSOSIY",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,6,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSIY",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSIY",4,0) Q "RTN","BPSOSIY",5,0) ; "RTN","BPSOSIY",6,0) ; INIT - Update BPS Transaction "RTN","BPSOSIY",7,0) ; Input "RTN","BPSOSIY",8,0) ; IEN59 - BPS Transaction "RTN","BPSOSIY",9,0) ; MOREDATA is not passed but assumed to exist "RTN","BPSOSIY",10,0) ; BP77 - BPS REQUEST ien "RTN","BPSOSIY",11,0) ; Returns "RTN","BPSOSIY",12,0) ; ERROR - 0 or error number "RTN","BPSOSIY",13,0) INIT(IEN59,BP77) ;EP - from BPSOSIZ "RTN","BPSOSIY",14,0) N BPCOB,BPSTIME "RTN","BPSOSIY",15,0) ; "RTN","BPSOSIY",16,0) ; Update the BPS Request with the Transaction IEN "RTN","BPSOSIY",17,0) I $G(BP77)>0 D UPD7759^BPSOSRX4(BP77,IEN59) "RTN","BPSOSIY",18,0) ; "RTN","BPSOSIY",19,0) ; Initialize variables "RTN","BPSOSIY",20,0) N FDA,MSG,FN,IENS,REC,B1,X1,X2,X3,ERROR,SEQ,X4 "RTN","BPSOSIY",21,0) N DIV,RXI,RXR "RTN","BPSOSIY",22,0) S FN=9002313.59,REC=IEN59_",",ERROR=0 "RTN","BPSOSIY",23,0) ; "RTN","BPSOSIY",24,0) ; Change status to 0% (Waiting to Start), which will reset START TIME, "RTN","BPSOSIY",25,0) ; and then to 10% (Building transaction) "RTN","BPSOSIY",26,0) D SETSTAT^BPSOSU(IEN59,0) "RTN","BPSOSIY",27,0) D SETSTAT^BPSOSU(IEN59,10) "RTN","BPSOSIY",28,0) ; "RTN","BPSOSIY",29,0) ; Get the Outpatient Site "RTN","BPSOSIY",30,0) S DIV=MOREDATA("DIVISION") "RTN","BPSOSIY",31,0) I 'DIV,MOREDATA("REQ TYPE")="C" S RXI=$P(IEN59,".",1),RXR=+$E($P(IEN59,".",2),1,4),DIV=$$GETDIV^BPSOSQC(RXI,RXR) "RTN","BPSOSIY",32,0) ; "RTN","BPSOSIY",33,0) ; If there are Prior Auth or Sub Clar Code override, create override "RTN","BPSOSIY",34,0) ; record. Note that setting of MOREDATA("BPOVRIEN") in this routine "RTN","BPSOSIY",35,0) ; will not conflict with prior setting of this value of BPOVRIEN "RTN","BPSOSIY",36,0) ; since BPOVRIEN and BPSAUTH/BPSCLARF are mutually exclusive "RTN","BPSOSIY",37,0) I $G(MOREDATA("BPSAUTH"))]""!($G(MOREDATA("BPSCLARF"))]"")!($G(MOREDATA("BPSDELAY"))]"") S MOREDATA("BPOVRIEN")=$$OVERRIDE(IEN59) "RTN","BPSOSIY",38,0) ; "RTN","BPSOSIY",39,0) ; Set BPSDATA into local variable "RTN","BPSOSIY",40,0) S B1=$G(MOREDATA("BPSDATA",1)) "RTN","BPSOSIY",41,0) ; "RTN","BPSOSIY",42,0) ; Get first record from MOREDATA("IBDATA") as there are some "RTN","BPSOSIY",43,0) ; non-multiple fields that need it "RTN","BPSOSIY",44,0) S X2="",SEQ=$O(MOREDATA("IBDATA","")) "RTN","BPSOSIY",45,0) I SEQ S X2=$G(MOREDATA("IBDATA",SEQ,2)) "RTN","BPSOSIY",46,0) ; "RTN","BPSOSIY",47,0) ; Set non-multiple fields "RTN","BPSOSIY",48,0) S FDA(FN,REC,1.05)=$G(MOREDATA("POLICY")) ; Policy Number "RTN","BPSOSIY",49,0) S FDA(FN,REC,1.07)=$$GETPHARM^BPSUTIL(DIV) ;BPS Pharmacy "RTN","BPSOSIY",50,0) S FDA(FN,REC,1.08)=1 ;PINS piece "RTN","BPSOSIY",51,0) S FDA(FN,REC,1.11)=$G(MOREDATA("RX")) ;Prescription "RTN","BPSOSIY",52,0) I $P($G(^BPST(IEN59,1)),U,12)=1 S FDA(FN,REC,1.12)=2 ;Resubmit after reversal "RTN","BPSOSIY",53,0) S FDA(FN,REC,1.13)=$G(MOREDATA("BPOVRIEN")) ;NCPDP Overrides "RTN","BPSOSIY",54,0) S FDA(FN,REC,5)=$G(MOREDATA("PATIENT")) ;Patient "RTN","BPSOSIY",55,0) I '$P($G(^BPST(IEN59,1)),U,12) S FDA(FN,REC,6)=$G(MOREDATA("SUBMIT TIME")) ;Submit Date/Time "RTN","BPSOSIY",56,0) S FDA(FN,REC,9)=$P(B1,U,4) ;Fill "RTN","BPSOSIY",57,0) S FDA(FN,REC,10)=$P(B1,U,3) ;NDC "RTN","BPSOSIY",58,0) S FDA(FN,REC,11)=DIV ;Outpatient Site "RTN","BPSOSIY",59,0) S FDA(FN,REC,13)=$G(MOREDATA("USER")) ;User "RTN","BPSOSIY",60,0) S FDA(FN,REC,16)=$G(MOREDATA("REQ IEN")) ;Request IEN "RTN","BPSOSIY",61,0) S FDA(FN,REC,17)=$G(MOREDATA("REQ DTTM")) ;Request Date/Time "RTN","BPSOSIY",62,0) S FDA(FN,REC,18)=$G(MOREDATA("PAYER SEQUENCE")) ;COB Indicator "RTN","BPSOSIY",63,0) S FDA(FN,REC,19)=$G(MOREDATA("REQ TYPE")) ;Transaction Type "RTN","BPSOSIY",64,0) S FDA(FN,REC,501)=$P(B1,U,1) ;Drug Quantify "RTN","BPSOSIY",65,0) S FDA(FN,REC,502)=$P(B1,U,2) ;Ingredient Cost "RTN","BPSOSIY",66,0) S FDA(FN,REC,504)=$P(X2,U,1) ;Dispense Fee "RTN","BPSOSIY",67,0) S FDA(FN,REC,505)=$P(X2,U,3) ;Total Price "RTN","BPSOSIY",68,0) S FDA(FN,REC,507)=$P(X2,U,5) ;Administrative Fee "RTN","BPSOSIY",69,0) S FDA(FN,REC,508)=$E($P(B1,U,7),1,2) ;Dispense Unit "RTN","BPSOSIY",70,0) S FDA(FN,REC,901)=1 ;Current VA Insurer "RTN","BPSOSIY",71,0) S FDA(FN,REC,1201)=$G(MOREDATA("RX ACTION")) ;RX Action "RTN","BPSOSIY",72,0) S FDA(FN,REC,1202)=$G(MOREDATA("DATE OF SERVICE")) ;Date of Service "RTN","BPSOSIY",73,0) S FDA(FN,REC,901.04)=$G(MOREDATA("ELIG")) ;Eligibility info returned from billing determination "RTN","BPSOSIY",74,0) ; "RTN","BPSOSIY",75,0) ; File secondary billing fields "RTN","BPSOSIY",76,0) I $$COB59^BPSUTIL2(IEN59)=2 D SECBIL59^BPSPRRX6(.MOREDATA,IEN59) "RTN","BPSOSIY",77,0) ; File non-multiple fields - Record is already defined "RTN","BPSOSIY",78,0) D FILE^DIE("","FDA","MSG") "RTN","BPSOSIY",79,0) I $D(MSG) D Q ERROR "RTN","BPSOSIY",80,0) . S ERROR=12 "RTN","BPSOSIY",81,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Non-multiple fields did not file") "RTN","BPSOSIY",82,0) . D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",83,0) . D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",84,0) . D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",85,0) . D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",86,0) ; "RTN","BPSOSIY",87,0) ; Build Multiple "RTN","BPSOSIY",88,0) S SEQ="" "RTN","BPSOSIY",89,0) F S SEQ=$O(MOREDATA("IBDATA",SEQ)) Q:SEQ="" D I ERROR Q "RTN","BPSOSIY",90,0) . K FDA,MSG,IENS "RTN","BPSOSIY",91,0) . S FN=9002313.59902,IENS="+1,"_REC,IENS(1)=SEQ "RTN","BPSOSIY",92,0) . S X1=$G(MOREDATA("IBDATA",SEQ,1)),X2=$G(MOREDATA("IBDATA",SEQ,2)),X3=$G(MOREDATA("IBDATA",SEQ,3)),X4=$G(MOREDATA("IBDATA",SEQ,4)) "RTN","BPSOSIY",93,0) . ; "RTN","BPSOSIY",94,0) . ; Update fields "RTN","BPSOSIY",95,0) . S FDA(FN,IENS,.01)=$P(X1,U,1) ;Plan ID "RTN","BPSOSIY",96,0) . S FDA(FN,IENS,902.02)=$P(X1,U,16) ;B1 Payer Sheet (Billing Request) "RTN","BPSOSIY",97,0) . S FDA(FN,IENS,902.03)=$P(X1,U,2) ;BIN "RTN","BPSOSIY",98,0) . S FDA(FN,IENS,902.04)=$P(X1,U,3) ;PCN "RTN","BPSOSIY",99,0) . S FDA(FN,IENS,902.05)=$P(X1,U,5) ;Group ID "RTN","BPSOSIY",100,0) . S FDA(FN,IENS,902.06)=$P(X1,U,6) ;Cardholder ID "RTN","BPSOSIY",101,0) . S FDA(FN,IENS,902.07)=$S(+$P(X1,U,7)>4:4,1:+$P(X1,U,7)) ;Patient Relationship Code "RTN","BPSOSIY",102,0) . S FDA(FN,IENS,902.08)=$P($P(X1,U,8)," ") ;Cardholder First Name "RTN","BPSOSIY",103,0) . S FDA(FN,IENS,902.09)=$P(X1,U,9) ;Cardholder Last Name "RTN","BPSOSIY",104,0) . S FDA(FN,IENS,902.11)=$P(X1,U,10) ;Home Plan State "RTN","BPSOSIY",105,0) . S FDA(FN,IENS,902.12)=$P(X2,U,1) ;Dispense Fee "RTN","BPSOSIY",106,0) . S FDA(FN,IENS,902.13)=$P(X2,U,2) ;Basis of Cost Determination "RTN","BPSOSIY",107,0) . S FDA(FN,IENS,902.14)=$P(X2,U,3) ;Usual & Customary Charge "RTN","BPSOSIY",108,0) . S FDA(FN,IENS,902.15)=$P(X2,U,4) ;Gross Amt Due "RTN","BPSOSIY",109,0) . S FDA(FN,IENS,902.16)=$P(X2,U,5) ;Administrative Fee "RTN","BPSOSIY",110,0) . S FDA(FN,IENS,902.17)=$P(B1,U,4) ;Fill Number "RTN","BPSOSIY",111,0) . S FDA(FN,IENS,902.18)=$P(X1,U,13) ;Software/Vendor Cert ID "RTN","BPSOSIY",112,0) . S FDA(FN,IENS,902.19)=$P(X1,U,17) ;B2 Payer Sheet (Reversal) "RTN","BPSOSIY",113,0) . S FDA(FN,IENS,902.21)=$P(X1,U,18) ;B3 Payer Sheet (Rebill) "RTN","BPSOSIY",114,0) . S FDA(FN,IENS,902.22)=$P(B1,U,5) ;Certify Mode "RTN","BPSOSIY",115,0) . S FDA(FN,IENS,902.23)=$P(B1,U,6) ;Certification IEN "RTN","BPSOSIY",116,0) . S FDA(FN,IENS,902.24)=$P(X1,U,14) ;Plan Name "RTN","BPSOSIY",117,0) . S FDA(FN,IENS,902.25)=$P(X3,U,1) ;Group Name "RTN","BPSOSIY",118,0) . S FDA(FN,IENS,902.26)=$P(X3,U,2) ;Insurance Co Phone # "RTN","BPSOSIY",119,0) . S FDA(FN,IENS,902.27)=$P(X3,U,3) ;Pharmacy Plan ID "RTN","BPSOSIY",120,0) . S FDA(FN,IENS,902.28)=$P(X3,U,4) ;Eligibility "RTN","BPSOSIY",121,0) . S FDA(FN,IENS,902.32)=$P(X3,U,6) ;COB Indicator "RTN","BPSOSIY",122,0) . S FDA(FN,IENS,902.33)=$P(X3,U,5) ;Insurance Co IEN "RTN","BPSOSIY",123,0) . S FDA(FN,IENS,902.34)=$P(X1,U,19) ;E1 Payer Sheet (Eligibility) "RTN","BPSOSIY",124,0) . S FDA(FN,IENS,902.35)=$P(X3,U,7) ;Policy Number "RTN","BPSOSIY",125,0) . S FDA(FN,IENS,902.36)=$P(X3,U,8) ;Max Transactions/Transmission "RTN","BPSOSIY",126,0) . ;the following fields are used only for secondary billing and for primary Tricare billing "RTN","BPSOSIY",127,0) . ;in both cases only entry = 1 in the multiple will be created EVEN if the sequence is 2 (for secondary) "RTN","BPSOSIY",128,0) . ;Note: actually only the entry = 1 is used for primary billing as well, others are never used "RTN","BPSOSIY",129,0) . I SEQ=1 D "RTN","BPSOSIY",130,0) . . S FDA(FN,IENS,902.29)=$G(MOREDATA("RTYPE")) ;Rate Type "RTN","BPSOSIY",131,0) . . S FDA(FN,IENS,902.3)=$G(MOREDATA("PRIMARY BILL")) ;Primary bill ien "RTN","BPSOSIY",132,0) . . S FDA(FN,IENS,902.31)=$G(MOREDATA("PRIOR PAYMENT")) ;Prior payment amount "RTN","BPSOSIY",133,0) . ; "RTN","BPSOSIY",134,0) . ; File the data "RTN","BPSOSIY",135,0) . D UPDATE^DIE("","FDA","IENS","MSG") "RTN","BPSOSIY",136,0) . I $D(MSG) D "RTN","BPSOSIY",137,0) .. S ERROR=13 "RTN","BPSOSIY",138,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-Multiple fields did not file, SEQ="_SEQ) "RTN","BPSOSIY",139,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",140,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",141,0) .. D LOG^BPSOSL(IEN59,"IENS Array:") "RTN","BPSOSIY",142,0) .. D LOGARRAY^BPSOSL(IEN59,"IENS") "RTN","BPSOSIY",143,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",144,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",145,0) ; "RTN","BPSOSIY",146,0) ; Quit if there was an error filing the Insurance multiple "RTN","BPSOSIY",147,0) I ERROR Q ERROR "RTN","BPSOSIY",148,0) ; "RTN","BPSOSIY",149,0) ; Store DUR multiple if it exists "RTN","BPSOSIY",150,0) N DUR,DURREC "RTN","BPSOSIY",151,0) S FN=9002313.5913,DUR=0 "RTN","BPSOSIY",152,0) F S DUR=$O(MOREDATA("DUR",DUR)) Q:DUR="" D I ERROR Q "RTN","BPSOSIY",153,0) . K FDA,MSG,IENS "RTN","BPSOSIY",154,0) . S DURREC=$G(MOREDATA("DUR",DUR,0)) "RTN","BPSOSIY",155,0) . S IENS="+1,"_REC,IENS(1)=DUR "RTN","BPSOSIY",156,0) . S FDA(FN,IENS,.01)=DUR ; DUR Counter "RTN","BPSOSIY",157,0) . S FDA(FN,IENS,1)=$P(DURREC,U,1) ; DUR Professional Service Code "RTN","BPSOSIY",158,0) . S FDA(FN,IENS,2)=$P(DURREC,U,2) ; DUR Reason for Service Code "RTN","BPSOSIY",159,0) . S FDA(FN,IENS,3)=$P(DURREC,U,3) ; DUR Result of Service Code "RTN","BPSOSIY",160,0) . D UPDATE^DIE("","FDA","IENS","MSG") "RTN","BPSOSIY",161,0) . I $D(MSG) D "RTN","BPSOSIY",162,0) .. S ERROR=15 "RTN","BPSOSIY",163,0) .. D LOG^BPSOSL(IEN59,$T(+0)_"-DUR fields did not file, DUR="_DUR) "RTN","BPSOSIY",164,0) .. D LOG^BPSOSL(IEN59,"DURREC="_DURREC) "RTN","BPSOSIY",165,0) .. D LOG^BPSOSL(IEN59,"MSG Array:") "RTN","BPSOSIY",166,0) .. D LOGARRAY^BPSOSL(IEN59,"MSG") "RTN","BPSOSIY",167,0) .. D LOG^BPSOSL(IEN59,"IENS Array:") "RTN","BPSOSIY",168,0) .. D LOGARRAY^BPSOSL(IEN59,"IENS") "RTN","BPSOSIY",169,0) .. D LOG^BPSOSL(IEN59,"FDA Array:") "RTN","BPSOSIY",170,0) .. D LOGARRAY^BPSOSL(IEN59,"FDA") "RTN","BPSOSIY",171,0) ; "RTN","BPSOSIY",172,0) Q ERROR "RTN","BPSOSIY",173,0) ; "RTN","BPSOSIY",174,0) ; OVERRIDE - Function to create override record "RTN","BPSOSIY",175,0) OVERRIDE(IEN59) ; "RTN","BPSOSIY",176,0) ;Save values into BPS NCPDP OVERRIDES (#9002313.511) "RTN","BPSOSIY",177,0) N BPSFDA,BPSFLD,BPOVRIEN,BPSMSG,BPSQ,BPSVALUE "RTN","BPSOSIY",178,0) ; "RTN","BPSOSIY",179,0) ; Set Name (.01) to transaction number "RTN","BPSOSIY",180,0) S BPSFDA(9002313.511,"+1,",.01)=IEN59 "RTN","BPSOSIY",181,0) ; "RTN","BPSOSIY",182,0) ; Set Created On (.02) to current date/time "RTN","BPSOSIY",183,0) S BPSFDA(9002313.511,"+1,",.02)=$$NOW^BPSOSRX() "RTN","BPSOSIY",184,0) ; "RTN","BPSOSIY",185,0) ; Submission Clarification Code "RTN","BPSOSIY",186,0) I $G(MOREDATA("BPSCLARF"))]"" D "RTN","BPSOSIY",187,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",420,"")) "RTN","BPSOSIY",188,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+2,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+2,+1,",.02)=$E(MOREDATA("BPSCLARF"),1,8) "RTN","BPSOSIY",189,0) ; "RTN","BPSOSIY",190,0) ; Prior Auth Fields (Code and Number) "RTN","BPSOSIY",191,0) I $G(MOREDATA("BPSAUTH"))]"" D "RTN","BPSOSIY",192,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",461,"")) "RTN","BPSOSIY",193,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+3,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+3,+1,",.02)=$E($P(MOREDATA("BPSAUTH"),U,1),1,2) "RTN","BPSOSIY",194,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",462,"")) "RTN","BPSOSIY",195,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+4,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+4,+1,",.02)=$E($P(MOREDATA("BPSAUTH"),U,2),1,11) "RTN","BPSOSIY",196,0) ; "RTN","BPSOSIY",197,0) ; Delay Reason Code - This is the IEN of the database "RTN","BPSOSIY",198,0) I $G(MOREDATA("BPSDELAY"))]"" D "RTN","BPSOSIY",199,0) . S BPSVALUE=$P($G(^BPS(9002313.29,MOREDATA("BPSDELAY"),0)),U,1) "RTN","BPSOSIY",200,0) . I BPSVALUE="" Q "RTN","BPSOSIY",201,0) . S BPSFLD=$O(^BPSF(9002313.91,"B",357,"")) "RTN","BPSOSIY",202,0) . I BPSFLD]"" S BPSFDA(9002313.5111,"+5,+1,",.01)=BPSFLD,BPSFDA(9002313.5111,"+5,+1,",.02)=$E(MOREDATA("BPSDELAY"),1,2) "RTN","BPSOSIY",203,0) ; "RTN","BPSOSIY",204,0) ; Create the record "RTN","BPSOSIY",205,0) D UPDATE^DIE("","BPSFDA","BPOVRIEN","BPSMSG") "RTN","BPSOSIY",206,0) ; "RTN","BPSOSIY",207,0) I $G(BPOVRIEN(1))]"" S BPSQ=BPOVRIEN(1) "RTN","BPSOSIY",208,0) E S BPSQ="" "RTN","BPSOSIY",209,0) Q BPSQ "RTN","BPSOSIZ") 0^30^B13539436 "RTN","BPSOSIZ",1,0) BPSOSIZ ;BHAM ISC/FCS/DRS/DLF - Filing BPS Transaction ;06/01/2004 "RTN","BPSOSIZ",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSIZ",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSIZ",4,0) ; "RTN","BPSOSIZ",5,0) Q "RTN","BPSOSIZ",6,0) ; "RTN","BPSOSIZ",7,0) ; EN - Create and/or update BPS Transaction "RTN","BPSOSIZ",8,0) ; Input "RTN","BPSOSIZ",9,0) ; IEN59 - BPS Transaction number "RTN","BPSOSIZ",10,0) ; MOREDATA - Array of data created by BPSNCPD* "RTN","BPSOSIZ",11,0) ; BP77 - BPS REQUEST file ien "RTN","BPSOSIZ",12,0) EN(IEN59,MOREDATA,BP77) ;EP - BPSOSRB "RTN","BPSOSIZ",13,0) ; Initialize variables "RTN","BPSOSIZ",14,0) N EXISTS,ERROR,X "RTN","BPSOSIZ",15,0) S ERROR=0 "RTN","BPSOSIZ",16,0) ; "RTN","BPSOSIZ",17,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Building Transaction") "RTN","BPSOSIZ",18,0) ; "RTN","BPSOSIZ",19,0) ; Lock the transaction "RTN","BPSOSIZ",20,0) I '$$LOCK59(IEN59) D ERROR(BP77,IEN59,"Could not lock the BPS Transaction") Q "RTN","BPSOSIZ",21,0) ; "RTN","BPSOSIZ",22,0) ; Make sure that the record is not already IN PROGRESS "RTN","BPSOSIZ",23,0) S X=+$$STATUS59^BPSOSRX(IEN59) "RTN","BPSOSIZ",24,0) I X'=0,X'=31,X'=99 D ERROR(BP77,IEN59,"STATUS is "_X) Q "RTN","BPSOSIZ",25,0) ; "RTN","BPSOSIZ",26,0) ; Check if the BPS Transaction exists "RTN","BPSOSIZ",27,0) S EXISTS=$$EXIST59(IEN59) "RTN","BPSOSIZ",28,0) ; "RTN","BPSOSIZ",29,0) ; If the record exists, delete all but the essential fields "RTN","BPSOSIZ",30,0) I EXISTS D CLEAR59(IEN59) "RTN","BPSOSIZ",31,0) ; "RTN","BPSOSIZ",32,0) ; If the record does not exist, create new record and validate the IEN "RTN","BPSOSIZ",33,0) I 'EXISTS S X=$$NEW59(IEN59) I X'=IEN59 D ERROR(BP77,IEN59,"NEW59 returned "_X) Q "RTN","BPSOSIZ",34,0) ; "RTN","BPSOSIZ",35,0) ; Update the fields. If error is returned, log to the BPS Transaction, which "RTN","BPSOSIZ",36,0) ; we know exists at this point "RTN","BPSOSIZ",37,0) S ERROR=$$INIT^BPSOSIY(IEN59,BP77) ;MOREDATA is passed in background "RTN","BPSOSIZ",38,0) I ERROR D ERROR^BPSOSU($T(+0),IEN59,ERROR,"BPS Transaction not updated"),UNLOCK59(IEN59) Q "RTN","BPSOSIZ",39,0) ; "RTN","BPSOSIZ",40,0) ; Validate the transaction "RTN","BPSOSIZ",41,0) D ONE59^BPSOSQA(IEN59) "RTN","BPSOSIZ",42,0) ; "RTN","BPSOSIZ",43,0) ; Unlock the transaction "RTN","BPSOSIZ",44,0) D UNLOCK59(IEN59) "RTN","BPSOSIZ",45,0) Q "RTN","BPSOSIZ",46,0) ; "RTN","BPSOSIZ",47,0) ; LOCK59 - Lock Transaction "RTN","BPSOSIZ",48,0) LOCK59(IEN59) ; "RTN","BPSOSIZ",49,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Lock BPS Transaction") "RTN","BPSOSIZ",50,0) L +^BPST(IEN59):5 "RTN","BPSOSIZ",51,0) Q $T "RTN","BPSOSIZ",52,0) ; "RTN","BPSOSIZ",53,0) ; UNLOCK59 - Unlock record "RTN","BPSOSIZ",54,0) UNLOCK59(IEN59) ; "RTN","BPSOSIZ",55,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Unlock BPS Transaction") "RTN","BPSOSIZ",56,0) L -^BPST(IEN59) "RTN","BPSOSIZ",57,0) Q "RTN","BPSOSIZ",58,0) ; "RTN","BPSOSIZ",59,0) ; EXISTS - See if the BPS Transaction already exists "RTN","BPSOSIZ",60,0) EXIST59(IEN59) ; "RTN","BPSOSIZ",61,0) N X "RTN","BPSOSIZ",62,0) S X=$$FIND1^DIC(9002313.59,,"QX","`"_IEN59) "RTN","BPSOSIZ",63,0) Q $S(X>0:X,X=0:0) "RTN","BPSOSIZ",64,0) ; "RTN","BPSOSIZ",65,0) ; NEW59 - Create a new BPS Transaction record "RTN","BPSOSIZ",66,0) ; IEN59 - BPS TRANSACTION ien "RTN","BPSOSIZ",67,0) NEW59(IEN59) ; "RTN","BPSOSIZ",68,0) ; Initialize variables "RTN","BPSOSIZ",69,0) N FDA,IEN,MSG,FN,BPSTIME,BPCOB "RTN","BPSOSIZ",70,0) ; "RTN","BPSOSIZ",71,0) ; The .01 node and IEN should be the transaction number "RTN","BPSOSIZ",72,0) S FN=9002313.59 "RTN","BPSOSIZ",73,0) S (IEN(1),FDA(FN,"+1,",.01))=IEN59 "RTN","BPSOSIZ",74,0) ; "RTN","BPSOSIZ",75,0) ; Create the new BPS Transaction record "RTN","BPSOSIZ",76,0) D UPDATE^DIE("","FDA","IEN","MSG") "RTN","BPSOSIZ",77,0) I $D(MSG) Q 0 "RTN","BPSOSIZ",78,0) Q IEN(1) "RTN","BPSOSIZ",79,0) ; "RTN","BPSOSIZ",80,0) ; CLEAR59 - If it exists, clear out the old values "RTN","BPSOSIZ",81,0) CLEAR59(IEN59) ; "RTN","BPSOSIZ",82,0) ; Deletes all values except for fields: "RTN","BPSOSIZ",83,0) ; Entry # (.01) "RTN","BPSOSIZ",84,0) ; Resubmit after reversal (1.12) "RTN","BPSOSIZ",85,0) ; Result Text (202) "RTN","BPSOSIZ",86,0) ; Comments (111 multiple) "RTN","BPSOSIZ",87,0) ; If reverse/resubmit, then also do not clear fields: "RTN","BPSOSIZ",88,0) ; Status (1) "RTN","BPSOSIZ",89,0) ; Submit Date/Time (6) "RTN","BPSOSIZ",90,0) ; Last Update (7) "RTN","BPSOSIZ",91,0) ; Start Date (15) "RTN","BPSOSIZ",92,0) ; "RTN","BPSOSIZ",93,0) ; Initialize variables "RTN","BPSOSIZ",94,0) N FN,FDA,MSG,FIELD,SKIP,ENTRY "RTN","BPSOSIZ",95,0) S FN=9002313.59 "RTN","BPSOSIZ",96,0) ; "RTN","BPSOSIZ",97,0) ; Set up fields that we do not want to delete "RTN","BPSOSIZ",98,0) S SKIP(1.12)="",SKIP(202)="" "RTN","BPSOSIZ",99,0) I $G(MOREDATA("REVERSE THEN RESUBMIT"))=1 S SKIP(1)="",SKIP(6)="",SKIP(7)="",SKIP(15)="" "RTN","BPSOSIZ",100,0) ; "RTN","BPSOSIZ",101,0) ; Start with field .01 so it will not be deleted "RTN","BPSOSIZ",102,0) ; Place 'non-skip' fields in FDA to be deleted "RTN","BPSOSIZ",103,0) S FIELD=.01 "RTN","BPSOSIZ",104,0) F S FIELD=$O(^DD(FN,FIELD)) Q:'FIELD I '$D(SKIP(FIELD)) S FDA(FN,IEN59_",",FIELD)="" "RTN","BPSOSIZ",105,0) ; "RTN","BPSOSIZ",106,0) ; Delete Insurance multiple "RTN","BPSOSIZ",107,0) S FN=9002313.59902,ENTRY=0 "RTN","BPSOSIZ",108,0) F S ENTRY=$O(^BPST(IEN59,10,ENTRY)) Q:ENTRY="B"!(ENTRY="") D "RTN","BPSOSIZ",109,0) . S FDA(FN,ENTRY_","_IEN59_",",.01)="" "RTN","BPSOSIZ",110,0) ; "RTN","BPSOSIZ",111,0) ; Delete DUR multiple "RTN","BPSOSIZ",112,0) S FN=9002313.5913,ENTRY=0 "RTN","BPSOSIZ",113,0) F S ENTRY=$O(^BPST(IEN59,13,ENTRY)) Q:+ENTRY=0 D "RTN","BPSOSIZ",114,0) . S FDA(FN,ENTRY_","_IEN59_",",.01)="" "RTN","BPSOSIZ",115,0) ; "RTN","BPSOSIZ",116,0) ; Delete COB OTHER PAYERS multiple "RTN","BPSOSIZ",117,0) S FN=9002313.5914,ENTRY=0 "RTN","BPSOSIZ",118,0) F S ENTRY=$O(^BPST(IEN59,14,ENTRY)) Q:'ENTRY D "RTN","BPSOSIZ",119,0) . S FDA(FN,ENTRY_","_IEN59_",",.01)="" "RTN","BPSOSIZ",120,0) ; "RTN","BPSOSIZ",121,0) ; Fileman call to do the delete "RTN","BPSOSIZ",122,0) D FILE^DIE("","FDA","MSG") "RTN","BPSOSIZ",123,0) ; "RTN","BPSOSIZ",124,0) ; Update Result Text File with 'PREVIOUSLY[' "RTN","BPSOSIZ",125,0) D PREVISLY(IEN59) ; for result text field 202 "RTN","BPSOSIZ",126,0) Q "RTN","BPSOSIZ",127,0) ; "RTN","BPSOSIZ",128,0) ; PREVISLY - Add semicolon in between the result text "RTN","BPSOSIZ",129,0) PREVISLY(IEN59) ;EP - BPSOSRB, BPSOSU "RTN","BPSOSIZ",130,0) N X "RTN","BPSOSIZ",131,0) S X=$$GET1^DIQ(9002313.59,IEN59,202) "RTN","BPSOSIZ",132,0) I X="" Q "RTN","BPSOSIZ",133,0) S X=$E(";"_X,1,200) "RTN","BPSOSIZ",134,0) N FN,FDA,MSG "RTN","BPSOSIZ",135,0) S FDA(9002313.59,IEN59_",",202)=X "RTN","BPSOSIZ",136,0) D FILE^DIE("","FDA","MSG") "RTN","BPSOSIZ",137,0) Q "RTN","BPSOSIZ",138,0) ; "RTN","BPSOSIZ",139,0) ; ERROR - Log an error to the log "RTN","BPSOSIZ",140,0) ERROR(BP77,IEN59,ERROR) ; "RTN","BPSOSIZ",141,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Calling BPSOSRB to handle error") "RTN","BPSOSIZ",142,0) D ERROR^BPSOSRB(BP77,IEN59,ERROR) "RTN","BPSOSIZ",143,0) D UNLOCK59(IEN59) "RTN","BPSOSIZ",144,0) Q "RTN","BPSOSL") 0^60^B6601315 "RTN","BPSOSL",1,0) BPSOSL ;BHAM ISC/FCS/DRS/DLF - Logging ;06/01/2004 "RTN","BPSOSL",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOSL",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSL",4,0) Q "RTN","BPSOSL",5,0) ; Entry Points: "RTN","BPSOSL",6,0) ; LOG - Log a message "RTN","BPSOSL",7,0) ; LOG2CLM - Log a message to all transactions associated with a claim "RTN","BPSOSL",8,0) ; LOG2LIST - Log a message for all transactions in TRANLIST "RTN","BPSOSL",9,0) ; LOGARRAY - Log array data into the transaction "RTN","BPSOSL",10,0) ; LOGARAY2 - Log array data into all transactions associated with a claim "RTN","BPSOSL",11,0) ; "RTN","BPSOSL",12,0) ; SLOT is usually a BPS Transaction, but can also be a communication log "RTN","BPSOSL",13,0) ; The only communication log currently is for purging (format is DT+.5) "RTN","BPSOSL",14,0) ; "RTN","BPSOSL",15,0) ; LOG - Add an entry to BPS LOG "RTN","BPSOSL",16,0) ; Input "RTN","BPSOSL",17,0) ; SLOT - Slot to write message (required) "RTN","BPSOSL",18,0) ; TEXT - Message text (required) "RTN","BPSOSL",19,0) ; SPECIAL - Special processing (add date and/or time to TEXT "RTN","BPSOSL",20,0) ; If it contains a 'D', add Date "RTN","BPSOSL",21,0) ; If it contains a 'T', add time "RTN","BPSOSL",22,0) LOG(SLOT,TEXT,SPECIAL) ; "RTN","BPSOSL",23,0) ; Check parameters "RTN","BPSOSL",24,0) I $G(SLOT)="" Q "RTN","BPSOSL",25,0) I $G(TEXT)="" Q "RTN","BPSOSL",26,0) ; "RTN","BPSOSL",27,0) ; Do SPECIAL processing "RTN","BPSOSL",28,0) I $G(SPECIAL)]"",SPECIAL["D"!(SPECIAL["T") D "RTN","BPSOSL",29,0) . N %,%H,%I,X,Y D NOW^%DTC S Y=% X ^DD("DD") "RTN","BPSOSL",30,0) . I SPECIAL'["D" S Y=$P(Y,"@",2) "RTN","BPSOSL",31,0) . I SPECIAL'["T" S Y=$P(Y,"@") "RTN","BPSOSL",32,0) . S TEXT=TEXT_" - "_Y "RTN","BPSOSL",33,0) ; "RTN","BPSOSL",34,0) ; Initialize variables "RTN","BPSOSL",35,0) N FN,FDA,LOGIEN,IEN,MSG,NOW "RTN","BPSOSL",36,0) S FN=9002313.12,NOW=$$NOW^XLFDT() "RTN","BPSOSL",37,0) ; "RTN","BPSOSL",38,0) ; If SLOT not defined, create it and then check for errors "RTN","BPSOSL",39,0) S LOGIEN=$O(^BPS(FN,"B",SLOT,"")) "RTN","BPSOSL",40,0) I 'LOGIEN D "RTN","BPSOSL",41,0) . S FDA(FN,"+1,",.01)=SLOT "RTN","BPSOSL",42,0) . D UPDATE^DIE("","FDA","IEN","MSG") "RTN","BPSOSL",43,0) . S LOGIEN=$G(IEN(1)) "RTN","BPSOSL",44,0) I 'LOGIEN!$D(MSG) Q "RTN","BPSOSL",45,0) ; "RTN","BPSOSL",46,0) ; Update LAST UPDATE field "RTN","BPSOSL",47,0) K FDA,MSG "RTN","BPSOSL",48,0) S FDA(FN,LOGIEN_",",.02)=NOW "RTN","BPSOSL",49,0) D FILE^DIE("","FDA","MSG") "RTN","BPSOSL",50,0) I $D(MSG) Q "RTN","BPSOSL",51,0) ; "RTN","BPSOSL",52,0) ; Create the multiple "RTN","BPSOSL",53,0) K FDA "RTN","BPSOSL",54,0) S FN=9002313.1201 "RTN","BPSOSL",55,0) S FDA(FN,"+1,"_LOGIEN_",",.01)=NOW "RTN","BPSOSL",56,0) S FDA(FN,"+1,"_LOGIEN_",",1)=$TR($E(TEXT,1,200),"^","~") "RTN","BPSOSL",57,0) D UPDATE^DIE("","FDA") "RTN","BPSOSL",58,0) Q "RTN","BPSOSL",59,0) ; "RTN","BPSOSL",60,0) ; LOG2CLM - Write MSG to log file for all BPS Transactions associated "RTN","BPSOSL",61,0) ; with the claim "RTN","BPSOSL",62,0) LOG2CLM(IEN02,MSG) ; "RTN","BPSOSL",63,0) N IEN59 S IEN59=0 "RTN","BPSOSL",64,0) F S IEN59=$O(^BPST("AE",IEN02,IEN59)) Q:'IEN59 D LOG(IEN59,MSG) "RTN","BPSOSL",65,0) Q "RTN","BPSOSL",66,0) ; "RTN","BPSOSL",67,0) ; LOG2LIST - Write MSG to the log files of all in TRANLIST(*) "RTN","BPSOSL",68,0) ; Assumes TRANLIST exists "RTN","BPSOSL",69,0) LOG2LIST(MSG) ; "RTN","BPSOSL",70,0) N IEN59 "RTN","BPSOSL",71,0) S IEN59=0 "RTN","BPSOSL",72,0) F S IEN59=$O(TRANLIST(IEN59)) Q:'IEN59 D LOG(IEN59,MSG) "RTN","BPSOSL",73,0) Q "RTN","BPSOSL",74,0) ; "RTN","BPSOSL",75,0) ; LOGARRAY - Log an array "RTN","BPSOSL",76,0) LOGARRAY(SLOT,ROOT,MAX) ; "RTN","BPSOSL",77,0) N REF S REF=ROOT "RTN","BPSOSL",78,0) N COUNT S COUNT=0 "RTN","BPSOSL",79,0) I '$D(MAX) S MAX=100 "RTN","BPSOSL",80,0) I $D(@REF)#10'=1 S REF=$Q(@REF) "RTN","BPSOSL",81,0) F Q:REF="" D Q:'MAX "RTN","BPSOSL",82,0) . D LOG(SLOT,REF_"="_@REF) "RTN","BPSOSL",83,0) . S COUNT=COUNT+1 "RTN","BPSOSL",84,0) . S REF=$Q(@REF) "RTN","BPSOSL",85,0) . S MAX=MAX-1 "RTN","BPSOSL",86,0) I 'MAX,REF]"" D LOG(SLOT,"More of "_ROOT_" to log, but max reached") "RTN","BPSOSL",87,0) I 'COUNT D LOG(SLOT,"Nothing found in "_ROOT) "RTN","BPSOSL",88,0) Q "RTN","BPSOSL",89,0) ; "RTN","BPSOSL",90,0) ; LOGARAY2 - Log an array to the BPS Transactions associated with a claim "RTN","BPSOSL",91,0) LOGARAY2(IEN02,ROOT,MAX) ; "RTN","BPSOSL",92,0) N IEN59 "RTN","BPSOSL",93,0) S IEN59=0 "RTN","BPSOSL",94,0) F S IEN59=$O(^BPST("AE",IEN02,IEN59)) Q:'IEN59 D LOGARRAY(IEN59,ROOT,MAX) "RTN","BPSOSL",95,0) Q "RTN","BPSOSO2") 0^3^B33642927 "RTN","BPSOSO2",1,0) BPSOSO2 ;BHAM ISC/FCS/DRS/DLF - NCPDP Override-Fman utils ;06/01/2004 "RTN","BPSOSO2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,10**;JUN 2004;Build 27 "RTN","BPSOSO2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSO2",4,0) Q "RTN","BPSOSO2",5,0) ; EDIT,EDITGEN are called from the menus in BPSOSO1, "RTN","BPSOSO2",6,0) ; typically reached from the pharmacy package's call "RTN","BPSOSO2",7,0) ; to OVERRIDE^BPSOSO "RTN","BPSOSO2",8,0) ; GET511 called from BPSOSCD during claim construction "RTN","BPSOSO2",9,0) ; "RTN","BPSOSO2",10,0) ;IHS/SD/lwj 8/01/02 NCPDP 5.1 changes to GET511 subroutine "RTN","BPSOSO2",11,0) ; Routine was changed to look at an exceptions list, if the "RTN","BPSOSO2",12,0) ; field being processed is in the exceptions list it will "RTN","BPSOSO2",13,0) ; create a "claim header" and "claim rx" entry. The reason "RTN","BPSOSO2",14,0) ; for this is that several 300 range fields were moved to the "RTN","BPSOSO2",15,0) ; claim rx area within the 5.1 segments creating duplicate flds. "RTN","BPSOSO2",16,0) ; (i.e. the <402 and >402 rule is no longer valid) "RTN","BPSOSO2",17,0) ; "RTN","BPSOSO2",18,0) ; subroutine PRIORA added to handle the input of the prior "RTN","BPSOSO2",19,0) ; authorization information at prescription creation time. "RTN","BPSOSO2",20,0) ; "RTN","BPSOSO2",21,0) EDIT(IEN,FIELDNUM) ; "RTN","BPSOSO2",22,0) I '$D(FIELDNUM) D EDITGEN(IEN) Q "RTN","BPSOSO2",23,0) ; Editing one field "RTN","BPSOSO2",24,0) N DIE,DA,DR,DIDEL,DTOUT,FIELDNAM "RTN","BPSOSO2",25,0) S DA=$$HASVALUE(IEN,FIELDNUM) "RTN","BPSOSO2",26,0) ; Make sure the entry exists in the subfile. "RTN","BPSOSO2",27,0) ; Create an empty one if necessary. "RTN","BPSOSO2",28,0) I 'DA S DA=$$SETVALUE(IEN,FIELDNUM,"") "RTN","BPSOSO2",29,0) ; edit the value field in the subfile "RTN","BPSOSO2",30,0) S DIE="^BPS(9002313.511,"_IEN_",1,",DA(1)=IEN "RTN","BPSOSO2",31,0) S DR=.02_$TR($$FIELDNAM(FIELDNUM),""";~","") "RTN","BPSOSO2",32,0) D ^DIE "RTN","BPSOSO2",33,0) ; If the value is null, then delete the entire FIELDNUM entry "RTN","BPSOSO2",34,0) I $$GETVALUE(IEN,FIELDNUM)="" D DELVALUE(IEN,FIELDNUM) "RTN","BPSOSO2",35,0) Q "RTN","BPSOSO2",36,0) ; "RTN","BPSOSO2",37,0) EDITGEN(IEN) ; general edit "RTN","BPSOSO2",38,0) ; First pass: quick & dirty Fileman ^DIE call "RTN","BPSOSO2",39,0) ; Future: Screenman interface "RTN","BPSOSO2",40,0) N DIE,DA,DR,DIDEL,DTOUT "RTN","BPSOSO2",41,0) S DA=IEN,DIE=$$FILENUM,DR=1 D ^DIE "RTN","BPSOSO2",42,0) ; And we need to delete any entries with null values "RTN","BPSOSO2",43,0) N A S A=0 F S A=$O(^BPS(9002313.511,IEN,1,A)) Q:'A D "RTN","BPSOSO2",44,0) . N X S X=^BPS(9002313.511,IEN,1,A,0) "RTN","BPSOSO2",45,0) . I $P(X,U,2)="" D "RTN","BPSOSO2",46,0) . . N FIELDNUM S FIELDNUM=$P(^BPSF(9002313.91,$P(X,U),0),U) "RTN","BPSOSO2",47,0) . . D DELVALUE(IEN,FIELDNUM) "RTN","BPSOSO2",48,0) Q "RTN","BPSOSO2",49,0) GET511(IEN,ARR101,ARR402) ;function, called from BPSOSCD - load arrays with data from IEN "RTN","BPSOSO2",50,0) ; "RTN","BPSOSO2",51,0) N A,BPFLDNUM,C,F,HDRLST,MULTLST,TFLD,X "RTN","BPSOSO2",52,0) ; "RTN","BPSOSO2",53,0) ; Build exception lists "RTN","BPSOSO2",54,0) S HDRLST=",524,",MULTLST=",147,308,315,316,317,318,319,320,327,357," "RTN","BPSOSO2",55,0) ; "RTN","BPSOSO2",56,0) S A=0,C=0 "RTN","BPSOSO2",57,0) F S A=$O(^BPS(9002313.511,IEN,1,A)) Q:'A D "RTN","BPSOSO2",58,0) . S X=^BPS(9002313.511,IEN,1,A,0) "RTN","BPSOSO2",59,0) . S F=$P(X,U) ; Field IEN, points to 9002313.91 "RTN","BPSOSO2",60,0) . ; Store in either claim header or claim detail, based on field # "RTN","BPSOSO2",61,0) . ; Note that logic below will put 401 field in both header and detail "RTN","BPSOSO2",62,0) . S BPFLDNUM=+$$FIELDNUM(F) "RTN","BPSOSO2",63,0) . S TFLD=","_BPFLDNUM_"," "RTN","BPSOSO2",64,0) . I BPFLDNUM<402!(HDRLST[TFLD) S @ARR101@(F)=$P(X,U,2) "RTN","BPSOSO2",65,0) . I BPFLDNUM>400!(MULTLST[TFLD) S @ARR402@(F)=$P(X,U,2) "RTN","BPSOSO2",66,0) . ; "RTN","BPSOSO2",67,0) . S C=C+1 "RTN","BPSOSO2",68,0) ; "RTN","BPSOSO2",69,0) Q C ; return count "RTN","BPSOSO2",70,0) ; "RTN","BPSOSO2",71,0) ; utilities "RTN","BPSOSO2",72,0) LOCK() L +^BPS(9002313.511,IEN):300 Q $T "RTN","BPSOSO2",73,0) ; "RTN","BPSOSO2",74,0) UNLOCK L -^BPS(9002313.511,IEN) Q "RTN","BPSOSO2",75,0) ; "RTN","BPSOSO2",76,0) FILENUM() Q 9002313.511 ; BPS NCPDP OVERRIDE (#9002313.511) "RTN","BPSOSO2",77,0) ; "RTN","BPSOSO2",78,0) SUBFNUM() Q 9002313.5111 ; NCPDP FIELD SUB-FIELD^^.02^2 "RTN","BPSOSO2",79,0) ; "RTN","BPSOSO2",80,0) FLOCK() L +^BPS(9002313.511):300 Q $T "RTN","BPSOSO2",81,0) ; "RTN","BPSOSO2",82,0) FUNLOCK L -^BPS(9002313.511) Q "RTN","BPSOSO2",83,0) ; "RTN","BPSOSO2",84,0) FIELDIEN(FIELDNUM) ; function, ien of BPS NCPDP FIELD DEFS (#9002313.91) Data Dictionary field "RTN","BPSOSO2",85,0) Q $$FIND1^DIC(9002313.91,,,FIELDNUM) "RTN","BPSOSO2",86,0) ; "RTN","BPSOSO2",87,0) FIELDNAM(FIELDNUM) ; function, name of a 9002313.91 NCPDP Data Dictionary field "RTN","BPSOSO2",88,0) Q $$GET1^DIQ(9002313.91,$$FIELDIEN(FIELDNUM),.03) "RTN","BPSOSO2",89,0) ; "RTN","BPSOSO2",90,0) ; for IEN in BPS NCPDP FIELD DEFS (#9002313.91) return external # "RTN","BPSOSO2",91,0) FIELDNUM(IEN91) Q $P($G(^BPSF(9002313.91,IEN91,0)),U) "RTN","BPSOSO2",92,0) ; "RTN","BPSOSO2",93,0) NEW() ;EP - function, create new entry in 9002313.511 "RTN","BPSOSO2",94,0) F Q:$$FLOCK Q:'$$IMPOSS^BPSOSUE("L","RTI","interlock on new Override record creation",,"NEW",$T(+0)) "RTN","BPSOSO2",95,0) N FLAGS,FDA,IEN,MSG,FN,X,NEWREC S FN=$$FILENUM "RTN","BPSOSO2",96,0) D NEW1 "RTN","BPSOSO2",97,0) D FUNLOCK "RTN","BPSOSO2",98,0) Q NEWREC "RTN","BPSOSO2",99,0) ; "RTN","BPSOSO2",100,0) NEW1 ; "RTN","BPSOSO2",101,0) S FDA(FN,"+1,",.01)=$O(^BPS(FN,"B",999999999999),-1)+1 "RTN","BPSOSO2",102,0) D UPDATE^DIE(,"FDA","IEN","MSG") "RTN","BPSOSO2",103,0) I $D(MSG) D G NEW1:$$IMPOSS^BPSOSUE("FM","TRI","UPDATE^DIE failed",,"NEW1",$T(+0)) "RTN","BPSOSO2",104,0) . D ZWRITE^BPSOS("FDA","IEN","MSG") "RTN","BPSOSO2",105,0) . K MSG "RTN","BPSOSO2",106,0) S NEWREC=IEN(1) "RTN","BPSOSO2",107,0) NEW2 ; "RTN","BPSOSO2",108,0) S FDA(FN,NEWREC_",",.02)="NOW" "RTN","BPSOSO2",109,0) D FILE^DIE("E","FDA","MSG") "RTN","BPSOSO2",110,0) Q:'$D(MSG) ; success "RTN","BPSOSO2",111,0) G NEW2:$$IMPOSS^BPSOSUE("FM","TRI","FILE^DIE failed",,"NEW2",$T(+0)) "RTN","BPSOSO2",112,0) Q "RTN","BPSOSO2",113,0) ; "RTN","BPSOSO2",114,0) HASVALUE(IEN,FIELDNUM) ; function, does the FIELDNUM have an override value? "RTN","BPSOSO2",115,0) ; returns IEN into the subfile "RTN","BPSOSO2",116,0) Q $$FIND1^DIC($$SUBFNUM,","_IEN_",",,FIELDNUM) "RTN","BPSOSO2",117,0) ; "RTN","BPSOSO2",118,0) GETVALUE(IEN,FIELDNUM) ; function, return currently-set override value for given FIELDNUM "RTN","BPSOSO2",119,0) N X S X=$$HASVALUE(IEN,FIELDNUM) I 'X Q "" "RTN","BPSOSO2",120,0) Q $$GET1^DIQ($$SUBFNUM,X_","_IEN_",",.02) "RTN","BPSOSO2",121,0) ; "RTN","BPSOSO2",122,0) SETVALUE(IEN,FIELDNUM,VALUE) ; function, returns ien in subfile for this FIELDNUM "RTN","BPSOSO2",123,0) ; Special case for the override file: if you're trying to set the "RTN","BPSOSO2",124,0) ; field's value to "@", don't just delete the field value, "RTN","BPSOSO2",125,0) ; which would leave the field defined with a null value. "RTN","BPSOSO2",126,0) ; Instead, delete the entire override for the field. "RTN","BPSOSO2",127,0) ; This prevents accidentally overriding a genuine value with null. "RTN","BPSOSO2",128,0) I "@"=VALUE D DELVALUE(IEN,FIELDNUM) Q "" "RTN","BPSOSO2",129,0) ; "RTN","BPSOSO2",130,0) ; But the usual case is just storing a value: "RTN","BPSOSO2",131,0) N FDA,MSG,IENS,IENARRAY "RTN","BPSOSO2",132,0) ; check if there's already an entry for the fieldnum, if not put in a "+1," "RTN","BPSOSO2",133,0) N ENTRY S ENTRY=$$HASVALUE(IEN,FIELDNUM) ; do we already have FIELDNUM? "RTN","BPSOSO2",134,0) I 'ENTRY S ENTRY="+1" ; create a new entry "RTN","BPSOSO2",135,0) ; "RTN","BPSOSO2",136,0) S IENS=ENTRY_","_IEN_"," "RTN","BPSOSO2",137,0) S FDA($$SUBFNUM,IENS,.01)=FIELDNUM "RTN","BPSOSO2",138,0) S FDA($$SUBFNUM,IENS,.02)=VALUE "RTN","BPSOSO2",139,0) D SETV1 "RTN","BPSOSO2",140,0) I ENTRY="+1" S ENTRY=$G(IENARRAY(1)) "RTN","BPSOSO2",141,0) Q ENTRY "RTN","BPSOSO2",142,0) ; "RTN","BPSOSO2",143,0) SETV1 ; "RTN","BPSOSO2",144,0) D UPDATE^DIE("E","FDA","IENARRAY","MSG") "RTN","BPSOSO2",145,0) Q:'$D(MSG) ; success "RTN","BPSOSO2",146,0) K ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE") "RTN","BPSOSO2",147,0) S ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE")=$$ERRHDR "RTN","BPSOSO2",148,0) M ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE","MSG")=MSG "RTN","BPSOSO2",149,0) I $D(IENARRAY) M ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE","IENARRAY")=IENARRAY "RTN","BPSOSO2",150,0) D ZWRITE^BPSOS("FDA","IENARRAY","MSG") "RTN","BPSOSO2",151,0) G SETV1:$$IMPOSS^BPSOSUE("FM","TRI",,,"SETVALUE",$T(+0)) "RTN","BPSOSO2",152,0) Q "RTN","BPSOSO2",153,0) ; "RTN","BPSOSO2",154,0) DELVALUE(IEN,FIELDNUM) ; "RTN","BPSOSO2",155,0) N ENTRY S ENTRY=$$HASVALUE(IEN,FIELDNUM) Q:'ENTRY ; wasn't defined "RTN","BPSOSO2",156,0) N FDA,MSG "RTN","BPSOSO2",157,0) S FDA($$SUBFNUM,ENTRY_","_IEN_",",.01)="@" "RTN","BPSOSO2",158,0) DE5 D FILE^DIE("E","FDA","MSG") "RTN","BPSOSO2",159,0) Q:'$D(MSG) ; success "RTN","BPSOSO2",160,0) K ^TMP("BPS",$J,"BPSOSO2",$J,"DELVALUE") "RTN","BPSOSO2",161,0) S ^TMP("BPS",$J,"BPSOSO2",$J,"DELVALUE")=$$ERRHDR "RTN","BPSOSO2",162,0) D ZWRITE^BPSOS("IEN","FDA","MSG") "RTN","BPSOSO2",163,0) G DE5:$$IMPOSS^BPSOSUE("FM","TRI",,,"DELVALUE",$T(+0)) "RTN","BPSOSO2",164,0) Q "RTN","BPSOSO2",165,0) ; "RTN","BPSOSO2",166,0) ERRHDR() Q "ERROR AT $H="_$H_" FOR $J="_$J "RTN","BPSOSO2",167,0) ; "RTN","BPSOSO2",168,0) SEE(IEN) N TMP M TMP=^BPS($$FILENUM,IEN) D ZWRITE^BPSOS("TMP") Q ; debugging "RTN","BPSOSO2",169,0) ; "RTN","BPSOSO2",170,0) PRIORA(IEN) ;IHS/SD/lwj 9/3/02 Prior Authorization "RTN","BPSOSO2",171,0) ; used to populate fields 461, 462 and 416. 416 will be created based on the input into fields 461, and 462. "RTN","BPSOSO2",172,0) ; "RTN","BPSOSO2",173,0) N FIELDNUM "RTN","BPSOSO2",174,0) ; "RTN","BPSOSO2",175,0) S FIELDNUM=461 ; 461-EU Prior Authorization Type Code "RTN","BPSOSO2",176,0) D EDIT(IEN,FIELDNUM) "RTN","BPSOSO2",177,0) S FIELDNUM=462 ; 462-EV Prior Authorization Number Submitted "RTN","BPSOSO2",178,0) D EDIT(IEN,FIELDNUM) "RTN","BPSOSO2",179,0) ; "RTN","BPSOSO2",180,0) ; combine field 461 and 462 to create 416-DG Prior Authorization/Medical Certification Code And Number "RTN","BPSOSO2",181,0) ; "RTN","BPSOSO2",182,0) N VAL461,VAL462,VAL416,DA "RTN","BPSOSO2",183,0) S VAL461=$$GETVALUE(IEN,461) "RTN","BPSOSO2",184,0) S VAL462=$$GETVALUE(IEN,462) "RTN","BPSOSO2",185,0) S VAL416=VAL461_VAL462 "RTN","BPSOSO2",186,0) Q:VAL416="" "RTN","BPSOSO2",187,0) ; "RTN","BPSOSO2",188,0) S DA=$$SETVALUE(IEN,416,"") "RTN","BPSOSO2",189,0) S:$G(DA)'="" DA=$$SETVALUE(IEN,416,VAL416) "RTN","BPSOSO2",190,0) ; "RTN","BPSOSO2",191,0) Q "RTN","BPSOSO2",192,0) ; "RTN","BPSOSQ2") 0^37^B16516735 "RTN","BPSOSQ2",1,0) BPSOSQ2 ;BHAM ISC/FCS/DRS/DLF - form transmission packets ;06/01/2004 "RTN","BPSOSQ2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSQ2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSQ2",4,0) ; Construct packets for transmission "RTN","BPSOSQ2",5,0) Q "RTN","BPSOSQ2",6,0) ; "RTN","BPSOSQ2",7,0) PACKETS ; EP - Tasked by BPSOSQA "RTN","BPSOSQ2",8,0) ; "RTN","BPSOSQ2",9,0) ; First handle insurer alseep transactions "RTN","BPSOSQ2",10,0) I $D(^BPST("AD",31)) D STATUS31^BPSOSQF "RTN","BPSOSQ2",11,0) ; "RTN","BPSOSQ2",12,0) ; Handle claims that need the packet to be built "RTN","BPSOSQ2",13,0) I $D(^BPST("AD",30)) D STATUS30 "RTN","BPSOSQ2",14,0) ; "RTN","BPSOSQ2",15,0) ; If there are still any claims with status 30 (perhaps due to failed "RTN","BPSOSQ2",16,0) ; LOCK59), queue up BPSOSQ2 to run again "RTN","BPSOSQ2",17,0) I $O(^BPST("AD",30,0)) H 60 D TASK^BPSOSQA "RTN","BPSOSQ2",18,0) Q "RTN","BPSOSQ2",19,0) ; "RTN","BPSOSQ2",20,0) ; Walk through claims at 30%, bundle, and create the claim "RTN","BPSOSQ2",21,0) STATUS30 ; "RTN","BPSOSQ2",22,0) N IEN59,ERROR,TRANLIST "RTN","BPSOSQ2",23,0) S IEN59="" "RTN","BPSOSQ2",24,0) I '$$LOCK59(30) Q "RTN","BPSOSQ2",25,0) ; "RTN","BPSOSQ2",26,0) ; Loop though claims at 30%, bundle with other 30% claims, and process "RTN","BPSOSQ2",27,0) F S IEN59=$$NEXT59(IEN59) Q:IEN59="" D "RTN","BPSOSQ2",28,0) . ; Intialize the list "RTN","BPSOSQ2",29,0) . K TRANLIST "RTN","BPSOSQ2",30,0) . S TRANLIST(IEN59)="" "RTN","BPSOSQ2",31,0) . ; "RTN","BPSOSQ2",32,0) . ; Update the status to 40 (Building the packet) "RTN","BPSOSQ2",33,0) . D SETSTAT^BPSOSU(IEN59,40) "RTN","BPSOSQ2",34,0) . ; "RTN","BPSOSQ2",35,0) . ; If the VA implements bundling in the future, then init BUNDLE variable to be 1 here "RTN","BPSOSQ2",36,0) . N BUNDLE "RTN","BPSOSQ2",37,0) . S BUNDLE=0 "RTN","BPSOSQ2",38,0) . ; "RTN","BPSOSQ2",39,0) . ; If reversal, only one claim per transmission "RTN","BPSOSQ2",40,0) . I $G(^BPST(IEN59,4)) S BUNDLE=0 "RTN","BPSOSQ2",41,0) . ; "RTN","BPSOSQ2",42,0) . ; Bundling only valid for billing requests, not eligibility or reversals "RTN","BPSOSQ2",43,0) . I $P($G(^BPST(IEN59,0)),U,15)'="C" S BUNDLE=0 "RTN","BPSOSQ2",44,0) . ; "RTN","BPSOSQ2",45,0) . ; If prior auth are entered, only one claim per transmission "RTN","BPSOSQ2",46,0) . I $$CHKPA() S BUNDLE=0 "RTN","BPSOSQ2",47,0) . ; "RTN","BPSOSQ2",48,0) . I $G(BUNDLE) D BUNDLE "RTN","BPSOSQ2",49,0) . ; "RTN","BPSOSQ2",50,0) . ; BPSOSQG will build the claim data, create the packet, and send to HL7 "RTN","BPSOSQ2",51,0) . S ERROR=$$PACKET^BPSOSQG "RTN","BPSOSQ2",52,0) . ; "RTN","BPSOSQ2",53,0) . ; If an error is returned, log the error to each transaction "RTN","BPSOSQ2",54,0) . I ERROR S IEN59="" F S IEN59=$O(TRANLIST(IEN59)) Q:IEN59="" D "RTN","BPSOSQ2",55,0) .. D ERROR^BPSOSU($T(+0),IEN59,$P(ERROR,U),$P(ERROR,U,2,$L(ERROR,U))) "RTN","BPSOSQ2",56,0) D UNLOCK59(30) "RTN","BPSOSQ2",57,0) Q "RTN","BPSOSQ2",58,0) ; "RTN","BPSOSQ2",59,0) NEXT59(IEN59) ;EP - BPSOSQF "RTN","BPSOSQ2",60,0) N GRPLAN,BPSIEN15 "RTN","BPSOSQ2",61,0) N59A ; "RTN","BPSOSQ2",62,0) ; Get next transaction at 30% "RTN","BPSOSQ2",63,0) S IEN59=$O(^BPST("AD",30,IEN59)) "RTN","BPSOSQ2",64,0) I IEN59="" Q IEN59 ; end of list, return "" "RTN","BPSOSQ2",65,0) ; "RTN","BPSOSQ2",66,0) ; Get the GROUP INSURANCE PLAN "RTN","BPSOSQ2",67,0) S GRPLAN=+$$GETPLN59^BPSUTIL2(IEN59) "RTN","BPSOSQ2",68,0) ; "RTN","BPSOSQ2",69,0) ; If the GROUP INSURANCE PLAN isn't asleep or if the IGNORE ASLEEP flag "RTN","BPSOSQ2",70,0) ; is set, then return this transaction "RTN","BPSOSQ2",71,0) I '$$ISASLEEP^BPSOSQF(GRPLAN) Q IEN59 "RTN","BPSOSQ2",72,0) ; "RTN","BPSOSQ2",73,0) ; If this is the prober and it is time to retry, then return the transaction "RTN","BPSOSQ2",74,0) I $$PROBER^BPSOSQF(GRPLAN)=IEN59,$$RETRY^BPSOSQF(GRPLAN) Q IEN59 "RTN","BPSOSQ2",75,0) ; "RTN","BPSOSQ2",76,0) ; For anything else, we need to turn on insurer asleep "RTN","BPSOSQ2",77,0) S BPSIEN15=$O(^BPS(9002313.15,"B",+$G(GRPLAN),0)) "RTN","BPSOSQ2",78,0) D SETSLEEP^BPSOSQ4(IEN59,BPSIEN15,$T(+0)_"-Insurer asleep - Waiting for Prober Transaction "_$$PROBER^BPSOSQF(+$G(GRPLAN))_" to complete") "RTN","BPSOSQ2",79,0) ; "RTN","BPSOSQ2",80,0) ; Get next transaction "RTN","BPSOSQ2",81,0) G N59A "RTN","BPSOSQ2",82,0) ; "RTN","BPSOSQ2",83,0) BUNDLE ; This code is for bundling claims. The VA is not doing bundling, but this "RTN","BPSOSQ2",84,0) ; code is being left in place in case we do bundling in the future. If so, the "RTN","BPSOSQ2",85,0) ; code will need to be rewritten to look at the correct fields. "RTN","BPSOSQ2",86,0) ; "RTN","BPSOSQ2",87,0) Q ; no bundling for now "RTN","BPSOSQ2",88,0) ; "RTN","BPSOSQ2",89,0) ; Code below is original IHS code, which is based on NCPCP version 3x. "RTN","BPSOSQ2",90,0) ; Going forward, the Transmission Header, Patient, and Insurance segments "RTN","BPSOSQ2",91,0) ; would need to be the same for all bundled claims. So, we would need: "RTN","BPSOSQ2",92,0) ; Same Pharmacy Plan (which we get the BIN, PCN, Software Cert ID) "RTN","BPSOSQ2",93,0) ; Same Pharmacy NPI (same division for all Rx's) "RTN","BPSOSQ2",94,0) ; Same DOS for all Rx's "RTN","BPSOSQ2",95,0) ; Same Patient "RTN","BPSOSQ2",96,0) ; Same Insurance/Cardholder "RTN","BPSOSQ2",97,0) ; Make sure the transaction is a billing request (not reversal/eligibility) "RTN","BPSOSQ2",98,0) N RA0,RA1 S RA0=^BPST(IEN59,0),RA1=^(1) "RTN","BPSOSQ2",99,0) N IEN59 S IEN59="" ; preserve the top-level index! "RTN","BPSOSQ2",100,0) F S IEN59=$$NEXT59(IEN59,30) Q:'IEN59 D "RTN","BPSOSQ2",101,0) . N RB0,RB1 S RB0=^BPST(IEN59,0),RB1=^(1) "RTN","BPSOSQ2",102,0) . ; Only bundle when you have the same: "RTN","BPSOSQ2",103,0) . ; Patient, Visit, Division, Division Source, Insurer, Pharmacy "RTN","BPSOSQ2",104,0) . I $P(RA0,U,6,7)'=$P(RB0,U,6,7) Q "RTN","BPSOSQ2",105,0) . I $P(RA1,U,4,7)'=$P(RB1,U,4,7) Q "RTN","BPSOSQ2",106,0) . I $P(RB0,U,2)'=30 Q ; might have been canceled, or maybe 31'd "RTN","BPSOSQ2",107,0) . D SETSTAT^BPSOSU(IEN59,40) "RTN","BPSOSQ2",108,0) . S TRANLIST(IEN59)="" "RTN","BPSOSQ2",109,0) . Q "RTN","BPSOSQ2",110,0) ; "RTN","BPSOSQ2",111,0) BUNDLEX ; "RTN","BPSOSQ2",112,0) Q "RTN","BPSOSQ2",113,0) ; "RTN","BPSOSQ2",114,0) ; "RTN","BPSOSQ2",115,0) LOCK59(STATUS) ;EP - BPSOSQF "RTN","BPSOSQ2",116,0) L +^BPST("AD",STATUS):60 "RTN","BPSOSQ2",117,0) Q $T "RTN","BPSOSQ2",118,0) ; "RTN","BPSOSQ2",119,0) UNLOCK59(STATUS) ;EP - BPSOSQF "RTN","BPSOSQ2",120,0) L -^BPST("AD",STATUS) "RTN","BPSOSQ2",121,0) Q "RTN","BPSOSQ2",122,0) ; "RTN","BPSOSQ2",123,0) ; IHS code, slightly modified for VA. We will need to look "RTN","BPSOSQ2",124,0) ; at this if we start bundling claims. "RTN","BPSOSQ2",125,0) ; Since the prior auth type and number are in the claim segment, "RTN","BPSOSQ2",126,0) ; which is at the transmission level, this check may not longer "RTN","BPSOSQ2",127,0) ; be valid. This code was originally for NCPCP version 3x and "RTN","BPSOSQ2",128,0) ; may no longer be valid for NCPCP version D0. "RTN","BPSOSQ2",129,0) ; If this is valid, it would seem that the same logic would "RTN","BPSOSQ2",130,0) ; need to be added to the BUNDLE procedure above so we don't add a "RTN","BPSOSQ2",131,0) ; BPS Transaction to the bundle if it has a prior auth type or number. "RTN","BPSOSQ2",132,0) CHKPA() ; "RTN","BPSOSQ2",133,0) N PATYP,PANUM,PACLM "RTN","BPSOSQ2",134,0) S PACLM=0 "RTN","BPSOSQ2",135,0) ; "RTN","BPSOSQ2",136,0) S PATYP=$P($G(^BPST(IEN59,1)),U,15) ;prior auth type code "RTN","BPSOSQ2",137,0) S PANUM=$P($G(^BPST(IEN59,1)),U,9) ;prior auth number "RTN","BPSOSQ2",138,0) I ($G(PATYP)'="")!($G(PANUM)'="") S PACLM=1 "RTN","BPSOSQ2",139,0) ; "RTN","BPSOSQ2",140,0) Q PACLM "RTN","BPSOSQ4") 0^53^B51328615 "RTN","BPSOSQ4",1,0) BPSOSQ4 ;BHAM ISC/FCS/DRS/DLF - Process responses ;12/7/07 15:48 "RTN","BPSOSQ4",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSQ4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSQ4",4,0) ; "RTN","BPSOSQ4",5,0) ; This routine has two components "RTN","BPSOSQ4",6,0) ; Procedures to report Response info "RTN","BPSOSQ4",7,0) ; Procedures to handle insurer asleep functions "RTN","BPSOSQ4",8,0) Q "RTN","BPSOSQ4",9,0) ; "RTN","BPSOSQ4",10,0) ; The following are separate little utilities called from elsewhere. "RTN","BPSOSQ4",11,0) ; "RTN","BPSOSQ4",12,0) PAID(IEN59) ;quick query to see if it's paid "RTN","BPSOSQ4",13,0) N TMP D RESPINFO(IEN59,.TMP) Q:'$D(TMP("RSP")) 0 "RTN","BPSOSQ4",14,0) N X S X=TMP("RSP") "RTN","BPSOSQ4",15,0) I X="Payable" Q 1 "RTN","BPSOSQ4",16,0) Q 0 "RTN","BPSOSQ4",17,0) RESPINFO(IEN59,DST) ;EP - BPSOS6M "RTN","BPSOSQ4",18,0) ; quick way to get all the response info for a given BPS Transaction "RTN","BPSOSQ4",19,0) ; IMPORTANT!! Do not change spelling, case, wording, or spacing!!! "RTN","BPSOSQ4",20,0) ; If a reversal was attempted, it complicates things. "RTN","BPSOSQ4",21,0) ; fills DST array as follows: "RTN","BPSOSQ4",22,0) ; DST("HDR")=Response Status (header) "RTN","BPSOSQ4",23,0) ; DST("RSP")=Response Status (transaction) "RTN","BPSOSQ4",24,0) ; This could be: "Payable", "Rejected", "Accepted", "Captured", "RTN","BPSOSQ4",25,0) ; "Duplicate", or "null" "RTN","BPSOSQ4",26,0) ; DST("REJ",0)=count of reject codes "RTN","BPSOSQ4",27,0) ; DST("REJ",n)=each reject code "RTN","BPSOSQ4",28,0) ; DST("MSG")=message with the response "RTN","BPSOSQ4",29,0) ; All of these are defined, even if originals were '$D. "RTN","BPSOSQ4",30,0) ; The external forms are returned. "RTN","BPSOSQ4",31,0) N REVERSAL S REVERSAL=$G(^BPST(IEN59,4))>0 "RTN","BPSOSQ4",32,0) N RESP "RTN","BPSOSQ4",33,0) I 'REVERSAL S RESP=$P(^BPST(IEN59,0),U,5) "RTN","BPSOSQ4",34,0) E S RESP=$P(^BPST(IEN59,4),U,2) "RTN","BPSOSQ4",35,0) I 'RESP Q "RTN","BPSOSQ4",36,0) N ECME S POS=$P(^BPST(IEN59,0),U,9) Q:'POS "RTN","BPSOSQ4",37,0) N FMT S FMT="E" "RTN","BPSOSQ4",38,0) S DST("HDR")=$$RESP500(RESP,FMT) "RTN","BPSOSQ4",39,0) S DST("RSP")=$$RESP1000(RESP,POS,FMT) "RTN","BPSOSQ4",40,0) S DST("REJ",0)=$$REJCOUNT(RESP,POS,FMT) "RTN","BPSOSQ4",41,0) I DST("REJ",0) D "RTN","BPSOSQ4",42,0) . N I F I=1:1:DST("REJ",0) S DST("REJ",I)=$$REJCODE(RESP,POS,I,FMT) "RTN","BPSOSQ4",43,0) S DST("MSG")=$$RESPMSG(RESP,POS) "RTN","BPSOSQ4",44,0) ; Dealing with oddities of PCS (and others'?) response to reversals "RTN","BPSOSQ4",45,0) I REVERSAL,DST("RSP")["null" D "RTN","BPSOSQ4",46,0) . I DST("RSP")["null" S DST("RSP")=DST("HDR")_" reversal" "RTN","BPSOSQ4",47,0) Q "RTN","BPSOSQ4",48,0) ; In the following quickies: "RTN","BPSOSQ4",49,0) ; RESP = RESPIEN, pointer to 9002313.03 "RTN","BPSOSQ4",50,0) ; FMT = "I" for internal, "E" for external, defaults to internal "RTN","BPSOSQ4",51,0) RESP500(RESP,FMT) ;EP - BPSOS57,BPSOSUC "RTN","BPSOSQ4",52,0) ; returns the response header status "RTN","BPSOSQ4",53,0) N X S X=$P($G(^BPSR(RESP,500)),U) "RTN","BPSOSQ4",54,0) I $G(FMT)'="E" Q X "RTN","BPSOSQ4",55,0) I X="" S X="null" "RTN","BPSOSQ4",56,0) S X=$S(X="A":"Accepted",X="R":"Rejected",1:"?"_X) "RTN","BPSOSQ4",57,0) Q X "RTN","BPSOSQ4",58,0) RESP1000(RESP,POS,FMT) ;EP - BPSOSUC "RTN","BPSOSQ4",59,0) ; returns the transaction response status "RTN","BPSOSQ4",60,0) ; Note! Could be DP or DC for duplicates "RTN","BPSOSQ4",61,0) N X S X=$P($G(^BPSR(RESP,1000,POS,500)),U) "RTN","BPSOSQ4",62,0) I $G(FMT)'="E" Q X "RTN","BPSOSQ4",63,0) I X="" S X="null" "RTN","BPSOSQ4",64,0) ; "RTN","BPSOSQ4",65,0) ;IHS/SD/lwj 10/07/02 NCPDP 5.1 changes - they will send an "A" back "RTN","BPSOSQ4",66,0) ; now on the transaction level to indicate that it has been accepted "RTN","BPSOSQ4",67,0) ; Next code line remarked out - following added "RTN","BPSOSQ4",68,0) ; "RTN","BPSOSQ4",69,0) S X=$S(X="A":"Accepted",X="P":"Payable",X="R":"Rejected",X="C":"Captured",X="D"!(X="DP")!(X="DC"):"Duplicate",1:"?"_X) "RTN","BPSOSQ4",70,0) Q X "RTN","BPSOSQ4",71,0) ; "RTN","BPSOSQ4",72,0) REJCOUNT(RESP,POS,FMT) ; returns rejection count "RTN","BPSOSQ4",73,0) Q +$P($G(^BPSR(RESP,1000,POS,511,0)),U,3) "RTN","BPSOSQ4",74,0) ; "RTN","BPSOSQ4",75,0) REJCODE(RESP,POS,N,FMT) ; returns Nth rejection code "RTN","BPSOSQ4",76,0) ; if FMT="E", returns code:text "RTN","BPSOSQ4",77,0) N CODE S CODE=$P($G(^BPSR(RESP,1000,POS,511,N,0)),U) "RTN","BPSOSQ4",78,0) I CODE="" S CODE="null" "RTN","BPSOSQ4",79,0) I FMT'="E" Q CODE "RTN","BPSOSQ4",80,0) N X S X=$O(^BPSF(9002313.93,"B",CODE,0)) "RTN","BPSOSQ4",81,0) I X]"" S CODE=CODE_":"_$P($G(^BPSF(9002313.93,X,0)),U,2) "RTN","BPSOSQ4",82,0) E S CODE="?"_CODE "RTN","BPSOSQ4",83,0) Q CODE "RTN","BPSOSQ4",84,0) ; "RTN","BPSOSQ4",85,0) ; NCPDP 5.1 changes - message may not come back in 504. They may "RTN","BPSOSQ4",86,0) ; come back in 526 instead "RTN","BPSOSQ4",87,0) ; NCPDP D.0 change - 526 is a repeating field "RTN","BPSOSQ4",88,0) RESPMSG(RESP,POS) ; response message - additional text from insurer "RTN","BPSOSQ4",89,0) ; "RTN","BPSOSQ4",90,0) I '$G(RESP) Q "" "RTN","BPSOSQ4",91,0) I '$G(POS) S POS=1 "RTN","BPSOSQ4",92,0) N MSG "RTN","BPSOSQ4",93,0) S MSG="" "RTN","BPSOSQ4",94,0) S MSG=$G(^BPSR(RESP,504)) "RTN","BPSOSQ4",95,0) I MSG]"" Q MSG "RTN","BPSOSQ4",96,0) N ADDMESS,N "RTN","BPSOSQ4",97,0) D ADDMESS^BPSSCRLG(RESP,POS,.ADDMESS) "RTN","BPSOSQ4",98,0) S N="" F S N=$O(ADDMESS(N)) Q:'N S MSG=MSG_$S(N=1:"",1:"~")_ADDMESS(N) "RTN","BPSOSQ4",99,0) Q MSG "RTN","BPSOSQ4",100,0) ; "RTN","BPSOSQ4",101,0) ; "RTN","BPSOSQ4",102,0) NOW() ; "RTN","BPSOSQ4",103,0) Q $$NOW^XLFDT "RTN","BPSOSQ4",104,0) ; "RTN","BPSOSQ4",105,0) ; The xxxSLEEP functions are called from BPSOSQL "RTN","BPSOSQ4",106,0) ; ISASLEEP also called by BPSOSQA "RTN","BPSOSQ4",107,0) ; "RTN","BPSOSQ4",108,0) REJSLEEP(BPSRESP,BPSPOS,IEN59) ; "RTN","BPSOSQ4",109,0) ; Check if the insurer should be asleep based on the reject codes "RTN","BPSOSQ4",110,0) ; Input "RTN","BPSOSQ4",111,0) ; BPSRESP - BPS Response IEN "RTN","BPSOSQ4",112,0) ; BPSPOS - Multiple IEN "RTN","BPSOSQ4",113,0) ; IEN59 - BPS TRANSACTION IEN "RTN","BPSOSQ4",114,0) ; Return "RTN","BPSOSQ4",115,0) ; 1 if the insurer should go to sleep "RTN","BPSOSQ4",116,0) ; 0 if the insurer should not go to sleep "RTN","BPSOSQ4",117,0) ; "RTN","BPSOSQ4",118,0) N BPSSITE,REJCD,GRPLAN,BPSRET "RTN","BPSOSQ4",119,0) ; "RTN","BPSOSQ4",120,0) ; Validate parameters "RTN","BPSOSQ4",121,0) I '$G(BPSRESP) Q 0 "RTN","BPSOSQ4",122,0) I '$G(BPSPOS) Q 0 "RTN","BPSOSQ4",123,0) I '$G(IEN59) Q 0 "RTN","BPSOSQ4",124,0) ; "RTN","BPSOSQ4",125,0) ; Check asleep parameters to see asleep functionality is disabled "RTN","BPSOSQ4",126,0) S BPSSITE=$G(^BPS(9002313.99,1,0)) "RTN","BPSOSQ4",127,0) I '$P(BPSSITE,"^",5)!('$P(BPSSITE,"^",6)) Q 0 "RTN","BPSOSQ4",128,0) ; "RTN","BPSOSQ4",129,0) ; Do not do insurer asleep for Eligibility Verification requests "RTN","BPSOSQ4",130,0) I $P($G(^BPST(IEN59,0)),U,15)="E" Q 0 "RTN","BPSOSQ4",131,0) ; "RTN","BPSOSQ4",132,0) ; Get the Group Insurance Plan and verify if asleep functionality is on "RTN","BPSOSQ4",133,0) S GRPLAN=$$GETPLN59^BPSUTIL2(IEN59) I 'GRPLAN Q 0 "RTN","BPSOSQ4",134,0) I $$IGNORE^BPSOSQF(+GRPLAN) Q 0 "RTN","BPSOSQ4",135,0) ; "RTN","BPSOSQ4",136,0) ; Don't sleep if response has reject 88 (DUR) or 79 (Refill Too Soon) "RTN","BPSOSQ4",137,0) I $D(^BPSR(BPSRESP,1000,BPSPOS,511,"B",88)) Q 0 "RTN","BPSOSQ4",138,0) I $D(^BPSR(BPSRESP,1000,BPSPOS,511,"B",79)) Q 0 "RTN","BPSOSQ4",139,0) ; "RTN","BPSOSQ4",140,0) ; Is this a reject code to consider? "RTN","BPSOSQ4",141,0) S BPSRET=0 "RTN","BPSOSQ4",142,0) F REJCD=90,91,92,95,96,97,98 I $D(^BPSR(BPSRESP,1000,BPSPOS,511,"B",REJCD)) S BPSRET=1 Q "RTN","BPSOSQ4",143,0) ; "RTN","BPSOSQ4",144,0) Q BPSRET "RTN","BPSOSQ4",145,0) ; "RTN","BPSOSQ4",146,0) ADDSLEEP(IEN59) ; "RTN","BPSOSQ4",147,0) ; Adds a payer (if not already there) to the Asleep file "RTN","BPSOSQ4",148,0) ; Input "RTN","BPSOSQ4",149,0) ; IEN59 - BPS TRANSACTION IEN "RTN","BPSOSQ4",150,0) ; Return "RTN","BPSOSQ4",151,0) ; 0 - No BPS Asleep Payer record created "RTN","BPSOSQ4",152,0) ; BPS Asleep Payer IEN "RTN","BPSOSQ4",153,0) ; "RTN","BPSOSQ4",154,0) I '$G(IEN59) Q 0 "RTN","BPSOSQ4",155,0) N GRPLAN,DIC,X,Y,DO,DTOUT,DUOUT "RTN","BPSOSQ4",156,0) ; "RTN","BPSOSQ4",157,0) ; Find the Group Insurance Plan "RTN","BPSOSQ4",158,0) S GRPLAN=$$GETPLN59^BPSUTIL2(IEN59) I 'GRPLAN Q 0 "RTN","BPSOSQ4",159,0) ; "RTN","BPSOSQ4",160,0) ; If already in file quit "RTN","BPSOSQ4",161,0) I $D(^BPS(9002313.15,"B",+GRPLAN)) Q 0 "RTN","BPSOSQ4",162,0) ; "RTN","BPSOSQ4",163,0) S DIC=9002313.15,DIC(0)="",X=+GRPLAN "RTN","BPSOSQ4",164,0) S DIC("DR")=".02///0;.03///0;.04////^S X=IEN59" "RTN","BPSOSQ4",165,0) D FILE^DICN "RTN","BPSOSQ4",166,0) ; "RTN","BPSOSQ4",167,0) Q Y "RTN","BPSOSQ4",168,0) ; "RTN","BPSOSQ4",169,0) INCSLEEP(IEN59) ; called from BPSOSQL "RTN","BPSOSQ4",170,0) ; INCSLEEP - Increment sleep time for this insurer "RTN","BPSOSQ4",171,0) ; Input "RTN","BPSOSQ4",172,0) ; IEN59 - BPS TRANSACTION IEN "RTN","BPSOSQ4",173,0) ; Return "RTN","BPSOSQ4",174,0) ; 0 - Awake now "RTN","BPSOSQ4",175,0) ; 1 - Still asleep "RTN","BPSOSQ4",176,0) ; "RTN","BPSOSQ4",177,0) I '$G(IEN59) Q 0 "RTN","BPSOSQ4",178,0) N GRPLAN,BPSIEN15,RETCNT,BPSPARAM,BPSRETRY,PROBER,IEN59T "RTN","BPSOSQ4",179,0) N DIE,DA,DR,DTOUT "RTN","BPSOSQ4",180,0) ; "RTN","BPSOSQ4",181,0) ; Get GROUP INSURANCE PLAN "RTN","BPSOSQ4",182,0) S GRPLAN=$$GETPLN59^BPSUTIL2(IEN59) I 'GRPLAN Q 0 "RTN","BPSOSQ4",183,0) ; "RTN","BPSOSQ4",184,0) ; If the payer is not already asleep, add it to the BPS ASLEEP PAYERS file "RTN","BPSOSQ4",185,0) S BPSIEN15=$O(^BPS(9002313.15,"B",+GRPLAN,0)) "RTN","BPSOSQ4",186,0) I 'BPSIEN15 S BPSIEN15=+$$ADDSLEEP(IEN59) "RTN","BPSOSQ4",187,0) I BPSIEN15<1 Q 0 "RTN","BPSOSQ4",188,0) ; "RTN","BPSOSQ4",189,0) ; Get the prober. "RTN","BPSOSQ4",190,0) S PROBER=$P($G(^BPS(9002313.15,BPSIEN15,0)),U,4) "RTN","BPSOSQ4",191,0) ; "RTN","BPSOSQ4",192,0) ; If there is a prober and this is not it, just put this transaction to sleep and quit "RTN","BPSOSQ4",193,0) I PROBER,IEN59'=PROBER D SETSLEEP(IEN59,BPSIEN15,$T(+0)_"-Insurer Asleep-Waiting for Prober Transaction "_PROBER_" to complete") Q 1 "RTN","BPSOSQ4",194,0) ; "RTN","BPSOSQ4",195,0) ; Get Asleep Paramters from BPS SETUP "RTN","BPSOSQ4",196,0) ; If the parameters are off, return 0 "RTN","BPSOSQ4",197,0) S BPSPARAM=^BPS(9002313.99,1,0) "RTN","BPSOSQ4",198,0) I '$P(BPSPARAM,"^",5)!('$P(BPSPARAM,"^",6)) Q 0 "RTN","BPSOSQ4",199,0) ; "RTN","BPSOSQ4",200,0) ; If maximum retries reached, flag to wake up and set status to complete. "RTN","BPSOSQ4",201,0) S RETCNT=$P($G(^BPS(9002313.15,BPSIEN15,0)),U,2)+1 "RTN","BPSOSQ4",202,0) I RETCNT>$P(BPSPARAM,"^",6) D Q 0 "RTN","BPSOSQ4",203,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Maximum retries reached for insurer. Completing BPS TRANSACTION: "_IEN59) "RTN","BPSOSQ4",204,0) ; "RTN","BPSOSQ4",205,0) ; Set RETRY TIME based on site parameters and update retry count and retry time "RTN","BPSOSQ4",206,0) S BPSRETRY=$$FMADD^XLFDT($$NOW^XLFDT,,,$P(BPSPARAM,"^",5)) "RTN","BPSOSQ4",207,0) I $$FILLFLDS^BPSUTIL2(9002313.15,".02",BPSIEN15,RETCNT)<1 Q 0 "RTN","BPSOSQ4",208,0) I $$FILLFLDS^BPSUTIL2(9002313.15,".05",BPSIEN15,BPSRETRY)<1 Q 0 "RTN","BPSOSQ4",209,0) ; "RTN","BPSOSQ4",210,0) ; Put the prober to Sleep "RTN","BPSOSQ4",211,0) S MSG="Retry number "_RETCNT_" scheduled for "_$$FMTE^XLFDT(BPSRETRY) "RTN","BPSOSQ4",212,0) D SETSLEEP(IEN59,BPSIEN15,$T(+0)_"-Insurer Asleep for "_$P(GRPLAN,U,2)_". "_MSG) "RTN","BPSOSQ4",213,0) ; "RTN","BPSOSQ4",214,0) ; Update the Last Update date/time for associated claims so that they don't "RTN","BPSOSQ4",215,0) ; end up on the View/Unstand Submission Screen "RTN","BPSOSQ4",216,0) S IEN59T="" F S IEN59T=$O(^BPST("ASL",BPSIEN15,IEN59T)) Q:IEN59T="" D "RTN","BPSOSQ4",217,0) . I IEN59T=PROBER Q "RTN","BPSOSQ4",218,0) . S DIE=9002313.59,DA=IEN59T,DR="7///NOW" D ^DIE "RTN","BPSOSQ4",219,0) . D LOG^BPSOSL(IEN59T,$T(+0)_"-INCSLEEP is resetting the LAST UPDATE field to the current date/time") "RTN","BPSOSQ4",220,0) ; "RTN","BPSOSQ4",221,0) ; Queue packeter to restart at next retry time+10 seconds "RTN","BPSOSQ4",222,0) D TASKAT^BPSOSQA($$FMADD^XLFDT(BPSRETRY,,,,10)) "RTN","BPSOSQ4",223,0) ; "RTN","BPSOSQ4",224,0) Q 1 "RTN","BPSOSQ4",225,0) ; "RTN","BPSOSQ4",226,0) SETSLEEP(IEN59,BPSIEN15,MSG) ; "RTN","BPSOSQ4",227,0) ; Put transaction to sleep "RTN","BPSOSQ4",228,0) ; Input "RTN","BPSOSQ4",229,0) ; IEN59 - BPS Transaction IEN "RTN","BPSOSQ4",230,0) ; BPSIEN15 - BPS Asleep Payer IEN "RTN","BPSOSQ4",231,0) ; MSG - Message used for Log "RTN","BPSOSQ4",232,0) ; "RTN","BPSOSQ4",233,0) I '$G(IEN59) Q "RTN","BPSOSQ4",234,0) I '$G(BPSIEN15) Q "RTN","BPSOSQ4",235,0) N DIE,DA,DR,DTOUT "RTN","BPSOSQ4",236,0) ; "RTN","BPSOSQ4",237,0) ; If the BPS TRANSACTION is not already pointing to the asleep payer, update it "RTN","BPSOSQ4",238,0) I '$D(^BPST("ASL",BPSIEN15,IEN59)) S DIE=9002313.59,DA=IEN59,DR="801////^S X=BPSIEN15" D ^DIE "RTN","BPSOSQ4",239,0) ; "RTN","BPSOSQ4",240,0) ; Set to 31% (Wait for retry (insurer asleep)) and log message "RTN","BPSOSQ4",241,0) D SETSTAT^BPSOSU(IEN59,31) "RTN","BPSOSQ4",242,0) I $G(MSG)="" S MSG=$T(+0)_"-Transaction being put to sleep by SETSLEEP" "RTN","BPSOSQ4",243,0) D LOG^BPSOSL(IEN59,MSG) "RTN","BPSOSQ4",244,0) Q "RTN","BPSOSQ4",245,0) ; "RTN","BPSOSQ4",246,0) CLRSLEEP(GRPLAN,IEN59) ;EP - BPSOSQL "RTN","BPSOSQ4",247,0) ; Clear insurer sleeping condition "RTN","BPSOSQ4",248,0) ; Input: "RTN","BPSOSQ4",249,0) ; GRPLAN - Group Insurance Plan IEN "RTN","BPSOSQ4",250,0) ; IEN59 - BPS Transaction IEN "RTN","BPSOSQ4",251,0) ; "RTN","BPSOSQ4",252,0) I '$G(GRPLAN) Q "RTN","BPSOSQ4",253,0) N BPSIEN15,DA,DIE,DR,DTOUT,DIK,IEN59T "RTN","BPSOSQ4",254,0) ; "RTN","BPSOSQ4",255,0) ; Get the BPS ASLEEP PAYER record "RTN","BPSOSQ4",256,0) S BPSIEN15=$O(^BPS(9002313.15,"B",+GRPLAN,0)) "RTN","BPSOSQ4",257,0) I BPSIEN15="" Q "RTN","BPSOSQ4",258,0) ; "RTN","BPSOSQ4",259,0) ; Logging message and creating a comment "RTN","BPSOSQ4",260,0) I $G(IEN59) D LOG^BPSOSL(IEN59,$T(+0)_"-Clearing sleep for "_$P(GRPLAN,U,2)) "RTN","BPSOSQ4",261,0) ; "RTN","BPSOSQ4",262,0) ; Delete the BPS ASLEEP PAYER record "RTN","BPSOSQ4",263,0) S DA=BPSIEN15,DIK="^BPS(9002313.15," D ^DIK "RTN","BPSOSQ4",264,0) ; "RTN","BPSOSQ4",265,0) ; Clear any pointers to the sleep payer "RTN","BPSOSQ4",266,0) S IEN59T="" F S IEN59T=$O(^BPST("ASL",BPSIEN15,IEN59T)) Q:IEN59T="" D "RTN","BPSOSQ4",267,0) . S DIE=9002313.59,DA=IEN59T,DR="801///@" D ^DIE "RTN","BPSOSQ4",268,0) . D LOG^BPSOSL(IEN59T,$T(+0)_"-CLRSLEEP is clearing pointer to ASLEEP PAYER") "RTN","BPSOSQ4",269,0) ; "RTN","BPSOSQ4",270,0) ; Run the packeter to resubmit any other claims for the this payer "RTN","BPSOSQ4",271,0) D TASK^BPSOSQA "RTN","BPSOSQ4",272,0) Q "RTN","BPSOSQA") 0^36^B9139209 "RTN","BPSOSQA",1,0) BPSOSQA ;BHAM ISC/FCS/DRS/DLF - ECME background, Part 1 ;06/02/2004 "RTN","BPSOSQA",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSQA",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSQA",4,0) Q "RTN","BPSOSQA",5,0) ; "RTN","BPSOSQA",6,0) ; ONE59 - Validate BPS Transaction data "RTN","BPSOSQA",7,0) ; Input "RTN","BPSOSQA",8,0) ; IEN59 - BPS Transaction "RTN","BPSOSQA",9,0) ; "RTN","BPSOSQA",10,0) ONE59(IEN59) ;EP - from BPSOSIZ "RTN","BPSOSQA",11,0) ; Process this one IEN59 "RTN","BPSOSQA",12,0) ; "RTN","BPSOSQA",13,0) ; Initialize variables "RTN","BPSOSQA",14,0) N RTN,X1,REQTYPE,ERRNO,ERRMSG "RTN","BPSOSQA",15,0) S RTN=$T(+0),X1=$G(^BPST(IEN59,1)),REQTYPE=$P($G(^BPST(IEN59,0)),U,15) "RTN","BPSOSQA",16,0) ; "RTN","BPSOSQA",17,0) ; Create log entry "RTN","BPSOSQA",18,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSOSQA",19,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Validating the BPS Transaction") "RTN","BPSOSQA",20,0) ; "RTN","BPSOSQA",21,0) ; Validate that there is a request type "RTN","BPSOSQA",22,0) I REQTYPE="" D ERROR^BPSOSU(RTN,IEN59,109,"Request Type not found in Transaction ") G END "RTN","BPSOSQA",23,0) ; "RTN","BPSOSQA",24,0) S (ERRNO,ERRMSG)="" "RTN","BPSOSQA",25,0) I REQTYPE="C" D I ERRNO D ERROR^BPSOSU(RTN,IEN59,ERRNO,ERRMSG) G END "RTN","BPSOSQA",26,0) . N RX,RXR "RTN","BPSOSQA",27,0) . S RX=$P(X1,U,11),RXR=$P(X1,U) "RTN","BPSOSQA",28,0) . I RX="" S ERRNO=108,ERRMSG="Prescription Number not found in Transaction" Q "RTN","BPSOSQA",29,0) . I RXR="" S ERRNO=107,ERRMSG="Fill Number not found in Transaction" Q "RTN","BPSOSQA",30,0) . I $$RXAPI1^BPSUTIL1(RX,.01,"I")="" S ERRNO=101,ERRMSG="Missing RX # field .01" Q "RTN","BPSOSQA",31,0) . I RXR,$$RXSUBF1^BPSUTIL1(RX,52,52.1,RXR,.01,"I")="" S ERRNO=102,ERRMSG="Missing RX Refill field .01" Q "RTN","BPSOSQA",32,0) ; "RTN","BPSOSQA",33,0) ; Check for missing patient "RTN","BPSOSQA",34,0) I '$P(^BPST(IEN59,0),U,6) D ERROR^BPSOSU(RTN,IEN59,103,"Patient missing from BPS Transaction") G END "RTN","BPSOSQA",35,0) ; "RTN","BPSOSQA",36,0) ; Check for missing division "RTN","BPSOSQA",37,0) I '$P(X1,U,4) D ERROR^BPSOSU(RTN,IEN59,104,"Division missing from BPS Transaction") G END "RTN","BPSOSQA",38,0) ; "RTN","BPSOSQA",39,0) ; Check for missing BPS Pharmacy "RTN","BPSOSQA",40,0) I '$P(X1,U,7)="" D ERROR^BPSOSU(RTN,IEN59,105,"ECME Pharmacy missing from BPS Transaction") G END "RTN","BPSOSQA",41,0) ; "RTN","BPSOSQA",42,0) ; Check for missing insurance node "RTN","BPSOSQA",43,0) I '$D(^BPST(IEN59,10,1,0)) D ERROR^BPSOSU(RTN,IEN59,106,"Missing Insurance in BPST("_IEN59_",10,1,0)") G END "RTN","BPSOSQA",44,0) ; "RTN","BPSOSQA",45,0) ; If we got this far, we did not get an error "RTN","BPSOSQA",46,0) ; Change status to 30 (Waiting for packet build) "RTN","BPSOSQA",47,0) D SETSTAT^BPSOSU(IEN59,30) "RTN","BPSOSQA",48,0) ; "RTN","BPSOSQA",49,0) END ; Common exit point "RTN","BPSOSQA",50,0) ; "RTN","BPSOSQA",51,0) ; Log payer sequence "RTN","BPSOSQA",52,0) N BPSCOB "RTN","BPSOSQA",53,0) S BPSCOB=$$COB59^BPSUTIL2(IEN59),BPSCOB=$S(BPSCOB=2:"-Secondary",BPSCOB=3:"-Tertiary",1:"-Primary"),BPSCOB=BPSCOB_" Insurance" "RTN","BPSOSQA",54,0) D LOG^BPSOSL(IEN59,$T(+0)_BPSCOB) "RTN","BPSOSQA",55,0) ; "RTN","BPSOSQA",56,0) ; Log the contents of Transaction record "RTN","BPSOSQA",57,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Contents of ^BPST("_IEN59_"):") "RTN","BPSOSQA",58,0) D LOG59(IEN59) "RTN","BPSOSQA",59,0) ; "RTN","BPSOSQA",60,0) ; If there are claims at 30%, fire up the packet process "RTN","BPSOSQA",61,0) I $O(^BPST("AD",30,0)) D TASK "RTN","BPSOSQA",62,0) Q "RTN","BPSOSQA",63,0) ; "RTN","BPSOSQA",64,0) ; "RTN","BPSOSQA",65,0) LOG59(IEN59) ; Log the IEN59 array "RTN","BPSOSQA",66,0) N A "RTN","BPSOSQA",67,0) M A=^BPST(IEN59) "RTN","BPSOSQA",68,0) D LOGARRAY^BPSOSL(IEN59,"A") "RTN","BPSOSQA",69,0) Q "RTN","BPSOSQA",70,0) ; "RTN","BPSOSQA",71,0) TASK ;EP - from BPSOSQ2,BPSOSQ4,BPSOSRB "RTN","BPSOSQA",72,0) N X,%DT,Y S X="N",%DT="ST" D ^%DT "RTN","BPSOSQA",73,0) D TASKAT(Y) "RTN","BPSOSQA",74,0) Q "RTN","BPSOSQA",75,0) ; "RTN","BPSOSQA",76,0) TASKAT(ZTDTH) ;EP - from BPSOSQ4 (requeue if insurer is sleeping) "RTN","BPSOSQA",77,0) N ZTRTN,ZTIO "RTN","BPSOSQA",78,0) S ZTRTN="PACKETS^BPSOSQ2",ZTIO="" "RTN","BPSOSQA",79,0) D ^%ZTLOAD "RTN","BPSOSQA",80,0) Q "RTN","BPSOSQF") 0^83^B7245546 "RTN","BPSOSQF",1,0) BPSOSQF ;BHAM ISC/FCS/DRS/FLS - Insurer asleep - status 31 ;06/01/2004 "RTN","BPSOSQF",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSQF",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSQF",4,0) Q "RTN","BPSOSQF",5,0) ; "RTN","BPSOSQF",6,0) ; Check for insurer asleep claims "RTN","BPSOSQF",7,0) ; "RTN","BPSOSQF",8,0) STATUS31 ;EP - BPSOSQ2 "RTN","BPSOSQF",9,0) ; Loop through claims at 31% "RTN","BPSOSQF",10,0) ; Reset to 30% if: "RTN","BPSOSQF",11,0) ; a) This is a prober and it is time to retry "RTN","BPSOSQF",12,0) ; b) The insurer is awake "RTN","BPSOSQF",13,0) N IEN59,GRPLAN "RTN","BPSOSQF",14,0) ; "RTN","BPSOSQF",15,0) ; Make sure we can get the lock "RTN","BPSOSQF",16,0) I '$$LOCK59^BPSOSQ2(31) Q "RTN","BPSOSQF",17,0) ; "RTN","BPSOSQF",18,0) ; Loop through transactions that are 31% "RTN","BPSOSQF",19,0) S IEN59="" "RTN","BPSOSQF",20,0) F S IEN59=$O(^BPST("AD",31,IEN59)) Q:'IEN59 D "RTN","BPSOSQF",21,0) . ; "RTN","BPSOSQF",22,0) . ; Get the Group Plan for the transaction "RTN","BPSOSQF",23,0) . S GRPLAN=+$$GETPLN59^BPSUTIL2(IEN59) "RTN","BPSOSQF",24,0) . I GRPLAN=0 D LOG^BPSOSL(IEN59,$T(+0)_"-No Group Plan was found") Q "RTN","BPSOSQF",25,0) . ; "RTN","BPSOSQF",26,0) . ; If this is the prober and it is time to retry, reset the status "RTN","BPSOSQF",27,0) . I $$PROBER(GRPLAN)=IEN59,$$RETRY(GRPLAN) D RESET(IEN59,"-Prober Transaction") Q "RTN","BPSOSQF",28,0) . ; "RTN","BPSOSQF",29,0) . ; If the plan is no longer asleep, reset the status "RTN","BPSOSQF",30,0) . I '$$ISASLEEP(GRPLAN) D RESET(IEN59,"-Payer is awake") "RTN","BPSOSQF",31,0) ; "RTN","BPSOSQF",32,0) D UNLOCK59^BPSOSQ2(31) "RTN","BPSOSQF",33,0) Q "RTN","BPSOSQF",34,0) ; "RTN","BPSOSQF",35,0) RESET(IEN59,MSG) ; "RTN","BPSOSQF",36,0) ; Procedure to set status to 30% and log a message "RTN","BPSOSQF",37,0) ; Input: "RTN","BPSOSQF",38,0) ; IEN59 - BPS Transaction IEN59 "RTN","BPSOSQF",39,0) ; PROBER - Flag indicating whether this is a prober "RTN","BPSOSQF",40,0) I '$G(IEN59) Q "RTN","BPSOSQF",41,0) ; Clear pointer to Asleep Payer "RTN","BPSOSQF",42,0) N DIE,DA,DR,DTOUT "RTN","BPSOSQF",43,0) S DIE=9002313.59,DA=IEN59,DR="801///@" D ^DIE "RTN","BPSOSQF",44,0) ; Set status to 30% "RTN","BPSOSQF",45,0) D SETSTAT^BPSOSU(IEN59,30) "RTN","BPSOSQF",46,0) ; Log message "RTN","BPSOSQF",47,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Retrying Asleep Claim"_$G(MSG)) "RTN","BPSOSQF",48,0) Q "RTN","BPSOSQF",49,0) ; "RTN","BPSOSQF",50,0) ISASLEEP(GRPLAN) ; "RTN","BPSOSQF",51,0) ; Function to check if Payer is asleep. "RTN","BPSOSQF",52,0) ; Input: "RTN","BPSOSQF",53,0) ; GRPLAN = GROUP INSURANCE PLAN file IEN "RTN","BPSOSQF",54,0) ; Returns: "RTN","BPSOSQF",55,0) ; 1 = Yes, payer is asleep "RTN","BPSOSQF",56,0) ; 0 = No, payer is not asleep "RTN","BPSOSQF",57,0) I '$G(GRPLAN) Q 0 "RTN","BPSOSQF",58,0) N BPAIEN,BPSSITE "RTN","BPSOSQF",59,0) ; "RTN","BPSOSQF",60,0) ; If the plan is not in the Insurer Asleep file, asleep is off "RTN","BPSOSQF",61,0) S BPAIEN=$O(^BPS(9002313.15,"B",GRPLAN,0)) "RTN","BPSOSQF",62,0) Q:'BPAIEN 0 "RTN","BPSOSQF",63,0) ; "RTN","BPSOSQF",64,0) ; If the plan is set to ignore, asleep is off "RTN","BPSOSQF",65,0) I $$IGNORE(GRPLAN) Q 0 "RTN","BPSOSQF",66,0) ; "RTN","BPSOSQF",67,0) ; Check is the site parameters have disabled sleep "RTN","BPSOSQF",68,0) S BPSSITE=$G(^BPS(9002313.99,1,0)) "RTN","BPSOSQF",69,0) I '$P(BPSSITE,"^",5)!('$P(BPSSITE,"^",6)) Q 0 "RTN","BPSOSQF",70,0) ; "RTN","BPSOSQF",71,0) Q 1 "RTN","BPSOSQF",72,0) ; "RTN","BPSOSQF",73,0) IGNORE(GRPLAN) ; "RTN","BPSOSQF",74,0) ; Function to check if IGNORE ASLEEP flag set for Plan "RTN","BPSOSQF",75,0) ; Input: "RTN","BPSOSQF",76,0) ; GRPLAN = Group Insurance Plan file IEN "RTN","BPSOSQF",77,0) ; Returns: "RTN","BPSOSQF",78,0) ; 1 = Ignore "RTN","BPSOSQF",79,0) ; 0 = Don't Ignore "RTN","BPSOSQF",80,0) I '$G(GRPLAN) Q 0 "RTN","BPSOSQF",81,0) N BPAIEN "RTN","BPSOSQF",82,0) S BPAIEN=$O(^BPS(9002313.15,"B",GRPLAN,0)) "RTN","BPSOSQF",83,0) Q:'BPAIEN 0 "RTN","BPSOSQF",84,0) Q $S($P($G(^BPS(9002313.15,BPAIEN,0)),U,3)=1:1,1:0) "RTN","BPSOSQF",85,0) ; "RTN","BPSOSQF",86,0) PROBER(GRPLAN) ; "RTN","BPSOSQF",87,0) ; Function to return the PROBER CLAIM for an insurer "RTN","BPSOSQF",88,0) ; Input: "RTN","BPSOSQF",89,0) ; GRPLAN = Group Insurance Plan file IEN "RTN","BPSOSQF",90,0) ; Returns: "RTN","BPSOSQF",91,0) ; PROBER CLAIM - Pointer to BPS TRANSACTION file "RTN","BPSOSQF",92,0) I '$G(GRPLAN) Q "" "RTN","BPSOSQF",93,0) N BPAIEN "RTN","BPSOSQF",94,0) S BPAIEN=$O(^BPS(9002313.15,"B",GRPLAN,0)) "RTN","BPSOSQF",95,0) Q:'BPAIEN "" "RTN","BPSOSQF",96,0) Q $P($G(^BPS(9002313.15,BPAIEN,0)),U,4) "RTN","BPSOSQF",97,0) ; "RTN","BPSOSQF",98,0) RETRY(GRPLAN) ; "RTN","BPSOSQF",99,0) ; Function to return a flag indicating whether it is time to rerun the prober "RTN","BPSOSQF",100,0) ; Input: "RTN","BPSOSQF",101,0) ; GRPLAN = Group Insurance Plan file IEN "RTN","BPSOSQF",102,0) ; Returns: "RTN","BPSOSQF",103,0) ; RETRY = Flag indicating it is time to retry the prober "RTN","BPSOSQF",104,0) I '$G(GRPLAN) Q 0 "RTN","BPSOSQF",105,0) N BPAIEN,RETRY "RTN","BPSOSQF",106,0) S BPAIEN=$O(^BPS(9002313.15,"B",GRPLAN,0)) "RTN","BPSOSQF",107,0) Q:'BPAIEN 0 "RTN","BPSOSQF",108,0) S RETRY=$$GET1^DIQ(9002313.15,BPAIEN_",",.05,"I") "RTN","BPSOSQF",109,0) I RETRY'>$$NOW^XLFDT Q 1 "RTN","BPSOSQF",110,0) Q 0 "RTN","BPSOSQG") 0^59^B6945511 "RTN","BPSOSQG",1,0) BPSOSQG ;BHAM ISC/FCS/DRS/FLS - form transmission packets ;06/01/2004 "RTN","BPSOSQG",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOSQG",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSQG",4,0) Q "RTN","BPSOSQG",5,0) ; "RTN","BPSOSQG",6,0) ; PACKET "RTN","BPSOSQG",7,0) ; Calls BPSOSCA to get claims data (BPS array) "RTN","BPSOSQG",8,0) ; Calls BPSECA1 to create packet "RTN","BPSOSQG",9,0) ; Calls CHOP^BPSECMC2 to send packet to HL7 application "RTN","BPSOSQG",10,0) ; "RTN","BPSOSQG",11,0) PACKET() ;EP - BPSOSQ2 "RTN","BPSOSQG",12,0) ; packetize one transaction (and possibly more transactions "RTN","BPSOSQG",13,0) ; for the same patient, if they're ready now.) "RTN","BPSOSQG",14,0) ; Called from BPSOSQ2, "RTN","BPSOSQG",15,0) ; which gave us TRANLIST(IEN59) array of claims to packetize. "RTN","BPSOSQG",16,0) ; "RTN","BPSOSQG",17,0) N CLAIMIEN,ERROR,FIRST59 "RTN","BPSOSQG",18,0) ; "RTN","BPSOSQG",19,0) ; Get first transaction from list "RTN","BPSOSQG",20,0) S FIRST59=$O(TRANLIST(0)) "RTN","BPSOSQG",21,0) ; "RTN","BPSOSQG",22,0) ; If it's a reversal, we already have an ^BPSC(, which was "RTN","BPSOSQG",23,0) ; created by the call to BPSECA8, way back at the beginning. "RTN","BPSOSQG",24,0) ; So, unlike claims, we need only the NCPDP formatting for it "RTN","BPSOSQG",25,0) ; by creating CLAIMIEN array and jumping to POINTM "RTN","BPSOSQG",26,0) I $G(^BPST(FIRST59,4)) D G POINTM "RTN","BPSOSQG",27,0) . ; Mimic a few things that are set up in the code we're skipping "RTN","BPSOSQG",28,0) . S CLAIMIEN=$P(^BPST(FIRST59,4),U) "RTN","BPSOSQG",29,0) . S CLAIMIEN(CLAIMIEN)="" "RTN","BPSOSQG",30,0) ; "RTN","BPSOSQG",31,0) ; DMB - This code will only be executed if there is more than one "RTN","BPSOSQG",32,0) ; transaction in TRANLIST. This will not happen for the VA but leave "RTN","BPSOSQG",33,0) ; functionality in case we bundle claims later "RTN","BPSOSQG",34,0) I $O(TRANLIST($O(TRANLIST("")))) D "RTN","BPSOSQG",35,0) . D LOG2LIST^BPSOSL($T(+0)_"-Packetizing - we have more than one claim:") "RTN","BPSOSQG",36,0) . N I,X,Y S (X,Y)="" "RTN","BPSOSQG",37,0) . F I=1:1 S X=$O(TRANLIST(X)) Q:'X D "RTN","BPSOSQG",38,0) . . S $P(Y,", ",I-1#4+1)=X "RTN","BPSOSQG",39,0) . . I I#4=0 D LOG2LIST^BPSOSL(Y) S Y="" "RTN","BPSOSQG",40,0) . I Y]"" D LOG2LIST^BPSOSL(Y) "RTN","BPSOSQG",41,0) ; "RTN","BPSOSQG",42,0) ; BPSOSCA calls BPSOSCB,BPSOSCC,BPSOSCD to set up BPS(*) and "RTN","BPSOSQG",43,0) ; then calls BPSOSCE to create claims in 9002313.02 "RTN","BPSOSQG",44,0) ; BPSOSCA expects TRANLIST(*) to be defined and will return "RTN","BPSOSQG",45,0) ; ERROR - any error encountered "RTN","BPSOSQG",46,0) ; CLAIMIEN - last claim created "RTN","BPSOSQG",47,0) ; CLAIMIEN(CLAIMIEN) - the list of all claims created "RTN","BPSOSQG",48,0) S ERROR=$$EN^BPSOSCA(.CLAIMIEN) "RTN","BPSOSQG",49,0) I ERROR D LOG2LIST^BPSOSL($T(+0)_"-ERROR="_ERROR_" returned from BPSOSCA") "RTN","BPSOSQG",50,0) I $G(CLAIMIEN)<1 Q $S(ERROR:ERROR,1:"300^No Claim IEN returned by BPSOSCA") "RTN","BPSOSQG",51,0) ; "RTN","BPSOSQG",52,0) ; POINTM will create the claims packet and put them in XTMP "RTN","BPSOSQG",53,0) POINTM ; Reversals are joining again here "RTN","BPSOSQG",54,0) N VAMSG,IEN59,ERROR "RTN","BPSOSQG",55,0) ; "RTN","BPSOSQG",56,0) ; CLAIMIEN(*) = a list of CLAIMIENs that were generated from "RTN","BPSOSQG",57,0) ; all the transactions that might have been bundled together. "RTN","BPSOSQG",58,0) ; So we must loop through that list. "RTN","BPSOSQG",59,0) ; Currently, VA does not bundle claims. If it does so, "RTN","BPSOSQG",60,0) ; we may want to change error handling. "RTN","BPSOSQG",61,0) S ERROR=0,CLAIMIEN="" "RTN","BPSOSQG",62,0) F S CLAIMIEN=$O(CLAIMIEN(CLAIMIEN)) Q:CLAIMIEN="" D "RTN","BPSOSQG",63,0) . S IEN59=$O(^BPST("AE",CLAIMIEN,"")) "RTN","BPSOSQG",64,0) . I IEN59="" S IEN59=$O(^BPST("AER",CLAIMIEN,"")) "RTN","BPSOSQG",65,0) . I IEN59="" S ERROR="500^Transaction IEN not determined for "_CLAIMIEN Q "RTN","BPSOSQG",66,0) . D SETSTAT^BPSOSU(IEN59,50) "RTN","BPSOSQG",67,0) . K VAMSG "RTN","BPSOSQG",68,0) . D LOG2CLM^BPSOSL(CLAIMIEN,$T(+0)_"-Packet being built for Claim ID "_$P(^BPSC(CLAIMIEN,0),U)) "RTN","BPSOSQG",69,0) . D ASCII^BPSECA1(CLAIMIEN,.VAMSG) "RTN","BPSOSQG",70,0) . I '$G(VAMSG("HLS",0)) S ERROR="501^Claim packet not built for "_$P($G(^BPSC(CLAIMIEN,0)),U,1) Q "RTN","BPSOSQG",71,0) . D CHOP^BPSECMC2(.VAMSG,CLAIMIEN,IEN59) "RTN","BPSOSQG",72,0) Q ERROR "RTN","BPSOSQL") 0^38^B18210044 "RTN","BPSOSQL",1,0) BPSOSQL ;BHAM ISC/FCS/DRS/FLS - Process responses ;12/7/07 15:28 "RTN","BPSOSQL",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSQL",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSQL",4,0) ; "RTN","BPSOSQL",5,0) Q "RTN","BPSOSQL",6,0) ; "RTN","BPSOSQL",7,0) ; ONE(CLAIMIEN,RESPIEN) "RTN","BPSOSQL",8,0) ; Process the Response for the claim. Loop through the "RTN","BPSOSQL",9,0) ; transaction associated with the claim and call RESP1 "RTN","BPSOSQL",10,0) ; RESP1 "RTN","BPSOSQL",11,0) ; The real work of response handling for one IEN59 is in here "RTN","BPSOSQL",12,0) ; RESPBAD "RTN","BPSOSQL",13,0) ; Branch from RESP1 if there is no response value in the transaction "RTN","BPSOSQL",14,0) ; "RTN","BPSOSQL",15,0) ; ONE - Both the claim and response record are correct and complete "RTN","BPSOSQL",16,0) ; Now update all of the transaction records affected by them. "RTN","BPSOSQL",17,0) ONE(CLAIMIEN,RESPIEN) ; "RTN","BPSOSQL",18,0) N TRANTYPE,INDEX,IEN59 "RTN","BPSOSQL",19,0) S TRANTYPE=$P($G(^BPSC(CLAIMIEN,100)),"^",3) "RTN","BPSOSQL",20,0) S INDEX=$S(TRANTYPE="B2":"AER",1:"AE") "RTN","BPSOSQL",21,0) S IEN59=0 "RTN","BPSOSQL",22,0) F S IEN59=$O(^BPST(INDEX,CLAIMIEN,IEN59)) Q:IEN59="" D "RTN","BPSOSQL",23,0) . D RESP1(IEN59,TRANTYPE,CLAIMIEN,RESPIEN) "RTN","BPSOSQL",24,0) Q "RTN","BPSOSQL",25,0) ; "RTN","BPSOSQL",26,0) ; RESP1 - Process each transaction associated with the transmission "RTN","BPSOSQL",27,0) RESP1(IEN59,TRANTYPE,CLAIMIEN,RESPIEN) ; called from ONE "RTN","BPSOSQL",28,0) N ERROR,ERRTXT,X,MSG "RTN","BPSOSQL",29,0) ; "RTN","BPSOSQL",30,0) ; Store pointer to response "RTN","BPSOSQL",31,0) N DIE,DA,DR "RTN","BPSOSQL",32,0) S DIE=9002313.59,DA=IEN59 "RTN","BPSOSQL",33,0) S DR=$S(TRANTYPE="B2":402,1:4)_"////"_RESPIEN "RTN","BPSOSQL",34,0) D ^DIE "RTN","BPSOSQL",35,0) ; "RTN","BPSOSQL",36,0) ; Update the status "RTN","BPSOSQL",37,0) D SETSTAT^BPSOSU(IEN59,90) ; "Processing response" "RTN","BPSOSQL",38,0) ; "RTN","BPSOSQL",39,0) ; Get Position and log it "RTN","BPSOSQL",40,0) N POSITION S POSITION=$P(^BPST(IEN59,0),U,9) "RTN","BPSOSQL",41,0) I TRANTYPE'="B1" S POSITION=1 ; Reversals and eligibility have only 1 transaction "RTN","BPSOSQL",42,0) ; "RTN","BPSOSQL",43,0) ; "RTN","BPSOSQL",44,0) S MSG=$T(+0)_"-Processing "_$S(TRANTYPE="B2":"Reversal ",TRANTYPE="E1":"Eligibility ",1:"") "RTN","BPSOSQL",45,0) S MSG=MSG_"Response #"_RESPIEN_" for Claim #"_CLAIMIEN_" and position "_POSITION "RTN","BPSOSQL",46,0) D LOG^BPSOSL(IEN59,MSG) "RTN","BPSOSQL",47,0) ; "RTN","BPSOSQL",48,0) ; If the Response Status is missing for the transaction, quit with error "RTN","BPSOSQL",49,0) I '$D(^BPSR(RESPIEN,1000,POSITION,500)) D G RESPBAD "RTN","BPSOSQL",50,0) . S ERROR=901,ERRTXT="Corrupted response `"_RESPIEN "RTN","BPSOSQL",51,0) ; "RTN","BPSOSQL",52,0) ; Get the Respose Status for the transaction and update the statistics "RTN","BPSOSQL",53,0) N RESP,PIECE S RESP=$P(^BPSR(RESPIEN,1000,POSITION,500),U) "RTN","BPSOSQL",54,0) S PIECE=$S(RESP="R"&TRANTYPE="B2":7,RESP="R"&(TRANTYPE="E1"):10,RESP="R":2,RESP="P":3,RESP="D":4,RESP="C":5,RESP="A"&(TRANTYPE="B2"):6,RESP="A":9,1:19) "RTN","BPSOSQL",55,0) D INCSTAT^BPSOSUD("R",PIECE) "RTN","BPSOSQL",56,0) ; "RTN","BPSOSQL",57,0) ; Log Response and if Payable, Amount Paid "RTN","BPSOSQL",58,0) S MSG=$T(+0)_"-Response = "_RESP "RTN","BPSOSQL",59,0) I RESP="P" S MSG=MSG_"-$"_$$INSPAID1^BPSOS03(RESPIEN,POSITION) "RTN","BPSOSQL",60,0) D LOG^BPSOSL(IEN59,MSG) "RTN","BPSOSQL",61,0) ; "RTN","BPSOSQL",62,0) ; If the claims was rejected, log the reject reason "RTN","BPSOSQL",63,0) I RESP="R" D ; rejected, give rejection reasons "RTN","BPSOSQL",64,0) . N J S J=0 F S J=$O(^BPSR(RESPIEN,1000,POSITION,511,J)) Q:'J D "RTN","BPSOSQL",65,0) .. N R,X S R=$P($G(^BPSR(RESPIEN,1000,POSITION,511,J,0)),U) "RTN","BPSOSQL",66,0) .. I R]"" D "RTN","BPSOSQL",67,0) ... S X=$O(^BPSF(9002313.93,"B",R,0)) "RTN","BPSOSQL",68,0) ... ; Check if reject lists for non-covered drug needs to be updated IA# 5185 "RTN","BPSOSQL",69,0) ... I TRANTYPE="B1" D UPDLST^IBNCDNC(+($G(IEN59)\1),$P($G(^BPST(+$G(IEN59),1)),U,2),$P($G(^BPSC(+$G(CLAIMIEN),1)),U,4),X) "RTN","BPSOSQL",70,0) ... I X]"" S X=$P($G(^BPSF(9002313.93,X,0)),U,2) "RTN","BPSOSQL",71,0) .. E S X="" "RTN","BPSOSQL",72,0) .. D LOG^BPSOSL(IEN59,"Reject Code: "_R_" - "_X) "RTN","BPSOSQL",73,0) . ; "RTN","BPSOSQL",74,0) . ; If there are reject codes and the claim is a billing request, synch reject codes "RTN","BPSOSQL",75,0) . ; with Outpatient Pharmacy "RTN","BPSOSQL",76,0) . I TRANTYPE="B1" D DURSYNC^BPSECMP2(IEN59) "RTN","BPSOSQL",77,0) ; "RTN","BPSOSQL",78,0) ; Get response messages and log them. "RTN","BPSOSQL",79,0) S X=$G(^BPSR(RESPIEN,504)) "RTN","BPSOSQL",80,0) I X]"" D LOG^BPSOSL(IEN59,"Response Message: "_X) "RTN","BPSOSQL",81,0) N ADDMESS "RTN","BPSOSQL",82,0) D ADDMESS^BPSSCRLG(RESPIEN,POSITION,.ADDMESS) "RTN","BPSOSQL",83,0) I $D(ADDMESS) D LOG^BPSOSL(IEN59,"Additional Text Message (array):"),LOGARRAY^BPSOSL(IEN59,"ADDMESS") "RTN","BPSOSQL",84,0) ; "RTN","BPSOSQL",85,0) ; Check if the payer should go to sleep based on the reject codes "RTN","BPSOSQL",86,0) I $$REJSLEEP^BPSOSQ4(RESPIEN,POSITION,IEN59),$$INCSLEEP^BPSOSQ4(IEN59) Q "RTN","BPSOSQL",87,0) ; "RTN","BPSOSQL",88,0) ; If we are here, we are not asleep so we need to clear sleep and log completion "RTN","BPSOSQL",89,0) ; Get the GROUP INSURANCE PLAN "RTN","BPSOSQL",90,0) N GRPLAN "RTN","BPSOSQL",91,0) S GRPLAN=$$GETPLN59^BPSUTIL2(IEN59) "RTN","BPSOSQL",92,0) ; "RTN","BPSOSQL",93,0) ; Clear any insurer asleep flags "RTN","BPSOSQL",94,0) D CLRSLEEP^BPSOSQ4(GRPLAN,IEN59) "RTN","BPSOSQL",95,0) ; "RTN","BPSOSQL",96,0) ; Set Result and final status (99%-Done) "RTN","BPSOSQL",97,0) N RESULT "RTN","BPSOSQL",98,0) S RESULT=$S(TRANTYPE="B2":"Reversal ",TRANTYPE="E1":"Eligibility ",1:"") "RTN","BPSOSQL",99,0) S RESULT=RESULT_$S(RESP="R":"Rejected",RESP="P":"Payable",RESP="D"!(RESP="S"):"Duplicate",RESP="C":"Captured",RESP="A":"Accepted",1:"Completed") "RTN","BPSOSQL",100,0) D SETRESU^BPSOSU(IEN59,0,RESULT) "RTN","BPSOSQL",101,0) D SETSTAT^BPSOSU(IEN59,99) "RTN","BPSOSQL",102,0) Q "RTN","BPSOSQL",103,0) ; "RTN","BPSOSQL",104,0) RESPBAD ; corrupted response escape from RESP1 - reached by a GOTO from RESP1 "RTN","BPSOSQL",105,0) ; Log the error "RTN","BPSOSQL",106,0) D ERROR^BPSOSU($T(+0),IEN59,$G(ERROR),$G(ERRTXT)) "RTN","BPSOSQL",107,0) Q "RTN","BPSOSR2") 1^31 "RTN","BPSOSRB") 0^35^B37930857 "RTN","BPSOSRB",1,0) BPSOSRB ;BHAM ISC/FCS/DRS/FLS - Process claim on processing queue ;06/01/2004 "RTN","BPSOSRB",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRB",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRB",4,0) ; "RTN","BPSOSRB",5,0) Q "RTN","BPSOSRB",6,0) BACKGR ; "RTN","BPSOSRB",7,0) I '$$LOCKNOW^BPSOSRX("BACKGROUND") Q "RTN","BPSOSRB",8,0) N TYPE,KEY1,KEY2,IEN59,IEN59PR,BPNOW,BPUNTIL "RTN","BPSOSRB",9,0) N BPIEN77,BPLCKRX,BPQ,BPCOBIND,GRPLAN "RTN","BPSOSRB",10,0) S BPNOW=$$NOW^BPSOSRX() "RTN","BPSOSRB",11,0) ;go through all ACTIVATED "RTN","BPSOSRB",12,0) S KEY1="" F S KEY1=$O(^BPS(9002313.77,"AC",1,KEY1)) Q:KEY1="" D "RTN","BPSOSRB",13,0) . S KEY2="" F S KEY2=$O(^BPS(9002313.77,"AC",1,KEY1,KEY2)) Q:KEY2="" D "RTN","BPSOSRB",14,0) . . S IEN59PR=+$$IEN59^BPSOSRX(KEY1,KEY2,0) "RTN","BPSOSRB",15,0) . . S BPLCKRX=$$LOCKRF^BPSOSRX(KEY1,KEY2,10,IEN59PR,$T(+0)) I BPLCKRX=0 D Q "RTN","BPSOSRB",16,0) . . . D LOG^BPSOSL(IEN59PR,$T(+0)_"-Failed to $$LOCKRF^BPSOSRX. Will retry later.") "RTN","BPSOSRB",17,0) . . S BPQ=0 "RTN","BPSOSRB",18,0) . . S BPIEN77="" F S BPIEN77=$O(^BPS(9002313.77,"AC",1,KEY1,KEY2,BPIEN77)) Q:(+BPIEN77=0)!(BPQ=1) D "RTN","BPSOSRB",19,0) . . . ;check DONT PROCESS UNTIL field #.08 and if it is greater than NOW then DO NOT process it "RTN","BPSOSRB",20,0) . . . S BPUNTIL=+$P($G(^BPS(9002313.77,BPIEN77,0)),U,8) I BPUNTIL>BPNOW S BPQ=1 Q ;D LOG^BPSOSL(IEN59,$T(+0)_"-The request cannot be processed until."_BPUNTIL_" Will retry later.") Q "RTN","BPSOSRB",21,0) . . . ;check if PROCESS FLAG is IN PROCESS - if the earlier record for this RX refill is in progress - "RTN","BPSOSRB",22,0) . . . ;we should not process the next operation queued - go to the next refill (BPQ=1) "RTN","BPSOSRB",23,0) . . . I $P($G(^BPS(9002313.77,BPIEN77,0)),U,4)=2 S BPQ=1 D Q "RTN","BPSOSRB",24,0) . . . . D LOG^BPSOSL(IEN59,$T(+0)_"-Status is 'IN PROCESS'. Will retry later.") "RTN","BPSOSRB",25,0) . . . S BPCOBIND=$P(^BPS(9002313.77,BPIEN77,0),U,3) "RTN","BPSOSRB",26,0) . . . S IEN59=$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND) "RTN","BPSOSRB",27,0) . . . ; Removed code to check Insurer Asleep "RTN","BPSOSRB",28,0) . . . S TYPE=$P($G(^BPS(9002313.77,+BPIEN77,1)),U,4),TYPE=$S(TYPE="C":"CLAIM",TYPE="U":"UNCLAIM",TYPE="E":"ELIGIBILITY",1:"UNKNW") "RTN","BPSOSRB",29,0) . . . I TYPE="UNKNW" D ERROR(+BPIEN77,IEN59,"Request Type is unknown. Cannot be processed.") Q "RTN","BPSOSRB",30,0) . . . D LOG^BPSOSL(IEN59,$T(+0)_"-Processing the Activated request "_BPIEN77) "RTN","BPSOSRB",31,0) . . . D LOG^BPSOSL(IEN59,$T(+0)_"-Dequeuing. Type is "_TYPE) "RTN","BPSOSRB",32,0) . . . ; if this is ACTIVATED then make it IN PROCESS (see SETPRFLG below) "RTN","BPSOSRB",33,0) . . . N TIME,MOREDATA "RTN","BPSOSRB",34,0) . . . S TIME=$P($G(^BPS(9002313.77,+BPIEN77,6)),U,1) ; time requested "RTN","BPSOSRB",35,0) . . . D READMORE^BPSOSRX4(BPIEN77,.MOREDATA) "RTN","BPSOSRB",36,0) . . . ;now it is IN PROCESS - i.e. goes to BACKGR1 (as K ^XTMP("BPS-PROC",TYPE,KEY1,KEY2 in old logic) "RTN","BPSOSRB",37,0) . . . I +$$INPROCES^BPSOSRX4(BPIEN77)=0 D ERROR(+BPIEN77,IEN59,"Cannot change the PROCESS FLAG to IN PROCESS. Cannot be processed.") Q "RTN","BPSOSRB",38,0) . . . D LOG^BPSOSL(IEN59,$T(+0)_"-The request "_BPIEN77_" has been changed to IN PROCESS") "RTN","BPSOSRB",39,0) . . . I +$$BACKGR1(TYPE,KEY1,KEY2,TIME,.MOREDATA,IEN59,+BPIEN77)=0 Q "RTN","BPSOSRB",40,0) . . . S BPQ=1 ; This will skip requests with the same keys as the one just processed "RTN","BPSOSRB",41,0) . . I BPLCKRX D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59PR,$T(+0)) "RTN","BPSOSRB",42,0) D UNLOCK^BPSOSRX("BACKGROUND") "RTN","BPSOSRB",43,0) Q "RTN","BPSOSRB",44,0) ; "RTN","BPSOSRB",45,0) ; "RTN","BPSOSRB",46,0) ; BACKGR1 - Further processing of the claim "RTN","BPSOSRB",47,0) ; Besides the parameter below, IEN59 also needs to be defined "RTN","BPSOSRB",48,0) ; TYPE - "CLAIM", "UNCLAIM", or "ELIGIBILITY" "RTN","BPSOSRB",49,0) ; KEY1 - First key of the request "RTN","BPSOSRB",50,0) ; KEY2 - Second key of the request "RTN","BPSOSRB",51,0) ; TIME - time requested "RTN","BPSOSRB",52,0) ; MOREDATA - array with claim data "RTN","BPSOSRB",53,0) ; IEN59 - BPS TRANSACTION ien "RTN","BPSOSRB",54,0) ; BPS77 - BPS REQUEST file ien "RTN","BPSOSRB",55,0) BACKGR1(TYPE,KEY1,KEY2,TIME,MOREDATA,IEN59,BPS77) ; "RTN","BPSOSRB",56,0) ; Resolve multiple requests "RTN","BPSOSRB",57,0) N SKIP,SKIPREAS,BPCOBIND,RESULT,PAYABLE "RTN","BPSOSRB",58,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Processing request "_BPS77_" with keys "_KEY1_", "_KEY2_" and type "_TYPE) "RTN","BPSOSRB",59,0) S SKIP=0 "RTN","BPSOSRB",60,0) S BPCOBIND=$$COB59^BPSUTIL2(IEN59) "RTN","BPSOSRB",61,0) S RESULT=$P($$STATUS^BPSOSRX(KEY1,KEY2,0,,BPCOBIND),U) "RTN","BPSOSRB",62,0) S PAYABLE=$$PAYABLE^BPSOSRX5(RESULT) "RTN","BPSOSRB",63,0) I TYPE="CLAIM" D "RTN","BPSOSRB",64,0) . I $$RXDEL^BPSOS(KEY1,KEY2) S SKIP=1,SKIPREAS="Prescription is marked as DELETED or CANCELLED in Outpatient Pharmacy" Q "RTN","BPSOSRB",65,0) . I PAYABLE S SKIP=1,SKIPREAS="Prescription is currently paid. Previous Result is "_RESULT Q "RTN","BPSOSRB",66,0) I TYPE="UNCLAIM",'PAYABLE S SKIP=1,SKIPREAS="Cannot reverse - previous result was "_RESULT "RTN","BPSOSRB",67,0) ; "RTN","BPSOSRB",68,0) ; If the SKIP flag message is set, handle error and quit "RTN","BPSOSRB",69,0) I SKIP D ERROR(BPS77,IEN59,SKIPREAS) Q 0 "RTN","BPSOSRB",70,0) ; "RTN","BPSOSRB",71,0) ; Submit claim "RTN","BPSOSRB",72,0) S MOREDATA("SUBMIT TIME")=TIME "RTN","BPSOSRB",73,0) ; "RTN","BPSOSRB",74,0) ; If reversal, execute reversal code and quit "RTN","BPSOSRB",75,0) I TYPE="UNCLAIM" D REVERSE(IEN59,.MOREDATA,$G(BPS77)) Q 1 "RTN","BPSOSRB",76,0) ; "RTN","BPSOSRB",77,0) ; Claims and Eligibility will fall through to here "RTN","BPSOSRB",78,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Initiating Claim") "RTN","BPSOSRB",79,0) D EN^BPSOSIZ(IEN59,.MOREDATA,$G(BPS77)) "RTN","BPSOSRB",80,0) Q 1 "RTN","BPSOSRB",81,0) ; "RTN","BPSOSRB",82,0) ; Error handling - If a record can not be processed, then it needs to be "RTN","BPSOSRB",83,0) ; inactivated and the next request activated "RTN","BPSOSRB",84,0) ; "RTN","BPSOSRB",85,0) ; This is also called by ERROR^BPSOSIZ "RTN","BPSOSRB",86,0) ERROR(BPS77,IEN59,ERROR) ; "RTN","BPSOSRB",87,0) I '$G(BPS77) Q "RTN","BPSOSRB",88,0) I $G(ERROR)="" S ERROR="Unknown" "RTN","BPSOSRB",89,0) N BPNXT77,BPRETV "RTN","BPSOSRB",90,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Skipping "_BPS77_" because of ERROR: "_ERROR) "RTN","BPSOSRB",91,0) ; "RTN","BPSOSRB",92,0) ; Inactivate the current request "RTN","BPSOSRB",93,0) S BPRETV=$$INACTIVE^BPSOSRX4(BPS77,ERROR) "RTN","BPSOSRB",94,0) I 'BPRETV D LOG^BPSOSL(IEN59,$T(+0)_"-Could not inactivate the request: "_BPRETV) Q "RTN","BPSOSRB",95,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Request is inactivated") "RTN","BPSOSRB",96,0) ; "RTN","BPSOSRB",97,0) ; See if there is a next request linked to this one "RTN","BPSOSRB",98,0) ; If there is, activate it "RTN","BPSOSRB",99,0) S BPNXT77=+$$GETNXREQ^BPSOSRX6(BPS77,0,0,$G(IEN59)) "RTN","BPSOSRB",100,0) I BPNXT77 D "RTN","BPSOSRB",101,0) . S BPRETV=$$ACTIVATE^BPSOSRX4(BPNXT77) "RTN","BPSOSRB",102,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-The next request "_BPNXT77_" has "_$S('BPRETV:"not ",1:"")_"been activated") "RTN","BPSOSRB",103,0) Q "RTN","BPSOSRB",104,0) ; "RTN","BPSOSRB",105,0) ; Process the reversal "RTN","BPSOSRB",106,0) REVERSE(IEN59,MOREDATA,BP77) ; "RTN","BPSOSRB",107,0) N MSG,RETVAL,REV "RTN","BPSOSRB",108,0) ; "RTN","BPSOSRB",109,0) ; Update BPS REQUEST with the BPS TRANSACTION IEN "RTN","BPSOSRB",110,0) I $G(BP77)>0 D UPD7759^BPSOSRX4(BP77,IEN59) "RTN","BPSOSRB",111,0) ; "RTN","BPSOSRB",112,0) ; Log Reversal or Reversal/Resubmit message. "RTN","BPSOSRB",113,0) ; Note that the reversal/resubmit message is needed "RTN","BPSOSRB",114,0) ; for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSOSRB",115,0) S MSG=$T(+0)_"-Initiating Reversal" "RTN","BPSOSRB",116,0) D LOG^BPSOSL(IEN59,MSG) "RTN","BPSOSRB",117,0) ; "RTN","BPSOSRB",118,0) ; Change status to 0% (Waiting to Start), which will reset START TIME, "RTN","BPSOSRB",119,0) ; and then to 10% (Building transaction) "RTN","BPSOSRB",120,0) D SETSTAT^BPSOSU(IEN59,0) "RTN","BPSOSRB",121,0) D SETSTAT^BPSOSU(IEN59,10) "RTN","BPSOSRB",122,0) ; "RTN","BPSOSRB",123,0) ; Update Submit Date (#6), User (#13), Request Type (#19), Reversal Reason (#404), "RTN","BPSOSRB",124,0) ; Reversal Request (#405), Reversal Request Date and Time (#406), "RTN","BPSOSRB",125,0) ; and RX Action (#1201) in BPS Transactions "RTN","BPSOSRB",126,0) N DIE,DR,DA "RTN","BPSOSRB",127,0) S DIE=9002313.59,DA=IEN59 "RTN","BPSOSRB",128,0) S DR="6////"_$G(MOREDATA("SUBMIT TIME"))_";13////"_$G(MOREDATA("USER")) "RTN","BPSOSRB",129,0) S DR=DR_";404////"_$G(MOREDATA("REVERSAL REASON"))_";1201////"_$G(MOREDATA("RX ACTION")) "RTN","BPSOSRB",130,0) S DR=DR_";19////"_$G(MOREDATA("REQ TYPE"))_";405////"_$G(MOREDATA("REQ IEN"))_";406////"_MOREDATA("REQ DTTM") "RTN","BPSOSRB",131,0) ; "RTN","BPSOSRB",132,0) D ^DIE "RTN","BPSOSRB",133,0) ; "RTN","BPSOSRB",134,0) ; Store the Payer Sequence in the log "RTN","BPSOSRB",135,0) N BPSCOB "RTN","BPSOSRB",136,0) S BPSCOB=$$COB59^BPSUTIL2(IEN59),BPSCOB=$S(BPSCOB=2:"-Secondary",BPSCOB=3:"-Tertiary",1:"-Primary"),BPSCOB=BPSCOB_" Insurance" "RTN","BPSOSRB",137,0) D LOG^BPSOSL(IEN59,$T(+0)_BPSCOB) "RTN","BPSOSRB",138,0) ; "RTN","BPSOSRB",139,0) ; Store contents of BPST in the Log "RTN","BPSOSRB",140,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Contents of ^BPST("_IEN59_") :") "RTN","BPSOSRB",141,0) D LOG59^BPSOSQA(IEN59) ; Log contents of 9002313.59 "RTN","BPSOSRB",142,0) ; "RTN","BPSOSRB",143,0) ; Add semi-colon to result text "RTN","BPSOSRB",144,0) D PREVISLY^BPSOSIZ(IEN59) "RTN","BPSOSRB",145,0) ; "RTN","BPSOSRB",146,0) ; Construct reversal claim "RTN","BPSOSRB",147,0) ; If no reversal claim is returned, log error and quit. "RTN","BPSOSRB",148,0) S REV=$$REVERSE^BPSECA8(IEN59) "RTN","BPSOSRB",149,0) I REV=0 D Q "RTN","BPSOSRB",150,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Reversal claim not created for "_IEN59) "RTN","BPSOSRB",151,0) . D ERROR^BPSOSU($T(+0),IEN59,100,"Reversal Claim not created") "RTN","BPSOSRB",152,0) ; "RTN","BPSOSRB",153,0) ; Update Reversal Field in the transaction "RTN","BPSOSRB",154,0) S DIE=9002313.59,DA=IEN59,DR="401////"_REV "RTN","BPSOSRB",155,0) D ^DIE "RTN","BPSOSRB",156,0) ; "RTN","BPSOSRB",157,0) ; Update Log "RTN","BPSOSRB",158,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Reversal claim "_$P(^BPSC(REV,0),U)_" ("_REV_")") "RTN","BPSOSRB",159,0) ; "RTN","BPSOSRB",160,0) ; Update status to 30% (Building the claim) "RTN","BPSOSRB",161,0) D SETSTAT^BPSOSU(IEN59,30) "RTN","BPSOSRB",162,0) ; "RTN","BPSOSRB",163,0) ; Fire off task to get this on the HL7 queue "RTN","BPSOSRB",164,0) D TASK^BPSOSQA "RTN","BPSOSRB",165,0) Q "RTN","BPSOSRX") 0^24^B40198470 "RTN","BPSOSRX",1,0) BPSOSRX ;BHAM ISC/FCS/DRS/FLS - callable from RPMS pharm ;06/01/2004 "RTN","BPSOSRX",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRX",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX",4,0) ; "RTN","BPSOSRX",5,0) ; There are three callable entry points: "RTN","BPSOSRX",6,0) ; $$REQST^BPSOSRX Schedule request "RTN","BPSOSRX",7,0) ; $$STATUS^BPSOSRX Inquire about a request's status "RTN","BPSOSRX",8,0) ; "RTN","BPSOSRX",9,0) ; reference to ^%ZTLOAD supported by DBIA 10063 "RTN","BPSOSRX",10,0) ; reference to NOW^%DTC supported by DBIA 10000 "RTN","BPSOSRX",11,0) ; reference to ^%DT supported by DBIA 10003 "RTN","BPSOSRX",12,0) ; "RTN","BPSOSRX",13,0) Q "RTN","BPSOSRX",14,0) ; "RTN","BPSOSRX",15,0) ; Schedule request "RTN","BPSOSRX",16,0) ; Process all requests - Billing requests (CLAIM), Reversal (UNCLAIM) "RTN","BPSOSRX",17,0) ; and Eligibility verification requests "RTN","BPSOSRX",18,0) ; "RTN","BPSOSRX",19,0) ; Input: see MKRQST^BPSOSRX3 "RTN","BPSOSRX",20,0) ; Return values: "RTN","BPSOSRX",21,0) ; 1^BPS REQUEST ien = accepted for processing "RTN","BPSOSRX",22,0) ; 0^reason = failure (should never happen) "RTN","BPSOSRX",23,0) REQST(BPREQTYP,KEY1,KEY2,MOREDATA,BPCOBIND,IEN59,BILLNDC,BPSKIP) ; "RTN","BPSOSRX",24,0) N BPRETV,BPIEN77,BPIENS78 "RTN","BPSOSRX",25,0) S BPSKIP=+$G(BPSKIP) "RTN","BPSOSRX",26,0) D LOG^BPSOSL(IEN59,$T(+0)_"- Start creating request") "RTN","BPSOSRX",27,0) S BPRETV=$$MKINSUR^BPSOSRX2(KEY1,KEY2,.MOREDATA,.BPIENS78) "RTN","BPSOSRX",28,0) I +BPRETV=0 Q BPRETV "RTN","BPSOSRX",29,0) ;create BPS REQUEST records for primary insurer only and populate its IBDATA multiple with the iens of BPS INSURER DATA "RTN","BPSOSRX",30,0) S BPRETV=$$MKRQST^BPSOSRX3(BPREQTYP,KEY1,KEY2,.MOREDATA,.BPIENS78,BPCOBIND,$G(BILLNDC),BPSKIP) "RTN","BPSOSRX",31,0) Q BPRETV "RTN","BPSOSRX",32,0) ; "RTN","BPSOSRX",33,0) ; $$STATUS(KEY1,KEY2,QUE,BPRQIEN) - Returns the Status of the request "RTN","BPSOSRX",34,0) ; Input "RTN","BPSOSRX",35,0) ; KEY1 - First key of the request "RTN","BPSOSRX",36,0) ; KEY2 - Second key of the request "RTN","BPSOSRX",37,0) ; QUE (optional): 0 - Do not check if a request is on the queue "RTN","BPSOSRX",38,0) ; 1/null - Check if a request is on the queue "RTN","BPSOSRX",39,0) ; BPRQIEN (optional) - the BPS REQUESTS (#9002313.77) IEN "RTN","BPSOSRX",40,0) ; BPCOB (optional)-the payer sequence (1- Primary, 2 Secondary), if null then 1 (primary) is assumed "RTN","BPSOSRX",41,0) ; "RTN","BPSOSRX",42,0) ; Returns "RTN","BPSOSRX",43,0) ; RESULT^LAST UPDATE DATE/TIME^DESCRIPTION^STATUS % "RTN","BPSOSRX",44,0) ; Returns null if there's no ECME record of this request "RTN","BPSOSRX",45,0) ; "RTN","BPSOSRX",46,0) ; RESULT is either: "RTN","BPSOSRX",47,0) ; 1. IN PROGRESS for incomplete requests "RTN","BPSOSRX",48,0) ; 2. Final status for complete requests. See comments for "RTN","BPSOSRX",49,0) ; BPSOSUC for complete list of possible statuses. "RTN","BPSOSRX",50,0) ; 3. SCHEDULED for scheduled (not ACTIVATED yet) requests "RTN","BPSOSRX",51,0) ; "RTN","BPSOSRX",52,0) ; LAST UPDATE DATE/TIME is the Fileman date and time of the "RTN","BPSOSRX",53,0) ; last update to the status of this request. "RTN","BPSOSRX",54,0) ; "RTN","BPSOSRX",55,0) ; DESCRIPTION is either: "RTN","BPSOSRX",56,0) ; 1. Incomplete requests will be the status (i.e., Waiting to Start, "RTN","BPSOSRX",57,0) ; Transmitting) "RTN","BPSOSRX",58,0) ; 2. Completed requests will have the reason that the ECME process "RTN","BPSOSRX",59,0) ; was aborted if the result is E OTHER. Otherwise, it will "RTN","BPSOSRX",60,0) ; be similar to the RESULT "RTN","BPSOSRX",61,0) ; "RTN","BPSOSRX",62,0) ; STATUS % is the completion percentage. Note that 99 is considered "RTN","BPSOSRX",63,0) ; complete. "RTN","BPSOSRX",64,0) ; "RTN","BPSOSRX",65,0) ; "RTN","BPSOSRX",66,0) STATUS(KEY1,KEY2,QUE,BPRQIEN,BPCOB) ; "RTN","BPSOSRX",67,0) ; Setup needed variables "RTN","BPSOSRX",68,0) N IEN59,SDT,SUBDT,BP59REQ,BPTRTYP,BP59ZERO,BP59REQ "RTN","BPSOSRX",69,0) I '$G(KEY1) Q "" "RTN","BPSOSRX",70,0) I $G(KEY2)="" Q "" "RTN","BPSOSRX",71,0) I $G(QUE)="" S QUE=1 "RTN","BPSOSRX",72,0) ; "RTN","BPSOSRX",73,0) ;if BPRQIEN then it is called from BPSNCPD1 to display progress to the user. So we need to check queue anyway "RTN","BPSOSRX",74,0) I $G(BPRQIEN)>0 S QUE=1 "RTN","BPSOSRX",75,0) ; "RTN","BPSOSRX",76,0) ;default COB = primary "RTN","BPSOSRX",77,0) I +$G(BPCOB)=0 S BPCOB=1 "RTN","BPSOSRX",78,0) ; "RTN","BPSOSRX",79,0) ;get IEN of BPS TRANSACTION "RTN","BPSOSRX",80,0) S IEN59=$$IEN59(KEY1,KEY2,BPCOB) "RTN","BPSOSRX",81,0) ; "RTN","BPSOSRX",82,0) ;read zeroth node of the BPS TRANSACTION record "RTN","BPSOSRX",83,0) S BP59ZERO=$G(^BPST(IEN59,0)) "RTN","BPSOSRX",84,0) ; "RTN","BPSOSRX",85,0) ;if doesn't have BPS TRANSACTION record AND doesn't have any BPS REQUEST records then "RTN","BPSOSRX",86,0) ;this is an old request OR it is not e-billable - so use the old logic, "RTN","BPSOSRX",87,0) ;which was used before COB patch, so this is for primary claims only. "RTN","BPSOSRX",88,0) I BPCOB=1 I $G(BPRQIEN)="" I BP59ZERO="" I '$D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB)) Q $$OLDSTAT^BPSOSRX6(KEY1,KEY2,$G(QUE)) "RTN","BPSOSRX",89,0) ; "RTN","BPSOSRX",90,0) ;if doesn't have BPS TRANSACTION record (not created yet) AND has BPS REQUEST record(s) "RTN","BPSOSRX",91,0) I BP59ZERO="" Q $$QUESTAT(KEY1,KEY2,BPCOB) "RTN","BPSOSRX",92,0) ; "RTN","BPSOSRX",93,0) ;get transaction type "RTN","BPSOSRX",94,0) S BPTRTYP=$P(BP59ZERO,U,15) "RTN","BPSOSRX",95,0) ;if Transaction type is not defined then this is an OLD request so use the old logic "RTN","BPSOSRX",96,0) ;which was used before COB patch, so this is for primary claims only. "RTN","BPSOSRX",97,0) I BPCOB=1 I $G(BPRQIEN)="" I BPTRTYP="" Q $$OLDSTAT^BPSOSRX6(KEY1,KEY2,$G(QUE)) "RTN","BPSOSRX",98,0) ; "RTN","BPSOSRX",99,0) ;get the current BPS REQUEST "RTN","BPSOSRX",100,0) S BP59REQ=$$GETRQST^BPSUTIL2(IEN59) "RTN","BPSOSRX",101,0) I $G(BP59REQ)="" Q $$QUESTAT(KEY1,KEY2,BPCOB) "RTN","BPSOSRX",102,0) ; "RTN","BPSOSRX",103,0) ;get request date/time "RTN","BPSOSRX",104,0) S SDT=$P($G(^BPS(9002313.77,+$G(BP59REQ),6)),U,1) ;REQUEST DATE AND TIME "RTN","BPSOSRX",105,0) ; "RTN","BPSOSRX",106,0) ; Loop: Get data, quit if times and status match (no change during gather) "RTN","BPSOSRX",107,0) N A,C,T1,T2,S1,S2 "RTN","BPSOSRX",108,0) F D I T1=T2,S1=S2 Q "RTN","BPSOSRX",109,0) . S T1=$$LASTUP59^BPSOSRX(IEN59) "RTN","BPSOSRX",110,0) . S S1=$$STATUS59^BPSOSRX(IEN59) "RTN","BPSOSRX",111,0) . I S1=99 D ; completed "RTN","BPSOSRX",112,0) . . S A=$$CATEG^BPSOSUC(IEN59) "RTN","BPSOSRX",113,0) . . S C=$$RESTXT59^BPSOSRX(IEN59) "RTN","BPSOSRX",114,0) . I S1'=99 D "RTN","BPSOSRX",115,0) . . S A="IN PROGRESS" "RTN","BPSOSRX",116,0) . . S C=$$STATI^BPSOSU($S(S1="":10,1:S1)) "RTN","BPSOSRX",117,0) . S T2=$$LASTUP59^BPSOSRX(IEN59) "RTN","BPSOSRX",118,0) . S S2=$$STATUS59^BPSOSRX(IEN59) "RTN","BPSOSRX",119,0) ; "RTN","BPSOSRX",120,0) ; If the queue parameter is set and the submit date from the queue "RTN","BPSOSRX",121,0) ; follows the SUBMIT DATE/LAST UPDATE date from BPS TRANSACTION "RTN","BPSOSRX",122,0) ; or the request is still on the queue, then change the response "RTN","BPSOSRX",123,0) ; to IN PROGRESS^Submit Date^WAITING TO START "RTN","BPSOSRX",124,0) S SUBDT=$$SUBMIT59^BPSOSRX(IEN59) "RTN","BPSOSRX",125,0) I SUBDT="" S SUBDT=T1 "RTN","BPSOSRX",126,0) ; "RTN","BPSOSRX",127,0) ;if we need to check the queue "RTN","BPSOSRX",128,0) I $G(QUE),$$QUETIME(KEY1,KEY2,BPCOB,1)>SUBDT S A="IN PROGRESS",T1=SDT,S1=-1,C=$$STATI^BPSOSU(0) "RTN","BPSOSRX",129,0) I $G(QUE),$$QUETIME(KEY1,KEY2,BPCOB,0)>SUBDT S A="IN PROGRESS",T1=SDT,S1=-1,C=$$STATI^BPSOSU(0) "RTN","BPSOSRX",130,0) I $G(QUE),$$QUETIME(KEY1,KEY2,BPCOB,2)>SUBDT S A="IN PROGRESS",T1=SDT,S1=-1,C=$$STATI^BPSOSU(0) ;To check IN PROCESS "RTN","BPSOSRX",131,0) ; "RTN","BPSOSRX",132,0) ; Return results "RTN","BPSOSRX",133,0) Q A_U_T1_U_$E(C,1,255-$L(A)-$L(T1)-2)_U_S1 "RTN","BPSOSRX",134,0) ; "RTN","BPSOSRX",135,0) ;the most current queue status as text "RTN","BPSOSRX",136,0) QUESTAT(KEY1,KEY2,BPCOB) ; "RTN","BPSOSRX",137,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,2)) Q "IN PROGRESS"_U_$$QUETIME(KEY1,KEY2,BPCOB,2)_U_$$STATI^BPSOSU(-96)_U_-1 "RTN","BPSOSRX",138,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,1)) Q "IN PROGRESS"_U_$$QUETIME(KEY1,KEY2,BPCOB,1)_U_$$STATI^BPSOSU(0)_U_-1 "RTN","BPSOSRX",139,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,0)) Q "IN PROGRESS"_U_$$QUETIME(KEY1,KEY2,BPCOB,0)_U_$$STATI^BPSOSU(-99)_U_-1 "RTN","BPSOSRX",140,0) ;if PROCESS FLAG=3,4,5 return null "RTN","BPSOSRX",141,0) Q "" "RTN","BPSOSRX",142,0) ; "RTN","BPSOSRX",143,0) ;the most current queue status as process flag "RTN","BPSOSRX",144,0) QUECUR(KEY1,KEY2,BPCOB) ; "RTN","BPSOSRX",145,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,3)) Q 3 "RTN","BPSOSRX",146,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,2)) Q 2 "RTN","BPSOSRX",147,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,1)) Q 1 "RTN","BPSOSRX",148,0) I $D(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,0)) Q 0 "RTN","BPSOSRX",149,0) ;if PROCESS FLAG=3,4,5 return null "RTN","BPSOSRX",150,0) Q "" "RTN","BPSOSRX",151,0) ; "RTN","BPSOSRX",152,0) ;the most current queue status as process flag "RTN","BPSOSRX",153,0) QUETIME(KEY1,KEY2,BPCOB,BPROCFL) ; "RTN","BPSOSRX",154,0) N BP77 "RTN","BPSOSRX",155,0) S BP77=$O(^BPS(9002313.77,"D",KEY1,KEY2,BPCOB,BPROCFL,0)) "RTN","BPSOSRX",156,0) I BP77>0 Q $P($G(^BPS(9002313.77,+BP77,6)),U,1) ;REQUEST DATE AND TIME "RTN","BPSOSRX",157,0) Q "" "RTN","BPSOSRX",158,0) ; "RTN","BPSOSRX",159,0) NOW() N %,%H,%I,X D NOW^%DTC Q % "RTN","BPSOSRX",160,0) ; "RTN","BPSOSRX",161,0) ; RESTXT59 - Return first semi-colon piece of the Result Text (202) field "RTN","BPSOSRX",162,0) ; from BPS Transaction "RTN","BPSOSRX",163,0) RESTXT59(IEN59) ; "RTN","BPSOSRX",164,0) I '$G(IEN59) Q "" "RTN","BPSOSRX",165,0) Q $P($P($G(^BPST(IEN59,2)),U,2,99),";",1) "RTN","BPSOSRX",166,0) ; "RTN","BPSOSRX",167,0) ; LASTUP59 - Return last update date/time from BPS Transactions "RTN","BPSOSRX",168,0) LASTUP59(IEN59) ; "RTN","BPSOSRX",169,0) I '$G(IEN59) Q "" "RTN","BPSOSRX",170,0) Q $P($G(^BPST(IEN59,0)),U,8) "RTN","BPSOSRX",171,0) ; "RTN","BPSOSRX",172,0) ; STATUS59 returns STATUS field from BPS Transaction "RTN","BPSOSRX",173,0) ; Note: 99 means complete "RTN","BPSOSRX",174,0) STATUS59(IEN59) ; "RTN","BPSOSRX",175,0) I '$G(IEN59) Q "" "RTN","BPSOSRX",176,0) Q $P($G(^BPST(IEN59,0)),U,2) "RTN","BPSOSRX",177,0) ; "RTN","BPSOSRX",178,0) ; SUBMIT59 - Return Submit date/time from BPS Transactions (#6) SUBMIT DATE/TIME "RTN","BPSOSRX",179,0) SUBMIT59(IEN59) ; "RTN","BPSOSRX",180,0) I '$G(IEN59) Q "" "RTN","BPSOSRX",181,0) Q $P($G(^BPST(IEN59,0)),U,7) "RTN","BPSOSRX",182,0) ; "RTN","BPSOSRX",183,0) ; Utilities "RTN","BPSOSRX",184,0) ; "RTN","BPSOSRX",185,0) ; LOCKING: Just one user of this routine at a time. "RTN","BPSOSRX",186,0) ; X = "SUBMIT" to interlock the request submission "RTN","BPSOSRX",187,0) ; X = "BACKGROUND" to interlock the background job "RTN","BPSOSRX",188,0) LOCK(X,TIMEOUT) ;EP - BPSOSRB "RTN","BPSOSRX",189,0) I $G(TIMEOUT)="" S TIMEOUT=0 "RTN","BPSOSRX",190,0) L +^XTMP("BPS-PROC",X):TIMEOUT "RTN","BPSOSRX",191,0) Q $T "RTN","BPSOSRX",192,0) ; "RTN","BPSOSRX",193,0) LOCKNOW(X) ;EP - BPSOSRB "RTN","BPSOSRX",194,0) L +^XTMP("BPS-PROC",X):0 "RTN","BPSOSRX",195,0) Q $T "RTN","BPSOSRX",196,0) ; "RTN","BPSOSRX",197,0) UNLOCK(X) ;EP - BPSOSRB "RTN","BPSOSRX",198,0) L -^XTMP("BPS-PROC",X) "RTN","BPSOSRX",199,0) Q "RTN","BPSOSRX",200,0) ; "RTN","BPSOSRX",201,0) RUNNING() ; "RTN","BPSOSRX",202,0) I '$$LOCKNOW("BACKGROUND") Q ; it is running; don't start another "RTN","BPSOSRX",203,0) D UNLOCK("BACKGROUND") ; it's not running; release our probing lock "RTN","BPSOSRX",204,0) D TASK "RTN","BPSOSRX",205,0) Q "RTN","BPSOSRX",206,0) ; "RTN","BPSOSRX",207,0) ;KEY1 - Either Prescription IEN (#52) or PATIENT IEN (#2) "RTN","BPSOSRX",208,0) ;KEY2 - Either Fill # or Policy Number "RTN","BPSOSRX",209,0) ; For Policy Number, the value passed in should be 9000 plus "RTN","BPSOSRX",210,0) ; the policy number "RTN","BPSOSRX",211,0) ;BPCOBIND - COB indicator "RTN","BPSOSRX",212,0) IEN59(KEY1,KEY2,BPCOBIND) ;EP - from BPSOS, BPSOSRB "RTN","BPSOSRX",213,0) I '$G(KEY1) Q "" "RTN","BPSOSRX",214,0) I '$G(KEY2) S KEY2=0 ;If no KEY2, assume RX/Fill and default to Original Fill "RTN","BPSOSRX",215,0) I +$G(BPCOBIND)=0 S BPCOBIND=1 ;default is primary "RTN","BPSOSRX",216,0) I BPCOBIND>3!(BPCOBIND<1) Q "" "RTN","BPSOSRX",217,0) Q KEY1_"."_$TR($J(KEY2,4)," ","0")_+BPCOBIND "RTN","BPSOSRX",218,0) ; "RTN","BPSOSRX",219,0) ; "RTN","BPSOSRX",220,0) ; The background job "RTN","BPSOSRX",221,0) TASK N X,Y,%DT "RTN","BPSOSRX",222,0) S X="N",%DT="ST" "RTN","BPSOSRX",223,0) D ^%DT,TASKAT(Y) "RTN","BPSOSRX",224,0) Q "RTN","BPSOSRX",225,0) ; "RTN","BPSOSRX",226,0) TASKAT(ZTDTH) ; "RTN","BPSOSRX",227,0) N ZTIO S ZTIO="" ; no device "RTN","BPSOSRX",228,0) N ZTRTN S ZTRTN="BACKGR^BPSOSRB" "RTN","BPSOSRX",229,0) D ^%ZTLOAD "RTN","BPSOSRX",230,0) Q "RTN","BPSOSRX",231,0) ; "RTN","BPSOSRX",232,0) ;Lock key pair - So two (or more) requests cannot be processed simultaneously "RTN","BPSOSRX",233,0) LOCKRF(KEY1,KEY2,BPTIMOUT,IEN59,BPSRC) ;EP - BPSOSRB "RTN","BPSOSRX",234,0) N BPRET "RTN","BPSOSRX",235,0) L +^XTMP("BPSOSRX-RX/REF",KEY1,KEY2):+$G(BPTIMOUT) "RTN","BPSOSRX",236,0) S BPRET=$T "RTN","BPSOSRX",237,0) Q BPRET "RTN","BPSOSRX",238,0) ; "RTN","BPSOSRX",239,0) ;UnLock key pair "RTN","BPSOSRX",240,0) UNLCKRF(KEY1,KEY2,IEN59,BPSRC) ;EP - BPSOSRB "RTN","BPSOSRX",241,0) L -^XTMP("BPSOSRX-RX/REF",KEY1,KEY2) "RTN","BPSOSRX",242,0) ;I $G(IEN59)>0 D LOG^BPSOSL(IEN59,$G(BPSRC)_"-Unlock keys: "_KEY1_"/"_KEY2) "RTN","BPSOSRX",243,0) Q "RTN","BPSOSRX",244,0) ;BPSOSRX "RTN","BPSOSRX2") 0^25^B31124186 "RTN","BPSOSRX2",1,0) BPSOSRX2 ;ALB/SS - ECME REQUESTS ;30-NOV-07 "RTN","BPSOSRX2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRX2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX2",4,0) ; "RTN","BPSOSRX2",5,0) ;Store insurer data in BPS INSURER DATA file "RTN","BPSOSRX2",6,0) ; KEY1 - First Key of the Request file "RTN","BPSOSRX2",7,0) ; KEY2 - Second Key of the Request file "RTN","BPSOSRX2",8,0) ; MOREDATA - Array of data needed for transaction/claim "RTN","BPSOSRX2",9,0) ; BPCOBIND - "active" COB indicator (the one is processed currently) COB "RTN","BPSOSRX2",10,0) ; BPIEN77 - BPS REQUEST ien (request for which the BPS INSURER DATA record is created) "RTN","BPSOSRX2",11,0) ; "RTN","BPSOSRX2",12,0) ; "RTN","BPSOSRX2",13,0) INSURER(KEY1,KEY2,MOREDATA,BPCOBIND) ; "RTN","BPSOSRX2",14,0) N BPIEN78,BPIEN59 "RTN","BPSOSRX2",15,0) ;IBDATA "RTN","BPSOSRX2",16,0) ;Create a new record with .01 field only "RTN","BPSOSRX2",17,0) S BPIEN59=$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND) "RTN","BPSOSRX2",18,0) S BPIEN78=+$$INSITEM^BPSUTIL2(9002313.78,"",BPIEN59,"","") ;BPS Transaction IEN "RTN","BPSOSRX2",19,0) I BPIEN78<1 Q "0^Cannot create a record in BPS INSURER DATA" "RTN","BPSOSRX2",20,0) ; "RTN","BPSOSRX2",21,0) ; Check for proper payer sheets "RTN","BPSOSRX2",22,0) I $G(MOREDATA("RX ACTION"))'="ELIG",$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,16)="" Q "0^Billing payer sheet is missing" "RTN","BPSOSRX2",23,0) I $G(MOREDATA("RX ACTION"))'="ELIG",$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,17)="" Q "0^Reversal payer sheet is missing" "RTN","BPSOSRX2",24,0) I $G(MOREDATA("RX ACTION"))="ELIG",$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,19)="" Q "0^Eligibility payer sheet is missing" "RTN","BPSOSRX2",25,0) ; "RTN","BPSOSRX2",26,0) ; Populate remaining fields "RTN","BPSOSRX2",27,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,16)) ; Billing Payer Sheet IEN "RTN","BPSOSRX2",28,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,17)) ; Reversal Payer Sheet IEN "RTN","BPSOSRX2",29,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,18)) ; Rebill Payer Sheet IEN "RTN","BPSOSRX2",30,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".07",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,14)) "RTN","BPSOSRX2",31,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".08",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,1)) "RTN","BPSOSRX2",32,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".09",BPIEN78,BPCOBIND) "RTN","BPSOSRX2",33,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".1",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,19)) ; Eligibility Payer Sheet IEN "RTN","BPSOSRX2",34,0) I $$FILLFLDS^BPSUTIL2(9002313.78,".11",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,7)) "RTN","BPSOSRX2",35,0) ; "RTN","BPSOSRX2",36,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,2)) "RTN","BPSOSRX2",37,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,3)) "RTN","BPSOSRX2",38,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,5)) "RTN","BPSOSRX2",39,0) I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,6)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"1.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,6)) "RTN","BPSOSRX2",40,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.05",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,7)) "RTN","BPSOSRX2",41,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.06",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,8)) "RTN","BPSOSRX2",42,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.07",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,9)) "RTN","BPSOSRX2",43,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"1.08",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,10)) "RTN","BPSOSRX2",44,0) ; "RTN","BPSOSRX2",45,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"2.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,1)) "RTN","BPSOSRX2",46,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"2.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,2)) "RTN","BPSOSRX2",47,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"2.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,3)) "RTN","BPSOSRX2",48,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"2.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,4)) "RTN","BPSOSRX2",49,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"2.05",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,2)),U,5)) "RTN","BPSOSRX2",50,0) I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,13)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"2.06",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,13)) "RTN","BPSOSRX2",51,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"2.07",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,8)) "RTN","BPSOSRX2",52,0) ; "RTN","BPSOSRX2",53,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"3.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,1)) "RTN","BPSOSRX2",54,0) I $P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,2)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"3.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,2)) "RTN","BPSOSRX2",55,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"3.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,3)) "RTN","BPSOSRX2",56,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"3.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,4)) "RTN","BPSOSRX2",57,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"3.05",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,5)) "RTN","BPSOSRX2",58,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"3.06",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,3)),U,6)) "RTN","BPSOSRX2",59,0) ; "RTN","BPSOSRX2",60,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"4.01",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,4)) ; Billing Payer Sheet Name "RTN","BPSOSRX2",61,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"4.02",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,11)) ; Reversal Payer Sheet Name "RTN","BPSOSRX2",62,0) I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,12)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"4.03",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,12)) ; Rebill Payer Sheet Name "RTN","BPSOSRX2",63,0) I $P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,15)'="" I $$FILLFLDS^BPSUTIL2(9002313.78,"4.04",BPIEN78,$P($G(MOREDATA("IBDATA",BPCOBIND,1)),U,15)) ; Eligibility Payer Sheet Name "RTN","BPSOSRX2",64,0) ; "RTN","BPSOSRX2",65,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"5.01",BPIEN78,+DUZ) "RTN","BPSOSRX2",66,0) I $$FILLFLDS^BPSUTIL2(9002313.78,"5.02",BPIEN78,DT) "RTN","BPSOSRX2",67,0) ; "RTN","BPSOSRX2",68,0) Q "1^"_BPIEN78 "RTN","BPSOSRX2",69,0) ; "RTN","BPSOSRX2",70,0) ERRFIELD(BP78,BPFIELD) ; "RTN","BPSOSRX2",71,0) N DIK,DA "RTN","BPSOSRX2",72,0) S DIK="^BPS(9002313.78," "RTN","BPSOSRX2",73,0) S DA=BP78 "RTN","BPSOSRX2",74,0) D ^DIK ;delete incomplete record "RTN","BPSOSRX2",75,0) ;return the error message "RTN","BPSOSRX2",76,0) Q $$FIELDMSG(0,"",9002313.78,$G(BPFIELD)) "RTN","BPSOSRX2",77,0) ; "RTN","BPSOSRX2",78,0) ;Store MOREDATA("IBDATA") in BPS INSURER DATA file "RTN","BPSOSRX2",79,0) ; KEY1 - First key of the BPS Request File "RTN","BPSOSRX2",80,0) ; KEY2 - Second Key of the BPS Request File "RTN","BPSOSRX2",81,0) ; MOREDATA - Array of data needed for transaction/claim "RTN","BPSOSRX2",82,0) ; BPINSUR(COB,IEN78) = array to return back BPS INSURERE DATA iens created "RTN","BPSOSRX2",83,0) ; return value: "RTN","BPSOSRX2",84,0) ; 1 = success "RTN","BPSOSRX2",85,0) ; 0^message = if one of the records wasn't created "RTN","BPSOSRX2",86,0) MKINSUR(KEY1,KEY2,MOREDATA,BPINSUR) ; "RTN","BPSOSRX2",87,0) N BPQ,BPCOB,BPERRMSG "RTN","BPSOSRX2",88,0) S BPERRMSG="" "RTN","BPSOSRX2",89,0) S BPQ=0,BPCOB=0 "RTN","BPSOSRX2",90,0) F S BPCOB=$O(MOREDATA("IBDATA",BPCOB)) Q:+BPCOB=0!(BPQ=1) D "RTN","BPSOSRX2",91,0) . S BPIEN78=$$INSURER(KEY1,KEY2,.MOREDATA,BPCOB) "RTN","BPSOSRX2",92,0) . I BPIEN78<1 S BPERRMSG="Missing data for the file #9002313.78, "_$P(BPIEN78,U,2),BPQ=1 Q "RTN","BPSOSRX2",93,0) . S BPINSUR(BPCOB)=+$P(BPIEN78,U,2) "RTN","BPSOSRX2",94,0) I BPQ=1 Q "0^"_BPERRMSG "RTN","BPSOSRX2",95,0) Q 1 "RTN","BPSOSRX2",96,0) ;add field name to the message "RTN","BPSOSRX2",97,0) ;BPRFILE - if 1 then add file # to the message "RTN","BPSOSRX2",98,0) ;BPMESS,BPFILENO,BPFLDNO - message text, file # and field # "RTN","BPSOSRX2",99,0) FIELDMSG(BPRFILE,BPMESS,BPFILENO,BPFLDNO) ; "RTN","BPSOSRX2",100,0) N BPFLDNM "RTN","BPSOSRX2",101,0) I ('$G(BPFILENO))!('$G(BPFLDNO)) Q $G(BPMESS) "RTN","BPSOSRX2",102,0) D FIELD^DID(BPFILENO,BPFLDNO,"","LABEL","BPFLDNM") "RTN","BPSOSRX2",103,0) Q $G(BPMESS)_$S($G(BPRFILE)=1:"file #"_BPFILENO_",",1:"")_"field #"_BPFLDNO_" ("_$G(BPFLDNM("LABEL"))_")" "RTN","BPSOSRX2",104,0) ;BPSOSRX2 "RTN","BPSOSRX3") 0^26^B117328424 "RTN","BPSOSRX3",1,0) BPSOSRX3 ;ALB/SS - ECME REQUESTS ;02-JAN-08 "RTN","BPSOSRX3",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRX3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX3",4,0) ; "RTN","BPSOSRX3",5,0) ;Input "RTN","BPSOSRX3",6,0) ;BPREQTYP - request type: "RTN","BPSOSRX3",7,0) ; "C" - Submit a claim to ECME "RTN","BPSOSRX3",8,0) ; If the claim has already been processed, and it's resubmitted, then a reversal will be "RTN","BPSOSRX3",9,0) ; done first, and then the resubmit. Intervening call to $$STATUS may show progress "RTN","BPSOSRX3",10,0) ; of the reversal before the resubmitted claim is processed. "RTN","BPSOSRX3",11,0) ; "U"- Reverse submitted claim. "RTN","BPSOSRX3",12,0) ; The reversal will actually be done ONLY if the most recent processing of the claim "RTN","BPSOSRX3",13,0) ; resulted in something reversible, namely E PAYABLE or E REVERSAL REJECTED "RTN","BPSOSRX3",14,0) ; "E" - Eligibility Verification Request "RTN","BPSOSRX3",15,0) ;KEY1 - First Key for the BPS Request file "RTN","BPSOSRX3",16,0) ;KEY2 - Second Key for the BPS Request file "RTN","BPSOSRX3",17,0) ;MOREDATA - Array of data for transaction/claim "RTN","BPSOSRX3",18,0) ;BPCOBIND - payer sequence "RTN","BPSOSRX3",19,0) ;BILLNDC - NDC passed into EN^BPSNCPDP sent in BILLNDC variable or determined by EN^BPSNCPDP if it was null "RTN","BPSOSRX3",20,0) ;at the very first time when EN^BPSNCPDP was called in "F" (foreground) mode "RTN","BPSOSRX3",21,0) ;BPSKIP(optional)=1 : skip the field, used when CLAIM request is created while the previous "RTN","BPSOSRX3",22,0) ;request is in progress. That means - billing determination will be done upon activation) "RTN","BPSOSRX3",23,0) ;Return values: "RTN","BPSOSRX3",24,0) ; 1^BPS REQUEST ien = accepted for processing "RTN","BPSOSRX3",25,0) ; 0^reason = failure (should never happen) "RTN","BPSOSRX3",26,0) MKRQST(BPREQTYP,KEY1,KEY2,MOREDATA,BPIENS78,BPCOBIND,BILLNDC,BPSKIP) ; "RTN","BPSOSRX3",27,0) N BPIEN77,BPCOB,BPQ,BPIEN772,BPERRMSG,BPIEN59,BPIEN78,BPZ "RTN","BPSOSRX3",28,0) N RETVAL,STAT,TYPE,RESULT,SUBMITDT,BPNOW,BPACTTYP,BP77LCK "RTN","BPSOSRX3",29,0) N DUR,BPIEN771,BPCNT,BPSDUPL "RTN","BPSOSRX3",30,0) S BPSKIP=+$G(BPSKIP) "RTN","BPSOSRX3",31,0) I $G(BPREQTYP)="" Q "0^Parameter error-Request Type" "RTN","BPSOSRX3",32,0) I '$G(KEY1) Q "0^Parameter error-Key1" "RTN","BPSOSRX3",33,0) I BPREQTYP="E",$G(KEY2)'>9000 Q "0^Parameter error-Key2 for eligibility" "RTN","BPSOSRX3",34,0) I '$G(BPCOBIND)="" Q "0^Parameter error-COB Indicator" "RTN","BPSOSRX3",35,0) I '$G(KEY2) S KEY2=0 "RTN","BPSOSRX3",36,0) S BPIEN59=+$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND) "RTN","BPSOSRX3",37,0) ; "RTN","BPSOSRX3",38,0) ;new record "RTN","BPSOSRX3",39,0) S BPERRMSG="Cannot create record in BPS REQUEST" "RTN","BPSOSRX3",40,0) S BPIEN77=$$INSITEM^BPSUTIL2(9002313.77,"",KEY1,"","","^BPS(9002313.77)",10) "RTN","BPSOSRX3",41,0) I BPIEN77<1 Q "0^"_BPERRMSG "RTN","BPSOSRX3",42,0) S BPNOW=$$NOW^BPSOSRX() "RTN","BPSOSRX3",43,0) S BPACTTYP=$G(MOREDATA("RX ACTION")) "RTN","BPSOSRX3",44,0) ; fill out the fields "RTN","BPSOSRX3",45,0) S BPERRMSG="Missing data for the " "RTN","BPSOSRX3",46,0) I $$FILLFLDS^BPSUTIL2(9002313.77,".02",BPIEN77,KEY2)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.02) "RTN","BPSOSRX3",47,0) I $$FILLFLDS^BPSUTIL2(9002313.77,".03",BPIEN77,BPCOBIND)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.03) "RTN","BPSOSRX3",48,0) ;set delay with the testing tool "RTN","BPSOSRX3",49,0) S BPZ=+$$SETDELAY^BPSTEST(BPIEN59) I BPZ>0 I $$FILLFLDS^BPSUTIL2(9002313.77,".08",BPIEN77,BPZ)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.08) "RTN","BPSOSRX3",50,0) ;set the process flag to "WAITING" "RTN","BPSOSRX3",51,0) I $$FILLFLDS^BPSUTIL2(9002313.77,".04",BPIEN77,0)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.04) "RTN","BPSOSRX3",52,0) I $$FILLFLDS^BPSUTIL2(9002313.77,"6.01",BPIEN77,BPNOW)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.01) "RTN","BPSOSRX3",53,0) I $$FILLFLDS^BPSUTIL2(9002313.77,"6.05",BPIEN77,BPNOW)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.05) "RTN","BPSOSRX3",54,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"6.02") I $$FILLFLDS^BPSUTIL2(9002313.77,"6.02",BPIEN77,+$G(MOREDATA("USER")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.02) "RTN","BPSOSRX3",55,0) I $$FILLFLDS^BPSUTIL2(9002313.77,"6.06",BPIEN77,+DUZ)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.06) "RTN","BPSOSRX3",56,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.01") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.01",BPIEN77,$G(MOREDATA("RX ACTION")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.01) "RTN","BPSOSRX3",57,0) I $G(MOREDATA("DIVISION")),$$FILLFLDS^BPSUTIL2(9002313.77,"1.02",BPIEN77,MOREDATA("DIVISION"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.02) "RTN","BPSOSRX3",58,0) I $$FILLFLDS^BPSUTIL2(9002313.77,"1.04",BPIEN77,BPREQTYP)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.04) "RTN","BPSOSRX3",59,0) ;if this is a queued "C" request then the billing will be done again upon activation so MOREDATA(BILL) is undefined "RTN","BPSOSRX3",60,0) ;that is why we are not checking this field "RTN","BPSOSRX3",61,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.05") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.05",BPIEN77,$P($G(MOREDATA("BILL")),U))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.05) "RTN","BPSOSRX3",62,0) I '$D(MOREDATA("ELIG")) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.06") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.06",BPIEN77,$P($G(MOREDATA("BILL")),U,3))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.06) "RTN","BPSOSRX3",63,0) I $D(MOREDATA("ELIG")) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.06") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.06",BPIEN77,$G(MOREDATA("ELIG")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.06) "RTN","BPSOSRX3",64,0) I $P($G(MOREDATA("BILL")),U,2)'="" I $$ACTFIELD(BPSKIP,BPREQTYP,"1.07") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.07",BPIEN77,$P($G(MOREDATA("BILL")),U,2))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.07) "RTN","BPSOSRX3",65,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.13") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.13",BPIEN77,$G(MOREDATA("RX")))<1,BPREQTYP'="E" Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.13) "RTN","BPSOSRX3",66,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.14") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.14",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,4))<1,BPREQTYP'="E" Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.14) "RTN","BPSOSRX3",67,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.15") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.15",BPIEN77,$G(MOREDATA("PATIENT")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.15) "RTN","BPSOSRX3",68,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.16"),$$FILLFLDS^BPSUTIL2(9002313.77,"1.16",BPIEN77,$P($G(MOREDATA("IBDATA",1,3)),U,7))<1,BPREQTYP="E" Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.16) "RTN","BPSOSRX3",69,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"2.01") I $$FILLFLDS^BPSUTIL2(9002313.77,"2.01",BPIEN77,+$G(MOREDATA("DATE OF SERVICE")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.01) "RTN","BPSOSRX3",70,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"2.02") I $$FILLFLDS^BPSUTIL2(9002313.77,"2.02",BPIEN77,$G(MOREDATA("REVERSAL REASON")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.02) "RTN","BPSOSRX3",71,0) I $L($G(MOREDATA("BPOVRIEN")))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.04",BPIEN77,$G(MOREDATA("BPOVRIEN")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.04) "RTN","BPSOSRX3",72,0) I $L($G(MOREDATA("BPSCLARF")))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.05",BPIEN77,$G(MOREDATA("BPSCLARF")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.05) "RTN","BPSOSRX3",73,0) I $L($G(BILLNDC))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.06",BPIEN77,BILLNDC)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.06) "RTN","BPSOSRX3",74,0) I $L($P($G(MOREDATA("BPSAUTH")),U))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.07",BPIEN77,$E($P(MOREDATA("BPSAUTH"),U,1),1,2))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.07) "RTN","BPSOSRX3",75,0) I $L($P($G(MOREDATA("BPSAUTH")),U,2))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.08",BPIEN77,$E($P(MOREDATA("BPSAUTH"),U,2),1,11))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.08) "RTN","BPSOSRX3",76,0) I $L($G(MOREDATA("BPSDELAY")))>0,$$FILLFLDS^BPSUTIL2(9002313.77,"2.1",BPIEN77,MOREDATA("BPSDELAY"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.1) "RTN","BPSOSRX3",77,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"4.01") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.01",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,1)) "RTN","BPSOSRX3",78,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"4.02") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.02",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,2)) "RTN","BPSOSRX3",79,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"4.03") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.03",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,3)) "RTN","BPSOSRX3",80,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"4.04"),$$FILLFLDS^BPSUTIL2(9002313.77,"4.04",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,4)) "RTN","BPSOSRX3",81,0) I $P($G(MOREDATA("BPSDATA",1)),U,5)'="" I $$ACTFIELD(BPSKIP,BPREQTYP,"4.05") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.05",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,5)) "RTN","BPSOSRX3",82,0) I $P($G(MOREDATA("BPSDATA",1)),U,6)'="" I $$ACTFIELD(BPSKIP,BPREQTYP,"4.06") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.06",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,6)) "RTN","BPSOSRX3",83,0) I $$ACTFIELD(BPSKIP,BPREQTYP,"4.07") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.07",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,7)) "RTN","BPSOSRX3",84,0) I $G(MOREDATA("CLOSE AFT REV"))=1 I $$FILLFLDS^BPSUTIL2(9002313.77,"7.01",BPIEN77,1)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.01) "RTN","BPSOSRX3",85,0) I $G(MOREDATA("CLOSE AFT REV REASON"))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"7.02",BPIEN77,+$G(MOREDATA("CLOSE AFT REV REASON")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.02) "RTN","BPSOSRX3",86,0) I $L($G(MOREDATA("CLOSE AFT REV COMMENT")))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"7.03",BPIEN77,$G(MOREDATA("CLOSE AFT REV COMMENT")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.03) "RTN","BPSOSRX3",87,0) I $G(BPSARRY("SC/EI OVR"))=1 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.09",BPIEN77,1)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.09) "RTN","BPSOSRX3",88,0) ; "RTN","BPSOSRX3",89,0) ; secondary billing and primary Tricare billing related fields "RTN","BPSOSRX3",90,0) I $G(MOREDATA("RTYPE"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,"1.08",BPIEN77,MOREDATA("RTYPE"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.08) "RTN","BPSOSRX3",91,0) I $G(MOREDATA("PRIMARY BILL"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,"1.09",BPIEN77,MOREDATA("PRIMARY BILL"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.09) "RTN","BPSOSRX3",92,0) I $G(MOREDATA("PRIOR PAYMENT"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,"1.1",BPIEN77,MOREDATA("PRIOR PAYMENT"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.1) "RTN","BPSOSRX3",93,0) I $G(MOREDATA("337-4C"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,1.11,BPIEN77,MOREDATA("337-4C"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.11) ; cob other payments count "RTN","BPSOSRX3",94,0) I $G(MOREDATA("308-C8"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,1.12,BPIEN77,MOREDATA("308-C8"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.12) ; other coverage code "RTN","BPSOSRX3",95,0) ; "RTN","BPSOSRX3",96,0) ; store secondary billing related data entered by the user - esg 6/8/10 "RTN","BPSOSRX3",97,0) S BPQ=0,BPERRMSG="" "RTN","BPSOSRX3",98,0) I BPCOBIND=2 D "RTN","BPSOSRX3",99,0) . N AMTIEN,BPIEN1,BPIEN2,BPIEN778,BPZ,BPZ1,BPZ2,OPAMT,OPAPQ,OPAYD,OPREJ,PIEN,REJIEN "RTN","BPSOSRX3",100,0) . S PIEN=0 F S PIEN=$O(MOREDATA("OTHER PAYER",PIEN)) Q:'PIEN!BPQ D "RTN","BPSOSRX3",101,0) .. S OPAYD=$G(MOREDATA("OTHER PAYER",PIEN,0)) Q:OPAYD="" "RTN","BPSOSRX3",102,0) .. ; "RTN","BPSOSRX3",103,0) .. ; count up the number of multiples we have in each set "RTN","BPSOSRX3",104,0) .. S BPZ=0 F BPZ1=0:1 S BPZ=$O(MOREDATA("OTHER PAYER",PIEN,"P",BPZ)) Q:'BPZ "RTN","BPSOSRX3",105,0) .. S BPZ=0 F BPZ2=0:1 S BPZ=$O(MOREDATA("OTHER PAYER",PIEN,"R",BPZ)) Q:'BPZ "RTN","BPSOSRX3",106,0) .. I BPZ1,BPZ2 S BPQ=1,BPERRMSG="Can't have both payments and rejects for the same OTHER PAYER" Q "RTN","BPSOSRX3",107,0) .. ; "RTN","BPSOSRX3",108,0) .. ; add a new entry to subfile 9002313.778 "RTN","BPSOSRX3",109,0) .. S BPIEN778=$$INSITEM^BPSUTIL2(9002313.778,BPIEN77,PIEN,PIEN,"",,0) "RTN","BPSOSRX3",110,0) .. I BPIEN778<1 S BPERRMSG="Can't create entry in COB OTHER PAYERS multiple of the BPS REQUESTS file",BPQ=1 Q "RTN","BPSOSRX3",111,0) .. S BPERRMSG="Can't populate field in COB OTHER PAYERS multiple" ; just in case BPQ is set below "RTN","BPSOSRX3",112,0) .. ; "RTN","BPSOSRX3",113,0) .. ; set the rest of the pieces at this level "RTN","BPSOSRX3",114,0) .. I $P(OPAYD,U,2)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.02,PIEN_","_BPIEN77,$P(OPAYD,U,2))<1 S BPQ=1 Q "RTN","BPSOSRX3",115,0) .. I $P(OPAYD,U,3)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.03,PIEN_","_BPIEN77,$P(OPAYD,U,3))<1 S BPQ=1 Q "RTN","BPSOSRX3",116,0) .. I $P(OPAYD,U,4)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.04,PIEN_","_BPIEN77,$P(OPAYD,U,4))<1 S BPQ=1 Q "RTN","BPSOSRX3",117,0) .. I $P(OPAYD,U,5)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.05,PIEN_","_BPIEN77,$P(OPAYD,U,5))<1 S BPQ=1 Q "RTN","BPSOSRX3",118,0) .. I $$FILLFLDS^BPSUTIL2(9002313.778,.06,PIEN_","_BPIEN77,BPZ1)<1 S BPQ=1 Q "RTN","BPSOSRX3",119,0) .. I $$FILLFLDS^BPSUTIL2(9002313.778,.07,PIEN_","_BPIEN77,BPZ2)<1 S BPQ=1 Q "RTN","BPSOSRX3",120,0) .. S BPERRMSG="" "RTN","BPSOSRX3",121,0) .. ; "RTN","BPSOSRX3",122,0) .. ; now loop thru the other payer payment array "RTN","BPSOSRX3",123,0) .. S AMTIEN=0 F S AMTIEN=$O(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN)) Q:'AMTIEN!BPQ D "RTN","BPSOSRX3",124,0) ... S OPAMT=$G(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN,0)) "RTN","BPSOSRX3",125,0) ... S OPAPQ=$P(OPAMT,U,2) ; 342-HC other payer amt paid qualifier (ncpdp 5.1 blank is OK) "RTN","BPSOSRX3",126,0) ... S OPAMT=+OPAMT ; 431-DV other payer amt paid "RTN","BPSOSRX3",127,0) ... ; "RTN","BPSOSRX3",128,0) ... ; add a new entry to subfile 9002313.7781 "RTN","BPSOSRX3",129,0) ... S BPIEN1=$$INSITEM^BPSUTIL2(9002313.7781,PIEN_","_BPIEN77,OPAMT,AMTIEN,"",,0) "RTN","BPSOSRX3",130,0) ... I BPIEN1<1 S BPERRMSG="Can't create entry in 9002313.7781 subfile",BPQ=1 Q "RTN","BPSOSRX3",131,0) ... ; "RTN","BPSOSRX3",132,0) ... ; set piece 2 "RTN","BPSOSRX3",133,0) ... I OPAPQ'="" I $$FILLFLDS^BPSUTIL2(9002313.7781,.02,AMTIEN_","_PIEN_","_BPIEN77,OPAPQ)<1 D "RTN","BPSOSRX3",134,0) .... S BPQ=1,BPERRMSG="Can't populate .02 field in 9002313.7781 subfile" "RTN","BPSOSRX3",135,0) .... Q "RTN","BPSOSRX3",136,0) ... Q "RTN","BPSOSRX3",137,0) .. ; "RTN","BPSOSRX3",138,0) .. ; now loop thru the other payer reject array "RTN","BPSOSRX3",139,0) .. S REJIEN=0 F S REJIEN=$O(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN)) Q:'REJIEN!BPQ D "RTN","BPSOSRX3",140,0) ... S OPREJ=$G(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN,0)) Q:OPREJ="" Q:$P(OPREJ,U,1)="" "RTN","BPSOSRX3",141,0) ... ; "RTN","BPSOSRX3",142,0) ... ; add a new entry to subfile 9002313.7782 "RTN","BPSOSRX3",143,0) ... S BPIEN2=$$INSITEM^BPSUTIL2(9002313.7782,PIEN_","_BPIEN77,$P(OPREJ,U,1),REJIEN,"",,0) "RTN","BPSOSRX3",144,0) ... I BPIEN2<1 S BPERRMSG="Can't create entry in 9002313.7782 subfile",BPQ=1 Q "RTN","BPSOSRX3",145,0) ... Q "RTN","BPSOSRX3",146,0) .. Q "RTN","BPSOSRX3",147,0) . Q "RTN","BPSOSRX3",148,0) I BPQ Q "0^"_BPERRMSG_" (COB DATA)" "RTN","BPSOSRX3",149,0) ; "RTN","BPSOSRX3",150,0) ;store DURREC info "RTN","BPSOSRX3",151,0) S BPQ=0 "RTN","BPSOSRX3",152,0) S DUR=0 "RTN","BPSOSRX3",153,0) F S DUR=$O(MOREDATA("DUR",DUR)) Q:+DUR=0!(BPQ=1) D "RTN","BPSOSRX3",154,0) . S BPIEN771=$$INSITEM^BPSUTIL2(9002313.771,BPIEN77,$P(MOREDATA("DUR",DUR,0),U),DUR,"",,0) "RTN","BPSOSRX3",155,0) . I BPIEN771<1 S BPERRMSG="Cannot create DUR record in DUR multiple of the BPS REQUEST file",BPQ=1 Q "RTN","BPSOSRX3",156,0) . S BPERRMSG="Cannot populate a field in DUR multiple" "RTN","BPSOSRX3",157,0) . I $$FILLFLDS^BPSUTIL2(9002313.771,".02",DUR_","_BPIEN77,$P(MOREDATA("DUR",DUR,0),U,2))<1 S BPQ=1 Q "RTN","BPSOSRX3",158,0) . I $$FILLFLDS^BPSUTIL2(9002313.771,".03",DUR_","_BPIEN77,$P(MOREDATA("DUR",DUR,0),U,3))<1 S BPQ=1 Q "RTN","BPSOSRX3",159,0) I BPQ=1 Q "0^"_BPERRMSG_" DUR DATA" "RTN","BPSOSRX3",160,0) ; "RTN","BPSOSRX3",161,0) ;store ins to IB INSURER DATA "RTN","BPSOSRX3",162,0) S BPQ=0 "RTN","BPSOSRX3",163,0) S BPCOB=0 F S BPCOB=$O(BPIENS78(BPCOB)) Q:+BPCOB=0!(BPQ=1) D "RTN","BPSOSRX3",164,0) . S BPIEN772=$$INSITEM^BPSUTIL2(9002313.772,BPIEN77,BPCOB,BPCOB,"",,0) "RTN","BPSOSRX3",165,0) . I BPIEN772<1 S BPERRMSG="Cannot create record in IBDATA multiple of the BPS REQUEST file",BPQ=1 Q "RTN","BPSOSRX3",166,0) . S BPERRMSG="Cannot populate a field in IBDATA multiple" "RTN","BPSOSRX3",167,0) . I $$FILLFLDS^BPSUTIL2(9002313.772,".02",BPCOB_","_BPIEN77,$S(BPCOBIND=BPCOB:1,1:0))<1 S BPQ=1 Q "RTN","BPSOSRX3",168,0) . I $$FILLFLDS^BPSUTIL2(9002313.772,".03",BPCOB_","_BPIEN77,BPIENS78(BPCOB))<1 S BPQ=1 Q "RTN","BPSOSRX3",169,0) I BPQ=1 Q "0^"_BPERRMSG_"INSURER DATA" "RTN","BPSOSRX3",170,0) ; "RTN","BPSOSRX3",171,0) ;return 1 (success) and IEN of the 9002313.77 entry "RTN","BPSOSRX3",172,0) Q "1^"_BPIEN77 "RTN","BPSOSRX3",173,0) ; "RTN","BPSOSRX3",174,0) ;check if the field is used in MOREDATA for the specified REQUEST TYPE - CLAIM="C" /UNCLAIM="U" "RTN","BPSOSRX3",175,0) ACTFIELD(BPSKIP,BPREQTYP,BPFLD) ; "RTN","BPSOSRX3",176,0) ;For Reversal or Skip, only do RX Action, Date of Service, Reversal Reason, and User who made the Request "RTN","BPSOSRX3",177,0) I (BPREQTYP="U")!(BPSKIP=1) Q ";1.01;2.01;2.02;6.02;"[(";"_BPFLD_";") "RTN","BPSOSRX3",178,0) ;For Eligibility Verification, skip Eligibility "RTN","BPSOSRX3",179,0) I BPREQTYP="E",";1.06;"[(";"_BPFLD_";") Q 0 "RTN","BPSOSRX3",180,0) Q 1 ;if "ERES","OF","RF" "RTN","BPSOSRX3",181,0) ; "RTN","BPSOSRX3",182,0) ;Lock BPS REQUEST "RTN","BPSOSRX3",183,0) LOCK77(BPTIMOUT,IEN59,BPSRC) ; "RTN","BPSOSRX3",184,0) N BPRET "RTN","BPSOSRX3",185,0) L +^BPS(9002313.77):+$G(BPTIMOUT) "RTN","BPSOSRX3",186,0) S BPRET=$T "RTN","BPSOSRX3",187,0) I $G(IEN59)>0 D LOG^BPSOSL(IEN59,$G(BPSRC)_$S(BPRET=1:"-Lock",1:"-Failed to Lock")_" BPS REQUEST file") "RTN","BPSOSRX3",188,0) Q BPRET "RTN","BPSOSRX3",189,0) ; "RTN","BPSOSRX3",190,0) ;UnLock BPS REQUEST "RTN","BPSOSRX3",191,0) UNLOCK77(IEN59,BPSRC) ; "RTN","BPSOSRX3",192,0) L -^BPS(9002313.77) "RTN","BPSOSRX3",193,0) I $G(IEN59)>0 D LOG^BPSOSL(IEN59,$G(BPSRC)_"-Unlock BPS REQUEST file") "RTN","BPSOSRX3",194,0) Q "RTN","BPSOSRX3",195,0) ; "RTN","BPSOSRX3",196,0) ;BP77 - ien of BPS REQUEST "RTN","BPSOSRX3",197,0) ERRFIELD(BP77,BPRFILE,BPMESS,BPFILENO,BPFLDNO) ; "RTN","BPSOSRX3",198,0) I $G(BP77)>0 D DELREQST^BPSOSRX4(BP77) ;delete incomplete record "RTN","BPSOSRX3",199,0) Q $$FIELDMSG^BPSOSRX2(BPRFILE,BPMESS,BPFILENO,BPFLDNO) "RTN","BPSOSRX3",200,0) ; "RTN","BPSOSRX3",201,0) ;BPSOSRX3 "RTN","BPSOSRX4") 0^27^B57083414 "RTN","BPSOSRX4",1,0) BPSOSRX4 ;ALB/SS - ECME REQUESTS ;04-JAN-08 "RTN","BPSOSRX4",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRX4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX4",4,0) ; "RTN","BPSOSRX4",5,0) Q "RTN","BPSOSRX4",6,0) ;restore MOREDATA from the file 9002313.77 "RTN","BPSOSRX4",7,0) READMORE(BPIEN77,MOREDATA) ; "RTN","BPSOSRX4",8,0) N BPIEN772,BPCOB,BPIEN78,BPACTTYP,BPDURCNT,BPPAYSEQ "RTN","BPSOSRX4",9,0) S MOREDATA("REQ IEN")=BPIEN77 "RTN","BPSOSRX4",10,0) S MOREDATA("REQ DTTM")=$P($G(^BPS(9002313.77,BPIEN77,6)),U,1) ;6.01 "RTN","BPSOSRX4",11,0) S MOREDATA("USER")=$P($G(^BPS(9002313.77,BPIEN77,6)),U,2) ;6.02 "RTN","BPSOSRX4",12,0) S BPPAYSEQ=$P($G(^BPS(9002313.77,BPIEN77,0)),U,3) "RTN","BPSOSRX4",13,0) S BPPAYSEQ=$S(BPPAYSEQ:BPPAYSEQ,1:1) "RTN","BPSOSRX4",14,0) S MOREDATA("PAYER SEQUENCE")=BPPAYSEQ "RTN","BPSOSRX4",15,0) S MOREDATA("RX ACTION")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,1) ;1.01 "RTN","BPSOSRX4",16,0) S BPACTTYP=MOREDATA("RX ACTION") "RTN","BPSOSRX4",17,0) S MOREDATA("DIVISION")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,2) ;1,02 "RTN","BPSOSRX4",18,0) S MOREDATA("REQ TYPE")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,4) ;1,04 "RTN","BPSOSRX4",19,0) S MOREDATA("ELIG")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1.06 "RTN","BPSOSRX4",20,0) S $P(MOREDATA("BILL"),U,1)=$P($G(^BPS(9002313.77,BPIEN77,1)),U,5) ;1,05 "RTN","BPSOSRX4",21,0) S $P(MOREDATA("BILL"),U,2)=$P($G(^BPS(9002313.77,BPIEN77,1)),U,7) ;1,07 "RTN","BPSOSRX4",22,0) S $P(MOREDATA("BILL"),U,3)=$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1,06 "RTN","BPSOSRX4",23,0) ;S MOREDATA("BILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,5)_U_$P($G(^BPS(9002313.77,BPIEN77,1)),U,7)_U_$P($G(^BPS(9002313.77,BPIEN77,1)),U,6) ;1,05^1.07^1.06 "RTN","BPSOSRX4",24,0) S MOREDATA("RX")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,13) "RTN","BPSOSRX4",25,0) S MOREDATA("FILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,14) "RTN","BPSOSRX4",26,0) S MOREDATA("PATIENT")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,15) "RTN","BPSOSRX4",27,0) S MOREDATA("POLICY")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,16) "RTN","BPSOSRX4",28,0) S MOREDATA("DATE OF SERVICE")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,1) ;2.01 "RTN","BPSOSRX4",29,0) S MOREDATA("REVERSAL REASON")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,2) ;2.02 "RTN","BPSOSRX4",30,0) S $P(MOREDATA("BPSDATA",1),U,1)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,1) ;4.01 "RTN","BPSOSRX4",31,0) S $P(MOREDATA("BPSDATA",1),U,2)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,2) ;4.02 "RTN","BPSOSRX4",32,0) S $P(MOREDATA("BPSDATA",1),U,3)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,3) ;4.03 "RTN","BPSOSRX4",33,0) S $P(MOREDATA("BPSDATA",1),U,4)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,4) ;4.04 "RTN","BPSOSRX4",34,0) S $P(MOREDATA("BPSDATA",1),U,5)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,5) ;4.05 "RTN","BPSOSRX4",35,0) S $P(MOREDATA("BPSDATA",1),U,6)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,6) ;4.06 "RTN","BPSOSRX4",36,0) S $P(MOREDATA("BPSDATA",1),U,7)=$P($G(^BPS(9002313.77,BPIEN77,4)),U,7) ;4.07 "RTN","BPSOSRX4",37,0) I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,4))>0 S MOREDATA("BPOVRIEN")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,4) ;override code (RED option) "RTN","BPSOSRX4",38,0) I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,5))>0 S MOREDATA("BPSCLARF")=$$GET1^DIQ(9002313.77,BPIEN77_",",2.05,"E") ; clarification code "RTN","BPSOSRX4",39,0) I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,7))>0 S $P(MOREDATA("BPSAUTH"),U,1)=$P($G(^BPS(9002313.77,BPIEN77,2)),U,7) ;preauth.code "RTN","BPSOSRX4",40,0) I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,8))>0 S $P(MOREDATA("BPSAUTH"),U,2)=$P($G(^BPS(9002313.77,BPIEN77,2)),U,8) ;preauth number "RTN","BPSOSRX4",41,0) I $L($P($G(^BPS(9002313.77,BPIEN77,2)),U,10))>0 S MOREDATA("BPSDELAY")=$P($G(^BPS(9002313.77,BPIEN77,2)),U,10) ;Delay Reason Code "RTN","BPSOSRX4",42,0) ;DUR override codes Reason for Service Code, Professional Service Code, Result of Service Code "RTN","BPSOSRX4",43,0) ; "RTN","BPSOSRX4",44,0) S MOREDATA("RTYPE")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,8) "RTN","BPSOSRX4",45,0) I BPPAYSEQ=2 D "RTN","BPSOSRX4",46,0) . S MOREDATA("PRIMARY BILL")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,9) "RTN","BPSOSRX4",47,0) . S MOREDATA("PRIOR PAYMENT")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,10) "RTN","BPSOSRX4",48,0) . S MOREDATA("337-4C")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,11) ;1.11 cob other payments count "RTN","BPSOSRX4",49,0) . S MOREDATA("308-C8")=$P($G(^BPS(9002313.77,BPIEN77,1)),U,12) ;1.12 other coverage code "RTN","BPSOSRX4",50,0) . ; "RTN","BPSOSRX4",51,0) . ; build COB data array - esg - 6/10/10 "RTN","BPSOSRX4",52,0) . N COBPIEN,APDIEN,REJIEN "RTN","BPSOSRX4",53,0) . K MOREDATA("OTHER PAYER") "RTN","BPSOSRX4",54,0) . S COBPIEN=0 F S COBPIEN=$O(^BPS(9002313.77,BPIEN77,8,COBPIEN)) Q:'COBPIEN D "RTN","BPSOSRX4",55,0) .. S MOREDATA("OTHER PAYER",COBPIEN,0)=$G(^BPS(9002313.77,BPIEN77,8,COBPIEN,0)) "RTN","BPSOSRX4",56,0) .. ; "RTN","BPSOSRX4",57,0) .. ; retrieve data from other payer amount paid multiple "RTN","BPSOSRX4",58,0) .. S APDIEN=0 F S APDIEN=$O(^BPS(9002313.77,BPIEN77,8,COBPIEN,1,APDIEN)) Q:'APDIEN D "RTN","BPSOSRX4",59,0) ... S MOREDATA("OTHER PAYER",COBPIEN,"P",APDIEN,0)=$G(^BPS(9002313.77,BPIEN77,8,COBPIEN,1,APDIEN,0)) "RTN","BPSOSRX4",60,0) ... Q "RTN","BPSOSRX4",61,0) .. ; "RTN","BPSOSRX4",62,0) .. ; retrieve data from other payer reject multiple "RTN","BPSOSRX4",63,0) .. S REJIEN=0 F S REJIEN=$O(^BPS(9002313.77,BPIEN77,8,COBPIEN,2,REJIEN)) Q:'REJIEN D "RTN","BPSOSRX4",64,0) ... S MOREDATA("OTHER PAYER",COBPIEN,"R",REJIEN,0)=$G(^BPS(9002313.77,BPIEN77,8,COBPIEN,2,REJIEN,0)) "RTN","BPSOSRX4",65,0) ... Q "RTN","BPSOSRX4",66,0) .. Q "RTN","BPSOSRX4",67,0) . Q "RTN","BPSOSRX4",68,0) ; "RTN","BPSOSRX4",69,0) S BPDURCNT=0 F S BPDURCNT=$O(^BPS(9002313.77,BPIEN77,3,BPDURCNT)) Q:+BPDURCNT=0 D "RTN","BPSOSRX4",70,0) . S MOREDATA("DUR",BPDURCNT,0)=$G(^BPS(9002313.77,BPIEN77,3,BPDURCNT,0)) "RTN","BPSOSRX4",71,0) ; "RTN","BPSOSRX4",72,0) S BPIEN772=0 F S BPIEN772=$O(^BPS(9002313.77,BPIEN77,5,BPIEN772)) Q:+BPIEN772=0 D "RTN","BPSOSRX4",73,0) . S BPCOB=+$G(^BPS(9002313.77,BPIEN77,5,BPIEN772,0)) ;.01 "RTN","BPSOSRX4",74,0) . S BPIEN78=+$P($G(^BPS(9002313.77,BPIEN77,5,BPIEN772,0)),U,3) ;.03 "RTN","BPSOSRX4",75,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,1)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,8) ;.08 "RTN","BPSOSRX4",76,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,2)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,1) ;1.01 "RTN","BPSOSRX4",77,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,3)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,2) ;1.02 "RTN","BPSOSRX4",78,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,4)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,1) ;4.01-billing payer sheet name "RTN","BPSOSRX4",79,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,5)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,3) ;1.03 "RTN","BPSOSRX4",80,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,6)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,4) ;1.04 "RTN","BPSOSRX4",81,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,7)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,5) ;1.05 "RTN","BPSOSRX4",82,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,8)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,6) ;1.06 "RTN","BPSOSRX4",83,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,9)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,7) ;1.07 "RTN","BPSOSRX4",84,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,10)=$P($G(^BPS(9002313.78,BPIEN78,1)),U,8) ;1.08 "RTN","BPSOSRX4",85,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,11)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,2) ;4.02-reversal payer sheet name "RTN","BPSOSRX4",86,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,12)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,3) ;4.03-rebill payer sheet name "RTN","BPSOSRX4",87,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,13)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,6) ;2.06 "RTN","BPSOSRX4",88,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,14)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,7) ;.07 "RTN","BPSOSRX4",89,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,15)=$P($G(^BPS(9002313.78,BPIEN78,4)),U,4) ;4.04-eligibility payer sheet name "RTN","BPSOSRX4",90,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,16)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,2) ;.02-billing payer sheet IEN "RTN","BPSOSRX4",91,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,17)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,3) ;.03-reversal payer sheet IEN "RTN","BPSOSRX4",92,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,18)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,4) ;.04-rebill payer sheet IEN "RTN","BPSOSRX4",93,0) . S $P(MOREDATA("IBDATA",BPCOB,1),U,19)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,10) ;.1-eligibility payer sheet IEN "RTN","BPSOSRX4",94,0) . S $P(MOREDATA("IBDATA",BPCOB,2),U,1)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,1) ;2.01 "RTN","BPSOSRX4",95,0) . S $P(MOREDATA("IBDATA",BPCOB,2),U,2)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,2) ;2.02 "RTN","BPSOSRX4",96,0) . S $P(MOREDATA("IBDATA",BPCOB,2),U,3)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,3) ;2.03 "RTN","BPSOSRX4",97,0) . S $P(MOREDATA("IBDATA",BPCOB,2),U,4)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,4) ;2.04 "RTN","BPSOSRX4",98,0) . S $P(MOREDATA("IBDATA",BPCOB,2),U,5)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,5) ;2.05 "RTN","BPSOSRX4",99,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,1)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,1) ;3.01 "RTN","BPSOSRX4",100,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,2)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,2) ;3.02 "RTN","BPSOSRX4",101,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,3)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,3) ;3.03 "RTN","BPSOSRX4",102,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,4)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,4) ;3.04-eligibility "RTN","BPSOSRX4",103,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,5)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,5) ;3.05-insurance ien "RTN","BPSOSRX4",104,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,6)=$P($G(^BPS(9002313.78,BPIEN78,3)),U,6) ;3.06-COB "RTN","BPSOSRX4",105,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,7)=$P($G(^BPS(9002313.78,BPIEN78,0)),U,11) ;.11 "RTN","BPSOSRX4",106,0) . S $P(MOREDATA("IBDATA",BPCOB,3),U,8)=$P($G(^BPS(9002313.78,BPIEN78,2)),U,7) ;2.07 "RTN","BPSOSRX4",107,0) Q "RTN","BPSOSRX4",108,0) ; "RTN","BPSOSRX4",109,0) ;change Process flag to "COMPLETED" "RTN","BPSOSRX4",110,0) COMPLETD(BPIEN77) ; "RTN","BPSOSRX4",111,0) Q $$CHNGPRFL^BPSOSRX6(BPIEN77,3) "RTN","BPSOSRX4",112,0) ; "RTN","BPSOSRX4",113,0) ;inactivate BPS REQUEST "RTN","BPSOSRX4",114,0) INACTIVE(BPIEN77,ERROR) ; "RTN","BPSOSRX4",115,0) I '$$CHNGPRFL^BPSOSRX6(BPIEN77,5) Q 0 "RTN","BPSOSRX4",116,0) I $G(ERROR)]"",$$FILLFLDS^BPSUTIL2(9002313.77,"9.01",BPIEN77,ERROR)<1 Q "0^Cannot update field #9.01 (INACTIVATION REASON) in BPS REQUEST" "RTN","BPSOSRX4",117,0) Q 1 "RTN","BPSOSRX4",118,0) ;activate the request - change Process flag to "ACTIVATED" "RTN","BPSOSRX4",119,0) ACTIVATE(BPIEN77) ; "RTN","BPSOSRX4",120,0) ;do we need to check what was the status of previous one - if it was rejected then we shouldn't activate it? "RTN","BPSOSRX4",121,0) Q $$CHNGPRFL^BPSOSRX6(BPIEN77,1) "RTN","BPSOSRX4",122,0) ; "RTN","BPSOSRX4",123,0) ;change Process flag to "IN PROCESS" "RTN","BPSOSRX4",124,0) INPROCES(BPIEN77) ; "RTN","BPSOSRX4",125,0) Q $$CHNGPRFL^BPSOSRX6(BPIEN77,2) "RTN","BPSOSRX4",126,0) ; "RTN","BPSOSRX4",127,0) ;delete BPS REQUEST record "RTN","BPSOSRX4",128,0) DELREQST(BPIEN77,IEN59) ; "RTN","BPSOSRX4",129,0) N BPCOB "RTN","BPSOSRX4",130,0) N DIK,DA "RTN","BPSOSRX4",131,0) I $$INACTIVE(BPIEN77,"DELREQST was called") "RTN","BPSOSRX4",132,0) ;Q "RTN","BPSOSRX4",133,0) S BPCOB=0 "RTN","BPSOSRX4",134,0) F S BPCOB=$O(^BPS(9002313.77,BPIEN77,5,BPCOB)) Q:+BPCOB=0 D "RTN","BPSOSRX4",135,0) . S DIK="^BPS(9002313.78," "RTN","BPSOSRX4",136,0) . S DA=+$P($G(^BPS(9002313.77,BPIEN77,5,BPCOB,0)),U,3) "RTN","BPSOSRX4",137,0) . D ^DIK "RTN","BPSOSRX4",138,0) ; "RTN","BPSOSRX4",139,0) S DIK="^BPS(9002313.77," "RTN","BPSOSRX4",140,0) S DA=BPIEN77 "RTN","BPSOSRX4",141,0) D ^DIK "RTN","BPSOSRX4",142,0) ; "RTN","BPSOSRX4",143,0) I $G(IEN59) D LOG^BPSOSL(IEN59,$T(+0)_"-Request "_BPIEN77_" and associated BPS INSURER DATA records were deleted") "RTN","BPSOSRX4",144,0) Q "RTN","BPSOSRX4",145,0) ; "RTN","BPSOSRX4",146,0) ;update fields in BPS REQUEST with BPS TRANSACTION data "RTN","BPSOSRX4",147,0) UPD7759(BP77,IEN59) ; "RTN","BPSOSRX4",148,0) N BPZ "RTN","BPSOSRX4",149,0) I +$G(BP77)=0!(+$G(IEN59)=0) Q "RTN","BPSOSRX4",150,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Populating fields in BPS Request "_BP77) "RTN","BPSOSRX4",151,0) I $$FILLFLDS^BPSUTIL2(9002313.77,".06",BP77,IEN59)<1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.06) of (#9002313.77)") "RTN","BPSOSRX4",152,0) S BPZ=$$UPUSRTIM^BPSOSRX6(BP77,$S($G(DUZ):+DUZ,1:.5)) I +BPZ=0 D LOG^BPSOSL(IEN59,$T(+0)_$P(BPZ,U,2)) "RTN","BPSOSRX4",153,0) Q "RTN","BPSOSRX4",154,0) ; "RTN","BPSOSRX5") 0^28^B45774231 "RTN","BPSOSRX5",1,0) BPSOSRX5 ;ALB/SS - ECME REQUESTS ;10-JAN-08 "RTN","BPSOSRX5",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRX5",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX5",4,0) ; "RTN","BPSOSRX5",5,0) ; if Resubmit then check was the previous UNCLAIM accepted "RTN","BPSOSRX5",6,0) ; (Cannot resubmit reversed claims unless they are accepted) "RTN","BPSOSRX5",7,0) ; "RTN","BPSOSRX5",8,0) TODAY() ; "RTN","BPSOSRX5",9,0) N % "RTN","BPSOSRX5",10,0) D NOW^%DTC "RTN","BPSOSRX5",11,0) Q $P(%,".",1) "RTN","BPSOSRX5",12,0) ; "RTN","BPSOSRX5",13,0) ;check if according the last response the payer IS going to PAY "RTN","BPSOSRX5",14,0) ;(Note: reversals can be done only on previously payable claims, if reversal failed then the claim stays PAYABLE) "RTN","BPSOSRX5",15,0) PAYABLE(BPRESP) ; "RTN","BPSOSRX5",16,0) Q ",E PAYABLE,E DUPLICATE,E REVERSAL REJECTED,E REVERSAL OTHER,E REVERSAL UNSTRANDED,"[(","_BPRESP_",") "RTN","BPSOSRX5",17,0) ; "RTN","BPSOSRX5",18,0) ;Action type "RTN","BPSOSRX5",19,0) ACTTYPE(BWHR) ; "RTN","BPSOSRX5",20,0) Q:",AREV,CRLR,CRLX,DC,DDED,DE,EREV,HLD,RS,"[(","_BWHR_",") "U" ;UNCLAIM (reversal) "RTN","BPSOSRX5",21,0) Q:",CRLB,ED,ERES,RL,RRL,"[(","_BWHR_",") "UC" ;UNCLAIM (reversal) + CLAIM (resubmit) "RTN","BPSOSRX5",22,0) Q:",ARES,BB,OF,PC,PE,PL,PP,RF,RN,"[(","_BWHR_",") "C" ;CLAIM (the very first submit OR resubmit only) "RTN","BPSOSRX5",23,0) Q:BWHR="ELIG" "E" "RTN","BPSOSRX5",24,0) Q "" ;unknown "RTN","BPSOSRX5",25,0) ; "RTN","BPSOSRX5",26,0) ;Check ECME availability at the site "RTN","BPSOSRX5",27,0) ;return : "RTN","BPSOSRX5",28,0) ; 1^CLMSTAT -off "RTN","BPSOSRX5",29,0) ; null -on "RTN","BPSOSRX5",30,0) ECMESITE(SITE) ; "RTN","BPSOSRX5",31,0) I '$G(SITE) Q "1^No Site Information" "RTN","BPSOSRX5",32,0) I '$$ECMEON^BPSUTIL(SITE) Q "1^ECME switch is not on for the site" "RTN","BPSOSRX5",33,0) Q "" "RTN","BPSOSRX5",34,0) ; "RTN","BPSOSRX5",35,0) ; This is called by STATUS99^BPSOSU when the status of the current claim becomes 99%. "RTN","BPSOSRX5",36,0) ; The purpose is to decide what to with the new next request in the chain "RTN","BPSOSRX5",37,0) ; "RTN","BPSOSRX5",38,0) ; Example: "RTN","BPSOSRX5",39,0) ; If this request (Request A) is the last one in the chain and we just received a new request "RTN","BPSOSRX5",40,0) ; (Request B) for the same keys, then Request B needs to be activated after Request A has been completed. Who will do this? "RTN","BPSOSRX5",41,0) ; Situation 1: "RTN","BPSOSRX5",42,0) ; If this code REQST99^BPSOSRX5 gets the lock first then it will not be able to activate Request B (because we "RTN","BPSOSRX5",43,0) ; don't have it in the NEXT REQUEST field). So Request A will be completed and when the REQST^BPSOSRX code gets "RTN","BPSOSRX5",44,0) ; the lock it will find Request A marked as completed and will not populate the NEXT REQUEST field of Request A. "RTN","BPSOSRX5",45,0) ; Instead it will just activate Request B. "RTN","BPSOSRX5",46,0) ; Situation 2: "RTN","BPSOSRX5",47,0) ; If the REQST^BPSOSRX code gets the lock first then it will check the status of the Request A and since it is "RTN","BPSOSRX5",48,0) ; still "IN PROCESS", then it will populate the NEXT REQUEST field of the Request 1 with ien of Request 2, and "RTN","BPSOSRX5",49,0) ; then release the lock. Then when the REQST99^BPSOSRX5 gets the lock it checks the NEXT REQUEST field and "RTN","BPSOSRX5",50,0) ; activate the request 2 "RTN","BPSOSRX5",51,0) ; "RTN","BPSOSRX5",52,0) ;Input: "RTN","BPSOSRX5",53,0) ;IEN59 - BPS TRANSACTION IEN "RTN","BPSOSRX5",54,0) ;BPCLMST - claim status "RTN","BPSOSRX5",55,0) ; For Billing Requests (type= C): "RTN","BPSOSRX5",56,0) ; E PAYABLE, E CAPTURED, E DUPLICATE, E REJECTED, E OTHER, and "RTN","BPSOSRX5",57,0) ; E UNSTRANDED "RTN","BPSOSRX5",58,0) ; "RTN","BPSOSRX5",59,0) ; For Reversals (type=U): "RTN","BPSOSRX5",60,0) ; E REVERSAL ACCEPTED, E REVERSAL REJECTED, E REVERSAL OTHER, and "RTN","BPSOSRX5",61,0) ; E REVERSAL UNSTRANDED "RTN","BPSOSRX5",62,0) ; "RTN","BPSOSRX5",63,0) ; For Eligibility (type=E): "RTN","BPSOSRX5",64,0) ; E ELIGIBILITY ACCEPTED, E ELIGIBILITY REJECTED, E ELIGIBILITY OTHER, and "RTN","BPSOSRX5",65,0) ; E ELIGIBILITY UNSTRANDED "RTN","BPSOSRX5",66,0) ; "RTN","BPSOSRX5",67,0) ;Output: "RTN","BPSOSRX5",68,0) ; return 0 if there is no next request "RTN","BPSOSRX5",69,0) ; otherwise - return IEN of next BPS REQUEST "RTN","BPSOSRX5",70,0) REQST99(IEN59,BPCLMST) ; "RTN","BPSOSRX5",71,0) N BP77,KEY1,KEY2,BPRETV,BPTYPE,RESAFTRV,BPPAYSEQ,BPTYPNXT,BPFLG "RTN","BPSOSRX5",72,0) N BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,BPCOBIND,BPDUR "RTN","BPSOSRX5",73,0) S RESAFTRV=0 "RTN","BPSOSRX5",74,0) I '$G(IEN59) D LOG^BPSOSL(IEN59,$T(+0)_"-Transaction IEN not passed in") Q 0 "RTN","BPSOSRX5",75,0) S BPCLMST=$G(BPCLMST) "RTN","BPSOSRX5",76,0) ; "RTN","BPSOSRX5",77,0) ; Get Keys to the request file "RTN","BPSOSRX5",78,0) S BP77=$$GETRQST^BPSUTIL2(IEN59) "RTN","BPSOSRX5",79,0) I 'BP77 D LOG^BPSOSL(IEN59,$T(+0)_"-BPS Request Pointer not found") Q 0 "RTN","BPSOSRX5",80,0) S KEY1=$P($G(^BPS(9002313.77,BP77,0)),U,1) "RTN","BPSOSRX5",81,0) S KEY2=$P($G(^BPS(9002313.77,BP77,0)),U,2) "RTN","BPSOSRX5",82,0) I 'KEY1!(KEY2="") D LOG^BPSOSL(IEN59,$T(+0)_"-Request keys not found for "_BP77) Q 0 "RTN","BPSOSRX5",83,0) ; "RTN","BPSOSRX5",84,0) ; Get lock "RTN","BPSOSRX5",85,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Attempting to lock request with keys "_KEY1_", "_KEY2) "RTN","BPSOSRX5",86,0) S BPRETV=$$LOCKRF^BPSOSRX(KEY1,KEY2,10,IEN59,$T(+0)) "RTN","BPSOSRX5",87,0) I 'BPRETV D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot lock keys in REQST99") Q 0 "RTN","BPSOSRX5",88,0) ; "RTN","BPSOSRX5",89,0) ; Mark this request as completed "RTN","BPSOSRX5",90,0) N BPNXT77 "RTN","BPSOSRX5",91,0) S BPRETV=$$COMPLETD^BPSOSRX4(BP77) I +BPRETV=0 D Q 0 "RTN","BPSOSRX5",92,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot change the PROCESS FLAG to COMPLETED: "_$P(BPRETV,U,2)) "RTN","BPSOSRX5",93,0) . D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0)) "RTN","BPSOSRX5",94,0) D LOG^BPSOSL(IEN59,$T(+0)_"-The request "_BP77_" has been changed to COMPLETED ("_+$P($G(^BPS(9002313.77,BP77,0)),U,4)_")") "RTN","BPSOSRX5",95,0) ; "RTN","BPSOSRX5",96,0) ; Get the request type and get the next request in the list "RTN","BPSOSRX5",97,0) ; For eligibility, do not deleted duplicate request. "RTN","BPSOSRX5",98,0) ; For others, do delete duplicate request "RTN","BPSOSRX5",99,0) S BPTYPE=$P($G(^BPS(9002313.77,BP77,1)),U,4) "RTN","BPSOSRX5",100,0) S BPFLG=$S(BPTYPE="E":0,1:1) "RTN","BPSOSRX5",101,0) S BPNXT77=+$$GETNXREQ^BPSOSRX6(BP77,BPFLG,BPFLG,IEN59) "RTN","BPSOSRX5",102,0) ; "RTN","BPSOSRX5",103,0) ; If this was reversal (UNCLAIM), the next request is "CLAIM", "RTN","BPSOSRX5",104,0) ; and the RX action is = resubmit (ERES), then this is a submit after reversal "RTN","BPSOSRX5",105,0) I BPTYPE="U",$P($G(^BPS(9002313.77,+BPNXT77,1)),U,4)="C",$P($G(^BPS(9002313.77,+BPNXT77,1)),U,1)="ERES" S RESAFTRV=1 "RTN","BPSOSRX5",106,0) I RESAFTRV=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Reverse then Resubmit attempt") "RTN","BPSOSRX5",107,0) ; "RTN","BPSOSRX5",108,0) S BPPAYSEQ=$$COB59^BPSUTIL2(IEN59) ;payer sequence "RTN","BPSOSRX5",109,0) ; "RTN","BPSOSRX5",110,0) ; If not eligibility and the current request failed, then cancel and delete all subsequent requests and quit "RTN","BPSOSRX5",111,0) I BPTYPE'="E",$$SUCCESS^BPSOSRX7(BPTYPE,BPCLMST)=0 D Q 0 "RTN","BPSOSRX5",112,0) . ; If secondary claim was rejected with certain reject codes - send it to Pharmacy worklist "RTN","BPSOSRX5",113,0) . ; DMB-Not sure if this is valid. Call from BPSOSQL to DURSYNC should have sent these already. "RTN","BPSOSRX5",114,0) . I BPTYPE="C",BPPAYSEQ=2 I $$SENDREJ^BPSWRKLS(KEY1,KEY2,IEN59,BPPAYSEQ) "RTN","BPSOSRX5",115,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Current request failed with "_BPCLMST_" - removing this and all sequential requests") "RTN","BPSOSRX5",116,0) . I RESAFTRV=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot do Reverse then Resubmit attempt - Reversal status: "_BPCLMST) "RTN","BPSOSRX5",117,0) . D DELALLRQ^BPSOSRX7(BP77,IEN59) "RTN","BPSOSRX5",118,0) . D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0)) "RTN","BPSOSRX5",119,0) ; "RTN","BPSOSRX5",120,0) ; If there is no "next request" for the RX/refill - delete the completed request and quit with 0 "RTN","BPSOSRX5",121,0) I BPNXT77=0 D Q 0 "RTN","BPSOSRX5",122,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-There is no NEXT REQUEST. Deleting the current request") "RTN","BPSOSRX5",123,0) . D DELREQST^BPSOSRX4(BP77,IEN59) "RTN","BPSOSRX5",124,0) . D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0)) "RTN","BPSOSRX5",125,0) ; "RTN","BPSOSRX5",126,0) ; If there is a NEXT REQUEST "RTN","BPSOSRX5",127,0) D LOG^BPSOSL(IEN59,$T(+0)_"-The NEXT "_$P($G(^BPS(9002313.77,+BPNXT77,1)),U,4)_"-type REQUEST is "_BPNXT77) "RTN","BPSOSRX5",128,0) ; "RTN","BPSOSRX5",129,0) S BPTYPNXT=$P($G(^BPS(9002313.77,+BPNXT77,1)),U,4) ;action type of the next request "RTN","BPSOSRX5",130,0) ; "RTN","BPSOSRX5",131,0) ; If eligibility, activate the next request "RTN","BPSOSRX5",132,0) I BPTYPE="E" S BPRETV=$$ACTIVATE^BPSNCPD4(BPNXT77,"E") G END "RTN","BPSOSRX5",133,0) ; "RTN","BPSOSRX5",134,0) ; If secondary claim AND action type ="C", don't redo billing determination again, just activate "RTN","BPSOSRX5",135,0) I BPPAYSEQ>1,BPTYPNXT="C" S BPRETV=$$ACTIVATE^BPSNCPD4(BPNXT77,"C") G END "RTN","BPSOSRX5",136,0) ; "RTN","BPSOSRX5",137,0) I RESAFTRV=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Now resubmit") "RTN","BPSOSRX5",138,0) S BFILLDAT=+$P($G(^BPS(9002313.77,BPNXT77,2)),U) "RTN","BPSOSRX5",139,0) S BWHERE=$P($G(^BPS(9002313.77,BPNXT77,1)),U) "RTN","BPSOSRX5",140,0) S BILLNDC=$P($G(^BPS(9002313.77,BPNXT77,2)),U,6) ;if we do not send it then BPSNCPDP will get the latest NDC "RTN","BPSOSRX5",141,0) S REVREAS=$P($G(^BPS(9002313.77,BPNXT77,2)),U,2) "RTN","BPSOSRX5",142,0) S DURREC="" "RTN","BPSOSRX5",143,0) S BPDUR=$O(^BPS(9002313.77,BPNXT77,3,"")) I BPDUR S DURREC=^BPS(9002313.77,BPNXT77,3,BPDUR,0) "RTN","BPSOSRX5",144,0) S BPOVRIEN=$P($G(^BPS(9002313.77,BPNXT77,2)),U,4) "RTN","BPSOSRX5",145,0) S BPSCLARF=$P($G(^BPS(9002313.77,BPNXT77,2)),U,5) "RTN","BPSOSRX5",146,0) S BPSAUTH=$P($G(^BPS(9002313.77,BPNXT77,2)),U,7) I BPSAUTH'="" S BPSAUTH=BPSAUTH_U_$P($G(^BPS(9002313.77,BPNXT77,2)),U,8) "RTN","BPSOSRX5",147,0) S BPCOBIND=+$P($G(^BPS(9002313.77,BPNXT77,0)),U,3) "RTN","BPSOSRX5",148,0) S BPSDELAY=$P($G(^BPS(9002313.77,BPNXT77,2)),U,10) "RTN","BPSOSRX5",149,0) ; Call ECME engine in "B" (background) mode to: "RTN","BPSOSRX5",150,0) ; Perform checks if necessary, "RTN","BPSOSRX5",151,0) ; Update billing info if this is a CLAIM "RTN","BPSOSRX5",152,0) ; Activate the request "RTN","BPSOSRX5",153,0) S BPRETV=$$EN^BPSNCPDP(KEY1,KEY2,BFILLDAT,BWHERE,BILLNDC,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPCOBIND,"B",BPNXT77,"","","","",BPSDELAY) "RTN","BPSOSRX5",154,0) ; Code falls through to here but is also called above "RTN","BPSOSRX5",155,0) END ; "RTN","BPSOSRX5",156,0) ; If unsuccessful, deactivate all subsequent request and quit "RTN","BPSOSRX5",157,0) I +BPRETV'=0 D Q 0 "RTN","BPSOSRX5",158,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot activate the next request: "_$P(BPRETV,U,2)) "RTN","BPSOSRX5",159,0) . D DELALLRQ^BPSOSRX7(BP77,IEN59) "RTN","BPSOSRX5",160,0) . D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0)) "RTN","BPSOSRX5",161,0) ; If was successful, do the next steps: "RTN","BPSOSRX5",162,0) ; Log an entry "RTN","BPSOSRX5",163,0) ; Delete the completed request "RTN","BPSOSRX5",164,0) ; Run background process, if neeeded "RTN","BPSOSRX5",165,0) D LOG^BPSOSL(IEN59,$T(+0)_"-The NEXT "_$P($G(^BPS(9002313.77,+BPNXT77,1)),U,4)_"-type REQUEST "_BPNXT77_" has been activated") "RTN","BPSOSRX5",166,0) D DELREQST^BPSOSRX4(BP77,IEN59) "RTN","BPSOSRX5",167,0) D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0)) "RTN","BPSOSRX5",168,0) ; Run background process to pick up the activated request for secondary claim (for primary only - it is done when we call EN^BPSNCPDP above) "RTN","BPSOSRX5",169,0) I BPTYPNXT="E"!(BPPAYSEQ>1&(BPTYPNXT="C")) D RUNNING^BPSOSRX() "RTN","BPSOSRX5",170,0) Q BPNXT77 "RTN","BPSOSRX5",171,0) ;BPSOSRX5 "RTN","BPSOSRX6") 0^73^B23669366 "RTN","BPSOSRX6",1,0) BPSOSRX6 ;ALB/SS - ECME REQUESTS ;02-JAN-08 "RTN","BPSOSRX6",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSOSRX6",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX6",4,0) ; "RTN","BPSOSRX6",5,0) ;to change the PROCESS FLAG status of the request "RTN","BPSOSRX6",6,0) ; BPIEN77 - BPS REQUEST ien "RTN","BPSOSRX6",7,0) ; BPSTAT - new PROCESS FLAG value "RTN","BPSOSRX6",8,0) ; returns "RTN","BPSOSRX6",9,0) ; 1^the BPIEN77 "RTN","BPSOSRX6",10,0) ; or "RTN","BPSOSRX6",11,0) ; 0^error message "RTN","BPSOSRX6",12,0) CHNGPRFL(BPIEN77,BPSTAT) ; "RTN","BPSOSRX6",13,0) I $$FILLFLDS^BPSUTIL2(9002313.77,".04",BPIEN77,BPSTAT)<1 Q "0^Cannot update field #.04 (PROCESS FLAG) in BPS REQUEST" "RTN","BPSOSRX6",14,0) ;update user and time "RTN","BPSOSRX6",15,0) Q $$UPUSRTIM(BPIEN77,+$G(MOREDATA("USER"))) "RTN","BPSOSRX6",16,0) ; "RTN","BPSOSRX6",17,0) ;to set NEXT REQUEST field "RTN","BPSOSRX6",18,0) ; BPIEN77 - BPS REQUEST ien "RTN","BPSOSRX6",19,0) ; BPNXTREQ - the NEXT REQUEST ien "RTN","BPSOSRX6",20,0) ; returns "RTN","BPSOSRX6",21,0) ; 1^the BPIEN77 "RTN","BPSOSRX6",22,0) ; or "RTN","BPSOSRX6",23,0) ; 0^error message "RTN","BPSOSRX6",24,0) NXTREQST(BPIEN77,BPNXTREQ) ; "RTN","BPSOSRX6",25,0) I BPIEN77=BPNXTREQ Q "0^Next and current requests cannot be the same" "RTN","BPSOSRX6",26,0) I $$FILLFLDS^BPSUTIL2(9002313.77,".05",BPIEN77,BPNXTREQ)<1 Q "0^Cannot update field #.05 (NEXT REQUEST) in BPS REQUEST" "RTN","BPSOSRX6",27,0) ;update user and time and quit (return 1^ien77 if success) "RTN","BPSOSRX6",28,0) Q $$UPUSRTIM(BPIEN77,+$G(MOREDATA("USER"))) "RTN","BPSOSRX6",29,0) ; "RTN","BPSOSRX6",30,0) ;any active requests for the keys? = scheduled,activated,in process,comleted but not activated yet "RTN","BPSOSRX6",31,0) ;KEY1 - First key of the BPS Request file "RTN","BPSOSRX6",32,0) ;KEY2 - Second Key of the BPS Request file "RTN","BPSOSRX6",33,0) ;BPCOB - COB (payer sequence) "RTN","BPSOSRX6",34,0) ;returns "RTN","BPSOSRX6",35,0) ;1 - yes "RTN","BPSOSRX6",36,0) ;0 -no "RTN","BPSOSRX6",37,0) ACTREQS(KEY1,KEY2,BPCOB) ; "RTN","BPSOSRX6",38,0) N BPZZ,BPACTRQ "RTN","BPSOSRX6",39,0) S BPACTRQ=0 "RTN","BPSOSRX6",40,0) F BPZZ=0,1,2,3 I $G(^BPS(9002313.77,"AC",BPZZ,KEY1,KEY2))=BPCOB S BPACTRQ=1 Q:BPACTRQ=1 "RTN","BPSOSRX6",41,0) Q BPACTRQ "RTN","BPSOSRX6",42,0) ;update time and user id "RTN","BPSOSRX6",43,0) ;BPIEN77 - BPS REQUEST ien "RTN","BPSOSRX6",44,0) ;BPUSER - user's DUZ "RTN","BPSOSRX6",45,0) ;returns 1^BPIEN77 "RTN","BPSOSRX6",46,0) ;or 0^error message "RTN","BPSOSRX6",47,0) UPUSRTIM(BPIEN77,BPUSER) ; "RTN","BPSOSRX6",48,0) I $$FILLFLDS^BPSUTIL2(9002313.77,"6.05",BPIEN77,+$$NOW^BPSOSRX())<1 Q "0^Cannot update the field #6.05 in BPS REQUEST" ;S SUBMITDT=$$NOW "RTN","BPSOSRX6",49,0) I $$FILLFLDS^BPSUTIL2(9002313.77,"6.06",BPIEN77,+BPUSER)<1 Q "0^Cannot update the field #6.06 in BPS REQUEST" ;USER "RTN","BPSOSRX6",50,0) Q "1^"_BPIEN77 "RTN","BPSOSRX6",51,0) ;remove all active requests for the keys "RTN","BPSOSRX6",52,0) DELACTRQ(KEY1,KEY2,IEN59) ; "RTN","BPSOSRX6",53,0) N BP77 "RTN","BPSOSRX6",54,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Deleting all active requests for keys "_KEY1_", "_KEY2) "RTN","BPSOSRX6",55,0) F BPZZ=0,1,2,3 D "RTN","BPSOSRX6",56,0) . S BP77=0 F S BP77=$O(^BPS(9002313.77,"AC",BPZZ,KEY1,KEY2,BP77)) Q:+BP77=0 D "RTN","BPSOSRX6",57,0) .. D DELREQST^BPSOSRX4(BP77,IEN59) "RTN","BPSOSRX6",58,0) Q "RTN","BPSOSRX6",59,0) ;Old status logic - to process claims that were submitted before Processing queue mods "RTN","BPSOSRX6",60,0) OLDSTAT(RXI,RXR,QUE) ; "RTN","BPSOSRX6",61,0) ; "RTN","BPSOSRX6",62,0) ; Setup needed variables "RTN","BPSOSRX6",63,0) N IEN59,SDT,A,SUBDT "RTN","BPSOSRX6",64,0) I '$G(RXI) Q "" "RTN","BPSOSRX6",65,0) I $G(RXR)="" Q "" "RTN","BPSOSRX6",66,0) I $G(QUE)="" S QUE=1 "RTN","BPSOSRX6",67,0) S IEN59=$$IEN59^BPSOSRX(RXI,RXR) "RTN","BPSOSRX6",68,0) S SDT=$G(^XTMP("BPSOSRX",RXI,RXR)) "RTN","BPSOSRX6",69,0) ; "RTN","BPSOSRX6",70,0) ; ECME record not created "RTN","BPSOSRX6",71,0) I '$D(^BPST(IEN59)) D Q A "RTN","BPSOSRX6",72,0) . I QUE,SDT S A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1 Q "RTN","BPSOSRX6",73,0) . I QUE,$D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)) S A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1 Q "RTN","BPSOSRX6",74,0) . S A="" "RTN","BPSOSRX6",75,0) ; "RTN","BPSOSRX6",76,0) ; Loop: Get data, quit if times and status match (no change during gather) "RTN","BPSOSRX6",77,0) N C,T1,T2,S1,S2 F D I T1=T2,S1=S2 Q "RTN","BPSOSRX6",78,0) . S T1=$$LASTUP59^BPSOSRX(IEN59) "RTN","BPSOSRX6",79,0) . S S1=$$STATUS59^BPSOSRX(IEN59) "RTN","BPSOSRX6",80,0) . I S1=99 D ; completed "RTN","BPSOSRX6",81,0) . . S A=$$CATEG^BPSOSUC(IEN59) "RTN","BPSOSRX6",82,0) . . S C=$$RESTXT59^BPSOSRX(IEN59) "RTN","BPSOSRX6",83,0) . I S1'=99 D "RTN","BPSOSRX6",84,0) . . S A="IN PROGRESS" "RTN","BPSOSRX6",85,0) . . S C=$$STATI^BPSOSU($S(S1="":10,1:S1)) "RTN","BPSOSRX6",86,0) . S T2=$$LASTUP59^BPSOSRX(IEN59) "RTN","BPSOSRX6",87,0) . S S2=$$STATUS59^BPSOSRX(IEN59) "RTN","BPSOSRX6",88,0) ; "RTN","BPSOSRX6",89,0) ; If the queue parameter is set and the submit date from the queue "RTN","BPSOSRX6",90,0) ; follows the SUBMIT DATE/LAST UPDATE date from BPS TRANSACTION "RTN","BPSOSRX6",91,0) ; or the RX/fill is still on the queue, then change the response "RTN","BPSOSRX6",92,0) ; to IN PROGRESS^Submit Date^WAITING TO START "RTN","BPSOSRX6",93,0) S SUBDT=$$SUBMIT59^BPSOSRX(IEN59) "RTN","BPSOSRX6",94,0) I SUBDT="" S SUBDT=T1 "RTN","BPSOSRX6",95,0) I $G(QUE),SDT>SUBDT!($D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)))!($D(^XTMP("BPS-PROC","UNCLAIM",RXI,RXR))) S A="IN PROGRESS",T1=SDT,S1=-1,C=$$STATI^BPSOSU(0) "RTN","BPSOSRX6",96,0) ; "RTN","BPSOSRX6",97,0) ; When finishing the reversal of a Reversal/Resubmit, display IN PROGRESS "RTN","BPSOSRX6",98,0) I $P($G(^BPST(IEN59,1)),"^",12)=1,S1=99 S A="IN PROGRESS",S1=98,C=$$STATI^BPSOSU(S1) "RTN","BPSOSRX6",99,0) ; "RTN","BPSOSRX6",100,0) ; Return results "RTN","BPSOSRX6",101,0) Q A_U_T1_U_$E(C,1,255-$L(A)-$L(T1)-2)_U_S1 "RTN","BPSOSRX6",102,0) ; "RTN","BPSOSRX6",103,0) ;check for duplicates and determine the NEXT REQUEST "RTN","BPSOSRX6",104,0) ;BP77 - the current request (ien of #9002313.77) "RTN","BPSOSRX6",105,0) ;BPDEL=1 - delete duplicates "RTN","BPSOSRX6",106,0) ;BPUPDNXT=1 - update the NEXT REQUEST field of the current request after skipping (deleting) duplicates "RTN","BPSOSRX6",107,0) ;(Note - if BPDEL=1 then BPUPDNXT will be set to 1 to avoid "hanging" requests "RTN","BPSOSRX6",108,0) ;BP59 - (optional) the ien of BPS TRANSACTION file "RTN","BPSOSRX6",109,0) ;Returns the next request or NULL (if there is no next request) "RTN","BPSOSRX6",110,0) ; "RTN","BPSOSRX6",111,0) ; For eligibility, return the next record (if there is one) "RTN","BPSOSRX6",112,0) ; Do not compare types or delete duplicates. "RTN","BPSOSRX6",113,0) GETNXREQ(BP77,BPDEL,BPUPDNXT,BP59) ; "RTN","BPSOSRX6",114,0) N BPCUR,BPCURTYP,BPARRDEL "RTN","BPSOSRX6",115,0) N BPNXT77,BPTYPNXT,BP77DEL "RTN","BPSOSRX6",116,0) S BPCUR=BP77,BPCURTYP=$P($G(^BPS(9002313.77,BP77,1)),U,4) "RTN","BPSOSRX6",117,0) F D Q:BPNXT77=0 Q:BPCURTYP'=BPTYPNXT!(BPCURTYP="E") S BPCUR=BPNXT77,BPCURTYP=BPTYPNXT,BPARRDEL(BPNXT77)="" "RTN","BPSOSRX6",118,0) . S BPNXT77=+$P($G(^BPS(9002313.77,BPCUR,0)),U,5) "RTN","BPSOSRX6",119,0) . Q:BPNXT77=0 "RTN","BPSOSRX6",120,0) . S BPTYPNXT=$P($G(^BPS(9002313.77,BPNXT77,1)),U,4) "RTN","BPSOSRX6",121,0) ;if nothing to skip then quit now "RTN","BPSOSRX6",122,0) I '$O(BPARRDEL("")) Q BPNXT77 "RTN","BPSOSRX6",123,0) ; delete duplicates "RTN","BPSOSRX6",124,0) I $G(BPDEL)=1 S BP77DEL=0 F S BP77DEL=$O(BPARRDEL(BP77DEL)) Q:+BP77DEL=0 D "RTN","BPSOSRX6",125,0) . I $G(BP59)>0 D LOG^BPSOSL(BP59,$T(+0)_"-Delete the duplicate request "_BP77DEL) "RTN","BPSOSRX6",126,0) . D DELREQST^BPSOSRX4(BP77DEL,$G(BP59)) "RTN","BPSOSRX6",127,0) I $G(BPDEL)=1 S BPUPDNXT=1 "RTN","BPSOSRX6",128,0) I $G(BPUPDNXT)=1 D "RTN","BPSOSRX6",129,0) . I $$FILLFLDS^BPSUTIL2(9002313.77,".05",BP77,BPNXT77)<1 D "RTN","BPSOSRX6",130,0) . . I $G(BP59)>0 D LOG^BPSOSL(BP59,$T(+0)_"-Cannot update field #.05 (NEXT REQUEST) in BPS REQUEST") "RTN","BPSOSRX6",131,0) . I $G(BP59)>0 D LOG^BPSOSL(BP59,$T(+0)_"-Update field #.05 (NEXT REQUEST) to "_BPNXT77_" in the request #"_BP77) "RTN","BPSOSRX6",132,0) ;return the NEXT request "RTN","BPSOSRX6",133,0) Q BPNXT77 "RTN","BPSOSRX6",134,0) ;BPSOSRX6 "RTN","BPSOSRX6",135,0) ; "RTN","BPSOSRX7") 0^33^B43038317 "RTN","BPSOSRX7",1,0) BPSOSRX7 ;ALB/SS - ECME REQUESTS ;04-JAN-08 "RTN","BPSOSRX7",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,10**;JUN 2004;Build 27 "RTN","BPSOSRX7",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX7",4,0) ; "RTN","BPSOSRX7",5,0) Q "RTN","BPSOSRX7",6,0) ; "RTN","BPSOSRX7",7,0) ;Input: "RTN","BPSOSRX7",8,0) ;KEY1 - First Key "RTN","BPSOSRX7",9,0) ;KEY2 - Second Key "RTN","BPSOSRX7",10,0) ;BPREQS (by reference)- local array to convey results back to the caller "RTN","BPSOSRX7",11,0) ; BPREQS = number of nodes stored in the array "RTN","BPSOSRX7",12,0) ; BPREQS(n)=BPS REQUEST ien ^ Claim type ^ COB "RTN","BPSOSRX7",13,0) ; "RTN","BPSOSRX7",14,0) ;return values: "RTN","BPSOSRX7",15,0) ; -5 : Unexpected ACTIVATED or IN PROCESS request has been found "RTN","BPSOSRX7",16,0) ; -4 : Multiple BPS REQUEST records with the same NEXT REQUEST value "RTN","BPSOSRX7",17,0) ; -3 : SCHEDULED request(s) were found but they is not ACTIVATED for some reason "RTN","BPSOSRX7",18,0) ; -2 : duplicate ACTVATED / IN PROCESS requests for the same keys - this should not happen "RTN","BPSOSRX7",19,0) ; -1 : cannot be accepted - because reversal was requested "RTN","BPSOSRX7",20,0) ; and there are requests already for these keys in the queue "RTN","BPSOSRX7",21,0) ; and the last one is REVERSAL too for the same COB "RTN","BPSOSRX7",22,0) ; so we will return "-1^Sequential duplicate reversal" "RTN","BPSOSRX7",23,0) ; 0 : can be accepted because there are NO requests for these keys "RTN","BPSOSRX7",24,0) ; we will create a new record in BPS REQUEST for it and ACTIVATE it. "RTN","BPSOSRX7",25,0) ; >0 : IEN of the last BPS REQUEST in the queue - there are requests already for these keys. "RTN","BPSOSRX7",26,0) ; "RTN","BPSOSRX7",27,0) CHKREQST(KEY1,KEY2,BPREQS) ; "RTN","BPSOSRX7",28,0) N BPPRFLG,BPCURNT,BPNEXT,BPCOB,BPRCUR,BPRNXT,BPQ,BPCNT,BPZ "RTN","BPSOSRX7",29,0) ;get the current IN PROCESS request for these keys "RTN","BPSOSRX7",30,0) S BPPRFLG=2 D I BPCURNT>0 I $O(^BPS(9002313.77,"AC",2,KEY1,KEY2,+BPCURNT))>0 Q "-2^Error: More than one IN PROCESS request for keys="_KEY1_", "_KEY2 "RTN","BPSOSRX7",31,0) . S BPCURNT=$O(^BPS(9002313.77,"AC",BPPRFLG,KEY1,KEY2,"")) "RTN","BPSOSRX7",32,0) ;if there is no IN PROCESS then check ACTIVATED "RTN","BPSOSRX7",33,0) I BPCURNT="" S BPPRFLG=1 D I BPCURNT>0 I $O(^BPS(9002313.77,"AC",BPPRFLG,KEY1,KEY2,+BPCURNT))>0 Q "-2^Error: More than one ACTIVATED request for keys="_KEY1_", "_KEY2 "RTN","BPSOSRX7",34,0) . S BPCURNT=$O(^BPS(9002313.77,"AC",BPPRFLG,KEY1,KEY2,"")) "RTN","BPSOSRX7",35,0) ;if there is no IACTIVATED then check SCHEDULED "RTN","BPSOSRX7",36,0) I BPCURNT="" S BPPRFLG=0 D I BPCURNT>0 Q "-3^Error: There is a SCHEDULED request without ACTIVATED requests, keys="_KEY1_", "_KEY2 "RTN","BPSOSRX7",37,0) . S BPCURNT=$O(^BPS(9002313.77,"AC",BPPRFLG,KEY1,KEY2,"")) "RTN","BPSOSRX7",38,0) ;if there is no any requests then return 0 "RTN","BPSOSRX7",39,0) I BPCURNT="" Q 0 ;can be accepted because there are NO requests for these keys "RTN","BPSOSRX7",40,0) ;Otherwise... "RTN","BPSOSRX7",41,0) S BPQ=0,BPREQS=1 "RTN","BPSOSRX7",42,0) S BPRCUR=BPCURNT "RTN","BPSOSRX7",43,0) ;save current_ien ^ actype ^ COB "RTN","BPSOSRX7",44,0) S BPREQS(BPREQS)=BPCURNT_U_$P($G(^BPS(9002313.77,BPCURNT,1)),U,4)_U_$P($G(^BPS(9002313.77,BPCURNT,0)),U,3) "RTN","BPSOSRX7",45,0) ;loop thru all SCHEDULED,ACTIVATED and IN PROCESS records starting with BPCURNT "RTN","BPSOSRX7",46,0) F S BPRNXT=$O(^BPS(9002313.77,"AN",BPRCUR,"")) Q:BPRNXT="" Q:BPQ'=0 D "RTN","BPSOSRX7",47,0) . I $D(BPREQS("R",BPRNXT)) S BPQ=-1 Q ;error - more than one records with the same next request "RTN","BPSOSRX7",48,0) . ;BPZ - process flag ^ act type ^ COB "RTN","BPSOSRX7",49,0) . S BPZ=$G(^BPS(9002313.77,"AN",BPRCUR,BPRNXT)) "RTN","BPSOSRX7",50,0) . I BPRCUR'=BPCURNT I +BPZ>0 S BPQ=+BPZ Q ;except the first record in the loop - all others should be SCHEDULED (i.e. process flag =0) "RTN","BPSOSRX7",51,0) . S BPREQS=BPREQS+1 "RTN","BPSOSRX7",52,0) . S BPREQS(BPREQS)=BPRNXT_U_$P($G(^BPS(9002313.77,BPRNXT,1)),U,4)_U_$P($G(^BPS(9002313.77,BPRNXT,0)),U,3) "RTN","BPSOSRX7",53,0) . S BPREQS("R",BPRNXT)="" ;used to check uniqueness "RTN","BPSOSRX7",54,0) . S BPRCUR=BPRNXT "RTN","BPSOSRX7",55,0) ; "RTN","BPSOSRX7",56,0) K BPREQS("R") "RTN","BPSOSRX7",57,0) I BPQ=-1 Q "-4^Error: Multiple BPS REQUEST records with the same NEXT REQUEST value for keys="_KEY1_", "_KEY2 "RTN","BPSOSRX7",58,0) I BPQ=1 Q "-5^Error: Unexpected ACTIVATED request has been found for keys="_KEY1_", "_KEY2 "RTN","BPSOSRX7",59,0) I BPQ=2 Q "-5^Error: Unexpected IN PROCESS request has been found for keys="_KEY1_", "_KEY2 "RTN","BPSOSRX7",60,0) S BPZ=BPREQS(BPREQS) "RTN","BPSOSRX7",61,0) Q +BPZ "RTN","BPSOSRX7",62,0) ; "RTN","BPSOSRX7",63,0) ; "RTN","BPSOSRX7",64,0) ;BPTYPE: C-CLAIM, U-UNCLAIM (reversal), E-ELIGIBILITY "RTN","BPSOSRX7",65,0) ;BPCLMST: "RTN","BPSOSRX7",66,0) ; For submissions (type=C): "RTN","BPSOSRX7",67,0) ; E PAYABLE, E CAPTURED, E DUPLICATE, E REJECTED, E OTHER, and "RTN","BPSOSRX7",68,0) ; E UNSTRANDED "RTN","BPSOSRX7",69,0) ; "RTN","BPSOSRX7",70,0) ; For Reversals (type=U): "RTN","BPSOSRX7",71,0) ; E REVERSAL ACCEPTED, E REVERSAL REJECTED, E REVERSAL OTHER, and "RTN","BPSOSRX7",72,0) ; E REVERSAL UNSTRANDED "RTN","BPSOSRX7",73,0) ; "RTN","BPSOSRX7",74,0) ; For Eligibility Verification (type=E): "RTN","BPSOSRX7",75,0) ; E ELIGIBILITY ACCEPTED, E ELIGIBILITY REJECTED, E ELIGIBILITY OTHER, and "RTN","BPSOSRX7",76,0) ; E ELIGIBILITY UNSTRANDED "RTN","BPSOSRX7",77,0) ;returns: "RTN","BPSOSRX7",78,0) ;1 - request was succesful "RTN","BPSOSRX7",79,0) ;0 - request failed "RTN","BPSOSRX7",80,0) SUCCESS(BPTYPE,BPCLMST) ; "RTN","BPSOSRX7",81,0) I BPTYPE="C" Q $S((BPCLMST="E PAYABLE")!(BPCLMST="E DUPLICATE"):1,1:0) "RTN","BPSOSRX7",82,0) I BPTYPE="U" Q $S((BPCLMST="E REVERSAL ACCEPTED"):1,1:0) "RTN","BPSOSRX7",83,0) I BPTYPE="E" Q $S((BPCLMST="E ELIGIBILITY ACCEPTED"):1,1:0) "RTN","BPSOSRX7",84,0) Q 0 "RTN","BPSOSRX7",85,0) ;delete all sequential requests and quit "RTN","BPSOSRX7",86,0) DELALLRQ(BP77,IEN59) ; "RTN","BPSOSRX7",87,0) N BPNXT77 "RTN","BPSOSRX7",88,0) F S BPNXT77=+$P($G(^BPS(9002313.77,BP77,0)),U,5) D Q:+BPNXT77=0 "RTN","BPSOSRX7",89,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Deleting "_$P($G(^BPS(9002313.77,BP77,1)),U,4)_"-type request = "_BP77) "RTN","BPSOSRX7",90,0) . D DELREQST^BPSOSRX4(BP77,IEN59) "RTN","BPSOSRX7",91,0) . S BP77=BPNXT77 "RTN","BPSOSRX7",92,0) Q "RTN","BPSOSRX7",93,0) ; Create BPS Insurer Data records and update BPS Request fields "RTN","BPSOSRX7",94,0) ; This is called by jobs that were scheduled in the background "RTN","BPSOSRX7",95,0) ; and are now being processed "RTN","BPSOSRX7",96,0) ; "RTN","BPSOSRX7",97,0) ; Input: "RTN","BPSOSRX7",98,0) ; BPIEN77 - IEN for BPS Request record "RTN","BPSOSRX7",99,0) ; MOREDATA - Array of data "RTN","BPSOSRX7",100,0) ; IEN59 - IEN for BPS Transaction record "RTN","BPSOSRX7",101,0) ; BPCOBIND - Coordination of Benefit indicator (not formally passed but "RTN","BPSOSRX7",102,0) ; newed/set by calling routine) "RTN","BPSOSRX7",103,0) ; Return values: "RTN","BPSOSRX7",104,0) ; 1^BPS REQUEST ien = accepted for processing "RTN","BPSOSRX7",105,0) ; 0^reason = failure (should never happen) "RTN","BPSOSRX7",106,0) UPDINSDT(BPIEN77,MOREDATA,IEN59) ; "RTN","BPSOSRX7",107,0) I '$G(BPIEN77) Q "0^Parameter error-BPS Request IEN missing" "RTN","BPSOSRX7",108,0) I '$D(MOREDATA) Q "0^Parameter error-MOREDATA missing" "RTN","BPSOSRX7",109,0) I '$G(IEN59) Q "0^Parameter error-BPS Transaction IEN missing" "RTN","BPSOSRX7",110,0) N BPRETV,BPIENS78,BPZ,KEY1,KEY2,BPCOB,BPQ,BPIEN772,BPREQTYP,BPERRMSG "RTN","BPSOSRX7",111,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Creating BPS INSURER DATA records and updating BPS Request record "_BPIEN77) "RTN","BPSOSRX7",112,0) S BPZ=$G(^BPS(9002313.77,BPIEN77,0)) "RTN","BPSOSRX7",113,0) S KEY1=$P(BPZ,U,1),KEY2=$P(BPZ,U,2) "RTN","BPSOSRX7",114,0) S BPRETV=$$MKINSUR^BPSOSRX2(KEY1,KEY2,.MOREDATA,.BPIENS78) "RTN","BPSOSRX7",115,0) I +BPRETV=0 Q BPRETV "RTN","BPSOSRX7",116,0) ; "RTN","BPSOSRX7",117,0) ; Update BPS Request record with BPS INSURER DATA IENs "RTN","BPSOSRX7",118,0) S BPQ=0 "RTN","BPSOSRX7",119,0) S BPCOB=0 F S BPCOB=$O(BPIENS78(BPCOB)) Q:+BPCOB=0!(BPQ=1) D "RTN","BPSOSRX7",120,0) . I '$D(^BPS(9002313.77,BPIEN77,5,BPCOB)) D I BPQ=1 Q "RTN","BPSOSRX7",121,0) . . S BPIEN772=$$INSITEM^BPSUTIL2(9002313.772,BPIEN77,BPCOB,BPCOB,"",,0) "RTN","BPSOSRX7",122,0) . . I BPIEN772<1 S BPERRMSG="Cannot create record in IBDATA multiple of the BPS REQUEST file",BPQ=1 Q "RTN","BPSOSRX7",123,0) . S BPERRMSG="Cannot populate a field in IBDATA multiple" "RTN","BPSOSRX7",124,0) . I $$FILLFLDS^BPSUTIL2(9002313.772,".02",BPCOB_","_BPIEN77,$S($G(BPCOBIND)=BPCOB:1,1:0))<1 S BPQ=1 Q "RTN","BPSOSRX7",125,0) . I $$FILLFLDS^BPSUTIL2(9002313.772,".03",BPCOB_","_BPIEN77,BPIENS78(BPCOB))<1 S BPQ=1 Q "RTN","BPSOSRX7",126,0) I BPQ=1 Q "0^"_BPERRMSG_"INSURER DATA" "RTN","BPSOSRX7",127,0) ; "RTN","BPSOSRX7",128,0) ; Update selective BPS Request fields "RTN","BPSOSRX7",129,0) S BPREQTYP=$P($G(^BPS(9002313.77,BPIEN77,1)),U,4),BPERRMSG="Missing data for the " "RTN","BPSOSRX7",130,0) I $G(MOREDATA("DIVISION")),$$FILLFLDS^BPSUTIL2(9002313.77,"1.02",BPIEN77,MOREDATA("DIVISION"))<1 Q "0^"_$$ERRFIELD^BPSOSRX3(BPIEN77,1,BPERRMSG,9002313.77,1.02) ; Outpatient Site "RTN","BPSOSRX7",131,0) I $$ACTFIELD^BPSOSRX3(0,BPREQTYP,"1.13"),$$FILLFLDS^BPSUTIL2(9002313.77,"1.13",BPIEN77,$G(MOREDATA("RX")))<1,BPREQTYP'="E" Q "0^"_$$ERRFIELD^BPSOSRX3(BPIEN77,1,BPERRMSG,9002313.77,1.13) ; RX "RTN","BPSOSRX7",132,0) I $$ACTFIELD^BPSOSRX3(0,BPREQTYP,"1.14"),$$FILLFLDS^BPSUTIL2(9002313.77,"1.14",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,4))<1,BPREQTYP'="E" Q "0^"_$$ERRFIELD^BPSOSRX3(BPIEN77,1,BPERRMSG,9002313.77,1.14) ; Fill Number "RTN","BPSOSRX7",133,0) I $$ACTFIELD^BPSOSRX3(0,BPREQTYP,"1.15"),$$FILLFLDS^BPSUTIL2(9002313.77,"1.15",BPIEN77,$G(MOREDATA("PATIENT")))<1 Q "0^"_$$ERRFIELD^BPSOSRX3(BPIEN77,1,BPERRMSG,9002313.77,1.15) ; Patient "RTN","BPSOSRX7",134,0) I $$ACTFIELD^BPSOSRX3(0,BPREQTYP,"4.04"),$$FILLFLDS^BPSUTIL2(9002313.77,"4.04",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,4)) ; Fill Number "RTN","BPSOSRX7",135,0) ; "RTN","BPSOSRX7",136,0) Q "1^"_BPIEN77 "RTN","BPSOSRX7",137,0) ;get eligibility "RTN","BPSOSRX7",138,0) ELIG(DFN) ; "RTN","BPSOSRX7",139,0) N BPSARRY "RTN","BPSOSRX7",140,0) Q $P($$RX^IBNCPDP(DFN,.BPSARRY),U,3) ;Call IB again "RTN","BPSOSRX7",141,0) ;BPSOSRX7 "RTN","BPSOSRX8") 0^34^B22878740 "RTN","BPSOSRX8",1,0) BPSOSRX8 ;ALB/SS - ECME REQUESTS ;10-JAN-08 "RTN","BPSOSRX8",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,10**;JUN 2004;Build 27 "RTN","BPSOSRX8",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSRX8",4,0) ; "RTN","BPSOSRX8",5,0) ;check parameters for EN^BPSNCPDP "RTN","BPSOSRX8",6,0) ;BRXIEN - Rx ien "RTN","BPSOSRX8",7,0) ;BRX - rx refil no "RTN","BPSOSRX8",8,0) ;BWHERE - RX action "RTN","BPSOSRX8",9,0) ;DFN - patient's ien "RTN","BPSOSRX8",10,0) ;PNAME - patient name "RTN","BPSOSRX8",11,0) ;BILLNDC - NDC "RTN","BPSOSRX8",12,0) ;return "RTN","BPSOSRX8",13,0) ;1 - passed "RTN","BPSOSRX8",14,0) ;0^message - failed "RTN","BPSOSRX8",15,0) CHCKPAR(BRXIEN,BRX,BWHERE,DFN,PNAME,BILLNDC) ; "RTN","BPSOSRX8",16,0) I '$G(BRXIEN) Q "0^Prescription IEN parameter missing" "RTN","BPSOSRX8",17,0) I $G(BWHERE)="" Q "0^RX Action parameter missing" "RTN","BPSOSRX8",18,0) I $G(BRX)="" Q "0^Prescription does not exist" "RTN","BPSOSRX8",19,0) I $G(DFN)="" Q "0^Patient's IEN does not exist" "RTN","BPSOSRX8",20,0) I $G(PNAME)="" Q "0^Patient name missing" "RTN","BPSOSRX8",21,0) I $G(BILLNDC)="" Q "0^Invalid NDC" "RTN","BPSOSRX8",22,0) Q 1 "RTN","BPSOSRX8",23,0) ; "RTN","BPSOSRX8",24,0) ;===== check if we need to print the messages to the screen ======= "RTN","BPSOSRX8",25,0) PRINTSCR(BWHER) ; "RTN","BPSOSRX8",26,0) I ",ARES,AREV,CRLB,CRLR,CRLX,DDED,DE,HLD,PC,PE,PL,RS,"[(","_BWHER_",") Q 0 "RTN","BPSOSRX8",27,0) Q 1 ;print messages to the screen "RTN","BPSOSRX8",28,0) ;check if any IB DATA is missing "RTN","BPSOSRX8",29,0) ;returns "RTN","BPSOSRX8",30,0) ; 0 - passed "RTN","BPSOSRX8",31,0) ; or "RTN","BPSOSRX8",32,0) ; RESPONSE code^CLMSTAT message^D(display message)^number of seconds to hang if display "RTN","BPSOSRX8",33,0) IBDATAOK(MOREDATA,BPSARRY) ; "RTN","BPSOSRX8",34,0) N BPRESP S BPRESP=2 "RTN","BPSOSRX8",35,0) I $G(BPSARRY("NO ECME INSURANCE")) S BPRESP=6 "RTN","BPSOSRX8",36,0) ; Check for missing data (Will IB billing determination catch this?) "RTN","BPSOSRX8",37,0) I $D(MOREDATA("IBDATA",1,1)),$P(MOREDATA("IBDATA",1,1),"^",1)="" Q BPRESP_U_"Information missing from IB data.^D^2" "RTN","BPSOSRX8",38,0) ; Check for missing/invalid payer sheets (I think IB billing determination will catch this) "RTN","BPSOSRX8",39,0) I $P($G(MOREDATA("IBDATA",1,1)),"^",4)="" Q BPRESP_U_"Invalid/missing payer sheet from IB data.^D^2" "RTN","BPSOSRX8",40,0) ; Check if IB says to bill "RTN","BPSOSRX8",41,0) I '$G(MOREDATA("BILL")) Q BPRESP_U_"Flagged by IB to not 3rd Party Insurance bill through ECME.^D^2" "RTN","BPSOSRX8",42,0) Q 0 "RTN","BPSOSRX8",43,0) ;Get Site "RTN","BPSOSRX8",44,0) GETSITE(BRXIEN,BFILL) ; "RTN","BPSOSRX8",45,0) I '$G(BRXIEN) Q "" "RTN","BPSOSRX8",46,0) I '$G(BFILL) Q $$RXAPI1^BPSUTIL1(BRXIEN,20,"I") "RTN","BPSOSRX8",47,0) Q $$RXSUBF1^BPSUTIL1(BRXIEN,52,52.1,+BFILL,8,"I") "RTN","BPSOSRX8",48,0) ; "RTN","BPSOSRX8",49,0) ; Store general information/parameters into MOREDATA "RTN","BPSOSRX8",50,0) ; In instances where duz is null set it equal to .5 (postmaster) "RTN","BPSOSRX8",51,0) BASICMOR(BWHERE,BFILLDAT,BPSITE,REVREAS,DURREC,BPOVRIEN,BPSCLARF,BPSAUTH,BPSDELAY,MOREDATA) ; "RTN","BPSOSRX8",52,0) S MOREDATA("USER")=$S('DUZ:.5,1:DUZ) "RTN","BPSOSRX8",53,0) S MOREDATA("RX ACTION")=$G(BWHERE) "RTN","BPSOSRX8",54,0) S MOREDATA("DATE OF SERVICE")=$P($G(BFILLDAT),".",1) "RTN","BPSOSRX8",55,0) S MOREDATA("REVERSAL REASON")=$S($G(REVREAS)="":"UNKNOWN",1:$E($G(REVREAS),1,40)) "RTN","BPSOSRX8",56,0) S MOREDATA("DIVISION")=$G(BPSITE) "RTN","BPSOSRX8",57,0) I $G(DURREC)]"" S MOREDATA("DUR",1,0)=DURREC "RTN","BPSOSRX8",58,0) I $G(BPOVRIEN)]"" S MOREDATA("BPOVRIEN")=BPOVRIEN "RTN","BPSOSRX8",59,0) I $G(BPSCLARF)]"" S MOREDATA("BPSCLARF")=BPSCLARF "RTN","BPSOSRX8",60,0) I $TR($G(BPSAUTH),"^")]"" S MOREDATA("BPSAUTH")=BPSAUTH "RTN","BPSOSRX8",61,0) I $G(BPSDELAY)]"" S MOREDATA("BPSDELAY")=BPSDELAY "RTN","BPSOSRX8",62,0) Q "RTN","BPSOSRX8",63,0) ;====== Prepare ret. value "RTN","BPSOSRX8",64,0) ;return RESPONSE ^ CLMSTAT ^ Display= D ^ seconds to HANG "RTN","BPSOSRX8",65,0) RSPCLMS(BPREQTYP,RESPONSE,MOREDATA,BPADDINF) ; "RTN","BPSOSRX8",66,0) I BPREQTYP="C",RESPONSE=0 Q RESPONSE_U_$S($G(MOREDATA("ELIG"))="T":"TRICARE ",1:"")_"Prescription "_BRX_$S($G(MOREDATA("ELIG"))="T":"",1:" successfully")_" submitted to ECME for claim generation.^D^" "RTN","BPSOSRX8",67,0) I BPREQTYP="C",RESPONSE>0 Q RESPONSE_U_"No claim submission made: "_$S($G(BPADDINF)'="":BPADDINF,1:"Unable to queue claim submission.")_"^D" "RTN","BPSOSRX8",68,0) I BPREQTYP="U",RESPONSE=0 Q RESPONSE_U_"Reversing prescription "_BRX_".^D^2" "RTN","BPSOSRX8",69,0) I BPREQTYP="U",RESPONSE>0 Q RESPONSE_U_"No claim submission made. Unable to queue reversal.^D^2" "RTN","BPSOSRX8",70,0) I BPREQTYP="UC",RESPONSE=10 Q RESPONSE_U_$S($G(MOREDATA("ELIG"))="T":"TRICARE ",1:"")_"Prescription "_BRX_$S($G(MOREDATA("ELIG"))="T":"",1:" successfully")_" submitted to ECME for claim reversal.^D^" "RTN","BPSOSRX8",71,0) I BPREQTYP="UC",RESPONSE=0 Q RESPONSE_U_$S($G(MOREDATA("ELIG"))="T":"TRICARE ",1:"")_"Prescription "_BRX_$S($G(MOREDATA("ELIG"))="T":"",1:" successfully")_" submitted to ECME for claim generation.^D^" "RTN","BPSOSRX8",72,0) I BPREQTYP="UC",RESPONSE>0,RESPONSE'=10 Q RESPONSE_U_"No claim submission made: "_$S($G(BPADDINF)'="":BPADDINF,1:"Unable to queue claim submission.")_"^D" "RTN","BPSOSRX8",73,0) Q "" "RTN","BPSOSRX8",74,0) ; "RTN","BPSOSRX8",75,0) SENDBUL(RESPONSE,BWHERE,BRXIEN,BFILL,SITE,DFN,PNAME,BPSERTXT,BPSRESP) ; "RTN","BPSOSRX8",76,0) ; if RESPONSE=4 (Unable to queue claim) "RTN","BPSOSRX8",77,0) ; and "RTN","BPSOSRX8",78,0) ; If not OP, then send an email to the OPECC "RTN","BPSOSRX8",79,0) I RESPONSE=4,",AREV,BB,ERES,EREV,"'[(","_BWHERE_",") D BULL^BPSNCPD1(BRXIEN,BFILL,$G(SITE),$G(DFN),$G(PNAME),,$G(BPSERTXT),$G(BPSRESP)) "RTN","BPSOSRX8",80,0) Q "RTN","BPSOSS8") 0^41^B2236526 "RTN","BPSOSS8",1,0) BPSOSS8 ;BHAM ISC/FCS/DRS/FLS - Edit Basic ECME Parameters ;03/07/08 14:09 "RTN","BPSOSS8",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSS8",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSS8",4,0) ; "RTN","BPSOSS8",5,0) EN ;EP - Option BPS SETUP BASIC PARAMS "RTN","BPSOSS8",6,0) N DIE,DA,DR,DTOUT "RTN","BPSOSS8",7,0) W !!,"Edit Pharmacy ECME configuration",! "RTN","BPSOSS8",8,0) ; "RTN","BPSOSS8",9,0) ; If the BPS Setup record is not created, create it. "RTN","BPSOSS8",10,0) ; Quit if there is an error. "RTN","BPSOSS8",11,0) D VERSION^BPSJINIT "RTN","BPSOSS8",12,0) ; "RTN","BPSOSS8",13,0) ; Check for errors "RTN","BPSOSS8",14,0) I '$D(^BPS(9002313.99,1,0)) D Q "RTN","BPSOSS8",15,0) . W !!,"BPS Setup not defined and can not be created. Quitting." "RTN","BPSOSS8",16,0) ; "RTN","BPSOSS8",17,0) ; Prompts and input "RTN","BPSOSS8",18,0) S DA=1 "RTN","BPSOSS8",19,0) S DIE=9002313.99 "RTN","BPSOSS8",20,0) S DR="3.01ECME timeout? (0 to 30 seconds)//10;.05Insurer Asleep Interval (0 to 29 minutes): //20;.06Insurer Asleep Retries (0 to 99): //10;.08Default Eligibility Pharmacy:" "RTN","BPSOSS8",21,0) D ^DIE "RTN","BPSOSS8",22,0) Q "RTN","BPSOSS8",23,0) ; "RTN","BPSOSSG") 0^48^B29948946 "RTN","BPSOSSG",1,0) BPSOSSG ;BHAM ISC/SD/lwj/FLS - Special gets for formats ;06/01/2004 "RTN","BPSOSSG",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSOSSG",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSSG",4,0) ; "RTN","BPSOSSG",5,0) Q "RTN","BPSOSSG",6,0) ; "RTN","BPSOSSG",7,0) FLD420 ; Submission Clarification Code "RTN","BPSOSSG",8,0) ; place fields 354 and 420 into BPS CLAIMS "RTN","BPSOSSG",9,0) ; called by SET CODE in BPS NCPDPD FIELD DEFS for field 420 "RTN","BPSOSSG",10,0) ; "RTN","BPSOSSG",11,0) Q:'$G(BPS(9002313.0201)) ; must have entry IEN "RTN","BPSOSSG",12,0) ; "RTN","BPSOSSG",13,0) N BPSCNTR,CNT,FDA,MSG,FLDIEN,SCC,I "RTN","BPSOSSG",14,0) K BPS(9002313.0354) ; results from UPDATE^DIE "RTN","BPSOSSG",15,0) S FLDIEN=$O(^BPSF(9002313.91,"B",420,"")) ;Get IEN for field 420 from NCPDP BPS FIELD DEFS "RTN","BPSOSSG",16,0) ; Are there overrides? "RTN","BPSOSSG",17,0) I $G(FLDIEN),$D(BPS("OVERRIDE","RX",BPS(9002313.0201),FLDIEN)) D "RTN","BPSOSSG",18,0) . K BPS("RX",BPS(9002313.0201),"Submission Clarif Code") "RTN","BPSOSSG",19,0) . S SCC=BPS("OVERRIDE","RX",BPS(9002313.0201),FLDIEN) "RTN","BPSOSSG",20,0) . F I=1:1:$S($G(BPS("NCPDP","Version"))="51":1,1:3) S BPS("RX",BPS(9002313.0201),"Submission Clarif Code",I)=$P(SCC,"~",I) "RTN","BPSOSSG",21,0) Q:'$O(BPS("RX",BPS(9002313.0201),"Submission Clarif Code",0)) ; no values found "RTN","BPSOSSG",22,0) S (CNT,BPSCNTR)=0 "RTN","BPSOSSG",23,0) F S CNT=$O(BPS("RX",BPS(9002313.0201),"Submission Clarif Code",CNT)) Q:'CNT D "RTN","BPSOSSG",24,0) .I BPS("RX",BPS(9002313.0201),"Submission Clarif Code",CNT)="" Q "RTN","BPSOSSG",25,0) .S BPSCNTR=BPSCNTR+1 ; ien for (#354.01) SUBMISSION CLARIFICATION MLTPL "RTN","BPSOSSG",26,0) .S FDA(9002313.02354,"+"_BPSCNTR_","_BPS(9002313.0201)_","_BPS(9002313.02)_",",.01)=BPSCNTR "RTN","BPSOSSG",27,0) .; 420-DK Submission Clarification Code "RTN","BPSOSSG",28,0) .S FDA(9002313.02354,"+"_BPSCNTR_","_BPS(9002313.0201)_","_BPS(9002313.02)_",",420)="DK"_$$NFF^BPSECFM(BPS("RX",BPS(9002313.0201),"Submission Clarif Code",CNT),2) "RTN","BPSOSSG",29,0) ; "RTN","BPSOSSG",30,0) I BPSCNTR D UPDATE^DIE("","FDA","BPS(9002313.0354)","MSG") "RTN","BPSOSSG",31,0) I $D(MSG) D Q ; if error, log it and quit "RTN","BPSOSSG",32,0) .D LOG2CLM^BPSOSL(BPS(9002313.02),$T(+0)_"-Failed to update NCPDP field 420") "RTN","BPSOSSG",33,0) .D LOGARAY2^BPSOSL(BPS(9002313.02),"MSG") "RTN","BPSOSSG",34,0) ; "RTN","BPSOSSG",35,0) ; 354-NX Submission Clarification Code Count "RTN","BPSOSSG",36,0) I BPSCNTR S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),350),U,4)="NX"_$$NFF^BPSECFM(BPSCNTR,1) "RTN","BPSOSSG",37,0) ; "RTN","BPSOSSG",38,0) Q "RTN","BPSOSSG",39,0) ; "RTN","BPSOSSG",40,0) FLD439 ;Reason for service code "RTN","BPSOSSG",41,0) ;Called by SET logic in BPS NCPDP Field DEFS for field 439 "RTN","BPSOSSG",42,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",43,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,2)=BPS("X") "RTN","BPSOSSG",44,0) Q "RTN","BPSOSSG",45,0) ; "RTN","BPSOSSG",46,0) FLD440 ;Professional Service Code "RTN","BPSOSSG",47,0) ;Called by set logic in BPS NCPDP Field DEFS for field 440 "RTN","BPSOSSG",48,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",49,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,3)=BPS("X") "RTN","BPSOSSG",50,0) Q "RTN","BPSOSSG",51,0) ; "RTN","BPSOSSG",52,0) FLD441 ;Result of Service Code "RTN","BPSOSSG",53,0) ;Called by SET logic in BPS NCPDP Field DEFS for field 441 "RTN","BPSOSSG",54,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",55,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,4)=BPS("X") "RTN","BPSOSSG",56,0) Q "RTN","BPSOSSG",57,0) ; "RTN","BPSOSSG",58,0) FLD473 ;DUR/PPS code counter - called from SET logic in BPS NCPDP Field Defs "RTN","BPSOSSG",59,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",60,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,1)=BPS("X") "RTN","BPSOSSG",61,0) S ^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,"B",BPS("X"),DUR)="" "RTN","BPSOSSG",62,0) Q "RTN","BPSOSSG",63,0) ; "RTN","BPSOSSG",64,0) FLD474 ;DUR/PPS level of effort - called from set logic in BPS NCPDP Field "RTN","BPSOSSG",65,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",66,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,5)=BPS("X") "RTN","BPSOSSG",67,0) Q "RTN","BPSOSSG",68,0) ; "RTN","BPSOSSG",69,0) FLD475 ;DUR Co-agent ID Qualifier - called from set logic in BPS NCPDP Field "RTN","BPSOSSG",70,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",71,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,6)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "RTN","BPSOSSG",72,0) Q "RTN","BPSOSSG",73,0) ; "RTN","BPSOSSG",74,0) FLD476 ;DUR Co-agent ID - called from set logic in BPS NCPDP Field "RTN","BPSOSSG",75,0) ;DUR is newed/set in BPSOSHF "RTN","BPSOSSG",76,0) S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),473.01,DUR,0),U,7)=$S($G(BPS("NCPDP","Version"))=51:BPS("X"),1:"") "RTN","BPSOSSG",77,0) Q "RTN","BPSOSSG",78,0) ; "RTN","BPSOSSG",79,0) FLD480 ; Other Amount Claimed Submitted field "RTN","BPSOSSG",80,0) ; Called by set logic in BPS NCPDP Field DEFS for field 480 "RTN","BPSOSSG",81,0) ; Sets fields 478, 479, and 480 into BPS Claims "RTN","BPSOSSG",82,0) ; 479-H8 Other Amount Claimed Submitted Qualifier "RTN","BPSOSSG",83,0) ; 480-H9 Other Amount Claimed Submitted "RTN","BPSOSSG",84,0) ; "RTN","BPSOSSG",85,0) Q:'$G(BPS(9002313.0201)) ; must have entry IEN "RTN","BPSOSSG",86,0) Q:'$O(BPS("Insurer","Other Amt Value",0)) ; nothing to do "RTN","BPSOSSG",87,0) ; "RTN","BPSOSSG",88,0) N BPSCNTR,CNT,FDA,MSG "RTN","BPSOSSG",89,0) K BPS(9002313.0601) ; results from UPDATE^DIE "RTN","BPSOSSG",90,0) S (CNT,BPSCNTR)=0 "RTN","BPSOSSG",91,0) F S CNT=$O(BPS("Insurer","Other Amt Value",CNT)) Q:'CNT D "RTN","BPSOSSG",92,0) . I +BPS("Insurer","Other Amt Value",CNT)=0 Q "RTN","BPSOSSG",93,0) . S BPSCNTR=BPSCNTR+1 ; ien for "PRICING REPEATING FIELDS SUB-FIELD^^480^3" "RTN","BPSOSSG",94,0) . S FDA(9002313.0601,"+"_BPSCNTR_","_BPS(9002313.0201)_","_BPS(9002313.02)_",",.01)=BPSCNTR "RTN","BPSOSSG",95,0) . S FDA(9002313.0601,"+"_BPSCNTR_","_BPS(9002313.0201)_","_BPS(9002313.02)_",",479)="H8"_$$ANFF^BPSECFM($G(BPS("Insurer","Other Amt Qual",CNT)),2) "RTN","BPSOSSG",96,0) . S FDA(9002313.0601,"+"_BPSCNTR_","_BPS(9002313.0201)_","_BPS(9002313.02)_",",480)="H9"_$$DFF^BPSECFM($G(BPS("Insurer","Other Amt Value",CNT)),8) "RTN","BPSOSSG",97,0) ; "RTN","BPSOSSG",98,0) I BPSCNTR D UPDATE^DIE("","FDA","BPS(9002313.0601)","MSG") "RTN","BPSOSSG",99,0) I $D(MSG) D Q "RTN","BPSOSSG",100,0) . D LOG2CLM^BPSOSL(BPS(9002313.02),$T(+0)_"-Failed to update NCPDP field 480 and/or 479") "RTN","BPSOSSG",101,0) . D LOGARAY2^BPSOSL(BPS(9002313.02),"MSG") "RTN","BPSOSSG",102,0) ; 478-H7 Other Amount Claimed Submitted Count "RTN","BPSOSSG",103,0) I BPSCNTR S $P(^BPSC(BPS(9002313.02),400,BPS(9002313.0201),470),U,8)="H7"_$$NFF^BPSECFM(BPSCNTR,1) "RTN","BPSOSSG",104,0) ; "RTN","BPSOSSG",105,0) Q "RTN","BPSOSSG",106,0) ; "RTN","BPSOSSG",107,0) EMPL ;Get employer info "RTN","BPSOSSG",108,0) ; This by GET logic in BPS NCPDP Field Defs for field 315 (Employer Name) "RTN","BPSOSSG",109,0) ; DMB 11/13/2006 - It makes some sense to only set these fields if "RTN","BPSOSSG",110,0) ; they exist on the payer sheet. However, it assumes that the "RTN","BPSOSSG",111,0) ; employer name field will always be before the other fields and "RTN","BPSOSSG",112,0) ; that the other fields will not exist without the Employer Name "RTN","BPSOSSG",113,0) ; field. For now, leave this be as these fields are on the "RTN","BPSOSSG",114,0) ; Worker's Comp segment, which we do not do. We may want to evaluate "RTN","BPSOSSG",115,0) ; if we were to ever add the Worker's Comp segment "RTN","BPSOSSG",116,0) Q:'$G(BPS("Patient","IEN")) "RTN","BPSOSSG",117,0) D GETS^DIQ(2,BPS("Patient","IEN"),".3111;.3112;.3113;.3115;.3116;.3117;.3118;.3119","","EMPL") "RTN","BPSOSSG",118,0) S BPS("Employer","Name")=EMPL(2,BPS("Patient","IEN")_",",.3111) "RTN","BPSOSSG",119,0) S:EMPL(2,BPS("Patient","IEN")_",",.3111)=""&(EMPL(2,BPS("Patient","IEN")_",",.3112)'="") BPS("Employer","Name")=EMPL(2,BPS("Patient","IEN")_",",.3112) "RTN","BPSOSSG",120,0) S BPS("Employer","Address")=EMPL(2,BPS("Patient","IEN")_",",.3113) "RTN","BPSOSSG",121,0) S BPS("Employer","City")=EMPL(2,BPS("Patient","IEN")_",",.3116) "RTN","BPSOSSG",122,0) S BPS("Employer","State")=EMPL(2,BPS("Patient","IEN")_",",.3117) "RTN","BPSOSSG",123,0) I BPS("Employer","State")'="" D "RTN","BPSOSSG",124,0) . S STATEIEN="",STATEIEN=$O(^DIC(5,"B",BPS("Employer","State"),STATEIEN)),BPS("Employer","State")=$P($G(^DIC(5,STATEIEN,0)),"^",2) "RTN","BPSOSSG",125,0) S BPS("Employer","Zip Code")=EMPL(2,BPS("Patient","IEN")_",",.3118) "RTN","BPSOSSG",126,0) S BPS("Employer","Phone")=EMPL(2,BPS("Patient","IEN")_",",.3119) "RTN","BPSOSSG",127,0) K EMPL,STATEIEN "RTN","BPSOSSG",128,0) Q "RTN","BPSOSSG",129,0) ; "RTN","BPSOSU") 0^39^B38973910 "RTN","BPSOSU",1,0) BPSOSU ;BHAM ISC/FCS/DRS/FLS - Common utilities ;06/01/2004 "RTN","BPSOSU",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSU",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSU",4,0) Q "RTN","BPSOSU",5,0) ; Common utilities called a lot. "RTN","BPSOSU",6,0) ; "RTN","BPSOSU",7,0) ; SETSTAT - set status field for ^BPST(IEN59, "RTN","BPSOSU",8,0) ; Input: "RTN","BPSOSU",9,0) ; IEN59 - BPS Transaction "RTN","BPSOSU",10,0) ; STATUS - Value to set into BPS Transaction "RTN","BPSOSU",11,0) SETSTAT(IEN59,STATUS) ; EP - from many places "RTN","BPSOSU",12,0) ; "RTN","BPSOSU",13,0) ; Lock the record - something is very wrong if you can't get the lock "RTN","BPSOSU",14,0) F L +^BPST(IEN59):300 Q:$T Q:'$$IMPOSS^BPSOSUE("L","RTI","LOCK +^BPST",,"SETSTAT",$T(+0)) "RTN","BPSOSU",15,0) N DIE,DA,DR,X "RTN","BPSOSU",16,0) S DIE=9002313.59,DA=IEN59,DR="1///"_STATUS_";7///NOW" ; Status and Last Update "RTN","BPSOSU",17,0) I STATUS=0 S DR=DR_";15///NOW" ; If Status is 0, init START TIME "RTN","BPSOSU",18,0) D ^DIE "RTN","BPSOSU",19,0) ; "RTN","BPSOSU",20,0) ; Verify that there no other statuses in the X-ref "RTN","BPSOSU",21,0) S X="" "RTN","BPSOSU",22,0) F S X=$O(^BPST("AD",X)) Q:X="" D "RTN","BPSOSU",23,0) . I X'=STATUS K ^BPST("AD",X,IEN59) "RTN","BPSOSU",24,0) I STATUS=99 D STATUS99(IEN59) "RTN","BPSOSU",25,0) L -^BPST(IEN59) "RTN","BPSOSU",26,0) Q "RTN","BPSOSU",27,0) ; "RTN","BPSOSU",28,0) ; STATUS99 - Special activity when a claim reaches status 99 "RTN","BPSOSU",29,0) ; Input: "RTN","BPSOSU",30,0) ; IEN59 - BPS Transaction IEN "RTN","BPSOSU",31,0) STATUS99(IEN59) ; "RTN","BPSOSU",32,0) N IEN77,BPS57,CLMSTAT,BPNXTREQ,BPSCLNOD,BPTYPE "RTN","BPSOSU",33,0) ; "RTN","BPSOSU",34,0) ; Get the current request "RTN","BPSOSU",35,0) S IEN77=+$$GETRQST^BPSUTIL2(IEN59) "RTN","BPSOSU",36,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Claim of the request "_IEN77_" has reached 99%") "RTN","BPSOSU",37,0) ; "RTN","BPSOSU",38,0) ; Create a copy in the BPS Log of Transaction "RTN","BPSOSU",39,0) S BPS57=$$NEW57(IEN59) "RTN","BPSOSU",40,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Created BPS Log of Transaction record "_BPS57) "RTN","BPSOSU",41,0) ; "RTN","BPSOSU",42,0) ; This data is needed when closing the claim later but needs to be "RTN","BPSOSU",43,0) ; read now since $$REQST99^BPSOSRX5 will delete the request as part "RTN","BPSOSU",44,0) ; of its processing "RTN","BPSOSU",45,0) S BPSCLNOD=$G(^BPS(9002313.77,IEN77,7)) "RTN","BPSOSU",46,0) S BPTYPE=$P($G(^BPS(9002313.77,IEN77,1)),U,4) "RTN","BPSOSU",47,0) ; "RTN","BPSOSU",48,0) ; Get status of the claim "RTN","BPSOSU",49,0) S CLMSTAT=$$CATEG^BPSOSUC(IEN59) "RTN","BPSOSU",50,0) S BPNXTREQ=$$REQST99^BPSOSRX5(IEN59,CLMSTAT) "RTN","BPSOSU",51,0) ; "RTN","BPSOSU",52,0) ; Check if the BPS Claim should be closed "RTN","BPSOSU",53,0) I +BPSCLNOD=1,$P(BPSCLNOD,U,2)>0 D "RTN","BPSOSU",54,0) . N BPSCLA,BPLCK,BPDROP,ERROR,DA,DR,DIE "RTN","BPSOSU",55,0) . I $$SUCCESS^BPSOSRX7(BPTYPE,CLMSTAT)=0 Q "RTN","BPSOSU",56,0) . I BPNXTREQ>0 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot close after reversal due to sequential requests in the queue") Q "RTN","BPSOSU",57,0) . D LOG^BPSOSL(IEN59,$T(+0)_"-Closing the claim after accepted reversal") "RTN","BPSOSU",58,0) . S BPSCLA=$$GET1^DIQ(9002313.59,IEN59,3,"I"),BPLCK=0,BPDROP="N" "RTN","BPSOSU",59,0) . L +^BPSC(BPSCLA):0 I '$T D Q "RTN","BPSOSU",60,0) . . D LOG^BPSOSL(IEN59,$T(+0)_"-Unable to close claim. Could not lock BPS CLAIMS file.") Q "RTN","BPSOSU",61,0) . D CLOSE^BPSBUTL(BPSCLA,IEN59,$P(^IBE(356.8,$P(BPSCLNOD,U,2),0),U),0,1,$P(BPSCLNOD,U,3),.ERROR) "RTN","BPSOSU",62,0) . I $D(ERROR) D Q "RTN","BPSOSU",63,0) . . D LOG^BPSOSL(IEN59,$T(+0)_"Unable to close Bill in IB. "_ERROR) "RTN","BPSOSU",64,0) . . L -^BPSC(BPSCLA) "RTN","BPSOSU",65,0) . S DIE="^BPSC(",DA=BPSCLA,DR="901///1;902///"_$$NOW^XLFDT()_";903////"_DUZ_";904///"_$P(BPSCLNOD,U,2)_";905////"_BPDROP D ^DIE "RTN","BPSOSU",66,0) . L -^BPSC(BPSCLA) "RTN","BPSOSU",67,0) . Q "RTN","BPSOSU",68,0) ; "RTN","BPSOSU",69,0) ; "RTN","BPSOSU",70,0) ; If claims completed normally, log its completion. "RTN","BPSOSU",71,0) ; Do not log error'ed or stranded claims as we don't want to show these in the "RTN","BPSOSU",72,0) ; turn-around stats "RTN","BPSOSU",73,0) ; Needed for Turn-Around Stats - Do NOT delete/alter!! "RTN","BPSOSU",74,0) I CLMSTAT'["E OTHER",CLMSTAT'["E UNSTRANDED",CLMSTAT'["E REVERSAL UNSTRANDED" D LOG^BPSOSL(IEN59,$T(+0)_"-Claim Complete") "RTN","BPSOSU",75,0) Q "RTN","BPSOSU",76,0) ; "RTN","BPSOSU",77,0) ; NEW57 - Copy the BPS Transaction into BPS Log of Transaction "RTN","BPSOSU",78,0) ; Input "RTN","BPSOSU",79,0) ; IEN59 - BPS Transaction "RTN","BPSOSU",80,0) ; Returns "RTN","BPSOSU",81,0) ; BPS Log of Transaction IEN "RTN","BPSOSU",82,0) NEW57(IEN59) ; "RTN","BPSOSU",83,0) F L +^BPSTL:300 Q:$T Q:'$$IMPOSS^BPSOSUE("L","RTI","LOCK ^BPSTL",,"NEW57",$T(+0)) "RTN","BPSOSU",84,0) ; "RTN","BPSOSU",85,0) ; Get next record number in BPS Log of Transactions "RTN","BPSOSU",86,0) NEW57A N N,C "RTN","BPSOSU",87,0) S N=$P(^BPSTL(0),U,3)+1 "RTN","BPSOSU",88,0) S C=$P(^BPSTL(0),U,4)+1 "RTN","BPSOSU",89,0) S $P(^BPSTL(0),U,3,4)=N_U_C "RTN","BPSOSU",90,0) I $D(^BPSTL(N)) G NEW57A ; should never happen "RTN","BPSOSU",91,0) L -^BPSTL "RTN","BPSOSU",92,0) ; "RTN","BPSOSU",93,0) ; Merge BPS Transaction into Log of Transactions "RTN","BPSOSU",94,0) M ^BPSTL(N)=^BPST(IEN59) "RTN","BPSOSU",95,0) ; "RTN","BPSOSU",96,0) ; Build fileman indices "RTN","BPSOSU",97,0) D "RTN","BPSOSU",98,0) . N DIK,DA S DIK="^BPSTL(",DA=N N N D IX1^DIK "RTN","BPSOSU",99,0) ; "RTN","BPSOSU",100,0) ; Quit with the new record number "RTN","BPSOSU",101,0) Q N "RTN","BPSOSU",102,0) ; "RTN","BPSOSU",103,0) ; ISREVES - Is this a reversal claim "RTN","BPSOSU",104,0) ; Input "RTN","BPSOSU",105,0) ; CLAIMIEN - Pointer to BPS Claims "RTN","BPSOSU",106,0) ; "RTN","BPSOSU",107,0) ; Return Value "RTN","BPSOSU",108,0) ; 1 - Reversal claim "RTN","BPSOSU",109,0) ; 0 - Not a reversal claim "RTN","BPSOSU",110,0) ISREVERS(CLAIM) ; "RTN","BPSOSU",111,0) Q $P($G(^BPSC(CLAIM,100)),"^",3)="B2" "RTN","BPSOSU",112,0) ; "RTN","BPSOSU",113,0) ; SETCSTAT - Set the status for every transaction associated with "RTN","BPSOSU",114,0) ; this claim "RTN","BPSOSU",115,0) SETCSTAT(CLAIM,STATUS) ; "RTN","BPSOSU",116,0) N IEN59,INDEX "RTN","BPSOSU",117,0) ; "RTN","BPSOSU",118,0) ; Determine correct index "RTN","BPSOSU",119,0) I $$ISREVERS(CLAIM) S INDEX="AER" "RTN","BPSOSU",120,0) E S INDEX="AE" "RTN","BPSOSU",121,0) ; "RTN","BPSOSU",122,0) ; Loop through the transactions and set the status "RTN","BPSOSU",123,0) S IEN59="" "RTN","BPSOSU",124,0) F S IEN59=$O(^BPST(INDEX,CLAIM,IEN59)) Q:IEN59="" D SETSTAT(IEN59,STATUS) "RTN","BPSOSU",125,0) Q "RTN","BPSOSU",126,0) ; "RTN","BPSOSU",127,0) ; ERROR - Handle any errors "RTN","BPSOSU",128,0) ; Log them into BPS Transactions "RTN","BPSOSU",129,0) ; Change status to 99 "RTN","BPSOSU",130,0) ; Update the LOG "RTN","BPSOSU",131,0) ; Increment the statistics "RTN","BPSOSU",132,0) ; We should be okay for the resubmit flag since the STATUS "RTN","BPSOSU",133,0) ; will be E OTHER instead of E REVERSAL ACCEPTED "RTN","BPSOSU",134,0) ; Input "RTN","BPSOSU",135,0) ; RTN - Routine reporting the error "RTN","BPSOSU",136,0) ; IEN59 - BPS Transaction "RTN","BPSOSU",137,0) ; ERROR - Error Number (goes in RESULT CODE) "RTN","BPSOSU",138,0) ; ERRTEXT - Error Text (goes in RESULT TEXT) "RTN","BPSOSU",139,0) ; "RTN","BPSOSU",140,0) ; To prevent conflicts, set the error number to the first digit of "RTN","BPSOSU",141,0) ; Status and a unique number for the status. "RTN","BPSOSU",142,0) ERROR(RTN,IEN59,ERROR,ERRTEXT) ; "RTN","BPSOSU",143,0) ; "RTN","BPSOSU",144,0) ; Check parameters "RTN","BPSOSU",145,0) I '$G(IEN59) Q "RTN","BPSOSU",146,0) I '$G(ERROR) S ERROR=0 "RTN","BPSOSU",147,0) I $G(ERRTEXT)="" S ERRTEXT="ERROR - see LOG" "RTN","BPSOSU",148,0) ; "RTN","BPSOSU",149,0) ; Set Error and Error Text in BPS Transaction "RTN","BPSOSU",150,0) D SETRESU(IEN59,ERROR,ERRTEXT) "RTN","BPSOSU",151,0) ; "RTN","BPSOSU",152,0) ; Log Message "RTN","BPSOSU",153,0) D LOG^BPSOSL(IEN59,RTN_" returned error - "_ERRTEXT) "RTN","BPSOSU",154,0) ; "RTN","BPSOSU",155,0) ; Update unbillable count in stats "RTN","BPSOSU",156,0) D INCSTAT^BPSOSUD("R",1) "RTN","BPSOSU",157,0) ; "RTN","BPSOSU",158,0) ; Update Status to complete "RTN","BPSOSU",159,0) D SETSTAT(IEN59,99) "RTN","BPSOSU",160,0) Q "RTN","BPSOSU",161,0) ; "RTN","BPSOSU",162,0) ; SETRESU - Set Result into ^BPST(IEN59,2) "RTN","BPSOSU",163,0) ; Input "RTN","BPSOSU",164,0) ; IEN59 - BPS Transaction IEN "RTN","BPSOSU",165,0) ; RESULT - Result Code "RTN","BPSOSU",166,0) ; TEXT - Result Text. Semi-colons (";") should not in the text data as "RTN","BPSOSU",167,0) ; this is used as a separator between current and previous text "RTN","BPSOSU",168,0) ; messages. If there is a semi-colon, it is converted to a dash. "RTN","BPSOSU",169,0) SETRESU(IEN59,RESULT,TEXT) ; "RTN","BPSOSU",170,0) ; "RTN","BPSOSU",171,0) ; First, store the Result Code "RTN","BPSOSU",172,0) S $P(^BPST(IEN59,2),U)=$G(RESULT) "RTN","BPSOSU",173,0) ; "RTN","BPSOSU",174,0) ; Second, store the Result Text "RTN","BPSOSU",175,0) ; Considerations: "RTN","BPSOSU",176,0) ; Convert any semi-colons to dashes "RTN","BPSOSU",177,0) ; Add semi-colon delimiter if needed "RTN","BPSOSU",178,0) ; Truncate data if needed "RTN","BPSOSU",179,0) I $G(TEXT)]"" D "RTN","BPSOSU",180,0) . N X "RTN","BPSOSU",181,0) . S TEXT=$TR(TEXT,";","-") "RTN","BPSOSU",182,0) . S X=$P(^BPST(IEN59,2),U,2,99) "RTN","BPSOSU",183,0) . I X]"",$E(X)'=";" S X=";"_X "RTN","BPSOSU",184,0) . S X=$E(TEXT_X,1,255-$L(RESULT)-1) "RTN","BPSOSU",185,0) . S $P(^BPST(IEN59,2),U,2)=X "RTN","BPSOSU",186,0) Q "RTN","BPSOSU",187,0) ; "RTN","BPSOSU",188,0) ; SETCRESU - set the result code for every transaction assoc'd with "RTN","BPSOSU",189,0) ; this claim. Note that this will only work for billing requests (B1) "RTN","BPSOSU",190,0) ; Input "RTN","BPSOSU",191,0) ; CLAIMIEN - BPS Claim IEN "RTN","BPSOSU",192,0) ; RESULT - Result Code "RTN","BPSOSU",193,0) ; TEXT - Result Text "RTN","BPSOSU",194,0) SETCRESU(CLAIM,RESULT,TEXT) ; "RTN","BPSOSU",195,0) N IEN59 "RTN","BPSOSU",196,0) S IEN59="" "RTN","BPSOSU",197,0) F S IEN59=$O(^BPST("AE",CLAIM,IEN59)) Q:IEN59="" D SETRESU(IEN59,RESULT,$G(TEXT)) "RTN","BPSOSU",198,0) Q "RTN","BPSOSU",199,0) ; "RTN","BPSOSU",200,0) ; STATI(X) gives a text version of what status code X means. "RTN","BPSOSU",201,0) ; For effeciency, put more common ones at the top. "RTN","BPSOSU",202,0) ; Also note that you should check the display on the stats screen if you "RTN","BPSOSU",203,0) ; modify any of these. "RTN","BPSOSU",204,0) STATI(X) ; "RTN","BPSOSU",205,0) I X=99 Q "Done" "RTN","BPSOSU",206,0) I X=60 Q "Transmitting" "RTN","BPSOSU",207,0) I X=0 Q "Waiting to start" "RTN","BPSOSU",208,0) I X=40 Q "Building the HL7 packet" "RTN","BPSOSU",209,0) I X=70 Q "Parsing response" "RTN","BPSOSU",210,0) I X=30 Q "Building the claim" "RTN","BPSOSU",211,0) I X=10 Q "Building the transaction" "RTN","BPSOSU",212,0) I X=90 Q "Processing response" "RTN","BPSOSU",213,0) I X=98 Q "Resubmitting" ; Used only by STATUS^BPSOSRX (Not stored in BPS Transactions) "RTN","BPSOSU",214,0) I X=50 Q "Preparing for transmit" "RTN","BPSOSU",215,0) I X=31 Q "Wait for retry (insurer asleep)" "RTN","BPSOSU",216,0) I X=80 Q "Waiting to process response" "RTN","BPSOSU",217,0) I X=-99 Q "Waiting for activation (scheduled)" ; Used only by STATUS^BPSOSRX (Not stored in BPS Transactions) "RTN","BPSOSU",218,0) I X=-98 Q "Cancelled" ; Used only by STATUS^BPSOSRX (Not stored in BPS Transactions) "RTN","BPSOSU",219,0) I X=-97 Q "Inactive" ; Used only by STATUS^BPSOSRX (Not stored in BPS Transactions) "RTN","BPSOSU",220,0) I X=-96 Q "Processing request" ; Used only by STATUS^BPSOSRX (Not stored in BPS Transactions) "RTN","BPSOSU",221,0) Q "?"_X_"?" "RTN","BPSOSUC") 0^40^B9012826 "RTN","BPSOSUC",1,0) BPSOSUC ;BHAM ISC/FCS/DRS/FLS - ECME utilities ;06/01/2004 "RTN","BPSOSUC",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSOSUC",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSOSUC",4,0) Q "RTN","BPSOSUC",5,0) ; CATEG returns the status of a Transaction or Log of Transaction "RTN","BPSOSUC",6,0) ; entry. It is used mainly by STATUS^BPSOSRX but is also "RTN","BPSOSUC",7,0) ; called by some other routines as well as computed fields of BPS Log "RTN","BPSOSUC",8,0) ; of Transactions and BPS Tranasctions "RTN","BPSOSUC",9,0) CATEG(N,WANTREV) ; "RTN","BPSOSUC",10,0) ; N - If decimal, IEN from BPS Transaction "RTN","BPSOSUC",11,0) ; - If integer, IEN from BPS Log of Transactions "RTN","BPSOSUC",12,0) ; $G(WANTREV) = true if you care about reversals "RTN","BPSOSUC",13,0) ; (that's the default if lookup is on IEN59) "RTN","BPSOSUC",14,0) ; $G(WANTREV) = false if you want to ignore reversals "RTN","BPSOSUC",15,0) ; (that's the default if lookup is on IEN57) "RTN","BPSOSUC",16,0) ; "RTN","BPSOSUC",17,0) ; Many routines rely on these exact return values; do not change them: "RTN","BPSOSUC",18,0) ; Return values: "RTN","BPSOSUC",19,0) ; For all submissions: "RTN","BPSOSUC",20,0) ; CORRUPT - Should never happen "RTN","BPSOSUC",21,0) ; "RTN","BPSOSUC",22,0) ; For Billing Requests: "RTN","BPSOSUC",23,0) ; E PAYABLE, E CAPTURED, E DUPLICATE, E REJECTED, E OTHER, and "RTN","BPSOSUC",24,0) ; E UNSTRANDED "RTN","BPSOSUC",25,0) ; "RTN","BPSOSUC",26,0) ; For Reversals: "RTN","BPSOSUC",27,0) ; E REVERSAL ACCEPTED, E REVERSAL REJECTED, E REVERSAL OTHER, and "RTN","BPSOSUC",28,0) ; E REVERSAL UNSTRANDED "RTN","BPSOSUC",29,0) ; "RTN","BPSOSUC",30,0) ; For Eligibility: "RTN","BPSOSUC",31,0) ; E ELIGIBILITY ACCEPTED, E ELIGIBILITY REJECTED, E ELIGIBILITY OTHER, and "RTN","BPSOSUC",32,0) ; E ELIGIBILITY UNSTRANDED "RTN","BPSOSUC",33,0) ; "RTN","BPSOSUC",34,0) I N<1 Q "" ; Should not happen "RTN","BPSOSUC",35,0) N FILENUM,RETVAL,CLAIM,RESP,X,RESP500,TRANTYPE,STAT,DISYS "RTN","BPSOSUC",36,0) S FILENUM=$S(N[".":9002313.59,1:9002313.57) "RTN","BPSOSUC",37,0) I '$D(WANTREV) S WANTREV=$S(FILENUM=9002313.57:0,FILENUM=9002313.59:1) "RTN","BPSOSUC",38,0) I '$$GET1^DIQ(FILENUM,N_",",.01) Q "CORRUPT" "RTN","BPSOSUC",39,0) S CLAIM=$$GET1^DIQ(FILENUM,N_",",3,"I") "RTN","BPSOSUC",40,0) S RESP=$$GET1^DIQ(FILENUM,N_",",4,"I") "RTN","BPSOSUC",41,0) S TRANTYPE=$$GET1^DIQ(FILENUM,N_",",19,"I") "RTN","BPSOSUC",42,0) S STAT=$$GET1^DIQ(FILENUM,N_",",202,"I") "RTN","BPSOSUC",43,0) ; Stranded statuses "RTN","BPSOSUC",44,0) I $P(STAT,";")="E REVERSAL UNSTRANDED" Q "E REVERSAL UNSTRANDED" "RTN","BPSOSUC",45,0) I $P(STAT,";")="E UNSTRANDED" Q "E UNSTRANDED" "RTN","BPSOSUC",46,0) I $P(STAT,";")="E ELIGIBILITY UNSTRANDED" Q "E ELIGIBILITY UNSTRANDED" "RTN","BPSOSUC",47,0) ; Eligibility Statuses "RTN","BPSOSUC",48,0) I TRANTYPE="E" D Q RETVAL "RTN","BPSOSUC",49,0) . I 'CLAIM!'RESP S RETVAL="E ELIGIBILITY OTHER" Q "RTN","BPSOSUC",50,0) . S RESP500=$$RESP500^BPSOSQ4(RESP,"I") "RTN","BPSOSUC",51,0) . S X=$$RESP1000^BPSOSQ4(RESP,1,"I") "RTN","BPSOSUC",52,0) . S RETVAL="E ELIGIBILITY " "RTN","BPSOSUC",53,0) . I RESP500="R"!(X="R") S RETVAL=RETVAL_"REJECTED" Q "RTN","BPSOSUC",54,0) . I RESP500="A",X="A" S RETVAL=RETVAL_"ACCEPTED" Q "RTN","BPSOSUC",55,0) . S RETVAL=RETVAL_"OTHER" "RTN","BPSOSUC",56,0) ; During a reversal/resubmit, you may get the next line between the reversal and "RTN","BPSOSUC",57,0) ; and the resubmit "RTN","BPSOSUC",58,0) I 'CLAIM S RETVAL="E OTHER" Q RETVAL "RTN","BPSOSUC",59,0) I WANTREV S X=$$GET1^DIQ(FILENUM,N_",",401,"I") I X D Q RETVAL "RTN","BPSOSUC",60,0) . S RESP=$$GET1^DIQ(FILENUM,N_",",402,"I") "RTN","BPSOSUC",61,0) . S RETVAL="E REVERSAL " "RTN","BPSOSUC",62,0) . I 'RESP S RETVAL=RETVAL_"OTHER" Q "RTN","BPSOSUC",63,0) . S RESP500=$$RESP500^BPSOSQ4(RESP,"I") "RTN","BPSOSUC",64,0) . S X=$$RESP1000^BPSOSQ4(RESP,1,"I") "RTN","BPSOSUC",65,0) . I RESP500="R"!(X="R") S RETVAL=RETVAL_"REJECTED" Q "RTN","BPSOSUC",66,0) . ; Treat Duplicate of Accepted Reversal ("S") as Accepted "RTN","BPSOSUC",67,0) . I RESP500="A",X="A"!(X="S") S RETVAL=RETVAL_"ACCEPTED" Q "RTN","BPSOSUC",68,0) . S RETVAL=RETVAL_"OTHER" "RTN","BPSOSUC",69,0) ; Response not received yet "RTN","BPSOSUC",70,0) I 'RESP S RETVAL="E OTHER" Q RETVAL "RTN","BPSOSUC",71,0) S RESP500=$$RESP500^BPSOSQ4(RESP,"I") "RTN","BPSOSUC",72,0) N POS S POS=$$GET1^DIQ(FILENUM,N_",",14) "RTN","BPSOSUC",73,0) S X=$$RESP1000^BPSOSQ4(RESP,POS,"I") "RTN","BPSOSUC",74,0) I X="P"!(X="DP") Q "E PAYABLE" "RTN","BPSOSUC",75,0) I X="D" Q "E DUPLICATE" ; SHOULD NEVER HAPPEN as of 02/06/2001 "RTN","BPSOSUC",76,0) I X="R" Q "E REJECTED" "RTN","BPSOSUC",77,0) I X="C"!(X="DC") Q "E CAPTURED" "RTN","BPSOSUC",78,0) ; 1000 indefinite, fall back to 500 "RTN","BPSOSUC",79,0) I RESP500="R" Q "E REJECTED" "RTN","BPSOSUC",80,0) Q "E OTHER" ; corrupt? "RTN","BPSPRRX3") 0^54^B196212053 "RTN","BPSPRRX3",1,0) BPSPRRX3 ;ALB/SS - ePharmacy secondary billing ;16-DEC-08 "RTN","BPSPRRX3",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**8,10**;JUN 2004;Build 27 "RTN","BPSPRRX3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSPRRX3",4,0) ; "RTN","BPSPRRX3",5,0) ;External reference to file 399.3 supported by IA 3822 "RTN","BPSPRRX3",6,0) ;External reference to $$INSUR^IBBAPI supported by IA 4419 "RTN","BPSPRRX3",7,0) ;External reference to $$PLANEPS^IBNCPDPU supported by IA 5572 "RTN","BPSPRRX3",8,0) ; "RTN","BPSPRRX3",9,0) PROMPTS(BPSPRARR) ; "RTN","BPSPRRX3",10,0) ;BPSPRARR - array to pass values determined earlier (if any) and to return user's input/corrections "RTN","BPSPRRX3",11,0) ;returns "RTN","BPSPRRX3",12,0) ; 1 = the data is correct "RTN","BPSPRRX3",13,0) ; -1 = the data is not correct - Do not create the claim "RTN","BPSPRRX3",14,0) ; "RTN","BPSPRRX3",15,0) ; Check paramters "RTN","BPSPRRX3",16,0) I $G(BPSPRARR("PRESCRIPTION"))="" Q -1 "RTN","BPSPRRX3",17,0) I $G(BPSPRARR("FILL NUMBER"))="" Q -1 "RTN","BPSPRRX3",18,0) I $G(BPSPRARR("FILL DATE"))="" Q -1 "RTN","BPSPRRX3",19,0) ; "RTN","BPSPRRX3",20,0) ; "RTN","BPSPRRX3",21,0) N BPQ,BPSQ,BPSPLAN,BPX,BPSDFLT,BPSSET,BPSDFN "RTN","BPSPRRX3",22,0) N BPSPIEN,BPSSET,BPCNT,BPSRJ,BPSPAID,RETV "RTN","BPSPRRX3",23,0) N BPRATTYP,BPSPDRJ,BPSPLNSL,BPX1,BPSFIEN,BPSPSARR,BPSPSHV "RTN","BPSPRRX3",24,0) ; "RTN","BPSPRRX3",25,0) S (BPQ,BPSQ)=0 "RTN","BPSPRRX3",26,0) ; "RTN","BPSPRRX3",27,0) ; Other Payer IEN defaults to 1 since we don't do tertiary "RTN","BPSPRRX3",28,0) S BPSPIEN=1 "RTN","BPSPRRX3",29,0) ; "RTN","BPSPRRX3",30,0) ; Get Primary BPS Transaction "RTN","BPSPRRX3",31,0) S BP59=$$IEN59^BPSOSRX(BPSPRARR("PRESCRIPTION"),BPSPRARR("FILL NUMBER"),1) "RTN","BPSPRRX3",32,0) ; "RTN","BPSPRRX3",33,0) ; Get/validate Patient DFN "RTN","BPSPRRX3",34,0) S BPSDFN=$P($G(^BPST(BP59,0)),U,6) "RTN","BPSPRRX3",35,0) I BPSDFN="" S BPSDFN=$$RXAPI1^BPSUTIL1(BPSPRARR("PRESCRIPTION"),2,"I") "RTN","BPSPRRX3",36,0) I BPSDFN="" Q -1 "RTN","BPSPRRX3",37,0) ; "RTN","BPSPRRX3",38,0) ; Validate and Display current COB fields "RTN","BPSPRRX3",39,0) I $$DISPSEC(BP59,BPSDFN,.BPSPRARR) "RTN","BPSPRRX3",40,0) ; "RTN","BPSPRRX3",41,0) S BPQ=0 "RTN","BPSPRRX3",42,0) I $G(BPSPRARR("PLAN"))=""!($G(BPSPRARR("RTYPE"))="")!($G(BPSPRARR("308-C8"))="") S BPQ=1 "RTN","BPSPRRX3",43,0) I BPSQ=0 F BPX=4,5 I $P($G(BPSPRARR("OTHER PAYER",BPSPIEN,0)),U,BPX)="" S BPQ=1 "RTN","BPSPRRX3",44,0) I BPQ=0,'$D(BPSPRARR("OTHER PAYER",BPSPIEN,"P")),'$D(BPSPRARR("OTHER PAYER",BPSPIEN,"R")) S BPQ=1 "RTN","BPSPRRX3",45,0) ; "RTN","BPSPRRX3",46,0) ; Prompt to continue or not "RTN","BPSPRRX3",47,0) W ! "RTN","BPSPRRX3",48,0) I BPQ=1 W !,"Required secondary claim information is missing. Enter all required information",! "RTN","BPSPRRX3",49,0) E S BPQ=$$YESNO^BPSSCRRS("Do you want to edit this Secondary Claim Information (Y/N)","N") Q:BPQ=-1 -1 G:BPQ=0 END "RTN","BPSPRRX3",50,0) ; "RTN","BPSPRRX3",51,0) ; Prompt for Secondary Insurance Plan "RTN","BPSPRRX3",52,0) W ! "RTN","BPSPRRX3",53,0) F D Q:BPSQ'=0 "RTN","BPSPRRX3",54,0) . S BPSPLAN=$$SELECTPL^BPSPRRX1(BPSDFN,$G(BPSPRARR("FILL DATE")),.BPSPLNSL,"SECONDARY INSURANCE POLICY",$G(BPSPRARR("PLAN"))) "RTN","BPSPRRX3",55,0) . I BPSPLAN=0 S BPSQ=-1 Q "RTN","BPSPRRX3",56,0) . I $P(BPSPLNSL(7),U)'=2 W !,"Must select a Secondary insurance plan." Q "RTN","BPSPRRX3",57,0) . S BPSPRARR("PLAN")=BPSPLAN "RTN","BPSPRRX3",58,0) . S BPSPRARR("INS NAME")=$P(BPSPLNSL(1),U,2) "RTN","BPSPRRX3",59,0) . S BPSPSHV=$$PAYSHTV(BPSPLAN) "RTN","BPSPRRX3",60,0) . S BPSQ=1 "RTN","BPSPRRX3",61,0) Q:BPSQ=-1 -1 "RTN","BPSPRRX3",62,0) ; "RTN","BPSPRRX3",63,0) ; Prompt for Rate Type and store in BPSPRARR("RTYPE") "RTN","BPSPRRX3",64,0) F S BPRATTYP=$$RATETYPE^BPSPRRX2($S($G(BPSPRARR("RTYPE"))]"":BPSPRARR("RTYPE"),1:8)) Q:BPRATTYP'="" "RTN","BPSPRRX3",65,0) I BPRATTYP=-1 Q -1 "RTN","BPSPRRX3",66,0) S BPSPRARR("RTYPE")=BPRATTYP "RTN","BPSPRRX3",67,0) ; "RTN","BPSPRRX3",68,0) ; Prompt for OTHER COVERAGE CODE "RTN","BPSPRRX3",69,0) S BPSSET="" D SET308(.BPSSET) "RTN","BPSPRRX3",70,0) S RETV=$$PROMPT("SRA"_U_BPSSET,"OTHER COVERAGE CODE: ",$G(BPSPRARR("308-C8")),"Indicate whether or not the patient has other insurance coverage") "RTN","BPSPRRX3",71,0) Q:RETV<0 -1 "RTN","BPSPRRX3",72,0) S BPSPRARR("308-C8")=RETV "RTN","BPSPRRX3",73,0) ; "RTN","BPSPRRX3",74,0) ; Prompt for OTHER PAYER ID "RTN","BPSPRRX3",75,0) S BPSDFLT=$P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,4) "RTN","BPSPRRX3",76,0) S RETV=$$PROMPT("FR"_U_"0:10:","OTHER PAYER ID",$G(BPSDFLT),"ID assigned to the payer") Q:RETV<0 -1 "RTN","BPSPRRX3",77,0) Q:RETV=-1 -1 "RTN","BPSPRRX3",78,0) S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,4)=RETV "RTN","BPSPRRX3",79,0) ; "RTN","BPSPRRX3",80,0) ; Prompt for OTHER PAYER DATE "RTN","BPSPRRX3",81,0) S BPSDFLT=$P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,5) "RTN","BPSPRRX3",82,0) S RETV=$$PROMPT("DR"_U_"","OTHER PAYER DATE",$$FMTE^XLFDT($G(BPSDFLT)),"Payment or denial date of the claim submitted to the other payer. Used for coordination of benefits.") "RTN","BPSPRRX3",83,0) Q:RETV=-1 -1 "RTN","BPSPRRX3",84,0) S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,5)=RETV "RTN","BPSPRRX3",85,0) ; "RTN","BPSPRRX3",86,0) ; Prompt for Paid Amount or Reject Codes "RTN","BPSPRRX3",87,0) S BPSSET="PAID:PAID AMOUNTS;REJECT:REJECT CODES" "RTN","BPSPRRX3",88,0) S BPSDFLT="" "RTN","BPSPRRX3",89,0) I $D(BPSPRARR("OTHER PAYER",BPSPIEN,"P")) S BPSDFLT="PAID AMOUNTS" "RTN","BPSPRRX3",90,0) I $D(BPSPRARR("OTHER PAYER",BPSPIEN,"R")) S BPSDFLT=$S(BPSDFLT="PAID AMOUNTS":"",1:"REJECT CODES") "RTN","BPSPRRX3",91,0) S BPSPDRJ=$$PROMPT("SRA"_U_BPSSET,"Edit Paid Amounts or Reject Codes (PAID AMOUNTS/REJECT CODES): ",BPSDFLT,"Edit the Paid Amounts or Reject Codes") "RTN","BPSPRRX3",92,0) Q:BPSPDRJ=-1 -1 "RTN","BPSPRRX3",93,0) ; "RTN","BPSPRRX3",94,0) ; Prompt to edit paid amounts "RTN","BPSPRRX3",95,0) D:BPSPDRJ="PAID" "RTN","BPSPRRX3",96,0) . ; Remove reject codes. "RTN","BPSPRRX3",97,0) . K BPSPRARR("OTHER PAYER",BPSPIEN,"R") "RTN","BPSPRRX3",98,0) . S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,7)="" "RTN","BPSPRRX3",99,0) . ; "RTN","BPSPRRX3",100,0) . K BPSPAID "RTN","BPSPRRX3",101,0) . S (BPCNT,BPX,BPQ)=0 "RTN","BPSPRRX3",102,0) . ; BPS NCPDP FIELD DEFS for field 342 codes "RTN","BPSPRRX3",103,0) . S BPSSET=$$GETCDLST(342,BPSPSHV) "RTN","BPSPRRX3",104,0) . F BPX1=0:1 S BPX=$O(BPSPRARR("OTHER PAYER",BPSPIEN,"P",BPX)) Q:'BPX D Q:BPQ=1 "RTN","BPSPRRX3",105,0) . . S BPSQUAL=$P(BPSPRARR("OTHER PAYER",BPSPIEN,"P",BPX,0),U,2) "RTN","BPSPRRX3",106,0) . . S BPSAMT=$P(BPSPRARR("OTHER PAYER",BPSPIEN,"P",BPX,0),U,1) "RTN","BPSPRRX3",107,0) . . S BPQ=$$ASKPAID(BPSSET,BPSQUAL,BPSAMT,.BPCNT,.BPSPAID) "RTN","BPSPRRX3",108,0) . ; "RTN","BPSPRRX3",109,0) . I 'BPQ F S BPQ=$$ASKPAID(BPSSET,"","",.BPCNT,.BPSPAID) Q:BPQ=1 "RTN","BPSPRRX3",110,0) . ; Enter update values into the BPSPRARR array "RTN","BPSPRRX3",111,0) . K BPSPRARR("OTHER PAYER",BPSPIEN,"P") "RTN","BPSPRRX3",112,0) . S BPX=0 F BPX1=0:1 S BPX=$O(BPSPAID(1,BPX)) Q:BPX="" D "RTN","BPSPRRX3",113,0) . . I $P(BPSPAID(1,BPX),U,2)="00" S $P(BPSPAID(1,BPX),U,2)=" " "RTN","BPSPRRX3",114,0) . . S BPSPRARR("OTHER PAYER",BPSPIEN,"P",BPX,0)=BPSPAID(1,BPX) "RTN","BPSPRRX3",115,0) . . ; "RTN","BPSPRRX3",116,0) . . ; Set the OTHER PAYER AMOUNT PAID COUNT "RTN","BPSPRRX3",117,0) . . S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,6)=BPX1 "RTN","BPSPRRX3",118,0) . Q "RTN","BPSPRRX3",119,0) ; "RTN","BPSPRRX3",120,0) ; Edit/add reject codes "RTN","BPSPRRX3",121,0) D:BPSPDRJ="REJECT" "RTN","BPSPRRX3",122,0) . ; Remove paid amounts on the prior claim. "RTN","BPSPRRX3",123,0) . K BPSPRARR("OTHER PAYER",BPSPIEN,"P") "RTN","BPSPRRX3",124,0) . S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,6)="" "RTN","BPSPRRX3",125,0) . ; "RTN","BPSPRRX3",126,0) . K BPSRJ "RTN","BPSPRRX3",127,0) . S (BPCNT,BPX)=0 "RTN","BPSPRRX3",128,0) . F BPX1=0:1 S BPX=$O(BPSPRARR("OTHER PAYER",BPSPIEN,"R",BPX)) Q:'BPX D Q:BPCNT>4 "RTN","BPSPRRX3",129,0) . . S BPCNT=BPCNT+1 I BPCNT>4 W !,"Maximum of 5 OTHER PAYER REJECT CODES reached." Q "RTN","BPSPRRX3",130,0) . . S BPSDFLT=BPSPRARR("OTHER PAYER",BPSPIEN,"R",BPX,0) "RTN","BPSPRRX3",131,0) . . S RETV=$$PROMPT("PO^9002313.93:AEMNQ","OTHER PAYER REJECT CODE",$G(BPSDFLT),"Enter the reject code returned by the previous payer") "RTN","BPSPRRX3",132,0) . . Q:RETV=-1 "RTN","BPSPRRX3",133,0) . . S BPSRJ(BPCNT)=$P(RETV,U,2) "RTN","BPSPRRX3",134,0) . I BPCNT<5 F S RETV=$$PROMPT("PO^9002313.93:AEMNQ","OTHER PAYER REJECT CODE","","Enter the reject code returned by the previous payer") Q:RETV=-1 D Q:BPCNT>4 "RTN","BPSPRRX3",135,0) . . S BPCNT=BPCNT+1 "RTN","BPSPRRX3",136,0) . . S BPSRJ(BPCNT)=$P(RETV,U,2) "RTN","BPSPRRX3",137,0) . . I BPCNT>4 W !,"Maximum of 5 OTHER PAYER REJECT CODES reached." "RTN","BPSPRRX3",138,0) . K BPSPRARR("OTHER PAYER",BPSPIEN,"R") "RTN","BPSPRRX3",139,0) . S BPX=0 F BPX1=0:1 S BPX=$O(BPSRJ(BPX)) Q:BPX="" D "RTN","BPSPRRX3",140,0) . . S BPSPRARR("OTHER PAYER",BPSPIEN,"R",BPX,0)=BPSRJ(BPX) "RTN","BPSPRRX3",141,0) . . ; Set the OTHER PAYER REJECT COUNT "RTN","BPSPRRX3",142,0) . . S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,7)=BPX1 "RTN","BPSPRRX3",143,0) . Q "RTN","BPSPRRX3",144,0) ; "RTN","BPSPRRX3",145,0) I '$D(BPSPRARR("OTHER PAYER",BPSPIEN,"P")),'$D(BPSPRARR("OTHER PAYER",BPSPIEN,"R")) W !,"No Paid Amounts or Reject Codes entered" Q -1 "RTN","BPSPRRX3",146,0) ; "RTN","BPSPRRX3",147,0) ; Default OTHER PAYER COVERAGE TYPE to PRIMARY "RTN","BPSPRRX3",148,0) S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,2)="01" "RTN","BPSPRRX3",149,0) ; "RTN","BPSPRRX3",150,0) ; Default OTHER PAYER ID QUALIFIER to BIN "RTN","BPSPRRX3",151,0) S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,3)="03" "RTN","BPSPRRX3",152,0) ; "RTN","BPSPRRX3",153,0) END ; Prompt to continue "RTN","BPSPRRX3",154,0) W ! "RTN","BPSPRRX3",155,0) I $$YESNO^BPSSCRRS("IS THIS CLAIM CORRECT?(Y/N)","Y")<1 Q -1 "RTN","BPSPRRX3",156,0) Q 1 "RTN","BPSPRRX3",157,0) ; "RTN","BPSPRRX3",158,0) ; "RTN","BPSPRRX3",159,0) ASKPAID(BPSSET,BPSQUAL,BPSAMT,BPCNT,BPSPAID) ; "RTN","BPSPRRX3",160,0) N RETV1,RETV2,BPSX,BPSPRA,BPSQ S BPSQ=0 "RTN","BPSPRRX3",161,0) I BPCNT>8 W !," Maximum of 9 OTHER PAYER AMOUNT PAID reached." Q 1 "RTN","BPSPRRX3",162,0) ASK1 S RETV1=$$PROMPT("SOA"_U_BPSSET,"OTHER PAYER AMOUNT PAID QUALIFIER: ",$G(BPSQUAL),"Type of payment from other sources (including coupons)") "RTN","BPSPRRX3",163,0) I RETV1=-1!(RETV1="") Q 1 "RTN","BPSPRRX3",164,0) I RETV1="08",$D(BPSPAID(2)) W !," Qualifier '08' cannot be entered with other qualifiers" G ASK1 "RTN","BPSPRRX3",165,0) S RETV2=$$PROMPT("NO"_U_"0:999999.99:2","OTHER PAYER AMOUNT PAID",$G(BPSAMT),"Amount of any payment from other sources (including coupons)") "RTN","BPSPRRX3",166,0) I RETV2=-1!(RETV2="") Q 1 "RTN","BPSPRRX3",167,0) ; Check for duplicate qualifiers and add Amount Paid to previous amount entered "RTN","BPSPRRX3",168,0) I $D(BPSPAID(2,RETV1)) D Q 0 "RTN","BPSPRRX3",169,0) . S BPSX="" F S BPSX=$O(BPSPAID(1,BPSX)) Q:BPSX="" D Q:BPSQ "RTN","BPSPRRX3",170,0) . . I $P(BPSPAID(1,BPSX),U,2)=RETV1 D "RTN","BPSPRRX3",171,0) . . . S BPSPRA=$P(BPSPAID(1,BPSX),U),$P(BPSPAID(1,BPSX),U)=BPSPRA+RETV2,BPSQ=1 "RTN","BPSPRRX3",172,0) . . . W !," $",$FN(RETV2,",",2)," has been added to amount $",$FN(BPSPRA,",",2)," for Qualifier ",RETV1 "RTN","BPSPRRX3",173,0) S BPCNT=BPCNT+1 "RTN","BPSPRRX3",174,0) S BPSPAID(1,BPCNT)=RETV2_U_RETV1 "RTN","BPSPRRX3",175,0) S BPSPAID(2,RETV1)="" "RTN","BPSPRRX3",176,0) I RETV1="08" Q 1 "RTN","BPSPRRX3",177,0) Q 0 "RTN","BPSPRRX3",178,0) ; "RTN","BPSPRRX3",179,0) DISPSEC(BP59,BPSDFN,BPSPRARR) ; "RTN","BPSPRRX3",180,0) ; Validate and Display the current secondary insurance information and prompt to edit. "RTN","BPSPRRX3",181,0) ; Return: 0 = Invalid data "RTN","BPSPRRX3",182,0) ; 1 = Valid data "RTN","BPSPRRX3",183,0) ; "RTN","BPSPRRX3",184,0) N BPSCOB,BPX,BPQ,BPSRET,BPSPIEN,BPSRESP,BPSOPDT,BPSINS,BPSSTAT,BPSCOV,BP592 "RTN","BPSPRRX3",185,0) ; Other Payer IEN defaults to 1 since we don't do tertiary "RTN","BPSPRRX3",186,0) S BPSPIEN=1 "RTN","BPSPRRX3",187,0) ; Get patient insurances "RTN","BPSPRRX3",188,0) S BPSRET=$$INSUR^IBBAPI($G(BPSDFN),$G(BPSPRARR("FILL DATE")),"E",.BPSINS,"1,7,8") "RTN","BPSPRRX3",189,0) ; Get the first Secondary insurance for default "RTN","BPSPRRX3",190,0) S (BPSCOB,BPSPRARR("PLAN"))="",(BPX,BPQ)=0 "RTN","BPSPRRX3",191,0) F S BPX=$O(BPSINS("IBBAPI","INSUR",BPX)) Q:'BPX D Q:BPQ "RTN","BPSPRRX3",192,0) . I $P(BPSINS("IBBAPI","INSUR",BPX,7),U)'=2 Q "RTN","BPSPRRX3",193,0) . S BPSPRARR("PLAN")=$P(BPSINS("IBBAPI","INSUR",BPX,8),U) "RTN","BPSPRRX3",194,0) . S BPSPRARR("INS NAME")=$P(BPSINS("IBBAPI","INSUR",BPX,1),U,2) "RTN","BPSPRRX3",195,0) . S BPSCOB="SECONDARY",BPQ=1 "RTN","BPSPRRX3",196,0) . Q "RTN","BPSPRRX3",197,0) S BPSRET=0 "RTN","BPSPRRX3",198,0) ; Get the Other Payer Date in internal format from the response "RTN","BPSPRRX3",199,0) S BPSOPDT="",BPSRESP=$P($G(^BPST(BP59,0)),U,5) "RTN","BPSPRRX3",200,0) I BPSRESP S BPSOPDT=($P($G(^BPSR(BPSRESP,0)),U,2))\1 "RTN","BPSPRRX3",201,0) ; Set array of Other Payer Data "RTN","BPSPRRX3",202,0) S BPSPRARR("337-4C")=1 "RTN","BPSPRRX3",203,0) S BPSPRARR("OTHER PAYER",BPSPIEN,0)="1^01^03^"_$G(BPSPRARR("BIN NUMBER"))_"^"_$G(BPSOPDT)_"^0^0" "RTN","BPSPRRX3",204,0) ; Get Rate Type for the Secondary Insurance "RTN","BPSPRRX3",205,0) S BP592=$$IEN59^BPSOSRX($G(BPSPRARR("PRESCRIPTION")),$G(BPSPRARR("FILL NUMBER")),2) "RTN","BPSPRRX3",206,0) S BPSPRARR("RTYPE")=$$GETRTP59^BPSPRRX5(BP592) "RTN","BPSPRRX3",207,0) I BPSPRARR("RTYPE")="" S BPSPRARR("RTYPE")=8 "RTN","BPSPRRX3",208,0) ; Get Coverage Code "RTN","BPSPRRX3",209,0) S BPSSTAT=$P($$STATUS^BPSOSRX($G(BPSPRARR("PRESCRIPTION")),$G(BPSPRARR("FILL NUMBER")),,,1),U) "RTN","BPSPRRX3",210,0) I $G(BPSPRARR("PRIOR PAYMENT"))>0 S BPSCOV="02 (OTHER COVERAGE EXISTS - PAYMENT COLLECTED)" "RTN","BPSPRRX3",211,0) E I BPSSTAT["E REJECTED" S BPSCOV="03 (OTHER COVERAGE EXISTS - THIS CLAIM NOT COVERED)" "RTN","BPSPRRX3",212,0) E S BPSCOV="04 (OTHER COVERAGE EXISTS - PAYMENT NOT COLLECTED)" "RTN","BPSPRRX3",213,0) S BPSPRARR("308-C8")=$P(BPSCOV," ",1) "RTN","BPSPRRX3",214,0) ; Write Data "RTN","BPSPRRX3",215,0) W !!,"Data for Secondary Claim" "RTN","BPSPRRX3",216,0) W !,"------------------------" "RTN","BPSPRRX3",217,0) W !,"Insurance: "_$G(BPSPRARR("INS NAME"))_" COB: "_BPSCOB "RTN","BPSPRRX3",218,0) W !,"Rate Type: "_$$GET1^DIQ(399.3,$G(BPSPRARR("RTYPE"))_",",.01,,,,) "RTN","BPSPRRX3",219,0) W !,"Other Coverage Code: "_BPSCOV "RTN","BPSPRRX3",220,0) W !,"Other Payer Coverage Type: 01 (PRIMARY)" "RTN","BPSPRRX3",221,0) W !,"Other Payer ID Qualifier: 03 (BANK INFORMATION NUMBER (BIN))" "RTN","BPSPRRX3",222,0) W !,"Other Payer ID: "_$G(BPSPRARR("BIN NUMBER")) "RTN","BPSPRRX3",223,0) W !,"Other Payer Date: "_$$FMTE^XLFDT($G(BPSOPDT)) "RTN","BPSPRRX3",224,0) ; Build/Write Paid Amounts if previous claim was paid "RTN","BPSPRRX3",225,0) K BPSPRARR("OTHER PAYER",BPSPIEN,"P") "RTN","BPSPRRX3",226,0) I BPSSTAT["E PAYABLE",BPSPRARR("PRIOR PAYMENT")]"" D "RTN","BPSPRRX3",227,0) . N BPARR,BPX D GETOPAP(BPSRESP,.BPARR) "RTN","BPSPRRX3",228,0) . S BPX=0 F S BPX=$O(BPARR(BPX)) Q:BPX="" D "RTN","BPSPRRX3",229,0) . . W !,"Other Payer Paid Qualifier: "_$P($G(BPARR(BPX)),U,2)_" ("_$$TRANCODE(342,$P($G(BPARR(BPX)),U,2))_")" "RTN","BPSPRRX3",230,0) . . S BPSPRARR("OTHER PAYER",BPSPIEN,"P",BPX,0)=BPARR(BPX) "RTN","BPSPRRX3",231,0) . . W !,"Other Payer Amount Paid: $"_$FN($P($G(BPARR(BPX)),U,1),",",2) "RTN","BPSPRRX3",232,0) . . S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,6)=BPX "RTN","BPSPRRX3",233,0) ; Build/Write Reject Codes if previous claims was rejected "RTN","BPSPRRX3",234,0) K BPSPRARR("OTHER PAYER",BPSPIEN,"R") "RTN","BPSPRRX3",235,0) I BPSSTAT["E REJECTED" D "RTN","BPSPRRX3",236,0) . N BPARR,BPX D GETRJCOD(BP59,.BPARR) "RTN","BPSPRRX3",237,0) . S BPX=0 F S BPX=$O(BPARR(BPX)) Q:BPX="" D "RTN","BPSPRRX3",238,0) . . W !,"Other Payer Reject Code: "_BPARR(BPX) "RTN","BPSPRRX3",239,0) . . S BPSPRARR("OTHER PAYER",BPSPIEN,"R",BPX,0)=$P(BPARR(BPX),":") "RTN","BPSPRRX3",240,0) . . S $P(BPSPRARR("OTHER PAYER",BPSPIEN,0),U,7)=BPX "RTN","BPSPRRX3",241,0) Q 1 "RTN","BPSPRRX3",242,0) ; "RTN","BPSPRRX3",243,0) PROMPT(ZERONODE,PRMTMSG,DFLTVAL,BPSHLP) ; "RTN","BPSPRRX3",244,0) ;prompts for selection "RTN","BPSPRRX3",245,0) ;returns selection "RTN","BPSPRRX3",246,0) ;OR -1 when timeout and uparrow "RTN","BPSPRRX3",247,0) ; "RTN","BPSPRRX3",248,0) N Y,DUOUT,DTOUT,BPQUIT,DIROUT "RTN","BPSPRRX3",249,0) N DIR "RTN","BPSPRRX3",250,0) S DIR(0)=ZERONODE "RTN","BPSPRRX3",251,0) S DIR("A")=PRMTMSG "RTN","BPSPRRX3",252,0) I BPSHLP]"" S DIR("?")=BPSHLP "RTN","BPSPRRX3",253,0) S:$L($G(DFLTVAL))>0 DIR("B")=DFLTVAL "RTN","BPSPRRX3",254,0) D ^DIR "RTN","BPSPRRX3",255,0) I (Y=-1)!$D(DIROUT)!$D(DUOUT)!$D(DTOUT) Q -1 "RTN","BPSPRRX3",256,0) Q Y "RTN","BPSPRRX3",257,0) ; "RTN","BPSPRRX3",258,0) GETCDLST(FLD,VERSION) ; Returns a list of codes by field/version for use in PROMPTS "RTN","BPSPRRX3",259,0) N FILE,CSUB,VSUB,ARRAY,BPSFIEN,IEN,X,BPSSET,BPSCD,BPSV,BPSOK "RTN","BPSPRRX3",260,0) S VERSION=$S(VERSION=5.1:51,VERSION=51:51,VERSION="D.0":"D0",VERSION="D0":"D0",1:"D0") "RTN","BPSPRRX3",261,0) S FILE=9002313.94,BPSSET="" "RTN","BPSPRRX3",262,0) S BPSFIEN=$O(^BPSF(9002313.91,"B",FLD,0)) "RTN","BPSPRRX3",263,0) Q:BPSFIEN="" BPSSET "RTN","BPSPRRX3",264,0) S IEN=$O(^BPS(FILE,"B",BPSFIEN,0)) "RTN","BPSPRRX3",265,0) Q:IEN="" BPSSET "RTN","BPSPRRX3",266,0) S BPSCD=0 F S BPSCD=$O(^BPS(FILE,IEN,1,BPSCD)) Q:BPSCD="" D "RTN","BPSPRRX3",267,0) . S (BPSOK,BPSV)=0 F S BPSV=$O(^BPS(FILE,IEN,1,BPSCD,1,BPSV)) Q:BPSV="" D Q:BPSOK "RTN","BPSPRRX3",268,0) . . I $P($G(^BPS(FILE,IEN,1,BPSCD,1,BPSV,0)),U)=VERSION S BPSOK=1 "RTN","BPSPRRX3",269,0) . I BPSOK S ARRAY(BPSCD)=$P(^BPS(FILE,IEN,1,BPSCD,0),U,1)_U_$P(^BPS(FILE,IEN,1,BPSCD,0),U,2) "RTN","BPSPRRX3",270,0) S X=0 F S X=$O(ARRAY(X)) Q:X="" D "RTN","BPSPRRX3",271,0) . S BPSSET=BPSSET_$P(ARRAY(X),U)_":"_$P(ARRAY(X),U,2)_";" "RTN","BPSPRRX3",272,0) Q BPSSET "RTN","BPSPRRX3",273,0) ; "RTN","BPSPRRX3",274,0) PAYSHTV(BPSPLAN) ;Get the Billing Payer Sheet version for this plan "RTN","BPSPRRX3",275,0) ; BPSPLAN = IEN to GROUP INSURANCE PLAN file #355.3 "RTN","BPSPRRX3",276,0) N BPSPSH,BPSBPSH "RTN","BPSPRRX3",277,0) ; Get Payer Sheets "RTN","BPSPRRX3",278,0) S BPSPSH=$$PLANEPS^IBNCPDPU(BPSPLAN) "RTN","BPSPRRX3",279,0) ; Get Billing Payer Sheet "RTN","BPSPRRX3",280,0) I +BPSPSH S BPSBPSH=$P($P(BPSPSH,"^",2),",") "RTN","BPSPRRX3",281,0) I $G(BPSBPSH)']"" Q "" "RTN","BPSPRRX3",282,0) Q $P(^BPSF(9002313.92,BPSBPSH,1),U,2) "RTN","BPSPRRX3",283,0) ; "RTN","BPSPRRX3",284,0) TRANCODE(FLD,CODE) ;CODE will be the incoming reason for NCPDP code "RTN","BPSPRRX3",285,0) N BPSFIEN,BPSDESC,BPSDIEN,IEN,FILE,CSUB,X,ARRAY "RTN","BPSPRRX3",286,0) S BPSDIEN=0 "RTN","BPSPRRX3",287,0) S BPSFIEN=$O(^BPSF(9002313.91,"B",FLD,0)) "RTN","BPSPRRX3",288,0) S IEN=$O(^BPS(9002313.94,"B",BPSFIEN,0)) "RTN","BPSPRRX3",289,0) S FILE=9002313.94,CSUB=9002313.941 "RTN","BPSPRRX3",290,0) D GETS^DIQ(FILE,IEN_",","**","IE","ARRAY") "RTN","BPSPRRX3",291,0) S X=0 F S X=$O(ARRAY(CSUB,X)) Q:X="" D "RTN","BPSPRRX3",292,0) . Q:ARRAY(CSUB,X,.01,"I")'=CODE "RTN","BPSPRRX3",293,0) . S BPSDESC=ARRAY(CSUB,X,1,"E") "RTN","BPSPRRX3",294,0) S:$G(BPSDESC)="" BPSDESC="Description not found for NCPDP field code" "RTN","BPSPRRX3",295,0) Q BPSDESC "RTN","BPSPRRX3",296,0) ; "RTN","BPSPRRX3",297,0) GETOPAP(BPSRESP,BPSDAT) ; Get the Other Payer Amount Paid values and qualifiers "RTN","BPSPRRX3",298,0) ; BPSRESP = IEN of BPS RESPONSE file "RTN","BPSPRRX3",299,0) ; BPSDAT(N)=Paid Amount^Qualifier "RTN","BPSPRRX3",300,0) I '$D(^BPSR(BPSRESP,1000)) Q "RTN","BPSPRRX3",301,0) N CNT,BPS509,BPS559,BPS558,BPS523,BPS563,BPS562,BPS521,BPSQUAL,BPSAMNT,BPSTAX,BPSOAP,BPSX "RTN","BPSPRRX3",302,0) S CNT=0 "RTN","BPSPRRX3",303,0) ; Set up D.0 fields for COB segment "RTN","BPSPRRX3",304,0) S BPS509=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,9)) "RTN","BPSPRRX3",305,0) ; If Total Amount Paid is a negative number, set it to zero. "RTN","BPSPRRX3",306,0) ; Zero Pay amount is allowed "RTN","BPSPRRX3",307,0) I BPS509<0 S BPS509=0 "RTN","BPSPRRX3",308,0) ; "RTN","BPSPRRX3",309,0) ; Cognitive Services Qualifier/Professional Service Fee Paid "RTN","BPSPRRX3",310,0) S BPS562=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,560)),U,2)) "RTN","BPSPRRX3",311,0) I BPS562<0 S BPS562=0 "RTN","BPSPRRX3",312,0) I +BPS562 S CNT=CNT+1,BPSDAT(CNT)=BPS562_U_"06" "RTN","BPSPRRX3",313,0) ; "RTN","BPSPRRX3",314,0) ; Incentive Qualifier/Incentive Amt Paid "RTN","BPSPRRX3",315,0) S BPS521=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,21)) "RTN","BPSPRRX3",316,0) I BPS521<0 S BPS521=0 "RTN","BPSPRRX3",317,0) I +BPS521 S CNT=CNT+1,BPSDAT(CNT)=BPS521_U_"05" "RTN","BPSPRRX3",318,0) ; Subtract Incentive Qualifier from Paid Amount for Drug Benefit "RTN","BPSPRRX3",319,0) S BPS509=BPS509-BPS521 "RTN","BPSPRRX3",320,0) ; "RTN","BPSPRRX3",321,0) ; Default all Tax values to zero for negative values "RTN","BPSPRRX3",322,0) S BPS559=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,550)),U,9)) ; Percentage Sales Tax Paid "RTN","BPSPRRX3",323,0) I BPS559<0 S BPS559=0 "RTN","BPSPRRX3",324,0) S BPS558=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,550)),U,8)) ; Flat Sales Tax Paid "RTN","BPSPRRX3",325,0) I BPS558<0 S BPS558=0 "RTN","BPSPRRX3",326,0) S BPS523=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,23)) ; Amount Attributed to Sales Tax "RTN","BPSPRRX3",327,0) I BPS523<0 S BPS523=0 "RTN","BPSPRRX3",328,0) ; "RTN","BPSPRRX3",329,0) ; Sales Tax Qualifier "RTN","BPSPRRX3",330,0) S BPSTAX=BPS559+BPS558-BPS523 "RTN","BPSPRRX3",331,0) I BPSTAX<0 S BPSTAX=0 "RTN","BPSPRRX3",332,0) I +BPSTAX S CNT=CNT+1,BPSDAT(CNT)=BPSTAX_U_"10" "RTN","BPSPRRX3",333,0) ; Subtract Sales Tax Qualifier from Paid Amount for Drug Benefit "RTN","BPSPRRX3",334,0) S BPS509=BPS509-BPSTAX "RTN","BPSPRRX3",335,0) ; "RTN","BPSPRRX3",336,0) ; Set OTHER AMOUNT PAID multiples "RTN","BPSPRRX3",337,0) S BPS563=0 F S BPS563=$O(^BPSR(BPSRESP,1000,1,563.01,BPS563)) Q:BPS563="" D "RTN","BPSPRRX3",338,0) . S BPSQUAL=$P($G(^BPSR(BPSRESP,1000,1,563.01,BPS563,1)),U,1) "RTN","BPSPRRX3",339,0) . ; Quit if qualifier = 99 since there is no NCPDP mapping for this qualifier "RTN","BPSPRRX3",340,0) . Q:BPSQUAL']""!(BPSQUAL=99) "RTN","BPSPRRX3",341,0) . S BPSAMNT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,563.01,BPS563,1)),U,2)) "RTN","BPSPRRX3",342,0) . ; Default negative amounts to zero "RTN","BPSPRRX3",343,0) . I BPSAMNT<0 S BPSAMNT=0 "RTN","BPSPRRX3",344,0) . I $D(BPSOAP(BPSQUAL)) S BPSOAP(BPSQUAL)=BPSOAP(BPSQUAL)+BPSAMNT "RTN","BPSPRRX3",345,0) . I '$D(BPSOAP(BPSQUAL)) S BPSOAP(BPSQUAL)=BPSAMNT "RTN","BPSPRRX3",346,0) . ; Subtract Amount if Qualifier is 01,02,03,04 or 09 "RTN","BPSPRRX3",347,0) . I "0102030409"[BPSQUAL S BPS509=BPS509-BPSAMNT "RTN","BPSPRRX3",348,0) I $D(BPSOAP) D "RTN","BPSPRRX3",349,0) . S BPSX="" F S BPSX=$O(BPSOAP(BPSX)) Q:BPSX="" D "RTN","BPSPRRX3",350,0) . . S CNT=CNT+1,BPSDAT(CNT)=BPSOAP(BPSX)_U_BPSX "RTN","BPSPRRX3",351,0) ; Set Drug Benefit Qualifier "RTN","BPSPRRX3",352,0) I BPS509<0 S BPS509=0 "RTN","BPSPRRX3",353,0) S CNT=CNT+1,BPSDAT(CNT)=BPS509_U_"07" "RTN","BPSPRRX3",354,0) Q "RTN","BPSPRRX3",355,0) ; Get Reject Codes "RTN","BPSPRRX3",356,0) GETRJCOD(BP59,BPARR1) ; "RTN","BPSPRRX3",357,0) N BP59DAT S BP59DAT=$G(^BPST(BP59,0)) "RTN","BPSPRRX3",358,0) N BPRESP,BPPOS,BPRAR,BPRCNT,BPRX,BPRJCOD,BPRJTXT,BPRJ,BPN1 "RTN","BPSPRRX3",359,0) ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59 "RTN","BPSPRRX3",360,0) ;get response and position "RTN","BPSPRRX3",361,0) I $$GRESPPOS^BPSSCRU3(BP59,.BPRESP,.BPPOS)=0 Q "RTN","BPSPRRX3",362,0) S (BPRCNT,BPRJ,BPN1)=0 "RTN","BPSPRRX3",363,0) F S BPRJ=$O(^BPSR(BPRESP,1000,BPPOS,511,BPRJ)) Q:+BPRJ=0 D Q:BPRCNT>4 "RTN","BPSPRRX3",364,0) . S BPRJCOD=$P($G(^BPSR(BPRESP,1000,BPPOS,511,BPRJ,0)),U) "RTN","BPSPRRX3",365,0) . Q:$L(BPRJCOD)=0 "RTN","BPSPRRX3",366,0) . S BPRJTXT=$$GETRJNAM^BPSSCRU3(BPRJCOD) "RTN","BPSPRRX3",367,0) . ; Remove Duplicate Reject Codes and only allow 5 max "RTN","BPSPRRX3",368,0) . S BPRCNT=BPRCNT+1,BPRAR(BPRJCOD)=BPRJTXT "RTN","BPSPRRX3",369,0) I $D(BPRAR) D "RTN","BPSPRRX3",370,0) . S BPRX="" F S BPRX=$O(BPRAR(BPRX)) Q:BPRX="" D "RTN","BPSPRRX3",371,0) . . S BPN1=BPN1+1,BPARR1(BPN1)=BPRAR(BPRX) "RTN","BPSPRRX3",372,0) Q "RTN","BPSPRRX3",373,0) ; "RTN","BPSPRRX3",374,0) ;because the set of codes is too long to fit the MUMPS code line - use a special code to populte set of codes "RTN","BPSPRRX3",375,0) SET308(BPSSET) ; "RTN","BPSPRRX3",376,0) N BPX,BPZ "RTN","BPSPRRX3",377,0) F BPX=2:1 S BPZ=$P($T(SET308C8+BPX),";;",2) Q:BPZ="" D "RTN","BPSPRRX3",378,0) . S BPSSET=BPSSET_$P(BPZ,U)_";" "RTN","BPSPRRX3",379,0) Q "RTN","BPSPRRX3",380,0) ; "RTN","BPSPRRX3",381,0) SET308C8 ;set of codes for 308-C8 "RTN","BPSPRRX3",382,0) ; set of codes "RTN","BPSPRRX3",383,0) ;;00:NOT SPECIFIED BY PATIENT "RTN","BPSPRRX3",384,0) ;;01:NO OTHER COVERAGE IDENTIFIED "RTN","BPSPRRX3",385,0) ;;02:OTHER COVERAGE EXISTS - PAYMENT COLLECTED "RTN","BPSPRRX3",386,0) ;;03:OTHER COVERAGE BILLED - CLAIM NOT COVERED "RTN","BPSPRRX3",387,0) ;;04:OTHER COVERAGE EXISTS - PAYMENT NOT COLLECTED "RTN","BPSPRRX3",388,0) ;;08:CLAIM IS BILLING FOR PATIENT FINANCIAL RESPONSIBILITY ONLY "RTN","BPSPRRX3",389,0) ;; "RTN","BPSPRRX3",390,0) ; "RTN","BPSPRRX3",391,0) ;BPSPRRX3 "RTN","BPSPRRX5") 0^69^B48238265 "RTN","BPSPRRX5",1,0) BPSPRRX5 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08 "RTN","BPSPRRX5",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**8,10**;JUN 2004;Build 27 "RTN","BPSPRRX5",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSPRRX5",4,0) ; "RTN","BPSPRRX5",5,0) ; "RTN","BPSPRRX5",6,0) ;select refill by fill date "RTN","BPSPRRX5",7,0) SELREFIL(BPSARR,BPSPRMPT,BPSMESS) ; "RTN","BPSPRRX5",8,0) N BPSSTR,BPSCNT,DIR,X,Y "RTN","BPSPRRX5",9,0) S BPX="" "RTN","BPSPRRX5",10,0) S BPSCNT=0 "RTN","BPSPRRX5",11,0) S DIR("A")=BPSPRMPT "RTN","BPSPRRX5",12,0) S DIR("L",1)=$G(BPSMESS) "RTN","BPSPRRX5",13,0) S DIR("L",2)="" "RTN","BPSPRRX5",14,0) S DIR("L",3)=" Fill Date" "RTN","BPSPRRX5",15,0) S DIR("L",4)=" ==== ==========" "RTN","BPSPRRX5",16,0) F S BPX=$O(BPSARR(BPX)) Q:BPX="" D "RTN","BPSPRRX5",17,0) . S BPSCNT=BPSCNT+1 "RTN","BPSPRRX5",18,0) . S $P(BPSSTR,";",BPSCNT)=BPX_":"_$$FMTE^XLFDT($P($G(BPSARR(BPX)),U,2),"5Z") "RTN","BPSPRRX5",19,0) . S DIR("L",BPSCNT+4)=" "_BPX_" "_$$FMTE^XLFDT($P($G(BPSARR(BPX)),U,2),"5Z") "RTN","BPSPRRX5",20,0) S DIR("L")=" " "RTN","BPSPRRX5",21,0) S DIR(0)="SO^"_BPSSTR "RTN","BPSPRRX5",22,0) D ^DIR "RTN","BPSPRRX5",23,0) I X="^" Q "-1^" "RTN","BPSPRRX5",24,0) I X="" Q "" "RTN","BPSPRRX5",25,0) Q BPSARR(+Y) "RTN","BPSPRRX5",26,0) ; "RTN","BPSPRRX5",27,0) ;check if there is any e-claim for this RX/refill "RTN","BPSPRRX5",28,0) ;BPSRXIEN-ien of file# 52 "RTN","BPSPRRX5",29,0) ;BPSREF-refill # "RTN","BPSPRRX5",30,0) ;BPCOBIND - payer sequence (1 -primary, 2- secondary) "RTN","BPSPRRX5",31,0) ;Return value "CODE ^ IEN59 ^ ECME STATUS ^ " "RTN","BPSPRRX5",32,0) ;where "RTN","BPSPRRX5",33,0) ;CODE is one of the following: "RTN","BPSPRRX5",34,0) ;0-not found "RTN","BPSPRRX5",35,0) ;1-payable "RTN","BPSPRRX5",36,0) ;2-not payable (rejected/reversed) "RTN","BPSPRRX5",37,0) ;3-in progress (including scheduled requests) "RTN","BPSPRRX5",38,0) ;IEN59 is ien of the BPS TRANSACTION "RTN","BPSPRRX5",39,0) ;ECME STATUS is the ECME claims status text like "E PAYABLE" "RTN","BPSPRRX5",40,0) ; "RTN","BPSPRRX5",41,0) FINDECLM(BPSRXIEN,BPSREF,BPCOBIND) ; "RTN","BPSPRRX5",42,0) N BPS59,BPSSTAT,BPPAYBLE "RTN","BPSPRRX5",43,0) S BPS59=+$$IEN59^BPSOSRX(BPSRXIEN,BPSREF,BPCOBIND) "RTN","BPSPRRX5",44,0) I +$G(^BPST(BPS59,0))=0 Q 0 "RTN","BPSPRRX5",45,0) S BPSSTAT=$P($$STATUS^BPSOSRX(BPSRXIEN,BPSREF,,,BPCOBIND),U) "RTN","BPSPRRX5",46,0) S BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT) "RTN","BPSPRRX5",47,0) I BPSSTAT["IN PROGRESS" Q 3_U_BPS59_U_BPSSTAT "RTN","BPSPRRX5",48,0) I BPPAYBLE=1 Q 1_U_BPS59_U_BPSSTAT "RTN","BPSPRRX5",49,0) I BPPAYBLE=0 Q 2_U_BPS59_U_BPSSTAT "RTN","BPSPRRX5",50,0) Q 0 "RTN","BPSPRRX5",51,0) ; "RTN","BPSPRRX5",52,0) ;Display e-claim details "RTN","BPSPRRX5",53,0) ;BPSIEN59-ien of the #9002313.59 BPS TRANSACTION file "RTN","BPSPRRX5",54,0) DISPECLM(BP59) ; "RTN","BPSPRRX5",55,0) W !,"Drug name NDC Date RX# FILL/ECME# TYPE STATUS" "RTN","BPSPRRX5",56,0) W !,"===============================================================================" "RTN","BPSPRRX5",57,0) W !,$$CLMINFO(BP59) "RTN","BPSPRRX5",58,0) Q "RTN","BPSPRRX5",59,0) ; "RTN","BPSPRRX5",60,0) CLMINFO(BP59) ; "RTN","BPSPRRX5",61,0) N BPX,BPX1,BPCOB,BPSSTAT,BPPAYBLE "RTN","BPSPRRX5",62,0) S BPCOB=$$COB59^BPSUTIL2(BP59) "RTN","BPSPRRX5",63,0) S BPX1=$$RXREF^BPSSCRU2(BP59) "RTN","BPSPRRX5",64,0) S BPX=$$LJ^BPSSCR02($$DRGNAME^BPSSCRU2(BP59),12)_" "_$$LJ^BPSSCR02($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),13)_" " "RTN","BPSPRRX5",65,0) S BPX=BPX_$$LJ^BPSSCR02($$FILLDATE^BPSSCRRS(+BPX1,+$P(BPX1,U,2)),5)_" " "RTN","BPSPRRX5",66,0) S BPX=BPX_$$LJ^BPSSCR02($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/" "RTN","BPSPRRX5",67,0) S BPX=BPX_$$LJ^BPSSCR02($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" " "RTN","BPSPRRX5",68,0) S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59) "RTN","BPSPRRX5",69,0) S BPSSTAT=$P($$STATUS^BPSOSRX(+BPX1,+$P(BPX1,U,2),,,BPCOB),U) "RTN","BPSPRRX5",70,0) S BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT) "RTN","BPSPRRX5",71,0) I BPPAYBLE Q BPX_" PAYABLE" "RTN","BPSPRRX5",72,0) I BPSSTAT["IN PROGRESS" Q BPX_" IN PROGRESS" "RTN","BPSPRRX5",73,0) I BPSSTAT["E REVERSAL ACCEPTED" Q BPX_" REVERSED" "RTN","BPSPRRX5",74,0) I BPSSTAT["E REJECTED" Q BPX_" REJECTED" "RTN","BPSPRRX5",75,0) Q BPX_" OTHER" "RTN","BPSPRRX5",76,0) ; "RTN","BPSPRRX5",77,0) ;get the plan (#355.3) from the BPS TRANSACTION file record "RTN","BPSPRRX5",78,0) GETPL59(BP59) ; "RTN","BPSPRRX5",79,0) Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),0)),U) "RTN","BPSPRRX5",80,0) ; "RTN","BPSPRRX5",81,0) ;get the RATE TYPE (#399.3) from the BPS TRANSACTION file record "RTN","BPSPRRX5",82,0) GETRTP59(BP59) ; "RTN","BPSPRRX5",83,0) Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),0)),U,8) "RTN","BPSPRRX5",84,0) ; "RTN","BPSPRRX5",85,0) ;get the primary bill (#399) from the BPS TRANSACTION file record "RTN","BPSPRRX5",86,0) GETBIL59(BP59) ; "RTN","BPSPRRX5",87,0) Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),2)),U,8) "RTN","BPSPRRX5",88,0) ; "RTN","BPSPRRX5",89,0) SELCOB(BPSPRMPT,BPSMESS) ; "RTN","BPSPRRX5",90,0) N DIR,X,Y "RTN","BPSPRRX5",91,0) S DIR("A")=BPSPRMPT "RTN","BPSPRRX5",92,0) S DIR(0)="SO^1:PRIMARY;2:SECONDARY" "RTN","BPSPRRX5",93,0) S DIR("L",1)=BPSMESS "RTN","BPSPRRX5",94,0) S DIR("L",2)="" "RTN","BPSPRRX5",95,0) S DIR("L",3)=" 1 PRIMARY" "RTN","BPSPRRX5",96,0) S DIR("L",4)=" 2 SECONDARY" "RTN","BPSPRRX5",97,0) S DIR("L")=" " "RTN","BPSPRRX5",98,0) D ^DIR "RTN","BPSPRRX5",99,0) I X="^" Q "-1^" "RTN","BPSPRRX5",100,0) Q +Y "RTN","BPSPRRX5",101,0) ; "RTN","BPSPRRX5",102,0) ;submit secondary claim if no primary bills or e-claim "RTN","BPSPRRX5",103,0) ;BPDISPPR - display bill information for "RTN","BPSPRRX5",104,0) ; "1" - primary "RTN","BPSPRRX5",105,0) ; "2" - secondary "RTN","BPSPRRX5",106,0) ; "1,2" - both "RTN","BPSPRRX5",107,0) ; "RTN","BPSPRRX5",108,0) ;Submission result (return value of EN^BPSNCPDP) "RTN","BPSPRRX5",109,0) ;Or one of the negative error codes: "RTN","BPSPRRX5",110,0) ; -100^Action cancelled "RTN","BPSPRRX5",111,0) ; -101^Existing e-claim "RTN","BPSPRRX5",112,0) ; -102^Claim in progress "RTN","BPSPRRX5",113,0) ; -103^Invalid or wrong bill# "RTN","BPSPRRX5",114,0) ; -104^Existing rejected/reversed e-claim "RTN","BPSPRRX5",115,0) ; -105^The same group plan selected "RTN","BPSPRRX5",116,0) ; -106^The primary insurer needs to be billed first. "RTN","BPSPRRX5",117,0) ; -107^Existing active bill "RTN","BPSPRRX5",118,0) SECNOPRM(BPSRX,BPSRF,BPSDOS,BPSDFN,BPDISPPR) ; "RTN","BPSPRRX5",119,0) N BPSBINFO,BPSRXCOB,BPSINIEN,BPPAYSEQ,BPSECLM,BP2NDBIL,BPSRET,BPSQ,BPY,BPYDEF "RTN","BPSPRRX5",120,0) N BPSPLNSL,BPSECOND,BPRET,BPENGINE,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR "RTN","BPSPRRX5",121,0) N BPRESUBM S BPRESUBM=0 ;default = original submission "RTN","BPSPRRX5",122,0) ;check if there is the secondary e-claim "RTN","BPSPRRX5",123,0) S BPSECLM=$$FINDECLM^BPSPRRX5(BPSRX,BPSRF,2) "RTN","BPSPRRX5",124,0) I +BPSECLM=3 Q "-102^Claim in progress" "RTN","BPSPRRX5",125,0) I +BPSECLM=1 Q "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting." "RTN","BPSPRRX5",126,0) S BPSQ=0 "RTN","BPSPRRX5",127,0) I +BPSECLM=2 D Q:BPSQ=1 "-100^Action cancelled" "RTN","BPSPRRX5",128,0) . D DISPECLM^BPSPRRX5(+$P(BPSECLM,U,2)) "RTN","BPSPRRX5",129,0) . W !!,"There is an existing rejected/reversed secondary e-claim(s) for the RX/refill." "RTN","BPSPRRX5",130,0) . I $$YESNO^BPSSCRRS("Do you want to submit a new secondary claim(Y/N)","N")=1 S BPRESUBM=1 "RTN","BPSPRRX5",131,0) . I BPRESUBM'=1 S BPSQ=1 "RTN","BPSPRRX5",132,0) ; if not found or if existing rejected/reversed claim then continue , otherwise - quit "RTN","BPSPRRX5",133,0) ;I +BPSECLM'=0 Q "-101^Existing e-claim" "RTN","BPSPRRX5",134,0) ;prepopulate COB fields if this is a resubmit "RTN","BPSPRRX5",135,0) I BPRESUBM=1 I $$RES2NDCL^BPSPRRX6($$IEN59^BPSOSRX(BPSRX,BPSRF,2),.BPSPL59,.BPSECOND,.BPRTTP59) "RTN","BPSPRRX5",136,0) ; "RTN","BPSPRRX5",137,0) D Q:+$P(BP2NDBIL,U,2)>0 "-107^Existing active secondary bill" "RTN","BPSPRRX5",138,0) . N BPSARR,BPS399,BPSCNT "RTN","BPSPRRX5",139,0) . ;check for the existing secondary bill "RTN","BPSPRRX5",140,0) . S BP2NDBIL=$$RXBILL^IBNCPUT3(BPSRX,BPSRF,"S",BPSDOS,.BPSARR) "RTN","BPSPRRX5",141,0) . I +BP2NDBIL=0 Q ;not found "RTN","BPSPRRX5",142,0) . S BPS399=0 "RTN","BPSPRRX5",143,0) . S BPSCNT=0 "RTN","BPSPRRX5",144,0) . F S BPS399=$O(BPSARR(BPS399)) Q:+BPS399=0 D "RTN","BPSPRRX5",145,0) . . N BPPSEQ "RTN","BPSPRRX5",146,0) . . S BPSCNT=BPSCNT+1 "RTN","BPSPRRX5",147,0) . . I $G(BPDISPPR)[2 D "RTN","BPSPRRX5",148,0) . . . W:BPSCNT=1 !!,"Secondary bill(s) found:" "RTN","BPSPRRX5",149,0) . . . S BPSRET=$P(BPSARR(BPS399),U,5) "RTN","BPSPRRX5",150,0) . . . S BPPSEQ=$S($P(BPSRET,U)="S":"Secondary",$P(BPSRET,U)="T":"Tertiary",$P(BPSRET,U)="P":"Primary",1:"Unknown") "RTN","BPSPRRX5",151,0) . . . D DISPBILL^BPSPRRX2(BPPSEQ,$P(BPSARR(BPS399),U,4),$P(BPSARR(BPS399),U,1),$P(BPSARR(BPS399),U,2),BPSRX,BPSRF,$P(BPSARR(BPS399),U,3),(BPSCNT=1)) "RTN","BPSPRRX5",152,0) . W ! "RTN","BPSPRRX5",153,0) ; "RTN","BPSPRRX5",154,0) ; check for ePharmacy secondary ins policy "RTN","BPSPRRX5",155,0) S BPYDEF="N" "RTN","BPSPRRX5",156,0) I '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS) D "RTN","BPSPRRX5",157,0) . S BPYDEF="Y" "RTN","BPSPRRX5",158,0) . W !!,"Unable to find a secondary insurance policy which is e-Pharmacy billable." "RTN","BPSPRRX5",159,0) . W !,"You must correct this in order to continue.",! "RTN","BPSPRRX5",160,0) . Q "RTN","BPSPRRX5",161,0) ; "RTN","BPSPRRX5",162,0) ;ask the user if he wants to jump to the BCN PATIENT INSURANCE option "RTN","BPSPRRX5",163,0) S BPY=$$YESNO^BPSSCRRS("DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT?(Y/N)",BPYDEF) "RTN","BPSPRRX5",164,0) I BPY=1 D EN1^IBNCPDPI(BPSDFN) "RTN","BPSPRRX5",165,0) I BPY=-1 Q "-100^Action cancelled" "RTN","BPSPRRX5",166,0) ; "RTN","BPSPRRX5",167,0) I '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS) Q "-115^No Secondary e-Pharmacy Insurance Policy." "RTN","BPSPRRX5",168,0) ; "RTN","BPSPRRX5",169,0) S BPSECOND("PRIMARY BILL")="" ;no primary bill "RTN","BPSPRRX5",170,0) ; Note: BPSECOND("PRIMARY BILL") will be populated by the following call "RTN","BPSPRRX5",171,0) S BPRET=$$PRIMDATA^BPSPRRX4($$IEN59^BPSOSRX(BPSRX,BPSRF,1),.BPSECOND,1,BPRESUBM) "RTN","BPSPRRX5",172,0) I BPRET=0 D GETFR52^BPSPRRX4(BPSRX,BPSRF,.BPSECOND) "RTN","BPSPRRX5",173,0) ; "RTN","BPSPRRX5",174,0) I $$PROMPTS^BPSPRRX3(.BPSECOND)=-1 Q "-100^Action cancelled" "RTN","BPSPRRX5",175,0) I $$YESNO^BPSSCRRS("SUBMIT CLAIM TO "_$G(BPSECOND("INS NAME"))_" ?(Y/N)","Y")=0 Q "-100^Action cancelled" "RTN","BPSPRRX5",176,0) I BPRESUBM=0 S BPSWHERE=$S(BPSRF>0:"RF",1:"OF") "RTN","BPSPRRX5",177,0) ;set the flag that indicates that we should use new COB data to resubmit the secondary claim , "RTN","BPSPRRX5",178,0) ;i.e. in BPSNCPDP the engine shouldn't use the COB data in BPS TRANSACTION for resubmit "RTN","BPSPRRX5",179,0) I BPRESUBM=1 S BPSECOND("NEW COB DATA")=1,BPSWHERE="ERES" "RTN","BPSPRRX5",180,0) S BPENGINE=$$SUBMCLM^BPSPRRX2(BPSECOND("PRESCRIPTION"),BPSECOND("FILL NUMBER"),BPSECOND("FILL DATE"),BPSWHERE,BPSECOND("BILLNDC"),2,BPSECOND("PLAN"),.BPSECOND,BPSECOND("RTYPE")) "RTN","BPSPRRX5",181,0) I +BPENGINE=4 W !!,$P(BPENGINE,U,2),! "RTN","BPSPRRX5",182,0) Q BPENGINE "RTN","BPSPRRX5",183,0) ;BPSPRRX5 "RTN","BPSPRRX6") 0^89^B57670037 "RTN","BPSPRRX6",1,0) BPSPRRX6 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08 "RTN","BPSPRRX6",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**8,10**;JUN 2004;Build 27 "RTN","BPSPRRX6",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSPRRX6",4,0) ; "RTN","BPSPRRX6",5,0) ; "RTN","BPSPRRX6",6,0) ;check if if prescription with given number exists "RTN","BPSPRRX6",7,0) ;BPSRX - RX# "RTN","BPSPRRX6",8,0) ;return: "RTN","BPSPRRX6",9,0) ; 1st piece - ien of #52 "RTN","BPSPRRX6",10,0) ; 2nd piece - ien of #2 "RTN","BPSPRRX6",11,0) ; -1 if "^" was entered "RTN","BPSPRRX6",12,0) RXINFO(BPSRX) ; "RTN","BPSPRRX6",13,0) N BPSDFN,BPS52,BPSRET "RTN","BPSPRRX6",14,0) ;prompt for the patient "RTN","BPSPRRX6",15,0) S BPSDFN=$$PROMPT^BPSSCRCV("P^DPT(","SELECT PATIENT") "RTN","BPSPRRX6",16,0) I BPSDFN=-1 Q -1 "RTN","BPSPRRX6",17,0) K ^TMP($J,"BPSPRRX") "RTN","BPSPRRX6",18,0) D RX^PSO52API(BPSDFN,"BPSPRRX",,BPSRX,"0") "RTN","BPSPRRX6",19,0) I +$G(^TMP($J,"BPSPRRX",BPSDFN,0))=-1 D Q 0 "RTN","BPSPRRX6",20,0) . W !,"Incorrect RX# or patient name entered.",! "RTN","BPSPRRX6",21,0) S BPSRET=+$O(^TMP($J,"BPSPRRX",BPSDFN,0))_U_BPSDFN "RTN","BPSPRRX6",22,0) K ^TMP($J,"BPSPRRX") "RTN","BPSPRRX6",23,0) Q BPSRET "RTN","BPSPRRX6",24,0) ;prompt for the fill# and do the rest "RTN","BPSPRRX6",25,0) RXREFIL(BPS52,BPSDFN,BPSRXNO) ; "RTN","BPSPRRX6",26,0) N BPSRF,BPSARR,BPSVAL,BPSELCTD,BPSRETV,BPORRFDT "RTN","BPSPRRX6",27,0) K ^TMP($J,"BPSPRRX") "RTN","BPSPRRX6",28,0) D RX^PSO52API(BPSDFN,"BPSPRRX",BPS52,,"R") "RTN","BPSPRRX6",29,0) I +$G(^TMP($J,"BPSPRRX",BPSDFN,BPS52,"RF",0))=0 Q 0 "RTN","BPSPRRX6",30,0) S BPSRF=0 "RTN","BPSPRRX6",31,0) F S BPSRF=$O(^TMP($J,"BPSPRRX",BPSDFN,BPS52,"RF",BPSRF)) Q:+BPSRF=0 D "RTN","BPSPRRX6",32,0) . S BPSVAL=$G(^TMP($J,"BPSPRRX",BPSDFN,BPS52,"RF",BPSRF,.01)) "RTN","BPSPRRX6",33,0) . S BPSARR(BPSRF)=BPSRF_U_$P(BPSVAL,U) "RTN","BPSPRRX6",34,0) ;original fill date "RTN","BPSPRRX6",35,0) S BPORRFDT=$$RXFLDT^PSOBPSUT(BPS52,0) "RTN","BPSPRRX6",36,0) S BPSARR(0)=0_U_BPORRFDT "RTN","BPSPRRX6",37,0) F S BPSELCTD=$$SELREFIL^BPSPRRX5(.BPSARR,"SELECT A FILL TO BILL","RX #"_BPSRXNO_" has the following fills:") Q:$P(BPSELCTD,U)'="" "RTN","BPSPRRX6",38,0) I BPSELCTD<0 Q -1 "RTN","BPSPRRX6",39,0) Q BPSELCTD "RTN","BPSPRRX6",40,0) ; "RTN","BPSPRRX6",41,0) ;restore BPSPLAN,BPSPRDAT,BPSRTYPE from BPS TRANSACTION file "RTN","BPSPRRX6",42,0) ;used for 2ndary claims only "RTN","BPSPRRX6",43,0) ;input: "RTN","BPSPRRX6",44,0) ; BP59 - ien of BPA TRANSACTION file of the SECONDARY claim "RTN","BPSPRRX6",45,0) ;output: "RTN","BPSPRRX6",46,0) ; BPSPLAN - plan, ien of #(355.3), by reference "RTN","BPSPRRX6",47,0) ; BPSPRDAT - array with 2ndary data, by reference "RTN","BPSPRRX6",48,0) ; BPSRTYPE - Rate Type, ien of #(399.3), by reference "RTN","BPSPRRX6",49,0) RESTOR59(BP59,BPSPLAN,BPSPRDAT,BPSRTYPE) ; "RTN","BPSPRRX6",50,0) ; Data from file 9002313.59 being saved into BPSPRDAT array "RTN","BPSPRRX6",51,0) N BP59PR,BPZ,BRXIEN,BFILL,BPSRESP "RTN","BPSPRRX6",52,0) S BPSPLAN=+$P($G(^BPST(BP59,10,1,0)),U,1) "RTN","BPSPRRX6",53,0) S BPSRTYPE=+$P($G(^BPST(BP59,10,1,0)),U,8) "RTN","BPSPRRX6",54,0) ; "RTN","BPSPRRX6",55,0) ; build array of COB secondary claim data from the BPS Transaction file - esg - 6/14/10 "RTN","BPSPRRX6",56,0) S BPSPRDAT("337-4C")=$P($G(^BPST(BP59,12)),U,4) ;1204 cob other payments count "RTN","BPSPRRX6",57,0) S BPSPRDAT("308-C8")=$P($G(^BPST(BP59,12)),U,5) ;1205 other coverage code "RTN","BPSPRRX6",58,0) ; "RTN","BPSPRRX6",59,0) ; build COB data array - esg - 6/14/10 "RTN","BPSPRRX6",60,0) N COBPIEN,APDIEN,REJIEN "RTN","BPSPRRX6",61,0) K BPSPRDAT("OTHER PAYER") "RTN","BPSPRRX6",62,0) S COBPIEN=0 F S COBPIEN=$O(^BPST(BP59,14,COBPIEN)) Q:'COBPIEN D "RTN","BPSPRRX6",63,0) . S BPSPRDAT("OTHER PAYER",COBPIEN,0)=$G(^BPST(BP59,14,COBPIEN,0)) "RTN","BPSPRRX6",64,0) . ; "RTN","BPSPRRX6",65,0) . ; retrieve data from other payer amount paid multiple "RTN","BPSPRRX6",66,0) . S APDIEN=0 F S APDIEN=$O(^BPST(BP59,14,COBPIEN,1,APDIEN)) Q:'APDIEN D "RTN","BPSPRRX6",67,0) .. S BPSPRDAT("OTHER PAYER",COBPIEN,"P",APDIEN,0)=$G(^BPST(BP59,14,COBPIEN,1,APDIEN,0)) "RTN","BPSPRRX6",68,0) .. Q "RTN","BPSPRRX6",69,0) . ; "RTN","BPSPRRX6",70,0) . ; retrieve data from other payer reject multiple "RTN","BPSPRRX6",71,0) . S REJIEN=0 F S REJIEN=$O(^BPST(BP59,14,COBPIEN,2,REJIEN)) Q:'REJIEN D "RTN","BPSPRRX6",72,0) .. S BPSPRDAT("OTHER PAYER",COBPIEN,"R",REJIEN,0)=$G(^BPST(BP59,14,COBPIEN,2,REJIEN,0)) "RTN","BPSPRRX6",73,0) .. Q "RTN","BPSPRRX6",74,0) . Q "RTN","BPSPRRX6",75,0) ; "RTN","BPSPRRX6",76,0) S BPSPRDAT("BILLNDC")=$P($G(^BPST(BP59,1)),U,2) "RTN","BPSPRRX6",77,0) S BPZ=$$RXREF^BPSSCRU2(BP59) "RTN","BPSPRRX6",78,0) S BRXIEN=+BPZ "RTN","BPSPRRX6",79,0) S BFILL=+$P(BPZ,U,2) "RTN","BPSPRRX6",80,0) S BP59PR=$$IEN59^BPSOSRX(BRXIEN,BFILL,1) "RTN","BPSPRRX6",81,0) S BPSRESP=+$P($G(^BPST(BP59PR,0)),U,5) ;#4 RESPONSE "RTN","BPSPRRX6",82,0) S BPSPRDAT("PRIOR PAYMENT")=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,9)) "RTN","BPSPRRX6",83,0) Q "RTN","BPSPRRX6",84,0) ; "RTN","BPSPRRX6",85,0) SECBIL59(MOREDATA,IEN59) ; populate 2ndary billing fields in BPS TRANSACTION "RTN","BPSPRRX6",86,0) ; MOREDATA array filed into 9002313.59 "RTN","BPSPRRX6",87,0) N BPTYPE,BPSTIME,BPCOB "RTN","BPSPRRX6",88,0) N AMTIEN,BPIEN1,BPIEN2,BPZ5914,BPZ,BPZ1,BPZ2,OPAMT,OPAPQ,OPAYD,OPREJ,PIEN,REJIEN "RTN","BPSPRRX6",89,0) I +$G(IEN59)=0 Q "RTN","BPSPRRX6",90,0) ; "RTN","BPSPRRX6",91,0) I $L($G(MOREDATA("337-4C"))) I $$FILLFLDS^BPSUTIL2(9002313.59,1204,IEN59,MOREDATA("337-4C"))<1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#1204) of (#9002313.59)") ; cob other payments count "RTN","BPSPRRX6",92,0) I $L($G(MOREDATA("308-C8"))) I $$FILLFLDS^BPSUTIL2(9002313.59,1205,IEN59,MOREDATA("308-C8"))<1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#1205) of (#9002313.59)") ; other coverage code "RTN","BPSPRRX6",93,0) ; "RTN","BPSPRRX6",94,0) ; store secondary billing related data entered by the user - esg 6/14/10 "RTN","BPSPRRX6",95,0) S BPQ=0 "RTN","BPSPRRX6",96,0) S PIEN=0 F S PIEN=$O(MOREDATA("OTHER PAYER",PIEN)) Q:'PIEN!BPQ D "RTN","BPSPRRX6",97,0) . S OPAYD=$G(MOREDATA("OTHER PAYER",PIEN,0)) Q:OPAYD="" "RTN","BPSPRRX6",98,0) . ; "RTN","BPSPRRX6",99,0) . ; count up the number of multiples we have in each set "RTN","BPSPRRX6",100,0) . S BPZ=0 F BPZ1=0:1 S BPZ=$O(MOREDATA("OTHER PAYER",PIEN,"P",BPZ)) Q:'BPZ "RTN","BPSPRRX6",101,0) . S BPZ=0 F BPZ2=0:1 S BPZ=$O(MOREDATA("OTHER PAYER",PIEN,"R",BPZ)) Q:'BPZ "RTN","BPSPRRX6",102,0) . I BPZ1,BPZ2 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot have both payments and rejects for the same OTHER PAYER.") Q "RTN","BPSPRRX6",103,0) . ; "RTN","BPSPRRX6",104,0) . ; add a new entry to subfile 9002313.5914 "RTN","BPSPRRX6",105,0) . S BPZ5914=$$INSITEM^BPSUTIL2(9002313.5914,IEN59,PIEN,PIEN,"",,0) "RTN","BPSPRRX6",106,0) . I BPZ5914<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Can't create entry in COB OTHER PAYERS multiple of the BPS TRANSACTION file") Q "RTN","BPSPRRX6",107,0) . ; "RTN","BPSPRRX6",108,0) . ; set the rest of the pieces at this level "RTN","BPSPRRX6",109,0) . I $P(OPAYD,U,2)'="" I $$FILLFLDS^BPSUTIL2(9002313.5914,.02,PIEN_","_IEN59,$P(OPAYD,U,2))<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.02) of (#9002313.5914)") Q "RTN","BPSPRRX6",110,0) . I $P(OPAYD,U,3)'="" I $$FILLFLDS^BPSUTIL2(9002313.5914,.03,PIEN_","_IEN59,$P(OPAYD,U,3))<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.03) of (#9002313.5914)") Q "RTN","BPSPRRX6",111,0) . I $P(OPAYD,U,4)'="" I $$FILLFLDS^BPSUTIL2(9002313.5914,.04,PIEN_","_IEN59,$P(OPAYD,U,4))<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.04) of (#9002313.5914)") Q "RTN","BPSPRRX6",112,0) . I $P(OPAYD,U,5)'="" I $$FILLFLDS^BPSUTIL2(9002313.5914,.05,PIEN_","_IEN59,$P(OPAYD,U,5))<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.05) of (#9002313.5914)") Q "RTN","BPSPRRX6",113,0) . I $$FILLFLDS^BPSUTIL2(9002313.5914,.06,PIEN_","_IEN59,BPZ1)<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.06) of (#9002313.5914)") Q "RTN","BPSPRRX6",114,0) . I $$FILLFLDS^BPSUTIL2(9002313.5914,.07,PIEN_","_IEN59,BPZ2)<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.07) of (#9002313.5914)") Q "RTN","BPSPRRX6",115,0) . ; "RTN","BPSPRRX6",116,0) . ; now loop thru the other payer payment array "RTN","BPSPRRX6",117,0) . S AMTIEN=0 F S AMTIEN=$O(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN)) Q:'AMTIEN!BPQ D "RTN","BPSPRRX6",118,0) .. S OPAMT=$G(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN,0)) "RTN","BPSPRRX6",119,0) .. S OPAPQ=$P(OPAMT,U,2) ; 342-HC other payer amt paid qualifier (ncpdp 5.1 blank is OK) "RTN","BPSPRRX6",120,0) .. S OPAMT=+OPAMT ; 431-DV other payer amt paid "RTN","BPSPRRX6",121,0) .. ; "RTN","BPSPRRX6",122,0) .. ; add a new entry to subfile 9002313.59141 "RTN","BPSPRRX6",123,0) .. S BPIEN1=$$INSITEM^BPSUTIL2(9002313.59141,PIEN_","_IEN59,OPAMT,AMTIEN,"",,0) "RTN","BPSPRRX6",124,0) .. I BPIEN1<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Can't create entry in 9002313.59141 subfile") Q "RTN","BPSPRRX6",125,0) .. ; "RTN","BPSPRRX6",126,0) .. ; set piece 2 "RTN","BPSPRRX6",127,0) .. I OPAPQ'="" I $$FILLFLDS^BPSUTIL2(9002313.59141,.02,AMTIEN_","_PIEN_","_IEN59,OPAPQ)<1 D "RTN","BPSPRRX6",128,0) ... S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot populate (#.02) of (#9002313.59141)") "RTN","BPSPRRX6",129,0) ... Q "RTN","BPSPRRX6",130,0) .. Q "RTN","BPSPRRX6",131,0) . ; "RTN","BPSPRRX6",132,0) . ; now loop thru the other payer reject array "RTN","BPSPRRX6",133,0) . S REJIEN=0 F S REJIEN=$O(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN)) Q:'REJIEN!BPQ D "RTN","BPSPRRX6",134,0) .. S OPREJ=$G(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN,0)) Q:OPREJ="" Q:$P(OPREJ,U,1)="" "RTN","BPSPRRX6",135,0) .. ; "RTN","BPSPRRX6",136,0) .. ; add a new entry to subfile 9002313.59142 "RTN","BPSPRRX6",137,0) .. S BPIEN2=$$INSITEM^BPSUTIL2(9002313.59142,PIEN_","_IEN59,$P(OPREJ,U,1),REJIEN,"",,0) "RTN","BPSPRRX6",138,0) .. I BPIEN2<1 S BPQ=1 D LOG^BPSOSL(IEN59,$T(+0)_"-Can't create entry in 9002313.59142 subfile") Q "RTN","BPSPRRX6",139,0) .. Q "RTN","BPSPRRX6",140,0) . Q "RTN","BPSPRRX6",141,0) Q "RTN","BPSPRRX6",142,0) ; "RTN","BPSPRRX6",143,0) RES2NDCL(BP59,BPSPLAN,BPSPRDAT,BPSRTYPE) ; populate fields to resubmit SECONDARY claim "RTN","BPSPRRX6",144,0) ;use for secondary claims only "RTN","BPSPRRX6",145,0) ;input: "RTN","BPSPRRX6",146,0) ; BP59 - ien of the BPS TRANSACTION file of the secondary claim "RTN","BPSPRRX6",147,0) ; BPSPLAN - "RTN","BPSPRRX6",148,0) ; BPSPRDAT - "RTN","BPSPRRX6",149,0) ; BPSRTYPE - "RTN","BPSPRRX6",150,0) ;output: "RTN","BPSPRRX6",151,0) ; 1 -success "RTN","BPSPRRX6",152,0) ; 0 -cannot populate fields "RTN","BPSPRRX6",153,0) ; "RTN","BPSPRRX6",154,0) N BPDOSDT,BPZ,BPRXIEN,BPRXR,BPBILL "RTN","BPSPRRX6",155,0) I $$COB59^BPSUTIL2(BP59)'=2 Q 0 "RTN","BPSPRRX6",156,0) S BPBILL=$$PAYBLPRI^BPSUTIL2(BP59) "RTN","BPSPRRX6",157,0) I BPBILL'>0 S BPBILL="" "RTN","BPSPRRX6",158,0) ;Retrieve DOS "RTN","BPSPRRX6",159,0) S BPZ=$$RXREF^BPSSCRU2(BP59) "RTN","BPSPRRX6",160,0) S BPRXIEN=+BPZ "RTN","BPSPRRX6",161,0) S BPRXR=+$P(BPZ,U,2) "RTN","BPSPRRX6",162,0) S BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR) "RTN","BPSPRRX6",163,0) S (BPSPLAN,BPSPRDAT,BPSRTYPE)="" "RTN","BPSPRRX6",164,0) D RESTOR59^BPSPRRX6(BP59,.BPSPLAN,.BPSPRDAT,.BPSRTYPE) "RTN","BPSPRRX6",165,0) S BPSPRDAT("PRIMARY BILL")=BPBILL "RTN","BPSPRRX6",166,0) S BPSPRDAT("FILL DATE")=BPDOSDT "RTN","BPSPRRX6",167,0) S BPSPRDAT("RX ACTION")="ERES" "RTN","BPSPRRX6",168,0) S BPSPRDAT("FILL NUMBER")=BPRXR "RTN","BPSPRRX6",169,0) S BPSPRDAT("PRESCRIPTION")=BPRXIEN "RTN","BPSPRRX6",170,0) Q 1 "RTN","BPSPRRX6",171,0) ;BPSPRRX6 "RTN","BPSRDT1") 0^52^B23897746 "RTN","BPSRDT1",1,0) BPSRDT1 ;BHAM ISC/FCS/DRS/FLS/DLF - Turn Around Time Statistics Report ;06/01/2004 "RTN","BPSRDT1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27 "RTN","BPSRDT1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRDT1",4,0) ; "RTN","BPSRDT1",5,0) N TRANDT,FR,TO,BPSSIZ,BPSTTAT,IEN57,IEN59,IEN,UPDT,SEQ,ENDLOOP,BPSTATIM "RTN","BPSRDT1",6,0) N BPSBGN,BPSBTIM,BPSCTIM,BPSEND,BPSETIM,BPSGTIM,BPSRTIM,BPSSTIM "RTN","BPSRDT1",7,0) N BPSBDT,BPSCNT,X,Y,BPSQUIT,MES,TYPE,DATA "RTN","BPSRDT1",8,0) K ^TMP("BPSRDT1",$J) "RTN","BPSRDT1",9,0) ; "RTN","BPSRDT1",10,0) ; Get start/end dates. Quit if no dates entered "RTN","BPSRDT1",11,0) D DATE I Y<0 K DTOUT Q "RTN","BPSRDT1",12,0) ; "RTN","BPSRDT1",13,0) ; Initialize variables "RTN","BPSRDT1",14,0) S TRANDT=FR,BPSSIZ=0,BPSTTAT=0,BPSCNT=0 "RTN","BPSRDT1",15,0) ; "RTN","BPSRDT1",16,0) ; Quit if no dates in X-ref that match "RTN","BPSRDT1",17,0) I '$O(^BPSTL("AH",TRANDT)) G QUIT "RTN","BPSRDT1",18,0) ; "RTN","BPSRDT1",19,0) ; Loop through the dates and build temporary list "RTN","BPSRDT1",20,0) F S TRANDT=$O(^BPSTL("AH",TRANDT)) Q:TRANDT=""!($P(TRANDT,".")>TO) D "RTN","BPSRDT1",21,0) . S IEN57="" "RTN","BPSRDT1",22,0) . F S IEN57=$O(^BPSTL("AH",TRANDT,IEN57)) Q:IEN57="" D "RTN","BPSRDT1",23,0) .. S IEN59=$P($G(^BPSTL(IEN57,0)),U,1) "RTN","BPSRDT1",24,0) .. I 'IEN59 Q "RTN","BPSRDT1",25,0) .. ; Sieve out eligibility verification transactions "RTN","BPSRDT1",26,0) .. I $P($G(^BPSTL(IEN57,0)),U,15)="E" Q "RTN","BPSRDT1",27,0) .. S IEN=$$EXISTS^BPSOSL1(IEN59) "RTN","BPSRDT1",28,0) .. I IEN S ^TMP("BPSRDT1",$J,1,IEN59)=IEN "RTN","BPSRDT1",29,0) ; "RTN","BPSRDT1",30,0) ; Loop through the temporary list and build second list with turn-around stats "RTN","BPSRDT1",31,0) S IEN59="" "RTN","BPSRDT1",32,0) F S IEN59=$O(^TMP("BPSRDT1",$J,1,IEN59)) Q:IEN59="" D "RTN","BPSRDT1",33,0) . S IEN=$G(^TMP("BPSRDT1",$J,1,IEN59)) "RTN","BPSRDT1",34,0) . S ENDLOOP=0 "RTN","BPSRDT1",35,0) . S (BPSBDT,BPSBGN,BPSEND,BPSBTIM,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM,TYPE)="" "RTN","BPSRDT1",36,0) . S UPDT=FR F S UPDT=$O(^BPS(9002313.12,IEN,10,"B",UPDT)) Q:UPDT="" D Q:ENDLOOP "RTN","BPSRDT1",37,0) .. S SEQ="" F S SEQ=$O(^BPS(9002313.12,IEN,10,"B",UPDT,SEQ)) Q:SEQ="" D Q:ENDLOOP "RTN","BPSRDT1",38,0) ... S MES=$$UP($P($G(^BPS(9002313.12,IEN,10,SEQ,1)),U,1)) "RTN","BPSRDT1",39,0) ... I MES="" Q "RTN","BPSRDT1",40,0) ... I MES["BEFORE SUBMIT OF " D "RTN","BPSRDT1",41,0) .... S TYPE=$P(MES,"BEFORE SUBMIT OF ",2) "RTN","BPSRDT1",42,0) .... S BPSBDT=$P(UPDT,".",1) "RTN","BPSRDT1",43,0) .... I BPSBDT>TO S BPSBDT="",ENDLOOP=1 Q "RTN","BPSRDT1",44,0) .... S BPSBGN=$$TIME2(UPDT),BPSBTIM=$$TIME(UPDT) "RTN","BPSRDT1",45,0) .... S (BPSEND,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM)="" "RTN","BPSRDT1",46,0) ... I ENDLOOP=1 Q "RTN","BPSRDT1",47,0) ... I BPSBDT,MES["BPSOSU NOW RESUBMIT"!(MES["BPSOSU-NOW RESUBMIT") D "RTN","BPSRDT1",48,0) .... S TYPE="Request portion of a Reversal/Resubmit" "RTN","BPSRDT1",49,0) .... S BPSBGN=$$TIME2(UPDT),BPSBTIM=$$TIME(UPDT) "RTN","BPSRDT1",50,0) .... S (BPSEND,BPSGTIM,BPSCTIM,BPSSTIM,BPSRTIM,BPSETIM)="" "RTN","BPSRDT1",51,0) ... I BPSBGN="" Q "RTN","BPSRDT1",52,0) ... I MES["INITIATING REVERSAL AND AFTER THAT, CLAIM WILL BE RESUBMITTED" S TYPE="Reversal portion of a Reversal/Resubmit" "RTN","BPSRDT1",53,0) ... I MES["GATHERING"!(MES["VALIDATING THE BPS TRANSACTION") S BPSGTIM=$$TIME(UPDT) "RTN","BPSRDT1",54,0) ... I MES["CREATED CLAIM ID" S BPSCTIM=$$TIME(UPDT) "RTN","BPSRDT1",55,0) ... I MES["BPSECMC2 - CLAIM - SENT"!(MES["BPSECMC2-CLAIM SENT") S BPSSTIM=$$TIME(UPDT) "RTN","BPSRDT1",56,0) ... I MES["BPSECMC2 - CLAIM - RESPONSE STORED"!(MES["BPSECMC2-RESPONSE STORED") S BPSRTIM=$$TIME(UPDT) "RTN","BPSRDT1",57,0) ... I MES["CLAIM - END"!(MES["BPSOSU-CLAIM COMPLETE") I BPSBGN D "RTN","BPSRDT1",58,0) .... S BPSEND=$$TIME2(UPDT),BPSETIM=$$TIME(UPDT) "RTN","BPSRDT1",59,0) .... D LOG "RTN","BPSRDT1",60,0) ; "RTN","BPSRDT1",61,0) ; If no data to report, quit "RTN","BPSRDT1",62,0) I 'BPSTTAT G QUIT "RTN","BPSRDT1",63,0) ; "RTN","BPSRDT1",64,0) ; Loop through list of stats and output "RTN","BPSRDT1",65,0) S BPSCNT="",BPSQUIT=0 "RTN","BPSRDT1",66,0) F S BPSCNT=$O(^TMP("BPSRDT1",$J,2,BPSCNT)) Q:BPSCNT="" D I BPSQUIT=1 Q "RTN","BPSRDT1",67,0) . S DATA=$G(^TMP("BPSRDT1",$J,2,BPSCNT)),IEN59=$P(DATA,U,1),TYPE=$P(DATA,U,2) "RTN","BPSRDT1",68,0) . S TYPE=$S(TYPE="CLAIM":"Request",TYPE="REVERSAL":"Reversal",1:TYPE) "RTN","BPSRDT1",69,0) . W !,"For Prescription",?25,IEN59_" (Rx# "_$$RXAPI1^BPSUTIL1($P(IEN59,"."),.01,"I")_")" "RTN","BPSRDT1",70,0) . W !,"Type",?25,TYPE "RTN","BPSRDT1",71,0) . W !,"Date",?25,$$FMTE^XLFDT($P(DATA,U,3),"5Z") "RTN","BPSRDT1",72,0) . W !,"Begin ",?25,$P(DATA,U,4) "RTN","BPSRDT1",73,0) . W !,"Gathering information",?25,$P(DATA,U,5) "RTN","BPSRDT1",74,0) . W !,"Claim ID created",?25,$P(DATA,U,6) "RTN","BPSRDT1",75,0) . W !,"Claim Sent",?25,$P(DATA,U,7) "RTN","BPSRDT1",76,0) . W !,"Response stored ",?25,$P(DATA,U,8) "RTN","BPSRDT1",77,0) . W !,"Completed at",?25,$P(DATA,U,9) "RTN","BPSRDT1",78,0) . W !,"Turn-around time",?25,$P(DATA,U,10),! "RTN","BPSRDT1",79,0) . I BPSCNT#2=0 D "RTN","BPSRDT1",80,0) .. R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME "RTN","BPSRDT1",81,0) .. I '$T!(X["^") S BPSQUIT=1 "RTN","BPSRDT1",82,0) ; "RTN","BPSRDT1",83,0) ; Write Totals "RTN","BPSRDT1",84,0) W !!!,"Total number of claims",?25,BPSSIZ "RTN","BPSRDT1",85,0) W !,"Average Turn-around time",?25,BPSTTAT\BPSSIZ,!! "RTN","BPSRDT1",86,0) D PRESSANY^BPSOSU5() "RTN","BPSRDT1",87,0) ; "RTN","BPSRDT1",88,0) ; Kill scratch global "RTN","BPSRDT1",89,0) K ^TMP("BPSRDT1",$J) "RTN","BPSRDT1",90,0) Q "RTN","BPSRDT1",91,0) ; "RTN","BPSRDT1",92,0) ; "RTN","BPSRDT1",93,0) TIME(%) ; "RTN","BPSRDT1",94,0) S %=$E($P(%,".",2)_"000000",1,6) "RTN","BPSRDT1",95,0) Q $E(%,1,2)_":"_$E(%,3,4)_":"_$E(%,5,6) "RTN","BPSRDT1",96,0) ; "RTN","BPSRDT1",97,0) TIME2(%) ; "RTN","BPSRDT1",98,0) Q $P($$FMTH^XLFDT(%),",",2) "RTN","BPSRDT1",99,0) ; "RTN","BPSRDT1",100,0) ; "RTN","BPSRDT1",101,0) LOG ; "RTN","BPSRDT1",102,0) I BPSBGN="" Q "RTN","BPSRDT1",103,0) I BPSEND="" Q "RTN","BPSRDT1",104,0) S BPSTATIM=$G(BPSEND)-$G(BPSBGN) "RTN","BPSRDT1",105,0) ; "RTN","BPSRDT1",106,0) ; Remove negative times (span midnight) and claims more than 20 minutes as anomolies "RTN","BPSRDT1",107,0) I BPSTATIM'>0 Q "RTN","BPSRDT1",108,0) ;I BPSTATIM>1200 Q "RTN","BPSRDT1",109,0) S BPSCNT=BPSCNT+1 "RTN","BPSRDT1",110,0) S ^TMP("BPSRDT1",$J,2,BPSCNT)=IEN59_U_TYPE_U_BPSBDT_U_BPSBTIM_U_BPSGTIM_U_BPSCTIM_U_BPSSTIM_U_BPSRTIM_U_BPSETIM_U_BPSTATIM "RTN","BPSRDT1",111,0) S BPSTTAT=BPSTTAT+BPSTATIM "RTN","BPSRDT1",112,0) S BPSSIZ=BPSSIZ+1 "RTN","BPSRDT1",113,0) I TYPE="Reversal/Resubmit" S BPSSIZ=BPSSIZ+1 "RTN","BPSRDT1",114,0) S (BPSBGN,TYPE)="" "RTN","BPSRDT1",115,0) Q "RTN","BPSRDT1",116,0) ; "RTN","BPSRDT1",117,0) DATE ; Ask user the date range "RTN","BPSRDT1",118,0) N %DT,VAL,TYPEVAL,X "RTN","BPSRDT1",119,0) S %DT="AEP",%DT(0)=-DT,%DT("A")="START WITH DATE: " "RTN","BPSRDT1",120,0) S %DT("B")="T-1" "RTN","BPSRDT1",121,0) D ^%DT Q:Y<0!($D(DTOUT)) "RTN","BPSRDT1",122,0) S (%DT(0),FR)=Y "RTN","BPSRDT1",123,0) S %DT("A")="GO TO DATE: " "RTN","BPSRDT1",124,0) S %DT("B")="T" "RTN","BPSRDT1",125,0) D ^%DT Q:Y<0!($D(DTOUT)) "RTN","BPSRDT1",126,0) S TO=Y "RTN","BPSRDT1",127,0) Q "RTN","BPSRDT1",128,0) ; "RTN","BPSRDT1",129,0) UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","BPSRDT1",130,0) QUIT ; "RTN","BPSRDT1",131,0) W !!,"*** No valid data found ***",!! "RTN","BPSRDT1",132,0) D PRESSANY^BPSOSU5() "RTN","BPSRDT1",133,0) Q "RTN","BPSREOP1") 0^70^B59523437 "RTN","BPSREOP1",1,0) BPSREOP1 ;BHAM ISC/SS - REOPEN CLOSED CLAIMS ;03/07/08 14:54 "RTN","BPSREOP1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**3,7,10**;JUN 2004;Build 27 "RTN","BPSREOP1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSREOP1",4,0) ;Reopen closed claims "RTN","BPSREOP1",5,0) ; "RTN","BPSREOP1",6,0) ;create an ^TMP for the list manager "RTN","BPSREOP1",7,0) ; "RTN","BPSREOP1",8,0) COLLECT(BPDFN,BPSTRT,BPEND) ; "RTN","BPSREOP1",9,0) D CLEAN^VALM10 "RTN","BPSREOP1",10,0) N LINE "RTN","BPSREOP1",11,0) N BPIEN02,BPIEN59 "RTN","BPSREOP1",12,0) S LINE=1 "RTN","BPSREOP1",13,0) S BPIEN59=0 "RTN","BPSREOP1",14,0) F S BPIEN59=$O(^BPST("AC",BPDFN,BPIEN59)) Q:+BPIEN59=0 D "RTN","BPSREOP1",15,0) . I $P($G(^BPST(BPIEN59,12)),U,2)BPEND Q "RTN","BPSREOP1",17,0) . ; Don't display deleted prescriptions "RTN","BPSREOP1",18,0) . I $$RXAPI1^BPSUTIL1($P(^BPST(BPIEN59,1),U,11),100,"I")=13 Q "RTN","BPSREOP1",19,0) . S BPIEN02=+$P($G(^BPST(BPIEN59,0)),U,4) "RTN","BPSREOP1",20,0) . ;if the is no BPS CLAIMS - error "RTN","BPSREOP1",21,0) . Q:BPIEN02=0 "RTN","BPSREOP1",22,0) . ;if NOT closed "RTN","BPSREOP1",23,0) . I +$P($G(^BPSC(BPIEN02,900)),U)=0 Q "RTN","BPSREOP1",24,0) . D SET^VALM10(LINE,$$LJ^BPSSCR02(LINE,6)_$$CLAIMINF(BPIEN59),BPIEN59) "RTN","BPSREOP1",25,0) . S LINE=LINE+1 "RTN","BPSREOP1",26,0) S VALMCNT=LINE-1 ;"of PAGE" fix - VALMCNT should be EXACT number of lines on the screen "RTN","BPSREOP1",27,0) Q "RTN","BPSREOP1",28,0) ;claim info for list manager screen "RTN","BPSREOP1",29,0) CLAIMINF(BP59) ;*/ "RTN","BPSREOP1",30,0) N BPX,BPX1 "RTN","BPSREOP1",31,0) S BPX1=$$RXREF^BPSSCRU2(BP59) "RTN","BPSREOP1",32,0) S BPX=$$LJ^BPSSCR02($$DRGNAME^BPSSCRU2(BP59),17)_" "_$$LJ^BPSSCR02($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),11)_" " "RTN","BPSREOP1",33,0) S BPX=BPX_$$LJ^BPSSCR02($$FILLDATE^BPSSCRRS(+BPX1,+$P(BPX1,U,2)),5)_" " "RTN","BPSREOP1",34,0) S BPX=BPX_$$LJ^BPSSCR02($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/" "RTN","BPSREOP1",35,0) S BPX=BPX_$$LJ^BPSSCR02($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" " "RTN","BPSREOP1",36,0) S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59) "RTN","BPSREOP1",37,0) Q BPX "RTN","BPSREOP1",38,0) ; "RTN","BPSREOP1",39,0) ;patient info for header "RTN","BPSREOP1",40,0) PATINF(BPDFN) ;*/ "RTN","BPSREOP1",41,0) N X "RTN","BPSREOP1",42,0) S X=$E($$PATNAME(BPDFN),1,22)_" "_$$SSN4^BPSSCRU2(BPDFN) "RTN","BPSREOP1",43,0) Q $$LJ^BPSSCR02(X,29) ;name "RTN","BPSREOP1",44,0) ; "RTN","BPSREOP1",45,0) ;------------ patient's name "RTN","BPSREOP1",46,0) PATNAME(BPDFN) ; "RTN","BPSREOP1",47,0) Q $E($P($G(^DPT(BPDFN,0)),U),1,30) "RTN","BPSREOP1",48,0) ; "RTN","BPSREOP1",49,0) ;/** "RTN","BPSREOP1",50,0) ;ECME User Screen Reopen Closed Claim Hidden Action (ROC) "RTN","BPSREOP1",51,0) ;**/ "RTN","BPSREOP1",52,0) EUSCREOP ; "RTN","BPSREOP1",53,0) N BPREOP,BP59,BPDFN,BPDISP,BPCNT,BPI,BPJ,BPCOMM,BPRETV,BPIEN02,BPSRXNUM "RTN","BPSREOP1",54,0) ; Check for BPS MANAGER security key "RTN","BPSREOP1",55,0) I '$D(^XUSEC("BPS MANAGER",DUZ)) D Q "RTN","BPSREOP1",56,0) . W !,"You must hold the BPS MANAGER Security Key to access the",!,"Reopen Closed Claims option." "RTN","BPSREOP1",57,0) . S VALMBCK="R" "RTN","BPSREOP1",58,0) . D PAUSE^VALM1 "RTN","BPSREOP1",59,0) S (BP59,BPCNT,BPI,BPJ)=0 "RTN","BPSREOP1",60,0) I '$D(@(VALMAR)) G REOP "RTN","BPSREOP1",61,0) D FULL^VALM1 "RTN","BPSREOP1",62,0) ; Select the claim(s) to reopen "RTN","BPSREOP1",63,0) W !,"Enter the line number for the claim you want to reopen." "RTN","BPSREOP1",64,0) I $$ASKLINES^BPSSCRU4("","C",.BPREOP,VALMAR) D "RTN","BPSREOP1",65,0) . ; Build array to display to user "RTN","BPSREOP1",66,0) . F S BP59=$O(BPREOP(BP59)) Q:BP59="" D "RTN","BPSREOP1",67,0) . . S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSREOP1",68,0) . . S BPCNT=BPCNT+1 "RTN","BPSREOP1",69,0) . . I '$D(BPDISP(BPDFN)) S BPDISP(BPDFN,BPCNT)=$$LJ^BPSSCR02($$PATNAME(BPDFN)_" :",50),BPCNT=BPCNT+1 "RTN","BPSREOP1",70,0) . . S BPDISP(BPDFN,BPCNT)=@VALMAR@($P(BPREOP(BP59),U,1),0) "RTN","BPSREOP1",71,0) . . ; Make sure this claim is closed "RTN","BPSREOP1",72,0) . . I '$$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) D "RTN","BPSREOP1",73,0) . . . S BPCNT=BPCNT+1 "RTN","BPSREOP1",74,0) . . . S BPDISP(BPDFN,BPCNT)="Claim NOT closed and cannot be reopened." "RTN","BPSREOP1",75,0) . . . K BPREOP(BP59) "RTN","BPSREOP1",76,0) . . ; Make sure the Prescription isn't deleted "RTN","BPSREOP1",77,0) . . I $$RXAPI1^BPSUTIL1($P(^BPST(BP59,1),U,11),100,"I")=13 D "RTN","BPSREOP1",78,0) . . . S BPCNT=BPCNT+1 "RTN","BPSREOP1",79,0) . . . S BPDISP(BPDFN,BPCNT)="The prescription has been marked DELETED and cannot be reopened." "RTN","BPSREOP1",80,0) . . . K BPREOP(BP59) "RTN","BPSREOP1",81,0) . ; Display the selected claims from the display array "RTN","BPSREOP1",82,0) . W !!,"You've chosen to reopen the following prescriptions(s) for" "RTN","BPSREOP1",83,0) . F S BPI=$O(BPDISP(BPI)) Q:BPI="" D "RTN","BPSREOP1",84,0) . . F S BPJ=$O(BPDISP(BPI,BPJ)) Q:BPJ="" D "RTN","BPSREOP1",85,0) . . . W !,BPDISP(BPI,BPJ) "RTN","BPSREOP1",86,0) . . Q "RTN","BPSREOP1",87,0) . Q "RTN","BPSREOP1",88,0) ; If there are any closed claims selected, verify if the users still wants to reopen "RTN","BPSREOP1",89,0) I $D(BPREOP) D "RTN","BPSREOP1",90,0) . W !!,"All Selected Rxs will be reopened using the same information gathered in the",!,"following prompts.",!! "RTN","BPSREOP1",91,0) . I $$YESNO^BPSSCRRS("Are you sure?(Y/N)") D "RTN","BPSREOP1",92,0) . . ; Get the Reopen Comments to be stored in the BPS CLAIMS file "RTN","BPSREOP1",93,0) . . S BPCOMM=$$PROMPT("REOPEN COMMENTS","","F",1,40) "RTN","BPSREOP1",94,0) . . Q:BPCOMM["^" "RTN","BPSREOP1",95,0) . . ; Do we REALLY want to reopen the claims? "RTN","BPSREOP1",96,0) . . I $$YESNO^BPSSCRRS("ARE YOU SURE YOU WANT TO RE-OPEN THIS CLAIM? (Y/N)","No") D "RTN","BPSREOP1",97,0) . . . S (BPCNT,BP59)=0 "RTN","BPSREOP1",98,0) . . . ; Loop through all selected claims and reopen them one at a time "RTN","BPSREOP1",99,0) . . . ; using the same comments "RTN","BPSREOP1",100,0) . . . F S BP59=$O(BPREOP(BP59)) Q:BP59="" D "RTN","BPSREOP1",101,0) . . . . S BPIEN02=+$P($G(^BPST(BP59,0)),U,4) "RTN","BPSREOP1",102,0) . . . . S BPRETV=$$REOPEN^BPSBUTL(BP59,BPIEN02,$$NOW^XLFDT,+DUZ,BPCOMM) "RTN","BPSREOP1",103,0) . . . . W !,$P(BPRETV,U,2) "RTN","BPSREOP1",104,0) . . . . I +BPRETV S BPCNT=BPCNT+1 "RTN","BPSREOP1",105,0) . . . . Q "RTN","BPSREOP1",106,0) . . . I BPCNT>1 W !!,BPCNT_" claims have been reopened.",! Q "RTN","BPSREOP1",107,0) . . . I BPCNT=1 W !!,"1 claim has been reopened.",! Q "RTN","BPSREOP1",108,0) . . . I BPCNT=0 W !!,"Unable to reopen claim" Q "RTN","BPSREOP1",109,0) I '$D(BPREOP) S VALMBCK="R" D PAUSE^VALM1 Q "RTN","BPSREOP1",110,0) D PAUSE^VALM1 "RTN","BPSREOP1",111,0) D REDRAW^BPSSCRUD("Updating screen for reopened claims...") "RTN","BPSREOP1",112,0) Q "RTN","BPSREOP1",113,0) ; "RTN","BPSREOP1",114,0) SELECT ; "RTN","BPSREOP1",115,0) I VALMCNT<1 D Q "RTN","BPSREOP1",116,0) . W !,"No claims to select." D PAUSE^VALM1 S VALMBCK="R" "RTN","BPSREOP1",117,0) N BP59,BPQ "RTN","BPSREOP1",118,0) D FULL^VALM1 "RTN","BPSREOP1",119,0) S BP59=0 "RTN","BPSREOP1",120,0) S BPQ=0 "RTN","BPSREOP1",121,0) F S BPLINE=$$PROMPT("Select item","","A") D Q:BPQ "RTN","BPSREOP1",122,0) . I BPLINE="^" S BPQ=1 Q "RTN","BPSREOP1",123,0) . I '(BPLINE?1N.N) W !,"Please select a SINGLE Rx Line Item." Q "RTN","BPSREOP1",124,0) . S BP59=+$$GET59(+BPLINE) I BP59>0 S BPQ=1 Q "RTN","BPSREOP1",125,0) . W !,"Please select a VALID Rx Line Item." "RTN","BPSREOP1",126,0) I BPLINE="^" S VALMBCK="R" Q "RTN","BPSREOP1",127,0) I BP59=0 S VALMBCK="R" W !,"Invalid selection." D PAUSE^VALM1 Q "RTN","BPSREOP1",128,0) I $$SELCLAIM(BP59)<1 S VALMBCK="R" Q "RTN","BPSREOP1",129,0) ;D RE^VALM4 "RTN","BPSREOP1",130,0) D REDRAW "RTN","BPSREOP1",131,0) S VALMBCK="R" "RTN","BPSREOP1",132,0) Q "RTN","BPSREOP1",133,0) ; "RTN","BPSREOP1",134,0) GET59(BPLINE) ; "RTN","BPSREOP1",135,0) Q +$O(^TMP("BPSREOP",$J,"VALM","IDX",BPLINE,0)) "RTN","BPSREOP1",136,0) ; "RTN","BPSREOP1",137,0) ;display selected claim information "RTN","BPSREOP1",138,0) SELCLAIM(BP59) ; "RTN","BPSREOP1",139,0) D FULL^VALM1 "RTN","BPSREOP1",140,0) W @IOF "RTN","BPSREOP1",141,0) N BPX,BPX1,BPDFN,BPIEN02,BPCLDATA,BPCOMM,BPRETV,BPQ "RTN","BPSREOP1",142,0) S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSREOP1",143,0) S BPX1=$$RXREF^BPSSCRU2(BP59) "RTN","BPSREOP1",144,0) W !,?1,$$LJ^BPSSCR02("PATIENT NAME: "_$$PATNAME(BPDFN),30) "RTN","BPSREOP1",145,0) W ?33,$$LJ^BPSSCR02("RX#: "_$$RXNUM^BPSSCRU2(+BPX1)_" "_$P(BPX1,U,2),22) "RTN","BPSREOP1",146,0) W ?57,$$LJ^BPSSCR02("DRUG: "_$$DRGNAME^BPSSCRU2(BP59),22) "RTN","BPSREOP1",147,0) ;ien in BPS CLAIMS "RTN","BPSREOP1",148,0) S BPIEN02=+$P($G(^BPST(BP59,0)),U,4) "RTN","BPSREOP1",149,0) I BPIEN02=0 W !,"BPS CLAIMS file error!" D PAUSE^VALM1 Q -1 "RTN","BPSREOP1",150,0) ;Close info "RTN","BPSREOP1",151,0) S BPCLDATA=$G(^BPSC(BPIEN02,900)) "RTN","BPSREOP1",152,0) ;if the is no BPS CLAIMS - error "RTN","BPSREOP1",153,0) W !,?3,"CLOSED ",$$FORMDATE^BPSSCRU6(+$P($G(^BPSC(BPIEN02,900)),U,2),2) "RTN","BPSREOP1",154,0) W !,?4,"ECME#: "_$$ECMENUM^BPSSCRU2(BP59)_", FILL DATE: "_$$FORMDATE^BPSSCRU6($$DOSDATE^BPSSCRRS(+BPX1,+$P(BPX1,U,2)),2) "RTN","BPSREOP1",155,0) W ", RELEASE DATE: "_$$FORMDATE^BPSSCRU6($$RELDATE^BPSSCRU6(+BPX1,+$P(BPX1,U,2)),2) "RTN","BPSREOP1",156,0) W !,?4,"PLAN: ",$$PLANNAME^BPSSCRU6(BP59)," INSURANCE: ",$$INSNAME^BPSSCRU6(BP59) "RTN","BPSREOP1",157,0) W !,?4,"CLOSE REASON: ",$$CLREASON^BPSSCRU6(+$P(BPCLDATA,U,4)) "RTN","BPSREOP1",158,0) W !,?4,"DROP TO PAPER: ",$S(+$P(BPCLDATA,U,5)=1:"YES",1:"NO") "RTN","BPSREOP1",159,0) W !,?4,"CLOSE USER: ",$P($G(^VA(200,+$P(BPCLDATA,U,3),0)),U) "RTN","BPSREOP1",160,0) W !!,"You have selected the CLOSED electronic claim listed above.",! "RTN","BPSREOP1",161,0) S BPCOMM=$$PROMPT("REOPEN COMMENTS","","F",1,40) "RTN","BPSREOP1",162,0) Q:BPCOMM["^" 0 "RTN","BPSREOP1",163,0) S BPQ=$$YESNO^BPSSCRRS("ARE YOU SURE YOU WANT TO RE-OPEN THIS CLAIM? (Y/N)","No") "RTN","BPSREOP1",164,0) Q:BPQ<1 0 "RTN","BPSREOP1",165,0) S BPRETV=$$REOPEN^BPSBUTL(BP59,BPIEN02,$$NOW^XLFDT,+DUZ,BPCOMM) "RTN","BPSREOP1",166,0) W !,$P(BPRETV,U,2),! "RTN","BPSREOP1",167,0) W !,"1 claim has been reopened.",! "RTN","BPSREOP1",168,0) D PAUSE^VALM1 "RTN","BPSREOP1",169,0) Q 1 "RTN","BPSREOP1",170,0) ; "RTN","BPSREOP1",171,0) REDRAW ; "RTN","BPSREOP1",172,0) N BPARR "RTN","BPSREOP1",173,0) D CLEAN^VALM10 "RTN","BPSREOP1",174,0) D COLLECT^BPSREOP1(BPDFN,BPSTRT,BPEND) "RTN","BPSREOP1",175,0) S VALMBCK="R" "RTN","BPSREOP1",176,0) Q "RTN","BPSREOP1",177,0) ;input: "RTN","BPSREOP1",178,0) ;BPSPROM - prompt text "RTN","BPSREOP1",179,0) ;BPSDFVL - default value (optional) "RTN","BPSREOP1",180,0) ;BPMODE - N- to enter numbers, F - free text, A - free text w/o limitations "RTN","BPSREOP1",181,0) ;returns: "RTN","BPSREOP1",182,0) ; "response" "RTN","BPSREOP1",183,0) ; or "^" for quit "RTN","BPSREOP1",184,0) PROMPT(BPSPROM,BPSDFVL,BPMODE,MINLEN,MAXLEN) ; "RTN","BPSREOP1",185,0) N IR,X,Y,DIRUT,DIR "RTN","BPSREOP1",186,0) I BPMODE="N" S DIR(0)="N^::2" "RTN","BPSREOP1",187,0) I BPMODE="A" S DIR(0)="F^::2" "RTN","BPSREOP1",188,0) I BPMODE="F" S DIR(0)="F^"_MINLEN_":"_MAXLEN_":2^K:(X?1"" ""."" "") X" "RTN","BPSREOP1",189,0) S DIR("A")=BPSPROM "RTN","BPSREOP1",190,0) I $L($G(BPSDFVL))>0 S DIR("B")=$G(BPSDFVL) "RTN","BPSREOP1",191,0) D ^DIR I $D(DIRUT) Q "^" "RTN","BPSREOP1",192,0) I Y["^" Q "^" "RTN","BPSREOP1",193,0) Q Y "RTN","BPSREOP1",194,0) ; "RTN","BPSREOP1",195,0) ;Update reopen record in BPS CLAIM "RTN","BPSREOP1",196,0) ;Input: "RTN","BPSREOP1",197,0) ; BP02 - ien in BPS CLAIMS file "RTN","BPSREOP1",198,0) ; BPCLOSED - value for CLOSED field "RTN","BPSREOP1",199,0) ; BPREOPDT - reopen date/time "RTN","BPSREOP1",200,0) ; BPDUZ - user DUZ (#200 ien) "RTN","BPSREOP1",201,0) ; BPCOMM - reopen comment text "RTN","BPSREOP1",202,0) ;Output: "RTN","BPSREOP1",203,0) ; 0^message_error - error "RTN","BPSREOP1",204,0) ; 1 - success "RTN","BPSREOP1",205,0) UPDREOP(BP02,BPCLOSED,BPREOPDT,BPDUZ,BPCOMM) ; "RTN","BPSREOP1",206,0) ;Now update ECME database "RTN","BPSREOP1",207,0) N RECIENS,BPDA,BPLCK,ERRARR "RTN","BPSREOP1",208,0) S RECIENS=BP02_"," "RTN","BPSREOP1",209,0) S BPDA(9002313.02,RECIENS,901)=BPCLOSED ;CLOSED = "NO" "RTN","BPSREOP1",210,0) S BPDA(9002313.02,RECIENS,906)=BPREOPDT ;reopen date/time "RTN","BPSREOP1",211,0) S BPDA(9002313.02,RECIENS,907)=+BPDUZ ;user "RTN","BPSREOP1",212,0) S BPDA(9002313.02,RECIENS,908)=BPCOMM ;comment "RTN","BPSREOP1",213,0) L +^BPST(9002313.02,+BP02):10 "RTN","BPSREOP1",214,0) S BPLCK=$T "RTN","BPSREOP1",215,0) I 'BPLCK Q "0^Locked record" ;quit "RTN","BPSREOP1",216,0) D FILE^DIE("","BPDA","ERRARR") "RTN","BPSREOP1",217,0) I BPLCK L -^BPST(9002313.02,+BP02) "RTN","BPSREOP1",218,0) I $D(ERRARR) Q "0^"_ERRARR("DIERR",1,"TEXT",1) "RTN","BPSREOP1",219,0) Q 1 "RTN","BPSREOP1",220,0) ; "RTN","BPSREOP1",221,0) ; Reopen Closed Claim displayed in ECME User Screen "RTN","BPSREOP1",222,0) REOP ; "RTN","BPSREOP1",223,0) Q "RTN","BPSRES") 0^11^B125666033 "RTN","BPSRES",1,0) BPSRES ;BHAM ISC/BEE - ECME SCREEN RESUBMIT W/EDITS ;3/12/08 14:01 "RTN","BPSRES",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**3,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSRES",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRES",4,0) ; "RTN","BPSRES",5,0) ;ECME Resubmit w/EDITS Protocol (Hidden) - Called by [BPS USER SCREEN] "RTN","BPSRES",6,0) ; "RTN","BPSRES",7,0) RESED N BPSEL "RTN","BPSRES",8,0) ; "RTN","BPSRES",9,0) I '$D(@(VALMAR)) G XRESED "RTN","BPSRES",10,0) D FULL^VALM1 "RTN","BPSRES",11,0) ; "RTN","BPSRES",12,0) ;Select the claim to resubmit "RTN","BPSRES",13,0) W !,"Enter the line number for the claim to be resubmitted." "RTN","BPSRES",14,0) S BPSEL=$$ASKLINE("Select item","Please select a SINGLE claim only when using the Resubmit w/EDITS action option.") "RTN","BPSRES",15,0) I BPSEL<1 S VALMBCK="R" G XRESED "RTN","BPSRES",16,0) ; "RTN","BPSRES",17,0) ;Attempt to resubmit the claim, update the content of the screen, and display "RTN","BPSRES",18,0) ;only if claim submitted successfully "RTN","BPSRES",19,0) I $$DOSELCTD(BPSEL) D REDRAW^BPSSCRUD("Updating screen for resubmitted claim...") "RTN","BPSRES",20,0) E S VALMBCK="R" "RTN","BPSRES",21,0) ; "RTN","BPSRES",22,0) XRESED Q "RTN","BPSRES",23,0) ; "RTN","BPSRES",24,0) ;Attempt to Edit and Resubmit Selected Claim "RTN","BPSRES",25,0) ; "RTN","BPSRES",26,0) ; Input Value -> BPRXI - Entry with ptr to BPS TRANSACTION file "RTN","BPSRES",27,0) ; "RTN","BPSRES",28,0) ; Return Value -> 0 - Claim was not resubmitted "RTN","BPSRES",29,0) ; 1 - Claim was resubmitted "RTN","BPSRES",30,0) ; "RTN","BPSRES",31,0) DOSELCTD(BPRXI) N BP02,BP59,BPBILL,BPCLTOT,BPDFN,BPDOSDT,BPOVRIEN,BPQ,BPRXIEN,BPRXR,BPSTATUS,BPUPDFLG "RTN","BPSRES",32,0) N BPBILL,BPCOB,BPDOCOB,BPSURE,BPPTRES,BPPHSRV,BPDLYRS "RTN","BPSRES",33,0) S (BPQ)="" "RTN","BPSRES",34,0) S (BPCLTOT,BPUPDFLG)=0 "RTN","BPSRES",35,0) ; "RTN","BPSRES",36,0) ;Pull BPS TRANSACTION/BPS CLAIMS entries "RTN","BPSRES",37,0) S BP59=$P(BPRXI,U,4) I BP59="" W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-Submission",! G XRES "RTN","BPSRES",38,0) S BP02=+$P($G(^BPST(BP59,0)),U,4) I 'BP02 W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-Submission",! G XRES "RTN","BPSRES",39,0) ; "RTN","BPSRES",40,0) ;Write Form Feed "RTN","BPSRES",41,0) W @IOF "RTN","BPSRES",42,0) ; "RTN","BPSRES",43,0) ;Display selected claim and ask to submit "RTN","BPSRES",44,0) S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSRES",45,0) W !,"You've chosen to RESUBMIT the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13) "RTN","BPSRES",46,0) W !,@VALMAR@(+$P(BPRXI,U,5),0) "RTN","BPSRES",47,0) S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)") "RTN","BPSRES",48,0) I BPQ'=1 S BPQ="^" G XRES "RTN","BPSRES",49,0) ; "RTN","BPSRES",50,0) ;Check to make sure claim can be Resubmitted w/EDITS "RTN","BPSRES",51,0) S BPRXIEN=$P(BP59,".") "RTN","BPSRES",52,0) S BPRXR=+$E($P(BP59,".",2),1,4) "RTN","BPSRES",53,0) I $$RXDEL^BPSOS($P(BP59,".",1),+$E($P(BP59,".",2),1,4)) W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"cannot be Resubmitted w/EDITS because it has been deleted in Pharmacy.",! G XRES "RTN","BPSRES",54,0) S BPSTATUS=$P($$CLAIMST^BPSSCRU3(BP59),U) "RTN","BPSRES",55,0) I BPSTATUS["IN PROGRESS" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is still In Progress and cannot be Resubmitted w/EDITS",! G XRES "RTN","BPSRES",56,0) I BPSTATUS'["E REJECTED" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is NOT Rejected and cannot be Resubmitted w/EDITS",! G XRES "RTN","BPSRES",57,0) I $P($G(^BPST(BP59,0)),U,14)<2,$$PAYABLE^BPSOSRX5(BPSTATUS),$$PAYBLSEC^BPSUTIL2(BP59) D G XRES "RTN","BPSRES",58,0) . W !,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"cannot be Resubmitted if the secondary claim is payable.",!,"Please reverse the secondary claim first." "RTN","BPSRES",59,0) S BPBILL=0 "RTN","BPSRES",60,0) ;I $P($G(^BPST(BP59,0)),U,14)=2 S BPBILL=$$PAYBLPRI^BPSUTIL2(BP59) I BPBILL=0 D G XRES "RTN","BPSRES",61,0) ;. W !,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"cannot be Resubmitted if the primary is NOT "RTN","BPSRES",62,0) ;can't resubmit a closed claim. The user must reopen first. "RTN","BPSRES",63,0) I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is Closed and cannot be Resubmitted w/EDITS.",! G XRES "RTN","BPSRES",64,0) ; "RTN","BPSRES",65,0) S BPCOB=$$COB59^BPSUTIL2(BP59) "RTN","BPSRES",66,0) ;Prompt for EDIT Information "RTN","BPSRES",67,0) S BPOVRIEN=$$PROMPTS(BP59,BP02,BPCOB) I BPOVRIEN=-1 G XRES "RTN","BPSRES",68,0) ; "RTN","BPSRES",69,0) ;Retrieve DOS "RTN","BPSRES",70,0) S BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR) "RTN","BPSRES",71,0) ; "RTN","BPSRES",72,0) ; If secondary, call COBFLDS "RTN","BPSRES",73,0) ; Otherwise, submit claim "RTN","BPSRES",74,0) I BPCOB=2 S BPBILL=$$COBFLDS(BP59,BPRXIEN,BPRXR,BPDOSDT,"ERES",BPOVRIEN) "RTN","BPSRES",75,0) I BPCOB'=2 S BPBILL=$$EN^BPSNCPDP(BPRXIEN,BPRXR,BPDOSDT,"ERES","","ECME RESUBMIT","",BPOVRIEN,,,BPCOB) "RTN","BPSRES",76,0) ; "RTN","BPSRES",77,0) ;Print Return Value Message "RTN","BPSRES",78,0) W !! "RTN","BPSRES",79,0) W:+BPBILL>0 $S(+BPBILL=10:"Reversal but no Resubmit:",1:"Not Processed:"),!," " "RTN","BPSRES",80,0) ; "RTN","BPSRES",81,0) ;Change Return Message for SC/EI "RTN","BPSRES",82,0) S:$P(BPBILL,U,2)="NEEDS SC DETERMINATION" $P(BPBILL,U,2)="NEEDS SC/EI DETERMINATION" "RTN","BPSRES",83,0) W $P(BPBILL,U,2) "RTN","BPSRES",84,0) ; "RTN","BPSRES",85,0) ;0 Prescription/Fill successfully submitted to ECME "RTN","BPSRES",86,0) ;1 ECME did not submit prescription/fill "RTN","BPSRES",87,0) ;2 IB says prescription/fill is not ECME billable or the data returned from IB is not valid "RTN","BPSRES",88,0) ;3 ECME closed the claim but did not submit it to the payer "RTN","BPSRES",89,0) ;4 Unable to queue the ECME claim "RTN","BPSRES",90,0) ;5 Invalid input "RTN","BPSRES",91,0) ;10 Reversal Processed But Claim Was Not Resubmitted "RTN","BPSRES",92,0) ; "RTN","BPSRES",93,0) I +BPBILL=0 D "RTN","BPSRES",94,0) . N BPSCOB S BPSCOB=$$COB59^BPSUTIL2(BP59) ;get COB for the BPS TRANSACTION IEN "RTN","BPSRES",95,0) . D ECMEACT^PSOBPSU1(+BPRXIEN,+BPRXR,"Claim resubmitted to 3rd party payer: ECME USER's SCREEN-"_$S(BPSCOB=1:"p",BPSCOB=2:"s",1:"")_$$INSNAME^BPSSCRU6(BP59)) "RTN","BPSRES",96,0) . S BPUPDFLG=1,BPCLTOT=1 "RTN","BPSRES",97,0) XRES I BPCLTOT W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been resubmitted.",! "RTN","BPSRES",98,0) D PAUSE^VALM1 "RTN","BPSRES",99,0) Q BPUPDFLG "RTN","BPSRES",100,0) ; "RTN","BPSRES",101,0) XRES2 I BPCLTOT W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been resubmitted.",! "RTN","BPSRES",102,0) Q BPUPDFLG "RTN","BPSRES",103,0) ;Enter EDIT information for claim "RTN","BPSRES",104,0) ; "RTN","BPSRES",105,0) ; Input Values -> BP59 - The BPS TRANSACTION entry "RTN","BPSRES",106,0) ; BP02 - The BPS CLAIMS entry "RTN","BPSRES",107,0) ; BPCOB - (optional) payer sequence (1-primary, 2 -secondary) "RTN","BPSRES",108,0) ; Output Value -> BPQ - -1 - The user chose to quit "RTN","BPSRES",109,0) ; "" - The user completed the EDITS "RTN","BPSRES",110,0) PROMPTS(BP59,BP02,BPCOB) ; "RTN","BPSRES",111,0) N %,BP300,BP35401,BPCLCD1,BPCLCD2,BPCLCD3,BPFDA,BPFLD,BPOVRIEN,BPMED,BPMSG,BPPSNCD,BPPREAUT,BPPRETYP,BPQ,BPRELCD,DIC,DIR,DIROUT,DTOUT,DUOUT,X,Y,DIRUT,DUP "RTN","BPSRES",112,0) ; "RTN","BPSRES",113,0) S BPQ="" "RTN","BPSRES",114,0) I +$G(BPCOB)=0 S BPCOB=1 "RTN","BPSRES",115,0) ;Pull Information from Claim "RTN","BPSRES",116,0) S BP300=$G(^BPSC(BP02,300)) "RTN","BPSRES",117,0) S BPRELCD=$TR($E($P(BP300,U,6),3,99)," ") "RTN","BPSRES",118,0) S BPPSNCD=$TR($E($P(BP300,U,3),3,99)," ") "RTN","BPSRES",119,0) S (BPPRETYP,BPPREAUT,BPDLYRS,BPPHSRV)="" "RTN","BPSRES",120,0) S BPMED=0 F S BPMED=$O(^BPSC(BP02,400,BPMED)) Q:'BPMED D I BPPREAUT]"" Q "RTN","BPSRES",121,0) . N BP460 S BP460=$G(^BPSC(BP02,400,BPMED,460)) "RTN","BPSRES",122,0) . S:BPPREAUT="" BPPREAUT=$TR($E($P(BP460,U,2),3,99)," "),BPPRETYP=$TR($E($P(BP460,U),3,99)," ") "RTN","BPSRES",123,0) . S:BPDLYRS="" BPDLYRS=$TR($E($P($G(^BPSC(BP02,400,BPMED,350)),U,7),3,99)," ") I BPDLYRS]"" S BPDLYRS=+BPDLYRS "RTN","BPSRES",124,0) . S:BPPHSRV="" BPPHSRV=$TR($E($P($G(^BPSC(BP02,400,BPMED,140)),U,7),3,99)," ") "RTN","BPSRES",125,0) . F BP35401=1:1:3 S @("BPCLCD"_BP35401)=$TR($E($P($G(^BPSC(BP02,400,BPMED,354.01,BP35401,1)),U),3,99)," ") "RTN","BPSRES",126,0) . S BPCLCD1=+BPCLCD1 I BPCLCD1=0 S BPCLCD1=1 "RTN","BPSRES",127,0) S BPPTRES=$TR($E($P($G(^BPSC(BP02,380)),U,4),3,99)," ") I BPPTRES="" S BPPTRES=1 "RTN","BPSRES",128,0) S:BPPHSRV="" BPPHSRV=1 "RTN","BPSRES",129,0) ; "RTN","BPSRES",130,0) ;Relationship Code "RTN","BPSRES",131,0) N X,DIC,Y "RTN","BPSRES",132,0) S DIC("B")=BPRELCD "RTN","BPSRES",133,0) S DIC(0)="QEAM",DIC=9002313.19,DIC("A")="Relationship Code: " "RTN","BPSRES",134,0) D ^DIC "RTN","BPSRES",135,0) ;Check for "^" or timeout "RTN","BPSRES",136,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSRES",137,0) S BPRELCD=$P(Y,U,2) "RTN","BPSRES",138,0) K X,DIC,Y "RTN","BPSRES",139,0) ; "RTN","BPSRES",140,0) ;Person Code "RTN","BPSRES",141,0) K DIR("?") S DIR(0)="FO^1:3",DIR("A")="Person Code",DIR("?")="Enter the Specific Person Code Assigned to the Patient by the Payer" "RTN","BPSRES",142,0) S DIR("B")=BPPSNCD "RTN","BPSRES",143,0) D ^DIR "RTN","BPSRES",144,0) I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS "RTN","BPSRES",145,0) S BPPSNCD=Y "RTN","BPSRES",146,0) ; "RTN","BPSRES",147,0) ;Pre-Authorization "RTN","BPSRES",148,0) K DIR("?") S DIR(0)="FO^1:11",DIR("A")="Prior Authorization Number",DIR("?")="Enter the Number Submitted by the Provider to Identify the Prior Authorization" "RTN","BPSRES",149,0) S DIR("B")=BPPREAUT "RTN","BPSRES",150,0) D ^DIR "RTN","BPSRES",151,0) I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS "RTN","BPSRES",152,0) S BPPREAUT=Y "RTN","BPSRES",153,0) ; "RTN","BPSRES",154,0) ;Prior-Authorization Type Code "RTN","BPSRES",155,0) N X,DIC,Y "RTN","BPSRES",156,0) S DIC("B")=+BPPRETYP "RTN","BPSRES",157,0) S DIC(0)="QEAM",DIC=9002313.26,DIC("A")="Prior Authorization Type Code: " "RTN","BPSRES",158,0) D ^DIC "RTN","BPSRES",159,0) ;Check for "^" or timeout "RTN","BPSRES",160,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSRES",161,0) S BPPRETYP=$P(Y,U,2) "RTN","BPSRES",162,0) K X,DIC,Y "RTN","BPSRES",163,0) ; "RTN","BPSRES",164,0) ;Submission Clarification Code 1 "RTN","BPSRES",165,0) S DIC("B")=BPCLCD1 "RTN","BPSRES",166,0) S DIC(0)="QEAM",DIC=9002313.25,DIC("A")="Submission Clarification Code 1: " "RTN","BPSRES",167,0) D ^DIC "RTN","BPSRES",168,0) ;Check for "^" or timeout "RTN","BPSRES",169,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSRES",170,0) S BPCLCD1=$P(Y,U,2) "RTN","BPSRES",171,0) K X,DIC,Y "RTN","BPSRES",172,0) ; "RTN","BPSRES",173,0) ;Submission Clarification Code 2 "RTN","BPSRES",174,0) I +BPCLCD2 S BPCLCD2=+BPCLCD2 S DIC("B")=BPCLCD2 "RTN","BPSRES",175,0) S DIC(0)="QEAM",DIC=9002313.25,DIC("A")="Submission Clarification Code 2: ",DUP=0 "RTN","BPSRES",176,0) F D Q:BPQ=-1 Q:'DUP "RTN","BPSRES",177,0) . D ^DIC "RTN","BPSRES",178,0) . ;Check for "^" or timeout "RTN","BPSRES",179,0) . I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y Q "RTN","BPSRES",180,0) . S BPCLCD2=$P(Y,U,2) "RTN","BPSRES",181,0) . S DUP=0 I BPCLCD2=BPCLCD1 S BPCLCD2="" W !," Duplicates not allowed" S DUP=1 "RTN","BPSRES",182,0) K X,DIC,Y "RTN","BPSRES",183,0) I BPQ=-1 G XPROMPTS "RTN","BPSRES",184,0) ; "RTN","BPSRES",185,0) ;Submission Clarification Code 3 "RTN","BPSRES",186,0) I BPCLCD2'="" D I BPQ=-1 G XPROMPTS "RTN","BPSRES",187,0) . I +BPCLCD3 S BPCLCD3=+BPCLCD3 S DIC("B")=BPCLCD3 "RTN","BPSRES",188,0) . S DIC(0)="QEAM",DIC=9002313.25,DIC("A")="Submission Clarification Code 3: ",DUP=0 "RTN","BPSRES",189,0) . F D Q:'DUP I BPQ=-1 Q "RTN","BPSRES",190,0) .. D ^DIC "RTN","BPSRES",191,0) .. ;Check for "^" or timeout "RTN","BPSRES",192,0) .. I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y Q "RTN","BPSRES",193,0) .. S BPCLCD3=$P(Y,U,2) "RTN","BPSRES",194,0) .. S DUP=0 I BPCLCD3=BPCLCD1!(BPCLCD3=BPCLCD2) S BPCLCD3="" W !," Duplicates not allowed" S DUP=1 "RTN","BPSRES",195,0) . K X,DIC,Y "RTN","BPSRES",196,0) ; "RTN","BPSRES",197,0) ;Patient Residence Code "RTN","BPSRES",198,0) N X,DIC,Y "RTN","BPSRES",199,0) S DIC("B")=+BPPTRES "RTN","BPSRES",200,0) S DIC(0)="QEAM",DIC=9002313.27,DIC("A")="Patient Residence Code: " "RTN","BPSRES",201,0) D ^DIC "RTN","BPSRES",202,0) ;Check for "^" or timeout "RTN","BPSRES",203,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSRES",204,0) S BPPTRES=$P(Y,U,2) "RTN","BPSRES",205,0) K X,DIC,Y "RTN","BPSRES",206,0) ; "RTN","BPSRES",207,0) ;Pharmacy Service Type Code "RTN","BPSRES",208,0) N X,DIC,Y "RTN","BPSRES",209,0) S DIC("B")=+BPPHSRV "RTN","BPSRES",210,0) S DIC(0)="QEAM",DIC=9002313.28,DIC("A")="Pharmacy Service Type Code: " "RTN","BPSRES",211,0) D ^DIC "RTN","BPSRES",212,0) ;Check for "^" or timeout "RTN","BPSRES",213,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSRES",214,0) S BPPHSRV=$P(Y,U,2) "RTN","BPSRES",215,0) K X,DIC,Y "RTN","BPSRES",216,0) ; "RTN","BPSRES",217,0) ;Delay Reason Code "RTN","BPSRES",218,0) N X,DIC,Y "RTN","BPSRES",219,0) S DIC("B")=BPDLYRS "RTN","BPSRES",220,0) S DIC(0)="QEAM",DIC=9002313.29,DIC("A")="Delay Reason Code: " "RTN","BPSRES",221,0) D ^DIC "RTN","BPSRES",222,0) ;Check for "^" or timeout "RTN","BPSRES",223,0) I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS "RTN","BPSRES",224,0) S BPDLYRS=$P(Y,U,2) "RTN","BPSRES",225,0) K X,DIC,Y "RTN","BPSRES",226,0) ; "RTN","BPSRES",227,0) ;Ask to proceed "RTN","BPSRES",228,0) I BPCOB=1 W ! S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)") I BPQ'=1 S BPQ=-1 G XPROMPTS "RTN","BPSRES",229,0) S BPQ=1 "RTN","BPSRES",230,0) ; "RTN","BPSRES",231,0) ;Save into BPS NCPDP OVERRIDES (#9002313.511) "RTN","BPSRES",232,0) S BPFDA(9002313.511,"+1,",.01)=BP59 "RTN","BPSRES",233,0) D NOW^%DTC "RTN","BPSRES",234,0) S BPFDA(9002313.511,"+1,",.02)=% "RTN","BPSRES",235,0) S BPFLD=$O(^BPSF(9002313.91,"B",303,"")) I BPFLD]"" S BPFDA(9002313.5111,"+2,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+2,+1,",.02)=BPPSNCD "RTN","BPSRES",236,0) S BPFLD=$O(^BPSF(9002313.91,"B",306,"")) I BPFLD]"" S BPFDA(9002313.5111,"+3,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+3,+1,",.02)=BPRELCD "RTN","BPSRES",237,0) S BPFLD=$O(^BPSF(9002313.91,"B",462,"")) I BPFLD]"" S BPFDA(9002313.5111,"+4,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+4,+1,",.02)=BPPREAUT "RTN","BPSRES",238,0) S BPFLD=$O(^BPSF(9002313.91,"B",461,"")) I BPFLD]"" S BPFDA(9002313.5111,"+5,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+5,+1,",.02)=BPPRETYP "RTN","BPSRES",239,0) S BPFLD=$O(^BPSF(9002313.91,"B",420,"")) I BPFLD]"" S BPFDA(9002313.5111,"+6,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+6,+1,",.02)=BPCLCD1_"~"_$G(BPCLCD2)_"~"_$G(BPCLCD3) "RTN","BPSRES",240,0) S BPFLD=$O(^BPSF(9002313.91,"B",384,"")) I BPFLD]"" S BPFDA(9002313.5111,"+7,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+7,+1,",.02)=BPPTRES "RTN","BPSRES",241,0) S BPFLD=$O(^BPSF(9002313.91,"B",147,"")) I BPFLD]"" S BPFDA(9002313.5111,"+8,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+8,+1,",.02)=BPPHSRV "RTN","BPSRES",242,0) S BPFLD=$O(^BPSF(9002313.91,"B",357,"")) I BPFLD]"" S BPFDA(9002313.5111,"+9,+1,",.01)=BPFLD,BPFDA(9002313.5111,"+9,+1,",.02)=BPDLYRS "RTN","BPSRES",243,0) D UPDATE^DIE("","BPFDA","BPOVRIEN","BPMSG") "RTN","BPSRES",244,0) ; "RTN","BPSRES",245,0) I $D(BPMSG("DIERR")) W !!,"Could Not Save Override information into BPS NCPDP OVERRIDES FILES",! S BPQ=-1 G XPROMPTS "RTN","BPSRES",246,0) ; "RTN","BPSRES",247,0) XPROMPTS ; "RTN","BPSRES",248,0) S BPOVRIEN=$S(BPQ=-1:BPQ,$G(BPOVRIEN(1))]"":BPOVRIEN(1),1:-1) "RTN","BPSRES",249,0) Q BPOVRIEN "RTN","BPSRES",250,0) ; "RTN","BPSRES",251,0) ;Prompt User for Claim to Resubmit (w/EDITS) "RTN","BPSRES",252,0) ; "RTN","BPSRES",253,0) ; Input values -> BPROMPT - prompt string "RTN","BPSRES",254,0) ; BPERRMES - the message to display when the user tries "RTN","BPSRES",255,0) ; to make multi line selection (optional) "RTN","BPSRES",256,0) ; Piece "RTN","BPSRES",257,0) ;output values -> 1 - 1 = okay, <0 = errors, 0 = quit "RTN","BPSRES",258,0) ; 2 - patient ien #2 "RTN","BPSRES",259,0) ; 3 - insurance ien #36 "RTN","BPSRES",260,0) ; 4 - ptr to #9002313.59 "RTN","BPSRES",261,0) ; 5 - 1st line for index(es) in LM "VALM" array "RTN","BPSRES",262,0) ; 6 - patient's index "RTN","BPSRES",263,0) ; 7 - claim's index "RTN","BPSRES",264,0) ASKLINE(BPROMPT,BPERRMES) ; "RTN","BPSRES",265,0) N BPRET,BPCNT "RTN","BPSRES",266,0) S BPRET="",BPCNT=0 "RTN","BPSRES",267,0) F S BPRET=$$SELLINE^BPSSCRU4(BPROMPT,"C",VALMAR,"") Q:BPRET'<0 D "RTN","BPSRES",268,0) . ; "RTN","BPSRES",269,0) . I BPCNT<1 S BPCNT=BPCNT+1 W ! "RTN","BPSRES",270,0) . E S BPCNT=0 D RE^VALM4 "RTN","BPSRES",271,0) . I BPRET=-1 W "Invalid line number" ; (invalid Patient summary line)" "RTN","BPSRES",272,0) . I BPRET=-8 W $S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number") "RTN","BPSRES",273,0) . I BPRET=-4 W "Invalid line number" ; (invalid RX line)" "RTN","BPSRES",274,0) . I BPRET=-2 W "Please select Patient's summary line." "RTN","BPSRES",275,0) . I BPRET=-3 W "Please specify RX line." "RTN","BPSRES",276,0) . I ",-1,-8,-4,-2,-3,"'[(","_BPRET_",") W "Incorrect format." ; Corrupted array (",BPRET,")" "RTN","BPSRES",277,0) Q BPRET "RTN","BPSRES",278,0) ; "RTN","BPSRES",279,0) ; "RTN","BPSRES",280,0) COBFLDS(BP59,BPRXIEN,BPRXR,BPDOSDT,BPSWHERE,BPOVRIEN) ; "RTN","BPSRES",281,0) N BPSECOND,BPSPL59,BPRTTP59,BPRET,BPENGINE,BPSPLAN,BPRATTYP "RTN","BPSRES",282,0) S BPSECOND("PRESCRIPTION")=BPRXIEN "RTN","BPSRES",283,0) S BPSECOND("FILL NUMBER")=BPRXR "RTN","BPSRES",284,0) S BPSECOND("FILL DATE")=BPDOSDT "RTN","BPSRES",285,0) S BPSPLAN=$$GETPL59^BPSPRRX5(BP59) "RTN","BPSRES",286,0) S BPRATTYP=$$GETRTP59^BPSPRRX5(BP59) "RTN","BPSRES",287,0) S BPSECOND("PRIMARY BILL")=$$GETBIL59^BPSPRRX5(BP59) "RTN","BPSRES",288,0) I $$RES2NDCL^BPSPRRX6(BP59,.BPSPL59,.BPSECOND,.BPRTTP59) "RTN","BPSRES",289,0) ; BPSECOND("RXCOB"),BPSECOND("PLAN"),BPSECOND("RTYPE") will be added in BPSNCPD4 and BPSNCPD5 "RTN","BPSRES",290,0) ; Note: BPSECOND("PRIMARY BILL") will be populated by the following call "RTN","BPSRES",291,0) S BPRET=$$PRIMDATA^BPSPRRX4($$IEN59^BPSOSRX(BPRXIEN,BPRXR,1),.BPSECOND,1,1) "RTN","BPSRES",292,0) I BPRET=0 D GETFR52^BPSPRRX4(BPRXIEN,BPRXR,.BPSECOND) "RTN","BPSRES",293,0) ; "RTN","BPSRES",294,0) I $$PROMPTS^BPSPRRX3(.BPSECOND)=-1 Q "-100^Action cancelled" "RTN","BPSRES",295,0) S BPSECOND("NEW COB DATA")=1 "RTN","BPSRES",296,0) S BPENGINE=$$SUBMCLM^BPSPRRX2(BPSECOND("PRESCRIPTION"),BPSECOND("FILL NUMBER"),BPSECOND("FILL DATE"),BPSWHERE,BPSECOND("BILLNDC"),2,BPSECOND("PLAN"),.BPSECOND,BPSECOND("RTYPE"),"ECME RESUBMIT",BPOVRIEN) "RTN","BPSRES",297,0) I +BPENGINE=4 W !!,$P(BPENGINE,U,2),! "RTN","BPSRES",298,0) Q BPENGINE "RTN","BPSRES",299,0) ; "RTN","BPSRPAY") 0^56^B33669319 "RTN","BPSRPAY",1,0) BPSRPAY ;BHAM ISC/BEE - ECME REPORTS ;11/15/07 14:13 "RTN","BPSRPAY",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,7,10**;JUN 2004;Build 27 "RTN","BPSRPAY",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPAY",4,0) ; "RTN","BPSRPAY",5,0) Q "RTN","BPSRPAY",6,0) ; "RTN","BPSRPAY",7,0) ; Payer Sheet Display Report "RTN","BPSRPAY",8,0) ; "RTN","BPSRPAY",9,0) ;User Prompts "RTN","BPSRPAY",10,0) EN N BPFILE,BPIEN,BPSCR,BPQ "RTN","BPSRPAY",11,0) S BPFILE=9002313.92 "RTN","BPSRPAY",12,0) ; "RTN","BPSRPAY",13,0) ;Select Payer Sheet "RTN","BPSRPAY",14,0) I $D(IOF) W @IOF "RTN","BPSRPAY",15,0) W !,"Payer Sheet Detail Report",!! "RTN","BPSRPAY",16,0) S BPIEN=$$BPIEN(BPFILE) "RTN","BPSRPAY",17,0) ; "RTN","BPSRPAY",18,0) ;Check for Valid Entry "RTN","BPSRPAY",19,0) I BPIEN=-1 G EXIT "RTN","BPSRPAY",20,0) ; "RTN","BPSRPAY",21,0) ;Select Device "RTN","BPSRPAY",22,0) I $$DEVICE=-1 G EXIT "RTN","BPSRPAY",23,0) ; "RTN","BPSRPAY",24,0) ;Display Data "RTN","BPSRPAY",25,0) D RUN(BPFILE,BPIEN) "RTN","BPSRPAY",26,0) ; "RTN","BPSRPAY",27,0) ;Exit "RTN","BPSRPAY",28,0) EXIT Q "RTN","BPSRPAY",29,0) ; "RTN","BPSRPAY",30,0) ;Display the Payer Sheet Info "RTN","BPSRPAY",31,0) ; "RTN","BPSRPAY",32,0) RUN(BPFILE,BPIEN) N BPQ "RTN","BPSRPAY",33,0) D PSPRNT(BPFILE,BPIEN) "RTN","BPSRPAY",34,0) Q "RTN","BPSRPAY",35,0) ; "RTN","BPSRPAY",36,0) ; Select a payer sheet "RTN","BPSRPAY",37,0) BPIEN(BPFILE) N DIC,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPAY",38,0) S DIC=$$ROOT^DILFD(BPFILE),DIC(0)="AEMQ" "RTN","BPSRPAY",39,0) S DIC("A")="Select Payer Sheet: " "RTN","BPSRPAY",40,0) D ^DIC "RTN","BPSRPAY",41,0) Q +Y "RTN","BPSRPAY",42,0) ; "RTN","BPSRPAY",43,0) ;Select the output Device "RTN","BPSRPAY",44,0) DEVICE() N %ZIS,ZTSK,ZTRTN,ZTIO,ZTSAVE,ZTDESC,POP,BPQ "RTN","BPSRPAY",45,0) S BPQ=0 "RTN","BPSRPAY",46,0) S %ZIS="QM" "RTN","BPSRPAY",47,0) W ! D ^%ZIS "RTN","BPSRPAY",48,0) I POP Q -1 "RTN","BPSRPAY",49,0) S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0) "RTN","BPSRPAY",50,0) I $D(IO("Q")) D S BPQ=-1 "RTN","BPSRPAY",51,0) . S ZTRTN="RUN^BPSRPAY(BPFILE,BPIEN)" "RTN","BPSRPAY",52,0) . S ZTIO=ION "RTN","BPSRPAY",53,0) . S ZTSAVE("*")="" "RTN","BPSRPAY",54,0) . S ZTDESC="PAYER SHEET DETAIL REPORT" "RTN","BPSRPAY",55,0) . D ^%ZTLOAD "RTN","BPSRPAY",56,0) . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") "RTN","BPSRPAY",57,0) . D HOME^%ZIS "RTN","BPSRPAY",58,0) U IO "RTN","BPSRPAY",59,0) Q BPQ "RTN","BPSRPAY",60,0) ; "RTN","BPSRPAY",61,0) ; Payer Sheet Display "RTN","BPSRPAY",62,0) PSPRNT(BPFILE,EN) N BPSHDR,BPIEN,BPPAGE,BPQ,CD,L,N,N1,N2,NAME,NM,NUM,SEG,SP "RTN","BPSRPAY",63,0) N SEGNM,TB,WP,X,X0,X5,ZTREQ "RTN","BPSRPAY",64,0) ; "RTN","BPSRPAY",65,0) ; Build List of Segment Header Names "RTN","BPSRPAY",66,0) D INIT "RTN","BPSRPAY",67,0) ; "RTN","BPSRPAY",68,0) ; Get header information "RTN","BPSRPAY",69,0) S BPIEN=EN_"," "RTN","BPSRPAY",70,0) D GETS^DIQ(BPFILE,EN,".01;1.02;1.06;1.14","","BPSHDR") "RTN","BPSRPAY",71,0) ; "RTN","BPSRPAY",72,0) ; Display Header Information "RTN","BPSRPAY",73,0) S BPQ=0,BPPAGE=0,SEGNM="" "RTN","BPSRPAY",74,0) D HDR "RTN","BPSRPAY",75,0) ; "RTN","BPSRPAY",76,0) ; Field Detail Information "RTN","BPSRPAY",77,0) ; Loop through Segments "RTN","BPSRPAY",78,0) S SEG=99 F S SEG=$O(^BPSF(BPFILE,EN,SEG)) Q:+SEG=0!(SEG>260) D I BPQ Q "RTN","BPSRPAY",79,0) . ; "RTN","BPSRPAY",80,0) . ;Make sure there are entries for the segment "RTN","BPSRPAY",81,0) . I $P($G(^BPSF(BPFILE,EN,SEG,0)),U,4)<1 Q "RTN","BPSRPAY",82,0) . ; "RTN","BPSRPAY",83,0) . ; Get and display Segment Name "RTN","BPSRPAY",84,0) . S SEGNM=$G(NAME(SEG)) "RTN","BPSRPAY",85,0) . ; Check that we can display the Segment Name and at least one additional field "RTN","BPSRPAY",86,0) . D CHKP(2) I BPQ Q "RTN","BPSRPAY",87,0) . I BPPAGE=1!($Y>5) W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***" "RTN","BPSRPAY",88,0) . ; Loop through the Field via the Sequence Number "RTN","BPSRPAY",89,0) . S N=0 F S N=$O(^BPSF(BPFILE,EN,SEG,"B",N)) Q:N="" D I BPQ Q "RTN","BPSRPAY",90,0) .. S N1=0 F S N1=$O(^BPSF(BPFILE,EN,SEG,"B",N,N1)) Q:N1="" D I BPQ Q "RTN","BPSRPAY",91,0) ... ; "RTN","BPSRPAY",92,0) ... ; Get Field Data and Format the Field Number "RTN","BPSRPAY",93,0) ... S X=$G(^BPSF(BPFILE,EN,SEG,N1,0)) "RTN","BPSRPAY",94,0) ... S NUM=$P(X,U,2),SP=$P(X,U,3) "RTN","BPSRPAY",95,0) ... I NUM S X0=$G(^BPSF(9002313.91,NUM,0)),X5=$G(^BPSF(9002313.91,NUM,5)) "RTN","BPSRPAY",96,0) ... E S (X0,X5)="" "RTN","BPSRPAY",97,0) ... S NUM=$P(X0,U,1)_"-"_$P(X5,U,1),NM=$P(X0,U,3) "RTN","BPSRPAY",98,0) ... ; "RTN","BPSRPAY",99,0) ... ; Display the field information "RTN","BPSRPAY",100,0) ... D CHKP(1) I BPQ Q "RTN","BPSRPAY",101,0) ... W !,N,?5,NUM,?17,NM,?71,$J(SP,9) "RTN","BPSRPAY",102,0) ... ; "RTN","BPSRPAY",103,0) ... ; If there is special code, display it "RTN","BPSRPAY",104,0) ... I SP="X" S N2=0 F S N2=$O(^BPSF(BPFILE,EN,SEG,N1,1,N2)) Q:N2="" D I BPQ Q "RTN","BPSRPAY",105,0) .... S CD=$G(^BPSF(BPFILE,EN,SEG,N1,1,N2,0)) "RTN","BPSRPAY",106,0) .... S TB=19,L=61,WP=0 "RTN","BPSRPAY",107,0) .... F D CHKP(1) Q:BPQ W ! D Q:CD="" "RTN","BPSRPAY",108,0) ..... W:N2=1 ?5,"Special Code: " "RTN","BPSRPAY",109,0) ..... W:WP=1 ?12,"" "RTN","BPSRPAY",110,0) ..... W ?19,$E(CD,1,L) "RTN","BPSRPAY",111,0) ..... S CD=$E(CD,L+1,200) Q:CD="" "RTN","BPSRPAY",112,0) ..... S WP=1 "RTN","BPSRPAY",113,0) . I BPQ Q "RTN","BPSRPAY",114,0) .D CHKP(1) Q:BPQ W ! "RTN","BPSRPAY",115,0) I 'BPSCR W !,@IOF "RTN","BPSRPAY",116,0) E I 'BPQ D PAUSE2 "RTN","BPSRPAY",117,0) I $D(ZTQUEUED) S ZTREQ="@" Q "RTN","BPSRPAY",118,0) D ^%ZISC "RTN","BPSRPAY",119,0) XPRT Q "RTN","BPSRPAY",120,0) ; "RTN","BPSRPAY",121,0) ;Display Report Header "RTN","BPSRPAY",122,0) ; "RTN","BPSRPAY",123,0) HDR S BPPAGE=$G(BPPAGE)+1 "RTN","BPSRPAY",124,0) W @IOF "RTN","BPSRPAY",125,0) W "Payer Sheet Detail Report" "RTN","BPSRPAY",126,0) W ?48,"Print Date: "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) "RTN","BPSRPAY",127,0) W " Page:",$J(BPPAGE,3) "RTN","BPSRPAY",128,0) W !,$J("Payer Sheet Name: ",20),$G(BPSHDR(BPFILE,BPIEN,.01)) "RTN","BPSRPAY",129,0) W ?40,$J("Version Number: ",20),$G(BPSHDR(BPFILE,BPIEN,1.14)) "RTN","BPSRPAY",130,0) I BPPAGE=1 D "RTN","BPSRPAY",131,0) . W !,$J("Status: ",20),$G(BPSHDR(BPFILE,BPIEN,1.06)) "RTN","BPSRPAY",132,0) . W ?40,$J("NCPDP Version: ",20),$G(BPSHDR(BPFILE,BPIEN,1.02)) "RTN","BPSRPAY",133,0) ; "RTN","BPSRPAY",134,0) ; Display subheader "RTN","BPSRPAY",135,0) W !!,"Seq",?5,"Field",?17,"Field Name",?71,"Proc Mode" "RTN","BPSRPAY",136,0) W !,"---",?5,"-----",?17,"----------",?71,"---------" "RTN","BPSRPAY",137,0) I $G(SEGNM)]"" W !,?((60-$L(SEGNM)+8)/2),"*** ",SEGNM," ***" "RTN","BPSRPAY",138,0) Q "RTN","BPSRPAY",139,0) ; "RTN","BPSRPAY",140,0) ;Check for End of Page "RTN","BPSRPAY",141,0) ; "RTN","BPSRPAY",142,0) ; Input variable -> BPLINES - Number of lines from bottom "RTN","BPSRPAY",143,0) ; CONT - 0 = New Entry, 1 = Continue Entry "RTN","BPSRPAY",144,0) ; "RTN","BPSRPAY",145,0) CHKP(BPLINES) S BPLINES=BPLINES+1 "RTN","BPSRPAY",146,0) I $G(BPSCR) S BPLINES=BPLINES+3 "RTN","BPSRPAY",147,0) I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE Q:$G(BPQ) 0 D HDR Q 1 "RTN","BPSRPAY",148,0) Q 0 "RTN","BPSRPAY",149,0) ; "RTN","BPSRPAY",150,0) PAUSE ; "RTN","BPSRPAY",151,0) N X "RTN","BPSRPAY",152,0) U IO(0) "RTN","BPSRPAY",153,0) R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME "RTN","BPSRPAY",154,0) I '$T S X="^" "RTN","BPSRPAY",155,0) I X["^" S BPQ=1 "RTN","BPSRPAY",156,0) U IO "RTN","BPSRPAY",157,0) Q "RTN","BPSRPAY",158,0) ; "RTN","BPSRPAY",159,0) PAUSE2 ; "RTN","BPSRPAY",160,0) N X "RTN","BPSRPAY",161,0) U IO(0) "RTN","BPSRPAY",162,0) R !,"Press RETURN to continue: ",X:DTIME "RTN","BPSRPAY",163,0) U IO "RTN","BPSRPAY",164,0) Q "RTN","BPSRPAY",165,0) ; "RTN","BPSRPAY",166,0) INIT ; Create local array of segment header names "RTN","BPSRPAY",167,0) S NAME(100)="Transaction Header Segment",NAME(110)="Patient Segment" "RTN","BPSRPAY",168,0) S NAME(120)="Insurance Segment",NAME(130)="Claim Segment" "RTN","BPSRPAY",169,0) S NAME(140)="Pharmacy Provider Segment",NAME(150)="Prescriber Segment" "RTN","BPSRPAY",170,0) S NAME(160)="COB/Other Payments Segment",NAME(170)="Workers' Compensation Segment" "RTN","BPSRPAY",171,0) S NAME(180)="DUR/PPS Segment",NAME(190)="Pricing Segment" "RTN","BPSRPAY",172,0) S NAME(200)="Coupon Segment",NAME(210)="Compound Segment" "RTN","BPSRPAY",173,0) S NAME(220)="Prior Authorization Segment",NAME(230)="Clinical Segment" "RTN","BPSRPAY",174,0) S NAME(240)="Additional Documentation Segment",NAME(250)="Facility Segment" "RTN","BPSRPAY",175,0) S NAME(260)="Narrative Segment" "RTN","BPSRPAY",176,0) Q "RTN","BPSRPT0") 0^4^B22539987 "RTN","BPSRPT0",1,0) BPSRPT0 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05 "RTN","BPSRPT0",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSRPT0",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPT0",4,0) ; "RTN","BPSRPT0",5,0) Q "RTN","BPSRPT0",6,0) ; "RTN","BPSRPT0",7,0) ; Front End for ECME Reports "RTN","BPSRPT0",8,0) ; "RTN","BPSRPT0",9,0) ; Input variable: BPRTYPE -> 1 = Payable Claims "RTN","BPSRPT0",10,0) ; 2 = Rejected Claims "RTN","BPSRPT0",11,0) ; 3 = Claims Submitted, Not Yet Released "RTN","BPSRPT0",12,0) ; 4 = Reversed Claims "RTN","BPSRPT0",13,0) ; 5 = Recent Transactions "RTN","BPSRPT0",14,0) ; 6 = Totals By Date "RTN","BPSRPT0",15,0) ; 7 = Closed Claims "RTN","BPSRPT0",16,0) ; 8 = Spending Account Report "RTN","BPSRPT0",17,0) ; "RTN","BPSRPT0",18,0) ; Passed variables - The following local variables are passed around the BPSRPT* routines "RTN","BPSRPT0",19,0) ; and are not passed as parameters but are assumed to be defined: "RTN","BPSRPT0",20,0) ; BPACREJ,BPAUTREV,BPBEGDT,BPBLINE,BPCCRSN,BPDRGCL,BPDRUG,BPENDDT,BPEXCEL, "RTN","BPSRPT0",21,0) ; BPINSINF,BPGRPLN,BPMWC,BPNOW,BPPAGE,BPPHARM,BPQ,BPQSTDRG, "RTN","BPSRPT0",22,0) ; BPRLNRL,BPRTBCK,BPSDATA,BPSUMDET,BPRTYPE "RTN","BPSRPT0",23,0) ; "RTN","BPSRPT0",24,0) EN(BPRTYPE) N %,BPACREJ,BPAUTREV,BPBEGDT,BPCCRSN,BPDRGCL,BPDRUG,BPENDDT,BPEXCEL,BPNOW,BPPHARM,BPINSINF,BPMWC,BPQ,BPQSTDRG "RTN","BPSRPT0",25,0) N BPREJCD,BPRLNRL,BPRPTNAM,BPRTBCK,BPSCR,BPSUMDET,CODE,POS,STAT,X,Y,BPINS,BPARR,BPELIG,BPOPCL "RTN","BPSRPT0",26,0) ; "RTN","BPSRPT0",27,0) ;Verify that a valid report has been requested "RTN","BPSRPT0",28,0) I ",1,2,3,4,5,6,7,8,"'[(","_$G(BPRTYPE)_",") W "" H 3 Q "RTN","BPSRPT0",29,0) S BPRPTNAM=$P("PAYABLE CLAIMS^REJECTED CLAIMS^SUBMIT,NOT RELEASED CLAIMS^REVERSED CLAIMS^RECENT TRANSACTIONS^TOTALS^CLOSED CLAIMS^SPENDING ACCOUNT REPORT","^",BPRTYPE) "RTN","BPSRPT0",30,0) ; "RTN","BPSRPT0",31,0) ;Get current Date/Time "RTN","BPSRPT0",32,0) D NOW^%DTC S Y=% D DD^%DT S BPNOW=Y "RTN","BPSRPT0",33,0) ; "RTN","BPSRPT0",34,0) ;Prompt for ECME Pharmacy Division(s) (No Default) "RTN","BPSRPT0",35,0) ;Sets up BPPHARM variable and array, BPPHARM =0 ALL or BPPHARM=1,BPPHARM(ptr) for list "RTN","BPSRPT0",36,0) S X=$$SELPHARM^BPSRPT3() I X="^" G EXIT "RTN","BPSRPT0",37,0) ; "RTN","BPSRPT0",38,0) ;Prompt to Display Summary or Detail Format (Default to Detail) "RTN","BPSRPT0",39,0) ;Returns 1 for Summary, 0 for Detail "RTN","BPSRPT0",40,0) S BPSUMDET=$$SELSMDET^BPSRPT3(2) I BPSUMDET="^" G EXIT "RTN","BPSRPT0",41,0) ; "RTN","BPSRPT0",42,0) ;Prompt to allow selection of Multiple Insurances or All (Default to ALL) "RTN","BPSRPT0",43,0) ;See description for $$INSURSEL^BPSSCRCU "RTN","BPSRPT0",44,0) S BPINS=$$INSURSEL^BPSSCRCU(.BPARR,DUZ) I BPINS<1 G EXIT "RTN","BPSRPT0",45,0) S BPINSINF=$S(BPARR(1.11)="I":BPARR("INS"),1:0) "RTN","BPSRPT0",46,0) ; "RTN","BPSRPT0",47,0) ;Prompt to Display (C)MOP or (M)ail or (W)indow or (A)LL (Default to ALL) "RTN","BPSRPT0",48,0) ;Returns (A-ALL,M-Mail,W-Window,C-CMOP) "RTN","BPSRPT0",49,0) S BPMWC=$$SELMWC^BPSRPT3("A") I BPMWC="^" G EXIT "RTN","BPSRPT0",50,0) ; "RTN","BPSRPT0",51,0) ;Prompt to Display (R)ealTime Fills or (B)ackbills or (A)LL (Default to ALL) "RTN","BPSRPT0",52,0) ;Returns (1-ALL,2-RealTime Fills,3-Backbills) "RTN","BPSRPT0",53,0) S BPRTBCK=$$SELRTBCK^BPSRPT3(1) I BPRTBCK="^" G EXIT "RTN","BPSRPT0",54,0) ; "RTN","BPSRPT0",55,0) ;Prompt to Display Specific (D)rug or Drug (C)lass or (A)ll (Default to ALL) "RTN","BPSRPT0",56,0) ;Returns (1-ALL,2-Drug,3-Drug Class) "RTN","BPSRPT0",57,0) S BPQSTDRG=$$SELDRGAL^BPSRPT3(1) I BPQSTDRG="^" Q "RTN","BPSRPT0",58,0) ; "RTN","BPSRPT0",59,0) ;Prompt to Select Drug (No Default) "RTN","BPSRPT0",60,0) S BPDRUG=0 I BPQSTDRG=2 S BPDRUG=$$SELDRG^BPSRPT3() I BPDRUG="^" G EXIT "RTN","BPSRPT0",61,0) ; "RTN","BPSRPT0",62,0) ;Prompt to Select Drug Class (No Default) "RTN","BPSRPT0",63,0) S BPDRGCL=0 I BPQSTDRG=3 S BPDRGCL=$$SELDRGCL^BPSRPT3() I BPDRGCL="^" G EXIT "RTN","BPSRPT0",64,0) ; "RTN","BPSRPT0",65,0) ;Report Specific Prompts "RTN","BPSRPT0",66,0) ; "RTN","BPSRPT0",67,0) ;Prompt to select Date Range "RTN","BPSRPT0",68,0) ;Returns (Start Date^End Date) "RTN","BPSRPT0",69,0) I (",1,2,3,4,5,6,7,8,")[BPRTYPE S BPBEGDT=$$SELDATE^BPSRPT3(BPRTYPE) D I BPBEGDT="^" G EXIT "RTN","BPSRPT0",70,0) .I BPBEGDT="^" Q "RTN","BPSRPT0",71,0) .S BPENDDT=$P(BPBEGDT,U,2) "RTN","BPSRPT0",72,0) .S BPBEGDT=$P(BPBEGDT,U) "RTN","BPSRPT0",73,0) ; "RTN","BPSRPT0",74,0) ;Prompt to Include (R)ELEASED or (N)OT RELEASED or (A)LL (Default to RELEASED) "RTN","BPSRPT0",75,0) ;Returns (1-ALL,2-RELEASED,3-NOT RELEASED) "RTN","BPSRPT0",76,0) S BPRLNRL=$S(BPRTYPE=3:3,1:1) I (",1,2,4,6,7,8,")[BPRTYPE S BPRLNRL=$$SELRLNRL^BPSRPT4(2) I BPRLNRL="^" G EXIT "RTN","BPSRPT0",77,0) ; "RTN","BPSRPT0",78,0) ;Prompt to Include (S)pecific Reject Code or (A)LL (Default to ALL) "RTN","BPSRPT0",79,0) ;Returns (0-ALL,ptr-Pointer to Selected Reject Code in #9002313.93) "RTN","BPSRPT0",80,0) S BPREJCD=0 I (",2,")[BPRTYPE S BPREJCD=$$SELREJCD^BPSRPT4(0) I BPREJCD="^" G EXIT "RTN","BPSRPT0",81,0) ; "RTN","BPSRPT0",82,0) ;Prompt to Include Auto(R)eversed or (A)LL (Default to ALL) "RTN","BPSRPT0",83,0) ;Returns (0-All,1-AutoReversed) "RTN","BPSRPT0",84,0) S BPAUTREV=0 I (",4,")[BPRTYPE S BPAUTREV=$$SELAUREV^BPSRPT4(0) I BPAUTREV="^" G EXIT "RTN","BPSRPT0",85,0) ; "RTN","BPSRPT0",86,0) ;Prompt to Include A(C)cepted or (R)ejected or (A)LL (Default to REJECTED) "RTN","BPSRPT0",87,0) ;Returns (0-All,1-Rejected,2-Accepted) "RTN","BPSRPT0",88,0) S BPACREJ=0 I (",4,")[BPRTYPE S BPACREJ=$$SELACREJ^BPSRPT4(1) I BPACREJ="^" G EXIT "RTN","BPSRPT0",89,0) ; "RTN","BPSRPT0",90,0) ;Prompt to Include (S)pecific Close Claim Reason or (A)ll (Default to All) "RTN","BPSRPT0",91,0) ;Returns (0-All,ptr-Pointer to #356.8) "RTN","BPSRPT0",92,0) S BPCCRSN=0 I (",7,")[BPRTYPE S BPCCRSN=$$SELCCRSN^BPSRPT4(0) I BPCCRSN="^" G EXIT "RTN","BPSRPT0",93,0) ; "RTN","BPSRPT0",94,0) ;Prompt for Eligibility Indicator for rejected claims report "RTN","BPSRPT0",95,0) ;Returns (V=Veteran,T=TRICARE,0=All) "RTN","BPSRPT0",96,0) S BPELIG=0 I (",2,")[BPRTYPE S BPELIG=$$SELELIG^BPSRPT3(1) I BPELIG="^" G EXIT "RTN","BPSRPT0",97,0) ; "RTN","BPSRPT0",98,0) ;Prompt for Open/Closed/All claims "RTN","BPSRPT0",99,0) ;Returns (1=Closed,2=Open,0=All) "RTN","BPSRPT0",100,0) S BPOPCL=0 I (",2,")[BPRTYPE S BPOPCL=$$SELOPCL^BPSRPT3(2) I BPOPCL="^" G EXIT "RTN","BPSRPT0",101,0) ; "RTN","BPSRPT0",102,0) ;Prompt for Excel Capture (Detail Only) "RTN","BPSRPT0",103,0) S BPEXCEL=0 I 'BPSUMDET S BPEXCEL=$$SELEXCEL^BPSRPT4() I BPEXCEL="^" G EXIT "RTN","BPSRPT0",104,0) ; "RTN","BPSRPT0",105,0) ;Prompt for the Device "RTN","BPSRPT0",106,0) I 'BPEXCEL D "RTN","BPSRPT0",107,0) .W !!,"WARNING - THIS REPORT REQUIRES THAT A DEVICE WITH 132 COLUMN WIDTH BE USED." "RTN","BPSRPT0",108,0) .W !,"IT WILL NOT DISPLAY CORRECTLY USING 80 COLUMN WIDTH DEVICES",! "RTN","BPSRPT0",109,0) S BPQ=0 D DEVICE(BPRPTNAM) Q:BPQ "RTN","BPSRPT0",110,0) ; "RTN","BPSRPT0",111,0) ;Compile and Run the Report "RTN","BPSRPT0",112,0) D RUN(BPEXCEL,BPRPTNAM,BPSUMDET) "RTN","BPSRPT0",113,0) I 'BPQ D PAUSE2^BPSRPT1 "RTN","BPSRPT0",114,0) ; "RTN","BPSRPT0",115,0) EXIT Q "RTN","BPSRPT0",116,0) ; "RTN","BPSRPT0",117,0) ;Compile and Run the Report "RTN","BPSRPT0",118,0) ; "RTN","BPSRPT0",119,0) RUN(BPEXCEL,BPRPTNAM,BPSUMDET) N BPPAGE,BPTMP "RTN","BPSRPT0",120,0) S BPTMP=$NA(^TMP($J,"BPSRPT")) "RTN","BPSRPT0",121,0) K @BPTMP "RTN","BPSRPT0",122,0) S BPPAGE=0 "RTN","BPSRPT0",123,0) W:BPSCR&'BPEXCEL !,"Please wait...",! "RTN","BPSRPT0",124,0) ; "RTN","BPSRPT0",125,0) ;Compile the report "RTN","BPSRPT0",126,0) Q:$$COLLECT^BPSRPT1(BPTMP)=-1 "RTN","BPSRPT0",127,0) U IO "RTN","BPSRPT0",128,0) ; "RTN","BPSRPT0",129,0) ;Display the report "RTN","BPSRPT0",130,0) D REPORT^BPSRPT5(BPTMP,BPEXCEL,BPSCR,BPRPTNAM,BPSUMDET,BPPAGE) "RTN","BPSRPT0",131,0) I 'BPSCR W !,@IOF "RTN","BPSRPT0",132,0) K @BPTMP "RTN","BPSRPT0",133,0) I $D(ZTQUEUED) S ZTREQ="@" Q "RTN","BPSRPT0",134,0) D ^%ZISC "RTN","BPSRPT0",135,0) Q "RTN","BPSRPT0",136,0) ; "RTN","BPSRPT0",137,0) ;Prompt For the Device "RTN","BPSRPT0",138,0) ; "RTN","BPSRPT0",139,0) ; Returns Device variables and BPSCR "RTN","BPSRPT0",140,0) ; "RTN","BPSRPT0",141,0) DEVICE(BPRPTNAM) N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP "RTN","BPSRPT0",142,0) S %ZIS="QM" "RTN","BPSRPT0",143,0) D ^%ZIS "RTN","BPSRPT0",144,0) I POP S BPQ=1 "RTN","BPSRPT0",145,0) ; "RTN","BPSRPT0",146,0) ;Check for exit "RTN","BPSRPT0",147,0) I $G(BPQ) G XDEV "RTN","BPSRPT0",148,0) ; "RTN","BPSRPT0",149,0) S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0) "RTN","BPSRPT0",150,0) I $D(IO("Q")) D S BPQ=1 "RTN","BPSRPT0",151,0) . S ZTRTN="RUN^BPSRPT0(BPEXCEL,BPRPTNAM,BPSUMDET)" "RTN","BPSRPT0",152,0) . S ZTIO=ION "RTN","BPSRPT0",153,0) . S ZTSAVE("*")="" "RTN","BPSRPT0",154,0) . S ZTDESC="BPS REPORT: "_BPRPTNAM "RTN","BPSRPT0",155,0) . D ^%ZTLOAD "RTN","BPSRPT0",156,0) . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") "RTN","BPSRPT0",157,0) . D HOME^%ZIS "RTN","BPSRPT0",158,0) U IO "RTN","BPSRPT0",159,0) XDEV Q "RTN","BPSRPT1") 0^13^B53891828 "RTN","BPSRPT1",1,0) BPSRPT1 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05 "RTN","BPSRPT1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSRPT1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPT1",4,0) Q "RTN","BPSRPT1",5,0) ; "RTN","BPSRPT1",6,0) ; ECME Report Compile Routine - Looping/Filtering Routine "RTN","BPSRPT1",7,0) ; "RTN","BPSRPT1",8,0) ; Input Variables: "RTN","BPSRPT1",9,0) ; BPRTYPE - Type of Report (1-7) "RTN","BPSRPT1",10,0) ; BPGLTMP - Temporary storage global "RTN","BPSRPT1",11,0) ; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array "RTN","BPSRPT1",12,0) ; of internal pointers of selected pharmacies "RTN","BPSRPT1",13,0) ; BPSUMDET - (1) Summary or (0) Detail format "RTN","BPSRPT1",14,0) ; BPINSINF - Set to 0 for all insurances or list of file 36 IENs "RTN","BPSRPT1",15,0) ; BPMWC - 1-ALL,2-Mail,3-Window,4-CMOP Prescriptions "RTN","BPSRPT1",16,0) ; BPRTBCK - 1-ALL,2-RealTime,3-Backbill Claim Submission "RTN","BPSRPT1",17,0) ; BPRLNRL - 1-ALL,2-RELEASED,3-NOT RELEASED "RTN","BPSRPT1",18,0) ; BPDRUG - DRUG to report on (ptr to #50) "RTN","BPSRPT1",19,0) ; BPDRGCL - DRUG CLASS to report on (0 for ALL) "RTN","BPSRPT1",20,0) ; BPBEGDT - Beginning Date "RTN","BPSRPT1",21,0) ; BPENDDT - Ending Date "RTN","BPSRPT1",22,0) ; BPCCRSN - Set to 0 for all closed claim reasons or ptr to #356.8 "RTN","BPSRPT1",23,0) ; BPAUTREV - 0-ALL,1-Auto Reversed "RTN","BPSRPT1",24,0) ; BPACREJ - 0-ALL,1-REJECTED,2-ACCEPTED "RTN","BPSRPT1",25,0) ; "RTN","BPSRPT1",26,0) COLLECT(BPGLTMP) N BP02,BP57,BP59,BPENDDT1,BPLDT02,BPLDT57,X,Y,OK,BPIX "RTN","BPSRPT1",27,0) ; "RTN","BPSRPT1",28,0) ;Check Variables "RTN","BPSRPT1",29,0) S OK=1 "RTN","BPSRPT1",30,0) S:'$G(BPBEGDT) BPBEGDT=0 "RTN","BPSRPT1",31,0) S:'$G(BPENDDT) BPENDDT=9999999 "RTN","BPSRPT1",32,0) S BPENDDT=BPENDDT+0.9 "RTN","BPSRPT1",33,0) I $G(BPRTYPE)=""!($G(BPGLTMP)="")!($G(BPPHARM)="")!($G(BPSUMDET)="")!($G(BPINSINF)="")!($G(BPMWC)="")!($G(BPRTBCK)="") S OK=-1 G EXIT "RTN","BPSRPT1",34,0) ; "RTN","BPSRPT1",35,0) ;Loop through BPS CLAIMS "RTN","BPSRPT1",36,0) ; "RTN","BPSRPT1",37,0) ;First look for fill/refill cross reference "RTN","BPSRPT1",38,0) ;Loop through Date of Service Index in BPS CLAIMS file and find link to "RTN","BPSRPT1",39,0) ;claim in BPS TRANSACTION. Process earliest Date of Service entry found in "RTN","BPSRPT1",40,0) ;BPS TRANSACTION "RTN","BPSRPT1",41,0) ; "RTN","BPSRPT1",42,0) ;Choose Index to Loop through (different for Closed Claims) "RTN","BPSRPT1",43,0) S BPIX="AF" S:BPRTYPE=7 BPIX="AG" "RTN","BPSRPT1",44,0) ; "RTN","BPSRPT1",45,0) S BPLDT02=$S(BPIX="AF":$$FM2YMD(BPBEGDT-0.00001),1:BPBEGDT) S:BPLDT02="" BPLDT02=0 "RTN","BPSRPT1",46,0) S BPENDDT1=$S(BPIX="AF":$$FM2YMD(BPENDDT),1:BPENDDT_".9999999999") S:BPENDDT1="" BPENDDT1=99999999 "RTN","BPSRPT1",47,0) F S BPLDT02=+$O(^BPSC(BPIX,BPLDT02)) Q:BPLDT02=0!(BPLDT02>BPENDDT1) D "RTN","BPSRPT1",48,0) . S BP02=0 F S BP02=$O(^BPSC(BPIX,BPLDT02,BP02)) Q:+BP02=0 D "RTN","BPSRPT1",49,0) . . S BP59=+$O(^BPST("AE",BP02,0)) "RTN","BPSRPT1",50,0) . . Q:BP59=0 "RTN","BPSRPT1",51,0) . . I $D(@BPGLTMP@("FILE59",BP59)) Q "RTN","BPSRPT1",52,0) . . S @BPGLTMP@("FILE59",BP59)=BPLDT02_"^02" "RTN","BPSRPT1",53,0) . . D PROCESS(BP59) "RTN","BPSRPT1",54,0) ; "RTN","BPSRPT1",55,0) ;#9002313.59 has only one entry per claim with, which has a date "RTN","BPSRPT1",56,0) ; of the latest update for the claim "RTN","BPSRPT1",57,0) ;#9002313.57 has more than one entries per claim and keep all "RTN","BPSRPT1",58,0) ; changes made the claim "RTN","BPSRPT1",59,0) ;so we have to go thru #9002313.57 to find the earliest date "RTN","BPSRPT1",60,0) ;related to the claim to check it against BPBEGDT "RTN","BPSRPT1",61,0) S BPLDT57=BPBEGDT-0.00001 "RTN","BPSRPT1",62,0) F S BPLDT57=+$O(^BPSTL("AH",BPLDT57)) Q:BPLDT57=0!(BPLDT57>BPENDDT) D "RTN","BPSRPT1",63,0) . S BP57=0 F S BP57=$O(^BPSTL("AH",BPLDT57,BP57)) Q:+BP57=0 D "RTN","BPSRPT1",64,0) . . S BP59=+$G(^BPSTL(BP57,0)) "RTN","BPSRPT1",65,0) . . I $D(@BPGLTMP@("FILE59",BP59)) Q "RTN","BPSRPT1",66,0) . . S @BPGLTMP@("FILE59",BP59)=BPLDT57_"^57" "RTN","BPSRPT1",67,0) . . D PROCESS(BP59) "RTN","BPSRPT1",68,0) ; "RTN","BPSRPT1",69,0) ;Remove Portion of Scratch Global "RTN","BPSRPT1",70,0) EXIT K @BPGLTMP@("FILE59") "RTN","BPSRPT1",71,0) Q OK "RTN","BPSRPT1",72,0) ; "RTN","BPSRPT1",73,0) ;Convert FB date to YYYYMMDD "RTN","BPSRPT1",74,0) FM2YMD(BPFMDT) N Y,Y1 "RTN","BPSRPT1",75,0) S Y=$E(BPFMDT,2,3),Y1=$E(BPFMDT,1,1) S Y=$S(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"") "RTN","BPSRPT1",76,0) Q:Y Y_$E(BPFMDT,4,7) "RTN","BPSRPT1",77,0) Q "" "RTN","BPSRPT1",78,0) ; "RTN","BPSRPT1",79,0) ;Process each Entry "RTN","BPSRPT1",80,0) ; "RTN","BPSRPT1",81,0) PROCESS(BP59) ; "RTN","BPSRPT1",82,0) N BPBCK,BPDFN,BPREF,BPPAYBL,BPPLAN,BPREJ,BPRLSDT,BPRX,BPRXDRG,BPSTATUS,BPSEQ "RTN","BPSRPT1",83,0) ; "RTN","BPSRPT1",84,0) S BPSEQ=$$COB59^BPSUTIL2(BP59) "RTN","BPSRPT1",85,0) ; "RTN","BPSRPT1",86,0) ;Get ABSBRXI - ptr to #52 "RTN","BPSRPT1",87,0) S BPRX=+$P($G(^BPST(BP59,1)),U,11) "RTN","BPSRPT1",88,0) ; "RTN","BPSRPT1",89,0) ;Get ABSBRXR - Prescription Number IEN "RTN","BPSRPT1",90,0) S BPREF=+$P($G(^BPST(BP59,1)),U) "RTN","BPSRPT1",91,0) ; "RTN","BPSRPT1",92,0) ;Get PATIENT - ptr to #2 "RTN","BPSRPT1",93,0) S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSRPT1",94,0) ; "RTN","BPSRPT1",95,0) ; Skip eligibility verification transactions "RTN","BPSRPT1",96,0) I $P($G(^BPST(BP59,0)),U,15)="E" G XPROC "RTN","BPSRPT1",97,0) ; "RTN","BPSRPT1",98,0) ;Check for correct BPS Pharmacy (DIVISION) "RTN","BPSRPT1",99,0) I $G(BPPHARM)=1,$$CHKPHRM(BP59)=0 G XPROC "RTN","BPSRPT1",100,0) ; "RTN","BPSRPT1",101,0) ;Check for Display 1-ALL,2-RELEASED,3-NOT RELEASED "RTN","BPSRPT1",102,0) S BPRLSDT=$$RELEASED(BPRX,BPREF) "RTN","BPSRPT1",103,0) I BPRLNRL'=1 I ((BPRLNRL=2)&(BPRLSDT=0))!((BPRLNRL=3)&(BPRLSDT)) G XPROC "RTN","BPSRPT1",104,0) ; "RTN","BPSRPT1",105,0) ;Get Status "RTN","BPSRPT1",106,0) S BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF,BPSEQ) "RTN","BPSRPT1",107,0) ; "RTN","BPSRPT1",108,0) ;if REVERSAL "RTN","BPSRPT1",109,0) I BPRTYPE=4,BPSTATUS'["REVERSAL" G XPROC ; exclude non-reversed "RTN","BPSRPT1",110,0) I BPRTYPE=4,$$CLOSED02^BPSSCR03($P(^BPST(BP59,0),U,4))=1 G XPROC ; exclude closed claims for Reversal Report "RTN","BPSRPT1",111,0) ; "RTN","BPSRPT1",112,0) ;if PAYABLE "RTN","BPSRPT1",113,0) S BPPAYBL=BPSTATUS["PAYABLE" "RTN","BPSRPT1",114,0) I BPRTYPE=1,'BPPAYBL G XPROC ; exclude non-payable "RTN","BPSRPT1",115,0) I BPRTYPE=1,BPSTATUS["REVERSAL" G XPROC ; reversed "RTN","BPSRPT1",116,0) ; "RTN","BPSRPT1",117,0) ;if REJECTED "RTN","BPSRPT1",118,0) S BPREJ=BPSTATUS["REJECTED" "RTN","BPSRPT1",119,0) I BPRTYPE=2,BPSTATUS["REVERSAL" G XPROC ; exclude rejected reversals "RTN","BPSRPT1",120,0) I BPRTYPE=2,'BPREJ G XPROC ; exclude non-rejected "RTN","BPSRPT1",121,0) ; "RTN","BPSRPT1",122,0) ;if SUBMITTED NOT RELEASED exclude released ones "RTN","BPSRPT1",123,0) I BPRTYPE=3,BPRLSDT'=0 G XPROC "RTN","BPSRPT1",124,0) I BPRTYPE=3,'BPPAYBL G XPROC ; exclude non-payable "RTN","BPSRPT1",125,0) ; "RTN","BPSRPT1",126,0) ;Auto Reverse Check "RTN","BPSRPT1",127,0) I BPRTYPE=4,BPAUTREV,'$$AUTOREV(BP59) G XPROC "RTN","BPSRPT1",128,0) ; "RTN","BPSRPT1",129,0) ;if CLOSED "RTN","BPSRPT1",130,0) I BPRTYPE=7,'$$CLSCLM(BP59) G XPROC ;exclude open claims "RTN","BPSRPT1",131,0) ;I BPRTYPE=7,BPSTATUS'["REJECTED" G XPROC ;exclude non-rejected closed claims "RTN","BPSRPT1",132,0) ; "RTN","BPSRPT1",133,0) ;if Spending Account Report, check Pricing Segment for data "RTN","BPSRPT1",134,0) I BPRTYPE=8,'$$PRICING^BPSRPT5(BP59) G XPROC "RTN","BPSRPT1",135,0) ; "RTN","BPSRPT1",136,0) ;if Recent Transactions, exclude closed claims "RTN","BPSRPT1",137,0) I BPRTYPE=5,$$CLSCLM(BP59) G XPROC "RTN","BPSRPT1",138,0) ; "RTN","BPSRPT1",139,0) ;If Totals by Date, include only rejects and payables "RTN","BPSRPT1",140,0) I BPRTYPE=6,BPSTATUS'["REJECTED",BPSTATUS'["PAYABLE" G XPROC ; Reversed "RTN","BPSRPT1",141,0) ; "RTN","BPSRPT1",142,0) ;Realtime/Backbill Check "RTN","BPSRPT1",143,0) S BPBCK=$$RTBCK(BP59) "RTN","BPSRPT1",144,0) I BPRTBCK'=1 I ((BPRTBCK=2)&(BPBCK=0))!((BPRTBCK=3)&(BPBCK)) G XPROC "RTN","BPSRPT1",145,0) ; "RTN","BPSRPT1",146,0) ;Check for MAIL/WINDOW/CMOP/ALL "RTN","BPSRPT1",147,0) I BPMWC'="A",$$MWC^BPSRPT6(BPRX,BPREF)'=BPMWC G XPROC "RTN","BPSRPT1",148,0) ; "RTN","BPSRPT1",149,0) ;Check for selected insurance "RTN","BPSRPT1",150,0) S BPPLAN=$$INSNAM^BPSRPT6(BP59) "RTN","BPSRPT1",151,0) I BPINSINF'=0,'$$CHKINS^BPSSCRCU($P(BPPLAN,U,1),BPINSINF) G XPROC "RTN","BPSRPT1",152,0) S BPPLAN=$P(BPPLAN,U,2) "RTN","BPSRPT1",153,0) ; "RTN","BPSRPT1",154,0) ;Check for selected drug "RTN","BPSRPT1",155,0) S BPRXDRG=$$GETDRUG^BPSRPT6(BPRX) "RTN","BPSRPT1",156,0) I BPRXDRG=0 G XPROC "RTN","BPSRPT1",157,0) I BPDRUG,BPDRUG'=BPRXDRG G XPROC "RTN","BPSRPT1",158,0) ; "RTN","BPSRPT1",159,0) ;Check for selected drug classes "RTN","BPSRPT1",160,0) I BPDRGCL'=0,BPDRGCL'=$$DRGCLNAM^BPSRPT6($$GETDRGCL^BPSRPT6(BPRXDRG),99) G XPROC "RTN","BPSRPT1",161,0) ; "RTN","BPSRPT1",162,0) ;Check for selected Close Reason "RTN","BPSRPT1",163,0) I BPCCRSN,BPCCRSN'=$P($$CLRSN^BPSRPT7(BP59),U) G XPROC "RTN","BPSRPT1",164,0) ; "RTN","BPSRPT1",165,0) ;Check for Accepted/Rejected "RTN","BPSRPT1",166,0) I BPACREJ=1,BPSTATUS'["REJECTED" G XPROC "RTN","BPSRPT1",167,0) I BPACREJ=2,BPSTATUS'["ACCEPTED" G XPROC "RTN","BPSRPT1",168,0) ; "RTN","BPSRPT1",169,0) ;Check for Specific Reject Code "RTN","BPSRPT1",170,0) I BPREJCD'=0,'$$CKREJ(BP59,BPREJCD) G XPROC "RTN","BPSRPT1",171,0) ; "RTN","BPSRPT1",172,0) ;Check for Eligibility Code "RTN","BPSRPT1",173,0) I BPELIG'=0,BPELIG'=$$ELIGCODE^BPSSCR05(BP59) G XPROC "RTN","BPSRPT1",174,0) ; "RTN","BPSRPT1",175,0) ;Check Open/Closed claim "RTN","BPSRPT1",176,0) I BPOPCL'=0,((BPOPCL=2)&($$CLOSED02^BPSSCR03($P(^BPST(BP59,0),U,4))=1))!((BPOPCL=1)&($$CLOSED02^BPSSCR03($P(^BPST(BP59,0),U,4))'=1)) G XPROC "RTN","BPSRPT1",177,0) ; "RTN","BPSRPT1",178,0) ;Save Entry for Report "RTN","BPSRPT1",179,0) D SETTMP^BPSRPT2(BPGLTMP,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,.BPPHARM,BPSUMDET,BPPLAN,BPRLSDT,BPPAYBL,BPREJ,BPRXDRG,$P(BPSTATUS,U)) "RTN","BPSRPT1",180,0) ; "RTN","BPSRPT1",181,0) XPROC Q "RTN","BPSRPT1",182,0) ; "RTN","BPSRPT1",183,0) ;Check if selected BPS PHARMACY "RTN","BPSRPT1",184,0) ; "RTN","BPSRPT1",185,0) ; Defined Variable: BPPHARM(ptr) - List of BPS Pharmacies to Report on "RTN","BPSRPT1",186,0) ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59) "RTN","BPSRPT1",187,0) ; "RTN","BPSRPT1",188,0) ; Returned Value -> 0 = Entry not in list of selected pharmacies "RTN","BPSRPT1",189,0) ; 1 = Entry is in list of selected pharmacies "RTN","BPSRPT1",190,0) CHKPHRM(BP59) N PHARM "RTN","BPSRPT1",191,0) S PHARM=+$P($G(^BPST(BP59,1)),"^",7) "RTN","BPSRPT1",192,0) S PHARM=$S($D(BPPHARM(PHARM)):1,1:0) "RTN","BPSRPT1",193,0) Q PHARM "RTN","BPSRPT1",194,0) ; "RTN","BPSRPT1",195,0) ;Determine whether claim is Released or Not Released "RTN","BPSRPT1",196,0) ; "RTN","BPSRPT1",197,0) ; Input Variables: BPRX - ptr to PRESCRIPTION (#52) "RTN","BPSRPT1",198,0) ; BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...) "RTN","BPSRPT1",199,0) ; "RTN","BPSRPT1",200,0) ; Return Value -> 0 = Not Released "RTN","BPSRPT1",201,0) ; released date = Released "RTN","BPSRPT1",202,0) ; "RTN","BPSRPT1",203,0) RELEASED(BPRX,BPREF) N RDT "RTN","BPSRPT1",204,0) ; "RTN","BPSRPT1",205,0) I BPREF=0 S RDT=$$RXRELDT^BPSRPT6(BPRX)\1 "RTN","BPSRPT1",206,0) I BPREF'=0 S RDT=$$REFRELDT^BPSRPT6(BPRX,BPREF)\1 "RTN","BPSRPT1",207,0) Q RDT "RTN","BPSRPT1",208,0) ; "RTN","BPSRPT1",209,0) ;Determine if claim was Auto Reversed "RTN","BPSRPT1",210,0) ; "RTN","BPSRPT1",211,0) ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59) "RTN","BPSRPT1",212,0) ; Return Value -> 1 = Auto Reversed "RTN","BPSRPT1",213,0) ; 0 = Not Auto Reversed "RTN","BPSRPT1",214,0) ; "RTN","BPSRPT1",215,0) AUTOREV(BP59) N AR,BP02 "RTN","BPSRPT1",216,0) S BP02=+$P($G(^BPST(BP59,0)),U,4) "RTN","BPSRPT1",217,0) S AR=+$P($G(^BPSC(BP02,0)),U,7) "RTN","BPSRPT1",218,0) Q AR "RTN","BPSRPT1",219,0) ; "RTN","BPSRPT1",220,0) ;Determine if claim was closed "RTN","BPSRPT1",221,0) ; "RTN","BPSRPT1",222,0) ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59) "RTN","BPSRPT1",223,0) ; Return Value -> 1 = Closed "RTN","BPSRPT1",224,0) ; 0 = Not Closed "RTN","BPSRPT1",225,0) ; "RTN","BPSRPT1",226,0) CLSCLM(BP59) N BP02,CL "RTN","BPSRPT1",227,0) S BP02=+$P($G(^BPST(BP59,0)),U,4) "RTN","BPSRPT1",228,0) S CL=+$G(^BPSC(BP02,900)) "RTN","BPSRPT1",229,0) Q CL "RTN","BPSRPT1",230,0) ; "RTN","BPSRPT1",231,0) ;Determine whether claim is Realtime or Backbilled "RTN","BPSRPT1",232,0) ; "RTN","BPSRPT1",233,0) ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59) "RTN","BPSRPT1",234,0) ; Return Value -> 1 = Backbilled "RTN","BPSRPT1",235,0) ; 0 = Realtime "RTN","BPSRPT1",236,0) RTBCK(BP59) N BB "RTN","BPSRPT1",237,0) S BB=$P($G(^BPST(BP59,12)),U) "RTN","BPSRPT1",238,0) S BB=$S(BB="BB":0,1:1) "RTN","BPSRPT1",239,0) Q BB "RTN","BPSRPT1",240,0) ; "RTN","BPSRPT1",241,0) ;Screen Pause 1 "RTN","BPSRPT1",242,0) ; "RTN","BPSRPT1",243,0) ; Return variable - BPQ = 0 Continue "RTN","BPSRPT1",244,0) ; 2 Quit "RTN","BPSRPT1",245,0) PAUSE N X "RTN","BPSRPT1",246,0) U IO(0) W !!,"Press RETURN to continue, '^' to exit:" "RTN","BPSRPT1",247,0) R X:$G(DTIME) S:'$T X="^" S:X["^" BPQ=2 "RTN","BPSRPT1",248,0) U IO "RTN","BPSRPT1",249,0) Q "RTN","BPSRPT1",250,0) ; "RTN","BPSRPT1",251,0) ;Screen Pause 2 "RTN","BPSRPT1",252,0) ; "RTN","BPSRPT1",253,0) ; Return variable - BPQ = 0 Continue "RTN","BPSRPT1",254,0) ; 2 Quit "RTN","BPSRPT1",255,0) PAUSE2 N X "RTN","BPSRPT1",256,0) U IO(0) W !!,"Press RETURN to continue:" "RTN","BPSRPT1",257,0) R X:$G(DTIME) S:'$T X="^" S:X["^" BPQ=2 "RTN","BPSRPT1",258,0) U IO "RTN","BPSRPT1",259,0) Q "RTN","BPSRPT1",260,0) ; "RTN","BPSRPT1",261,0) ;Get ECME# "RTN","BPSRPT1",262,0) ; "RTN","BPSRPT1",263,0) ;BP59 - ptr to 9002313.59 "RTN","BPSRPT1",264,0) ;output : "RTN","BPSRPT1",265,0) ;ECME number from 9002313.02 "RTN","BPSRPT1",266,0) ; 7 or 12 digits of the prescription IEN file 52 "RTN","BPSRPT1",267,0) ; or 12 spaces "RTN","BPSRPT1",268,0) ECMENUM(BP59) ;*/ "RTN","BPSRPT1",269,0) Q $$ECMENUM^BPSSCRU2(BP59) "RTN","BPSRPT1",270,0) ; "RTN","BPSRPT1",271,0) ;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format "RTN","BPSRPT1",272,0) ; "RTN","BPSRPT1",273,0) DATTIM(X) N DATE,BPT,BPM,BPH,BPAP "RTN","BPSRPT1",274,0) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"") "RTN","BPSRPT1",275,0) S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT)) "RTN","BPSRPT1",276,0) S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4) "RTN","BPSRPT1",277,0) S BPAP="AM" I BPH>12 S BPH=BPH-12,BPAP="PM" S:$L(BPH)<2 BPH="0"_BPH "RTN","BPSRPT1",278,0) I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP "RTN","BPSRPT1",279,0) Q $G(DATE) "RTN","BPSRPT1",280,0) ; "RTN","BPSRPT1",281,0) ;Display RT-Realtime,BB-Backbill, or " " "RTN","BPSRPT1",282,0) ; "RTN","BPSRPT1",283,0) RTBCKNAM(BPINDEX) Q $S(BPINDEX=1:"RT",BPINDEX=0:"BB",1:" ") "RTN","BPSRPT1",284,0) ; "RTN","BPSRPT1",285,0) ;See for Specific Reject Code "RTN","BPSRPT1",286,0) ; "RTN","BPSRPT1",287,0) CKREJ(BP59,BPREJCD) N FREJ,I,REJ,X "RTN","BPSRPT1",288,0) S FREJ=0 "RTN","BPSRPT1",289,0) S X=$$REJTEXT^BPSRPT2(BP59,.REJ) "RTN","BPSRPT1",290,0) S X="" F S X=$O(REJ(X)) Q:X="" D Q:FREJ=1 "RTN","BPSRPT1",291,0) .S REJ=$P($G(REJ(X)),":") Q:REJ="" "RTN","BPSRPT1",292,0) .S I="" F S I=$O(^BPSF(9002313.93,"B",REJ,I)) Q:I="" I I=BPREJCD S FREJ=1 "RTN","BPSRPT1",293,0) Q FREJ "RTN","BPSRPT4") 0^6^B76530531 "RTN","BPSRPT4",1,0) BPSRPT4 ;BHAM ISC/BEE - ECME REPORTS (CONT) ;14-FEB-05 "RTN","BPSRPT4",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSRPT4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPT4",4,0) ; "RTN","BPSRPT4",5,0) Q "RTN","BPSRPT4",6,0) ; "RTN","BPSRPT4",7,0) ; Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL "RTN","BPSRPT4",8,0) ; "RTN","BPSRPT4",9,0) ; Input Variable -> DFLT = 3 NOT RELEASED "RTN","BPSRPT4",10,0) ; 2 RELEASED "RTN","BPSRPT4",11,0) ; 1 ALL "RTN","BPSRPT4",12,0) ; "RTN","BPSRPT4",13,0) ; Return Value -> 3 = NOT RELEASED "RTN","BPSRPT4",14,0) ; 2 = RELEASED "RTN","BPSRPT4",15,0) ; 1 = ALL "RTN","BPSRPT4",16,0) ; ^ = Exit "RTN","BPSRPT4",17,0) ; "RTN","BPSRPT4",18,0) SELRLNRL(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPT4",19,0) S DFLT=$S($G(DFLT)=1:"ALL",$G(DFLT)=3:"NOT RELEASED",1:"RELEASED") "RTN","BPSRPT4",20,0) S DIR(0)="S^R:RELEASED;N:NOT RELEASED;A:ALL" "RTN","BPSRPT4",21,0) S DIR("A")="Include Rxs - (R)ELEASED or (N)OT RELEASED or (A)LL",DIR("B")=DFLT "RTN","BPSRPT4",22,0) D ^DIR "RTN","BPSRPT4",23,0) ; "RTN","BPSRPT4",24,0) ;Check for "^", timeout, or blank entry "RTN","BPSRPT4",25,0) I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^" "RTN","BPSRPT4",26,0) ; "RTN","BPSRPT4",27,0) S Y=$S(Y="A":1,Y="R":2,Y="N":3,1:Y) "RTN","BPSRPT4",28,0) ; "RTN","BPSRPT4",29,0) Q Y "RTN","BPSRPT4",30,0) ; "RTN","BPSRPT4",31,0) ; Select to Include (S)pecific Reject Code or (A)ll "RTN","BPSRPT4",32,0) ; "RTN","BPSRPT4",33,0) ; Input Variable -> DFLT = 1 Specific Reject Code "RTN","BPSRPT4",34,0) ; 0 All Reject Codes "RTN","BPSRPT4",35,0) ; "RTN","BPSRPT4",36,0) ; Return Value -> ptr = pointer to BPS NCPDP REJECT CODES (#9002313.93) "RTN","BPSRPT4",37,0) ; 0 = All Reject Codes "RTN","BPSRPT4",38,0) ; ^ = Exit "RTN","BPSRPT4",39,0) ; "RTN","BPSRPT4",40,0) SELREJCD(DFLT) N DIC,DIR,DIRUT,DUOUT,REJ,X,Y "RTN","BPSRPT4",41,0) ; "RTN","BPSRPT4",42,0) S DFLT=$S($G(DFLT)=1:"Specific Reject Code",1:"ALL") "RTN","BPSRPT4",43,0) S DIR(0)="S^S:Specific Reject Code;A:ALL" "RTN","BPSRPT4",44,0) S DIR("A")="Include (S)pecific Reject Code or (A)LL",DIR("B")=DFLT "RTN","BPSRPT4",45,0) D ^DIR "RTN","BPSRPT4",46,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^" "RTN","BPSRPT4",47,0) S REJ=$S(Y="S":1,Y="A":0,1:Y) "RTN","BPSRPT4",48,0) ; "RTN","BPSRPT4",49,0) ;Check for "^" or timeout "RTN","BPSRPT4",50,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) S (REJ,Y)="^" "RTN","BPSRPT4",51,0) ; "RTN","BPSRPT4",52,0) ;If Specific Reject Code selected, ask prompt "RTN","BPSRPT4",53,0) I $G(REJ)=1 D "RTN","BPSRPT4",54,0) .; "RTN","BPSRPT4",55,0) .;Prompt for entry "RTN","BPSRPT4",56,0) .K X S DIC(0)="QEAM",DIC=9002313.93,DIC("A")="Select Reject Code: " "RTN","BPSRPT4",57,0) .W ! D ^DIC "RTN","BPSRPT4",58,0) .; "RTN","BPSRPT4",59,0) .;Check for "^", timeout, or blank entry "RTN","BPSRPT4",60,0) .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S (REJ,Y)="^" Q "RTN","BPSRPT4",61,0) .; "RTN","BPSRPT4",62,0) .;If valid entry, setup REJ "RTN","BPSRPT4",63,0) .I +Y>0 S REJ=+Y "RTN","BPSRPT4",64,0) ; "RTN","BPSRPT4",65,0) Q REJ "RTN","BPSRPT4",66,0) ; "RTN","BPSRPT4",67,0) ; Include Auto(R)eversed or (A)LL "RTN","BPSRPT4",68,0) ; "RTN","BPSRPT4",69,0) ; Input Variable -> DFLT = 1 AutoReversed "RTN","BPSRPT4",70,0) ; 0 ALL "RTN","BPSRPT4",71,0) ; "RTN","BPSRPT4",72,0) ; Return Value -> 1 = AutoReversed "RTN","BPSRPT4",73,0) ; 0 = ALL "RTN","BPSRPT4",74,0) ; ^ = Exit "RTN","BPSRPT4",75,0) ; "RTN","BPSRPT4",76,0) SELAUREV(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPT4",77,0) ; "RTN","BPSRPT4",78,0) S DFLT=$S($G(DFLT)=1:"AutoReversed",1:"ALL") "RTN","BPSRPT4",79,0) S DIR(0)="S^R:AutoReversed;A:ALL" "RTN","BPSRPT4",80,0) S DIR("A")="Include Auto(R)eversed or (A)LL",DIR("B")=DFLT "RTN","BPSRPT4",81,0) D ^DIR "RTN","BPSRPT4",82,0) ; "RTN","BPSRPT4",83,0) ;Check for "^", timeout, or blank entry "RTN","BPSRPT4",84,0) I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^" "RTN","BPSRPT4",85,0) ; "RTN","BPSRPT4",86,0) S Y=$S(Y="A":0,Y="R":1,1:Y) "RTN","BPSRPT4",87,0) ; "RTN","BPSRPT4",88,0) Q Y "RTN","BPSRPT4",89,0) ; "RTN","BPSRPT4",90,0) ; Include A(C)cepted or (R)ejected or (A)LL "RTN","BPSRPT4",91,0) ; "RTN","BPSRPT4",92,0) ; Input Variable -> DFLT = 2 Accepted "RTN","BPSRPT4",93,0) ; 1 Rejected "RTN","BPSRPT4",94,0) ; 0 ALL "RTN","BPSRPT4",95,0) ; "RTN","BPSRPT4",96,0) ; Return Value -> 2 = Accepted "RTN","BPSRPT4",97,0) ; 1 = Rejected "RTN","BPSRPT4",98,0) ; 0 = ALL "RTN","BPSRPT4",99,0) ; ^ = Exit "RTN","BPSRPT4",100,0) ; "RTN","BPSRPT4",101,0) SELACREJ(DFLT) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPT4",102,0) ; "RTN","BPSRPT4",103,0) S DFLT=$S($G(DFLT)=2:"Accepted",$G(DFLT)=1:"Rejected",1:"ALL") "RTN","BPSRPT4",104,0) S DIR(0)="S^C:Accepted;R:Rejected;A:ALL" "RTN","BPSRPT4",105,0) S DIR("A")="Include A(C)cepted or (R)ejected or (A)LL",DIR("B")=DFLT "RTN","BPSRPT4",106,0) D ^DIR "RTN","BPSRPT4",107,0) ; "RTN","BPSRPT4",108,0) ;Check for "^", timeout, or blank entry "RTN","BPSRPT4",109,0) I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S Y="^" "RTN","BPSRPT4",110,0) ; "RTN","BPSRPT4",111,0) S Y=$S(Y="C":2,Y="R":1,Y="A":0,1:Y) "RTN","BPSRPT4",112,0) ; "RTN","BPSRPT4",113,0) Q Y "RTN","BPSRPT4",114,0) ; "RTN","BPSRPT4",115,0) ; Select to Include (S)pecific Close Claim Reason or (A)ll "RTN","BPSRPT4",116,0) ; "RTN","BPSRPT4",117,0) ; Input Variable -> DFLT = 1 Specific CLAIMS TRACKING NON-BILLABLE REASONS "RTN","BPSRPT4",118,0) ; 0 All Reasons "RTN","BPSRPT4",119,0) ; "RTN","BPSRPT4",120,0) ; Return Value -> ptr = pointer to CLAIMS TRACKING NON-BILLABLE REASONS (#356.8) "RTN","BPSRPT4",121,0) ; 0 = All Reasons "RTN","BPSRPT4",122,0) ; ^ = Exit "RTN","BPSRPT4",123,0) ; "RTN","BPSRPT4",124,0) SELCCRSN(DFLT) N DIC,DIR,DIRUT,DUOUT,RSN,X,Y "RTN","BPSRPT4",125,0) ; "RTN","BPSRPT4",126,0) S DFLT=$S($G(DFLT)=1:"Specific Close Claim Reason",1:"ALL") "RTN","BPSRPT4",127,0) S DIR(0)="S^S:Specific Close Claim Reason;A:ALL" "RTN","BPSRPT4",128,0) S DIR("A")="Include (S)pecific Close Claim Reason or (A)LL",DIR("B")=DFLT "RTN","BPSRPT4",129,0) D ^DIR "RTN","BPSRPT4",130,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) S Y="^" "RTN","BPSRPT4",131,0) S RSN=$S(Y="S":1,Y="A":0,1:Y) "RTN","BPSRPT4",132,0) ; "RTN","BPSRPT4",133,0) ;Check for "^" or timeout "RTN","BPSRPT4",134,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) S (RSN,Y)="^" "RTN","BPSRPT4",135,0) ; "RTN","BPSRPT4",136,0) ;If Specific Reject Code selected, ask prompt "RTN","BPSRPT4",137,0) I $G(RSN)=1 D "RTN","BPSRPT4",138,0) .; "RTN","BPSRPT4",139,0) .;Prompt for entry "RTN","BPSRPT4",140,0) .K X S DIC(0)="QEAM",DIC=356.8,DIC("A")="Select Close Claim Reason: " "RTN","BPSRPT4",141,0) .W ! D ^DIC "RTN","BPSRPT4",142,0) .; "RTN","BPSRPT4",143,0) .;Check for "^", timeout, or blank entry "RTN","BPSRPT4",144,0) .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S (RSN,Y)="^" Q "RTN","BPSRPT4",145,0) .; "RTN","BPSRPT4",146,0) .;If valid entry, setup RSN "RTN","BPSRPT4",147,0) .I +Y>0 S RSN=+Y "RTN","BPSRPT4",148,0) ; "RTN","BPSRPT4",149,0) Q RSN "RTN","BPSRPT4",150,0) ; "RTN","BPSRPT4",151,0) ;Pull Selected BPS Pharmacies for Display "RTN","BPSRPT4",152,0) ; "RTN","BPSRPT4",153,0) ; Input Variables: "RTN","BPSRPT4",154,0) ; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array of internal "RTN","BPSRPT4",155,0) ; pointers of selected pharmacies "RTN","BPSRPT4",156,0) ; - BPLEN = The length of the display field "RTN","BPSRPT4",157,0) ; Returned value -> List of selected BPS Pharmacies (possibly cut short) "RTN","BPSRPT4",158,0) ; "RTN","BPSRPT4",159,0) GETDIVS(BPLEN,BPPHARM) N BPDIV,BPSTR,BPQUIT "RTN","BPSRPT4",160,0) I $G(BPPHARM)=0 S BPSTR="ALL" "RTN","BPSRPT4",161,0) E D "RTN","BPSRPT4",162,0) .S BPDIV="",BPQUIT=0,BPSTR="" "RTN","BPSRPT4",163,0) .F S BPDIV=$O(BPPHARM(BPDIV)) Q:+BPDIV=0 D Q:BPQUIT=1 "RTN","BPSRPT4",164,0) .. I $L(BPSTR_$$DIVNAME^BPSSCRDS(BPDIV))>(BPLEN-4) D S BPQUIT=1 Q "RTN","BPSRPT4",165,0) ... S BPSTR=$$LJ^BPSSCR02(BPSTR_",...",BPLEN) "RTN","BPSRPT4",166,0) .. S BPSTR=BPSTR_$S(BPSTR]"":", ",1:"")_$$DIVNAME^BPSSCRDS(BPDIV) "RTN","BPSRPT4",167,0) Q BPSTR "RTN","BPSRPT4",168,0) ; "RTN","BPSRPT4",169,0) ;Get the Reject Code "RTN","BPSRPT4",170,0) ; "RTN","BPSRPT4",171,0) ; Input variable -> 0 for All Reject Codes or "RTN","BPSRPT4",172,0) ; lookup to BPS NCPDP REJECT CODES (#9002313.93) "RTN","BPSRPT4",173,0) ; Returned value -> ALL or the selected Reject Code "RTN","BPSRPT4",174,0) ; "RTN","BPSRPT4",175,0) GETREJ(REJ) ; "RTN","BPSRPT4",176,0) I REJ="0" S REJ="ALL" "RTN","BPSRPT4",177,0) E S REJ=$P($G(^BPSF(9002313.93,+REJ,0)),U,2) "RTN","BPSRPT4",178,0) Q REJ "RTN","BPSRPT4",179,0) ; "RTN","BPSRPT4",180,0) ;Print Header 2 Line 1 "RTN","BPSRPT4",181,0) ; "RTN","BPSRPT4",182,0) ; Input variable: BPRTYPE -> Report Type (1-7) "RTN","BPSRPT4",183,0) ; "RTN","BPSRPT4",184,0) HEADLN1(BPRTYPE) ; "RTN","BPSRPT4",185,0) I (",1,2,3,4,5,7,8,")[BPRTYPE W !,"PATIENT NAME",?27,"Pt.ID",?35,"RX#",?47,"REF/ECME#" "RTN","BPSRPT4",186,0) I (BPRTYPE=1)!(BPRTYPE=4)!(BPRTYPE=8) D Q "RTN","BPSRPT4",187,0) . W ?68,"DATE" "RTN","BPSRPT4",188,0) . W ?78,$J("$BILLED",10) "RTN","BPSRPT4",189,0) . W ?97,$J("$INS RESPONSE",13) "RTN","BPSRPT4",190,0) . W ?122,$J("$COLLECT",10) "RTN","BPSRPT4",191,0) ; "RTN","BPSRPT4",192,0) I BPRTYPE=2 D Q "RTN","BPSRPT4",193,0) . W ?68,"DATE" "RTN","BPSRPT4",194,0) . W ?78,"RELEASED ON" "RTN","BPSRPT4",195,0) . W ?91,"RX INFO" "RTN","BPSRPT4",196,0) . W ?109,"RX COB" "RTN","BPSRPT4",197,0) . W ?116,"OPEN/CLOSED" "RTN","BPSRPT4",198,0) . W ?128,"ELIG" "RTN","BPSRPT4",199,0) ; "RTN","BPSRPT4",200,0) I BPRTYPE=3 D Q "RTN","BPSRPT4",201,0) . W ?68,"DATE" "RTN","BPSRPT4",202,0) . W ?100,$J("$BILLED",10) "RTN","BPSRPT4",203,0) . W ?119,$J("$INS RESPONSE",13) "RTN","BPSRPT4",204,0) ; "RTN","BPSRPT4",205,0) I BPRTYPE=5 D Q "RTN","BPSRPT4",206,0) . W ?65,"COMPLETED" "RTN","BPSRPT4",207,0) . W ?83,"TRANS TYPE" "RTN","BPSRPT4",208,0) . W ?100,"PAYER RESPONSE" "RTN","BPSRPT4",209,0) . W ?125,"RX COB" "RTN","BPSRPT4",210,0) ; "RTN","BPSRPT4",211,0) I BPRTYPE=6 D Q "RTN","BPSRPT4",212,0) . W !,?33,$J("AMOUNT",17) "RTN","BPSRPT4",213,0) . W ?51,$J("RETURNED",17) "RTN","BPSRPT4",214,0) . W ?69,$J("RETURNED",17) "RTN","BPSRPT4",215,0) . W ?87,$J("AMOUNT",17) "RTN","BPSRPT4",216,0) ; "RTN","BPSRPT4",217,0) I BPRTYPE=7 D Q "RTN","BPSRPT4",218,0) . W ?65,"RX INFO" "RTN","BPSRPT4",219,0) . W ?87,"DRUG" "RTN","BPSRPT4",220,0) . W ?121,"NDC" "RTN","BPSRPT4",221,0) Q "RTN","BPSRPT4",222,0) ; "RTN","BPSRPT4",223,0) ;Print Header 2 Line 2 "RTN","BPSRPT4",224,0) ; "RTN","BPSRPT4",225,0) ; Input variable: BPRTYPE -> Report Type (1-7) "RTN","BPSRPT4",226,0) ; "RTN","BPSRPT4",227,0) HEADLN2(BPRTYPE) ; "RTN","BPSRPT4",228,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT4",229,0) . W !,?4,"DRUG" "RTN","BPSRPT4",230,0) . W ?36,"NDC" "RTN","BPSRPT4",231,0) . I BPRTYPE=1 W ?47,"RELEASED ON" "RTN","BPSRPT4",232,0) . W ?68,"RX INFO" "RTN","BPSRPT4",233,0) . I BPRTYPE=4 W ?92,"RX COB" "RTN","BPSRPT4",234,0) . I BPRTYPE=1 W ?115,$J("BILL# RX COB",17) "RTN","BPSRPT4",235,0) ; "RTN","BPSRPT4",236,0) I BPRTYPE=2 D Q "RTN","BPSRPT4",237,0) . W !,?3,"CARDHOLD.ID" "RTN","BPSRPT4",238,0) . W ?31,"GROUP ID" "RTN","BPSRPT4",239,0) . W ?41,$J("$BILLED",10) "RTN","BPSRPT4",240,0) . W ?54,"QTY" "RTN","BPSRPT4",241,0) . W ?61,"NDC#" "RTN","BPSRPT4",242,0) . W ?82,"DRUG" "RTN","BPSRPT4",243,0) ; "RTN","BPSRPT4",244,0) I BPRTYPE=3 D Q "RTN","BPSRPT4",245,0) . W !,?4,"DRUG" "RTN","BPSRPT4",246,0) . W ?43,"NDC" "RTN","BPSRPT4",247,0) . W ?68,"RX INFO" "RTN","BPSRPT4",248,0) . W ?88,"RX COB" "RTN","BPSRPT4",249,0) ; "RTN","BPSRPT4",250,0) I BPRTYPE=5 D Q "RTN","BPSRPT4",251,0) . W !,?4,"DRUG" "RTN","BPSRPT4",252,0) . W ?32,"NDC" "RTN","BPSRPT4",253,0) . W ?47,"RX INFO" "RTN","BPSRPT4",254,0) . W ?69,"INSURANCE" "RTN","BPSRPT4",255,0) . W ?112,"ELAP TIME IN SECONDS" "RTN","BPSRPT4",256,0) ; "RTN","BPSRPT4",257,0) I BPRTYPE=6 D Q "RTN","BPSRPT4",258,0) .W !,?1,"DATE" "RTN","BPSRPT4",259,0) .W ?15,$J("#CLAIMS",17) "RTN","BPSRPT4",260,0) .W ?33,$J("SUBMITTED",17) "RTN","BPSRPT4",261,0) .W ?51,$J("REJECTED",17) "RTN","BPSRPT4",262,0) .W ?69,$J("PAYABLE",17) "RTN","BPSRPT4",263,0) .W ?87,$J("TO RECEIVE",17) "RTN","BPSRPT4",264,0) .W ?115,$J("DIFFERENCE",17) "RTN","BPSRPT4",265,0) ; "RTN","BPSRPT4",266,0) I BPRTYPE=7 D Q "RTN","BPSRPT4",267,0) . W !,?3,"CARDHOLD.ID" "RTN","BPSRPT4",268,0) . W ?31,"GROUP ID" "RTN","BPSRPT4",269,0) . W ?41,"CLOSE DATE/TIME" "RTN","BPSRPT4",270,0) . W ?59,"CLOSED BY" "RTN","BPSRPT4",271,0) . W ?87,"CLOSE REASON" "RTN","BPSRPT4",272,0) . W ?121,"RX COB" "RTN","BPSRPT4",273,0) ; "RTN","BPSRPT4",274,0) I BPRTYPE=8 D Q "RTN","BPSRPT4",275,0) . W !,?2,"DRUG" "RTN","BPSRPT4",276,0) . W ?38,"RX INFO" "RTN","BPSRPT4",277,0) . W ?54,"INS GROUP#" "RTN","BPSRPT4",278,0) . W ?79,"INS GROUP NAME" "RTN","BPSRPT4",279,0) . W ?121,"BILL#" "RTN","BPSRPT4",280,0) Q "RTN","BPSRPT4",281,0) ; "RTN","BPSRPT4",282,0) ;Print Header 2 Line 3 "RTN","BPSRPT4",283,0) ; "RTN","BPSRPT4",284,0) ; Input variable: BPRTYPE -> Report Type (1-7) "RTN","BPSRPT4",285,0) ; "RTN","BPSRPT4",286,0) HEADLN3(BPTYP) ; "RTN","BPSRPT4",287,0) I BPTYP=4 D Q "RTN","BPSRPT4",288,0) . W !,?6,"RELEASED ON" "RTN","BPSRPT4",289,0) . W ?22,"REVERSAL METHOD/RETURN STATUS/REASON" "RTN","BPSRPT4",290,0) ; "RTN","BPSRPT4",291,0) I BPTYP=8 D Q "RTN","BPSRPT4",292,0) . W !,?4,"$PROVIDER NETWORK" "RTN","BPSRPT4",293,0) . W ?23,"$BRAND DRUG" "RTN","BPSRPT4",294,0) . W ?38,"$NON-PREF FORM" "RTN","BPSRPT4",295,0) . W ?56,"$BRAND NON-PREF FORM" "RTN","BPSRPT4",296,0) . W ?81,"$COVERAGE GAP" "RTN","BPSRPT4",297,0) . W ?96,"$HEALTH ASST" "RTN","BPSRPT4",298,0) . W ?111,"$SPEND ACCT REMAINING" "RTN","BPSRPT4",299,0) Q "RTN","BPSRPT4",300,0) ; "RTN","BPSRPT4",301,0) SELEXCEL() ; - Returns whether to capture data for Excel report. "RTN","BPSRPT4",302,0) ; Output: EXCEL = 1 - YES (capture data) / 0 - NO (DO NOT capture data) "RTN","BPSRPT4",303,0) ; "RTN","BPSRPT4",304,0) N EXCEL,DIR,DIRUT,DTOUT,DUOUT,DIROUT "RTN","BPSRPT4",305,0) ; "RTN","BPSRPT4",306,0) S DIR(0)="Y",DIR("B")="NO",DIR("T")=DTIME W ! "RTN","BPSRPT4",307,0) S DIR("A")="Do you want to capture report data for an Excel document" "RTN","BPSRPT4",308,0) S DIR("?")="^D HEXC^BPSRPT4" "RTN","BPSRPT4",309,0) D ^DIR K DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q "^" "RTN","BPSRPT4",310,0) K DIROUT,DTOUT,DUOUT,DIRUT "RTN","BPSRPT4",311,0) S EXCEL=0 I Y S EXCEL=1 "RTN","BPSRPT4",312,0) ; "RTN","BPSRPT4",313,0) ;Display Excel display message "RTN","BPSRPT4",314,0) I EXCEL=1 D EXMSG "RTN","BPSRPT4",315,0) ; "RTN","BPSRPT4",316,0) Q EXCEL "RTN","BPSRPT4",317,0) ; "RTN","BPSRPT4",318,0) HEXC ; - 'Do you want to capture data...' prompt "RTN","BPSRPT4",319,0) W !!," Enter: 'Y' - To capture detail report data to transfer" "RTN","BPSRPT4",320,0) W !," to an Excel document" "RTN","BPSRPT4",321,0) W !," '' - To skip this option" "RTN","BPSRPT4",322,0) W !," '^' - To quit this option" "RTN","BPSRPT4",323,0) Q "RTN","BPSRPT4",324,0) ; "RTN","BPSRPT4",325,0) ;Display the message about capturing to an Excel file format "RTN","BPSRPT4",326,0) ; "RTN","BPSRPT4",327,0) EXMSG ; "RTN","BPSRPT4",328,0) W !!?5,"Before continuing, please set up your terminal to capture the" "RTN","BPSRPT4",329,0) W !?5,"detail report data. On some terminals, this can be done by" "RTN","BPSRPT4",330,0) W !?5,"clicking on the 'Tools' menu above, then click on 'Capture" "RTN","BPSRPT4",331,0) W !?5,"Incoming Data' to save to Desktop. This report may take a" "RTN","BPSRPT4",332,0) W !?5,"while to run." "RTN","BPSRPT4",333,0) W !!?5,"Note: To avoid undesired wrapping of the data saved to the" "RTN","BPSRPT4",334,0) W !?5," file, please enter '0;256;999' at the 'DEVICE:' prompt.",! "RTN","BPSRPT4",335,0) Q "RTN","BPSRPT5") 0^8^B136990119 "RTN","BPSRPT5",1,0) BPSRPT5 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05 "RTN","BPSRPT5",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSRPT5",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPT5",4,0) ; "RTN","BPSRPT5",5,0) ;Routine to Display the Reports "RTN","BPSRPT5",6,0) ; "RTN","BPSRPT5",7,0) ;Print Report Line 1 "RTN","BPSRPT5",8,0) WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL,BPPSEQ) ; "RTN","BPSRPT5",9,0) ;Excel Output "RTN","BPSRPT5",10,0) I $G(BPEXCEL) D WRLINE1^BPSRPT8(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPPSEQ) Q "RTN","BPSRPT5",11,0) ;Report Output "RTN","BPSRPT5",12,0) W !,$$PATNAME^BPSRPT6(BPDFN) "RTN","BPSRPT5",13,0) W ?27,"("_$$SSN4^BPSRPT6(BPDFN)_")" "RTN","BPSRPT5",14,0) W ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX) "RTN","BPSRPT5",15,0) W ?47,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3)) "RTN","BPSRPT5",16,0) I (BPRTYPE=1)!(BPRTYPE=4)!(BPRTYPE=8) D Q "RTN","BPSRPT5",17,0) . W ?68,$$DATTIM^BPSRPT1(BPSRTDT) "RTN","BPSRPT5",18,0) . W ?78,$J(BPBIL,10,2),?100,$J(BPINS,10,2),?122,$S(BPCOLL]"":$J(BPCOLL,10,2),1:"") "RTN","BPSRPT5",19,0) I BPRTYPE=2 D Q "RTN","BPSRPT5",20,0) . W ?68,$$DATTIM^BPSRPT1(BPSRTDT) "RTN","BPSRPT5",21,0) . W ?78,$$DATTIM^BPSRPT1(+BPX) "RTN","BPSRPT5",22,0) . W ?91,$$MWC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",23,0) . W ?94,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3))) "RTN","BPSRPT5",24,0) . W ?98,$$RXSTATUS^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",25,0) . W ?100,$S($P(BPX,U):"/R",1:"/N") "RTN","BPSRPT5",26,0) . W ?109,$$RXCOB^BPSRPT8(BPPSEQ) "RTN","BPSRPT5",27,0) . W ?116,$S($$CLOSED02^BPSSCR03($P(^BPST($P(BPX,U,3),0),U,4))=1:"Closed",1:"Open") "RTN","BPSRPT5",28,0) . W ?128,$S($$ELIGCODE^BPSSCR05($P(BPX,U,3))="V":"Vet",$$ELIGCODE^BPSSCR05($P(BPX,U,3))="T":"Tri",1:"UNK") "RTN","BPSRPT5",29,0) I BPRTYPE=3 D Q "RTN","BPSRPT5",30,0) . W ?68,$$DATTIM^BPSRPT1(BPSRTDT) "RTN","BPSRPT5",31,0) . W ?100,$J(BPBIL,10,2),?122,$J(BPINS,10,2) "RTN","BPSRPT5",32,0) I BPRTYPE=5 D Q "RTN","BPSRPT5",33,0) . W ?65,$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($P(BPX,U,3),1)) "RTN","BPSRPT5",34,0) . W ?83,$$TTYPE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ) "RTN","BPSRPT5",35,0) . W ?100,$$RESPONSE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ) "RTN","BPSRPT5",36,0) . W ?125,$$RXCOB^BPSRPT8(BPPSEQ) "RTN","BPSRPT5",37,0) I BPRTYPE=7 D Q "RTN","BPSRPT5",38,0) . W ?65,$$MWC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",39,0) . W ?68,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3))) "RTN","BPSRPT5",40,0) . W ?72,$$RXSTATUS^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",41,0) . W ?74,$S($P(BPX,U):"/R",1:"/N") "RTN","BPSRPT5",42,0) . W ?79,$S($P(BPX,U,13):"REJ",1:"") "RTN","BPSRPT5",43,0) . W ?87,$$DRGNAM^BPSRPT6($P(BPX,U,14),30) "RTN","BPSRPT5",44,0) . W ?118,$$GETNDC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",45,0) Q "RTN","BPSRPT5",46,0) ; "RTN","BPSRPT5",47,0) ;Print Report Line 2 "RTN","BPSRPT5",48,0) WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,BPICNT,BPPSEQ) ; "RTN","BPSRPT5",49,0) ;Excel Output "RTN","BPSRPT5",50,0) I $G(BPEXCEL) D WRLINE2^BPSRPT8(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPPSEQ) Q "RTN","BPSRPT5",51,0) ;Report Output "RTN","BPSRPT5",52,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT5",53,0) . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),27),?32,$$GETNDC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",54,0) . I BPRTYPE=1 W ?47,$$DATTIM^BPSRPT1(+BPX) "RTN","BPSRPT5",55,0) . W ?68,$$MWC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",56,0) . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3))) "RTN","BPSRPT5",57,0) . W ?75,$$RXSTATUS^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",58,0) . W ?77,$S($P(BPX,U):"/R",1:"/N") "RTN","BPSRPT5",59,0) . W ?82,$S($P(BPX,U,13):"REJ",1:"") "RTN","BPSRPT5",60,0) . I BPRTYPE=4 W ?92,$$RXCOB^BPSRPT8(BPPSEQ) "RTN","BPSRPT5",61,0) . I BPRTYPE=1 W ?115,$$BILLCOB(BPRX,BPREF,BPPSEQ) "RTN","BPSRPT5",62,0) I BPRTYPE=2 D Q "RTN","BPSRPT5",63,0) . W !,?3,$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23) "RTN","BPSRPT5",64,0) . W ?31,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10) "RTN","BPSRPT5",65,0) . W ?41,$J(BPBIL,10,2) "RTN","BPSRPT5",66,0) . W ?54,$$QTY^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",67,0) . W ?61,$$GETNDC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",68,0) . W ?82,$$DRGNAM^BPSRPT6($P(BPX,U,14),32) "RTN","BPSRPT5",69,0) I BPRTYPE=3 D Q "RTN","BPSRPT5",70,0) . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),32) "RTN","BPSRPT5",71,0) . W ?41,$$GETNDC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",72,0) . W ?68,$$MWC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",73,0) . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3))) "RTN","BPSRPT5",74,0) . W ?74,$$RXSTATUS^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",75,0) . W ?76,$S($P(BPX,U):"/R",1:"/N") "RTN","BPSRPT5",76,0) . W ?81,$S($P(BPX,U,13):"REJ",1:"") "RTN","BPSRPT5",77,0) . W ?88,$$RXCOB^BPSRPT8(BPPSEQ) "RTN","BPSRPT5",78,0) I BPRTYPE=5 D Q "RTN","BPSRPT5",79,0) . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),23) "RTN","BPSRPT5",80,0) . W ?28,$$GETNDC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",81,0) . W ?47,$$MWC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",82,0) . W ?50,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3))) "RTN","BPSRPT5",83,0) . W ?53,$$RXSTATUS^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",84,0) . W ?55,$S($P(BPX,U):"/R",1:"/N") "RTN","BPSRPT5",85,0) . W ?60,$S($P(BPX,U,13):"REJ",1:"") "RTN","BPSRPT5",86,0) . I $P(BPGRPLAN,U,2)]"" W ?69,$E($P(BPGRPLAN,U,2),1,30) "RTN","BPSRPT5",87,0) . W ?122,$J($$ELAPSE^BPSRPT6($P(BPX,U,3)),10) "RTN","BPSRPT5",88,0) I BPRTYPE=7 D Q "RTN","BPSRPT5",89,0) . W !,?3,$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23) "RTN","BPSRPT5",90,0) . W ?31,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10) "RTN","BPSRPT5",91,0) . W ?41,$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$P(BPX,U,3))) "RTN","BPSRPT5",92,0) . N BPCLBY S BPCLBY=$E($$CLSBY^BPSRPT6(+$P(BPX,U,3)),1,25) S:BPCLBY="" BPCLBY="BLANK" "RTN","BPSRPT5",93,0) . W ?59,BPCLBY S BPCNT(BPCLBY)=$G(BPCNT(BPCLBY))+1,BPGCNT(BPCLBY)=$G(BPGCNT(BPCLBY))+1,BPICNT(BPCLBY)=$G(BPICNT(BPCLBY))+1 "RTN","BPSRPT5",94,0) . W ?87,$E($P($$CLRSN^BPSRPT7(+$P(BPX,U,3)),U,2),1,30) "RTN","BPSRPT5",95,0) . W ?121,$$RXCOB^BPSRPT8(BPPSEQ) "RTN","BPSRPT5",96,0) I BPRTYPE=8 D Q "RTN","BPSRPT5",97,0) . W !,?2,$$DRGNAM^BPSRPT6($P(BPX,U,14),34) "RTN","BPSRPT5",98,0) . W ?38,$$MWC^BPSRPT6(BPRX,BPREF) "RTN","BPSRPT5",99,0) . W ?42,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3))) "RTN","BPSRPT5",100,0) . W ?46,$$RXSTATUS^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",101,0) . W ?48,$S($P(BPX,U):"/R",1:"/N") "RTN","BPSRPT5",102,0) . W ?54,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10) "RTN","BPSRPT5",103,0) . W ?79,$E(BPGRPLAN,1,40) "RTN","BPSRPT5",104,0) . W ?121,$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ) "RTN","BPSRPT5",105,0) Q "RTN","BPSRPT5",106,0) ; "RTN","BPSRPT5",107,0) ;Print Report Line 3 "RTN","BPSRPT5",108,0) WRLINE3(BPRTYPE,BPREC,BPX,BPEXCEL) N BP59,BPRICINF "RTN","BPSRPT5",109,0) S BP59=+$P(BPX,U,3) "RTN","BPSRPT5",110,0) ;Excel Output "RTN","BPSRPT5",111,0) I $G(BPEXCEL) D WRLINE3^BPSRPT8(BPRTYPE,.BPREC,BPX) Q "RTN","BPSRPT5",112,0) ;Report Output "RTN","BPSRPT5",113,0) I BPRTYPE=4 D Q "RTN","BPSRPT5",114,0) . S NP=$$CHKP(1) Q:BPQ "RTN","BPSRPT5",115,0) . ;Released On "RTN","BPSRPT5",116,0) . W !,?6,$$DATTIM^BPSRPT1(+BPX) "RTN","BPSRPT5",117,0) . ;Method "RTN","BPSRPT5",118,0) . I $$AUTOREV^BPSRPT1(BP59) W ?22,"AUTO/" "RTN","BPSRPT5",119,0) . E W ?22,"REGULAR/" "RTN","BPSRPT5",120,0) . ;Return Status "RTN","BPSRPT5",121,0) . I $P(BPX,U,15)["ACCEPTED" W "ACCEPTED/" "RTN","BPSRPT5",122,0) . E W "REJECTED/" "RTN","BPSRPT5",123,0) . ;Reason "RTN","BPSRPT5",124,0) . W $$RVSRSN^BPSRPT7(+$P(BPX,U,3)) "RTN","BPSRPT5",125,0) ; "RTN","BPSRPT5",126,0) I BPRTYPE=8 D Q "RTN","BPSRPT5",127,0) . S BPRICINF=$$PRICEVAL(BP59) "RTN","BPSRPT5",128,0) . W !,?4,$S($P(BPRICINF,U,3)]"":$P(BPRICINF,U,3),1:"N/A") "RTN","BPSRPT5",129,0) . W ?23,$S($P(BPRICINF,U,4)]"":$P(BPRICINF,U,4),1:"N/A") "RTN","BPSRPT5",130,0) . W ?38,$S($P(BPRICINF,U,5)]"":$P(BPRICINF,U,5),1:"N/A") "RTN","BPSRPT5",131,0) . W ?56,$S($P(BPRICINF,U,6)]"":$P(BPRICINF,U,6),1:"N/A") "RTN","BPSRPT5",132,0) . W ?81,$S($P(BPRICINF,U,7)]"":$P(BPRICINF,U,7),1:"N/A") "RTN","BPSRPT5",133,0) . W ?96,$S($P(BPRICINF,U,2)]"":$P(BPRICINF,U,2),1:"N/A") "RTN","BPSRPT5",134,0) . W ?111,$S($P(BPRICINF,U,1)]"":$P(BPRICINF,U,1),1:"N/A") "RTN","BPSRPT5",135,0) ; "RTN","BPSRPT5",136,0) Q "RTN","BPSRPT5",137,0) ; "RTN","BPSRPT5",138,0) ;Display the Report "RTN","BPSRPT5",139,0) REPORT(REF,BPEXCEL,BPSCR,BPRPTNAM,BPSUMDET,BPPAGE) ; "RTN","BPSRPT5",140,0) N BPBIL,BPBLINE,BPCOLL,BPDFN,BPDIV,BPELTM,BPGELTM,BPGBIL,BPGINS,BPGCOLL,BPGCNT,BPGRPLAN,BPINS,BPLINES,BPREC,BPREF,BPRX,BPSRTDT,BPSTATUS,BPTBIL,BPTCOLL,BPTINS,BPX,BPSGTOT,NP,BPSDATA "RTN","BPSRPT5",141,0) N BPPSEQ,BPBILINF,BPRICINF "RTN","BPSRPT5",142,0) N BPGPRICE,BPG128,BPG129,BPG133,BPG134,BPG135,BPG136,BPG137 "RTN","BPSRPT5",143,0) N BPIPRICE,BPI128,BPI129,BPI133,BPI134,BPI135,BPI136,BPI137 "RTN","BPSRPT5",144,0) N BPTPRICE,BPT128,BPT129,BPT133,BPT134,BPT135,BPT136,BPT137 "RTN","BPSRPT5",145,0) I '$D(@REF) D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) W !,"No data meets the criteria." G XREPORT "RTN","BPSRPT5",146,0) S (BPGBIL,BPGINS,BPGCOLL,BPGCNT,BPGELTM,BPGPRICE,BPG128,BPG129,BPG133,BPG134,BPG135,BPG136,BPG137)=0 "RTN","BPSRPT5",147,0) S BPDIV="" F S BPDIV=$O(@REF@(BPDIV)) Q:BPDIV="" D Q:BPQ "RTN","BPSRPT5",148,0) .S BPGRPLAN=0 D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) "RTN","BPSRPT5",149,0) .N BPCNT S (BPTBIL,BPTINS,BPTCOLL,BPCNT,BPELTM,BPTPRICE,BPT128,BPT129,BPT133,BPT134,BPT135,BPT136,BPT137)=0 "RTN","BPSRPT5",150,0) .F S BPGRPLAN=$O(@REF@(BPDIV,BPGRPLAN)) Q:BPGRPLAN="" D Q:BPQ "RTN","BPSRPT5",151,0) .. I BPSUMDET=0 D WRPLAN(BPGRPLAN) Q:BPQ "RTN","BPSRPT5",152,0) .. S BPBLINE="" ;Reset Blank Line Indicator "RTN","BPSRPT5",153,0) .. N BPSCLM,BPREC,BPTOT,BPIBIL,BPICNT,BPICOL,BPIINS "RTN","BPSRPT5",154,0) .. S (BPIBIL,BPICNT,BPICOL,BPIINS,BPIPRICE,BPI128,BPI129,BPI133,BPI134,BPI135,BPI136,BPI137)=0 "RTN","BPSRPT5",155,0) .. S BPDFN="" F S BPDFN=$O(@REF@(BPDIV,BPGRPLAN,BPDFN)) Q:BPDFN="" D Q:BPQ "RTN","BPSRPT5",156,0) ... S BPSRTDT="" F S BPSRTDT=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT)) Q:BPSRTDT="" D Q:BPQ "RTN","BPSRPT5",157,0) .... S BPRX="" F S BPRX=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX)) Q:BPRX="" D Q:BPQ "RTN","BPSRPT5",158,0) ..... S BPREF="" F S BPREF=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF)) Q:BPREF="" D Q:BPQ "RTN","BPSRPT5",159,0) ...... S BPX=@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF) "RTN","BPSRPT5",160,0) ...... S BPCNT=BPCNT+1,BPGCNT=BPGCNT+1,BPICNT=BPICNT+1 "RTN","BPSRPT5",161,0) ...... S BPPSEQ=$$COB59^BPSUTIL2($P(BPX,U,3)) "RTN","BPSRPT5",162,0) ...... I BPRTYPE=5 D "RTN","BPSRPT5",163,0) ....... S BPELTM=BPELTM+$$ELAPSE^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",164,0) ....... S BPGELTM=BPGELTM+$$ELAPSE^BPSRPT6($P(BPX,U,3)) "RTN","BPSRPT5",165,0) ...... S BPBILINF=$$COLLECTD^BPSRPT6(BPRX,BPREF,BPPSEQ) "RTN","BPSRPT5",166,0) ...... S BPBIL=+$P(BPBILINF,U,2),BPTBIL=BPTBIL+BPBIL,BPGBIL=BPGBIL+BPBIL,BPIBIL=BPIBIL+BPBIL "RTN","BPSRPT5",167,0) ...... S BPINS=$$INSPAID^BPSRPT2($P(BPX,U,3)),BPTINS=BPTINS+BPINS,BPGINS=BPGINS+BPINS,BPIINS=BPIINS+BPINS "RTN","BPSRPT5",168,0) ...... S BPCOLL=+BPBILINF,BPTCOLL=BPTCOLL+BPCOLL,BPGCOLL=BPGCOLL+BPCOLL,BPICOL=BPICOL+BPCOLL "RTN","BPSRPT5",169,0) ...... I BPRTYPE=6 D Q "RTN","BPSRPT5",170,0) ....... S BPSTATUS=$P(BPX,U,7) "RTN","BPSRPT5",171,0) ....... I BPSTATUS["REJECT" S $P(BPSCLM(BPSRTDT),U,3)=$P($G(BPSCLM(BPSRTDT)),U,3)+BPBIL "RTN","BPSRPT5",172,0) ....... I BPSTATUS["PAYABLE" S $P(BPSCLM(BPSRTDT),U,4)=$P($G(BPSCLM(BPSRTDT)),U,4)+BPBIL "RTN","BPSRPT5",173,0) ....... S $P(BPSCLM(BPSRTDT),U,2)=$P($G(BPSCLM(BPSRTDT)),U,2)+BPBIL "RTN","BPSRPT5",174,0) ....... S $P(BPSCLM(BPSRTDT),U,5)=$P($G(BPSCLM(BPSRTDT)),U,5)+BPINS "RTN","BPSRPT5",175,0) ....... S $P(BPSCLM(BPSRTDT),U)=$P($G(BPSCLM(BPSRTDT)),U)+1 "RTN","BPSRPT5",176,0) ...... I BPRTYPE=8 D "RTN","BPSRPT5",177,0) ....... ;Get Pricing Information for totals "RTN","BPSRPT5",178,0) ....... S BPRICINF=$$PRICEVAL(+$P(BPX,U,3)) "RTN","BPSRPT5",179,0) ....... S BPI128=BPI128+$P($G(BPRICINF),U),BPI129=BPI129+$P($G(BPRICINF),U,2),BPI133=BPI133+$P($G(BPRICINF),U,3),BPI134=BPI134+$P($G(BPRICINF),U,4) "RTN","BPSRPT5",180,0) ....... S BPI135=BPI135+$P($G(BPRICINF),U,5),BPI136=BPI136+$P($G(BPRICINF),U,6),BPI137=BPI137+$P($G(BPRICINF),U,7) "RTN","BPSRPT5",181,0) ....... S BPT128=BPT128+$P($G(BPRICINF),U),BPT129=BPT129+$P($G(BPRICINF),U,2),BPT133=BPT133+$P($G(BPRICINF),U,3),BPT134=BPT134+$P($G(BPRICINF),U,4) "RTN","BPSRPT5",182,0) ....... S BPT135=BPT135+$P($G(BPRICINF),U,5),BPT136=BPT136+$P($G(BPRICINF),U,6),BPT137=BPT137+$P($G(BPRICINF),U,7) "RTN","BPSRPT5",183,0) ....... S BPG128=BPG128+$P($G(BPRICINF),U),BPG129=BPG129+$P($G(BPRICINF),U,2),BPG133=BPG133+$P($G(BPRICINF),U,3),BPG134=BPG134+$P($G(BPRICINF),U,4) "RTN","BPSRPT5",184,0) ....... S BPG135=BPG135+$P($G(BPRICINF),U,5),BPG136=BPG136+$P($G(BPRICINF),U,6),BPG137=BPG137+$P($G(BPRICINF),U,7) "RTN","BPSRPT5",185,0) ....... S BPIPRICE=BPI128_U_BPI129_U_BPI133_U_BPI134_U_BPI135_U_BPI136_U_BPI137 "RTN","BPSRPT5",186,0) ....... S BPTPRICE=BPT128_U_BPT129_U_BPT133_U_BPT134_U_BPT135_U_BPT136_U_BPT137 "RTN","BPSRPT5",187,0) ....... S BPGPRICE=BPG128_U_BPG129_U_BPG133_U_BPG134_U_BPG135_U_BPG136_U_BPG137 "RTN","BPSRPT5",188,0) ...... ;Display Detail Section "RTN","BPSRPT5",189,0) ...... Q:BPSUMDET=1 "RTN","BPSRPT5",190,0) ...... S BPREC="" ;Reset Excel Display Variable "RTN","BPSRPT5",191,0) ...... I 'BPEXCEL,BPRTYPE=1,BPBLINE=1 S NP=$$CHKP(2) Q:BPQ I BPBLINE=1 W ! ;Print blank line "RTN","BPSRPT5",192,0) ...... S NP=$$CHKP(1) Q:BPQ D WRLINE1(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL,BPPSEQ) "RTN","BPSRPT5",193,0) ...... S NP=$$CHKP(1) Q:BPQ D WRLINE2(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,.BPICNT,BPPSEQ) "RTN","BPSRPT5",194,0) ...... D WRLINE3(BPRTYPE,.BPREC,BPX,BPEXCEL) "RTN","BPSRPT5",195,0) ...... I (",2,7,8")[BPRTYPE,'BPEXCEL D Q:BPQ "RTN","BPSRPT5",196,0) ....... D COMMENT(+$P(BPX,U,3)) Q:BPQ "RTN","BPSRPT5",197,0) ....... S NP=$$CHKP(1) Q:BPQ "RTN","BPSRPT5",198,0) ....... W !,?10,"Claim ID: ",$$CLAIMID^BPSRPT2(+$P(BPX,U,3)) "RTN","BPSRPT5",199,0) ....... N BPSARR,BPRJCNT,BPZZ S BPRJCNT=$$REJTEXT^BPSRPT2(+$P(BPX,U,3),.BPSARR) "RTN","BPSRPT5",200,0) ....... F BPZZ=1:1:BPRJCNT S NP=$$CHKP(1) Q:BPQ W !,?10,BPSARR(BPZZ) Q:BPQ "RTN","BPSRPT5",201,0) ...... I 'BPEXCEL,BPRTYPE=1 S BPBLINE=1 ;Set Blank Line Display Indicator "RTN","BPSRPT5",202,0) .. I BPRTYPE=6 D PTBDT^BPSRPT7(BPDIV,BPSUMDET,.BPSCLM,.BPSGTOT) "RTN","BPSRPT5",203,0) .. I 'BPQ,(",1,2,3,4,7,8,")[BPRTYPE,'BPEXCEL S NP=$$CHKP(5) Q:BPQ D ITOT^BPSRPT8(BPRTYPE,BPDIV,BPGRPLAN,BPIBIL,BPIINS,BPICOL,.BPICNT,BPIPRICE) "RTN","BPSRPT5",204,0) .I 'BPEXCEL,'BPQ,BPRTYPE'=6 S NP=$$CHKP(5) Q:BPQ D TOTALS^BPSRPT7(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,.BPCNT,BPELTM,BPTPRICE) "RTN","BPSRPT5",205,0) .I 'BPEXCEL,'BPQ,$O(@REF@(BPDIV))]"" D:$G(BPSCR) PAUSE^BPSRPT1 Q:BPQ "RTN","BPSRPT5",206,0) ;Print Grand Totals "RTN","BPSRPT5",207,0) I 'BPEXCEL D "RTN","BPSRPT5",208,0) .I 'BPQ,BPRTYPE=6 D PGTOT6^BPSRPT7($G(BPSGTOT)) "RTN","BPSRPT5",209,0) .I 'BPQ,BPRTYPE'=6 S NP=$$CHKP(5) Q:BPQ D PGTOT^BPSRPT7(BPRTYPE,BPGBIL,BPGINS,BPGCOLL,.BPGCNT,BPGELTM,BPGPRICE) "RTN","BPSRPT5",210,0) ; "RTN","BPSRPT5",211,0) XREPORT Q "RTN","BPSRPT5",212,0) ; "RTN","BPSRPT5",213,0) ;Display Comments "RTN","BPSRPT5",214,0) ;Input Variable: BP59 - Lookup to BPS TRANSACTION (#59) "RTN","BPSRPT5",215,0) COMMENT(BP59) N CNODE,I,J,NP "RTN","BPSRPT5",216,0) S I="" F S I=$O(^BPST(BP59,11,"B",I),-1) Q:'I D Q:BPQ "RTN","BPSRPT5",217,0) .S NP=$$CHKP(1) Q:BPQ "RTN","BPSRPT5",218,0) .S J=$O(^BPST(BP59,11,"B",I,"")) Q:J="" "RTN","BPSRPT5",219,0) .S CNODE=$G(^BPST(BP59,11,J,0)) "RTN","BPSRPT5",220,0) .W !,?10,$$DATTIM^BPSRPT1(+$P($P(CNODE,U),"."))," - ",$P(CNODE,U,3) "RTN","BPSRPT5",221,0) Q "RTN","BPSRPT5",222,0) ; "RTN","BPSRPT5",223,0) ;Display the Insurance "RTN","BPSRPT5",224,0) ; Input Variable -> BPSDATA -> if 0, skip page check "RTN","BPSRPT5",225,0) ; BPEXCEL -> 1 - Print to Excel/0 Regular Display "RTN","BPSRPT5",226,0) WRPLAN(BPGRPLAN) N INS,NP "RTN","BPSRPT5",227,0) ; "RTN","BPSRPT5",228,0) I BPSUMDET'=0 Q "RTN","BPSRPT5",229,0) I BPEXCEL Q "RTN","BPSRPT5",230,0) ;Skip for Recent Transactions and Totals by Date Reports "RTN","BPSRPT5",231,0) I BPRTYPE=5!(BPRTYPE=6) Q "RTN","BPSRPT5",232,0) I $G(BPSDATA) S NP=$$CHKP(5) Q:BPQ!NP "RTN","BPSRPT5",233,0) ;Get and display the Insurance Name "RTN","BPSRPT5",234,0) S INS=$E(BPGRPLAN,1,90) "RTN","BPSRPT5",235,0) I INS]"" D "RTN","BPSRPT5",236,0) .D ULINE("-") "RTN","BPSRPT5",237,0) .W !,INS "RTN","BPSRPT5",238,0) .D ULINE("-") "RTN","BPSRPT5",239,0) Q "RTN","BPSRPT5",240,0) ; "RTN","BPSRPT5",241,0) ;Check for End of Page "RTN","BPSRPT5",242,0) ; Input variables -> BPLINES -> Number of lines from bottom "RTN","BPSRPT5",243,0) ; BPEXCEL -> 1 - Print to Excel/0 Regular Display "RTN","BPSRPT5",244,0) ; Output variable -> BPSDATA -> 0 -> New screen, no data displayed yet "RTN","BPSRPT5",245,0) ; 1 -> Data displayed on current screen "RTN","BPSRPT5",246,0) CHKP(BPLINES) Q:$G(BPEXCEL) 0 "RTN","BPSRPT5",247,0) S BPLINES=BPLINES+1 "RTN","BPSRPT5",248,0) I $G(BPSCR) S BPLINES=BPLINES+2 "RTN","BPSRPT5",249,0) I $G(BPSCR),'$G(BPSDATA) S BPSDATA=1 Q 0 "RTN","BPSRPT5",250,0) S BPSDATA=1 "RTN","BPSRPT5",251,0) I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE^BPSRPT1 Q:$G(BPQ) 0 D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) Q 1 "RTN","BPSRPT5",252,0) Q 0 "RTN","BPSRPT5",253,0) ; "RTN","BPSRPT5",254,0) ;Print one line of characters "RTN","BPSRPT5",255,0) ULINE(X) N I "RTN","BPSRPT5",256,0) W ! F I=1:1:132 W $G(X,"-") "RTN","BPSRPT5",257,0) Q "RTN","BPSRPT5",258,0) BILLCOB(BPRX,BPREF,BPPSEQ) ; "RTN","BPSRPT5",259,0) N BPSBILL "RTN","BPSRPT5",260,0) S BPSBILL=$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ) "RTN","BPSRPT5",261,0) I BPSBILL="" Q "" "RTN","BPSRPT5",262,0) Q $J(BPSBILL_" "_$$RXCOB^BPSRPT8(BPPSEQ)_" ",17) "RTN","BPSRPT5",263,0) ; "RTN","BPSRPT5",264,0) PRICING(BP59) ; Check if Pricing Segment exists "RTN","BPSRPT5",265,0) ; Returns: 1 if data exists, 0 if not "RTN","BPSRPT5",266,0) N BPSRESP,BPSPOS "RTN","BPSRPT5",267,0) D RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS) "RTN","BPSRPT5",268,0) S ^TMP($J,"ZZZBNT",BP59)=BPSRESP_U_BPSPOS "RTN","BPSRPT5",269,0) Q:(BPSRESP="")!(BPSPOS="") 0 "RTN","BPSRPT5",270,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,120)),U,8)]"" Q 1 "RTN","BPSRPT5",271,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,120)),U,9)]"" Q 1 "RTN","BPSRPT5",272,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,130)),U,3)]"" Q 1 "RTN","BPSRPT5",273,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,130)),U,4)]"" Q 1 "RTN","BPSRPT5",274,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,130)),U,5)]"" Q 1 "RTN","BPSRPT5",275,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,130)),U,6)]"" Q 1 "RTN","BPSRPT5",276,0) I $P($G(^BPSR(BPSRESP,1000,BPSPOS,130)),U,7)]"" Q 1 "RTN","BPSRPT5",277,0) Q 0 "RTN","BPSRPT5",278,0) ; "RTN","BPSRPT5",279,0) PRICEVAL(BP59) ; "RTN","BPSRPT5",280,0) N BPSRESP,BPSPOS,RETV,BPS120,BPS130 "RTN","BPSRPT5",281,0) S RETV=0 "RTN","BPSRPT5",282,0) D RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS) "RTN","BPSRPT5",283,0) Q:(BPSRESP="")!(BPSPOS="") RETV "RTN","BPSRPT5",284,0) S BPS120=$G(^BPSR(BPSRESP,1000,BPSPOS,120)),BPS130=$G(^BPSR(BPSRESP,1000,BPSPOS,130)) "RTN","BPSRPT5",285,0) S RETV=$$DFF2EXT^BPSECFM($P($G(BPS120),U,8))_U_$$DFF2EXT^BPSECFM($P($G(BPS120),U,9))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,3))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,4)) "RTN","BPSRPT5",286,0) S RETV=RETV_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,5))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,6))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,7)) "RTN","BPSRPT5",287,0) Q RETV "RTN","BPSRPT5",288,0) ; "RTN","BPSRPT7") 0^5^B105055369 "RTN","BPSRPT7",1,0) BPSRPT7 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05 "RTN","BPSRPT7",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSRPT7",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPT7",4,0) ; "RTN","BPSRPT7",5,0) Q "RTN","BPSRPT7",6,0) ; "RTN","BPSRPT7",7,0) ;Routine to Display the Reports (Continued) "RTN","BPSRPT7",8,0) ; "RTN","BPSRPT7",9,0) ; Input Variables -> BPCLM = Array of report data by date "RTN","BPSRPT7",10,0) ; BPDIV,BPSUMDET,GTOT "RTN","BPSRPT7",11,0) ; Returned Value -> Cumulative Grand Totals "RTN","BPSRPT7",12,0) ; "RTN","BPSRPT7",13,0) PTBDT(BPDIV,BPSUMDET,BPCLM,GTOT) N DIFF,I,NP,RDT,TOT,X "RTN","BPSRPT7",14,0) ; "RTN","BPSRPT7",15,0) ;Loop through compiled array and display "RTN","BPSRPT7",16,0) S TOT="" "RTN","BPSRPT7",17,0) S RDT="" F S RDT=$O(BPCLM(RDT)) Q:RDT="" D Q:BPQ "RTN","BPSRPT7",18,0) .S NP=$$CHKP^BPSRPT5(1) Q:BPQ "RTN","BPSRPT7",19,0) .S X=$G(BPCLM(RDT)) "RTN","BPSRPT7",20,0) .; "RTN","BPSRPT7",21,0) .;Print Details - Report "RTN","BPSRPT7",22,0) .I BPSUMDET=0,'BPEXCEL D "RTN","BPSRPT7",23,0) ..W !,$$DATTIM^BPSRPT1(RDT) ;Date "RTN","BPSRPT7",24,0) ..W ?15,$J(+$P(X,U),17) ;#Claims "RTN","BPSRPT7",25,0) ..W ?33,$J(+$P(X,U,2),17,2) ;Amount Submitted "RTN","BPSRPT7",26,0) ..W ?51,$J(+$P(X,U,3),17,2) ;Returned Rejected "RTN","BPSRPT7",27,0) ..W ?69,$J(+$P(X,U,4),17,2) ;Returned Payable "RTN","BPSRPT7",28,0) ..W ?87,$J(+$P(X,U,5),17,2) ;Amount to Receive "RTN","BPSRPT7",29,0) ..; "RTN","BPSRPT7",30,0) ..;Difference "RTN","BPSRPT7",31,0) ..S DIFF=+$P(X,U,4)-$P(X,U,5) "RTN","BPSRPT7",32,0) ..I DIFF<0 S DIFF="<"_$TR($J(-DIFF,15,2)," ")_">" W ?117,$J(DIFF,15) "RTN","BPSRPT7",33,0) ..E W ?116,$J(DIFF,15,2) "RTN","BPSRPT7",34,0) ..; "RTN","BPSRPT7",35,0) ..;Print Details - Excel "RTN","BPSRPT7",36,0) .I BPSUMDET=0,BPEXCEL D "RTN","BPSRPT7",37,0) ..; "RTN","BPSRPT7",38,0) ..;Division "RTN","BPSRPT7",39,0) ..W !,$S(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV),U "RTN","BPSRPT7",40,0) ..W $$DATTIM^BPSRPT1(RDT),U ;Date "RTN","BPSRPT7",41,0) ..W +$P(X,U),U ;#Claims "RTN","BPSRPT7",42,0) ..W $TR($J(+$P(X,U,2),17,2)," "),U ;Amount Submitted "RTN","BPSRPT7",43,0) ..W $TR($J(+$P(X,U,3),17,2)," "),U ;Returned Rejected "RTN","BPSRPT7",44,0) ..W $TR($J(+$P(X,U,4),17,2)," "),U ;Returned Payable "RTN","BPSRPT7",45,0) ..W $TR($J(+$P(X,U,5),17,2)," "),U ;Amount to Receive "RTN","BPSRPT7",46,0) ..; "RTN","BPSRPT7",47,0) ..;Difference "RTN","BPSRPT7",48,0) ..S DIFF=+$P(X,U,4)-$P(X,U,5) "RTN","BPSRPT7",49,0) ..W $TR($J(DIFF,15,2)," ") "RTN","BPSRPT7",50,0) .; "RTN","BPSRPT7",51,0) .;Save Totals "RTN","BPSRPT7",52,0) .F I=1:1:5 S $P(TOT,U,I)=$P(TOT,U,I)+$P(X,U,I),$P(GTOT,U,I)=$P($G(GTOT),U,I)+$P(X,U,I) "RTN","BPSRPT7",53,0) ; "RTN","BPSRPT7",54,0) ;Print Totals "RTN","BPSRPT7",55,0) Q:BPEXCEL "RTN","BPSRPT7",56,0) Q:BPQ S NP=$$CHKP^BPSRPT5(2) Q:BPQ "RTN","BPSRPT7",57,0) D ULINE^BPSRPT5("-") "RTN","BPSRPT7",58,0) W !,"TOTALS" "RTN","BPSRPT7",59,0) W ?15,$J(+$P(TOT,U),17) "RTN","BPSRPT7",60,0) W ?33,$J(+$P(TOT,U,2),17,2) "RTN","BPSRPT7",61,0) W ?51,$J(+$P(TOT,U,3),17,2) "RTN","BPSRPT7",62,0) W ?69,$J(+$P(TOT,U,4),17,2) "RTN","BPSRPT7",63,0) W ?87,$J(+$P(TOT,U,5),17,2) "RTN","BPSRPT7",64,0) S X=$S((+$P(TOT,U,4))=0:0,1:(+$P(TOT,U,5))/(+$P(TOT,U,4))) "RTN","BPSRPT7",65,0) S DIFF=+$P(TOT,U,4)-$P(TOT,U,5) "RTN","BPSRPT7",66,0) I DIFF<0 S DIFF="<"_$TR($J(-DIFF,15,2)," ")_">" W ?117,$J(DIFF,15) "RTN","BPSRPT7",67,0) E W ?116,$J(DIFF,15,2) "RTN","BPSRPT7",68,0) Q "RTN","BPSRPT7",69,0) ; "RTN","BPSRPT7",70,0) ;Print Grand Totals - Report 6 "RTN","BPSRPT7",71,0) ; "RTN","BPSRPT7",72,0) PGTOT6(GTOT) N DIFF,NP,X "RTN","BPSRPT7",73,0) Q:BPQ S NP=$$CHKP^BPSRPT5(2) Q:BPQ "RTN","BPSRPT7",74,0) D ULINE^BPSRPT5("-") "RTN","BPSRPT7",75,0) W !,"GRAND TOTALS" "RTN","BPSRPT7",76,0) W ?15,$J(+$P(GTOT,U),17) "RTN","BPSRPT7",77,0) W ?33,$J(+$P(GTOT,U,2),17,2) "RTN","BPSRPT7",78,0) W ?51,$J(+$P(GTOT,U,3),17,2) "RTN","BPSRPT7",79,0) W ?69,$J(+$P(GTOT,U,4),17,2) "RTN","BPSRPT7",80,0) W ?87,$J(+$P(GTOT,U,5),17,2) "RTN","BPSRPT7",81,0) S X=$S((+$P(GTOT,U,4))=0:0,1:(+$P(GTOT,U,5))/(+$P(GTOT,U,4))) "RTN","BPSRPT7",82,0) S DIFF=+$P(GTOT,U,4)-$P(GTOT,U,5) "RTN","BPSRPT7",83,0) I DIFF<0 S DIFF="<"_$TR($J(-DIFF,15,2)," ")_">" W ?117,$J(DIFF,15) "RTN","BPSRPT7",84,0) E W ?116,$J(DIFF,15,2) "RTN","BPSRPT7",85,0) Q "RTN","BPSRPT7",86,0) ; "RTN","BPSRPT7",87,0) ;Print Grand Totals - Reports 1,2,3,4,5,7,8 "RTN","BPSRPT7",88,0) ; "RTN","BPSRPT7",89,0) PGTOT(BPRTYPE,BPGBIL,BPGINS,BPGCOLL,BPGCNT,BPGELTM,BPRICE) ; "RTN","BPSRPT7",90,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT7",91,0) .W !!,?78,"----------",?100,"----------",?122,"----------" "RTN","BPSRPT7",92,0) .W !,"GRAND TOTALS",?78,$J(BPGBIL,10,2),?100,$J(BPGINS,10,2),?122,$J(BPGCOLL,10,2) "RTN","BPSRPT7",93,0) .W !,"COUNT",?78,$J(BPGCNT,10),?100,$J(BPGCNT,10),?122,$J(BPGCNT,10) "RTN","BPSRPT7",94,0) .W:BPGCNT !,"MEAN",?78,$J(BPGBIL/BPGCNT,10,2),?100,$J(BPGINS/BPGCNT,10,2),?122,$J(BPGCOLL/BPGCNT,10,2) "RTN","BPSRPT7",95,0) I BPRTYPE=3 D Q "RTN","BPSRPT7",96,0) .W !!,?100,"----------",?122,"----------" "RTN","BPSRPT7",97,0) .W !,"GRAND TOTALS",?100,$J(BPGBIL,10,2),?122,$J(BPGINS,10,2) "RTN","BPSRPT7",98,0) .W !,"COUNT",?100,$J(BPGCNT,10),?122,$J(BPGCNT,10) "RTN","BPSRPT7",99,0) .W:BPGCNT !,"MEAN",?100,$J(BPGBIL/BPGCNT,10,2),?122,$J(BPGINS/BPGCNT,10,2) "RTN","BPSRPT7",100,0) I BPRTYPE=2 D Q "RTN","BPSRPT7",101,0) .W !!,?41,"----------" "RTN","BPSRPT7",102,0) .W !,"GRAND TOTALS",?41,$J(BPGBIL,10,2) "RTN","BPSRPT7",103,0) .W !,"COUNT",?41,$J(BPGCNT,10) "RTN","BPSRPT7",104,0) .W:BPGCNT !,"MEAN",?41,$J(BPGBIL/BPGCNT,10,2) "RTN","BPSRPT7",105,0) I (BPRTYPE=5) D Q "RTN","BPSRPT7",106,0) .W !!,"GRAND TOTALS (ALL DIVISIONS)",?65,"---------------" "RTN","BPSRPT7",107,0) .W !,"TOTAL CLAIMS",?65,$J(BPGCNT,15) "RTN","BPSRPT7",108,0) .W !,"AVERAGE ELAPSED TIME PER CLAIM",?65,$J($S(BPGCNT=0:"0",1:(BPGELTM\BPGCNT)),15) "RTN","BPSRPT7",109,0) I (BPRTYPE=7) D Q "RTN","BPSRPT7",110,0) .W !!,"GRAND TOTALS (ALL DIVISIONS) BY BILLER" "RTN","BPSRPT7",111,0) .N BPBILR,BPDIV S BPDIV="ALL DIVISIONS" "RTN","BPSRPT7",112,0) .S BPBILR="" F S BPBILR=$O(BPGCNT(BPBILR)) Q:BPBILR="" D Q:BPQ "RTN","BPSRPT7",113,0) ..S NP=$$CHKP^BPSRPT5(1) Q:BPQ "RTN","BPSRPT7",114,0) ..W !,?3,BPBILR,?65,$J($G(BPGCNT(BPBILR)),5) "RTN","BPSRPT7",115,0) .Q:$G(BPQ) "RTN","BPSRPT7",116,0) .W !,?65,"-----" "RTN","BPSRPT7",117,0) .W !,"CLOSED CLAIMS GRAND TOTAL",?65,$J(BPGCNT,5) "RTN","BPSRPT7",118,0) I BPRTYPE=8 D Q "RTN","BPSRPT7",119,0) .W !!,?78,"----------",?100,"----------",?122,"----------" "RTN","BPSRPT7",120,0) .W !,"GRAND TOTALS",?78,$J(BPGBIL,10,2),?100,$J(BPGINS,10,2),?122,$J(BPGCOLL,10,2) "RTN","BPSRPT7",121,0) .W !,?4,$J($P(BPRICE,U,3),10,2),?23,$J($P(BPRICE,U,4),10,2),?38,$J($P(BPRICE,U,5),10,2),?56,$J($P(BPRICE,U,6),10,2),?81,$J($P(BPRICE,U,7),10,2),?96,$J($P(BPRICE,U,2),10,2),?111,$J($P(BPRICE,U),10,2) "RTN","BPSRPT7",122,0) .W !,"COUNT",?78,$J(BPGCNT,10),?100,$J(BPGCNT,10),?122,$J(BPGCNT,10) "RTN","BPSRPT7",123,0) .W !,?4,$J(BPGCNT,10),?23,$J(BPGCNT,10),?38,$J(BPGCNT,10),?56,$J(BPGCNT,10),?81,$J(BPGCNT,10),?96,$J(BPGCNT,10),?111,$J(BPGCNT,10) "RTN","BPSRPT7",124,0) .W:BPGCNT !,"MEAN",?78,$J(BPGBIL/BPGCNT,10,2),?100,$J(BPGINS/BPGCNT,10,2),?122,$J(BPGCOLL/BPGCNT,10,2) "RTN","BPSRPT7",125,0) .W !,?4,$J($P(BPRICE,U,3)/BPGCNT,10,2),?23,$J($P(BPRICE,U,4)/BPGCNT,10,2),?38,$J($P(BPRICE,U,5)/BPGCNT,10,2) "RTN","BPSRPT7",126,0) .W ?56,$J($P(BPRICE,U,6)/BPGCNT,10,2),?81,$J($P(BPRICE,U,7)/BPGCNT,10,2),?96,$J($P(BPRICE,U,2)/BPGCNT,10,2),?111,$J($P(BPRICE,U)/BPGCNT,10,2) "RTN","BPSRPT7",127,0) ; "RTN","BPSRPT7",128,0) Q "RTN","BPSRPT7",129,0) ; "RTN","BPSRPT7",130,0) ;Get Close Reason "RTN","BPSRPT7",131,0) ; "RTN","BPSRPT7",132,0) ; Input Variable -> BP59 = ptr to BPS TRANSACTIONS "RTN","BPSRPT7",133,0) ; Returned Value -> Claim Close Reason "RTN","BPSRPT7",134,0) ; "RTN","BPSRPT7",135,0) CLRSN(BP59) N BP02,CIEN,CL "RTN","BPSRPT7",136,0) S CL="" "RTN","BPSRPT7",137,0) S BP02=+$P($G(^BPST(BP59,0)),U,4) "RTN","BPSRPT7",138,0) S CIEN=+$P($G(^BPSC(BP02,900)),U,4) "RTN","BPSRPT7",139,0) I CIEN'=0 S CL=$$GETCLR^BPSRPT6(CIEN) "RTN","BPSRPT7",140,0) Q CIEN_"^"_CL "RTN","BPSRPT7",141,0) ; "RTN","BPSRPT7",142,0) ;Get Reversal Reason "RTN","BPSRPT7",143,0) ; "RTN","BPSRPT7",144,0) ; Input Variable -> BP59 = ptr to BPS TRANSACTIONS "RTN","BPSRPT7",145,0) ; Returned Value -> Claim Reversal Reason "RTN","BPSRPT7",146,0) ; "RTN","BPSRPT7",147,0) RVSRSN(BP59) Q $P($G(^BPST(BP59,4)),U,4) "RTN","BPSRPT7",148,0) ; "RTN","BPSRPT7",149,0) ;Return the Billed Amount "RTN","BPSRPT7",150,0) ; "RTN","BPSRPT7",151,0) BILLED(BP59) ; "RTN","BPSRPT7",152,0) Q +$P($G(^BPST(BP59,5)),U,5) "RTN","BPSRPT7",153,0) ; "RTN","BPSRPT7",154,0) ;Return the Transaction Type - SUBMIT or REVERSAL "RTN","BPSRPT7",155,0) ; "RTN","BPSRPT7",156,0) TTYPE(BPRX,BPREF,BPSEQ) N BPSTATUS,TTYPE "RTN","BPSRPT7",157,0) S TTYPE="SUBMIT" "RTN","BPSRPT7",158,0) S BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF,$G(BPSEQ)) "RTN","BPSRPT7",159,0) I BPSTATUS["REVERSAL" S TTYPE="REVERSAL" "RTN","BPSRPT7",160,0) Q TTYPE "RTN","BPSRPT7",161,0) ; "RTN","BPSRPT7",162,0) ;Return the payer response "RTN","BPSRPT7",163,0) ; "RTN","BPSRPT7",164,0) RESPONSE(BPRX,BPREF,BPSEQ) Q $P($$STATUS^BPSRPT6(BPRX,BPREF,$G(BPSEQ)),U) "RTN","BPSRPT7",165,0) ; "RTN","BPSRPT7",166,0) ;Print Report Subtotals "RTN","BPSRPT7",167,0) ; "RTN","BPSRPT7",168,0) TOTALS(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,BPCNT,BPELTM,BPRICE) ; "RTN","BPSRPT7",169,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT7",170,0) .W !!,?78,"----------",?100,"----------",?122,"----------" "RTN","BPSRPT7",171,0) .W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?78,$J(BPTBIL,10,2),?100,$J(BPTINS,10,2),?122,$J(BPTCOLL,10,2) "RTN","BPSRPT7",172,0) .W !,"COUNT",?78,$J(BPCNT,10),?100,$J(BPCNT,10),?122,$J(BPCNT,10) "RTN","BPSRPT7",173,0) .W:BPCNT !,"MEAN",?78,$J(BPTBIL/BPCNT,10,2),?100,$J(BPTINS/BPCNT,10,2),?122,$J(BPTCOLL/BPCNT,10,2) "RTN","BPSRPT7",174,0) I BPRTYPE=3 D Q "RTN","BPSRPT7",175,0) .W !!,?100,"----------",?122,"----------" "RTN","BPSRPT7",176,0) .W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?100,$J(BPTBIL,10,2),?122,$J(BPTINS,10,2) "RTN","BPSRPT7",177,0) .W !,"COUNT",?100,$J(BPCNT,10),?122,$J(BPCNT,10) "RTN","BPSRPT7",178,0) .W:BPCNT !,"MEAN",?100,$J(BPTBIL/BPCNT,10,2),?122,$J(BPTINS/BPCNT,10,2) "RTN","BPSRPT7",179,0) I BPRTYPE=2 D Q "RTN","BPSRPT7",180,0) .W !!,?41,"----------" "RTN","BPSRPT7",181,0) .W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,22),?41,$J(BPTBIL,10,2) "RTN","BPSRPT7",182,0) .W !,"COUNT",?41,$J(BPCNT,10) "RTN","BPSRPT7",183,0) .W:BPCNT !,"MEAN",?41,$J(BPTBIL/BPCNT,10,2) "RTN","BPSRPT7",184,0) I (BPRTYPE=5) D Q "RTN","BPSRPT7",185,0) .W !!,"SUBTOTALS for DIV: ",$E($$BPDIV(BPDIV),1,43),?65,"---------------" "RTN","BPSRPT7",186,0) .W !,"TOTAL CLAIMS",?65,$J(BPCNT,15) "RTN","BPSRPT7",187,0) .W !,"AVERAGE ELAPSED TIME PER CLAIM",?65,$J($S(BPCNT=0:"0",1:(BPELTM\BPCNT)),15) "RTN","BPSRPT7",188,0) I (BPRTYPE=7) D Q "RTN","BPSRPT7",189,0) .W !!,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,43) "RTN","BPSRPT7",190,0) .N BPBILR "RTN","BPSRPT7",191,0) .S BPBILR="" F S BPBILR=$O(BPCNT(BPBILR)) Q:BPBILR="" D Q:BPQ "RTN","BPSRPT7",192,0) ..S NP=$$CHKP^BPSRPT5(1) Q:BPQ "RTN","BPSRPT7",193,0) ..W !,?3,BPBILR,?65,$J($G(BPCNT(BPBILR)),5) "RTN","BPSRPT7",194,0) .Q:$G(BPQ) "RTN","BPSRPT7",195,0) .W !,?65,"-----" "RTN","BPSRPT7",196,0) .W !,"CLOSED CLAIMS SUBTOTAL",?65,$J(BPCNT,5) "RTN","BPSRPT7",197,0) I BPRTYPE=8 D Q "RTN","BPSRPT7",198,0) .W !!,?78,"----------",?100,"----------",?122,"----------" "RTN","BPSRPT7",199,0) .W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?78,$J(BPTBIL,10,2),?100,$J(BPTINS,10,2),?122,$J(BPTCOLL,10,2) "RTN","BPSRPT7",200,0) .W !,?4,$J($P(BPRICE,U,3),10,2),?23,$J($P(BPRICE,U,4),10,2),?38,$J($P(BPRICE,U,5),10,2),?56,$J($P(BPRICE,U,6),10,2),?81,$J($P(BPRICE,U,7),10,2),?96,$J($P(BPRICE,U,2),10,2),?111,$J($P(BPRICE,U),10,2) "RTN","BPSRPT7",201,0) .W !,"COUNT",?78,$J(BPCNT,10),?100,$J(BPCNT,10),?122,$J(BPCNT,10) "RTN","BPSRPT7",202,0) .W !,?4,$J(BPCNT,10),?23,$J(BPCNT,10),?38,$J(BPCNT,10),?56,$J(BPCNT,10),?81,$J(BPCNT,10),?96,$J(BPCNT,10),?111,$J(BPCNT,10) "RTN","BPSRPT7",203,0) .W:BPCNT !,"MEAN",?78,$J(BPTBIL/BPCNT,10,2),?100,$J(BPTINS/BPCNT,10,2),?122,$J(BPTCOLL/BPCNT,10,2) "RTN","BPSRPT7",204,0) .W !,?4,$J($P(BPRICE,U,3)/BPCNT,10,2),?23,$J($P(BPRICE,U,4)/BPCNT,10,2),?38,$J($P(BPRICE,U,5)/BPCNT,10,2),?56,$J($P(BPRICE,U,6)/BPCNT,10,2),?81,$J($P(BPRICE,U,7)/BPCNT,10,2),?96,$J($P(BPRICE,U,2)/BPCNT,10,2),?111,$J($P(BPRICE,U)/BPCNT,10,2) "RTN","BPSRPT7",205,0) ; "RTN","BPSRPT7",206,0) Q "RTN","BPSRPT7",207,0) ; "RTN","BPSRPT7",208,0) ;Print Report Header "RTN","BPSRPT7",209,0) ; Input variables (defined in BPSRPT0) - BPPHARM,BPSUMDET,BPNOW,BPMWC,BPRTBCK,BPINSINF "RTN","BPSRPT7",210,0) ; BPREJCD,BPCCRSN,BPAUTREV,BPACREJ,BPQSTDRG "RTN","BPSRPT7",211,0) ; BPDRUG,BPDRGCL,BPRLNRL,BPSORT,BPBEGDT,BPENDDT "RTN","BPSRPT7",212,0) ; Output variable - BPSDATA -> Reset to 0 to show no actual data has been printed "RTN","BPSRPT7",213,0) ; on the screen "RTN","BPSRPT7",214,0) ; BPPAGE -> First set in BPSRPT0 "RTN","BPSRPT7",215,0) ; BPBLINE -> Controls whether to print a blank line "RTN","BPSRPT7",216,0) ; "RTN","BPSRPT7",217,0) HDR(BPRTYPE,BPRPTNAM,BPPAGE) ; "RTN","BPSRPT7",218,0) ;Display Excel Header "RTN","BPSRPT7",219,0) I BPEXCEL D HDR^BPSRPT8(BPRTYPE) Q "RTN","BPSRPT7",220,0) ; "RTN","BPSRPT7",221,0) ; Define BPPDATA - Tells whether data has been displayed for a screen "RTN","BPSRPT7",222,0) S BPSDATA=0 "RTN","BPSRPT7",223,0) S BPBLINE="" "RTN","BPSRPT7",224,0) S BPPAGE=$G(BPPAGE)+1 "RTN","BPSRPT7",225,0) W @IOF "RTN","BPSRPT7",226,0) W "ECME "_BPRPTNAM_" "_$S(BPSUMDET=1:"SUMMARY",1:"DETAIL")_" REPORT" "RTN","BPSRPT7",227,0) W ?89,"Print Date: "_$G(BPNOW)_" Page:",$J(BPPAGE,3) "RTN","BPSRPT7",228,0) W !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(75,.BPPHARM) "RTN","BPSRPT7",229,0) W ?93,"Fill Locations: "_$S(BPMWC="A":"C,M,W",1:BPMWC) "RTN","BPSRPT7",230,0) W ?116,"Fill type: "_$S(BPRTBCK=2:"RT",BPRTBCK=3:"BB",1:"RT,BB") "RTN","BPSRPT7",231,0) W !,"Insurance: "_$S(BPINSINF=0:"ALL",1:$$BPINS(BPINSINF)) "RTN","BPSRPT7",232,0) I (",7,")[BPRTYPE W ?44,"Close Reason: ",$E($$GETCLR^BPSRPT6(BPCCRSN),1,26) "RTN","BPSRPT7",233,0) I (",4,")[BPRTYPE W ?44,$J($S(BPAUTREV=0:"ALL",1:"AUTO"),4)," Reversals" "RTN","BPSRPT7",234,0) I (",4,")[BPRTYPE W ?60,$J($S(BPACREJ=1:"REJECTED",BPACREJ=2:"ACCEPTED",1:"ALL"),8)," Returned Status" "RTN","BPSRPT7",235,0) W ?87,"Drugs/Classes: "_$S(BPQSTDRG=2:$$DRGNAM^BPSRPT6(BPDRUG,30),BPQSTDRG=3:$E(BPDRGCL,1,30),1:"ALL") "RTN","BPSRPT7",236,0) I (",2,")[BPRTYPE W !,"Reject Code: ",$E($$GETREJ^BPSRPT4(BPREJCD),1,28) "RTN","BPSRPT7",237,0) I (",2,")[BPRTYPE W ?89,"Eligibility: ",$S(BPELIG="V":"VET",BPELIG="T":"TRI",1:"ALL"),?111,"Open/Closed: ",$S(BPOPCL=1:"CLOSED",BPOPCL=2:"OPEN",1:"ALL") "RTN","BPSRPT7",238,0) W !,$S(BPRTYPE=5:"PRESCRIPTIONS",BPRLNRL=2:"RELEASED PRESCRIPTIONS",BPRLNRL=3:"PRESCRIPTIONS (NOT RELEASED)",1:"ALL PRESCRIPTIONS") "RTN","BPSRPT7",239,0) W " BY "_$S(BPRTYPE=7:"CLOSE",1:"TRANSACTION")_" DATE: " "RTN","BPSRPT7",240,0) W "From "_$$DATTIM^BPSRPT1(BPBEGDT)_" through "_$$DATTIM^BPSRPT1($P(BPENDDT,".")) "RTN","BPSRPT7",241,0) ; "RTN","BPSRPT7",242,0) D ULINE^BPSRPT5("=") Q:$G(BPQ) "RTN","BPSRPT7",243,0) D HEADLN1^BPSRPT4(BPRTYPE) "RTN","BPSRPT7",244,0) D HEADLN2^BPSRPT4(BPRTYPE) "RTN","BPSRPT7",245,0) D HEADLN3^BPSRPT4(BPRTYPE) "RTN","BPSRPT7",246,0) D ULINE^BPSRPT5("=") "RTN","BPSRPT7",247,0) ; "RTN","BPSRPT7",248,0) ;Print Division "RTN","BPSRPT7",249,0) I $G(BPDIV)]"" D "RTN","BPSRPT7",250,0) .W !,"DIVISION: ",$S(BPDIV=0:"BLANK",BPDIV="ALL DIVISIONS":"ALL DIVISIONS",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV) "RTN","BPSRPT7",251,0) .I BPRTYPE=5!(BPRTYPE=6)!(BPSUMDET=1)!(BPGRPLAN="") D ULINE^BPSRPT5("-") "RTN","BPSRPT7",252,0) ; "RTN","BPSRPT7",253,0) ;Print Insurance If Defined "RTN","BPSRPT7",254,0) I BPSUMDET=0,$G(BPGRPLAN)]"",$G(BPGRPLAN)'=0,$G(BPGRPLAN)'="~" D WRPLAN^BPSRPT5(BPGRPLAN) "RTN","BPSRPT7",255,0) Q "RTN","BPSRPT7",256,0) ; "RTN","BPSRPT7",257,0) ;Special Division Handling "RTN","BPSRPT7",258,0) ; "RTN","BPSRPT7",259,0) BPDIV(BPDIV) Q $S(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV) "RTN","BPSRPT7",260,0) ; "RTN","BPSRPT7",261,0) ;Get selected insurance names based on user selection "RTN","BPSRPT7",262,0) ;If length is greater than 68 append "..." "RTN","BPSRPT7",263,0) ;Input: BPINSINF = Semi-colon separated list of file 36 IENs "RTN","BPSRPT7",264,0) ;Output: comma separated list of related file 36 names "RTN","BPSRPT7",265,0) BPINS(BPINSINF) ; "RTN","BPSRPT7",266,0) N BPINS,BPINAME,RETV "RTN","BPSRPT7",267,0) S RETV="" "RTN","BPSRPT7",268,0) F I=2:1 S BPINS=$P($G(BPINSINF),";",I) Q:BPINS="" D "RTN","BPSRPT7",269,0) . S BPINAME=$$INSNM^IBNCPDPI(BPINS) Q:BPINAME="" "RTN","BPSRPT7",270,0) . I RETV'="" S RETV=RETV_", "_BPINAME Q "RTN","BPSRPT7",271,0) . S RETV=BPINAME "RTN","BPSRPT7",272,0) I $L(RETV)>68 S RETV=$E(RETV,1,68)_"..." "RTN","BPSRPT7",273,0) Q RETV "RTN","BPSRPT8") 0^7^B125609567 "RTN","BPSRPT8",1,0) BPSRPT8 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05 "RTN","BPSRPT8",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSRPT8",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSRPT8",4,0) ; "RTN","BPSRPT8",5,0) Q "RTN","BPSRPT8",6,0) ; "RTN","BPSRPT8",7,0) ;Routine to Display the Reports in Excel "RTN","BPSRPT8",8,0) ; "RTN","BPSRPT8",9,0) ;Print Report Line 1 "RTN","BPSRPT8",10,0) ; "RTN","BPSRPT8",11,0) ; Input Variable -> BPRTYPE,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT "RTN","BPSRPT8",12,0) ; BPBIL,BPINS,BPCOLL "RTN","BPSRPT8",13,0) ; "RTN","BPSRPT8",14,0) WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPPSEQ) ; "RTN","BPSRPT8",15,0) ; "RTN","BPSRPT8",16,0) ;Division "RTN","BPSRPT8",17,0) S BPREC=$S(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)_U "RTN","BPSRPT8",18,0) ;Insurance "RTN","BPSRPT8",19,0) I BPRTYPE'=5,BPRTYPE'=6 S BPREC=BPREC_$E(BPGRPLAN,1,90)_U "RTN","BPSRPT8",20,0) S BPREC=BPREC_$$PATNAME^BPSRPT6(BPDFN)_U ;Patient Name "RTN","BPSRPT8",21,0) S BPREC=BPREC_"("_$$SSN4^BPSRPT6(BPDFN)_")"_U ;L4SSN "RTN","BPSRPT8",22,0) S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number "RTN","BPSRPT8",23,0) S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number "RTN","BPSRPT8",24,0) ; "RTN","BPSRPT8",25,0) I (BPRTYPE=1)!(BPRTYPE=4)!(BPRTYPE=8) D Q "RTN","BPSRPT8",26,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date "RTN","BPSRPT8",27,0) . S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed "RTN","BPSRPT8",28,0) . S BPREC=BPREC_$TR($J(BPINS,10,2)," ")_U ;$Ins. Paid "RTN","BPSRPT8",29,0) . S BPREC=BPREC_$S(BPCOLL]"":$TR($J(BPCOLL,10,2)," "),1:"")_U ;$Collected "RTN","BPSRPT8",30,0) ; "RTN","BPSRPT8",31,0) I BPRTYPE=2 D Q "RTN","BPSRPT8",32,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date "RTN","BPSRPT8",33,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U ;Released On "RTN","BPSRPT8",34,0) . ;RX INFO "RTN","BPSRPT8",35,0) . S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location "RTN","BPSRPT8",36,0) . S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type "RTN","BPSRPT8",37,0) . S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status "RTN","BPSRPT8",38,0) . S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR "RTN","BPSRPT8",39,0) . S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U "RTN","BPSRPT8",40,0) . S BPREC=BPREC_$S($$CLOSED02^BPSSCR03($P(^BPST($P(BPX,U,3),0),U,4))=1:"C",1:"O")_U ;Open/Closed "RTN","BPSRPT8",41,0) . S BPREC=BPREC_$$ELIGCODE^BPSSCR05($P(BPX,U,3))_U ;Eligibility "RTN","BPSRPT8",42,0) ; "RTN","BPSRPT8",43,0) I BPRTYPE=3 D Q "RTN","BPSRPT8",44,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date "RTN","BPSRPT8",45,0) . S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed "RTN","BPSRPT8",46,0) . S BPREC=BPREC_$TR($J(BPINS,10,2)," ")_U ;Insurance Response "RTN","BPSRPT8",47,0) ; "RTN","BPSRPT8",48,0) I BPRTYPE=5 D Q "RTN","BPSRPT8",49,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($P(BPX,U,3),1))_U ;Completed "RTN","BPSRPT8",50,0) . S BPREC=BPREC_$$TTYPE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ)_U ;Trans Type "RTN","BPSRPT8",51,0) . S BPREC=BPREC_$$RESPONSE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ)_U ;Payer Response "RTN","BPSRPT8",52,0) . S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U ;RX COB "RTN","BPSRPT8",53,0) ; "RTN","BPSRPT8",54,0) I BPRTYPE=7 D Q "RTN","BPSRPT8",55,0) . ;RX INFO "RTN","BPSRPT8",56,0) . S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location "RTN","BPSRPT8",57,0) . S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type "RTN","BPSRPT8",58,0) . S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status "RTN","BPSRPT8",59,0) . S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR "RTN","BPSRPT8",60,0) . S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"")_U "RTN","BPSRPT8",61,0) . S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),32)_U ;Drug "RTN","BPSRPT8",62,0) . S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U "RTN","BPSRPT8",63,0) Q "RTN","BPSRPT8",64,0) ; "RTN","BPSRPT8",65,0) ;Print Report Line 2 "RTN","BPSRPT8",66,0) ; "RTN","BPSRPT8",67,0) ; Input Variable -> BPRTYPE,BPX,BPRX,BPREF,BPBIL,BPGRPLAN "RTN","BPSRPT8",68,0) ; "RTN","BPSRPT8",69,0) WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPPSEQ) ; "RTN","BPSRPT8",70,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT8",71,0) . ;Drug, Released On "RTN","BPSRPT8",72,0) . S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),32)_U_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U "RTN","BPSRPT8",73,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U "RTN","BPSRPT8",74,0) . ;RX INFO "RTN","BPSRPT8",75,0) . S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location "RTN","BPSRPT8",76,0) . S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type "RTN","BPSRPT8",77,0) . S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status "RTN","BPSRPT8",78,0) . S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR "RTN","BPSRPT8",79,0) . I BPRTYPE=4 S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U "RTN","BPSRPT8",80,0) . S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"") "RTN","BPSRPT8",81,0) . I BPRTYPE=1 S BPREC=BPREC_U_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U_$$RXCOB($G(BPPSEQ)) ;Bill # and RX COB "RTN","BPSRPT8",82,0) ; "RTN","BPSRPT8",83,0) I BPRTYPE=2 D Q "RTN","BPSRPT8",84,0) . S BPREC=BPREC_$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23)_U ;Cardholder ID "RTN","BPSRPT8",85,0) . S BPREC=BPREC_$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)_U ;Group ID "RTN","BPSRPT8",86,0) . S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed "RTN","BPSRPT8",87,0) . S BPREC=BPREC_$$QTY^BPSRPT6($P(BPX,U,3))_U ;Qty "RTN","BPSRPT8",88,0) . S BPREC=BPREC_$$GETNDC^BPSRPT6(BPRX,BPREF)_U ;NDC# "RTN","BPSRPT8",89,0) . S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),32)_U ;Drug "RTN","BPSRPT8",90,0) ; "RTN","BPSRPT8",91,0) I BPRTYPE=3 D Q "RTN","BPSRPT8",92,0) . S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),32)_U ;Drug "RTN","BPSRPT8",93,0) . S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U "RTN","BPSRPT8",94,0) . ;RX INFO "RTN","BPSRPT8",95,0) . S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location "RTN","BPSRPT8",96,0) . S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type "RTN","BPSRPT8",97,0) . S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status "RTN","BPSRPT8",98,0) . S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR "RTN","BPSRPT8",99,0) . S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U "RTN","BPSRPT8",100,0) . S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"") "RTN","BPSRPT8",101,0) ; "RTN","BPSRPT8",102,0) I BPRTYPE=5 D Q "RTN","BPSRPT8",103,0) . S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),32)_U ;Drug "RTN","BPSRPT8",104,0) . S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U "RTN","BPSRPT8",105,0) . ;RX INFO "RTN","BPSRPT8",106,0) . S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location "RTN","BPSRPT8",107,0) . S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type "RTN","BPSRPT8",108,0) . S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status "RTN","BPSRPT8",109,0) . S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR "RTN","BPSRPT8",110,0) . S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"")_U "RTN","BPSRPT8",111,0) . I $P(BPGRPLAN,U,2)]"" S BPREC=BPREC_$E($P(BPGRPLAN,U,2),1,30) ;Insurance "RTN","BPSRPT8",112,0) . S BPREC=BPREC_U_$$ELAPSE^BPSRPT6($P(BPX,U,3)) ;Elapsed Time "RTN","BPSRPT8",113,0) ; "RTN","BPSRPT8",114,0) I BPRTYPE=7 D Q "RTN","BPSRPT8",115,0) . S BPREC=BPREC_$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23)_U ;Cardholder ID "RTN","BPSRPT8",116,0) . S BPREC=BPREC_$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)_U ;Group ID "RTN","BPSRPT8",117,0) . S BPREC=BPREC_$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$P(BPX,U,3)))_U ;Close Dt/Time "RTN","BPSRPT8",118,0) . S BPREC=BPREC_$E($$CLSBY^BPSRPT6(+$P(BPX,U,3)),1,25)_U ;Close By "RTN","BPSRPT8",119,0) . S BPREC=BPREC_$E($P($$CLRSN^BPSRPT7(+$P(BPX,U,3)),U,2),1,30)_U ;Close Reason "RTN","BPSRPT8",120,0) ; "RTN","BPSRPT8",121,0) I BPRTYPE=8 D Q "RTN","BPSRPT8",122,0) . S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),27)_U ;Drug "RTN","BPSRPT8",123,0) . S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_" " ;Fill Location "RTN","BPSRPT8",124,0) . S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_" " ;Fill Type "RTN","BPSRPT8",125,0) . S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status "RTN","BPSRPT8",126,0) . S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR "RTN","BPSRPT8",127,0) . S BPREC=BPREC_$TR($E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)," ","")_U ;Group ID "RTN","BPSRPT8",128,0) . S BPREC=BPREC_$E(BPGRPLAN,1,30)_U ;Insurance "RTN","BPSRPT8",129,0) . S BPREC=BPREC_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U ;Bill# "RTN","BPSRPT8",130,0) ; "RTN","BPSRPT8",131,0) Q "RTN","BPSRPT8",132,0) ; "RTN","BPSRPT8",133,0) ;Print Report Line 3 "RTN","BPSRPT8",134,0) ; "RTN","BPSRPT8",135,0) ; Input Variable -> BPRTYPE,BPX "RTN","BPSRPT8",136,0) ; "RTN","BPSRPT8",137,0) WRLINE3(BPRTYPE,BPREC,BPX) N BP59,BPSARR,BPRJCNT,BPZZ,BPRICE "RTN","BPSRPT8",138,0) S BP59=+$P(BPX,U,3) "RTN","BPSRPT8",139,0) ; "RTN","BPSRPT8",140,0) I (",2,7,")[BPRTYPE D Q "RTN","BPSRPT8",141,0) .S BPREC=BPREC_$$CLAIMID^BPSRPT2(BP59)_U ;Claim ID "RTN","BPSRPT8",142,0) .S BPRJCNT=$$REJTEXT^BPSRPT2(BP59,.BPSARR) "RTN","BPSRPT8",143,0) .F BPZZ=1:1:BPRJCNT S:BPZZ'=1 BPREC=BPREC_"," S BPREC=BPREC_$P(BPSARR(BPZZ),":") "RTN","BPSRPT8",144,0) .; "RTN","BPSRPT8",145,0) .;Write one record per reject/close code "RTN","BPSRPT8",146,0) .S:+BPRJCNT=0 BPRJCNT=1 "RTN","BPSRPT8",147,0) .F BPZZ=1:1:BPRJCNT W !,$G(BPREC),U,$P($G(BPSARR(BPZZ)),":"),U,$P($G(BPSARR(BPZZ)),":",2) "RTN","BPSRPT8",148,0) ; "RTN","BPSRPT8",149,0) I BPRTYPE=4 D "RTN","BPSRPT8",150,0) . ;Method "RTN","BPSRPT8",151,0) . I $$AUTOREV^BPSRPT1(BP59) S BPREC=BPREC_U_"AUTO"_U "RTN","BPSRPT8",152,0) . E S BPREC=BPREC_U_"REGULAR"_U "RTN","BPSRPT8",153,0) . ;Return Status "RTN","BPSRPT8",154,0) . I $P(BPX,U,15)["ACCEPTED" S BPREC=BPREC_"ACCEPTED"_U "RTN","BPSRPT8",155,0) . E S BPREC=BPREC_"REJECTED"_U "RTN","BPSRPT8",156,0) . ;Reason "RTN","BPSRPT8",157,0) . S BPREC=BPREC_$$RVSRSN^BPSRPT7(+$P(BPX,U,3)) "RTN","BPSRPT8",158,0) ; "RTN","BPSRPT8",159,0) I BPRTYPE=8 D "RTN","BPSRPT8",160,0) . S BPRICE=$$PRICEVAL^BPSRPT5(BP59) "RTN","BPSRPT8",161,0) . S BPREC=BPREC_$P($G(BPRICE),U,3)_U "RTN","BPSRPT8",162,0) . S BPREC=BPREC_$P($G(BPRICE),U,4)_U "RTN","BPSRPT8",163,0) . S BPREC=BPREC_$P($G(BPRICE),U,5)_U "RTN","BPSRPT8",164,0) . S BPREC=BPREC_$P($G(BPRICE),U,6)_U "RTN","BPSRPT8",165,0) . S BPREC=BPREC_$P($G(BPRICE),U,7)_U "RTN","BPSRPT8",166,0) . S BPREC=BPREC_$P($G(BPRICE),U,2)_U "RTN","BPSRPT8",167,0) . S BPREC=BPREC_$P($G(BPRICE),U,1)_U "RTN","BPSRPT8",168,0) ;Write the record "RTN","BPSRPT8",169,0) W !,$G(BPREC) "RTN","BPSRPT8",170,0) Q "RTN","BPSRPT8",171,0) ; "RTN","BPSRPT8",172,0) ;Print Excel Header "RTN","BPSRPT8",173,0) ; "RTN","BPSRPT8",174,0) HDR(BPRTYPE) ; "RTN","BPSRPT8",175,0) ; "RTN","BPSRPT8",176,0) ;Check if header already printed "RTN","BPSRPT8",177,0) I $G(BPSDATA) Q "RTN","BPSRPT8",178,0) S BPSDATA=1 "RTN","BPSRPT8",179,0) ; "RTN","BPSRPT8",180,0) ;Division "RTN","BPSRPT8",181,0) W !,"DIVISION",U "RTN","BPSRPT8",182,0) ; "RTN","BPSRPT8",183,0) I BPRTYPE'=5,BPRTYPE'=6 W "INSURANCE",U "RTN","BPSRPT8",184,0) ; "RTN","BPSRPT8",185,0) I (",1,2,3,4,5,7,8,")[BPRTYPE W "PATIENT NAME",U,"Pt.ID",U,"RX#",U,"REF/ECME#",U "RTN","BPSRPT8",186,0) ; "RTN","BPSRPT8",187,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT8",188,0) . W "DATE",U "RTN","BPSRPT8",189,0) . W "$BILLED",U "RTN","BPSRPT8",190,0) . W "$INS RESPONSE",U "RTN","BPSRPT8",191,0) . W "$COLLECT",U "RTN","BPSRPT8",192,0) . W "DRUG",U "RTN","BPSRPT8",193,0) . W "NDC",U "RTN","BPSRPT8",194,0) . W "RELEASED ON",U "RTN","BPSRPT8",195,0) . W "FILL LOCATION",U "RTN","BPSRPT8",196,0) . W "FILL TYPE",U "RTN","BPSRPT8",197,0) . W "STATUS",U "RTN","BPSRPT8",198,0) . I BPRTYPE=4 W "RX COB",U "RTN","BPSRPT8",199,0) . W "REJECTED" "RTN","BPSRPT8",200,0) . I BPRTYPE=1 W U,"BILL#",U,"RX COB" "RTN","BPSRPT8",201,0) . I BPRTYPE=4 W U,"REVERSAL METHOD",U,"RETURN STATUS",U,"REASON" "RTN","BPSRPT8",202,0) ; "RTN","BPSRPT8",203,0) I BPRTYPE=2 D Q "RTN","BPSRPT8",204,0) . W "DATE",U "RTN","BPSRPT8",205,0) . W "RELEASED ON",U "RTN","BPSRPT8",206,0) . W "FILL LOCATION",U "RTN","BPSRPT8",207,0) . W "FILL TYPE",U "RTN","BPSRPT8",208,0) . W "STATUS",U "RTN","BPSRPT8",209,0) . W "RX COB",U "RTN","BPSRPT8",210,0) . W "OPEN/CLOSED",U "RTN","BPSRPT8",211,0) . W "ELIGIBILITY",U "RTN","BPSRPT8",212,0) . W "CARDHOLD.ID",U "RTN","BPSRPT8",213,0) . W "GROUP ID",U "RTN","BPSRPT8",214,0) . W "$BILLED",U "RTN","BPSRPT8",215,0) . W "QTY",U "RTN","BPSRPT8",216,0) . W "NDC#",U "RTN","BPSRPT8",217,0) . W "DRUG",U "RTN","BPSRPT8",218,0) . W "CLAIM ID",U "RTN","BPSRPT8",219,0) . W "REJECT CODE(S)",U "RTN","BPSRPT8",220,0) . W "REJECT CODE",U "RTN","BPSRPT8",221,0) . W "REJECT EXPLANATION" "RTN","BPSRPT8",222,0) ; "RTN","BPSRPT8",223,0) I BPRTYPE=3 D Q "RTN","BPSRPT8",224,0) . W "DATE",U "RTN","BPSRPT8",225,0) . W "$BILLED",U "RTN","BPSRPT8",226,0) . W "$INS RESPONSE",U "RTN","BPSRPT8",227,0) . W "DRUG",U "RTN","BPSRPT8",228,0) . W "NDC",U "RTN","BPSRPT8",229,0) . W "FILL LOCATION",U "RTN","BPSRPT8",230,0) . W "FILL TYPE",U "RTN","BPSRPT8",231,0) . W "STATUS",U "RTN","BPSRPT8",232,0) . W "RX COB",U "RTN","BPSRPT8",233,0) . W "REJECTED" "RTN","BPSRPT8",234,0) ; "RTN","BPSRPT8",235,0) I BPRTYPE=5 D Q "RTN","BPSRPT8",236,0) . W "COMPLETED",U "RTN","BPSRPT8",237,0) . W "TRANS TYPE",U "RTN","BPSRPT8",238,0) . W "PAYER RESPONSE",U "RTN","BPSRPT8",239,0) . W "RX COB",U "RTN","BPSRPT8",240,0) . W "DRUG",U "RTN","BPSRPT8",241,0) . W "NDC",U "RTN","BPSRPT8",242,0) . W "FILL LOCATION",U "RTN","BPSRPT8",243,0) . W "FILL TYPE",U "RTN","BPSRPT8",244,0) . W "STATUS",U "RTN","BPSRPT8",245,0) . W "REJECTED",U "RTN","BPSRPT8",246,0) . W "INSURANCE",U "RTN","BPSRPT8",247,0) . W "ELAP TIME IN SECONDS" "RTN","BPSRPT8",248,0) ; "RTN","BPSRPT8",249,0) I BPRTYPE=6 D Q "RTN","BPSRPT8",250,0) .W "DATE",U "RTN","BPSRPT8",251,0) .W "#CLAIMS",U "RTN","BPSRPT8",252,0) .W "AMOUNT SUBMITTED",U "RTN","BPSRPT8",253,0) .W "RETURNED REJECTED",U "RTN","BPSRPT8",254,0) .W "RETURNED PAYABLE",U "RTN","BPSRPT8",255,0) .W "AMOUNT TO RECEIVE",U "RTN","BPSRPT8",256,0) .W "DIFFERENCE" "RTN","BPSRPT8",257,0) ; "RTN","BPSRPT8",258,0) I BPRTYPE=7 D Q "RTN","BPSRPT8",259,0) . W "FILL LOCATION",U "RTN","BPSRPT8",260,0) . W "FILL TYPE",U "RTN","BPSRPT8",261,0) . W "STATUS",U "RTN","BPSRPT8",262,0) . W "REJECTED",U "RTN","BPSRPT8",263,0) . W "DRUG",U "RTN","BPSRPT8",264,0) . W "NDC",U "RTN","BPSRPT8",265,0) . W "CARDHOLD.ID",U "RTN","BPSRPT8",266,0) . W "GROUP ID",U "RTN","BPSRPT8",267,0) . W "CLOSE DATE/TIME",U "RTN","BPSRPT8",268,0) . W "CLOSED BY",U "RTN","BPSRPT8",269,0) . W "CLOSE REASON",U "RTN","BPSRPT8",270,0) . W "CLAIM ID",U "RTN","BPSRPT8",271,0) . W "REJECT CODE(S)",U "RTN","BPSRPT8",272,0) . W "REJECT CODE",U "RTN","BPSRPT8",273,0) . W "REJECT EXPLANATION" "RTN","BPSRPT8",274,0) ; "RTN","BPSRPT8",275,0) I BPRTYPE=8 D Q "RTN","BPSRPT8",276,0) . W "DATE",U "RTN","BPSRPT8",277,0) . W "$BILLED",U "RTN","BPSRPT8",278,0) . W "$INS RESPONSE",U "RTN","BPSRPT8",279,0) . W "$COLLECT",U "RTN","BPSRPT8",280,0) . W "DRUG",U "RTN","BPSRPT8",281,0) . W "RX INFO",U "RTN","BPSRPT8",282,0) . W "INS GROUP#",U "RTN","BPSRPT8",283,0) . W "INS GROUP NAME",U "RTN","BPSRPT8",284,0) . W "BILL#",U "RTN","BPSRPT8",285,0) . W "$PROVIDER NETWORK",U "RTN","BPSRPT8",286,0) . W "$BRAND DRUG",U "RTN","BPSRPT8",287,0) . W "$NON-PREF FORM",U "RTN","BPSRPT8",288,0) . W "$BRAND NON-PREF FORM",U "RTN","BPSRPT8",289,0) . W "$COVERAGE GAP",U "RTN","BPSRPT8",290,0) . W "$HEALTH ASST",U "RTN","BPSRPT8",291,0) . W "$SPEND ACCT REMAINING",U "RTN","BPSRPT8",292,0) Q "RTN","BPSRPT8",293,0) ; "RTN","BPSRPT8",294,0) ;Print Report Insurance Subtotals "RTN","BPSRPT8",295,0) ; "RTN","BPSRPT8",296,0) ITOT(BPRTYPE,BPDIV,BPGRPLAN,BPTBIL,BPTINS,BPTCOLL,BPCNT,BPRICE) N BPNP "RTN","BPSRPT8",297,0) I (BPRTYPE=1)!(BPRTYPE=4) D Q "RTN","BPSRPT8",298,0) .W !!,?78,"----------",?100,"----------",?122,"----------" "RTN","BPSRPT8",299,0) .W !,"SUBTOTALS for INS:",$E(BPGRPLAN,1,50),?78,$J(BPTBIL,10,2),?100,$J(BPTINS,10,2),?122,$J(BPTCOLL,10,2) "RTN","BPSRPT8",300,0) .W !,"COUNT",?78,$J(BPCNT,10),?100,$J(BPCNT,10),?122,$J(BPCNT,10) "RTN","BPSRPT8",301,0) .W:BPCNT !,"MEAN",?78,$J(BPTBIL/BPCNT,10,2),?100,$J(BPTINS/BPCNT,10,2),?122,$J(BPTCOLL/BPCNT,10,2) "RTN","BPSRPT8",302,0) I BPRTYPE=3 D Q "RTN","BPSRPT8",303,0) .W !!,?100,"----------",?122,"----------" "RTN","BPSRPT8",304,0) .W !,"SUBTOTALS for INS:",$E(BPGRPLAN,1,50),?100,$J(BPTBIL,10,2),?122,$J(BPTINS,10,2) "RTN","BPSRPT8",305,0) .W !,"COUNT",?100,$J(BPCNT,10),?122,$J(BPCNT,10) "RTN","BPSRPT8",306,0) .W:BPCNT !,"MEAN",?100,$J(BPTBIL/BPCNT,10,2),?122,$J(BPTINS/BPCNT,10,2) "RTN","BPSRPT8",307,0) I BPRTYPE=2 D Q "RTN","BPSRPT8",308,0) .W !!,?41,"----------" "RTN","BPSRPT8",309,0) .W !,"SUBTOTALS for INS:",$E(BPGRPLAN,1,22),?41,$J(BPTBIL,10,2) "RTN","BPSRPT8",310,0) .W !,"COUNT",?41,$J(BPCNT,10) "RTN","BPSRPT8",311,0) .W:BPCNT !,"MEAN",?41,$J(BPTBIL/BPCNT,10,2) "RTN","BPSRPT8",312,0) I (BPRTYPE=7) D Q "RTN","BPSRPT8",313,0) .W !!,"SUBTOTALS for INS:",$E(BPGRPLAN,1,50) "RTN","BPSRPT8",314,0) .N BPBILR "RTN","BPSRPT8",315,0) .S BPBILR="" F S BPBILR=$O(BPCNT(BPBILR)) Q:BPBILR="" D Q:BPQ "RTN","BPSRPT8",316,0) ..S BPNP=$$CHKP^BPSRPT5(1) Q:BPQ "RTN","BPSRPT8",317,0) ..W !,?3,BPBILR,?65,$J($G(BPCNT(BPBILR)),5) "RTN","BPSRPT8",318,0) .Q:$G(BPQ) "RTN","BPSRPT8",319,0) .W !,?65,"-----" "RTN","BPSRPT8",320,0) .W !,"CLOSED CLAIMS SUBTOTAL",?65,$J(BPCNT,5) "RTN","BPSRPT8",321,0) I BPRTYPE=8 D Q "RTN","BPSRPT8",322,0) .W !!,?78,"----------",?100,"----------",?122,"----------" "RTN","BPSRPT8",323,0) .W !,"SUBTOTALS for INS:",$E(BPGRPLAN,1,50),?78,$J(BPTBIL,10,2),?100,$J(BPTINS,10,2),?122,$J(BPTCOLL,10,2) "RTN","BPSRPT8",324,0) .W !,?4,$J($P(BPRICE,U,3),10,2),?23,$J($P(BPRICE,U,4),10,2),?38,$J($P(BPRICE,U,5),10,2),?56,$J($P(BPRICE,U,6),10,2),?81,$J($P(BPRICE,U,7),10,2),?96,$J($P(BPRICE,U,2),10,2),?111,$J($P(BPRICE,U),10,2) "RTN","BPSRPT8",325,0) .W !,"COUNT",?78,$J(BPCNT,10),?100,$J(BPCNT,10),?122,$J(BPCNT,10) "RTN","BPSRPT8",326,0) .W !,?4,$J(BPCNT,10),?23,$J(BPCNT,10),?38,$J(BPCNT,10),?56,$J(BPCNT,10),?81,$J(BPCNT,10),?96,$J(BPCNT,10),?111,$J(BPCNT,10) "RTN","BPSRPT8",327,0) .W:BPCNT !,"MEAN",?78,$J(BPTBIL/BPCNT,10,2),?100,$J(BPTINS/BPCNT,10,2),?122,$J(BPTCOLL/BPCNT,10,2) "RTN","BPSRPT8",328,0) .W !,?4,$J($P(BPRICE,U,3)/BPCNT,10,2),?23,$J($P(BPRICE,U,4)/BPCNT,10,2),?38,$J($P(BPRICE,U,5)/BPCNT,10,2),?56,$J($P(BPRICE,U,6)/BPCNT,10,2),?81,$J($P(BPRICE,U,7)/BPCNT,10,2),?96,$J($P(BPRICE,U,2)/BPCNT,10,2),?111,$J($P(BPRICE,U)/BPCNT,10,2) "RTN","BPSRPT8",329,0) ; "RTN","BPSRPT8",330,0) Q "RTN","BPSRPT8",331,0) ;return RX COB as the 1st letter of the RX COB indicator "RTN","BPSRPT8",332,0) RXCOB(BPPSEQ) ; "RTN","BPSRPT8",333,0) Q $S(BPPSEQ=1:"p",BPPSEQ=2:"s",1:"") "RTN","BPSRPT8",334,0) ;BPSRPT8 "RTN","BPSSCR02") 0^47^B42496170 "RTN","BPSSCR02",1,0) BPSSCR02 ;BHAM ISC/SS - USER SCREEN UTILITIES ;05-APR-05 "RTN","BPSSCR02",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,10**;JUN 2004;Build 27 "RTN","BPSSCR02",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCR02",4,0) ;USER SCREEN "RTN","BPSSCR02",5,0) ; "RTN","BPSSCR02",6,0) REVERSE ; "RTN","BPSSCR02",7,0) N BPSDFN,BPSRX "RTN","BPSSCR02",8,0) D SELECT(.BPSDFN,.BPSRX) "RTN","BPSSCR02",9,0) S VALMBCK="R" "RTN","BPSSCR02",10,0) Q "RTN","BPSSCR02",11,0) ; "RTN","BPSSCR02",12,0) SELECT(BPSDFN1,BPSRX1,BPSRF1,BPS59) ; Select a patient. Returns patient IEN(s) in array "RTN","BPSSCR02",13,0) N BPLN "RTN","BPSSCR02",14,0) S BPLN=$$SELLINE("Select the line(s) with the paid claim(s) you wish to REVERSE","") "RTN","BPSSCR02",15,0) Q "RTN","BPSSCR02",16,0) ; "RTN","BPSSCR02",17,0) SELLINE(BPSPROM,BPSDFVL) ; "RTN","BPSSCR02",18,0) N BPRET,DIR,X,Y,DIRUT "RTN","BPSSCR02",19,0) S BPRET="^" "RTN","BPSSCR02",20,0) W ! S DIR(0)="N^::2",DIR("A")=BPSPROM,DIR("B")=BPSDFVL D ^DIR I $D(DIRUT) Q "^" "RTN","BPSSCR02",21,0) S $P(BPRET,U)=Y "RTN","BPSSCR02",22,0) Q BPRET "RTN","BPSSCR02",23,0) ;/** "RTN","BPSSCR02",24,0) ;make array element "RTN","BPSSCR02",25,0) ;BPLINE - line number in LM ARRAY (by ref) "RTN","BPSSCR02",26,0) ;BPTMP - VALMAR (TMP global for LM) "RTN","BPSSCR02",27,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCR02",28,0) ;BPLMIND - passed by ref - current patient(/insurance) index ( to make 1, 2,etc) "RTN","BPSSCR02",29,0) ;BPDRIND - passed by ref - current claim level index ( to make .1, .2, .10,... .20,... ) "RTN","BPSSCR02",30,0) ;TMP structure gives on the screen: "RTN","BPSSCR02",31,0) ;^TMP("BPSSCR",$J,"VALM","LMIND",1,0,DFN,0,0)= "RTN","BPSSCR02",32,0) ;^TMP("BPSSCR",$J,"VALM",1,0)=1 BUMSTEAD,CHARLE (5444)/100-234-2345 *done* FINISHED "RTN","BPSSCR02",33,0) ;BPLINE = 1 "RTN","BPSSCR02",34,0) ;BPLMIND=1 "RTN","BPSSCR02",35,0) ;on the screen: "RTN","BPSSCR02",36,0) ;1 BUMSTEAD,CHARLE (5444) /100-234-2345 *done* FINISHED "RTN","BPSSCR02",37,0) ; "RTN","BPSSCR02",38,0) ;^TMP(538978189,"BPSSCR","SORT","T",1,401959.00001)= "RTN","BPSSCR02",39,0) ;^TMP("BPSSCR",$J,"VALM","LMIND",1,1,DFN,401959.00001,1)= "RTN","BPSSCR02",40,0) ;^TMP("BPSSCR",$J,"VALM",2,0)= 1.1 LOVASTATIN 20MG TAB "RTN","BPSSCR02",41,0) ;BPLINE = 2 "RTN","BPSSCR02",42,0) ;BP59= 401959.00001 "RTN","BPSSCR02",43,0) ;on the screen: "RTN","BPSSCR02",44,0) ; 1.1 LOVASTATIN 20MG TAB "RTN","BPSSCR02",45,0) ; "RTN","BPSSCR02",46,0) ;^TMP(538978189,"BPSSCR","SORT","T",1,501750.00011)= "RTN","BPSSCR02",47,0) ;^TMP("BPSSCR",$J,"VALM","LMIND",1,2,DFN,501750.00011,2)= "RTN","BPSSCR02",48,0) ;^TMP("BPSSCR",$J,"VALM",3,0)= 1.2 CIMETIDINE 300MG TAB "RTN","BPSSCR02",49,0) ;BPLINE = 3 "RTN","BPSSCR02",50,0) ;BP59= 501750.00011 "RTN","BPSSCR02",51,0) ;on the screen: "RTN","BPSSCR02",52,0) ; 1.2 CIMETIDINE 300MG TAB "RTN","BPSSCR02",53,0) ; "RTN","BPSSCR02",54,0) MKARRELM(BPLINE,BPTMP,BP59,BPLMIND,BPDRIND,BPPREV) ;*/ "RTN","BPSSCR02",55,0) N BPSSTR,BPLNS,BPDFN,BPSTAT,BPSINSUR,BPINSDAT "RTN","BPSSCR02",56,0) S BPDFN=+$P($G(^BPST(BP59,0)),U,6) ;patient's DFN "RTN","BPSSCR02",57,0) S BPINSDAT=$$GETINSUR^BPSSCRU2(BP59) "RTN","BPSSCR02",58,0) S BPSINSUR=+BPINSDAT ;patient's insurance IEN "RTN","BPSSCR02",59,0) ; "RTN","BPSSCR02",60,0) ;PATIENT SUMMARY level "RTN","BPSSCR02",61,0) ; if last one was different DFN/INSURANCE combination then create a new Patient Summary level "RTN","BPSSCR02",62,0) I (+$O(@BPTMP@("LMIND",BPLMIND,0,0))'=BPDFN)!(+$O(@BPTMP@("LMIND",BPLMIND,0,BPDFN,0))'=BPSINSUR) D "RTN","BPSSCR02",63,0) . ;-------- first process previous patient & insurance group "RTN","BPSSCR02",64,0) . ;determine patient summary statuses for the previous "patient" group "RTN","BPSSCR02",65,0) . I BPLMIND>0,+BPPREV=BPLMIND D "RTN","BPSSCR02",66,0) . . ;update the record for previous patient summary after we went thru all his claims "RTN","BPSSCR02",67,0) . . D UPDPREV(BPTMP,BPLMIND,BPPREV) "RTN","BPSSCR02",68,0) . ;process new "patient & insurance" group ------------------ "RTN","BPSSCR02",69,0) . S BPDRIND=0 "RTN","BPSSCR02",70,0) . S BPLMIND=(BPLMIND\1)+1 "RTN","BPSSCR02",71,0) . ;save the all necessary data for the patient & insurance to use as previous for STAT4PAT later on "RTN","BPSSCR02",72,0) . S BPPREV=BPLMIND_U_BPLINE_U_BPDFN_U_$$PATINF(BPDFN,BPINSDAT)_U_BPSINSUR "RTN","BPSSCR02",73,0) . S BPSSTR=$$LJ(BPLMIND,4)_$P(BPPREV,U,4) "RTN","BPSSCR02",74,0) . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,0,BPLINE,BPSSTR,BPSINSUR) "RTN","BPSSCR02",75,0) . S BPLINE=BPLINE+1 "RTN","BPSSCR02",76,0) ; "RTN","BPSSCR02",77,0) ;CLAIMS level "RTN","BPSSCR02",78,0) D "RTN","BPSSCR02",79,0) . I +$O(@BPTMP@("LMIND",BPLMIND,BPDRIND,BPDFN,0))'=BP59 D "RTN","BPSSCR02",80,0) . . S BPDRIND=BPDRIND+1 "RTN","BPSSCR02",81,0) . . S BPSSTR=" "_$$LJ(+$P(BPLMIND,".")_"."_BPDRIND,5)_" "_$$CLAIMINF(BP59) "RTN","BPSSCR02",82,0) . . ;@debug,remove the next line after finish debugging "RTN","BPSSCR02",83,0) . . ;S BPSSTR=BPSSTR_" 59:"_BP59_" DT:"_$$TRANDT^BPSSCRU2(BP59)_" DFN:"_BPDFN_" INS:"_BPSINSUR "RTN","BPSSCR02",84,0) . . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR) "RTN","BPSSCR02",85,0) . . S BPLINE=BPLINE+1 "RTN","BPSSCR02",86,0) . . N BPARR,X "RTN","BPSSCR02",87,0) . . S BPLNS=$$ADDINF^BPSSCR03(BP59,.BPARR,74,"R") "RTN","BPSSCR02",88,0) . . F X=1:1:BPLNS D "RTN","BPSSCR02",89,0) . . . I $G(BPARR(X))="" Q "RTN","BPSSCR02",90,0) . . . D SAVEARR(BPTMP,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE," "_BPARR(X),BPSINSUR) "RTN","BPSSCR02",91,0) . . . S BPLINE=BPLINE+1 "RTN","BPSSCR02",92,0) Q "RTN","BPSSCR02",93,0) ;S BPS=BPX "RTN","BPSSCR02",94,0) ;/** "RTN","BPSSCR02",95,0) ;BP59 "RTN","BPSSCR02",96,0) CLAIMINF(BP59) ;*/ "RTN","BPSSCR02",97,0) N BPX,BPX1 "RTN","BPSSCR02",98,0) S BPX1=$$RXREF^BPSSCRU2(BP59) "RTN","BPSSCR02",99,0) S BPX=$$LJ($$DRGNAME^BPSSCRU2(BP59),17)_" "_$$LJ($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),11)_" " "RTN","BPSSCR02",100,0) S BPX=BPX_$$LJ($$FILLDATE^BPSSCRRS(+BPX1,+$P(BPX1,U,2)),5)_" " "RTN","BPSSCR02",101,0) S BPX=BPX_$$LJ($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/" "RTN","BPSSCR02",102,0) S BPX=BPX_$$LJ($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" " "RTN","BPSSCR02",103,0) S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59) "RTN","BPSSCR02",104,0) Q BPX "RTN","BPSSCR02",105,0) ;/** "RTN","BPSSCR02",106,0) ;determine "done" and "FINISHED" status for patient/insurance group by BPLMIND in TMP global "RTN","BPSSCR02",107,0) STAT4PAT(BPLMIND) ;*/ "RTN","BPSSCR02",108,0) N BPCL,BPDFN,BP59,BPX,BPINS,BPX,BPCNT,BPELI "RTN","BPSSCR02",109,0) N BPPB,BPRJ,BPACRV,BPRJRV,BPSR,BPFIN,BPPRCNTG "RTN","BPSSCR02",110,0) S (BPCL,BPPB,BPRJ,BPACRV,BPSR,BPRJRV)=0 "RTN","BPSSCR02",111,0) S BPFIN=0 ; finished by default "RTN","BPSSCR02",112,0) S BPPRCNTG=0 "RTN","BPSSCR02",113,0) S BPCNT=0 "RTN","BPSSCR02",114,0) F S BPCL=+$O(@BPTMP@("LMIND",BPLMIND,BPCL)) Q:BPCL=0 D "RTN","BPSSCR02",115,0) . S BPDFN=0 "RTN","BPSSCR02",116,0) . F S BPDFN=+$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN)) Q:BPDFN=0 D "RTN","BPSSCR02",117,0) . . S BPINS="" ;can be 0 in the TMP global if insurance plan "RTN","BPSSCR02",118,0) . . ;is corrupted in file ##9002313.59 "RTN","BPSSCR02",119,0) . . F S BPINS=$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS)) Q:BPINS="" D "RTN","BPSSCR02",120,0) . . . S BP59=0,BPINS=+BPINS "RTN","BPSSCR02",121,0) . . . F S BP59=+$O(@BPTMP@("LMIND",BPLMIND,BPCL,BPDFN,BPINS,BP59)) Q:BP59=0 D "RTN","BPSSCR02",122,0) . . . . S BPCNT=BPCNT+1 "RTN","BPSSCR02",123,0) . . . . S BPX=$P($$CLAIMST^BPSSCRU3(BP59),U) "RTN","BPSSCR02",124,0) . . . . I BPX["E PAYABLE" S BPPB=BPPB+1 ;Payable "RTN","BPSSCR02",125,0) . . . . I BPX["E REJECTED" S BPRJ=BPRJ+1 ;Rejected "RTN","BPSSCR02",126,0) . . . . I BPX["E REVERSAL ACCEPTED" S BPACRV=BPACRV+1 ;Accepted Reversal "RTN","BPSSCR02",127,0) . . . . I BPX["E REVERSAL REJECTED" S BPRJRV=BPRJRV+1 ;Rejected Reversal "RTN","BPSSCR02",128,0) . . . . I $D(BP59) S BPELI=$$ELIGCODE^BPSSCR05($G(BP59)) "RTN","BPSSCR02",129,0) S BPX=$S($G(BPELI)="V":"Vet",$G(BPELI)="T":"Tri",$G(BPELI)="C":"Cha",1:"Unk") "RTN","BPSSCR02",130,0) ; "RTN","BPSSCR02",131,0) I BPPB=BPCNT S BPX=BPX_" ALL payable" "RTN","BPSSCR02",132,0) E S BPX=BPX_" Pb:"_BPPB_" Rj:"_BPRJ_" AcRv:"_BPACRV_" RjRv:"_BPRJRV "RTN","BPSSCR02",133,0) Q BPX "RTN","BPSSCR02",134,0) ;/** "RTN","BPSSCR02",135,0) ;gets the patient summary information "RTN","BPSSCR02",136,0) ;input: "RTN","BPSSCR02",137,0) ; BPDFN - ptr to #2 "RTN","BPSSCR02",138,0) ; BPINS - insurance ien^insurance name^phone "RTN","BPSSCR02",139,0) ;output: "RTN","BPSSCR02",140,0) ; patient summary information "RTN","BPSSCR02",141,0) PATINF(BPDFN,BPINS) ;*/ "RTN","BPSSCR02",142,0) N X,BPINSNM "RTN","BPSSCR02",143,0) S BPINSNM=$P(BPINS,U,2) "RTN","BPSSCR02",144,0) S X=$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN),13) ;name "RTN","BPSSCR02",145,0) S X=X_" "_$$LJ($$SSN4^BPSSCRU2(BPDFN),6) ;4digits of SSN "RTN","BPSSCR02",146,0) S X=X_" "_$$LJ($S(BPINSNM="":"????",1:BPINSNM),8) ;insurance "RTN","BPSSCR02",147,0) S X=X_"/"_$$LJ($P(BPINS,U,3),14) ;phone "RTN","BPSSCR02",148,0) Q X "RTN","BPSSCR02",149,0) ; "RTN","BPSSCR02",150,0) ;/** "RTN","BPSSCR02",151,0) ;creates an entry in LM array and builds a non-standard index "RTN","BPSSCR02",152,0) ;BPLMIND - passed by ref - current LM index - patient_AND_insurance level "RTN","BPSSCR02",153,0) ;BPDRIND - passed by ref - current LM index - claim level "RTN","BPSSCR02",154,0) ;BPTMP - VALMAR (TMP global for LM) "RTN","BPSSCR02",155,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCR02",156,0) ;BPLINE - line number in LM ARRAY (by ref) "RTN","BPSSCR02",157,0) ;BPSTR - string to save in ARRAY "RTN","BPSSCR02",158,0) ;BPSINSUR - INSURANCE ien "RTN","BPSSCR02",159,0) SAVEARR(BPTMP1,BPLMIND,BPDRIND,BPDFN,BP59,BPLINE,BPSSTR,BPSINSUR) ; "RTN","BPSSCR02",160,0) S @BPTMP1@("LMIND",BPLMIND,BPDRIND,BPDFN,BPSINSUR,BP59,BPLINE)="" "RTN","BPSSCR02",161,0) D SET^VALM10(BPLINE,BPSSTR,BP59) "RTN","BPSSCR02",162,0) Q "RTN","BPSSCR02",163,0) ;left justified, blank padded "RTN","BPSSCR02",164,0) ;adds spaces on right or truncates to make return string BPLEN characters long "RTN","BPSSCR02",165,0) ;BPST- original string "RTN","BPSSCR02",166,0) ;BPLEN - desired length "RTN","BPSSCR02",167,0) LJ(BPST,BPLEN) ; "RTN","BPSSCR02",168,0) N BPL "RTN","BPSSCR02",169,0) S BPL=BPLEN-$L(BPST) "RTN","BPSSCR02",170,0) Q $E(BPST_$J("",$S(BPL<0:0,1:BPL)),1,BPLEN) "RTN","BPSSCR02",171,0) ; "RTN","BPSSCR02",172,0) ;right justified, blank padded "RTN","BPSSCR02",173,0) ;adds spaces on left or truncates to make return string BPLEN characters long "RTN","BPSSCR02",174,0) ;BPST- original string "RTN","BPSSCR02",175,0) ;BPLEN - desired length "RTN","BPSSCR02",176,0) RJ(BPST,BPLEN) ; "RTN","BPSSCR02",177,0) S BPL=BPLEN-$L(BPST) "RTN","BPSSCR02",178,0) I BPL>0 Q $J("",$S(BPL<0:0,1:BPL))_BPST "RTN","BPSSCR02",179,0) Q $E(BPST,1,BPLEN) "RTN","BPSSCR02",180,0) ; "RTN","BPSSCR02",181,0) ;is the claim payable? "RTN","BPSSCR02",182,0) PAYABLE(BP59) ; "RTN","BPSSCR02",183,0) I $P($$CLAIMST^BPSSCRU3(BP59),U)["E PAYABLE" Q 1 "RTN","BPSSCR02",184,0) Q 0 "RTN","BPSSCR02",185,0) ; "RTN","BPSSCR02",186,0) ;is the claim rejected? "RTN","BPSSCR02",187,0) REJECTED(BP59) ; "RTN","BPSSCR02",188,0) I $P($$CLAIMST^BPSSCRU3(BP59),U)["E REJECTED" Q 1 "RTN","BPSSCR02",189,0) I $P($$CLAIMST^BPSSCRU3(BP59),U)["E REVERSAL REJECTED" Q 1 "RTN","BPSSCR02",190,0) Q 0 "RTN","BPSSCR02",191,0) ;update patient summary information for the previous patient/insurance pair "RTN","BPSSCR02",192,0) UPDPREV(BPTMP,BPLMIND,BPPREV) ; "RTN","BPSSCR02",193,0) N BPSSTR "RTN","BPSSCR02",194,0) ;update the record for previous patient summary after we went thru all his claims "RTN","BPSSCR02",195,0) S BPSSTR=$$LJ^BPSSCR02(BPLMIND,4)_$P(BPPREV,U,4)_" "_$$STAT4PAT^BPSSCR02(BPLMIND) "RTN","BPSSCR02",196,0) D SAVEARR^BPSSCR02(BPTMP,BPLMIND,0,+$P(BPPREV,U,3),0,+$P(BPPREV,U,2),BPSSTR,+$P(BPPREV,U,5)) "RTN","BPSSCR02",197,0) Q "RTN","BPSSCR02",198,0) ; "RTN","BPSSCR03") 0^51^B40126137 "RTN","BPSSCR03",1,0) BPSSCR03 ;BHAM ISC/SS - ECME USR SCREEN UTILITIES ;05-APR-05 "RTN","BPSSCR03",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSSCR03",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCR03",4,0) Q "RTN","BPSSCR03",5,0) ;/** "RTN","BPSSCR03",6,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCR03",7,0) ; BPARR to return formatted info via ref "RTN","BPSSCR03",8,0) ; BPMLEM - max len for each line "RTN","BPSSCR03",9,0) ; BPMODE - mode "RTN","BPSSCR03",10,0) ; R -regular for main screen, will show only latest comment "RTN","BPSSCR03",11,0) ; C - comment mode - show all comments "RTN","BPSSCR03",12,0) ADDINF(BP59,BPARR,BPMLEN,BPMODE) ;to return additional information about the claim*/ "RTN","BPSSCR03",13,0) N BPX,BPN,BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1,BPN2,BPSTATUS,BPSCOBA,BP59X,I "RTN","BPSSCR03",14,0) S BPN=0,(BPTXT1,BPTXT2,BPTXT3,BPTXT4,BPX1)="" "RTN","BPSSCR03",15,0) I BPMODE="R" D "RTN","BPSSCR03",16,0) . S BPX=$$COMMENT^BPSSCRU3(BP59) "RTN","BPSSCR03",17,0) . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=$P(BPX,U) "RTN","BPSSCR03",18,0) . I $P(BPX,U,2)]"" S BPN=BPN+1,BPARR(BPN)="("_$P(BPX,U,2)_")" "RTN","BPSSCR03",19,0) E D "RTN","BPSSCR03",20,0) . N BPCMNT,BPX1 S BPCMNT=99999999 "RTN","BPSSCR03",21,0) . F S BPCMNT=$O(^BPST(BP59,11,BPCMNT),-1) Q:+BPCMNT=0 D "RTN","BPSSCR03",22,0) . . S BPX1=$G(^BPST(BP59,11,BPCMNT,0)) "RTN","BPSSCR03",23,0) . . I BPX1="" Q "RTN","BPSSCR03",24,0) . . S BPX=$$DATTIM^BPSSCRU3($P(BPX1,U,1)\1)_" - "_$P(BPX1,U,3) "RTN","BPSSCR03",25,0) . . I $L(BPX)>0 S BPN=BPN+1,BPARR(BPN)=BPX "RTN","BPSSCR03",26,0) . . I +$P(BPX1,U,2)]"" D "RTN","BPSSCR03",27,0) . . . S BPX=$$USERNAM^BPSCMT01(+$P(BPX1,U,2)) "RTN","BPSSCR03",28,0) . . . I BPX'="" S BPX="("_BPX_")",BPN=BPN+1,BPARR(BPN)=BPX "RTN","BPSSCR03",29,0) S BPX=$$CLAIMST^BPSSCRU3(BP59) "RTN","BPSSCR03",30,0) S BPSTATUS=$P(BPX,U) "RTN","BPSSCR03",31,0) ; Show status for this BPS Transaction "RTN","BPSSCR03",32,0) S BPTXT1=$$COBCLST^BPSSCRU6(BP59) "RTN","BPSSCR03",33,0) ; Append status for associated claim, if one exists "RTN","BPSSCR03",34,0) S BPSCOBA=$$ALLCOB59^BPSUTIL2(BP59) "RTN","BPSSCR03",35,0) F I=1:1 S BP59X=$P(BPSCOBA,U,I) Q:BP59X="" D "RTN","BPSSCR03",36,0) . Q:BP59X=BP59 "RTN","BPSSCR03",37,0) . S BPTXT1=BPTXT1_" ("_$$COBCLST^BPSSCRU6(BP59X)_")" "RTN","BPSSCR03",38,0) ; "RTN","BPSSCR03",39,0) I (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED") D "RTN","BPSSCR03",40,0) . I $L(BPTXT1)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT1 "RTN","BPSSCR03",41,0) . S BPTXT1="" "RTN","BPSSCR03",42,0) . S BPN2=BPN "RTN","BPSSCR03",43,0) . D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"") "RTN","BPSSCR03",44,0) . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0) "RTN","BPSSCR03",45,0) . D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0) "RTN","BPSSCR03",46,0) ; "RTN","BPSSCR03",47,0) I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS")!(BPSTATUS["E UNSTRANDED")!(BPSTATUS["E CAPTURED")!(BPSTATUS["E REVERSAL UNSTRANDED") D "RTN","BPSSCR03",48,0) . I (BPSTATUS["E OTHER")!(BPSTATUS["IN PROGRESS") S BPX1=$P(BPX,U,3) I BPTXT1=BPX1 S BPX1="" "RTN","BPSSCR03",49,0) . S:BPX1="" BPX1=$$GETMESS^BPSSCRU3(504,BP59) "RTN","BPSSCR03",50,0) . I $L(BPX1)>0 S BPTXT1=BPTXT1_"- "_$TR(BPX1,"]","") "RTN","BPSSCR03",51,0) ; "RTN","BPSSCR03",52,0) S BPTXT2=$E(BPTXT1,1,BPMLEN) "RTN","BPSSCR03",53,0) S BPTXT3=$E(BPTXT1,BPMLEN+1,2*BPMLEN) "RTN","BPSSCR03",54,0) S BPTXT4=$E(BPTXT1,(2*BPMLEN)+1,3*BPMLEN) "RTN","BPSSCR03",55,0) I $L(BPTXT2)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT2 "RTN","BPSSCR03",56,0) I $L(BPTXT3)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT3 "RTN","BPSSCR03",57,0) I $L(BPTXT4)>0 S BPN=BPN+1,BPARR(BPN)=BPTXT4 "RTN","BPSSCR03",58,0) Q BPN "RTN","BPSSCR03",59,0) ; "RTN","BPSSCR03",60,0) CLMINF(BP59) ;ptr to #9002313.59 "RTN","BPSSCR03",61,0) W !,"Claim info. Press a key" "RTN","BPSSCR03",62,0) D PAUSE^VALM1 "RTN","BPSSCR03",63,0) Q "RTN","BPSSCR03",64,0) ; "RTN","BPSSCR03",65,0) ; "RTN","BPSSCR03",66,0) COMM(BP59) ;ptr to #9002313.59 "RTN","BPSSCR03",67,0) W !,"the latest comment. Press a key" "RTN","BPSSCR03",68,0) D PAUSE^VALM1 "RTN","BPSSCR03",69,0) Q "RTN","BPSSCR03",70,0) ; "RTN","BPSSCR03",71,0) RESP(BP59) ;Payer Response Information "RTN","BPSSCR03",72,0) W !,"payer Response Information. Press a key" "RTN","BPSSCR03",73,0) D PAUSE^VALM1 "RTN","BPSSCR03",74,0) Q "RTN","BPSSCR03",75,0) ; "RTN","BPSSCR03",76,0) ;/** "RTN","BPSSCR03",77,0) ;Checks if the claim is closed and sets the "/Closed" indicator at the end of the text "RTN","BPSSCR03",78,0) ;BP59 - pointer to file #9002313.59 "RTN","BPSSCR03",79,0) ;BPTXT - Current status text to be displayed "RTN","BPSSCR03",80,0) ;return: "RTN","BPSSCR03",81,0) ;if the claim is not closed, BPTXT is returned. If it is closed BPTXT_"/Closed " is returned "RTN","BPSSCR03",82,0) CLMCLSTX(BP59,BPTXT) ;*/ "RTN","BPSSCR03",83,0) Q $S($$CLOSED02($P($G(^BPST(BP59,0)),U,4)):BPTXT_"/Closed ",1:BPTXT) "RTN","BPSSCR03",84,0) ; "RTN","BPSSCR03",85,0) ;/** "RTN","BPSSCR03",86,0) ;Checks if the CLAIM for specific Transaction is CLOSED? "RTN","BPSSCR03",87,0) ;BPCLAIM - ptr to #9002313.02 "RTN","BPSSCR03",88,0) ;see also CLOSED^BPSSCRU1 "RTN","BPSSCR03",89,0) CLOSED02(BPCLAIM) ;*/ "RTN","BPSSCR03",90,0) I +$G(BPCLAIM)=0 Q 0 "RTN","BPSSCR03",91,0) ; get closed status "RTN","BPSSCR03",92,0) Q +$P($G(^BPSC(BPCLAIM,900)),U)=1 "RTN","BPSSCR03",93,0) ; "RTN","BPSSCR03",94,0) ;return: "RTN","BPSSCR03",95,0) ; 1 - okay. matches criteria "RTN","BPSSCR03",96,0) ; 0- not okay, doesn't match criteria "RTN","BPSSCR03",97,0) FILTER(BP59,BPARR) ; "RTN","BPSSCR03",98,0) N BPST0,BPST1,BPRXREF,BPRX52,BPREFNUM "RTN","BPSSCR03",99,0) N BPRET "RTN","BPSSCR03",100,0) S BPRET=1 ;1 - okay by default "RTN","BPSSCR03",101,0) S BPST0=$G(^BPST(BP59,0)) "RTN","BPSSCR03",102,0) S BPST1=$G(^BPST(BP59,1)) "RTN","BPSSCR03",103,0) ; Do not display eligibility verification requests "RTN","BPSSCR03",104,0) I $P(BPST0,U,15)="E" Q 0 "RTN","BPSSCR03",105,0) S BPRXREF=$$RXREF^BPSSCRU2(BP59) "RTN","BPSSCR03",106,0) S BPRX52=+$P(BPRXREF,U) ;ptr to #52 "RTN","BPSSCR03",107,0) S BPREFNUM=$P(BPRXREF,U,2) ;refill # "RTN","BPSSCR03",108,0) ;Check for Open Claim "RTN","BPSSCR03",109,0) I $G(BPARR(2.02))="O",$$CLOSED02(+$P(BPST0,U,4)) Q 0 "RTN","BPSSCR03",110,0) ;Check for Closed Claim "RTN","BPSSCR03",111,0) I $G(BPARR(2.02))="C",'$$CLOSED02(+$P(BPST0,U,4)) Q 0 "RTN","BPSSCR03",112,0) ;Eligibility Indicator "RTN","BPSSCR03",113,0) I '$$FLTELIG^BPSSCR05(BP59,.BPARR) Q 0 "RTN","BPSSCR03",114,0) ;Submission type "RTN","BPSSCR03",115,0) I '$$FLTSUBTP^BPSSCR05(BP59,.BPARR) Q 0 "RTN","BPSSCR03",116,0) ;user "RTN","BPSSCR03",117,0) I $G(BPARR(1.01))="U",$$FLTUSR(BPST0,.BPARR)=0 Q 0 "RTN","BPSSCR03",118,0) ;patient "RTN","BPSSCR03",119,0) I $G(BPARR(1.02))="P",$$FLTPAT(BPST0,.BPARR)=0 Q 0 "RTN","BPSSCR03",120,0) ;RX "RTN","BPSSCR03",121,0) I $G(BPARR(1.03))="R",$$FLTRX(BPST1,.BPARR)=0 Q 0 "RTN","BPSSCR03",122,0) ;only rejected "RTN","BPSSCR03",123,0) I $G(BPARR(1.06))="R",$$REJECTED^BPSSCR02(BP59)=0 Q 0 "RTN","BPSSCR03",124,0) ;only payable "RTN","BPSSCR03",125,0) I $G(BPARR(1.06))="P",$$PAYABLE^BPSSCR02(BP59)=0 Q 0 "RTN","BPSSCR03",126,0) ;released "RTN","BPSSCR03",127,0) I $G(BPARR(1.07))="R",$$RL^BPSSCRU2(BP59)'="R" Q 0 "RTN","BPSSCR03",128,0) ;non released "RTN","BPSSCR03",129,0) I $G(BPARR(1.07))="N",$$RL^BPSSCRU2(BP59)="R" Q 0 "RTN","BPSSCR03",130,0) ;window/cmop/mail "RTN","BPSSCR03",131,0) I $G(BPARR(1.08))'="A",$$ISMWC(BPRX52,BPREFNUM,$G(BPARR(1.08)))=0 Q 0 "RTN","BPSSCR03",132,0) ;Back billing "RTN","BPSSCR03",133,0) I $G(BPARR(1.09))="B",$$RTBB^BPSSCRU2(BP59)'="BB" Q 0 "RTN","BPSSCR03",134,0) ;real time "RTN","BPSSCR03",135,0) I $G(BPARR(1.09))="R",$$RTBB^BPSSCRU2(BP59)="BB" Q 0 "RTN","BPSSCR03",136,0) ;if only rejected and only specific rejected codes should be displayed "RTN","BPSSCR03",137,0) I $G(BPARR(1.06))="R",$G(BPARR(1.1))="R",$$FLTREJ(BP59,.BPARR)=0 Q 0 "RTN","BPSSCR03",138,0) ;insurance "RTN","BPSSCR03",139,0) I '$$FLTINS^BPSSCR05(BP59,.BPARR) Q 0 "RTN","BPSSCR03",140,0) ;divisions - ECME pharmacies "RTN","BPSSCR03",141,0) I $G(BPARR(1.13))="D",BPARR("DIVS")'[(";"_$P(BPST1,U,7)_";") Q 0 "RTN","BPSSCR03",142,0) Q 1 "RTN","BPSSCR03",143,0) ; "RTN","BPSSCR03",144,0) ;check user filter "RTN","BPSSCR03",145,0) ;input: "RTN","BPSSCR03",146,0) ;BPST0 - zero node of #9002313.59 "RTN","BPSSCR03",147,0) ;BPARR array with user's preferences "RTN","BPSSCR03",148,0) ;returns : "RTN","BPSSCR03",149,0) ;1 -okay, leave in the list "RTN","BPSSCR03",150,0) ;0 -not okay, exclude from the list "RTN","BPSSCR03",151,0) FLTUSR(BPST0,BPARR) ; "RTN","BPSSCR03",152,0) I $L($G(BPARR(1.16)))=0 Q 0 "RTN","BPSSCR03",153,0) I $P(BPST0,U,10)'=$G(BPARR(1.16)) Q 0 "RTN","BPSSCR03",154,0) Q 1 "RTN","BPSSCR03",155,0) ;check patient filter "RTN","BPSSCR03",156,0) ;input: "RTN","BPSSCR03",157,0) ;BPST0 - zero node of #9002313.59 "RTN","BPSSCR03",158,0) ;BPARR array with user's preferences "RTN","BPSSCR03",159,0) ;returns : "RTN","BPSSCR03",160,0) ;1 -okay, leave in the list "RTN","BPSSCR03",161,0) ;0 -not okay, exclude from the list "RTN","BPSSCR03",162,0) FLTPAT(BPST0,BPARR) ; "RTN","BPSSCR03",163,0) I $L($G(BPARR(1.17)))=0 Q 0 "RTN","BPSSCR03",164,0) I $P(BPST0,U,6)'=$G(BPARR(1.17)) Q 0 "RTN","BPSSCR03",165,0) Q 1 "RTN","BPSSCR03",166,0) ;check RX filter "RTN","BPSSCR03",167,0) ;input: "RTN","BPSSCR03",168,0) ;BPST1 - 1st node of #9002313.59 "RTN","BPSSCR03",169,0) ;BPARR array with user's preferences "RTN","BPSSCR03",170,0) ;returns : "RTN","BPSSCR03",171,0) ;1 -okay, leave in the list "RTN","BPSSCR03",172,0) ;0 -not okay, exclude from the list "RTN","BPSSCR03",173,0) FLTRX(BPST1,BPARR) ; "RTN","BPSSCR03",174,0) I $L($G(BPARR(1.18)))=0 Q 0 "RTN","BPSSCR03",175,0) I $P(BPST1,U,11)'=$G(BPARR(1.18)) Q 0 "RTN","BPSSCR03",176,0) Q 1 "RTN","BPSSCR03",177,0) ;input: "RTN","BPSSCR03",178,0) ;BP59 - zero node of #9002313.59 "RTN","BPSSCR03",179,0) ;BPARR array with user's preferences "RTN","BPSSCR03",180,0) ;returns : "RTN","BPSSCR03",181,0) ;1 -okay, leave in the list "RTN","BPSSCR03",182,0) ;0 -not okay, exclude from the list "RTN","BPSSCR03",183,0) FLTREJ(BP59,BPARR) ; "RTN","BPSSCR03",184,0) N BPRCODES "RTN","BPSSCR03",185,0) N BPRJCD "RTN","BPSSCR03",186,0) S BPRJCD=$P($G(^BPSF(9002313.93,+$G(BPARR(1.15)),0)),U) "RTN","BPSSCR03",187,0) I $L(BPRJCD)=0 Q 0 "RTN","BPSSCR03",188,0) D REJCODES^BPSSCRU3(BP59,.BPRCODES) "RTN","BPSSCR03",189,0) I $D(BPRCODES(BPRJCD)) Q 1 "RTN","BPSSCR03",190,0) Q 0 "RTN","BPSSCR03",191,0) ; "RTN","BPSSCR03",192,0) ;check W(indow)/C(mop)/M(ail) "RTN","BPSSCR03",193,0) ;input: "RTN","BPSSCR03",194,0) ;BPRX52 - ptr to #52 "RTN","BPSSCR03",195,0) ;BPREFNUM - refill # "RTN","BPSSCR03",196,0) ;BPMWC - given value from CMOP/MAIL/WINDOW instance 1.08 of BPS USRSCR parameters "RTN","BPSSCR03",197,0) ;returns : "RTN","BPSSCR03",198,0) ;1 -okay, leave in the list "RTN","BPSSCR03",199,0) ;0 -not okay, exclude from the list "RTN","BPSSCR03",200,0) ISMWC(BPRX52,BPREFNUM,BPMWC) ; "RTN","BPSSCR03",201,0) I $$MWCNAME^BPSSCRU2($$MWC^BPSSCRU2(BPRX52,BPREFNUM))=BPMWC Q 1 "RTN","BPSSCR03",202,0) Q 0 "RTN","BPSSCR03",203,0) ; "RTN","BPSSCR03",204,0) FILTRALL(BPTMP1,BPTMP2,BPARR) ; "RTN","BPSSCR03",205,0) N BP59 "RTN","BPSSCR03",206,0) S BP59=0 "RTN","BPSSCR03",207,0) F S BP59=+$O(@BPTMP1@(BP59)) Q:+BP59=0 D "RTN","BPSSCR03",208,0) . I $$FILTER(BP59,.BPARR) S @BPTMP2@(BP59)="" "RTN","BPSSCR03",209,0) Q "RTN","BPSSCR03",210,0) ; "RTN","BPSSCR03",211,0) ;go thru all FILE59 entries and run SETTRDFN for each of them "RTN","BPSSCR03",212,0) ; "RTN","BPSSCR03",213,0) TRDFNALL(BPTMP) ; "RTN","BPSSCR03",214,0) N BP59 "RTN","BPSSCR03",215,0) S BP59=0 "RTN","BPSSCR03",216,0) F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D "RTN","BPSSCR03",217,0) . D SETTRDFN(BPTMP,BP59) "RTN","BPSSCR03",218,0) Q "RTN","BPSSCR03",219,0) ; "RTN","BPSSCR03",220,0) ;sorting for "TRANSACTION DATE" type is "RTN","BPSSCR03",221,0) ;actually sorting by patients , but patient should be sorted not in alphabetical order: "RTN","BPSSCR03",222,0) ;the first patient is the one which has the most recent transaction and so on "RTN","BPSSCR03",223,0) ;BPTMP - TMP global "RTN","BPSSCR03",224,0) ;BP59 - ptr to #9002313.59 "RTN","BPSSCR03",225,0) SETTRDFN(BPTMP,BP59) ; "RTN","BPSSCR03",226,0) ;the following stores the latest transaction date of the claims, which "RTN","BPSSCR03",227,0) ;was found for this particular combination of patient and insurance "RTN","BPSSCR03",228,0) ;@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT "RTN","BPSSCR03",229,0) ;the following stores the latest transaction date BPTRDT,patient BPDFN and "RTN","BPSSCR03",230,0) ;insurance BPINSUR to provide a proper order "RTN","BPSSCR03",231,0) ;@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)="" "RTN","BPSSCR03",232,0) N BPZERO,BPTRDT,BPDFN,BPPREV,BPINSUR "RTN","BPSSCR03",233,0) S BPZERO=$G(^BPST(BP59,0)) ; "RTN","BPSSCR03",234,0) S BPTRDT=-$P(BPZERO,U,8) ;"transaction" date "RTN","BPSSCR03",235,0) S BPDFN=+$P(BPZERO,U,6) ;patient ptr to #2 "RTN","BPSSCR03",236,0) S BPINSUR=+$$GETINSUR^BPSSCRU2(BP59) ;insurance ien "RTN","BPSSCR03",237,0) ;in the beginning we don't have any "DFN-TRDT" and "TRDTDFN" "RTN","BPSSCR03",238,0) ;so create them and quit "RTN","BPSSCR03",239,0) I '$D(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)) D Q "RTN","BPSSCR03",240,0) . S @BPTMP@("DFN-TRDT",BPDFN,BPINSUR)=BPTRDT "RTN","BPSSCR03",241,0) . S @BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINSUR)="" "RTN","BPSSCR03",242,0) ;if we already have them then get the latest into BPPREV "RTN","BPSSCR03",243,0) S BPPREV=+$G(@BPTMP@("DFN-TRDT",BPDFN,BPINSUR)) "RTN","BPSSCR03",244,0) ;and compare it against the BPTRDT for this BP59 "RTN","BPSSCR03",245,0) ;if the BPTRDT is greater then replace the values in "DFN-TRDT" "RTN","BPSSCR03",246,0) ;and "TRDTDFN" "RTN","BPSSCR03",247,0) I BPTRDT1 VALMCNT=VALMCNT-1 "RTN","BPSSCRLG",25,0) Q "RTN","BPSSCRLG",26,0) ; "RTN","BPSSCRLG",27,0) HELP ; -- help code "RTN","BPSSCRLG",28,0) S X="?" D DISP^XQORM1 W !! "RTN","BPSSCRLG",29,0) K X "RTN","BPSSCRLG",30,0) Q "RTN","BPSSCRLG",31,0) ; "RTN","BPSSCRLG",32,0) EXIT ; -- exit code "RTN","BPSSCRLG",33,0) Q "RTN","BPSSCRLG",34,0) ; "RTN","BPSSCRLG",35,0) EXPND ; -- expand code "RTN","BPSSCRLG",36,0) Q "RTN","BPSSCRLG",37,0) ; "RTN","BPSSCRLG",38,0) ; "RTN","BPSSCRLG",39,0) LOG ;entry point for LOG menu option "RTN","BPSSCRLG",40,0) N BPRET,BPSEL "RTN","BPSSCRLG",41,0) I '$D(@(VALMAR)) Q "RTN","BPSSCRLG",42,0) D FULL^VALM1 "RTN","BPSSCRLG",43,0) W !,"Enter the line number for which you wish to print claim logs." "RTN","BPSSCRLG",44,0) S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE Rx Line.") "RTN","BPSSCRLG",45,0) I BPSEL<1 S VALMBCK="R" Q "RTN","BPSSCRLG",46,0) D SAVESEL(BPSEL,VALMAR) "RTN","BPSSCRLG",47,0) D EN "RTN","BPSSCRLG",48,0) S VALMBCK="R" "RTN","BPSSCRLG",49,0) Q "RTN","BPSSCRLG",50,0) ; "RTN","BPSSCRLG",51,0) ;save for ListManager "RTN","BPSSCRLG",52,0) ;BPSEL - selected line "RTN","BPSSCRLG",53,0) ;BPVALMR - parent VALMAR "RTN","BPSSCRLG",54,0) SAVESEL(BPSEL,BPVALMR) ; "RTN","BPSSCRLG",55,0) D CLEANIT "RTN","BPSSCRLG",56,0) S ^TMP("BPSLOG",$J,"VALM","SELLN")=BPSEL "RTN","BPSSCRLG",57,0) S ^TMP("BPSLOG",$J,"VALM","PARENT")=BPVALMR "RTN","BPSSCRLG",58,0) M ^TMP("BPSLOG",$J,"VALM","VIEWPARAMS")=@BPVALMR@("VIEWPARAMS") "RTN","BPSSCRLG",59,0) Q "RTN","BPSSCRLG",60,0) ; "RTN","BPSSCRLG",61,0) CLEANIT ; "RTN","BPSSCRLG",62,0) K ^TMP("BPSLOG",$J,"VALM") "RTN","BPSSCRLG",63,0) Q "RTN","BPSSCRLG",64,0) ;input: "RTN","BPSSCRLG",65,0) ; BPDFN: patient ien #2 "RTN","BPSSCRLG",66,0) ; BP36: insurance ien #36 "RTN","BPSSCRLG",67,0) ; BP59: ptr to #9002313.59 "RTN","BPSSCRLG",68,0) ; returns # of lines "RTN","BPSSCRLG",69,0) PREPINFO(BPLN,BPDFN,BP36,BP59) ; "RTN","BPSSCRLG",70,0) N BPSECME "RTN","BPSSCRLG",71,0) I '$G(BP59) Q 0 "RTN","BPSSCRLG",72,0) I '$G(BP36) Q 0 "RTN","BPSSCRLG",73,0) I '$G(BPDFN) Q 0 "RTN","BPSSCRLG",74,0) N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17) "RTN","BPSSCRLG",75,0) N BPX,BPRXIEN,BPRXN,BPREF,BP1,BPLSTCLM,BPLSTRSP,BPDAT59,BPUSR,BPSTRT,BPHIST,BPQ "RTN","BPSSCRLG",76,0) N BPDT,BPLN0,BPCNT,DFN,VADM "RTN","BPSSCRLG",77,0) S DFN=BPDFN D DEM^VADPT "RTN","BPSSCRLG",78,0) S BP1=$$RXREF^BPSSCRU2(BP59) "RTN","BPSSCRLG",79,0) S BPRXIEN=$P(BP1,U,1) "RTN","BPSSCRLG",80,0) S BPRXN=$$RXNUM^BPSSCRU2(+BPRXIEN) "RTN","BPSSCRLG",81,0) S BPREF=$P(BP1,U,2) "RTN","BPSSCRLG",82,0) S BPDAT59(0)=$G(^BPST(BP59,0)) "RTN","BPSSCRLG",83,0) ;create history "RTN","BPSSCRLG",84,0) D MKHIST^BPSSCRU5(BP59,.BPHIST) "RTN","BPSSCRLG",85,0) ; "RTN","BPSSCRLG",86,0) S BPLN0=BPLN "RTN","BPSSCRLG",87,0) D SETLINE(.BPLN,"Pharmacy ECME Log") "RTN","BPSSCRLG",88,0) D SETLINE(.BPLN,"") "RTN","BPSSCRLG",89,0) S BPX=$$RJ^BPSSCR02("Rx #: ",20)_BPRXN_"/"_BPREF "RTN","BPSSCRLG",90,0) S BPSECME=$$ECMENUM^BPSSCRU2(BP59) "RTN","BPSSCRLG",91,0) S BPX=BPX_$$RJ^BPSSCR02("ECME #: ",20)_BPSECME "RTN","BPSSCRLG",92,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",93,0) S BPX=$$RJ^BPSSCR02("Drug: ",20)_$$DRGNAM^BPSSCRU2($$GETDRG59^BPSSCRU2(BP59)) "RTN","BPSSCRLG",94,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",95,0) S BPX=$$RJ^BPSSCR02("Patient: ",20) "RTN","BPSSCRLG",96,0) S BPX=BPX_$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN)_" "_$$SSN4^BPSSCRU2(BPDFN),25) "RTN","BPSSCRLG",97,0) S BPX=BPX_$$LJ^BPSSCR02("Sex: "_$P($G(VADM(5)),"^",1),10) "RTN","BPSSCRLG",98,0) S BPX=BPX_$$LJ^BPSSCR02("DOB: "_$P($G(VADM(3)),"^",2)_"("_$G(VADM(4))_")",20) "RTN","BPSSCRLG",99,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",100,0) S BPX=$$RJ^BPSSCR02("Transaction Number: ",20) "RTN","BPSSCRLG",101,0) S BPX=BPX_$P($G(^BPST(BP59,0)),U,1) "RTN","BPSSCRLG",102,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",103,0) S BPX=$$RJ^BPSSCR02("Last Submitted: ",20) "RTN","BPSSCRLG",104,0) S BPSTRT=$P(BPDAT59(0),U,11) ;@# need to check with analyst if this is a START DATE "RTN","BPSSCRLG",105,0) I BPSTRT]"" S BPX=BPX_$$DATETIME^BPSSCRU5(BPSTRT) "RTN","BPSSCRLG",106,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",107,0) S BPX=$$RJ^BPSSCR02("Last Submitted By: ",20) "RTN","BPSSCRLG",108,0) S BPUSR=$P(BPDAT59(0),U,10) "RTN","BPSSCRLG",109,0) I BPUSR]"" S BPX=BPX_$$GETUSRNM^BPSSCRU1(BPUSR) "RTN","BPSSCRLG",110,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",111,0) ; "RTN","BPSSCRLG",112,0) ;latest claim "RTN","BPSSCRLG",113,0) S BP1=+$O(BPHIST("C",99999999),-1) "RTN","BPSSCRLG",114,0) I BP1=0 D SETLINE(.BPLN,""),SETLINE(.BPLN,"------ No electronic claims ------") Q BPLN "RTN","BPSSCRLG",115,0) S BP1=+$O(BPHIST("C",BP1,0)) "RTN","BPSSCRLG",116,0) S BPX=$$RJ^BPSSCR02("Last VA Claim #: ",20)_$P($G(^BPSC(+BP1,0)),U,1) "RTN","BPSSCRLG",117,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",118,0) F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"") "RTN","BPSSCRLG",119,0) ;process history "RTN","BPSSCRLG",120,0) N BPTYPE,BPIEN,BPIENRS "RTN","BPSSCRLG",121,0) S BPDT=99999999 "RTN","BPSSCRLG",122,0) F S BPDT=$O(BPHIST("C",BPDT),-1) Q:+BPDT=0 D "RTN","BPSSCRLG",123,0) . S BPIEN=+$O(BPHIST("C",BPDT,0)) Q:BPIEN="" "RTN","BPSSCRLG",124,0) . D DISPCLM(.BPLN,BP59,BPIEN,+BPHIST("C",BPDT,BPIEN),$P(BPHIST("C",BPDT,BPIEN),U,2),BPDT) "RTN","BPSSCRLG",125,0) . S BPIENRS=0 "RTN","BPSSCRLG",126,0) . F S BPIENRS=$O(BPHIST("C",BPDT,BPIEN,"R",BPIENRS)) Q:+BPIENRS=0 D "RTN","BPSSCRLG",127,0) . . D DISPRSP(.BPLN,BP59,BPIENRS,+BPHIST("C",BPDT,BPIEN,"R",BPIENRS),$P(BPHIST("C",BPDT,BPIEN,"R",BPIENRS),U,2),BPDT) "RTN","BPSSCRLG",128,0) . . D DISPPYR(.BPLN,BPIENRS) "RTN","BPSSCRLG",129,0) Q BPLN "RTN","BPSSCRLG",130,0) ; "RTN","BPSSCRLG",131,0) ;increments BPLINE "RTN","BPSSCRLG",132,0) SETLINE(BPLINE,BPSTR) ; "RTN","BPSSCRLG",133,0) D SET^VALM10(BPLINE,BPSTR) "RTN","BPSSCRLG",134,0) S BPLINE=BPLINE+1 "RTN","BPSSCRLG",135,0) Q "RTN","BPSSCRLG",136,0) ;display claim record "RTN","BPSSCRLG",137,0) DISPCLM(BPLN,BP59,BPIEN02,BP57,BPSTYPE,BPSDTALT) ; "RTN","BPSSCRLG",138,0) N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17) "RTN","BPSSCRLG",139,0) N BPX,BPLN0,BPCNT,BPSTR1,BPSTYP2 "RTN","BPSSCRLG",140,0) S BPLN0=BPLN "RTN","BPSSCRLG",141,0) S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"") "RTN","BPSSCRLG",142,0) S BPSTR1="Transmission Information ("_BPSTYP2_")(#"_BPIEN02_")" "RTN","BPSSCRLG",143,0) D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-")) "RTN","BPSSCRLG",144,0) D SETLINE(.BPLN,"") "RTN","BPSSCRLG",145,0) D SETLINE(.BPLN,"Created on: "_$$CREATEDT(BPIEN02,BPSDTALT)) "RTN","BPSSCRLG",146,0) D SETLINE(.BPLN,"VA Claim ID: "_$P($G(^BPSC(+BPIEN02,0)),U,1)) "RTN","BPSSCRLG",147,0) D SETLINE(.BPLN,"Submitted By: "_$$SUBMTBY(BP57)) "RTN","BPSSCRLG",148,0) D SETLINE(.BPLN,"Transaction Type: "_$$TRTYPE^BPSSCRU5($$TRCODE(BPIEN02))) "RTN","BPSSCRLG",149,0) D SETLINE(.BPLN,"Date of Service: "_$$DOSCLM(BPIEN02)) "RTN","BPSSCRLG",150,0) D SETLINE(.BPLN,"NDC Code: "_$$LNDC^BPSSCRU5(BPIEN02)) "RTN","BPSSCRLG",151,0) D SETLINE(.BPLN,"Division: "_$$DIV(BP57)) "RTN","BPSSCRLG",152,0) D SETLINE(.BPLN,"NPI#: "_$$NPI(BP57)) "RTN","BPSSCRLG",153,0) D SETLINE(.BPLN,"ECME Pharmacy: "_$$DIVNAME^BPSSCRDS($$LDIV(BP57))) "RTN","BPSSCRLG",154,0) D SETLINE(.BPLN,"Days Supply: "_$$DAYSSUPL(BPIEN02)) "RTN","BPSSCRLG",155,0) S BPX="Qty: "_$$QTY(BP57) "RTN","BPSSCRLG",156,0) S BPX=BPX_" Unit Price: "_$$UNTPRICE(BP57) "RTN","BPSSCRLG",157,0) S BPX=BPX_" Total Price: "_$$TOTPRICE(BP57) "RTN","BPSSCRLG",158,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",159,0) D SETLINE(.BPLN,"") "RTN","BPSSCRLG",160,0) D SETLINE(.BPLN,"Insurance Name: "_$$INSUR57(BP57)) "RTN","BPSSCRLG",161,0) D SETLINE(.BPLN,"Group Name: "_$$GRPNM(BPIEN02)) "RTN","BPSSCRLG",162,0) D SETLINE(.BPLN,"Rx Coordination of Benefits: "_$$RXCOB57(BP57)) "RTN","BPSSCRLG",163,0) D SETLINE(.BPLN,"BIN: "_$$BIN(BPIEN02)) "RTN","BPSSCRLG",164,0) D SETLINE(.BPLN,"PCN: "_$$PCN(BPIEN02)) "RTN","BPSSCRLG",165,0) D SETLINE(.BPLN,"NCPDP Version: "_$$GETVER(BPIEN02)) "RTN","BPSSCRLG",166,0) D SETLINE(.BPLN,"Group ID: "_$$GRPID(BPIEN02)) "RTN","BPSSCRLG",167,0) D SETLINE(.BPLN,"Cardholder ID: "_$$CRDHLDID(BPIEN02)) "RTN","BPSSCRLG",168,0) D SETLINE(.BPLN,"Patient Relationship Code: "_$$PATRELSH(BPIEN02)) "RTN","BPSSCRLG",169,0) D SETLINE(.BPLN,"Cardholder First Name: "_$$CRDHLDFN(BPIEN02,BP57)) "RTN","BPSSCRLG",170,0) D SETLINE(.BPLN,"Cardholder Last Name: "_$$CRDHLDLN(BPIEN02,BP57)) "RTN","BPSSCRLG",171,0) F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"") "RTN","BPSSCRLG",172,0) S BPLN0=BPLN "RTN","BPSSCRLG",173,0) D SETLINE(.BPLN,"Billing Request Payer Sheet: "_$$B1PYRIEN^BPSSCRU5(BP57)) "RTN","BPSSCRLG",174,0) D SETLINE(.BPLN,"Reversal Payer Sheet: "_$$B2PYRIEN^BPSSCRU5(BP57)) "RTN","BPSSCRLG",175,0) F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"") "RTN","BPSSCRLG",176,0) Q "RTN","BPSSCRLG",177,0) ;Submitted By User "RTN","BPSSCRLG",178,0) SUBMTBY(BP57) ; "RTN","BPSSCRLG",179,0) N BPIEN,BPUSR "RTN","BPSSCRLG",180,0) S BPIEN=$P($G(^BPSTL(BP57,0)),U,10) "RTN","BPSSCRLG",181,0) S BPUSR=$$GETUSRNM^BPSSCRU1(BPIEN) "RTN","BPSSCRLG",182,0) Q $S(BPUSR']"":"UNKNOWN",1:BPUSR) "RTN","BPSSCRLG",183,0) ;Date of service "RTN","BPSSCRLG",184,0) DOSCLM(BPIEN02) ; "RTN","BPSSCRLG",185,0) N BPDT "RTN","BPSSCRLG",186,0) S BPDT=$P($G(^BPSC(BPIEN02,400,1,400)),U,1)\1 "RTN","BPSSCRLG",187,0) Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4) "RTN","BPSSCRLG",188,0) ;Create date "RTN","BPSSCRLG",189,0) CREATEDT(BPIEN02,BPSDTALT) ; "RTN","BPSSCRLG",190,0) N BPSDT "RTN","BPSSCRLG",191,0) S BPSDT=+$P($G(^BPSC(BPIEN02,0)),U,6) "RTN","BPSSCRLG",192,0) Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT)) "RTN","BPSSCRLG",193,0) ;Plan ID "RTN","BPSSCRLG",194,0) PLANID(BP57) ; "RTN","BPSSCRLG",195,0) Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,1) "RTN","BPSSCRLG",196,0) CERTMOD(BP57) ; "RTN","BPSSCRLG",197,0) Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,5) "RTN","BPSSCRLG",198,0) ;Software Vendor/Cert ID "RTN","BPSSCRLG",199,0) CERTIEN(BP57) ; "RTN","BPSSCRLG",200,0) Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,6) "RTN","BPSSCRLG",201,0) ;Division "RTN","BPSSCRLG",202,0) DIV(BP57) ; "RTN","BPSSCRLG",203,0) Q $$GET1^DIQ(9002313.57,BP57_",",11) "RTN","BPSSCRLG",204,0) ;NPI "RTN","BPSSCRLG",205,0) NPI(BPIEN02) ; "RTN","BPSSCRLG",206,0) Q $$GET1^DIQ(9002313.02,BPIEN02_",",201) "RTN","BPSSCRLG",207,0) ;group ID "RTN","BPSSCRLG",208,0) GRPID(BPIEN02) ; "RTN","BPSSCRLG",209,0) Q $E($P($G(^BPSC(BPIEN02,300)),U,1),3,99) "RTN","BPSSCRLG",210,0) ;Group Name "RTN","BPSSCRLG",211,0) GRPNM(BPSIEN02) ; "RTN","BPSSCRLG",212,0) N BPSGPN "RTN","BPSSCRLG",213,0) S BPSGPN=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),3)),U,1) "RTN","BPSSCRLG",214,0) Q BPSGPN "RTN","BPSSCRLG",215,0) ;Cardholder ID "RTN","BPSSCRLG",216,0) CRDHLDID(BPIEN02) ; "RTN","BPSSCRLG",217,0) Q $E($P($G(^BPSC(BPIEN02,300)),U,2),3,99) "RTN","BPSSCRLG",218,0) ;Cardholder First name "RTN","BPSSCRLG",219,0) CRDHLDFN(BPIEN02,BP57) ; "RTN","BPSSCRLG",220,0) N Y "RTN","BPSSCRLG",221,0) S Y=$E($P($G(^BPSC(BPIEN02,300)),U,12),3,99) "RTN","BPSSCRLG",222,0) I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,6) "RTN","BPSSCRLG",223,0) Q Y "RTN","BPSSCRLG",224,0) ;Cardholder Last Name "RTN","BPSSCRLG",225,0) CRDHLDLN(BPIEN02,BP57) ; "RTN","BPSSCRLG",226,0) N Y "RTN","BPSSCRLG",227,0) S Y=$E($P($G(^BPSC(BPIEN02,300)),U,13),3,99) "RTN","BPSSCRLG",228,0) I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,7) "RTN","BPSSCRLG",229,0) Q Y "RTN","BPSSCRLG",230,0) ;Patient Relationship Code "RTN","BPSSCRLG",231,0) PATRELSH(BPIEN02) ; "RTN","BPSSCRLG",232,0) N Y "RTN","BPSSCRLG",233,0) S Y=$E($P($G(^BPSC(BPIEN02,300)),U,6),3,99) "RTN","BPSSCRLG",234,0) Q $S(Y=0:"NOT SPECIFIED",Y=1:"CARDHOLDER",Y=2:"SPOUSE",Y=3:"CHILD",Y=4:"OTHER",1:Y) "RTN","BPSSCRLG",235,0) PCN(BPIEN02) ; "RTN","BPSSCRLG",236,0) Q $P($G(^BPSC(BPIEN02,100)),U,4) "RTN","BPSSCRLG",237,0) ; Get the Payer Sheet Version Number. "RTN","BPSSCRLG",238,0) GETVER(BPIEN02) ; "RTN","BPSSCRLG",239,0) N BPSVER "RTN","BPSSCRLG",240,0) S BPSVER=$P($G(^BPSC(BPIEN02,100)),U,2) "RTN","BPSSCRLG",241,0) I $G(BPSVER)]"" S BPSVER=$E(BPSVER,1)_"."_$E(BPSVER,2,99) "RTN","BPSSCRLG",242,0) Q BPSVER "RTN","BPSSCRLG",243,0) BIN(BPIEN02) ; "RTN","BPSSCRLG",244,0) Q $P($G(^BPSC(BPIEN02,100)),U,1) "RTN","BPSSCRLG",245,0) ;insurance name by 9002313.57 pointer "RTN","BPSSCRLG",246,0) INSUR57(BPIEN57) ; "RTN","BPSSCRLG",247,0) N BPINSN "RTN","BPSSCRLG",248,0) S BPINSN=+$G(^BPSTL(BPIEN57,9)) "RTN","BPSSCRLG",249,0) Q $P($G(^BPSTL(BPIEN57,10,BPINSN,0)),U,7) "RTN","BPSSCRLG",250,0) QTY(BPIEN57) ; "RTN","BPSSCRLG",251,0) Q +$P($G(^BPSTL(BPIEN57,5)),U,1) "RTN","BPSSCRLG",252,0) UNTPRICE(BPIEN57) ; "RTN","BPSSCRLG",253,0) Q +$P($G(^BPSTL(BPIEN57,5)),U,2) "RTN","BPSSCRLG",254,0) TOTPRICE(BPIEN57) ; "RTN","BPSSCRLG",255,0) Q +$P($G(^BPSTL(BPIEN57,5)),U,5) "RTN","BPSSCRLG",256,0) ;get ECME pharmacy division ptr for LOG "RTN","BPSSCRLG",257,0) LDIV(BPIEN57) ; "RTN","BPSSCRLG",258,0) Q +$P($G(^BPSTL(BPIEN57,1)),U,7) "RTN","BPSSCRLG",259,0) ;transaction code "RTN","BPSSCRLG",260,0) TRCODE(BPIEN02) ; "RTN","BPSSCRLG",261,0) Q $P($G(^BPSC(BPIEN02,100)),U,3) "RTN","BPSSCRLG",262,0) ;days supply "RTN","BPSSCRLG",263,0) DAYSSUPL(BPIEN02) ; "RTN","BPSSCRLG",264,0) ;format D5NNN -> NNN "RTN","BPSSCRLG",265,0) Q +$E($P($G(^BPSC(BPIEN02,400,1,400)),U,5),3,99) "RTN","BPSSCRLG",266,0) ; "RTN","BPSSCRLG",267,0) ;display response record "RTN","BPSSCRLG",268,0) DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ; "RTN","BPSSCRLG",269,0) N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17) "RTN","BPSSCRLG",270,0) N BPX,BPLN0,BPCNT,BPRJCDS,BPRJ,BPSTR1,BPSTYP2,BDUR,BMSG "RTN","BPSSCRLG",271,0) S BPLN0=BPLN "RTN","BPSSCRLG",272,0) S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"") "RTN","BPSSCRLG",273,0) S BPSTR1="Response Information ("_BPSTYP2_")(#"_BPIEN03_")" "RTN","BPSSCRLG",274,0) D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-")) "RTN","BPSSCRLG",275,0) D SETLINE(.BPLN,"") "RTN","BPSSCRLG",276,0) D SETLINE(.BPLN,"Response Received: "_$$RESPREC(BPIEN03,BPSDTALT)) "RTN","BPSSCRLG",277,0) D SETLINE(.BPLN,"Date of Service: "_$$DOSRSP(BPIEN03)) "RTN","BPSSCRLG",278,0) D SETLINE(.BPLN,"Transaction Response Status: "_$$RESPSTAT^BPSSCRU5(BPIEN03)) "RTN","BPSSCRLG",279,0) D SETLINE(.BPLN,"Total Amount Paid: $"_+$$TOTAMNT(BPIEN03,BP59,BP57)) "RTN","BPSSCRLG",280,0) D SETLINE(.BPLN,"Reject code(s): ") "RTN","BPSSCRLG",281,0) D REJCODES^BPSSCRU5(BPIEN03,.BPRJCDS) "RTN","BPSSCRLG",282,0) S BPRJ="" "RTN","BPSSCRLG",283,0) F S BPRJ=$O(BPRJCDS(BPRJ)) Q:BPRJ="" D "RTN","BPSSCRLG",284,0) . D SETLINE(.BPLN," "_$$GETRJNAM^BPSSCRU3(BPRJ)) "RTN","BPSSCRLG",285,0) D WRAPLN^BPSSCRU5(.BPLN,$$MESSAGE(BPIEN03),76,"Payer Message: ",5) "RTN","BPSSCRLG",286,0) D ADDMESS(BPIEN03,1,.BPADDMSG) "RTN","BPSSCRLG",287,0) S BMSG="" F S BMSG=$O(BPADDMSG(BMSG)) Q:BMSG="" D "RTN","BPSSCRLG",288,0) . D WRAPLN^BPSSCRU5(.BPLN,BPADDMSG(BMSG),76,$S(BMSG=1:"Payer Additional Message: ",1:" "),5) "RTN","BPSSCRLG",289,0) D SETLINE(.BPLN,"Reason for Service Code: "_$$DURREAS(BPIEN03)) "RTN","BPSSCRLG",290,0) D SETLINE(.BPLN,"DUR Text: "_$$DURTEXT(BPIEN03)) "RTN","BPSSCRLG",291,0) D WRAPLN^BPSSCRU5(.BPLN,$$DURADD(BPIEN03),76,"DUR Additional Text: ",5) "RTN","BPSSCRLG",292,0) F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"") "RTN","BPSSCRLG",293,0) Q "RTN","BPSSCRLG",294,0) ; "RTN","BPSSCRLG",295,0) RESPREC(BPIEN03,BPSDTALT) ; "RTN","BPSSCRLG",296,0) N BPSDT "RTN","BPSSCRLG",297,0) S BPSDT=+$P($G(^BPSR(BPIEN03,0)),U,2) "RTN","BPSSCRLG",298,0) Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT)) "RTN","BPSSCRLG",299,0) ; "RTN","BPSSCRLG",300,0) DOSRSP(BPIEN03) ; "RTN","BPSSCRLG",301,0) N BPDT "RTN","BPSSCRLG",302,0) S BPDT=$P($G(^BPSR(BPIEN03,400)),U,1)\1 "RTN","BPSSCRLG",303,0) Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4) "RTN","BPSSCRLG",304,0) ; "RTN","BPSSCRLG",305,0) TOTAMNT(BPIEN03,BP59,BP57) ; "RTN","BPSSCRLG",306,0) Q $$DFF2EXT^BPSECFM($P($G(^BPSR(BPIEN03,1000,1,500)),U,9)) "RTN","BPSSCRLG",307,0) ; "RTN","BPSSCRLG",308,0) MESSAGE(BPIEN03) ; "RTN","BPSSCRLG",309,0) Q $P($G(^BPSR(BPIEN03,504)),U) "RTN","BPSSCRLG",310,0) ; "RTN","BPSSCRLG",311,0) ADDMESS(BPIEN03,POS,BPADDMSG) ; "RTN","BPSSCRLG",312,0) N ADM,X,QUA,TXT,CON,BPMTMP,L,NEXT "RTN","BPSSCRLG",313,0) K BPMTMP,BPADDMSG "RTN","BPSSCRLG",314,0) I '$G(BPIEN03) Q "RTN","BPSSCRLG",315,0) I '$G(POS) S POS=1 "RTN","BPSSCRLG",316,0) S (ADM,L)=0 F S ADM=$O(^BPSR(BPIEN03,1000,POS,130.01,ADM)) Q:'ADM D "RTN","BPSSCRLG",317,0) . S X=$G(^BPSR(BPIEN03,1000,POS,130.01,ADM,0)) "RTN","BPSSCRLG",318,0) . S TXT=$P($G(^BPSR(BPIEN03,1000,POS,130.01,ADM,1)),U,1) "RTN","BPSSCRLG",319,0) . S QUA=$P(X,U,3),CON=$P(X,U,2) "RTN","BPSSCRLG",320,0) . ; This should not happen, but if the qualifier is null, set it "RTN","BPSSCRLG",321,0) . ; to "Z"_concatenated with a unique number so that it follows the "RTN","BPSSCRLG",322,0) . ; other qualifiers. Per the D0 standard, qualifiers can be 1-9 and "RTN","BPSSCRLG",323,0) . ; A-Z. ECL limits this to 1-9 but an future ECL may extend this. "RTN","BPSSCRLG",324,0) . I QUA="" S L=L+1,QUA="Z"_L "RTN","BPSSCRLG",325,0) . S BPMTMP(QUA)=CON_U_TXT "RTN","BPSSCRLG",326,0) I '$D(BPMTMP) Q "RTN","BPSSCRLG",327,0) S L=0,(QUA,NEXT)="" F S QUA=$O(BPMTMP(QUA)) Q:QUA="" D "RTN","BPSSCRLG",328,0) . S CON=$P(BPMTMP(QUA),U,1),TXT=$P(BPMTMP(QUA),U,2) "RTN","BPSSCRLG",329,0) . I NEXT="+" S BPADDMSG(L)=BPADDMSG(L)_TXT,NEXT=CON Q "RTN","BPSSCRLG",330,0) . S L=L+1,BPADDMSG(L)=TXT,NEXT=CON "RTN","BPSSCRLG",331,0) Q "RTN","BPSSCRLG",332,0) ; "RTN","BPSSCRLG",333,0) DURTEXT(BPIEN03) ; "RTN","BPSSCRLG",334,0) ; DUR FREE TEXT MESSAGE from first instance of DUR PPS RESPONSE "RTN","BPSSCRLG",335,0) Q $P($G(^BPSR(BPIEN03,1000,1,567.01,1,0)),U,9) "RTN","BPSSCRLG",336,0) ; "RTN","BPSSCRLG",337,0) DURREAS(BPIEN03) ; "RTN","BPSSCRLG",338,0) ; REASON FOR SERVICE CODE from first instance of DUR PPS RESPONSE "RTN","BPSSCRLG",339,0) Q $$GET1^DIQ(9002313.1101,"1,1,"_BPIEN03_",",439) "RTN","BPSSCRLG",340,0) ; "RTN","BPSSCRLG",341,0) DURADD(BPIEN03) ; "RTN","BPSSCRLG",342,0) ; DUR ADDITIONAL TEXT from first instance of DUR PPS RESPONSE "RTN","BPSSCRLG",343,0) Q $P($G(^BPSR(BPIEN03,1000,1,567.01,1,1)),U) "RTN","BPSSCRLG",344,0) ; "RTN","BPSSCRLG",345,0) RXCOB57(BPIEN57) ; "RTN","BPSSCRLG",346,0) N BPCOB "RTN","BPSSCRLG",347,0) S BPCOB=+$P($G(^BPSTL(BPIEN57,0)),U,14) "RTN","BPSSCRLG",348,0) Q $S(BPCOB=2:"SECONDARY",BPCOB=3:"TERTIARY",1:"PRIMARY") "RTN","BPSSCRLG",349,0) ; "RTN","BPSSCRLG",350,0) ;Display other payer(s) "RTN","BPSSCRLG",351,0) DISPPYR(BPLN,BPIEN03) ; "RTN","BPSSCRLG",352,0) N PYR,PYRDATA,BPSTR1 "RTN","BPSSCRLG",353,0) S PYR=0 F S PYR=$O(^BPSR(BPIEN03,1000,1,355.01,PYR)) Q:'PYR D "RTN","BPSSCRLG",354,0) . S PYRDATA=^BPSR(BPIEN03,1000,1,355.01,PYR,1) "RTN","BPSSCRLG",355,0) . S BPSTR1="Other Payer Information ("_PYR_")(#"_BPIEN03_")" "RTN","BPSSCRLG",356,0) . D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-")) "RTN","BPSSCRLG",357,0) . D SETLINE(.BPLN,"Other Payer ID Count: "_$$PYRIDCNT(BPIEN03,PYR)) "RTN","BPSSCRLG",358,0) . D SETLINE(.BPLN,"Other Payer ID: "_$P(PYRDATA,U,3)) "RTN","BPSSCRLG",359,0) . D SETLINE(.BPLN,"Other Payer Coverage Type: "_$P(PYRDATA,U,1)) "RTN","BPSSCRLG",360,0) . D SETLINE(.BPLN,"Other Payer ID Qualifier: "_$P(PYRDATA,U,2)) "RTN","BPSSCRLG",361,0) . D SETLINE(.BPLN,"Other Payer Help Desk Phone Number: "_$P(PYRDATA,U,8)) "RTN","BPSSCRLG",362,0) . D SETLINE(.BPLN,"Other Payer Processor Control Number: "_$P(PYRDATA,U,4)) "RTN","BPSSCRLG",363,0) . D SETLINE(.BPLN,"Other Payer Effective Date: "_$P(PYRDATA,U,10)) "RTN","BPSSCRLG",364,0) . D SETLINE(.BPLN,"Other Payer Termination Date: "_$P(PYRDATA,U,11)) "RTN","BPSSCRLG",365,0) . D SETLINE(.BPLN,"Other Payer Person Code: "_$P(PYRDATA,U,7)) "RTN","BPSSCRLG",366,0) . D SETLINE(.BPLN,"Other Payer Patient Relationship Code: "_$P(PYRDATA,U,9)) "RTN","BPSSCRLG",367,0) . D SETLINE(.BPLN,"Other Payer Cardholder ID: "_$P(PYRDATA,U,5)) "RTN","BPSSCRLG",368,0) . D SETLINE(.BPLN,"Other Payer Group ID: "_$P(PYRDATA,U,6)) "RTN","BPSSCRLG",369,0) Q "RTN","BPSSCRLG",370,0) ; "RTN","BPSSCRLG",371,0) PYRIDCNT(BPIEN03,PYR) ; "RTN","BPSSCRLG",372,0) Q $P($G(^BPSR(BPIEN03,1000,1,355.01,PYR,0)),U) "RTN","BPSSCRRS") 0^87^B34060825 "RTN","BPSSCRRS",1,0) BPSSCRRS ;BHAM ISC/SS - ECME SCREEN RESUBMIT ;05-APR-05 "RTN","BPSSCRRS",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSSCRRS",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCRRS",4,0) Q "RTN","BPSSCRRS",5,0) ;IA 4702 "RTN","BPSSCRRS",6,0) ; "RTN","BPSSCRRS",7,0) RES ; "RTN","BPSSCRRS",8,0) N BPRET,BPSARR59 "RTN","BPSSCRRS",9,0) I '$D(@(VALMAR)) Q "RTN","BPSSCRRS",10,0) D FULL^VALM1 "RTN","BPSSCRRS",11,0) W !,"Enter the line numbers for the claim(s) to be resubmitted." "RTN","BPSSCRRS",12,0) S BPRET=$$ASKLINES^BPSSCRU4("Select item(s)","C",.BPSARR59,VALMAR) "RTN","BPSSCRRS",13,0) I BPRET="^" S VALMBCK="R" Q "RTN","BPSSCRRS",14,0) ;go thru all selected claims and try to resubmit them separately "RTN","BPSSCRRS",15,0) ;update the content of the screen and display it "RTN","BPSSCRRS",16,0) ;only if at least one claim was submitted successfully "RTN","BPSSCRRS",17,0) I $$RESUBMIT(.BPSARR59) D REDRAW^BPSSCRUD("Updating screen for resubmitted claims...") "RTN","BPSSCRRS",18,0) E S VALMBCK="R" "RTN","BPSSCRRS",19,0) Q "RTN","BPSSCRRS",20,0) ; "RTN","BPSSCRRS",21,0) ;/** "RTN","BPSSCRRS",22,0) ;go thru all selected claims and try to resubmit them separately "RTN","BPSSCRRS",23,0) ;input: "RTN","BPSSCRRS",24,0) ; RXI - array with ptrs to BPS TRANSACTION file (see ASKLINES^BPSSCRU4) "RTN","BPSSCRRS",25,0) ;returns "RTN","BPSSCRRS",26,0) ; 0 - if no claims were resubmitted "RTN","BPSSCRRS",27,0) ; 1 - if at least one claim was resubmitted "RTN","BPSSCRRS",28,0) RESUBMIT(RXI) ;*/ "RTN","BPSSCRRS",29,0) N BPRVRSED ;was successfully reversed "RTN","BPSSCRRS",30,0) N BPRVNEED ;needs reversal "RTN","BPSSCRRS",31,0) N BPRVWAIT ;cycles of waiting "RTN","BPSSCRRS",32,0) N BPRVRSNT ;reversal has been sent "RTN","BPSSCRRS",33,0) N WHERE,DOSDATE,BILLNUM,RXIEN,RXR,BPDFN "RTN","BPSSCRRS",34,0) N BP59 "RTN","BPSSCRRS",35,0) N UPDATFLG,BPCLTOT,BPCLTOTR "RTN","BPSSCRRS",36,0) N BPQ "RTN","BPSSCRRS",37,0) N BPSTATUS "RTN","BPSSCRRS",38,0) N REVCOUNT S REVCOUNT=0 "RTN","BPSSCRRS",39,0) N BPIFANY S BPIFANY=0 "RTN","BPSSCRRS",40,0) N BPINPROG S BPINPROG=0 "RTN","BPSSCRRS",41,0) S BPCLTOT=0 ;total for resubmitted "RTN","BPSSCRRS",42,0) S BPCLTOTR=0 ;total for reversed, not resubmitted "RTN","BPSSCRRS",43,0) S UPDATFLG=0 "RTN","BPSSCRRS",44,0) S BP59="",BPQ="" "RTN","BPSSCRRS",45,0) F S BP59=$O(RXI(BP59)) Q:BP59="" D Q:BPQ="^" "RTN","BPSSCRRS",46,0) . I BPIFANY=0 W @IOF "RTN","BPSSCRRS",47,0) . S BPIFANY=1,BPQ="" "RTN","BPSSCRRS",48,0) . S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSSCRRS",49,0) . W !,"You've chosen to RESUBMIT the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13) "RTN","BPSSCRRS",50,0) . W !,@VALMAR@(+$G(RXI(BP59)),0) "RTN","BPSSCRRS",51,0) . S (BPRVNEED,BPRVRSED,BPRVWAIT,BPRVRSNT)=0 "RTN","BPSSCRRS",52,0) . S BPQ=$$YESNO("Are you sure?(Y/N)") "RTN","BPSSCRRS",53,0) . I BPQ=-1 S BPQ="^" Q "RTN","BPSSCRRS",54,0) . I BPQ'=1 Q "RTN","BPSSCRRS",55,0) . S RXIEN=$P(BP59,".") "RTN","BPSSCRRS",56,0) . S RXR=+$E($P(BP59,".",2),1,4) "RTN","BPSSCRRS",57,0) . I BPRVNEED=1&(BPRVRSED'=1) Q ;cannot be resubmitted "RTN","BPSSCRRS",58,0) . I $$RXDEL^BPSOS(+RXIEN,RXR) W !!,">> Cannot Reverse or Resubmit ",!,@VALMAR@(+$G(RXI(BP59)),0),!," because it has been deleted in Pharmacy.",! Q "RTN","BPSSCRRS",59,0) . ;can't resubmit a closed claim. The user must reopen first. "RTN","BPSSCRRS",60,0) . I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) D Q "RTN","BPSSCRRS",61,0) . . W !!,">> Cannot Resubmit ",!,$G(@VALMAR@(+$G(RXI(BP59)),0)),!," because the claim is Closed. Reopen the claim and try again.",! Q "RTN","BPSSCRRS",62,0) . S BPSTATUS=$P($$CLAIMST^BPSSCRU3(BP59),U) "RTN","BPSSCRRS",63,0) . I $P($G(^BPST(BP59,0)),U,14)<2,$$PAYABLE^BPSOSRX5(BPSTATUS),BPINPROG=0,$$PAYBLSEC^BPSUTIL2(BP59) D S BPQ=$$PAUSE^BPSSCRRV() Q "RTN","BPSSCRRS",64,0) . . W !,"The claim: ",!,$G(@VALMAR@(+$G(RXI(BP59)),0)),!,"cannot be Resubmitted if the secondary claim is payable.",!,"Please reverse the secondary claim first." "RTN","BPSSCRRS",65,0) . I (BPSTATUS="IN PROGRESS")!(BPSTATUS="SCHEDULED") S BPINPROG=1 "RTN","BPSSCRRS",66,0) . I BPINPROG=1 D I $$YESNO^BPSSCRRS("Do you want to proceed?(Y/N)")=0 S BPQ="^" Q "RTN","BPSSCRRS",67,0) . . W !,"The claim is in progress. The request will be scheduled and processed after" "RTN","BPSSCRRS",68,0) . . W !,"the previous request(s) are completed. Please be aware that the result of " "RTN","BPSSCRRS",69,0) . . W !,"the resubmit depends on the payer's response to the prior incomplete requests." "RTN","BPSSCRRS",70,0) . S DOSDATE=$$DOSDATE(RXIEN,RXR) "RTN","BPSSCRRS",71,0) . S BILLNUM=$$EN^BPSNCPDP(RXIEN,RXR,DOSDATE,"ERES","","ECME RESUBMIT",,,,,$$COB59^BPSUTIL2(BP59)) "RTN","BPSSCRRS",72,0) . ;print return value message "RTN","BPSSCRRS",73,0) . W !! "RTN","BPSSCRRS",74,0) . W:+BILLNUM>0 $S(+BILLNUM=10:"Reversal but no Resubmit:",1:"Not Processed:"),!," " "RTN","BPSSCRRS",75,0) . ;Change Return Message for SC/EI "RTN","BPSSCRRS",76,0) . S:$P(BILLNUM,U,2)="NEEDS SC DETERMINATION" $P(BILLNUM,U,2)="NEEDS SC/EI DETERMINATION" "RTN","BPSSCRRS",77,0) . W $P(BILLNUM,U,2) "RTN","BPSSCRRS",78,0) . ;0 Prescription/Fill successfully submitted to ECME for claims processing "RTN","BPSSCRRS",79,0) . ;1 ECME did not submit prescription/fill "RTN","BPSSCRRS",80,0) . ;2 IB says prescription/fill is not ECME billable or the data returned from IB is not valid "RTN","BPSSCRRS",81,0) . ;3 ECME closed the claim but did not submit it to the payer "RTN","BPSSCRRS",82,0) . ;4 Unable to queue the ECME claim "RTN","BPSSCRRS",83,0) . ;5 Invalid input "RTN","BPSSCRRS",84,0) . ;10 Reversal but no resubmit "RTN","BPSSCRRS",85,0) . N BPSCOB S BPSCOB=$$COB59^BPSUTIL2(BP59) ;get COB for the BPS TRANSACTION IEN "RTN","BPSSCRRS",86,0) . I +BILLNUM=0 D "RTN","BPSSCRRS",87,0) . . D ECMEACT^PSOBPSU1(+RXIEN,+RXR,"Claim resubmitted to 3rd party payer: ECME USER's SCREEN-"_$S(BPSCOB=1:"p",BPSCOB=2:"s",1:"")_$$INSNAME^BPSSCRU6(BP59)) "RTN","BPSSCRRS",88,0) . . S UPDATFLG=1,BPCLTOT=BPCLTOT+1 "RTN","BPSSCRRS",89,0) . I +BILLNUM=10 D "RTN","BPSSCRRS",90,0) . . D ECMEACT^PSOBPSU1(+RXIEN,+RXR,"Claim reversed but not resubmitted: ECME USER's SCREEN-"_$S(BPSCOB=1:"p",BPSCOB=2:"s",1:"")_$$INSNAME^BPSSCRU6(BP59)) "RTN","BPSSCRRS",91,0) . . S UPDATFLG=1,BPCLTOTR=BPCLTOTR+1 "RTN","BPSSCRRS",92,0) W:BPIFANY=0 !,"No eligible items selected." "RTN","BPSSCRRS",93,0) W !,BPCLTOT," claim",$S(BPCLTOT'=1:"s have",1:" has")," been resubmitted.",! "RTN","BPSSCRRS",94,0) W:BPCLTOTR>0 !,BPCLTOTR," claim",$S(BPCLTOTR'=1:"s have",1:" has")," been reversed but not resubmitted.",! "RTN","BPSSCRRS",95,0) D PAUSE^VALM1 "RTN","BPSSCRRS",96,0) Q UPDATFLG "RTN","BPSSCRRS",97,0) ; "RTN","BPSSCRRS",98,0) ; Ask "RTN","BPSSCRRS",99,0) ; Input: "RTN","BPSSCRRS",100,0) ; BPQSTR - question "RTN","BPSSCRRS",101,0) ; BPDFL - default answer "RTN","BPSSCRRS",102,0) ; Output: "RTN","BPSSCRRS",103,0) ; 1 YES "RTN","BPSSCRRS",104,0) ; 0 NO "RTN","BPSSCRRS",105,0) ; -1 if cancelled "RTN","BPSSCRRS",106,0) YESNO(BPQSTR,BPDFL) ; Default - YES "RTN","BPSSCRRS",107,0) N DIR,Y,DUOUT "RTN","BPSSCRRS",108,0) S DIR(0)="Y" "RTN","BPSSCRRS",109,0) S DIR("A")=BPQSTR "RTN","BPSSCRRS",110,0) S:$L($G(BPDFL)) DIR("B")=BPDFL "RTN","BPSSCRRS",111,0) D ^DIR "RTN","BPSSCRRS",112,0) Q $S($G(DUOUT)!$G(DUOUT)!(Y="^"):-1,1:Y) "RTN","BPSSCRRS",113,0) ; "RTN","BPSSCRRS",114,0) ;Date of service "RTN","BPSSCRRS",115,0) ;RXIEN - IEN in file #52 "RTN","BPSSCRRS",116,0) ;RXR - refill number "RTN","BPSSCRRS",117,0) ;returns: "RTN","BPSSCRRS",118,0) ; date of service "RTN","BPSSCRRS",119,0) DOSDATE(RXIEN,RXR) ; "RTN","BPSSCRRS",120,0) N BPDOS,BPDT "RTN","BPSSCRRS",121,0) ;try release date "RTN","BPSSCRRS",122,0) S BPDOS=$$RXRLDT^PSOBPSUT(RXIEN,RXR)\1 "RTN","BPSSCRRS",123,0) Q:+BPDOS>0 BPDOS "RTN","BPSSCRRS",124,0) ;try fill date "RTN","BPSSCRRS",125,0) S BPDOS=$$RXFLDT^PSOBPSUT(RXIEN,RXR)\1 "RTN","BPSSCRRS",126,0) I '$G(DT) Q BPDOS "RTN","BPSSCRRS",127,0) I BPDOS>0,BPDOS'>DT Q BPDOS "RTN","BPSSCRRS",128,0) ;use current date (today) "RTN","BPSSCRRS",129,0) Q DT\1 "RTN","BPSSCRRS",130,0) ; "RTN","BPSSCRRS",131,0) ;To display the FILL date on the screen "RTN","BPSSCRRS",132,0) ; use Date Of Service date , later on it might be changed "RTN","BPSSCRRS",133,0) ;input: "RTN","BPSSCRRS",134,0) ;RXIEN - IEN in file #52 "RTN","BPSSCRRS",135,0) ;RXR - refill number "RTN","BPSSCRRS",136,0) ;returns: "RTN","BPSSCRRS",137,0) ; date of service "RTN","BPSSCRRS",138,0) ; or empty date if failure "RTN","BPSSCRRS",139,0) FILLDATE(RXIEN,RXR) ; "RTN","BPSSCRRS",140,0) N DOSDT "RTN","BPSSCRRS",141,0) S DOSDT=$$DOSDATE(RXIEN,RXR) "RTN","BPSSCRRS",142,0) I $L(DOSDT)'=7 Q " / " "RTN","BPSSCRRS",143,0) Q $E(DOSDT,4,5)_"/"_$E(DOSDT,6,7) "RTN","BPSSCRRS",144,0) ; "RTN","BPSSCRU2") 0^14^B46275468 "RTN","BPSSCRU2",1,0) BPSSCRU2 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05 "RTN","BPSSCRU2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,10**;JUN 2004;Build 27 "RTN","BPSSCRU2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCRU2",4,0) ;USER SCREEN "RTN","BPSSCRU2",5,0) Q "RTN","BPSSCRU2",6,0) ;/** "RTN","BPSSCRU2",7,0) ;Input: "RTN","BPSSCRU2",8,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",9,0) ;Output: "RTN","BPSSCRU2",10,0) ;get filling "location" like "WINDOW/LOCALMAIL/CMOP" "RTN","BPSSCRU2",11,0) GETMWC(BP59) ;*/ "RTN","BPSSCRU2",12,0) N BP1 S BP1=$$RXREF(BP59) "RTN","BPSSCRU2",13,0) Q:+BP1=0 "" "RTN","BPSSCRU2",14,0) Q $$MWC($P(BP1,U),$P(BP1,U,2)) "RTN","BPSSCRU2",15,0) ; "RTN","BPSSCRU2",16,0) ;initially this was designed to convert numbers to letters to display on the screen "RTN","BPSSCRU2",17,0) ;but later the Pharmacy designed API that returns letters instead of numbers "RTN","BPSSCRU2",18,0) ;so now this function just returns what it receives in its parameter, while it does not "RTN","BPSSCRU2",19,0) ;make any sense, we still keep it in order to prevent changes in other four routines: "RTN","BPSSCRU2",20,0) ; BPSREOP1, BPSSCR02, BPSSCR03, BPSSCR04 "RTN","BPSSCRU2",21,0) MWCNAME(BPMWC) ; "RTN","BPSSCRU2",22,0) Q BPMWC "RTN","BPSSCRU2",23,0) ;/** "RTN","BPSSCRU2",24,0) ;Input: "RTN","BPSSCRU2",25,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",26,0) ;Output: "RTN","BPSSCRU2",27,0) ;get RX pointer in file #52 and refill number in its multiple (0 - original refill) "RTN","BPSSCRU2",28,0) RXREF(BP59) ; "RTN","BPSSCRU2",29,0) N BPRX,BPREF "RTN","BPSSCRU2",30,0) S BPRX=+$P($G(^BPST(BP59,1)),U,11) ;ptr to RX node in #52 "RTN","BPSSCRU2",31,0) S BPREF=+$P($G(^BPST(BP59,1)),U) ;ptr to refill multiple in #52 "RTN","BPSSCRU2",32,0) Q BPRX_U_BPREF "RTN","BPSSCRU2",33,0) ; determines if the refill was MAIL/WINDOW/CMOP "RTN","BPSSCRU2",34,0) MWC(BPRX,BPREF) ;MAIL/WINDOW/CMOP "RTN","BPSSCRU2",35,0) ;input: "RTN","BPSSCRU2",36,0) ; BPRX ptr to #52 (RX) "RTN","BPSSCRU2",37,0) ; BPREF ptr to #52.1 (refills) "RTN","BPSSCRU2",38,0) ;return value: "RTN","BPSSCRU2",39,0) ; 2-MAIL/3-WINDOW/4-CMOP "RTN","BPSSCRU2",40,0) Q $$MWC^PSOBPSU2(BPRX,BPREF) "RTN","BPSSCRU2",41,0) ; "RTN","BPSSCRU2",42,0) ; "RTN","BPSSCRU2",43,0) ;/** "RTN","BPSSCRU2",44,0) ;Input: "RTN","BPSSCRU2",45,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",46,0) ;Output: "RTN","BPSSCRU2",47,0) ; insurance ien ^ name ^ phone "RTN","BPSSCRU2",48,0) GETINSUR(BP59) ;get insurance info by the pointer of #9002313.59 "RTN","BPSSCRU2",49,0) N BPHONE,BPINSNM,BPINSID,BP57,BPINSN,BPX "RTN","BPSSCRU2",50,0) S BPX=$$NAMEPHON^BPSSCRU3(BP59) "RTN","BPSSCRU2",51,0) S BPINSNM=$P(BPX,U,1) "RTN","BPSSCRU2",52,0) S BPHONE=$P(BPX,U,2) "RTN","BPSSCRU2",53,0) ;Get a temporary ID for the insurance from ^TMP list of insurances. "RTN","BPSSCRU2",54,0) ;If doesn't exist yet then create a new record in ^TMP list of insurances "RTN","BPSSCRU2",55,0) ; for this insurance and return the ID for the record. "RTN","BPSSCRU2",56,0) ;A lifetime for ^TMP list of insurances is the time period the user is using "RTN","BPSSCRU2",57,0) ; the User Screen menu option "RTN","BPSSCRU2",58,0) S BPINSID=$$CHKINSUR^BPSSCR(BPINSNM,BPHONE) "RTN","BPSSCRU2",59,0) I $L(BPHONE)=0 S BPHONE=" " "RTN","BPSSCRU2",60,0) I $L(BPINSNM)=0 S BPINSNM="?NODATA?" "RTN","BPSSCRU2",61,0) Q BPINSID_U_BPINSNM_U_BPHONE "RTN","BPSSCRU2",62,0) ; "RTN","BPSSCRU2",63,0) ;/** "RTN","BPSSCRU2",64,0) ;Input: "RTN","BPSSCRU2",65,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",66,0) ;Output: "RTN","BPSSCRU2",67,0) ;transaction date "RTN","BPSSCRU2",68,0) TRANDT(BP59) ; "RTN","BPSSCRU2",69,0) Q $P($G(^BPST(BP59,0)),U,8)\1 "RTN","BPSSCRU2",70,0) ; "RTN","BPSSCRU2",71,0) ;/** "RTN","BPSSCRU2",72,0) ;Input: "RTN","BPSSCRU2",73,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",74,0) ;Output: "RTN","BPSSCRU2",75,0) ;ECME pharmacy division (9002313.56) "RTN","BPSSCRU2",76,0) DIVIS(BP59) ; "RTN","BPSSCRU2",77,0) Q $P($G(^BPST(BP59,1)),U,7) "RTN","BPSSCRU2",78,0) ; "RTN","BPSSCRU2",79,0) ;/** "RTN","BPSSCRU2",80,0) ;Input: "RTN","BPSSCRU2",81,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",82,0) ;Output: "RTN","BPSSCRU2",83,0) ;patient's DFN (file #2) "RTN","BPSSCRU2",84,0) GETPATID(BP59) ; "RTN","BPSSCRU2",85,0) Q $P($G(^BPST(BP59,0)),U,6) "RTN","BPSSCRU2",86,0) ; "RTN","BPSSCRU2",87,0) ;return RX status as ACT/DIS/etc "RTN","BPSSCRU2",88,0) RXST(BP59) ; "RTN","BPSSCRU2",89,0) N BPRXREF "RTN","BPSSCRU2",90,0) S BPRXREF=$$RXREF^BPSSCRU2(BP59) "RTN","BPSSCRU2",91,0) ;display status ONLY if the refill is the most recent "RTN","BPSSCRU2",92,0) ;otherwise display blanks (three spaces for sorting purposes) "RTN","BPSSCRU2",93,0) I +$P(BPRXREF,U,2)'=(+$$LSTRFL^PSOBPSU1(+$P(BPRXREF,U,1))) Q "**" "RTN","BPSSCRU2",94,0) Q $$RXSTANAM($$RXSTATUS(+$P(BPRXREF,U,1))) "RTN","BPSSCRU2",95,0) ;/** "RTN","BPSSCRU2",96,0) ;RX status "RTN","BPSSCRU2",97,0) ;Input "RTN","BPSSCRU2",98,0) ; RXNUM: "RTN","BPSSCRU2",99,0) ; ien of file #52 (if MODE=0) "RTN","BPSSCRU2",100,0) ; or RX number (if MODE=1) "RTN","BPSSCRU2",101,0) ;---------- "RTN","BPSSCRU2",102,0) ;Output: "RTN","BPSSCRU2",103,0) ; 0 if not found "RTN","BPSSCRU2",104,0) ; status set# "RTN","BPSSCRU2",105,0) RXSTATUS(RXNUM) ;*/ "RTN","BPSSCRU2",106,0) N BPRET "RTN","BPSSCRU2",107,0) S BPRET=$$RXAPI1^BPSUTIL1(RXNUM,100,"I") "RTN","BPSSCRU2",108,0) I BPRET="" Q -1 "RTN","BPSSCRU2",109,0) Q BPRET "RTN","BPSSCRU2",110,0) ;/** "RTN","BPSSCRU2",111,0) ;if RX "valid" "RTN","BPSSCRU2",112,0) RXACTIVE(BPRXSTAT) ;*/ "RTN","BPSSCRU2",113,0) ; 0 not valid "RTN","BPSSCRU2",114,0) ; 1 valid (i.e. ACTIVE/NON-VERIFIED/REFILL/HOLD/DRUG INTERACTIONS/SUSPENDED) "RTN","BPSSCRU2",115,0) ; -1 doesn't exist "RTN","BPSSCRU2",116,0) Q:BPRXSTAT<6 1 ;active "RTN","BPSSCRU2",117,0) ;/** "RTN","BPSSCRU2",118,0) ;RX status text "RTN","BPSSCRU2",119,0) RXSTANAM(BPRXSTAT) ;*/ "RTN","BPSSCRU2",120,0) Q:BPRXSTAT=0 "AC" ; ACTIVE; "RTN","BPSSCRU2",121,0) Q:BPRXSTAT=1 "NV" ; NON-VERIFIED; "RTN","BPSSCRU2",122,0) Q:BPRXSTAT=3 "HL" ; HOLD; "RTN","BPSSCRU2",123,0) Q:BPRXSTAT=5 "SU" ; SUSPENDED; "RTN","BPSSCRU2",124,0) Q:BPRXSTAT=11 "EX" ; EXPIRED; "RTN","BPSSCRU2",125,0) Q:BPRXSTAT=12 "DS" ; DISCONTINUED; "RTN","BPSSCRU2",126,0) Q:BPRXSTAT=13 "DL" ; DELETED; "RTN","BPSSCRU2",127,0) Q:BPRXSTAT=14 "DS" ; DISCONTINUED BY PROVIDER; "RTN","BPSSCRU2",128,0) Q:BPRXSTAT=15 "DS" ; DISCONTINUED (EDIT); "RTN","BPSSCRU2",129,0) Q:BPRXSTAT=16 "HL" ; PROVIDER HOLD; "RTN","BPSSCRU2",130,0) Q:BPRXSTAT=-1 "??" "RTN","BPSSCRU2",131,0) Q "" "RTN","BPSSCRU2",132,0) ;/** "RTN","BPSSCRU2",133,0) ;Input: "RTN","BPSSCRU2",134,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",135,0) ;Output: "RTN","BPSSCRU2",136,0) ;returns: "RTN","BPSSCRU2",137,0) ;>0 Released "RTN","BPSSCRU2",138,0) ;0 non released "RTN","BPSSCRU2",139,0) ;-1 error "RTN","BPSSCRU2",140,0) ISRXREL(BP59) ; "RTN","BPSSCRU2",141,0) N BP1 "RTN","BPSSCRU2",142,0) S BP1=$$REFILINF(BP59) "RTN","BPSSCRU2",143,0) Q:BP1<0 -1 "RTN","BPSSCRU2",144,0) Q $P(BP1,U,2) ; i.e. it is non-released if there is no any release date "RTN","BPSSCRU2",145,0) ; "RTN","BPSSCRU2",146,0) ;release status "RTN","BPSSCRU2",147,0) RL(BP59) ; "RTN","BPSSCRU2",148,0) Q $S($$ISRXREL(BP59)>0:"R",1:"N") "RTN","BPSSCRU2",149,0) ;/** "RTN","BPSSCRU2",150,0) ;get refill (including original refill) info by BP59 "RTN","BPSSCRU2",151,0) ;Input: "RTN","BPSSCRU2",152,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU2",153,0) ;Output: "RTN","BPSSCRU2",154,0) ;returns: "RTN","BPSSCRU2",155,0) ;on error : "-1" "RTN","BPSSCRU2",156,0) ;on success : refill# ^ release date ^label print date ^ fill date ^ issue date "RTN","BPSSCRU2",157,0) REFILINF(BP59) ;*/ "RTN","BPSSCRU2",158,0) N BP1 S BP1=$$RXREF(BP59) "RTN","BPSSCRU2",159,0) N BPRX S BPRX=$P(BP1,U,1) ;ptr to #52 "RTN","BPSSCRU2",160,0) N BPREF S BPREF=$P(BP1,U,2) ;ptr in its refill multiple "RTN","BPSSCRU2",161,0) I BPREF,$$IFREFILL(BPRX,BPREF)=0 Q -1 ;if bad data "RTN","BPSSCRU2",162,0) ;original refill "RTN","BPSSCRU2",163,0) I BPREF=0 Q "0"_U_$$RXRELDT(BPRX)_U_U_$$RXFILDT(BPRX)_U_$$RXISSDT(BPRX) "RTN","BPSSCRU2",164,0) ;refill's release date "RTN","BPSSCRU2",165,0) I BPREF>0 Q BPREF_U_$$REFRELDT(BPRX,BPREF)_U_U_$$REFFILDT(BPRX,BPREF)_U_$$REFISSDT(BPRX,BPREF) "RTN","BPSSCRU2",166,0) Q -1 "RTN","BPSSCRU2",167,0) ; "RTN","BPSSCRU2",168,0) ;-Prescriptions----------------------- "RTN","BPSSCRU2",169,0) ;RX issue date "RTN","BPSSCRU2",170,0) RXISSDT(BPRX) ; "RTN","BPSSCRU2",171,0) Q +$$RXAPI1^BPSUTIL1(BPRX,1,"I") "RTN","BPSSCRU2",172,0) ; "RTN","BPSSCRU2",173,0) ;RX's release date "RTN","BPSSCRU2",174,0) RXRELDT(BPRX) ; "RTN","BPSSCRU2",175,0) Q +$$RXAPI1^BPSUTIL1(BPRX,31,"I") "RTN","BPSSCRU2",176,0) ; "RTN","BPSSCRU2",177,0) ;RX's fill date "RTN","BPSSCRU2",178,0) RXFILDT(BPRX) ; "RTN","BPSSCRU2",179,0) Q +$$RXAPI1^BPSUTIL1(BPRX,22,"I") "RTN","BPSSCRU2",180,0) ; "RTN","BPSSCRU2",181,0) ;refill's release date "RTN","BPSSCRU2",182,0) REFRELDT(BPRX,BPREF) ; "RTN","BPSSCRU2",183,0) Q +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,17,"I") "RTN","BPSSCRU2",184,0) ; "RTN","BPSSCRU2",185,0) ;refill's refill date "RTN","BPSSCRU2",186,0) REFFILDT(BPRX,BPREF) ; "RTN","BPSSCRU2",187,0) Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I") "RTN","BPSSCRU2",188,0) ; "RTN","BPSSCRU2",189,0) ;refill's issue date "RTN","BPSSCRU2",190,0) REFISSDT(BPRX,BPREF) ; "RTN","BPSSCRU2",191,0) Q $$REFDISDT(BPRX,BPREF) "RTN","BPSSCRU2",192,0) ; "RTN","BPSSCRU2",193,0) ;refill's dispense date "RTN","BPSSCRU2",194,0) REFDISDT(BPRX,BPREF) ; "RTN","BPSSCRU2",195,0) Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,10.1,"I") "RTN","BPSSCRU2",196,0) ; "RTN","BPSSCRU2",197,0) ;if refill exists "RTN","BPSSCRU2",198,0) IFREFILL(BPRX,BPREF) ; "RTN","BPSSCRU2",199,0) Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")'="" "RTN","BPSSCRU2",200,0) ;/** "RTN","BPSSCRU2",201,0) ;input "RTN","BPSSCRU2",202,0) ;ptr to 9002313.59 "RTN","BPSSCRU2",203,0) ;output : "RTN","BPSSCRU2",204,0) ; BB - back billing "RTN","BPSSCRU2",205,0) ; RT - all other values in (#1201) RX ACTION field on 9002313.59 "RTN","BPSSCRU2",206,0) RTBB(BP59) ;*/ "RTN","BPSSCRU2",207,0) N BPTRBB "RTN","BPSSCRU2",208,0) S BPTRBB=$P($G(^BPST(BP59,12)),U) "RTN","BPSSCRU2",209,0) I BPTRBB="" Q "**" "RTN","BPSSCRU2",210,0) I BPTRBB="BB" Q "BB" "RTN","BPSSCRU2",211,0) Q "RT" "RTN","BPSSCRU2",212,0) ; "RTN","BPSSCRU2",213,0) ;------------ patient's name "RTN","BPSSCRU2",214,0) PATNAME(BPDFN) ; "RTN","BPSSCRU2",215,0) Q $E($P($G(^DPT(BPDFN,0)),U),1,15) "RTN","BPSSCRU2",216,0) ; "RTN","BPSSCRU2",217,0) SSN4(DFN) ;last 4 SSN "RTN","BPSSCRU2",218,0) N X "RTN","BPSSCRU2",219,0) S X=$P($G(^DPT(DFN,0)),U,9) "RTN","BPSSCRU2",220,0) Q "("_$E(X,$L(X)-3,$L(X))_")" "RTN","BPSSCRU2",221,0) ; "RTN","BPSSCRU2",222,0) ;get drug generic name "RTN","BPSSCRU2",223,0) DRGNAM(BP50) ; "RTN","BPSSCRU2",224,0) ;BP50 - ptr to #50 "RTN","BPSSCRU2",225,0) Q $E($$DRUGDIE^BPSUTIL1(BP50,.01,"E"),1,35) "RTN","BPSSCRU2",226,0) ;get drug "RTN","BPSSCRU2",227,0) GETDRUG(BP52) ; "RTN","BPSSCRU2",228,0) ;return value: "RTN","BPSSCRU2",229,0) ; 0 - unknown "RTN","BPSSCRU2",230,0) ; n - ptr to DRUG file #50 "RTN","BPSSCRU2",231,0) Q +$$RXAPI1^BPSUTIL1(BP52,6,"I") "RTN","BPSSCRU2",232,0) ; "RTN","BPSSCRU2",233,0) GETDRG59(BP59) ; "RTN","BPSSCRU2",234,0) N BPX "RTN","BPSSCRU2",235,0) S BPX=$$RXREF(BP59) "RTN","BPSSCRU2",236,0) Q $$GETDRUG(+BPX) "RTN","BPSSCRU2",237,0) ; "RTN","BPSSCRU2",238,0) ; "RTN","BPSSCRU2",239,0) ;review %% for each of claims in the array "RTN","BPSSCRU2",240,0) ;and calculate "overall" "done" status "RTN","BPSSCRU2",241,0) ;input: "RTN","BPSSCRU2",242,0) ; BPARR59 - array of ptr to #9002313.59 "RTN","BPSSCRU2",243,0) ;output: "RTN","BPSSCRU2",244,0) ; status "RTN","BPSSCRU2",245,0) FINISHST(BPARR59) ; "RTN","BPSSCRU2",246,0) N BPFIN,BP59 "RTN","BPSSCRU2",247,0) S BPFIN=1,BP59=0 "RTN","BPSSCRU2",248,0) F S BP59=$O(BPARR59(BP59)) Q:+BP59=0 D Q:BPFIN=0 "RTN","BPSSCRU2",249,0) . I $$PRCNTG^BPSSCRU3(BP59)<99 S BPFIN=0 "RTN","BPSSCRU2",250,0) I BPFIN=1 Q "**FINISHED**" "RTN","BPSSCRU2",251,0) Q "" "RTN","BPSSCRU2",252,0) ; "RTN","BPSSCRU2",253,0) ; "RTN","BPSSCRU2",254,0) ;BPRX - ptr to #52 "RTN","BPSSCRU2",255,0) RXNUM(BPRX) ; "RTN","BPSSCRU2",256,0) Q $$RXAPI1^BPSUTIL1(BPRX,.01,"E")_$S(+$$RXAPI1^BPSUTIL1(BPRX,105,"I"):"$",1:"") "RTN","BPSSCRU2",257,0) ; "RTN","BPSSCRU2",258,0) ;/** "RTN","BPSSCRU2",259,0) ;get NDC "RTN","BPSSCRU2",260,0) ;input "RTN","BPSSCRU2",261,0) ;BPRX - ptr to #52 "RTN","BPSSCRU2",262,0) ;BPREF - refill # (0,1,2,3...) "RTN","BPSSCRU2",263,0) NDC(BPRX,BPREF) ;*/ "RTN","BPSSCRU2",264,0) N X "RTN","BPSSCRU2",265,0) S X=$TR($$GETNDC^PSONDCUT(BPRX,BPREF),"-","") ;remove dashes "RTN","BPSSCRU2",266,0) Q X "RTN","BPSSCRU2",267,0) ; "RTN","BPSSCRU2",268,0) DRGNAME(BP59) ;drug name BP59 -ptr to .59 file "RTN","BPSSCRU2",269,0) N BPRX "RTN","BPSSCRU2",270,0) S BPRX=+$P($G(^BPST(BP59,1)),U,11) ;ptr to RX node in #52 "RTN","BPSSCRU2",271,0) Q $E($$DRGNAM($$GETDRUG(BPRX)),1,23) "RTN","BPSSCRU2",272,0) ; "RTN","BPSSCRU2",273,0) ;is the number even? "RTN","BPSSCRU2",274,0) ;1-yes "RTN","BPSSCRU2",275,0) ;0 -no "RTN","BPSSCRU2",276,0) ISEVEN(BPNUM) ; "RTN","BPSSCRU2",277,0) Q ((BPNUM/2)-(BPNUM\2))=0 "RTN","BPSSCRU2",278,0) ; "RTN","BPSSCRU2",279,0) ;BPSTR - string to format "RTN","BPSSCRU2",280,0) ;BPSMLEN - max lenght "RTN","BPSSCRU2",281,0) ;BPSCHR - char to add "RTN","BPSSCRU2",282,0) ;BPSLFT - 1 - add from the left, 0 - from the right "RTN","BPSSCRU2",283,0) FORMAT(BPSTR,BPSMLEN,BPSCHR,BPSLFT) ; "RTN","BPSSCRU2",284,0) N LN S LN=$L(BPSTR) "RTN","BPSSCRU2",285,0) N ZZ S ZZ="" "RTN","BPSSCRU2",286,0) I LN=BPSMLEN Q BPSTR "RTN","BPSSCRU2",287,0) I LN>BPSMLEN Q:BPSLFT $E(BPSTR,LN-BPSMLEN+1,9999) Q $E(BPSTR,1,BPSMLEN) "RTN","BPSSCRU2",288,0) S $P(ZZ,BPSCHR,BPSMLEN-LN+1)="" "RTN","BPSSCRU2",289,0) Q:BPSLFT ZZ_BPSTR "RTN","BPSSCRU2",290,0) Q BPSTR_ZZ "RTN","BPSSCRU2",291,0) ; "RTN","BPSSCRU2",292,0) ;/** "RTN","BPSSCRU2",293,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCRU2",294,0) ;output : "RTN","BPSSCRU2",295,0) ;ECME number from 9002313.02 "RTN","BPSSCRU2",296,0) ; 7 or 12 digits of the prescription IEN file 52 "RTN","BPSSCRU2",297,0) ; or 12 spaces "RTN","BPSSCRU2",298,0) ECMENUM(BP59) ;*/ "RTN","BPSSCRU2",299,0) N BPST0,BPST4,PC,PF,PR,X "RTN","BPSSCRU2",300,0) S BPST0=$G(^BPST(BP59,0)),PC=$P(BPST0,U,4),PF=$P(BPST0,U,9) "RTN","BPSSCRU2",301,0) S BPST4=$G(^BPST(BP59,4)),PR=$P(BPST4,U,1) "RTN","BPSSCRU2",302,0) I PR]"" S PC=PR ;This is a reversal "RTN","BPSSCRU2",303,0) I PC=""!(PF="") Q $$FORMAT("",12," ",1) "RTN","BPSSCRU2",304,0) S X=$P($G(^BPSC(PC,400,PF,400)),U,2) "RTN","BPSSCRU2",305,0) I X="" Q $$FORMAT(X,12," ",1) "RTN","BPSSCRU2",306,0) Q $E(X,3,14) "RTN","BPSSCRU3") 0^84^B30414230 "RTN","BPSSCRU3",1,0) BPSSCRU3 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05 "RTN","BPSSCRU3",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,9,10**;JUN 2004;Build 27 "RTN","BPSSCRU3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCRU3",4,0) ;USER SCREEN "RTN","BPSSCRU3",5,0) Q "RTN","BPSSCRU3",6,0) ;get comment from BPS TRANSACTION file "RTN","BPSSCRU3",7,0) ;BP59 - ien in that file "RTN","BPSSCRU3",8,0) COMMENT(BP59) ; "RTN","BPSSCRU3",9,0) N BPCMNT,BPX,BPTXT "RTN","BPSSCRU3",10,0) S BPCMNT=$O(^BPST(BP59,11,999999),-1) "RTN","BPSSCRU3",11,0) I BPCMNT="" Q "" "RTN","BPSSCRU3",12,0) S BPX=$G(^BPST(BP59,11,BPCMNT,0)) "RTN","BPSSCRU3",13,0) S BPTXT=$P(BPX,U,3) I $L(BPTXT)>60 S BPTXT=$E(BPTXT,1,58)_"..." "RTN","BPSSCRU3",14,0) Q $$DATTIM($P(BPX,U,1)\1)_" - "_BPTXT_U_$$USERNAM^BPSCMT01($P(BPX,U,2)) "RTN","BPSSCRU3",15,0) ; "RTN","BPSSCRU3",16,0) DATTIM(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format. "RTN","BPSSCRU3",17,0) I +X=0 W "" "RTN","BPSSCRU3",18,0) N DATE,YR,BPT,BPM,BPH,BPAP "RTN","BPSSCRU3",19,0) I $G(X) S YR=$E(X,2,3) "RTN","BPSSCRU3",20,0) I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"") "RTN","BPSSCRU3",21,0) S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT)) "RTN","BPSSCRU3",22,0) S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4) "RTN","BPSSCRU3",23,0) S BPAP="a" I BPH>12 S BPH=BPH-12,BPAP="p" S:$L(BPH)<2 BPH="0"_BPH "RTN","BPSSCRU3",24,0) I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP "RTN","BPSSCRU3",25,0) Q $G(DATE) "RTN","BPSSCRU3",26,0) ;/** "RTN","BPSSCRU3",27,0) ;a wrapper for $$STATUS^BPSOSRX to get the status by BPS TRANSACTION pointer "RTN","BPSSCRU3",28,0) ;input BP59 - ptr to 9002313.59 "RTN","BPSSCRU3",29,0) ;output - pieces 1,2 and 3 of the $$STATUS^BPSOSRX output "RTN","BPSSCRU3",30,0) ; example: "E REVERSAL ACCEPTED^3071206.152829^Reversal Accepted" "RTN","BPSSCRU3",31,0) CLAIMST(BP59) ;*/ "RTN","BPSSCRU3",32,0) N BPX,BPSTATUS,BPREF,BPSCHED "RTN","BPSSCRU3",33,0) N BPCOB S BPCOB=$$COB59^BPSUTIL2(BP59) "RTN","BPSSCRU3",34,0) S BPSCHED=0 "RTN","BPSSCRU3",35,0) S BPX=$$RXREF^BPSSCRU2(BP59) "RTN","BPSSCRU3",36,0) S BPREF=$P(BPX,U,2) "RTN","BPSSCRU3",37,0) S BPSTATUS=$$STATUS^BPSOSRX(+BPX,BPREF,,,BPCOB) "RTN","BPSSCRU3",38,0) ;if the request completed (99%) and there is another active (scheduled, activated, "RTN","BPSSCRU3",39,0) ;in process,completed but not inactivated yet) request then return IN PROGRESS "RTN","BPSSCRU3",40,0) I $P(BPSTATUS,U,4)=99,$$ACTREQS^BPSOSRX6(+BPX,BPREF,BPCOB) S BPSCHED=1 "RTN","BPSSCRU3",41,0) I BPSCHED I ($P(BPSTATUS,U)="E PAYABLE")!($P(BPSTATUS,U)="E REVERSAL ACCEPTED") Q "IN PROGRESS"_U_$P(BPSTATUS,U,2) "RTN","BPSSCRU3",42,0) Q $P(BPSTATUS,U,1,3) "RTN","BPSSCRU3",43,0) ; "RTN","BPSSCRU3",44,0) ;/** "RTN","BPSSCRU3",45,0) ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59 "RTN","BPSSCRU3",46,0) ;B59 - ptr to #9002313.59 "RTN","BPSSCRU3",47,0) ;BPRESP - ptr to #9002313.03 "RTN","BPSSCRU3",48,0) ;BPPOS - position inside #9002313.03 (i.e. the number "RTN","BPSSCRU3",49,0) ;of the claim in the transmission - currently we always have only 1 "RTN","BPSSCRU3",50,0) GRESPPOS(BP59,BPRESP,BPPOS) ;*/ "RTN","BPSSCRU3",51,0) I $G(^BPST(BP59,4)) D ; reversal kind of message "RTN","BPSSCRU3",52,0) . S BPRESP=+$P(^BPST(BP59,4),U,2) "RTN","BPSSCRU3",53,0) . S BPPOS=1 "RTN","BPSSCRU3",54,0) E D "RTN","BPSSCRU3",55,0) . S BPRESP=+$P($G(^BPST(BP59,0)),U,5) "RTN","BPSSCRU3",56,0) . S BPPOS=+$P($G(^BPST(BP59,0)),U,9) "RTN","BPSSCRU3",57,0) Q:+BPRESP=0 0 "RTN","BPSSCRU3",58,0) Q:+BPPOS=0 0 "RTN","BPSSCRU3",59,0) Q 1 "RTN","BPSSCRU3",60,0) ; "RTN","BPSSCRU3",61,0) ;/** "RTN","BPSSCRU3",62,0) ;Messages from the BPS RESPONSE file "RTN","BPSSCRU3",63,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCRU3",64,0) ;FIELD - what field to get "RTN","BPSSCRU3",65,0) ; "RTN","BPSSCRU3",66,0) GETMESS(FIELD,BP59) ; "RTN","BPSSCRU3",67,0) I '$G(FIELD) Q "" "RTN","BPSSCRU3",68,0) I '$G(BP59) Q "" "RTN","BPSSCRU3",69,0) N BPRESP,BPPOS "RTN","BPSSCRU3",70,0) ; Get response and position in the BPS RESPONSE file "RTN","BPSSCRU3",71,0) I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q "" "RTN","BPSSCRU3",72,0) ; 504-F4 (Message) "RTN","BPSSCRU3",73,0) I FIELD=504 Q $P($G(^BPSR(BPRESP,504)),U) "RTN","BPSSCRU3",74,0) ; 526-FQ (Additional Message Information) - Get first entry of the multiple) "RTN","BPSSCRU3",75,0) I FIELD=526 N MESSAGE,N D Q MESSAGE "RTN","BPSSCRU3",76,0) . N ADDMESS "RTN","BPSSCRU3",77,0) . D ADDMESS^BPSSCRLG(BPRESP,BPPOS,.ADDMESS) "RTN","BPSSCRU3",78,0) . S MESSAGE="" "RTN","BPSSCRU3",79,0) . S N=$O(ADDMESS("")) "RTN","BPSSCRU3",80,0) . I N S MESSAGE=$E(ADDMESS(N),1,200) "RTN","BPSSCRU3",81,0) Q "" "RTN","BPSSCRU3",82,0) ; "RTN","BPSSCRU3",83,0) ;reject message from RESPONSE file "RTN","BPSSCRU3",84,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCRU3",85,0) ;BPARR1 - array to return messages (by ref) "RTN","BPSSCRU3",86,0) ;BPN1 - index for the array (by ref - will "RTN","BPSSCRU3",87,0) ; be incremented if more than one node added) "RTN","BPSSCRU3",88,0) ;BPMLEN - max length for each string "RTN","BPSSCRU3",89,0) ;PBPREF - for prefix string "RTN","BPSSCRU3",90,0) ;compare GETRJCOD from BPSSCRU2 "RTN","BPSSCRU3",91,0) GETRJCOD(BP59,BPARR1,BPN1,BPMLEN,PBPREF) ; "RTN","BPSSCRU3",92,0) N BP59DAT S BP59DAT=$G(^BPST(BP59,0)) "RTN","BPSSCRU3",93,0) N BPRESP,BPPOS "RTN","BPSSCRU3",94,0) N BPRJCOD "RTN","BPSSCRU3",95,0) N BPRJTXT "RTN","BPSSCRU3",96,0) N BPSTR "RTN","BPSSCRU3",97,0) N BPRJ "RTN","BPSSCRU3",98,0) ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59 "RTN","BPSSCRU3",99,0) ;get response and position "RTN","BPSSCRU3",100,0) I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q "RTN","BPSSCRU3",101,0) S BPRJ=0 "RTN","BPSSCRU3",102,0) S BPSTR="" "RTN","BPSSCRU3",103,0) F S BPRJ=$O(^BPSR(BPRESP,1000,BPPOS,511,BPRJ)) Q:+BPRJ=0 D "RTN","BPSSCRU3",104,0) . S BPRJCOD=$P($G(^BPSR(BPRESP,1000,BPPOS,511,BPRJ,0)),U) "RTN","BPSSCRU3",105,0) . Q:$L(BPRJCOD)=0 "RTN","BPSSCRU3",106,0) . S BPRJTXT=$$GETRJNAM(BPRJCOD) "RTN","BPSSCRU3",107,0) . S BPN1=BPN1+1,BPARR1(BPN1)=PBPREF_BPRJTXT "RTN","BPSSCRU3",108,0) Q BPN1 "RTN","BPSSCRU3",109,0) ;/** "RTN","BPSSCRU3",110,0) ;Input: "RTN","BPSSCRU3",111,0) ; BP59 - pointer to file #9002313.59 "RTN","BPSSCRU3",112,0) ;Output: "RTN","BPSSCRU3",113,0) ; BPRCODES - array for reject codes by reference "RTN","BPSSCRU3",114,0) REJCODES(BP59,BPRCODES) ;get reject codes "RTN","BPSSCRU3",115,0) N BPRESP,BPPOS,BPA,BPR "RTN","BPSSCRU3",116,0) ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59 "RTN","BPSSCRU3",117,0) ;get response and position "RTN","BPSSCRU3",118,0) I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q "RTN","BPSSCRU3",119,0) ; "RTN","BPSSCRU3",120,0) S BPA=0 "RTN","BPSSCRU3",121,0) F S BPA=$O(^BPSR(BPRESP,1000,BPPOS,511,BPA)) Q:'BPA D "RTN","BPSSCRU3",122,0) . S BPR=$P(^BPSR(BPRESP,1000,BPPOS,511,BPA,0),U) "RTN","BPSSCRU3",123,0) . I BPR'="" S BPRCODES(BPR)="" "RTN","BPSSCRU3",124,0) Q "RTN","BPSSCRU3",125,0) ;/** "RTN","BPSSCRU3",126,0) ;BPRJCODE - code "RTN","BPSSCRU3",127,0) GETRJNAM(BPRJCODE) ;*/ "RTN","BPSSCRU3",128,0) N BPRJIEN "RTN","BPSSCRU3",129,0) S BPRJIEN=$O(^BPSF(9002313.93,"B",BPRJCODE,0)) "RTN","BPSSCRU3",130,0) Q:+BPRJIEN=0 "" "RTN","BPSSCRU3",131,0) Q BPRJCODE_":"_$P($G(^BPSF(9002313.93,BPRJIEN,0)),U,2) "RTN","BPSSCRU3",132,0) ;/** "RTN","BPSSCRU3",133,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCRU3",134,0) ;was the claim ever autoreversed ? "RTN","BPSSCRU3",135,0) AUTOREV(BP59) ;*/ "RTN","BPSSCRU3",136,0) N BP02 "RTN","BPSSCRU3",137,0) S BP02=+$P($G(^BPST(BP59,0)),U,4) "RTN","BPSSCRU3",138,0) Q +$P($G(^BPSC(BP02,0)),U,7) "RTN","BPSSCRU3",139,0) ; "RTN","BPSSCRU3",140,0) ;/** "RTN","BPSSCRU3",141,0) ;BP59 - ptr to 9002313.59 "RTN","BPSSCRU3",142,0) ;returns : "RTN","BPSSCRU3",143,0) ;0 Waiting to start "RTN","BPSSCRU3",144,0) ;10 Gathering claim info "RTN","BPSSCRU3",145,0) ;19 Special Grouping "RTN","BPSSCRU3",146,0) ;30 Waiting for packet build "RTN","BPSSCRU3",147,0) ;31 Wait for retry (insurer asleep) "RTN","BPSSCRU3",148,0) ;40 Packet being built "RTN","BPSSCRU3",149,0) ;50 Waiting for transmit "RTN","BPSSCRU3",150,0) ;51 Wait for retry (comms error) "RTN","BPSSCRU3",151,0) ;60 Transmitting "RTN","BPSSCRU3",152,0) ;70 Receiving Response "RTN","BPSSCRU3",153,0) ;80 Waiting to process response "RTN","BPSSCRU3",154,0) ;90 Processing response "RTN","BPSSCRU3",155,0) ;99 Done "RTN","BPSSCRU3",156,0) ; "RTN","BPSSCRU3",157,0) PRCNTG(BP59) ;*/ "RTN","BPSSCRU3",158,0) Q +$P($G(^BPST(BP59,0)),U,2) "RTN","BPSSCRU3",159,0) ; "RTN","BPSSCRU3",160,0) ; "RTN","BPSSCRU3",161,0) LINE(BPN,BPCH) ; "RTN","BPSSCRU3",162,0) N BP1 "RTN","BPSSCRU3",163,0) S $P(BP1,BPCH,BPN+1)="" "RTN","BPSSCRU3",164,0) Q BP1 "RTN","BPSSCRU3",165,0) ; "RTN","BPSSCRU3",166,0) DTTIME(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format. "RTN","BPSSCRU3",167,0) I +X=0 W "" "RTN","BPSSCRU3",168,0) N DATE,YR,BPT,BPM,BPH,BPAP,BPS "RTN","BPSSCRU3",169,0) I $G(X) S YR=$E(X,1,3)+1700 "RTN","BPSSCRU3",170,0) I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"") "RTN","BPSSCRU3",171,0) S BPT=$P(X,".",2) "RTN","BPSSCRU3",172,0) I BPT S:$L(BPT)<6 BPT=BPT_$E("000000",1,6-$L(BPT)) "RTN","BPSSCRU3",173,0) S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4),BPS=$E(BPT,5,6) "RTN","BPSSCRU3",174,0) I BPT S DATE=DATE_"@"_BPH_":"_BPM_":"_BPS "RTN","BPSSCRU3",175,0) Q $G(DATE) "RTN","BPSSCRU3",176,0) ; "RTN","BPSSCRU3",177,0) ;call IB API to get insurance data, then select proper insurance by its name "RTN","BPSSCRU3",178,0) ;get its phone number "RTN","BPSSCRU3",179,0) ;input: "RTN","BPSSCRU3",180,0) ; DFN - patient IEN in #2 "RTN","BPSSCRU3",181,0) ; BPDOS - date of service "RTN","BPSSCRU3",182,0) ; BPINSNM - insurance name "RTN","BPSSCRU3",183,0) ;output: insurance ien^insurance name^phone "RTN","BPSSCRU3",184,0) GETPHONE(BPDFN,BPDOS,BPINSNM) ; "RTN","BPSSCRU3",185,0) N BPX,BPZZ,BP1,BPPHONE "RTN","BPSSCRU3",186,0) S BPPHONE="" "RTN","BPSSCRU3",187,0) I $$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,6")'=1 Q "" "RTN","BPSSCRU3",188,0) S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D "RTN","BPSSCRU3",189,0) . I BPINSNM=$P($G(BPZZ("IBBAPI","INSUR",BP1,1)),U,2) S BPPHONE=$G(BPZZ("IBBAPI","INSUR",BP1,6)) Q "RTN","BPSSCRU3",190,0) Q BPPHONE "RTN","BPSSCRU3",191,0) ; "RTN","BPSSCRU3",192,0) ;try to get insurance name and phone from #9002313.59, #9002313.57 and from INSUR^IBBAPI "RTN","BPSSCRU3",193,0) ;input: BP59 - ien in #9002313.59 "RTN","BPSSCRU3",194,0) ;return insurance_name^phone# "RTN","BPSSCRU3",195,0) NAMEPHON(BP59) ; "RTN","BPSSCRU3",196,0) N BPHONE,BPINSNM,BPINSID,BP57,BPINSN "RTN","BPSSCRU3",197,0) S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2) "RTN","BPSSCRU3",198,0) S BPINSNM=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),0)),U,7) "RTN","BPSSCRU3",199,0) S BP57=0 "RTN","BPSSCRU3",200,0) F Q:(BPHONE'="")&(BPINSNM'="") S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D "RTN","BPSSCRU3",201,0) . S BPINSN=+$G(^BPSTL(BP57,9)) "RTN","BPSSCRU3",202,0) . S:BPHONE="" BPHONE=$P($G(^BPSTL(BP57,10,BPINSN,3)),U,2) "RTN","BPSSCRU3",203,0) . S:BPINSNM="" BPINSNM=$P($G(^BPSTL(BP57,10,BPINSN,0)),U,7) "RTN","BPSSCRU3",204,0) ; "RTN","BPSSCRU3",205,0) I (BPINSNM'="")&(BPHONE="") D "RTN","BPSSCRU3",206,0) . S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1 "RTN","BPSSCRU3",207,0) . I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1 "RTN","BPSSCRU3",208,0) . S BPDFN=+$P($G(^BPST(BP59,0)),U,6) "RTN","BPSSCRU3",209,0) . S BPHONE=$$GETPHONE(BPDFN,BPDOS,BPINSNM) "RTN","BPSSCRU3",210,0) Q BPINSNM_U_BPHONE "RTN","BPSSCRU3",211,0) ; "RTN","BPSSCRU5") 0^67^B61949980 "RTN","BPSSCRU5",1,0) BPSSCRU5 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05 "RTN","BPSSCRU5",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27 "RTN","BPSSCRU5",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCRU5",4,0) ;USER SCREEN "RTN","BPSSCRU5",5,0) Q "RTN","BPSSCRU5",6,0) ; "RTN","BPSSCRU5",7,0) DATETIME(Y) ;EP - convert fileman date.time to printable "RTN","BPSSCRU5",8,0) X ^DD("DD") "RTN","BPSSCRU5",9,0) Q Y "RTN","BPSSCRU5",10,0) ; "RTN","BPSSCRU5",11,0) ;create a history of claims and responses in #9002313.57 file "RTN","BPSSCRU5",12,0) ;record for the specified transaction in #9002313.59 file "RTN","BPSSCRU5",13,0) ;input: "RTN","BPSSCRU5",14,0) ; BP59 - ptr to #9002313.59 "RTN","BPSSCRU5",15,0) ; BPHIST - array to return results "RTN","BPSSCRU5",16,0) ;output: "RTN","BPSSCRU5",17,0) ; Array in BPHIST with the format: "RTN","BPSSCRU5",18,0) ; BPHIST(type,timedate,PointerToResponseClaimFile)=PointerTo#9002313.57^request type "RTN","BPSSCRU5",19,0) ; where: "RTN","BPSSCRU5",20,0) ; request type - "C" - billing request, "R" - reversal request "RTN","BPSSCRU5",21,0) ; type "C" - BPS CLAIM file, "R" - BPS RESPONSE file "RTN","BPSSCRU5",22,0) ; PointerToResponseClaimFile - pointer to 9002313.03 or 9002313.02 "RTN","BPSSCRU5",23,0) MKHIST(BP59,BPHIST) ; "RTN","BPSSCRU5",24,0) N BP57,BPLSTCLM,BPLSTRSP,BPDAT57,BP1,BPSSTDT "RTN","BPSSCRU5",25,0) S BP57=0 "RTN","BPSSCRU5",26,0) N BPSARR02 "RTN","BPSSCRU5",27,0) N BPSARR03 "RTN","BPSSCRU5",28,0) ; -- process BPS LOG OF TRANSACTIONS file "RTN","BPSSCRU5",29,0) F S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D "RTN","BPSSCRU5",30,0) . ;claim transmissions "RTN","BPSSCRU5",31,0) . S BPDAT57(0)=$G(^BPSTL(BP57,0)) "RTN","BPSSCRU5",32,0) . S BPSSTDT=+$P(BPDAT57(0),U,11) ;start time "RTN","BPSSCRU5",33,0) . S BPLSTCLM=+$P(BPDAT57(0),U,4) ;claim "RTN","BPSSCRU5",34,0) . I BPLSTCLM>0 D "RTN","BPSSCRU5",35,0) . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on "RTN","BPSSCRU5",36,0) . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on "RTN","BPSSCRU5",37,0) . . ;old BPS CLAIMS recs don't have dates, so use START TIME from .57 file but "RTN","BPSSCRU5",38,0) . . ;only at the very first time (using $D for this) "RTN","BPSSCRU5",39,0) . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT "RTN","BPSSCRU5",40,0) . . I BP1 I '$D(BPHIST("C",BP1,BPLSTCLM)) S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"C" "RTN","BPSSCRU5",41,0) . S BPLSTRSP=+$P(BPDAT57(0),U,5) ;response "RTN","BPSSCRU5",42,0) . I BPLSTRSP>0 D "RTN","BPSSCRU5",43,0) . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on "RTN","BPSSCRU5",44,0) . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT "RTN","BPSSCRU5",45,0) . . I BP1 I '$D(BPHIST("R",BP1,BPLSTRSP)) S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"C" "RTN","BPSSCRU5",46,0) . ;reversal transmissions "RTN","BPSSCRU5",47,0) . S BPDAT57(4)=$G(^BPSTL(BP57,4)) "RTN","BPSSCRU5",48,0) . S BPLSTCLM=+$P(BPDAT57(4),U,1) ;reversal "RTN","BPSSCRU5",49,0) . I BPLSTCLM>0 D "RTN","BPSSCRU5",50,0) . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on "RTN","BPSSCRU5",51,0) . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on "RTN","BPSSCRU5",52,0) . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT "RTN","BPSSCRU5",53,0) . . I BP1 I '$D(BPHIST("C",BP1,BPLSTCLM)) S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"R" "RTN","BPSSCRU5",54,0) . S BPLSTRSP=+$P(BPDAT57(4),U,2) ;reversal response "RTN","BPSSCRU5",55,0) . I BPLSTRSP>0 D "RTN","BPSSCRU5",56,0) . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on "RTN","BPSSCRU5",57,0) . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT "RTN","BPSSCRU5",58,0) . . I BP1 I '$D(BPHIST("R",BP1,BPLSTRSP)) S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"R" "RTN","BPSSCRU5",59,0) ;-------- "RTN","BPSSCRU5",60,0) ;sorting: pairs (send/respond) in reversed chronological order "RTN","BPSSCRU5",61,0) N BPCLDT1,BPCLIEN,BPRSDT1,BPRSIEN,BPCLDT2 "RTN","BPSSCRU5",62,0) S BPCLDT1=0 "RTN","BPSSCRU5",63,0) F S BPCLDT1=$O(BPHIST("C",BPCLDT1)) Q:BPCLDT1="" D "RTN","BPSSCRU5",64,0) . S BPCLIEN=$O(BPHIST("C",BPCLDT1,0)) Q:BPCLIEN="" D "RTN","BPSSCRU5",65,0) . . S BPCLDT2=+$O(BPHIST("C",BPCLDT1)) "RTN","BPSSCRU5",66,0) . . I BPCLDT2=0 S BPCLDT2=9999999 "RTN","BPSSCRU5",67,0) . . S BPRSDT1=BPCLDT1 "RTN","BPSSCRU5",68,0) . . F S BPRSDT1=$O(BPHIST("R",BPRSDT1)) Q:BPRSDT1=""!(BPRSDT1>BPCLDT2) D "RTN","BPSSCRU5",69,0) . . . S BPRSIEN=$O(BPHIST("R",BPRSDT1,0)) Q:BPRSIEN="" D "RTN","BPSSCRU5",70,0) . . . . S BPHIST("C",BPCLDT1,BPCLIEN,"R",BPRSIEN)=BPHIST("R",BPRSDT1,BPRSIEN) "RTN","BPSSCRU5",71,0) ; "RTN","BPSSCRU5",72,0) Q "RTN","BPSSCRU5",73,0) ;returns text for the transaction code in file #9002313.02 -- BPS CLAIMS FILE "RTN","BPSSCRU5",74,0) TRTYPE(BPTRCD) ; "RTN","BPSSCRU5",75,0) I BPTRCD="E1" Q "Eligibility Verification" "RTN","BPSSCRU5",76,0) I BPTRCD="B1" Q "REQUEST" ;"Billing" "RTN","BPSSCRU5",77,0) I BPTRCD="B2" Q "REVERSAL" ; "Reversal" "RTN","BPSSCRU5",78,0) I BPTRCD="B3" Q "Rebill" "RTN","BPSSCRU5",79,0) I BPTRCD="P1" Q "P.A. Request & Billing" "RTN","BPSSCRU5",80,0) I BPTRCD="P2" Q "P.A. Reversal" "RTN","BPSSCRU5",81,0) I BPTRCD="P3" Q "P.A. Inquiry" "RTN","BPSSCRU5",82,0) I BPTRCD="P4" Q "P.A. Request Only" "RTN","BPSSCRU5",83,0) I BPTRCD="N1" Q "Information Reporting" "RTN","BPSSCRU5",84,0) I BPTRCD="N2" Q "Information Reporting Reversal" "RTN","BPSSCRU5",85,0) I BPTRCD="N3" Q "Information Reporting Rebill" "RTN","BPSSCRU5",86,0) I BPTRCD="C1" Q "Controlled Substance Reporting" "RTN","BPSSCRU5",87,0) I BPTRCD="C2" Q "Controlled Substance Reporting Reversal" "RTN","BPSSCRU5",88,0) I BPTRCD="C3" Q "Controlled Substance Reporting Rebill" "RTN","BPSSCRU5",89,0) Q "" "RTN","BPSSCRU5",90,0) ; "RTN","BPSSCRU5",91,0) ;get NDC for LOG "RTN","BPSSCRU5",92,0) ;BPIEN02 - IEN in #9002313.02 file "RTN","BPSSCRU5",93,0) LNDC(BPIEN02) ; "RTN","BPSSCRU5",94,0) N BPDAT02,BPNDC "RTN","BPSSCRU5",95,0) S BPDAT02(400)=$G(^BPSC(BPIEN02,400,1,400)) "RTN","BPSSCRU5",96,0) S BPNDC=$E($P(BPDAT02(400),U,7),3,99) "RTN","BPSSCRU5",97,0) S BPNDC=$E(BPNDC,1,5)_"-"_$E(BPNDC,6,9)_"-"_$E(BPNDC,10,11) "RTN","BPSSCRU5",98,0) Q BPNDC "RTN","BPSSCRU5",99,0) ;prepares array of reject codes "RTN","BPSSCRU5",100,0) ; BPIEN03 - IEN in #9002313.03 file "RTN","BPSSCRU5",101,0) ; BPRCODES - array to return results "RTN","BPSSCRU5",102,0) REJCODES(BPIEN03,BPRCODES) ; "RTN","BPSSCRU5",103,0) N BPA,BPR "RTN","BPSSCRU5",104,0) S BPA=0 "RTN","BPSSCRU5",105,0) F S BPA=$O(^BPSR(BPIEN03,1000,1,511,BPA)) Q:'BPA D "RTN","BPSSCRU5",106,0) . S BPR=$P(^BPSR(BPIEN03,1000,1,511,BPA,0),U) "RTN","BPSSCRU5",107,0) . I BPR'="" S BPRCODES(BPR)="" "RTN","BPSSCRU5",108,0) Q "RTN","BPSSCRU5",109,0) ;status of the response "RTN","BPSSCRU5",110,0) RESPSTAT(BPIEN03) ; "RTN","BPSSCRU5",111,0) N BP1 "RTN","BPSSCRU5",112,0) S BP1=$P($G(^BPSR(BPIEN03,1000,1,110)),U,2) "RTN","BPSSCRU5",113,0) Q:BP1="A" "Approved" "RTN","BPSSCRU5",114,0) Q:BP1="C" "Captured" "RTN","BPSSCRU5",115,0) Q:BP1="D" "Duplicate of Paid" "RTN","BPSSCRU5",116,0) Q:BP1="F" "PA Deferred" "RTN","BPSSCRU5",117,0) Q:BP1="P" "Paid" "RTN","BPSSCRU5",118,0) Q:BP1="Q" "Duplicate of Capture" "RTN","BPSSCRU5",119,0) Q:BP1="R" "Rejected" "RTN","BPSSCRU5",120,0) Q:BP1="S" "Duplicate of Approved" "RTN","BPSSCRU5",121,0) Q "" "RTN","BPSSCRU5",122,0) ; "RTN","BPSSCRU5",123,0) ;Electronic payer - ptr to #9002313.92 "RTN","BPSSCRU5",124,0) ;BPIEN02 - ptr in #9002313.02 "RTN","BPSSCRU5",125,0) B1PYRIEN(BP57) ; "RTN","BPSSCRU5",126,0) N BPX,BPX2 "RTN","BPSSCRU5",127,0) S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,2) "RTN","BPSSCRU5",128,0) S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U) "RTN","BPSSCRU5",129,0) Q BPX "RTN","BPSSCRU5",130,0) ; "RTN","BPSSCRU5",131,0) ;BPIEN02 - ptr in #9002313.02 "RTN","BPSSCRU5",132,0) B2PYRIEN(BP57) ; "RTN","BPSSCRU5",133,0) N BPX,BPX2 "RTN","BPSSCRU5",134,0) S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,3) "RTN","BPSSCRU5",135,0) S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U) "RTN","BPSSCRU5",136,0) Q BPX "RTN","BPSSCRU5",137,0) ; "RTN","BPSSCRU5",138,0) ;B3 payer sheet "RTN","BPSSCRU5",139,0) B3PYRIEN(BP57) ; "RTN","BPSSCRU5",140,0) N BPX,BPX2 "RTN","BPSSCRU5",141,0) S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,4) "RTN","BPSSCRU5",142,0) S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U) "RTN","BPSSCRU5",143,0) Q BPX "RTN","BPSSCRU5",144,0) ; "RTN","BPSSCRU5",145,0) ; "RTN","BPSSCRU5",146,0) ;BPLN= line to use in SETLINE "RTN","BPSSCRU5",147,0) ;BPX - long string to display "RTN","BPSSCRU5",148,0) ;BPMLEN - max length "RTN","BPSSCRU5",149,0) ;BPPREFX - prefix string "RTN","BPSSCRU5",150,0) ;BPMARG - left margin "RTN","BPSSCRU5",151,0) WRAPLN(BPLN,BPX,BPMLEN,BPPREFX,BPMARG) ; "RTN","BPSSCRU5",152,0) N BPQ,BPLEN,BPXX "RTN","BPSSCRU5",153,0) S BPQ=0 "RTN","BPSSCRU5",154,0) S BPLEN=BPMLEN-$L(BPPREFX) "RTN","BPSSCRU5",155,0) S BPXX=$E(BPX,1,BPLEN) "RTN","BPSSCRU5",156,0) D SETLINE^BPSSCRLG(.BPLN,BPPREFX_BPXX) "RTN","BPSSCRU5",157,0) S BPX=$E(BPX,BPLEN+1,9999) "RTN","BPSSCRU5",158,0) I $L(BPX)<1 Q "RTN","BPSSCRU5",159,0) S BPLEN=BPMLEN-BPMARG "RTN","BPSSCRU5",160,0) F D Q:BPQ=1 "RTN","BPSSCRU5",161,0) . S BPXX=$E(BPX,1,BPLEN) "RTN","BPSSCRU5",162,0) . D SETLINE^BPSSCRLG(.BPLN,$$SPACES(BPMARG)_BPXX) "RTN","BPSSCRU5",163,0) . S BPX=$E(BPX,BPLEN+1,9999) "RTN","BPSSCRU5",164,0) . I $L(BPX)<1 S BPQ=1 "RTN","BPSSCRU5",165,0) Q "RTN","BPSSCRU5",166,0) ; "RTN","BPSSCRU5",167,0) ;to prepare spaces "RTN","BPSSCRU5",168,0) SPACES(BPN) ; "RTN","BPSSCRU5",169,0) N BPX "RTN","BPSSCRU5",170,0) S $P(BPX," ",BPN+1)="" "RTN","BPSSCRU5",171,0) Q BPX "RTN","BPSSCRU5",172,0) ; "RTN","BPSSCRU5",173,0) ;BPN= line counter (index) "RTN","BPSSCRU5",174,0) ;BPARR - array for lines "RTN","BPSSCRU5",175,0) ;BPX - long string to display "RTN","BPSSCRU5",176,0) ;BPMLEN - mas length "RTN","BPSSCRU5",177,0) ;BPPREFX - prefix string "RTN","BPSSCRU5",178,0) ;BPMARG - left margin "RTN","BPSSCRU5",179,0) WRAPLN2(BPN,BPARR,BPX,BPMLEN,BPPREFX,BPMARG) ; "RTN","BPSSCRU5",180,0) N BPQ,BPLEN,BPXX "RTN","BPSSCRU5",181,0) S BPQ=0 "RTN","BPSSCRU5",182,0) S BPLEN=BPMLEN-$L(BPPREFX) "RTN","BPSSCRU5",183,0) S BPXX=$E(BPX,1,BPLEN) "RTN","BPSSCRU5",184,0) D SETLN(.BPN,.BPARR,BPPREFX_BPXX) "RTN","BPSSCRU5",185,0) S BPX=$E(BPX,BPLEN+1,9999) "RTN","BPSSCRU5",186,0) I $L(BPX)<1 Q "RTN","BPSSCRU5",187,0) S BPLEN=BPMLEN-BPMARG "RTN","BPSSCRU5",188,0) F D Q:BPQ=1 "RTN","BPSSCRU5",189,0) . S BPXX=$E(BPX,1,BPLEN) "RTN","BPSSCRU5",190,0) . D SETLN(.BPN,.BPARR,$$SPACES(BPMARG)_BPXX) "RTN","BPSSCRU5",191,0) . S BPX=$E(BPX,BPLEN+1,9999) "RTN","BPSSCRU5",192,0) . I $L(BPX)<1 S BPQ=1 "RTN","BPSSCRU5",193,0) Q "RTN","BPSSCRU5",194,0) ; "RTN","BPSSCRU5",195,0) ; "RTN","BPSSCRU5",196,0) SETLN(BPN,BPARR,BPTXT) ; "RTN","BPSSCRU5",197,0) S BPN=BPN+1,BPARR(BPN)=BPTXT "RTN","BPSSCRU5",198,0) Q "RTN","BPSSCRU5",199,0) ;--- "RTN","BPSSCRU5",200,0) ;check 2nd insurance "RTN","BPSSCRU5",201,0) ;if there then ask user and print message "RTN","BPSSCRU5",202,0) CH2NDINS(BP59,BPPATNAM,BPINSNAM,BPRXINFO) ; "RTN","BPSSCRU5",203,0) N BPRETV "RTN","BPSSCRU5",204,0) S BPRETV=$$NEXTINS^BPSSCRCL(BP59,BPINSNAM) "RTN","BPSSCRU5",205,0) Q:+BPRETV=0 "RTN","BPSSCRU5",206,0) D PRN(BPPATNAM,BPRETV,.BPRXINFO,"S") "RTN","BPSSCRU5",207,0) W !! "RTN","BPSSCRU5",208,0) I $$YESNO^BPSSCRRS("Do you want to print the information (above) concerning additional insurance? (Y/N)")'=1 Q "RTN","BPSSCRU5",209,0) D PRN(BPPATNAM,BPRETV,.BPRXINFO,"P") "RTN","BPSSCRU5",210,0) Q "RTN","BPSSCRU5",211,0) ; "RTN","BPSSCRU5",212,0) ;BPPRNFL "RTN","BPSSCRU5",213,0) ; S- print to screen "RTN","BPSSCRU5",214,0) PRN(BPPATNAM,BPRETV,BPRXINFO,BPPRNFL) ; "RTN","BPSSCRU5",215,0) I BPPRNFL="S" W @IOF D MS2NDINS Q "RTN","BPSSCRU5",216,0) D PRINT("MS2NDINS^BPSSCRU5","BPS 2ND INSURANCE INFO","BP*") "RTN","BPSSCRU5",217,0) W !! "RTN","BPSSCRU5",218,0) Q "RTN","BPSSCRU5",219,0) ; "RTN","BPSSCRU5",220,0) MS2NDINS ; "RTN","BPSSCRU5",221,0) N Y,Z "RTN","BPSSCRU5",222,0) W !,"This patient has ADDITIONAL insurance with Rx Coverage that may be" "RTN","BPSSCRU5",223,0) W !,"used to bill this claim. The system will change the CT entry to a" "RTN","BPSSCRU5",224,0) W !,"NON-BILLABLE Episode. If appropriate, please go to the ECME Pharmacy" "RTN","BPSSCRU5",225,0) W !,"COB menu and use the PRO - Process Secondary/TRICARE Rx to ECME" "RTN","BPSSCRU5",226,0) W !,"option to create an ePharmacy secondary claim." "RTN","BPSSCRU5",227,0) W !!,"Patient: ",?18,BPPATNAM "RTN","BPSSCRU5",228,0) S Y=$P(BPRETV,U,4)\1 D DD^%DT "RTN","BPSSCRU5",229,0) W !,"Date of service: ",?18,Y "RTN","BPSSCRU5",230,0) W !,"Insurance: ",?18,$P(BPRETV,U,2) "RTN","BPSSCRU5",231,0) W !,"Group number: ",?18,$P(BPRETV,U,3) "RTN","BPSSCRU5",232,0) S Z=0 F S Z=$O(BPRXINFO(Z)) Q:+Z=0 W !,BPRXINFO(Z) "RTN","BPSSCRU5",233,0) Q "RTN","BPSSCRU5",234,0) ; "RTN","BPSSCRU5",235,0) ;Prints report "RTN","BPSSCRU5",236,0) ;propmpts user to choose device (including queuing) "RTN","BPSSCRU5",237,0) ;TXTSRC - name of the report's entry point "RTN","BPSSCRU5",238,0) ;DESCR - description for the Task Manager "RTN","BPSSCRU5",239,0) ;SAVEVARS - mask for vars that need to be available in the report "RTN","BPSSCRU5",240,0) ; (exmpl: "BP*") "RTN","BPSSCRU5",241,0) PRINT(TXTSRC,DESCR,SAVEVARS) ; "RTN","BPSSCRU5",242,0) N Y,QUITVAR,SCRFLAG "RTN","BPSSCRU5",243,0) S (QUITVAR,SCRFLAG)=0 "RTN","BPSSCRU5",244,0) D DEVICE Q:QUITVAR "RTN","BPSSCRU5",245,0) D @TXTSRC "RTN","BPSSCRU5",246,0) D ^%ZISC "RTN","BPSSCRU5",247,0) I QUITVAR W !,"Cancelled" "RTN","BPSSCRU5",248,0) Q "RTN","BPSSCRU5",249,0) ; "RTN","BPSSCRU5",250,0) DEVICE ; "RTN","BPSSCRU5",251,0) N DIR,DIRUT,POP "RTN","BPSSCRU5",252,0) N ZTRTN,ZTIO,ZTSAVE,ZTDESC,%ZIS "RTN","BPSSCRU5",253,0) K IO("Q") S %ZIS="QM" "RTN","BPSSCRU5",254,0) W ! D ^%ZIS "RTN","BPSSCRU5",255,0) I POP S QUITVAR=1 Q "RTN","BPSSCRU5",256,0) S SCRFLAG=$S($E($G(IOST),1,2)="C-":1,1:0) "RTN","BPSSCRU5",257,0) I $D(IO("Q")) D S QUITVAR=1 "RTN","BPSSCRU5",258,0) . S ZTRTN=TXTSRC "RTN","BPSSCRU5",259,0) . S ZTIO=ION "RTN","BPSSCRU5",260,0) . S ZTSAVE(SAVEVARS)="" "RTN","BPSSCRU5",261,0) . S ZTDESC=DESCR "RTN","BPSSCRU5",262,0) . D ^%ZTLOAD "RTN","BPSSCRU5",263,0) . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") "RTN","BPSSCRU5",264,0) . D HOME^%ZIS "RTN","BPSSCRU5",265,0) U IO "RTN","BPSSCRU5",266,0) Q "RTN","BPSSCRU5",267,0) ; "RTN","BPSSCRU6") 0^85^B17791929 "RTN","BPSSCRU6",1,0) BPSSCRU6 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;22-MAY-06 "RTN","BPSSCRU6",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**3,8,10**;JUN 2004;Build 27 "RTN","BPSSCRU6",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSSCRU6",4,0) ;USER SCREEN "RTN","BPSSCRU6",5,0) Q "RTN","BPSSCRU6",6,0) ; "RTN","BPSSCRU6",7,0) ;Input: "RTN","BPSSCRU6",8,0) ; BP59 - "RTN","BPSSCRU6",9,0) ;Output: "RTN","BPSSCRU6",10,0) ; "RTN","BPSSCRU6",11,0) DISPREJ(BP59) ; "RTN","BPSSCRU6",12,0) I '$G(BP59) Q "RTN","BPSSCRU6",13,0) N BPARR,BPN,BPCNT "RTN","BPSSCRU6",14,0) S BPN=0 "RTN","BPSSCRU6",15,0) D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"") "RTN","BPSSCRU6",16,0) D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0) "RTN","BPSSCRU6",17,0) D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0) "RTN","BPSSCRU6",18,0) I BPN=0 Q "RTN","BPSSCRU6",19,0) S BPCNT=0 "RTN","BPSSCRU6",20,0) F S BPCNT=$O(BPARR(BPCNT)) Q:+BPCNT=0 D "RTN","BPSSCRU6",21,0) . W:$L(BPARR(BPCNT)) !,?6,BPARR(BPCNT) "RTN","BPSSCRU6",22,0) Q "RTN","BPSSCRU6",23,0) ; "RTN","BPSSCRU6",24,0) ;return Date in specified format "RTN","BPSSCRU6",25,0) ;BPDT - date in FileMan format "RTN","BPSSCRU6",26,0) ;BPMODE: "RTN","BPSSCRU6",27,0) ; 1- like "JUL 23, 2005" "RTN","BPSSCRU6",28,0) ; 2- like "JUL 23, 2005@16:03 " "RTN","BPSSCRU6",29,0) ; 3- MM/DD/YY "RTN","BPSSCRU6",30,0) FORMDATE(BPDT,BPMODE) ; "RTN","BPSSCRU6",31,0) N Y,BPTIME,BPHR "RTN","BPSSCRU6",32,0) I $G(BPDT)=0 Q "" "RTN","BPSSCRU6",33,0) I BPMODE=1 S Y=BPDT\1 X ^DD("DD") Q Y "RTN","BPSSCRU6",34,0) I BPMODE=2 S Y=BPDT X ^DD("DD") Q Y "RTN","BPSSCRU6",35,0) I BPMODE=3 S Y=$E(BPDT,4,5)_"/"_$E(BPDT,6,7)_"/"_$E(BPDT,2,3) Q Y "RTN","BPSSCRU6",36,0) Q "" "RTN","BPSSCRU6",37,0) ; "RTN","BPSSCRU6",38,0) ;Generic function to ask a date "RTN","BPSSCRU6",39,0) ;Input: "RTN","BPSSCRU6",40,0) ;BPPROMPT - prompt like "START WITH DATE: " "RTN","BPSSCRU6",41,0) ;BPDFLDT - default for the prompt like "TODAY" or "T" or "T-100" or 12/12/2005 "RTN","BPSSCRU6",42,0) ;output: "RTN","BPSSCRU6",43,0) ; 0 - nothing "RTN","BPSSCRU6",44,0) ; <0 quit "RTN","BPSSCRU6",45,0) ; >0 fileman date "RTN","BPSSCRU6",46,0) ASKDATE(BPPROMPT,BPDFLDT) ; "RTN","BPSSCRU6",47,0) S %DT="AEX" "RTN","BPSSCRU6",48,0) S %DT("A")=BPPROMPT,%DT("B")=BPDFLDT "RTN","BPSSCRU6",49,0) D ^%DT K %DT "RTN","BPSSCRU6",50,0) I Y<0 Q -1 "RTN","BPSSCRU6",51,0) Q +Y "RTN","BPSSCRU6",52,0) ;Release date "RTN","BPSSCRU6",53,0) ;RXNO - RX ien #52 "RTN","BPSSCRU6",54,0) ;REFNO - fill number (0=original) "RTN","BPSSCRU6",55,0) RELDATE(RXNO,REFNO) ; "RTN","BPSSCRU6",56,0) I REFNO=0 Q $$RXRELDT^BPSSCRU2(+RXNO) "RTN","BPSSCRU6",57,0) Q $$REFRELDT^BPSSCRU2(+RXNO,REFNO) "RTN","BPSSCRU6",58,0) ; "RTN","BPSSCRU6",59,0) ;Group name/Plan name - name originally comes from file #355.3 by BPS TRANSACTION file ien "RTN","BPSSCRU6",60,0) PLANNAME(BP59) ; "RTN","BPSSCRU6",61,0) N BPPLNM "RTN","BPSSCRU6",62,0) S BPPLNM=$P($G(^BPST(BP59,10,1,3)),U) "RTN","BPSSCRU6",63,0) S:BPPLNM="" BPPLNM=$P($G(^BPST(BP59,10,1,1)),U,3) "RTN","BPSSCRU6",64,0) Q BPPLNM "RTN","BPSSCRU6",65,0) ;Insurance name - name originally comes from file #36 by BPS TRANSACTION file ien "RTN","BPSSCRU6",66,0) INSNAME(BP59) ; "RTN","BPSSCRU6",67,0) Q $P($G(^BPST(BP59,10,1,0)),U,7) "RTN","BPSSCRU6",68,0) ; "RTN","BPSSCRU6",69,0) ;Returns close reason by ien file#356.8 "RTN","BPSSCRU6",70,0) CLREASON(BP3568) ; "RTN","BPSSCRU6",71,0) Q $P($G(^IBE(356.8,BP3568,0)),U) "RTN","BPSSCRU6",72,0) ; "RTN","BPSSCRU6",73,0) ;Convert YYYYMMDD to FileMan format "RTN","BPSSCRU6",74,0) YMD2FM(BPYMD) ; "RTN","BPSSCRU6",75,0) Q ($E(BPYMD,1,4)-1700)_$E(BPYMD,5,8) "RTN","BPSSCRU6",76,0) ; "RTN","BPSSCRU6",77,0) ;get DRUG ien from PRESCRIPTION file "RTN","BPSSCRU6",78,0) DRUGIEN(BP52,BPDFN) ; "RTN","BPSSCRU6",79,0) N XZ "RTN","BPSSCRU6",80,0) S XZ=0 "RTN","BPSSCRU6",81,0) K ^TMP($J,"BPSDRUG") "RTN","BPSSCRU6",82,0) D RX^PSO52API(BPDFN,"BPSDRUG",BP52,,"") "RTN","BPSSCRU6",83,0) S XZ=$G(^TMP($J,"BPSDRUG",BPDFN,BP52,6)) "RTN","BPSSCRU6",84,0) K ^TMP($J,"BPSDRUG") "RTN","BPSSCRU6",85,0) Q +$P(XZ,U) "RTN","BPSSCRU6",86,0) ; "RTN","BPSSCRU6",87,0) ; "RTN","BPSSCRU6",88,0) CONVCLID(BPCLID) ; "RTN","BPSSCRU6",89,0) Q $P(BPCLID,"D2",2) "RTN","BPSSCRU6",90,0) ; "RTN","BPSSCRU6",91,0) ;Return claim status "RTN","BPSSCRU6",92,0) COBCLST(BP59) ; "RTN","BPSSCRU6",93,0) N BPTXT1,BPX,BPSTATUS,BPCOBIND,BPCOB "RTN","BPSSCRU6",94,0) S BPCOBIND=$P(^BPST(BP59,0),U,14) "RTN","BPSSCRU6",95,0) S BPSCOB=$S($G(BPCOBIND)>0:$G(BPCOBIND),1:1) "RTN","BPSSCRU6",96,0) S BPTXT1=$S(BPSCOB=2:"s-",BPSCOB=3:"t-",1:"p-") "RTN","BPSSCRU6",97,0) S BPX=$$CLAIMST^BPSSCRU3(BP59) "RTN","BPSSCRU6",98,0) S BPSTATUS=$P(BPX,U) "RTN","BPSSCRU6",99,0) I BPSTATUS["E REVERSAL ACCEPTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal accepted") "RTN","BPSSCRU6",100,0) I BPSTATUS["E REVERSAL REJECTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal rejected") "RTN","BPSSCRU6",101,0) I BPSTATUS["E PAYABLE" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Payable") "RTN","BPSSCRU6",102,0) I BPSTATUS["E REJECTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Rejected") "RTN","BPSSCRU6",103,0) I BPSTATUS["E UNSTRANDED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded") "RTN","BPSSCRU6",104,0) I BPSTATUS["E REVERSAL UNSTRANDED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded reversal") "RTN","BPSSCRU6",105,0) I BPSTATUS["E CAPTURED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Captured") "RTN","BPSSCRU6",106,0) I BPSTATUS["E DUPLICATE" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Duplicate") "RTN","BPSSCRU6",107,0) I BPSTATUS["E OTHER" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Other") "RTN","BPSSCRU6",108,0) I BPSTATUS["IN PROGRESS" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"In progress") "RTN","BPSSCRU6",109,0) I BPSTATUS["CORRUPT" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Corrupt") "RTN","BPSSCRU6",110,0) I BPSTATUS["E REVERSAL OTHER" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal Other") "RTN","BPSSCRU6",111,0) I BPTXT1="" S BPTXT1="Unknown status " "RTN","BPSSCRU6",112,0) Q BPTXT1 "RTN","BPSTEST") 0^74^B93493261 "RTN","BPSTEST",1,0) BPSTEST ;OAK/ELZ - ECME TESTING TOOL ;11/15/07 09:55 "RTN","BPSTEST",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**6,7,8,10**;JUN 2004;Build 27 "RTN","BPSTEST",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSTEST",4,0) ; "RTN","BPSTEST",5,0) ; "RTN","BPSTEST",6,0) GETOVER(KEY1,KEY2,BPSORESP,BPSWHERE,BPSTYPE,BPPAYSEQ) ; "RTN","BPSTEST",7,0) ; called by BPSNCPDP to enter overrides for a particular RX "RTN","BPSTEST",8,0) ; INPUT "RTN","BPSTEST",9,0) ; KEY1 - Prescription IEN/Patient IEN "RTN","BPSTEST",10,0) ; KEY2 - Fill Number/Policy Number "RTN","BPSTEST",11,0) ; BPSORESP - Previous response when this claim was processed "RTN","BPSTEST",12,0) ; BPSWHERE - RX Action passed into BPSNCPDP "RTN","BPSTEST",13,0) ; BPSTYPE - R (Reversal), S (Submission), E (Eligibility) "RTN","BPSTEST",14,0) ; BPPAYSEQ - payer sequence 1 - primary, 2 - secondary "RTN","BPSTEST",15,0) ; OUTPUT "RTN","BPSTEST",16,0) ; None - Table BPS PAYER RESPONSE OVERRIDE entry is created. "RTN","BPSTEST",17,0) ; "RTN","BPSTEST",18,0) N BPSTRANS,BPSTIEN,BPSSRESP,DIC,X,Y,DIR,DIK,DA "RTN","BPSTEST",19,0) ; "RTN","BPSTEST",20,0) ; Check if testing is enabled "RTN","BPSTEST",21,0) I '$$CHECK() Q "RTN","BPSTEST",22,0) ; "RTN","BPSTEST",23,0) ; Option can not be run for Date of Death option as it causes errors "RTN","BPSTEST",24,0) I $G(XQY0)["DG DEATH ENTRY" W !,"The testing tool can not be run from Date of Death option" Q "RTN","BPSTEST",25,0) ; "RTN","BPSTEST",26,0) ; Do not run for background jobs (CMOP (CR*) or ARES/AREV) "RTN","BPSTEST",27,0) I $D(ZTQUEUED)!(",ARES,AREV,CRLB,CRLR,CRLX,PC,PL,"[(","_BPSWHERE_",")) Q "RTN","BPSTEST",28,0) ; "RTN","BPSTEST",29,0) ; Create Transaction Number "RTN","BPSTEST",30,0) S BPSTRANS=$$IEN59^BPSOSRX(KEY1,KEY2,$S($G(BPPAYSEQ)>0:+BPPAYSEQ,1:1)) "RTN","BPSTEST",31,0) ; "RTN","BPSTEST",32,0) ; Lookup the record in the BPS PAYER RESPONSE OVERRIDE table "RTN","BPSTEST",33,0) S DIC=9002313.32,DIC(0)="",X=BPSTRANS "RTN","BPSTEST",34,0) D ^DIC "RTN","BPSTEST",35,0) S BPSTIEN=+Y "RTN","BPSTEST",36,0) ; "RTN","BPSTEST",37,0) ; Prompt if user wants to do overrides "RTN","BPSTEST",38,0) W !!,"Payer Overrides are enabled at this site. If this is production environment," "RTN","BPSTEST",39,0) W !,"do not enter overrides (enter No at the next prompt) and disable this" "RTN","BPSTEST",40,0) W !,"functionality in the BPS SETUP table." "RTN","BPSTEST",41,0) W !!,"Entering No at the next prompt will delete any current overrides for the" "RTN","BPSTEST",42,0) W !,"request, if they exist.",! "RTN","BPSTEST",43,0) S DIR(0)="SA^Y:Yes;N:No" "RTN","BPSTEST",44,0) S DIR("A")="Do you want to enter overrides for this request? ",DIR("B")="NO" "RTN","BPSTEST",45,0) D ^DIR "RTN","BPSTEST",46,0) ; "RTN","BPSTEST",47,0) ; If no, delete the transaction (if it exists) and quit "RTN","BPSTEST",48,0) I Y'="Y" D:BPSTIEN'=-1 Q "RTN","BPSTEST",49,0) . S DIK="^BPS(9002313.32,",DA=BPSTIEN "RTN","BPSTEST",50,0) . D ^DIK "RTN","BPSTEST",51,0) ; "RTN","BPSTEST",52,0) ; If the record does not exist, create it "RTN","BPSTEST",53,0) I BPSTIEN=-1 S BPSTIEN=$$CREATE(BPSTRANS) "RTN","BPSTEST",54,0) I BPSTIEN=-1 W !,"Failed to create the BPS PAYER RESPONSE OVERRIDE record",! Q "RTN","BPSTEST",55,0) ; "RTN","BPSTEST",56,0) ; If BPSTYPE is 'S' (submission) and old response is 'E Payable', change BPSTYPE to 'RS' "RTN","BPSTEST",57,0) I BPSTYPE="S",BPSORESP="E PAYABLE"!(BPSORESP="E DUPLICATE")!(BPSORESP="E REVERSAL REJECTED")!(BPSORESP="E REVERSAL UNSTRANDED") S BPSTYPE="RS" "RTN","BPSTEST",58,0) ; "RTN","BPSTEST",59,0) ; Update with the BPSTYPE "RTN","BPSTEST",60,0) D FILE("^BPS(9002313.32,",BPSTIEN,.02,BPSTYPE) "RTN","BPSTEST",61,0) ; "RTN","BPSTEST",62,0) ; Message for RS "RTN","BPSTEST",63,0) I BPSTYPE="RS" D "RTN","BPSTEST",64,0) . W !!,"This submission may also have a reversal so you will be prompted for the" "RTN","BPSTEST",65,0) . W !,"reversal overrides." "RTN","BPSTEST",66,0) ; "RTN","BPSTEST",67,0) ; If BPSTYPE is equal to 'E', then prompt for eligibility response "RTN","BPSTEST",68,0) I BPSTYPE["E" D "RTN","BPSTEST",69,0) . W !!,"Eligibility Questions" "RTN","BPSTEST",70,0) . D PROMPT(BPSTIEN,.08,"A") "RTN","BPSTEST",71,0) . N BPSRESP "RTN","BPSTEST",72,0) . S BPSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.08,"I") "RTN","BPSTEST",73,0) . I BPSRESP="R" D PROMPT(BPSTIEN,1,"07") "RTN","BPSTEST",74,0) ; "RTN","BPSTEST",75,0) ; If BPSTYPE contains 'R', then prompt for reversal response "RTN","BPSTEST",76,0) I BPSTYPE["R" D "RTN","BPSTEST",77,0) . W !!,"Reversal Questions" "RTN","BPSTEST",78,0) . D PROMPT(BPSTIEN,.05,"A") "RTN","BPSTEST",79,0) . N BPSRESP "RTN","BPSTEST",80,0) . S BPSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I") "RTN","BPSTEST",81,0) . I BPSRESP="R" D ENREVRJ(BPSTRANS) "RTN","BPSTEST",82,0) ; "RTN","BPSTEST",83,0) ; If BPSTYPE contains 'S', do submission response "RTN","BPSTEST",84,0) I BPSTYPE["S" D "RTN","BPSTEST",85,0) . W !!,"Submission Questions" "RTN","BPSTEST",86,0) . D PROMPT(BPSTIEN,.03,"P") "RTN","BPSTEST",87,0) . S BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I") "RTN","BPSTEST",88,0) . I BPSSRESP="P"!(BPSSRESP="D") D PROMPT(BPSTIEN,.04,40) "RTN","BPSTEST",89,0) . I BPSSRESP="P"!(BPSSRESP="D") D PROMPT(BPSTIEN,.06,9) "RTN","BPSTEST",90,0) . I BPSSRESP="R" D PROMPT(BPSTIEN,1,"07") "RTN","BPSTEST",91,0) ; "RTN","BPSTEST",92,0) W ! D PROMPT(BPSTIEN,.07,0) "RTN","BPSTEST",93,0) Q "RTN","BPSTEST",94,0) ; "RTN","BPSTEST",95,0) SETOVER(BPSTRANS,BPSTYPE,BPSDATA) ; "RTN","BPSTEST",96,0) ; called by BPSECMPS to set the override data "RTN","BPSTEST",97,0) ; Input "RTN","BPSTEST",98,0) ; BPSTRANS - Transaction IEN "RTN","BPSTEST",99,0) ; BPSTYPE - B1 for submission, B2 for reversals "RTN","BPSTEST",100,0) ; Output "RTN","BPSTEST",101,0) ; BPSDATA - Passed by reference and updated with appropriate overrides "RTN","BPSTEST",102,0) ; "RTN","BPSTEST",103,0) N BPSTIEN,BPSRRESP,BPSSRESP,BPSPAID,BPSRCNT,BPSRIEN,BPSRCODE,BPSRCD,BPSCOPAY,BPSXXXX,BPSUNDEF "RTN","BPSTEST",104,0) ; "RTN","BPSTEST",105,0) ; Check the Test Flag in set in BPS SETUP "RTN","BPSTEST",106,0) I '$$CHECK() Q "RTN","BPSTEST",107,0) ; "RTN","BPSTEST",108,0) ; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES "RTN","BPSTEST",109,0) S BPSTIEN=$O(^BPS(9002313.32,"B",BPSTRANS,"")) "RTN","BPSTEST",110,0) I BPSTIEN="" Q "RTN","BPSTEST",111,0) ; "RTN","BPSTEST",112,0) ; If a eligibility, check for specific reversal overrides and set "RTN","BPSTEST",113,0) I BPSTYPE="E1" D Q "RTN","BPSTEST",114,0) . S BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.08,"I") "RTN","BPSTEST",115,0) . ; "RTN","BPSTEST",116,0) . ; If the response is Stranded, force an error "RTN","BPSTEST",117,0) . I BPSRRESP="S" S BPSXXXX=BPSUNDEF "RTN","BPSTEST",118,0) . I BPSRRESP]"" S BPSDATA(1,112)=BPSRRESP "RTN","BPSTEST",119,0) . S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSRRESP="R":"R",1:"A") "RTN","BPSTEST",120,0) . ; "RTN","BPSTEST",121,0) . ; If the response is accepted, delete the reject code count and codes "RTN","BPSTEST",122,0) . I BPSRRESP="A" K BPSDATA(1,510),BPSDATA(1,511) "RTN","BPSTEST",123,0) . ; "RTN","BPSTEST",124,0) . ; If the response is rejected, delete the rejections returned by payers "RTN","BPSTEST",125,0) . ; and put in the ones entered by the user "RTN","BPSTEST",126,0) . I BPSRRESP="R" D "RTN","BPSTEST",127,0) .. K BPSDATA(1,509),BPSDATA(1,511) "RTN","BPSTEST",128,0) .. S BPSRCNT=0 "RTN","BPSTEST",129,0) .. S BPSRIEN=0 F S BPSRIEN=$O(^BPS(9002313.32,BPSTIEN,1,BPSRIEN)) Q:+BPSRIEN=0 D "RTN","BPSTEST",130,0) ... S BPSRCODE=$P($G(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1) "RTN","BPSTEST",131,0) ... ; Increment counter and store "RTN","BPSTEST",132,0) ... I BPSRCODE]"" D "RTN","BPSTEST",133,0) .... S BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E") "RTN","BPSTEST",134,0) .... I BPSRCD]"" S BPSRCNT=BPSRCNT+1,BPSDATA(1,511,BPSRCNT)=BPSRCD "RTN","BPSTEST",135,0) .. ; Store total number of rejections "RTN","BPSTEST",136,0) .. S BPSDATA(1,510)=BPSRCNT "RTN","BPSTEST",137,0) ; "RTN","BPSTEST",138,0) ; If a reversal, check for specific reversal overrides and set "RTN","BPSTEST",139,0) I BPSTYPE="B2" D "RTN","BPSTEST",140,0) . S BPSRRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.05,"I") "RTN","BPSTEST",141,0) . ; "RTN","BPSTEST",142,0) . ; If the response is Stranded, force an error "RTN","BPSTEST",143,0) . I BPSRRESP="S" S BPSXXXX=BPSUNDEF "RTN","BPSTEST",144,0) . I BPSRRESP]"" S BPSDATA(1,112)=$S(BPSRRESP="D":"S",1:BPSRRESP) "RTN","BPSTEST",145,0) . S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSRRESP="R":"R",1:"A") "RTN","BPSTEST",146,0) . ; "RTN","BPSTEST",147,0) . ; If the response is accepted or duplicate, kill the reject code count and codes "RTN","BPSTEST",148,0) . I BPSRRESP="A"!(BPSRRESP="D") K BPSDATA(1,510),BPSDATA(1,511) "RTN","BPSTEST",149,0) . ; "RTN","BPSTEST",150,0) . ; If the response is rejected, set the reject codes "RTN","BPSTEST",151,0) . I BPSRRESP="R" D SETREJ(BPSTRANS) "RTN","BPSTEST",152,0) ; "RTN","BPSTEST",153,0) ; If a submission, check for specific submission overrides and set "RTN","BPSTEST",154,0) I BPSTYPE="B1" D "RTN","BPSTEST",155,0) . ; Get submission response "RTN","BPSTEST",156,0) . S BPSSRESP=$$GET1^DIQ(9002313.32,BPSTIEN_",",.03,"I") "RTN","BPSTEST",157,0) . ; "RTN","BPSTEST",158,0) . ; If the response is Stranded, force an error "RTN","BPSTEST",159,0) . I BPSSRESP="S" S BPSXXXX=BPSUNDEF "RTN","BPSTEST",160,0) . ; "RTN","BPSTEST",161,0) . ; If BPSSRESP exists, file it "RTN","BPSTEST",162,0) . I BPSSRESP]"" D "RTN","BPSTEST",163,0) .. S BPSDATA(1,112)=BPSSRESP "RTN","BPSTEST",164,0) .. S BPSDATA(9002313.03,9002313.03,"+1,",501)=$S(BPSSRESP="R":"R",1:"A") "RTN","BPSTEST",165,0) .. ; If payable or duplicate, get the BPSPAID amount and file it if it "RTN","BPSTEST",166,0) .. ; exists. Also delete any reject codes "RTN","BPSTEST",167,0) .. I BPSSRESP="P"!(BPSSRESP="D") D "RTN","BPSTEST",168,0) ... S BPSPAID=$$GET1^DIQ(9002313.32,BPSTIEN_",",.04,"I") "RTN","BPSTEST",169,0) ... I BPSPAID]"" S BPSDATA(1,509)=$$DFF^BPSECFM(BPSPAID,8) "RTN","BPSTEST",170,0) ... K BPSDATA(1,510),BPSDATA(1,511) "RTN","BPSTEST",171,0) ... S BPSCOPAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.06,"I") "RTN","BPSTEST",172,0) ... I BPSCOPAY]"" S BPSDATA(1,518)=$$DFF^BPSECFM(BPSCOPAY,8) "RTN","BPSTEST",173,0) .. ; If rejected, get the rejection code and file them "RTN","BPSTEST",174,0) .. ; Also, delete the BPSPAID amount "RTN","BPSTEST",175,0) .. I BPSSRESP="R" D "RTN","BPSTEST",176,0) ... ; Delete old rejections and BPSPAID amount "RTN","BPSTEST",177,0) ... K BPSDATA(1,509),BPSDATA(1,511) "RTN","BPSTEST",178,0) ... ; Loop through rejections and store "RTN","BPSTEST",179,0) ... S BPSRCNT=0 "RTN","BPSTEST",180,0) ... S BPSRIEN=0 F S BPSRIEN=$O(^BPS(9002313.32,BPSTIEN,1,BPSRIEN)) Q:+BPSRIEN=0 D "RTN","BPSTEST",181,0) .... S BPSRCODE=$P($G(^BPS(9002313.32,BPSTIEN,1,BPSRIEN,0)),"^",1) "RTN","BPSTEST",182,0) .... ; Increment counter and store "RTN","BPSTEST",183,0) .... I BPSRCODE]"" D "RTN","BPSTEST",184,0) ..... S BPSRCD=$$GET1^DIQ(9002313.93,BPSRCODE_",",.01,"E") "RTN","BPSTEST",185,0) ..... I BPSRCD]"" S BPSRCNT=BPSRCNT+1,BPSDATA(1,511,BPSRCNT)=BPSRCD "RTN","BPSTEST",186,0) ... ; Store total number of rejections "RTN","BPSTEST",187,0) ... S BPSDATA(1,510)=BPSRCNT "RTN","BPSTEST",188,0) Q "RTN","BPSTEST",189,0) ; "RTN","BPSTEST",190,0) SELOVER ; "RTN","BPSTEST",191,0) ; Used to create overrides for prescription that will processed in the "RTN","BPSTEST",192,0) ; background (CMOP, auto-reversals). The user is prompted for the "RTN","BPSTEST",193,0) ; prescription and other information and then calls GETOVER. It is called "RTN","BPSTEST",194,0) ; by option BPS PROVIDER RESPONSE OVERRIDES "RTN","BPSTEST",195,0) ; "RTN","BPSTEST",196,0) ; This does not work for eligibility but we don't do them in the background "RTN","BPSTEST",197,0) ; right now. "RTN","BPSTEST",198,0) ; "RTN","BPSTEST",199,0) N BPSRXIEN,BPSRXNM,BPSRXFL,BPSRFL,BPSORESP,BPSTYPE,BPSRXARR,BPSRARR,DIC,Y,DIR "RTN","BPSTEST",200,0) ; "RTN","BPSTEST",201,0) ; Check if test mode is on "RTN","BPSTEST",202,0) I '$$CHECK() Q "RTN","BPSTEST",203,0) ; "RTN","BPSTEST",204,0) ; Prompt for the Prescription "RTN","BPSTEST",205,0) S BPSRXIEN=$$PROMPTRX^BPSUTIL1 Q:BPSRXIEN<1 "RTN","BPSTEST",206,0) D RXAPI^BPSUTIL1(BPSRXIEN,".01;22","BPSRXARR","IE") "RTN","BPSTEST",207,0) S BPSRXNM=$G(BPSRXARR(52,BPSRXIEN,.01,"E")) "RTN","BPSTEST",208,0) ; "RTN","BPSTEST",209,0) ; Prompt for Fill/Refill "RTN","BPSTEST",210,0) S DIR(0)="S^0:"_$G(BPSRXARR(52,BPSRXIEN,22,"E")) "RTN","BPSTEST",211,0) F BPSRFL=1:1 D RXSUBF^BPSUTIL1(BPSRXIEN,52,52.1,BPSRFL,.01,"BPSRARR","E") Q:$G(BPSRARR(52.1,BPSRFL,.01,"E"))="" D "RTN","BPSTEST",212,0) . S DIR(0)=DIR(0)_";"_BPSRFL_":"_BPSRARR(52.1,BPSRFL,.01,"E") "RTN","BPSTEST",213,0) S DIR("A")="Select fill/refill for prescription "_BPSRXNM,DIR("B")=0 "RTN","BPSTEST",214,0) D ^DIR "RTN","BPSTEST",215,0) I Y'=+Y Q "RTN","BPSTEST",216,0) S BPSRXFL=Y "RTN","BPSTEST",217,0) ; "RTN","BPSTEST",218,0) ; Prompt for BPSTYPE "RTN","BPSTEST",219,0) S DIR(0)="S^R:Reversal;RS:Resubmit with Reversal;S:Submit" "RTN","BPSTEST",220,0) S DIR("A")="Enter BPSTYPE of transaction",DIR("B")="SUBMIT" "RTN","BPSTEST",221,0) D ^DIR "RTN","BPSTEST",222,0) I ",R,RS,S,"'[","_Y_"," Q "RTN","BPSTEST",223,0) S BPSTYPE=Y "RTN","BPSTEST",224,0) ; "RTN","BPSTEST",225,0) ; Set up parameters "RTN","BPSTEST",226,0) S BPSORESP="" "RTN","BPSTEST",227,0) I BPSTYPE="RS" S BPSTYPE="S",BPSORESP="E PAYABLE" "RTN","BPSTEST",228,0) ; "RTN","BPSTEST",229,0) ; Call GETOVER "RTN","BPSTEST",230,0) D GETOVER(BPSRXIEN,BPSRXFL,BPSORESP,"",BPSTYPE) "RTN","BPSTEST",231,0) Q "RTN","BPSTEST",232,0) ; "RTN","BPSTEST",233,0) CHECK() ; "RTN","BPSTEST",234,0) ; Check if Test Mode is ON in the BPS Setup table "RTN","BPSTEST",235,0) ; Also called by BPSNCPDP and BPSEMCPS "RTN","BPSTEST",236,0) ; "RTN","BPSTEST",237,0) ;IA#4440 "RTN","BPSTEST",238,0) Q $S($$PROD^XUPROD:0,1:$P($G(^BPS(9002313.99,1,0)),"^",3)) "RTN","BPSTEST",239,0) ; "RTN","BPSTEST",240,0) CREATE(BPSTRANS) ; "RTN","BPSTEST",241,0) ; Create the Override record "RTN","BPSTEST",242,0) ; "RTN","BPSTEST",243,0) N DIC,X,Y,BPSTIEN,DA "RTN","BPSTEST",244,0) S DIC=9002313.32,DIC(0)="L",X=BPSTRANS "RTN","BPSTEST",245,0) D ^DIC "RTN","BPSTEST",246,0) S BPSTIEN=+Y "RTN","BPSTEST",247,0) Q BPSTIEN "RTN","BPSTEST",248,0) ; "RTN","BPSTEST",249,0) FILE(DIE,DA,BPSFLD,BPSDATA) ; "RTN","BPSTEST",250,0) ; File in the Override record "RTN","BPSTEST",251,0) ; "RTN","BPSTEST",252,0) N DR,X,Y "RTN","BPSTEST",253,0) S DR=BPSFLD_"///"_BPSDATA "RTN","BPSTEST",254,0) L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q "RTN","BPSTEST",255,0) W !?5,"Another user is editing this entry." "RTN","BPSTEST",256,0) Q "RTN","BPSTEST",257,0) ; "RTN","BPSTEST",258,0) PROMPT(DA,BPSFLD,BPSDFLT) ; "RTN","BPSTEST",259,0) ; Prompt for a specific field and set the data "RTN","BPSTEST",260,0) ; "RTN","BPSTEST",261,0) N DIE,DR,DTOUT,X,Y "RTN","BPSTEST",262,0) S DIE="^BPS(9002313.32,",DR=BPSFLD_"//"_BPSDFLT "RTN","BPSTEST",263,0) L +@(DIE_DA_")"):0 I $T D ^DIE L -@(DIE_DA_")") Q "RTN","BPSTEST",264,0) W !?5,"Another user is editing this entry." "RTN","BPSTEST",265,0) Q "RTN","BPSTEST",266,0) ; "RTN","BPSTEST",267,0) SETDELAY(BPSTRANS) ; "RTN","BPSTEST",268,0) ; Input "RTN","BPSTEST",269,0) ; BPSTRANS - Transaction IEN "RTN","BPSTEST",270,0) ; Check the Test Flag in set in BPS SETUP "RTN","BPSTEST",271,0) I '$$CHECK() Q 0 "RTN","BPSTEST",272,0) N BPSDELAY,BPSTIEN,BPSTIME "RTN","BPSTEST",273,0) ; Check if the Transaction Number is defined in BPS RESPONSE OVERRIDES "RTN","BPSTEST",274,0) S BPSTIEN=$O(^BPS(9002313.32,"B",BPSTRANS,"")) "RTN","BPSTEST",275,0) I BPSTIEN="" Q 0 "RTN","BPSTEST",276,0) S BPSDELAY=$$GET1^DIQ(9002313.32,BPSTIEN_",",.07,"I")*60 "RTN","BPSTEST",277,0) I BPSDELAY'>0 Q 0 "RTN","BPSTEST",278,0) S BPSTIME=$$FMADD^XLFDT($$NOW^XLFDT,,,,BPSDELAY) "RTN","BPSTEST",279,0) I BPSTIME>0 D Q BPSTIME "RTN","BPSTEST",280,0) . ;schedule a task to run RUNNING^BPSOSRX "RTN","BPSTEST",281,0) . N ZTRTN,ZTDTH,ZTIO,ZTSK "RTN","BPSTEST",282,0) . S ZTRTN="RUNECME^BPSTEST",ZTDESC="BPSTEST: ECME testing tool" "RTN","BPSTEST",283,0) . S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,,,,BPSDELAY+10),ZTIO="" "RTN","BPSTEST",284,0) . D ^%ZTLOAD "RTN","BPSTEST",285,0) Q 0 "RTN","BPSTEST",286,0) ; "RTN","BPSTEST",287,0) RUNECME ; "RTN","BPSTEST",288,0) D RUNNING^BPSOSRX() "RTN","BPSTEST",289,0) Q "RTN","BPSTEST",290,0) ;get the reversal reject from the ^XTMP and set BPSDATA to override data "RTN","BPSTEST",291,0) SETREJ(BPSTRANS) ; "RTN","BPSTEST",292,0) N BPSREJ "RTN","BPSTEST",293,0) S BPSREJ=$G(^XTMP("BPSTEST",BPSTRANS)) "RTN","BPSTEST",294,0) I BPSREJ="" Q "RTN","BPSTEST",295,0) S BPSDATA(1,511,1)=BPSREJ "RTN","BPSTEST",296,0) S BPSDATA(1,510)=1 "RTN","BPSTEST",297,0) Q "RTN","BPSTEST",298,0) ;enter a reversal reject "RTN","BPSTEST",299,0) ENREVRJ(BPSTRANS) ; "RTN","BPSTEST",300,0) N BPRJCODE,TMSTAMP "RTN","BPSTEST",301,0) S BPRJCODE=$$PROMPT^BPSSCRU4("Enter a reject code for reversal") "RTN","BPSTEST",302,0) I $P(BPRJCODE,U)="" Q "RTN","BPSTEST",303,0) I $P(BPRJCODE,U)=0 Q "RTN","BPSTEST",304,0) N X,X1,X2 "RTN","BPSTEST",305,0) S X1=DT,X2=2 D C^%DTC "RTN","BPSTEST",306,0) S ^XTMP("BPSTEST",0)=X_U_DT_U_"ECME TESTING TOOL, SEE BPSTEST ROUTINE" "RTN","BPSTEST",307,0) S ^XTMP("BPSTEST",BPSTRANS)=$P(BPRJCODE,U) "RTN","BPSTEST",308,0) Q "RTN","BPSTEST",309,0) ; "RTN","BPSUSCR") 0^63^B1901475 "RTN","BPSUSCR",1,0) BPSUSCR ;BHAM ISC/FLS - ECME STRANDED SUBMISSIONS SCREEN MAIN ;03/07/08 10:44 "RTN","BPSUSCR",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,7,10**;JUN 2004;Build 27 "RTN","BPSUSCR",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSUSCR",4,0) ; "RTN","BPSUSCR",5,0) ;STRANDED SUBMISSIONS SCREEN "RTN","BPSUSCR",6,0) EN ; -- main entry point for BPS ECME USER SCREEN "RTN","BPSUSCR",7,0) N BPTMPGL,DUOUT,DTOUT,BPQ "RTN","BPSUSCR",8,0) S BPQ=$$MESSAGE^BPSUSCR1() I BPQ=1 Q "RTN","BPSUSCR",9,0) D GETDTS^BPSUSCR1(.BPARR) Q:$D(DUOUT)!$D(DTOUT) "RTN","BPSUSCR",10,0) D EN^VALM("BPS LSTMN ECME UNSTRAND") "RTN","BPSUSCR",11,0) Q "RTN","BPSUSCR",12,0) ; "RTN","BPSUSCR",13,0) HDR ; -- header code "RTN","BPSUSCR",14,0) S BPBDT=$$FMTE^XLFDT($P(BPBDT,"."),"5Z") "RTN","BPSUSCR",15,0) S BPEDT=$$FMTE^XLFDT($P(BPEDT,"."),"5Z") "RTN","BPSUSCR",16,0) S VALMHDR(1)="Submissions Stranded from "_BPBDT_" through "_BPEDT "RTN","BPSUSCR",17,0) S VALMHDR(2)="Sorted by Transaction Date" "RTN","BPSUSCR",18,0) Q "RTN","BPSUSCR",19,0) ; "RTN","BPSUSCR",20,0) INIT ; -- init variables and list array "RTN","BPSUSCR",21,0) N BPLN,BPLM,BP59,BPSORT,BPDUZ7,BPRET,CONT "RTN","BPSUSCR",22,0) W !,"Please wait..." "RTN","BPSUSCR",23,0) K ^TMP("BPSUSCR-1",$J),^TMP("BPSUSCR-2",$J),^TMP("BPSUSCR",$J) "RTN","BPSUSCR",24,0) S BPTMPGL="^TMP(""BPSUSCR"",$J)" "RTN","BPSUSCR",25,0) S CONT=1,VALMCNT=0 "RTN","BPSUSCR",26,0) D COLLECT^BPSUSCR4(.BPARR) "RTN","BPSUSCR",27,0) Q "RTN","BPSUSCR",28,0) ; "RTN","BPSUSCR",29,0) HELP ; -- help code "RTN","BPSUSCR",30,0) S X="?" D DISP^XQORM1 W !! "RTN","BPSUSCR",31,0) K X "RTN","BPSUSCR",32,0) Q "RTN","BPSUSCR",33,0) ; "RTN","BPSUSCR",34,0) EXIT ; -- exit code "RTN","BPSUSCR",35,0) K BPARR,BPEDT,BPBDT "RTN","BPSUSCR",36,0) D CLEAN^VALM10 "RTN","BPSUSCR",37,0) Q "RTN","BPSUSCR1") 0^64^B52105056 "RTN","BPSUSCR1",1,0) BPSUSCR1 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;10-MAR-2005 "RTN","BPSUSCR1",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10**;JUN 2004;Build 27 "RTN","BPSUSCR1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSUSCR1",4,0) ; "RTN","BPSUSCR1",5,0) ; IA# 10060 - Fileman read of New Person file (VA(200)) "RTN","BPSUSCR1",6,0) ; "RTN","BPSUSCR1",7,0) Q "RTN","BPSUSCR1",8,0) ; "RTN","BPSUSCR1",9,0) ; Warning message for 'Transmitting' submissions "RTN","BPSUSCR1",10,0) MESSAGE() ; "RTN","BPSUSCR1",11,0) W !!!,"Please be aware that if there are submissions appearing on the ECME User Screen" "RTN","BPSUSCR1",12,0) W !,"with a status of 'In progress - Transmitting', then there may be a problem" "RTN","BPSUSCR1",13,0) W !,"with HL7 or with system connectivity with the Austin Automation Center (AAC)." "RTN","BPSUSCR1",14,0) W !,"Please contact your IRM to verify that connectivity to the AAC is working" "RTN","BPSUSCR1",15,0) W !,"and the HL7 link BPS NCPDP is processing messages before using this option" "RTN","BPSUSCR1",16,0) W !,"to unstrand submissions with a status of 'In progress - Transmitting'.",! "RTN","BPSUSCR1",17,0) N DIR,X,Y,BPQ "RTN","BPSUSCR1",18,0) S BPQ=0 "RTN","BPSUSCR1",19,0) S DIR(0)="YA",DIR("A")="Do you want to continue? " "RTN","BPSUSCR1",20,0) S DIR("B")="NO" "RTN","BPSUSCR1",21,0) D ^DIR "RTN","BPSUSCR1",22,0) I Y'=1 S BPQ=1 "RTN","BPSUSCR1",23,0) W !! "RTN","BPSUSCR1",24,0) Q BPQ "RTN","BPSUSCR1",25,0) ; "RTN","BPSUSCR1",26,0) GETDTS(BPARR) ; Transaction dates to view. "RTN","BPSUSCR1",27,0) N DIR "RTN","BPSUSCR1",28,0) K DIRUT,DIROUT,DUOUT,DTOUT,Y "RTN","BPSUSCR1",29,0) S DIR(0)="DA^:DT:EX",DIR("A")="FIRST TRANSACTION DATE: " "RTN","BPSUSCR1",30,0) S DIR("B")="T-1" "RTN","BPSUSCR1",31,0) D ^DIR "RTN","BPSUSCR1",32,0) Q:$D(DUOUT)!($D(DTOUT)) "RTN","BPSUSCR1",33,0) S BPARR("BDT")=Y_".000001" "RTN","BPSUSCR1",34,0) ENDDT ; "RTN","BPSUSCR1",35,0) K DIRUT,DIROUT,DUOUT,DTOUT,Y "RTN","BPSUSCR1",36,0) S DIR(0)="DA^"_$P(BPARR("BDT"),".",1)_":DT:EX",DIR("A")="LAST TRANSACTION DATE: " "RTN","BPSUSCR1",37,0) S DIR("B")="T" "RTN","BPSUSCR1",38,0) D ^DIR "RTN","BPSUSCR1",39,0) Q:$D(DUOUT)!($D(DTOUT)) "RTN","BPSUSCR1",40,0) S BPARR("EDT")=$$EDATE(Y) "RTN","BPSUSCR1",41,0) Q "RTN","BPSUSCR1",42,0) ; "RTN","BPSUSCR1",43,0) EDATE(DATE) ; "RTN","BPSUSCR1",44,0) N RTN,%,%H "RTN","BPSUSCR1",45,0) S RTN=DATE_".235959" "RTN","BPSUSCR1",46,0) D NOW^%DTC "RTN","BPSUSCR1",47,0) I $P(%,".")=DATE S $P(%H,",",2)=$P(%H,",",2)-1800 D YX^%DTC S RTN=DATE_% "RTN","BPSUSCR1",48,0) Q RTN "RTN","BPSUSCR1",49,0) ; "RTN","BPSUSCR1",50,0) ALL ; Unstrand all submissions currently selected. "RTN","BPSUSCR1",51,0) D FULL^VALM1 "RTN","BPSUSCR1",52,0) N D0,DIR,SEQ,LAST,TMP,TMP2 "RTN","BPSUSCR1",53,0) S LAST=+$O(^TMP("BPSUSCR-2",$J,""),-1) "RTN","BPSUSCR1",54,0) I LAST=0 D Q "RTN","BPSUSCR1",55,0) . W !,"There are no stranded submissions in this date range to unstrand" "RTN","BPSUSCR1",56,0) . D PRESSANY^BPSOSU5() "RTN","BPSUSCR1",57,0) ; Display message if there are multiple types on the queue "RTN","BPSUSCR1",58,0) S TMP=$O(^TMP("BPSUSCR-1",$J,"")) "RTN","BPSUSCR1",59,0) I TMP S TMP2=$O(^TMP("BPSUSCR-1",$J,TMP)) "RTN","BPSUSCR1",60,0) I TMP2 D "RTN","BPSUSCR1",61,0) . W !,"Please be aware there are multiple types of requests currently stranded." "RTN","BPSUSCR1",62,0) . W !,"Are you sure you want to unstrand ALL submissions? If not, exit this" "RTN","BPSUSCR1",63,0) . W !,"action and select which submissions you want to unstrand." "RTN","BPSUSCR1",64,0) . W !!,"Answer NO to following prompt if you wish to SELECT the submissions to unstrand.",! "RTN","BPSUSCR1",65,0) S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO" D ^DIR Q:'Y "RTN","BPSUSCR1",66,0) W !,"Please wait..." "RTN","BPSUSCR1",67,0) S SEQ=0 "RTN","BPSUSCR1",68,0) F S SEQ=$O(^TMP("BPSUSCR-2",$J,SEQ)) Q:'SEQ D "RTN","BPSUSCR1",69,0) . S D0="" "RTN","BPSUSCR1",70,0) . F S D0=$O(^TMP("BPSUSCR-2",$J,SEQ,D0)) Q:'D0 D "RTN","BPSUSCR1",71,0) . . D UNSTRAND(D0,$G(^TMP("BPSUSCR-2",$J,SEQ,D0))) "RTN","BPSUSCR1",72,0) . . Q "RTN","BPSUSCR1",73,0) . Q "RTN","BPSUSCR1",74,0) W !,"Done" "RTN","BPSUSCR1",75,0) D CLEAN^VALM10 "RTN","BPSUSCR1",76,0) D COLLECT^BPSUSCR4(.BPARR) "RTN","BPSUSCR1",77,0) Q "RTN","BPSUSCR1",78,0) ; "RTN","BPSUSCR1",79,0) SELECT ; Select entries from the list and run each through the unstrand function "RTN","BPSUSCR1",80,0) N D0,DIR,I,J,VAR,BPTMPGL,PT,POP,LAST "RTN","BPSUSCR1",81,0) S LAST=+$O(^TMP("BPSUSCR-2",$J,""),-1) "RTN","BPSUSCR1",82,0) I LAST=0 D Q "RTN","BPSUSCR1",83,0) . W !,"There are no stranded submissions to select" "RTN","BPSUSCR1",84,0) . D PRESSANY^BPSOSU5() "RTN","BPSUSCR1",85,0) K DTOUT,DUOUT "RTN","BPSUSCR1",86,0) S BPTMPGL="^TMP(""BPSUSCR"",$J)" "RTN","BPSUSCR1",87,0) S VAR="" "RTN","BPSUSCR1",88,0) S DIR(0)="LO^1:"_LAST "RTN","BPSUSCR1",89,0) S DIR("A")="Enter a Selection of Stranded Submissions",DIR("B")="" "RTN","BPSUSCR1",90,0) D ^DIR "RTN","BPSUSCR1",91,0) I $D(DTOUT)!$D(DUOUT) Q "RTN","BPSUSCR1",92,0) S VAR=Y "RTN","BPSUSCR1",93,0) F I=1:1:$L(VAR,",") S PT=$P(VAR,",",I) D "RTN","BPSUSCR1",94,0) . Q:PT="" "RTN","BPSUSCR1",95,0) . I PT'["-" S D0=$O(^TMP("BPSUSCR-2",$J,PT,"")) D UNSTRAND(D0,$G(^TMP("BPSUSCR-2",$J,PT,+D0))) Q "RTN","BPSUSCR1",96,0) . F J=$P(PT,"-"):1:$P(PT,"-",2) S D0=$O(^TMP("BPSUSCR-2",$J,J,"")) D UNSTRAND(D0,$G(^TMP("BPSUSCR-2",$J,J,+D0))) "RTN","BPSUSCR1",97,0) . Q "RTN","BPSUSCR1",98,0) D CLEAN^VALM10 "RTN","BPSUSCR1",99,0) D COLLECT^BPSUSCR4(.BPARR) "RTN","BPSUSCR1",100,0) Q "RTN","BPSUSCR1",101,0) ; "RTN","BPSUSCR1",102,0) PRINT ; "RTN","BPSUSCR1",103,0) ; Full Screen Mode "RTN","BPSUSCR1",104,0) D FULL^VALM1 "RTN","BPSUSCR1",105,0) ; Prompt for pinter "RTN","BPSUSCR1",106,0) N %ZIS,POP "RTN","BPSUSCR1",107,0) S %ZIS="M",%ZIS("A")="Select Printer: ",%ZIS("B")="" D ^%ZIS "RTN","BPSUSCR1",108,0) I POP Q "RTN","BPSUSCR1",109,0) ; Use device "RTN","BPSUSCR1",110,0) U IO "RTN","BPSUSCR1",111,0) ; Create Report "RTN","BPSUSCR1",112,0) D REPORT "RTN","BPSUSCR1",113,0) Q "RTN","BPSUSCR1",114,0) ; "RTN","BPSUSCR1",115,0) REPORT ; "RTN","BPSUSCR1",116,0) N SEQ,LINE,BPQ,LCNT,DATA,BPSCR "RTN","BPSUSCR1",117,0) ; "RTN","BPSUSCR1",118,0) ; Set flag for interactive device "RTN","BPSUSCR1",119,0) S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0) "RTN","BPSUSCR1",120,0) ; "RTN","BPSUSCR1",121,0) ; Print first header "RTN","BPSUSCR1",122,0) D HDR "RTN","BPSUSCR1",123,0) ; "RTN","BPSUSCR1",124,0) ; Loop through data and display "RTN","BPSUSCR1",125,0) S SEQ=0,BPQ=0,DATA=0 "RTN","BPSUSCR1",126,0) F S SEQ=$O(^TMP("BPSUSCR",$J,SEQ)) Q:'SEQ D I BPQ Q "RTN","BPSUSCR1",127,0) . S LINE=$G(^TMP("BPSUSCR",$J,SEQ,0)) "RTN","BPSUSCR1",128,0) . ; Check if we filled a page "RTN","BPSUSCR1",129,0) . S BPQ=$$CHKP(BPSCR) I BPQ Q "RTN","BPSUSCR1",130,0) . W !,$E(LINE,1,79) "RTN","BPSUSCR1",131,0) . S LCNT=LCNT+1 "RTN","BPSUSCR1",132,0) . S DATA=1 "RTN","BPSUSCR1",133,0) ; "RTN","BPSUSCR1",134,0) ; If no data, display message "RTN","BPSUSCR1",135,0) I DATA=0 W !?4,"No data to display" "RTN","BPSUSCR1",136,0) ; "RTN","BPSUSCR1",137,0) ; Write FF for print devices "RTN","BPSUSCR1",138,0) ; Else final Press Return... "RTN","BPSUSCR1",139,0) I 'BPSCR W !,@IOF "RTN","BPSUSCR1",140,0) E I 'BPQ D PAUSE2 "RTN","BPSUSCR1",141,0) ; "RTN","BPSUSCR1",142,0) ; Close the device and quit "RTN","BPSUSCR1",143,0) D ^%ZISC "RTN","BPSUSCR1",144,0) Q "RTN","BPSUSCR1",145,0) ; "RTN","BPSUSCR1",146,0) HDR ; "RTN","BPSUSCR1",147,0) ; Display Header. "RTN","BPSUSCR1",148,0) ; LCNT is returned "RTN","BPSUSCR1",149,0) N HDR,TAB "RTN","BPSUSCR1",150,0) S HDR="Submissions Stranded from "_BPBDT_" through "_BPEDT "RTN","BPSUSCR1",151,0) S TAB=80-$L(HDR)\2 "RTN","BPSUSCR1",152,0) W !!,?TAB,HDR "RTN","BPSUSCR1",153,0) W !!?4,"TRANS DT",?15,"PATIENT NAME",?36,"ID",?41,"EXTERN RX#",?54,"RF",?57,"DOS",?68,"INS CO" "RTN","BPSUSCR1",154,0) W !,?4,"--------",?15,"------------",?36,"--",?41,"----------",?54,"--",?57,"---",?68,"------" "RTN","BPSUSCR1",155,0) S LCNT=5 "RTN","BPSUSCR1",156,0) Q "RTN","BPSUSCR1",157,0) ; "RTN","BPSUSCR1",158,0) CHKP(BPSCR) ; "RTN","BPSUSCR1",159,0) ; Check for End of Page "RTN","BPSUSCR1",160,0) ; LCNT is returned "RTN","BPSUSCR1",161,0) N BPLINES "RTN","BPSUSCR1",162,0) I $G(BPSCR) S BPLINES=3 "RTN","BPSUSCR1",163,0) E S BPLINES=1 "RTN","BPSUSCR1",164,0) I '$G(IOSL) Q 0 "RTN","BPSUSCR1",165,0) I IOSL'<(LCNT+BPLINES) Q 0 "RTN","BPSUSCR1",166,0) I $G(BPSCR) S BPQ=$$PAUSE I BPQ Q 1 "RTN","BPSUSCR1",167,0) D HDR "RTN","BPSUSCR1",168,0) Q 0 "RTN","BPSUSCR1",169,0) ; "RTN","BPSUSCR1",170,0) PAUSE() ; "RTN","BPSUSCR1",171,0) N X "RTN","BPSUSCR1",172,0) U IO(0) "RTN","BPSUSCR1",173,0) R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME "RTN","BPSUSCR1",174,0) I '$T!(X="^") Q 1 "RTN","BPSUSCR1",175,0) U IO "RTN","BPSUSCR1",176,0) Q 0 "RTN","BPSUSCR1",177,0) ; "RTN","BPSUSCR1",178,0) PAUSE2 ; "RTN","BPSUSCR1",179,0) N X "RTN","BPSUSCR1",180,0) U IO(0) "RTN","BPSUSCR1",181,0) R !,"Press RETURN to continue: ",X:DTIME "RTN","BPSUSCR1",182,0) U IO "RTN","BPSUSCR1",183,0) Q "RTN","BPSUSCR1",184,0) ; "RTN","BPSUSCR1",185,0) ; Unstrand the submission "RTN","BPSUSCR1",186,0) ; "RTN","BPSUSCR1",187,0) ; Input variables "RTN","BPSUSCR1",188,0) ; IEN59 - IEN of BPS TRANSACTION "RTN","BPSUSCR1",189,0) ; BP77IEN - IEN of BPS REQUEST - If this is defined, it means that there "RTN","BPSUSCR1",190,0) ; was only a request record but no BPS TRANSACTION record "RTN","BPSUSCR1",191,0) UNSTRAND(IEN59,BP77IEN) ; "RTN","BPSUSCR1",192,0) N MES,BPTYPE "RTN","BPSUSCR1",193,0) ; If BP77IEN is passed in, that means that there was no transaction data (no 0 node) "RTN","BPSUSCR1",194,0) ; so we need to just remove the request. This will be done by UNQUEUE. "RTN","BPSUSCR1",195,0) I $G(BP77IEN)>0 D UNQUEUE(IEN59,+BP77IEN) Q "RTN","BPSUSCR1",196,0) ; "RTN","BPSUSCR1",197,0) ; Set the result (error 99) and message "RTN","BPSUSCR1",198,0) S BPTYPE=$P($G(^BPST(IEN59,0)),U,15) "RTN","BPSUSCR1",199,0) S MES="E UNSTRANDED" "RTN","BPSUSCR1",200,0) I $P($G(^BPST(IEN59,4)),"^",1)!($P($G(^BPST(IEN59,4)),"^",4)]"") S MES="E REVERSAL UNSTRANDED" "RTN","BPSUSCR1",201,0) I BPTYPE="E" S MES="E ELIGIBILITY UNSTRANDED" "RTN","BPSUSCR1",202,0) D SETRESU^BPSOSU(IEN59,99,MES) "RTN","BPSUSCR1",203,0) ; "RTN","BPSUSCR1",204,0) ; Setting the status to 99% will call REQST99^BPSOSRX5, which will delete "RTN","BPSUSCR1",205,0) ; the current request and subsequent requests "RTN","BPSUSCR1",206,0) D SETSTAT^BPSOSU(IEN59,99) "RTN","BPSUSCR1",207,0) ; "RTN","BPSUSCR1",208,0) ; Update the log "RTN","BPSUSCR1",209,0) S MES=$T(+0)_"-Unstranded" "RTN","BPSUSCR1",210,0) I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E") ; IA# 10060 "RTN","BPSUSCR1",211,0) D LOG^BPSOSL(IEN59,MES) "RTN","BPSUSCR1",212,0) Q "RTN","BPSUSCR1",213,0) ; "RTN","BPSUSCR1",214,0) ;Remove all requests for this set of keys "RTN","BPSUSCR1",215,0) UNQUEUE(IEN59,BP77IEN) ; "RTN","BPSUSCR1",216,0) N MES,KEY1,KEY2,BPTYPE,BPRETV "RTN","BPSUSCR1",217,0) I 'BP77IEN Q "RTN","BPSUSCR1",218,0) S KEY1=$$GET1^DIQ(9002313.77,BP77IEN,.01,"I") "RTN","BPSUSCR1",219,0) S KEY2=$$GET1^DIQ(9002313.77,BP77IEN,.02,"I") "RTN","BPSUSCR1",220,0) S BPTYPE=$$GET1^DIQ(9002313.77,BP77IEN,1.04,"I") "RTN","BPSUSCR1",221,0) I BPTYPE'="E" D "RTN","BPSUSCR1",222,0) . W !,"Warning! The stranded request for the prescription #"_$$GET1^DIQ(9002313.77,BP77IEN,1.13,"E")_" and fill "_$$GET1^DIQ(9002313.77,BP77IEN,1.14,"E") "RTN","BPSUSCR1",223,0) . W !,"is being deleted. It might need to be submitted manually in the IB Claims" "RTN","BPSUSCR1",224,0) . W !,"Tracking Edit option." "RTN","BPSUSCR1",225,0) . D PRESSANY^BPSOSU5() "RTN","BPSUSCR1",226,0) ; "RTN","BPSUSCR1",227,0) ; Lock the request "RTN","BPSUSCR1",228,0) D LOG^BPSOSL(IEN59,$T(+0)_"-Attempting to lock request with keys "_KEY1_", "_KEY2) "RTN","BPSUSCR1",229,0) S BPRETV=$$LOCKRF^BPSOSRX(KEY1,KEY2,10,IEN59,$T(+0)) "RTN","BPSUSCR1",230,0) I 'BPRETV D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot lock keys") Q "RTN","BPSUSCR1",231,0) ; "RTN","BPSUSCR1",232,0) ; Set request to completed and delete any other subsequent or active requests "RTN","BPSUSCR1",233,0) ; Then unlock the record "RTN","BPSUSCR1",234,0) D COMPLETD^BPSOSRX4(BP77IEN),DELALLRQ^BPSOSRX7(BP77IEN,IEN59),DELACTRQ^BPSOSRX6(KEY1,KEY2,IEN59) "RTN","BPSUSCR1",235,0) D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0)) "RTN","BPSUSCR1",236,0) ; "RTN","BPSUSCR1",237,0) ; Put message in log indicating that we have unstranded the request "RTN","BPSUSCR1",238,0) S MES=$T(+0)_"-Unqueued (unstranded)" "RTN","BPSUSCR1",239,0) I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E") ; IA# 10060 "RTN","BPSUSCR1",240,0) D LOG^BPSOSL(IEN59,MES) "RTN","BPSUSCR1",241,0) Q "RTN","BPSUSCR2") 0^65^B14190168 "RTN","BPSUSCR2",1,0) BPSUSCR2 ;ALB ISC/SS - STRANDED SUBMISSIONS SCREEN (cont) ;02-MAY-2008 "RTN","BPSUSCR2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,10**;JUN 2004;Build 27 "RTN","BPSUSCR2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSUSCR2",4,0) ; "RTN","BPSUSCR2",5,0) Q "RTN","BPSUSCR2",6,0) ; "RTN","BPSUSCR2",7,0) ;Stranded requests with BPS TRANSACTION record "RTN","BPSUSCR2",8,0) ; Input: "RTN","BPSUSCR2",9,0) ; BPARR - Date Range "RTN","BPSUSCR2",10,0) ; Output: "RTN","BPSUSCR2",11,0) ; ^TMP("BPSUSCR",$J) "RTN","BPSUSCR2",12,0) ; ^TMP($J,2) "RTN","BPSUSCR2",13,0) COLACTRQ(BPARR) ; "RTN","BPSUSCR2",14,0) N KEY1,KEY2,BPIEN77,BPRX,FILL,COB "RTN","BPSUSCR2",15,0) N TFILE,CFILE,STATUS,IEN59,VART,LSTUDT,CD0 "RTN","BPSUSCR2",16,0) N NAME,SSN,INSCO,FILLDT,BPTYPE "RTN","BPSUSCR2",17,0) N BPBDT,BPEDT "RTN","BPSUSCR2",18,0) S TFILE=9002313.59,CFILE=9002313.02 "RTN","BPSUSCR2",19,0) S BPBDT=BPARR("BDT") ;start date and time "RTN","BPSUSCR2",20,0) S BPEDT=BPARR("EDT") ;end date and time "RTN","BPSUSCR2",21,0) S KEY1=0 "RTN","BPSUSCR2",22,0) F S KEY1=$O(^BPS(9002313.77,"AC",2,KEY1)) Q:+KEY1=0 D "RTN","BPSUSCR2",23,0) .S KEY2="" "RTN","BPSUSCR2",24,0) .F S KEY2=$O(^BPS(9002313.77,"AC",2,KEY1,KEY2)) Q:KEY2="" D "RTN","BPSUSCR2",25,0) .. S BPIEN77=+$O(^BPS(9002313.77,"AC",2,KEY1,KEY2,0)) "RTN","BPSUSCR2",26,0) .. S COB=$$GET1^DIQ(9002313.77,BPIEN77,.03,"I") "RTN","BPSUSCR2",27,0) .. S IEN59=$$IEN59^BPSOSRX(KEY1,KEY2,COB) "RTN","BPSUSCR2",28,0) .. S VART=$G(^BPST(IEN59,0)) "RTN","BPSUSCR2",29,0) .. ; If the transaction is missing, get the data from the request "RTN","BPSUSCR2",30,0) .. I VART="" D REQSTTMP Q "RTN","BPSUSCR2",31,0) .. ; If the Request pointer in the transaction is not the same as the "RTN","BPSUSCR2",32,0) .. ; original request from the request file, get the data from the request "RTN","BPSUSCR2",33,0) .. S BPTYPE=$P(VART,"^",15) "RTN","BPSUSCR2",34,0) .. I BPIEN77'=0,BPIEN77'=+$$GETRQST^BPSUTIL2(IEN59) D REQSTTMP Q "RTN","BPSUSCR2",35,0) .. S LSTUDT=$$GET1^DIQ(TFILE,IEN59,7,"I") "RTN","BPSUSCR2",36,0) .. I LSTUDTBPEDT) Q "RTN","BPSUSCR2",37,0) .. S LSTUDT=$P(LSTUDT,".",1) "RTN","BPSUSCR2",38,0) .. I LSTUDT="" Q "RTN","BPSUSCR2",39,0) .. S BPTYPE=$P(VART,"^",15) "RTN","BPSUSCR2",40,0) .. S BPTYPE=$S(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4) "RTN","BPSUSCR2",41,0) .. I $D(^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,+IEN59)) Q ;already has it "RTN","BPSUSCR2",42,0) .. S BPRX=$$GET1^DIQ(TFILE,IEN59,1.11,"E") "RTN","BPSUSCR2",43,0) .. S FILL=$$GET1^DIQ(TFILE,IEN59,9) "RTN","BPSUSCR2",44,0) .. S STATUS=$P(VART,"^",2) "RTN","BPSUSCR2",45,0) .. S CD0=$$GET1^DIQ(TFILE,IEN59,3,"I") "RTN","BPSUSCR2",46,0) .. I CD0'="" D "RTN","BPSUSCR2",47,0) ... S FILLDT=$$GET1^DIQ(CFILE,CD0,401),FILLDT=$$HL7TFM^XLFDT(FILLDT) "RTN","BPSUSCR2",48,0) .. I CD0="" D "RTN","BPSUSCR2",49,0) ... S FILLDT=$P($G(^BPST(IEN59,12)),"^",2) "RTN","BPSUSCR2",50,0) .. S NAME=$$GET1^DIQ(TFILE,IEN59,5,"E") "RTN","BPSUSCR2",51,0) .. S SSN="" "RTN","BPSUSCR2",52,0) .. I $P(VART,"^",6)]"" S SSN=$P($G(^DPT($P(VART,"^",6),0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN)) "RTN","BPSUSCR2",53,0) .. S INSCO=$P($G(^BPST(IEN59,10,1,0)),"^",7) "RTN","BPSUSCR2",54,0) .. S ^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_BPRX_U_FILL_U_FILLDT_U_INSCO_U_STATUS "RTN","BPSUSCR2",55,0) Q "RTN","BPSUSCR2",56,0) ; "RTN","BPSUSCR2",57,0) ;Stranded requests without BPS TRANSACTION record "RTN","BPSUSCR2",58,0) ;Note the IEN59 here is a calculated ien only - the record doesn't exist "RTN","BPSUSCR2",59,0) REQSTTMP ; "RTN","BPSUSCR2",60,0) N BPDFN,BPIEN78,BPX "RTN","BPSUSCR2",61,0) I BPIEN77=0 Q "RTN","BPSUSCR2",62,0) S STATUS=-96 "RTN","BPSUSCR2",63,0) S LSTUDT=$$GET1^DIQ(9002313.77,BPIEN77,6.05,"I") "RTN","BPSUSCR2",64,0) I LSTUDTBPEDT) Q "RTN","BPSUSCR2",65,0) S LSTUDT=$P(LSTUDT,".",1) "RTN","BPSUSCR2",66,0) I LSTUDT="" Q "RTN","BPSUSCR2",67,0) S BPTYPE=$$GET1^DIQ(9002313.77,BPIEN77,1.04,"I") "RTN","BPSUSCR2",68,0) S BPTYPE=$S(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4) "RTN","BPSUSCR2",69,0) I $D(^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,+IEN59)) Q ;already has it "RTN","BPSUSCR2",70,0) S BPRX=$$GET1^DIQ(9002313.77,BPIEN77,1.13,"E") "RTN","BPSUSCR2",71,0) S FILL=$$GET1^DIQ(9002313.77,BPIEN77,1.14) "RTN","BPSUSCR2",72,0) S FILLDT=$$GET1^DIQ(9002313.77,BPIEN77,2.01,"I") "RTN","BPSUSCR2",73,0) S NAME=$$GET1^DIQ(9002313.77,BPIEN77,1.15,"E") "RTN","BPSUSCR2",74,0) S BPDFN=$$GET1^DIQ(9002313.77,BPIEN77,1.15,"I") "RTN","BPSUSCR2",75,0) ; Older request might not have the Patient Name so get it from "RTN","BPSUSCR2",76,0) ; the RX "RTN","BPSUSCR2",77,0) I BPDFN="",BPRX D "RTN","BPSUSCR2",78,0) . S NAME=$$RXAPI1^BPSUTIL1(BPRX,2,"E") "RTN","BPSUSCR2",79,0) . S BPDFN=$$RXAPI1^BPSUTIL1(BPRX,2,"I") "RTN","BPSUSCR2",80,0) S SSN="" "RTN","BPSUSCR2",81,0) I BPDFN>0 S SSN=$P($G(^DPT(BPDFN,0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN)) "RTN","BPSUSCR2",82,0) S BPX=$O(^BPS(9002313.77,BPIEN77,5,0)) "RTN","BPSUSCR2",83,0) I BPX>0 S BPIEN78=+$P($G(^BPS(9002313.77,BPIEN77,5,BPX,0)),U,3),INSCO=$$GET1^DIQ(9002313.78,BPIEN78,.07,"E") "RTN","BPSUSCR2",84,0) E S INSCO="UNKNOWN" "RTN","BPSUSCR2",85,0) S ^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_BPRX_U_FILL_U_FILLDT_U_INSCO_U_STATUS_U_BPIEN77 "RTN","BPSUSCR2",86,0) Q "RTN","BPSUSCR4") 0^66^B15393480 "RTN","BPSUSCR4",1,0) BPSUSCR4 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;14-FEB-05 "RTN","BPSUSCR4",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,10**;JUN 2004;Build 27 "RTN","BPSUSCR4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSUSCR4",4,0) ; "RTN","BPSUSCR4",5,0) Q "RTN","BPSUSCR4",6,0) ; "RTN","BPSUSCR4",7,0) ; COLLECT - Compile stranded submissions "RTN","BPSUSCR4",8,0) ; Input: "RTN","BPSUSCR4",9,0) ; BPARR - Date Range "RTN","BPSUSCR4",10,0) ; Output: "RTN","BPSUSCR4",11,0) ; ^TMP("BPSUSCR",$J) "RTN","BPSUSCR4",12,0) ; ^TMP("BPSUSCR-1",$J) "RTN","BPSUSCR4",13,0) ; ^TMP("BPSUSCR-2",$J) "RTN","BPSUSCR4",14,0) COLLECT(BPARR) ; "RTN","BPSUSCR4",15,0) N TFILE,CFILE,SDT,STATUS,IEN59,VART,LSTUDT,CD0,DATA "RTN","BPSUSCR4",16,0) N RX,REFILL,NAME,SSN,INSCO,FILLDT,SEQ,ITEM,MESSAGE "RTN","BPSUSCR4",17,0) N BPIEN77,BPSTATUS,BPTYPE,STR,POS,X "RTN","BPSUSCR4",18,0) K BPBDT,BPEDT "RTN","BPSUSCR4",19,0) K ^TMP("BPSUSCR-1",$J),^TMP("BPSUSCR-2",$J),^TMP("BPSUSCR",$J) "RTN","BPSUSCR4",20,0) S VALMCNT=0,TFILE=9002313.59,CFILE=9002313.02 "RTN","BPSUSCR4",21,0) S BPBDT=BPARR("BDT") ;start date and time "RTN","BPSUSCR4",22,0) S BPEDT=BPARR("EDT") ;end date and time "RTN","BPSUSCR4",23,0) ; "RTN","BPSUSCR4",24,0) ; Loop through all statuses from 0 to 98 "RTN","BPSUSCR4",25,0) S STATUS=-1 "RTN","BPSUSCR4",26,0) F S STATUS=$O(^BPST("AD",STATUS)) Q:STATUS>98!(STATUS="") D "RTN","BPSUSCR4",27,0) . ; Status of 31 is Insurer Asleep - these will process when insurer wakes up "RTN","BPSUSCR4",28,0) . ; Insurer asleep disabled for Phase III so these should appear on the report for now "RTN","BPSUSCR4",29,0) . ;I STATUS=31 Q "RTN","BPSUSCR4",30,0) . S IEN59=0 "RTN","BPSUSCR4",31,0) . F S IEN59=$O(^BPST("AD",STATUS,IEN59)) Q:'IEN59 D "RTN","BPSUSCR4",32,0) .. S VART=$G(^BPST(IEN59,0)) Q:VART="" "RTN","BPSUSCR4",33,0) .. S LSTUDT=$$GET1^DIQ(TFILE,IEN59,7,"I") "RTN","BPSUSCR4",34,0) .. I LSTUDTBPEDT) Q "RTN","BPSUSCR4",35,0) .. S LSTUDT=$P(LSTUDT,".",1) "RTN","BPSUSCR4",36,0) .. I LSTUDT="" Q "RTN","BPSUSCR4",37,0) .. S BPTYPE=$P(VART,"^",15) "RTN","BPSUSCR4",38,0) .. S BPTYPE=$S(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4) "RTN","BPSUSCR4",39,0) .. S RX=$$GET1^DIQ(TFILE,IEN59,1.11) "RTN","BPSUSCR4",40,0) .. S REFILL=$$GET1^DIQ(TFILE,IEN59,9) "RTN","BPSUSCR4",41,0) .. S CD0=$$GET1^DIQ(TFILE,IEN59,3,"I") "RTN","BPSUSCR4",42,0) .. I CD0'="" D "RTN","BPSUSCR4",43,0) ... S FILLDT=$$GET1^DIQ(CFILE,CD0,401),FILLDT=$$HL7TFM^XLFDT(FILLDT) "RTN","BPSUSCR4",44,0) .. I CD0="" D "RTN","BPSUSCR4",45,0) ... S FILLDT=$P($G(^BPST(IEN59,12)),"^",2) "RTN","BPSUSCR4",46,0) .. S NAME=$$GET1^DIQ(TFILE,IEN59,5,"E") "RTN","BPSUSCR4",47,0) .. S SSN="" "RTN","BPSUSCR4",48,0) .. I $P(VART,"^",6)]"" S SSN=$P($G(^DPT($P(VART,"^",6),0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN)) "RTN","BPSUSCR4",49,0) .. S INSCO=$P($G(^BPST(IEN59,10,1,0)),"^",7) "RTN","BPSUSCR4",50,0) .. S ^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_RX_U_REFILL_U_FILLDT_U_INSCO_U_STATUS "RTN","BPSUSCR4",51,0) ; "RTN","BPSUSCR4",52,0) ; Look for stranded submissions on the BPS Request queue "RTN","BPSUSCR4",53,0) D COLACTRQ^BPSUSCR2(.BPARR) "RTN","BPSUSCR4",54,0) ; "RTN","BPSUSCR4",55,0) ; Now that the data is sorted, format it and build list for display "RTN","BPSUSCR4",56,0) S (SEQ,ITEM)=0 "RTN","BPSUSCR4",57,0) S BPTYPE="" F S BPTYPE=$O(^TMP("BPSUSCR-1",$J,BPTYPE)) Q:BPTYPE="" D "RTN","BPSUSCR4",58,0) . S STR="*** "_$S(BPTYPE=1:"CLAIMS",BPTYPE=2:"REVERSALS",BPTYPE=3:"ELIGIBILITY INQUIRIES",1:"UNKNOWN")_" ***" "RTN","BPSUSCR4",59,0) . S POS=41-($L(STR)/2+.5\1) "RTN","BPSUSCR4",60,0) . S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(STR))=STR "RTN","BPSUSCR4",61,0) . S SEQ=SEQ+1,^TMP("BPSUSCR",$J,SEQ,0)=X "RTN","BPSUSCR4",62,0) . S SDT="" F S SDT=$O(^TMP("BPSUSCR-1",$J,BPTYPE,SDT)) Q:SDT="" D "RTN","BPSUSCR4",63,0) .. S IEN59="" F S IEN59=$O(^TMP("BPSUSCR-1",$J,BPTYPE,SDT,IEN59)) Q:IEN59="" D "RTN","BPSUSCR4",64,0) ... S DATA=$G(^TMP("BPSUSCR-1",$J,BPTYPE,SDT,IEN59)) "RTN","BPSUSCR4",65,0) ... S LSTUDT=$$FORMAT($$FMTE^XLFDT(SDT,"5Z"),10) "RTN","BPSUSCR4",66,0) ... S NAME=$$FORMAT($P(DATA,U,1),20) "RTN","BPSUSCR4",67,0) ... S SSN=$$FORMAT($P(DATA,U,2),4) "RTN","BPSUSCR4",68,0) ... S RX=$$FORMAT($P(DATA,U,3),12) "RTN","BPSUSCR4",69,0) ... S REFILL=$J($P(DATA,U,4),2) "RTN","BPSUSCR4",70,0) ... S FILLDT=$$FMTE^XLFDT($P(DATA,U,5),"5Z") "RTN","BPSUSCR4",71,0) ... S INSCO=$$FORMAT($P(DATA,U,6),12) "RTN","BPSUSCR4",72,0) ... S BPSTATUS=+$P(DATA,U,7) "RTN","BPSUSCR4",73,0) ... S BPIEN77=$P(DATA,U,8) "RTN","BPSUSCR4",74,0) ... S SEQ=SEQ+1 "RTN","BPSUSCR4",75,0) ... S ITEM=ITEM+1 "RTN","BPSUSCR4",76,0) ... S ^TMP("BPSUSCR",$J,SEQ,0)=$J(ITEM,3)_" "_LSTUDT_" "_NAME_" "_SSN_" "_RX_" "_REFILL_" "_FILLDT_" "_INSCO "RTN","BPSUSCR4",77,0) ... S ^TMP("BPSUSCR-2",$J,ITEM,IEN59)=BPIEN77 "RTN","BPSUSCR4",78,0) ... S SEQ=SEQ+1 "RTN","BPSUSCR4",79,0) ... S MESSAGE=$$STATI^BPSOSU($P(DATA,U,7)) "RTN","BPSUSCR4",80,0) ... I $E(MESSAGE,1)="?" S MESSAGE="Unknown Status" "RTN","BPSUSCR4",81,0) ... S ^TMP("BPSUSCR",$J,SEQ,0)=" In Progress - "_MESSAGE "RTN","BPSUSCR4",82,0) S VALMCNT=SEQ "RTN","BPSUSCR4",83,0) Q "RTN","BPSUSCR4",84,0) ; "RTN","BPSUSCR4",85,0) FORMAT(D1,LEN) ; "RTN","BPSUSCR4",86,0) N OUT "RTN","BPSUSCR4",87,0) S D1=$G(D1),LEN=$G(LEN) "RTN","BPSUSCR4",88,0) S D1=$$NOSPACE(D1) "RTN","BPSUSCR4",89,0) S OUT=$E($E(D1,1,LEN)_$J("",LEN),1,LEN) "RTN","BPSUSCR4",90,0) Q OUT "RTN","BPSUSCR4",91,0) ; "RTN","BPSUSCR4",92,0) NOSPACE(VAR) ; "RTN","BPSUSCR4",93,0) N RTN,SEQ,I "RTN","BPSUSCR4",94,0) S RTN="" "RTN","BPSUSCR4",95,0) F I=1:1:$L(VAR," ") I $P(VAR," ",I)'="" S SEQ=$G(SEQ)+1,$P(RTN," ",SEQ)=$P(VAR," ",I) "RTN","BPSUSCR4",96,0) Q RTN "RTN","BPSUTIL2") 0^76^B28691065 "RTN","BPSUTIL2",1,0) BPSUTIL2 ;BHAM ISC/SS - General Utility functions ;08/01/2006 "RTN","BPSUTIL2",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27 "RTN","BPSUTIL2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","BPSUTIL2",4,0) ; "RTN","BPSUTIL2",5,0) Q "RTN","BPSUTIL2",6,0) ; "RTN","BPSUTIL2",7,0) ;/** "RTN","BPSUTIL2",8,0) ;Creates a new entry (or node for multiple with .01 field) "RTN","BPSUTIL2",9,0) ; "RTN","BPSUTIL2",10,0) ;BPFILE - file/subfile number "RTN","BPSUTIL2",11,0) ;BPIEN - ien of the parent file entry in which the new subfile entry will be inserted "RTN","BPSUTIL2",12,0) ;BPVAL01 - .01 value for the new entry "RTN","BPSUTIL2",13,0) ;NEWRECNO -(optional) specify IEN if you want specific value "RTN","BPSUTIL2",14,0) ; Note: "" then the system will assign the entry number itself. "RTN","BPSUTIL2",15,0) ;BPFLGS - FLAGS parameter for UPDATE^DIE "RTN","BPSUTIL2",16,0) ;LCKGL - fully specified global reference to lock "RTN","BPSUTIL2",17,0) ;LCKTIME - time out for LOCK, if LOCKTIME=0 then the function will not lock the file "RTN","BPSUTIL2",18,0) ;BPNEWREC - optional, flag = if 1 then allow to create a new top level record "RTN","BPSUTIL2",19,0) ;Examples "RTN","BPSUTIL2",20,0) ;top level: "RTN","BPSUTIL2",21,0) ; D INSITEM(366.14,"",IBDATE,"") "RTN","BPSUTIL2",22,0) ;to create with the specific ien "RTN","BPSUTIL2",23,0) ; W $$INSITEM^BPSUTIL2(9002313.77,"",55555555,45555,,,,1) "RTN","BPSUTIL2",24,0) ; "RTN","BPSUTIL2",25,0) ;1st level multiple: "RTN","BPSUTIL2",26,0) ; subfile number = #366.141 "RTN","BPSUTIL2",27,0) ; parent file #366.14 entry number = 345 "RTN","BPSUTIL2",28,0) ; D INSITEM(366.141,345,"SUBMIT","") "RTN","BPSUTIL2",29,0) ; to create multiple entry with particular entry number = 23 "RTN","BPSUTIL2",30,0) ; D INSITEM(366.141,345,"SUBMIT",23) "RTN","BPSUTIL2",31,0) ; "RTN","BPSUTIL2",32,0) ;2nd level multiple "RTN","BPSUTIL2",33,0) ;parent file #366.14 entry number = 234 "RTN","BPSUTIL2",34,0) ;parent multiple entry number = 55 "RTN","BPSUTIL2",35,0) ;create multiple entry INSURANCE "RTN","BPSUTIL2",36,0) ; D INSITEM(366.1412,"55,234","INS","") "RTN","BPSUTIL2",37,0) ; results in : "RTN","BPSUTIL2",38,0) ; ^IBCNR(366.14,234,1,55,5,0)=^366.1412PA^1^1 "RTN","BPSUTIL2",39,0) ; ^IBCNR(366.14,234,1,55,5,1,0)=INS "RTN","BPSUTIL2",40,0) ; ^IBCNR(366.14,234,1,55,5,"B","INS",1)= "RTN","BPSUTIL2",41,0) ; (DD node for this multiple =5 ) "RTN","BPSUTIL2",42,0) ; "RTN","BPSUTIL2",43,0) ;output : "RTN","BPSUTIL2",44,0) ; positive number - record # created "RTN","BPSUTIL2",45,0) ; <=0 - failure "RTN","BPSUTIL2",46,0) ; See description above "RTN","BPSUTIL2",47,0) INSITEM(BPFILE,BPIEN,BPVAL01,NEWRECNO,BPFLGS,LCKGL,LCKTIME,BPNEWREC) ;*/ "RTN","BPSUTIL2",48,0) I ('$G(BPFILE)) Q "0^Invalid parameter" "RTN","BPSUTIL2",49,0) I +$G(BPNEWREC)=0 I $G(NEWRECNO)>0,'$G(BPIEN) Q "0^Invalid parameter" "RTN","BPSUTIL2",50,0) I $G(BPVAL01)="" Q "0^Null" "RTN","BPSUTIL2",51,0) N BPLOCK S BPLOCK=0 "RTN","BPSUTIL2",52,0) ;I '$G(BPFILE) Q -1 "RTN","BPSUTIL2",53,0) ;I '$G(BPVAL01) Q -1 "RTN","BPSUTIL2",54,0) N BPSSI,BPIENS,BPFDA,BPERR "RTN","BPSUTIL2",55,0) I '$G(NEWRECNO) N NEWRECNO S NEWRECNO=$G(NEWRECNO) "RTN","BPSUTIL2",56,0) I BPIEN'="" S BPIENS="+1,"_BPIEN_"," I $L(NEWRECNO)>0 S BPSSI(1)=+NEWRECNO "RTN","BPSUTIL2",57,0) I BPIEN="" S BPIENS="+1," I $L(NEWRECNO)>0 S BPSSI(1)=+NEWRECNO "RTN","BPSUTIL2",58,0) S BPFDA(BPFILE,BPIENS,.01)=BPVAL01 "RTN","BPSUTIL2",59,0) I $L($G(LCKGL)) L +@LCKGL:(+$G(LCKTIME)) S BPLOCK=$T I 'BPLOCK Q -2 ;lock failure "RTN","BPSUTIL2",60,0) D UPDATE^DIE($G(BPFLGS),"BPFDA","BPSSI","BPERR") "RTN","BPSUTIL2",61,0) I BPLOCK L -@LCKGL "RTN","BPSUTIL2",62,0) I $D(BPERR) D BMES^XPDUTL($G(BPERR("DIERR",1,"TEXT",1),"Update Error")) Q -1 ;D BMES^XPDUTL(BPERR("DIERR",1,"TEXT",1)) "RTN","BPSUTIL2",63,0) Q +$G(BPSSI(1)) "RTN","BPSUTIL2",64,0) ; "RTN","BPSUTIL2",65,0) ;fill fields "RTN","BPSUTIL2",66,0) ;Input: "RTN","BPSUTIL2",67,0) ;FILENO file number "RTN","BPSUTIL2",68,0) ;FLDNO field number "RTN","BPSUTIL2",69,0) ;RECIEN ien string "RTN","BPSUTIL2",70,0) ;NEWVAL new value to file (internal format) "RTN","BPSUTIL2",71,0) ;Output: "RTN","BPSUTIL2",72,0) ;0^ NEWVAL^error if failure "RTN","BPSUTIL2",73,0) ;1^ NEWVAL if success "RTN","BPSUTIL2",74,0) FILLFLDS(FILENO,FLDNO,RECIEN,NEWVAL) ; "RTN","BPSUTIL2",75,0) I '$G(FILENO) Q "0^Invalid parameter" "RTN","BPSUTIL2",76,0) I '$G(FLDNO) Q "0^Invalid parameter" "RTN","BPSUTIL2",77,0) I '$G(RECIEN) Q "0^Invalid parameter" "RTN","BPSUTIL2",78,0) I $G(NEWVAL)="" Q "0^Null" "RTN","BPSUTIL2",79,0) N RECIENS,FDA,ERRARR "RTN","BPSUTIL2",80,0) S RECIENS=RECIEN_"," "RTN","BPSUTIL2",81,0) S FDA(FILENO,RECIENS,FLDNO)=NEWVAL "RTN","BPSUTIL2",82,0) D FILE^DIE("","FDA","ERRARR") "RTN","BPSUTIL2",83,0) I $D(ERRARR) Q "0^"_NEWVAL_"^"_ERRARR("DIERR",1,"TEXT",1) "RTN","BPSUTIL2",84,0) Q "1^"_NEWVAL "RTN","BPSUTIL2",85,0) ; "RTN","BPSUTIL2",86,0) ;API to return the GROUP INSURANCE PLAN associated with the "RTN","BPSUTIL2",87,0) ;PRIMARY INSURANCE in the BPS TRANSACTION File "RTN","BPSUTIL2",88,0) ;Input: "RTN","BPSUTIL2",89,0) ;BPIEN59 = IEN of entry in BPS TRANSACTION File "RTN","BPSUTIL2",90,0) ;Output: "RTN","BPSUTIL2",91,0) ;IEN of GROUP INSURANCE PLAN file^INSURANCE COMPANY Name "RTN","BPSUTIL2",92,0) GETPLN59(BPIEN59) ; "RTN","BPSUTIL2",93,0) N IENS,GRPNM "RTN","BPSUTIL2",94,0) S IENS=+$G(^BPST(BPIEN59,9))_","_BPIEN59_"," "RTN","BPSUTIL2",95,0) S GRPNM=$$GET1^DIQ(9002313.59902,IENS,"PLAN ID:INSURANCE COMPANY") "RTN","BPSUTIL2",96,0) Q +$G(^BPST(BPIEN59,10,+$G(^BPST(BPIEN59,9)),0))_"^"_GRPNM "RTN","BPSUTIL2",97,0) ; "RTN","BPSUTIL2",98,0) GETPLN77(BPIEN77) ; "RTN","BPSUTIL2",99,0) N BPINSIEN,BPSINSUR,BPINSDAT "RTN","BPSUTIL2",100,0) I '$G(BPIEN77) Q 0 "RTN","BPSUTIL2",101,0) S BPINSIEN=0 "RTN","BPSUTIL2",102,0) ;get the USED FOR THE REQUEST=1 (active) entry in the multiple "RTN","BPSUTIL2",103,0) S BPINSIEN=$O(^BPS(9002313.77,BPIEN77,5,"C",1,BPINSIEN)) "RTN","BPSUTIL2",104,0) I +BPINSIEN=0 Q 0 "RTN","BPSUTIL2",105,0) ;get BPS IBNSURER DATA pointer "RTN","BPSUTIL2",106,0) S BPSINSUR=+$P($G(^BPS(9002313.77,BPIEN77,5,BPINSIEN,0)),U,3) "RTN","BPSUTIL2",107,0) I BPSINSUR=0 Q 0 "RTN","BPSUTIL2",108,0) ;get 0th node of the BPS INSURER DATA "RTN","BPSUTIL2",109,0) S BPINSDAT=$G(^BPS(9002313.78,BPSINSUR,0)) "RTN","BPSUTIL2",110,0) I BPINSDAT="" Q 0 "RTN","BPSUTIL2",111,0) Q $P(BPINSDAT,U,8)_"^"_$P(BPINSDAT,U,7) "RTN","BPSUTIL2",112,0) ; "RTN","BPSUTIL2",113,0) GETRQST(IEN59) ; Return the BPS Request IEN for a BPS Transaction record "RTN","BPSUTIL2",114,0) N BPTYPE,IEN77 "RTN","BPSUTIL2",115,0) I '$G(IEN59) Q "" "RTN","BPSUTIL2",116,0) S BPTYPE=$$GET1^DIQ(9002313.59,IEN59,19,"I") "RTN","BPSUTIL2",117,0) ; If reversal, return the Reversal Request field "RTN","BPSUTIL2",118,0) I BPTYPE="U" Q $$GET1^DIQ(9002313.59,IEN59,405,"I") "RTN","BPSUTIL2",119,0) ; Otherwise, return the Submission Request field "RTN","BPSUTIL2",120,0) Q $$GET1^DIQ(9002313.59,IEN59,16,"I") "RTN","BPSUTIL2",121,0) ; "RTN","BPSUTIL2",122,0) ;Return the COB (payer sequence) by IEN of the BPS TRANSACTION file "RTN","BPSUTIL2",123,0) COB59(BPSIEN59) ; "RTN","BPSUTIL2",124,0) ;try to get it from 9002313.59, if it was not created yet then get it from IEN itself "RTN","BPSUTIL2",125,0) Q $S($P($G(^BPST(BPSIEN59,0)),U,14):$P(^BPST(BPSIEN59,0),U,14),1:$E($P(BPSIEN59,".",2),5,5)) "RTN","BPSUTIL2",126,0) ; "RTN","BPSUTIL2",127,0) ;Return the plan's COB (from PATIENT file) by IEN of the BPS TRANSACTION file and entry # "RTN","BPSUTIL2",128,0) PLANCOB(BPSIEN59,BPSENTRY) ; "RTN","BPSUTIL2",129,0) I +$G(BPSENTRY)=0 S BPSENTRY=1 ;the first entry by default "RTN","BPSUTIL2",130,0) Q $P($G(^BPST(BPSIEN59,10,BPSENTRY,3)),U,6) "RTN","BPSUTIL2",131,0) ; "RTN","BPSUTIL2",132,0) ;Return the IEN of BPS TRANSACTION file by IEN of BPS CLAIMS file "RTN","BPSUTIL2",133,0) CLAIM59(BPS02) ; "RTN","BPSUTIL2",134,0) Q +$P($G(^BPSC(BPS02,0)),U,8) "RTN","BPSUTIL2",135,0) ; "RTN","BPSUTIL2",136,0) ;Return BPS TRANSACTIONS for associated primary and secondary claims "RTN","BPSUTIL2",137,0) ALLCOB59(BP59) ; "RTN","BPSUTIL2",138,0) N BPSP,BPSS,BPRX,BPRXI,BPRXR "RTN","BPSUTIL2",139,0) S BPRX=$$RXREF^BPSSCRU2(BP59),BPRXI=$P(BPRX,U),BPRXR=$P(BPRX,U,2) "RTN","BPSUTIL2",140,0) S BPSP=$$IEN59^BPSOSRX(BPRXI,BPRXR,1),BPSS=$$IEN59^BPSOSRX(BPRXI,BPRXR,2) "RTN","BPSUTIL2",141,0) I '$D(^BPST(BPSP)) S BPSP="" "RTN","BPSUTIL2",142,0) I '$D(^BPST(BPSS)) S BPSS="" "RTN","BPSUTIL2",143,0) Q BPSP_"^"_BPSS "RTN","BPSUTIL2",144,0) ; "RTN","BPSUTIL2",145,0) ;input: BPS59 - ien of the BPS TRANSACTION file "RTN","BPSUTIL2",146,0) ;returns three pieces: "RTN","BPSUTIL2",147,0) ;COB = Coordination Of Benefit indicator of the insurance as it is stored in (#.2) COB field of the (#.3121) insurance Type multiple of the Patient file (#2) "RTN","BPSUTIL2",148,0) ; 1- primary, 2 -secondary, 3 -tertiary "RTN","BPSUTIL2",149,0) ;RXCOB = the payer sequence indicator of the claim which was sent to the payer as a result of this call: 1- primary, 2 -secondary, 3 -tertiary "RTN","BPSUTIL2",150,0) ;INSURANCE = Name of the insurance company that was billed as a result of this call "RTN","BPSUTIL2",151,0) CLMINFO(BPS59) ; "RTN","BPSUTIL2",152,0) N RETV "RTN","BPSUTIL2",153,0) S $P(RETV,U,1)=$$PLANCOB(BPS59,1) "RTN","BPSUTIL2",154,0) S $P(RETV,U,2)=$$COB59(BPS59) "RTN","BPSUTIL2",155,0) S $P(RETV,U,3)=$$INSNAME^BPSSCRU6(BPS59) "RTN","BPSUTIL2",156,0) Q RETV "RTN","BPSUTIL2",157,0) ; "RTN","BPSUTIL2",158,0) ;to determine whether the secondary claim is payable "RTN","BPSUTIL2",159,0) ; BPSRIM59 - ien of PRIMARY claim in the BPS TRANSACTION "RTN","BPSUTIL2",160,0) ;returns "RTN","BPSUTIL2",161,0) ; 0 - the secondary claim doesn't exist "RTN","BPSUTIL2",162,0) ; 0 - the secondary claim exists and it's not payable "RTN","BPSUTIL2",163,0) ; 1 - the secondary claim exists and it's payable "RTN","BPSUTIL2",164,0) PAYBLSEC(BPSRIM59) ; "RTN","BPSUTIL2",165,0) N BRXIEN,BFILL,BPSSTAT2,BPZ "RTN","BPSUTIL2",166,0) S BPZ=$$RXREF^BPSSCRU2(BPSRIM59) "RTN","BPSUTIL2",167,0) S BRXIEN=+BPZ "RTN","BPSUTIL2",168,0) S BFILL=+$P(BPZ,U,2) "RTN","BPSUTIL2",169,0) S BPSSTAT2=$P($$STATUS^BPSOSRX(BRXIEN,BFILL,0,,2),U,1) "RTN","BPSUTIL2",170,0) ; check if the payer IS going to PAY according to the last response "RTN","BPSUTIL2",171,0) Q $$PAYABLE^BPSOSRX5(BPSSTAT2) "RTN","BPSUTIL2",172,0) ; "RTN","BPSUTIL2",173,0) ;to determine whether the primary claim is payable "RTN","BPSUTIL2",174,0) ; BPSSEC59 - ien of SECONDARY claim in the BPS TRANSACTION "RTN","BPSUTIL2",175,0) ;returns "RTN","BPSUTIL2",176,0) ; 0 - the primary claim doesn't exist "RTN","BPSUTIL2",177,0) ; 0 - the primary claim exists and it's not payable "RTN","BPSUTIL2",178,0) ; ien of 399 - the primary claim exists "RTN","BPSUTIL2",179,0) PAYBLPRI(BPSSEC59) ; "RTN","BPSUTIL2",180,0) N BRXIEN,BFILL,BPSSTAT1,BPZ,BPZ1,BPSARR "RTN","BPSUTIL2",181,0) S BPZ=$$RXREF^BPSSCRU2(BPSSEC59) "RTN","BPSUTIL2",182,0) S BRXIEN=+BPZ "RTN","BPSUTIL2",183,0) S BFILL=+$P(BPZ,U,2) "RTN","BPSUTIL2",184,0) S BPSSTAT1=$P($$STATUS^BPSOSRX(BRXIEN,BFILL,0,,1),U,1) "RTN","BPSUTIL2",185,0) ; check if the payer IS going to PAY according to the last response "RTN","BPSUTIL2",186,0) I +$$PAYABLE^BPSOSRX5(BPSSTAT1)=0 Q 0 "RTN","BPSUTIL2",187,0) S BPZ=$$RXBILL^IBNCPUT3(BRXIEN,BFILL,"P",$P($G(^BPST(BPSSEC59,12)),U,2),.BPSARR) "RTN","BPSUTIL2",188,0) I +$P(BPZ,U,2)>0 Q +$P(BPZ,U,2) ; latest bill in AR active status "RTN","BPSUTIL2",189,0) S BPZ1=+$O(BPSARR(999999999),-1) ; latest bill in any status "RTN","BPSUTIL2",190,0) I BPZ1>0 Q BPZ1 "RTN","BPSUTIL2",191,0) Q 0 "RTN","BPSUTIL2",192,0) ; "RTN","BPSUTIL2",193,0) ;BPSUTIL2 "SEC","^DD",9002313.19,9002313.19,.01,8) "SEC","^DIC",9002313.02,9002313.02,0,"AUDIT") @ "SEC","^DIC",9002313.02,9002313.02,0,"DD") @ "SEC","^DIC",9002313.02,9002313.02,0,"DEL") @ "SEC","^DIC",9002313.02,9002313.02,0,"LAYGO") @ "SEC","^DIC",9002313.02,9002313.02,0,"RD") Pp "SEC","^DIC",9002313.02,9002313.02,0,"WR") @ "SEC","^DIC",9002313.03,9002313.03,0,"AUDIT") @ "SEC","^DIC",9002313.03,9002313.03,0,"DD") @ "SEC","^DIC",9002313.03,9002313.03,0,"DEL") @ "SEC","^DIC",9002313.03,9002313.03,0,"LAYGO") @ "SEC","^DIC",9002313.03,9002313.03,0,"RD") Pp "SEC","^DIC",9002313.03,9002313.03,0,"WR") @ "SEC","^DIC",9002313.19,9002313.19,0,"AUDIT") @ "SEC","^DIC",9002313.19,9002313.19,0,"DD") @ "SEC","^DIC",9002313.19,9002313.19,0,"DEL") @ "SEC","^DIC",9002313.19,9002313.19,0,"LAYGO") @ "SEC","^DIC",9002313.19,9002313.19,0,"RD") Pp "SEC","^DIC",9002313.19,9002313.19,0,"WR") @ "SEC","^DIC",9002313.21,9002313.21,0,"AUDIT") @ "SEC","^DIC",9002313.21,9002313.21,0,"DD") @ "SEC","^DIC",9002313.21,9002313.21,0,"DEL") @ "SEC","^DIC",9002313.21,9002313.21,0,"LAYGO") @ "SEC","^DIC",9002313.21,9002313.21,0,"RD") Pp "SEC","^DIC",9002313.21,9002313.21,0,"WR") @ "SEC","^DIC",9002313.22,9002313.22,0,"AUDIT") @ "SEC","^DIC",9002313.22,9002313.22,0,"DD") @ "SEC","^DIC",9002313.22,9002313.22,0,"DEL") @ "SEC","^DIC",9002313.22,9002313.22,0,"LAYGO") @ "SEC","^DIC",9002313.22,9002313.22,0,"RD") Pp "SEC","^DIC",9002313.22,9002313.22,0,"WR") @ "SEC","^DIC",9002313.23,9002313.23,0,"AUDIT") @ "SEC","^DIC",9002313.23,9002313.23,0,"DD") @ "SEC","^DIC",9002313.23,9002313.23,0,"DEL") @ "SEC","^DIC",9002313.23,9002313.23,0,"LAYGO") @ "SEC","^DIC",9002313.23,9002313.23,0,"RD") Pp "SEC","^DIC",9002313.23,9002313.23,0,"WR") @ "SEC","^DIC",9002313.24,9002313.24,0,"AUDIT") @ "SEC","^DIC",9002313.24,9002313.24,0,"DD") @ "SEC","^DIC",9002313.24,9002313.24,0,"DEL") @ "SEC","^DIC",9002313.24,9002313.24,0,"LAYGO") @ "SEC","^DIC",9002313.24,9002313.24,0,"RD") Pp "SEC","^DIC",9002313.24,9002313.24,0,"WR") @ "SEC","^DIC",9002313.26,9002313.26,0,"AUDIT") @ "SEC","^DIC",9002313.26,9002313.26,0,"DD") @ "SEC","^DIC",9002313.26,9002313.26,0,"DEL") @ "SEC","^DIC",9002313.26,9002313.26,0,"LAYGO") @ "SEC","^DIC",9002313.26,9002313.26,0,"RD") Pp "SEC","^DIC",9002313.26,9002313.26,0,"WR") @ "SEC","^DIC",9002313.27,9002313.27,0,"AUDIT") @ "SEC","^DIC",9002313.27,9002313.27,0,"DD") @ "SEC","^DIC",9002313.27,9002313.27,0,"DEL") @ "SEC","^DIC",9002313.27,9002313.27,0,"LAYGO") @ "SEC","^DIC",9002313.27,9002313.27,0,"RD") Pp "SEC","^DIC",9002313.27,9002313.27,0,"WR") @ "SEC","^DIC",9002313.28,9002313.28,0,"AUDIT") @ "SEC","^DIC",9002313.28,9002313.28,0,"DD") @ "SEC","^DIC",9002313.28,9002313.28,0,"DEL") @ "SEC","^DIC",9002313.28,9002313.28,0,"LAYGO") @ "SEC","^DIC",9002313.28,9002313.28,0,"RD") Pp "SEC","^DIC",9002313.28,9002313.28,0,"WR") @ "SEC","^DIC",9002313.29,9002313.29,0,"AUDIT") @ "SEC","^DIC",9002313.29,9002313.29,0,"DD") @ "SEC","^DIC",9002313.29,9002313.29,0,"DEL") @ "SEC","^DIC",9002313.29,9002313.29,0,"LAYGO") @ "SEC","^DIC",9002313.29,9002313.29,0,"RD") Pp "SEC","^DIC",9002313.29,9002313.29,0,"WR") @ "SEC","^DIC",9002313.91,9002313.91,0,"AUDIT") @ "SEC","^DIC",9002313.91,9002313.91,0,"DD") @ "SEC","^DIC",9002313.91,9002313.91,0,"DEL") @ "SEC","^DIC",9002313.91,9002313.91,0,"LAYGO") @ "SEC","^DIC",9002313.91,9002313.91,0,"RD") Pp "SEC","^DIC",9002313.91,9002313.91,0,"WR") @ "SEC","^DIC",9002313.93,9002313.93,0,"AUDIT") @ "SEC","^DIC",9002313.93,9002313.93,0,"DD") @ "SEC","^DIC",9002313.93,9002313.93,0,"DEL") @ "SEC","^DIC",9002313.93,9002313.93,0,"LAYGO") @ "SEC","^DIC",9002313.93,9002313.93,0,"RD") Pp "SEC","^DIC",9002313.93,9002313.93,0,"WR") @ "SEC","^DIC",9002313.94,9002313.94,0,"AUDIT") @ "SEC","^DIC",9002313.94,9002313.94,0,"DD") @ "SEC","^DIC",9002313.94,9002313.94,0,"DEL") @ "SEC","^DIC",9002313.94,9002313.94,0,"LAYGO") @ "SEC","^DIC",9002313.94,9002313.94,0,"RD") @ "SEC","^DIC",9002313.94,9002313.94,0,"WR") @ "UP",9002313.31,9002313.3122,-2) 9002313.31^2 "UP",9002313.31,9002313.3122,-1) 9002313.312^2 "UP",9002313.31,9002313.3122,0) 9002313.3122 "UP",9002313.31,9002313.3123,-2) 9002313.31^2 "UP",9002313.31,9002313.3123,-1) 9002313.312^3 "UP",9002313.31,9002313.3123,0) 9002313.3123 "UP",9002313.31,9002313.31231,-3) 9002313.31^2 "UP",9002313.31,9002313.31231,-2) 9002313.312^3 "UP",9002313.31,9002313.31231,-1) 9002313.3123^1 "UP",9002313.31,9002313.31231,0) 9002313.31231 "UP",9002313.31,9002313.31232,-3) 9002313.31^2 "UP",9002313.31,9002313.31232,-2) 9002313.312^3 "UP",9002313.31,9002313.31232,-1) 9002313.3123^2 "UP",9002313.31,9002313.31232,0) 9002313.31232 "UP",9002313.31,9002313.31233,-3) 9002313.31^2 "UP",9002313.31,9002313.31233,-2) 9002313.312^3 "UP",9002313.31,9002313.31233,-1) 9002313.3123^3 "UP",9002313.31,9002313.31233,0) 9002313.31233 "UP",9002313.31,9002313.31234,-3) 9002313.31^2 "UP",9002313.31,9002313.31234,-2) 9002313.312^3 "UP",9002313.31,9002313.31234,-1) 9002313.3123^4 "UP",9002313.31,9002313.31234,0) 9002313.31234 "UP",9002313.31,9002313.3124,-2) 9002313.31^2 "UP",9002313.31,9002313.3124,-1) 9002313.312^4 "UP",9002313.31,9002313.3124,0) 9002313.3124 "UP",9002313.57,9002313.57902,-1) 9002313.57^10 "UP",9002313.57,9002313.57902,0) 9002313.57902 "UP",9002313.59,9002313.59902,-1) 9002313.59^10 "UP",9002313.59,9002313.59902,0) 9002313.59902 "UP",9002313.92,9002313.9205,-1) 9002313.92^100 "UP",9002313.92,9002313.9205,0) 9002313.9205 "UP",9002313.92,9002313.92051,-2) 9002313.92^100 "UP",9002313.92,9002313.92051,-1) 9002313.9205^1 "UP",9002313.92,9002313.92051,0) 9002313.92051 "UP",9002313.92,9002313.9206,-1) 9002313.92^110 "UP",9002313.92,9002313.9206,0) 9002313.9206 "UP",9002313.92,9002313.92061,-2) 9002313.92^110 "UP",9002313.92,9002313.92061,-1) 9002313.9206^1 "UP",9002313.92,9002313.92061,0) 9002313.92061 "UP",9002313.92,9002313.9207,-1) 9002313.92^120 "UP",9002313.92,9002313.9207,0) 9002313.9207 "UP",9002313.92,9002313.92071,-2) 9002313.92^120 "UP",9002313.92,9002313.92071,-1) 9002313.9207^1 "UP",9002313.92,9002313.92071,0) 9002313.92071 "UP",9002313.92,9002313.9208,-1) 9002313.92^130 "UP",9002313.92,9002313.9208,0) 9002313.9208 "UP",9002313.92,9002313.92081,-2) 9002313.92^130 "UP",9002313.92,9002313.92081,-1) 9002313.9208^1 "UP",9002313.92,9002313.92081,0) 9002313.92081 "UP",9002313.92,9002313.9209,-1) 9002313.92^140 "UP",9002313.92,9002313.9209,0) 9002313.9209 "UP",9002313.92,9002313.92091,-2) 9002313.92^140 "UP",9002313.92,9002313.92091,-1) 9002313.9209^1 "UP",9002313.92,9002313.92091,0) 9002313.92091 "UP",9002313.92,9002313.921,-1) 9002313.92^150 "UP",9002313.92,9002313.921,0) 9002313.921 "UP",9002313.92,9002313.9211,-2) 9002313.92^150 "UP",9002313.92,9002313.9211,-1) 9002313.921^1 "UP",9002313.92,9002313.9211,0) 9002313.9211 "UP",9002313.92,9002313.9213,-1) 9002313.92^160 "UP",9002313.92,9002313.9213,0) 9002313.9213 "UP",9002313.92,9002313.92131,-2) 9002313.92^160 "UP",9002313.92,9002313.92131,-1) 9002313.9213^1 "UP",9002313.92,9002313.92131,0) 9002313.92131 "UP",9002313.92,9002313.9214,-1) 9002313.92^170 "UP",9002313.92,9002313.9214,0) 9002313.9214 "UP",9002313.92,9002313.92141,-2) 9002313.92^170 "UP",9002313.92,9002313.92141,-1) 9002313.9214^1 "UP",9002313.92,9002313.92141,0) 9002313.92141 "UP",9002313.92,9002313.9215,-1) 9002313.92^180 "UP",9002313.92,9002313.9215,0) 9002313.9215 "UP",9002313.92,9002313.92151,-2) 9002313.92^180 "UP",9002313.92,9002313.92151,-1) 9002313.9215^1 "UP",9002313.92,9002313.92151,0) 9002313.92151 "UP",9002313.92,9002313.9216,-1) 9002313.92^190 "UP",9002313.92,9002313.9216,0) 9002313.9216 "UP",9002313.92,9002313.92161,-2) 9002313.92^190 "UP",9002313.92,9002313.92161,-1) 9002313.9216^1 "UP",9002313.92,9002313.92161,0) 9002313.92161 "UP",9002313.92,9002313.9217,-1) 9002313.92^200 "UP",9002313.92,9002313.9217,0) 9002313.9217 "UP",9002313.92,9002313.92171,-2) 9002313.92^200 "UP",9002313.92,9002313.92171,-1) 9002313.9217^1 "UP",9002313.92,9002313.92171,0) 9002313.92171 "UP",9002313.92,9002313.9218,-1) 9002313.92^210 "UP",9002313.92,9002313.9218,0) 9002313.9218 "UP",9002313.92,9002313.92181,-2) 9002313.92^210 "UP",9002313.92,9002313.92181,-1) 9002313.9218^1 "UP",9002313.92,9002313.92181,0) 9002313.92181 "UP",9002313.92,9002313.9219,-1) 9002313.92^220 "UP",9002313.92,9002313.9219,0) 9002313.9219 "UP",9002313.92,9002313.92191,-2) 9002313.92^220 "UP",9002313.92,9002313.92191,-1) 9002313.9219^1 "UP",9002313.92,9002313.92191,0) 9002313.92191 "UP",9002313.92,9002313.922,-1) 9002313.92^230 "UP",9002313.92,9002313.922,0) 9002313.922 "UP",9002313.92,9002313.9221,-2) 9002313.92^230 "UP",9002313.92,9002313.9221,-1) 9002313.922^1 "UP",9002313.92,9002313.9221,0) 9002313.9221 "UP",9002313.92,9002313.9223,-1) 9002313.92^240 "UP",9002313.92,9002313.9223,0) 9002313.9223 "UP",9002313.92,9002313.92231,-2) 9002313.92^240 "UP",9002313.92,9002313.92231,-1) 9002313.9223^1 "UP",9002313.92,9002313.92231,0) 9002313.92231 "UP",9002313.92,9002313.92232,-2) 9002313.92^240 "UP",9002313.92,9002313.92232,-1) 9002313.9223^2 "UP",9002313.92,9002313.92232,0) 9002313.92232 "UP",9002313.92,9002313.9224,-1) 9002313.92^250 "UP",9002313.92,9002313.9224,0) 9002313.9224 "UP",9002313.92,9002313.92241,-2) 9002313.92^250 "UP",9002313.92,9002313.92241,-1) 9002313.9224^1 "UP",9002313.92,9002313.92241,0) 9002313.92241 "UP",9002313.92,9002313.92242,-2) 9002313.92^250 "UP",9002313.92,9002313.92242,-1) 9002313.9224^2 "UP",9002313.92,9002313.92242,0) 9002313.92242 "UP",9002313.92,9002313.9225,-1) 9002313.92^260 "UP",9002313.92,9002313.9225,0) 9002313.9225 "UP",9002313.92,9002313.92251,-2) 9002313.92^260 "UP",9002313.92,9002313.92251,-1) 9002313.9225^1 "UP",9002313.92,9002313.92251,0) 9002313.92251 "UP",9002313.92,9002313.92252,-2) 9002313.92^260 "UP",9002313.92,9002313.92252,-1) 9002313.9225^2 "UP",9002313.92,9002313.92252,0) 9002313.92252 "VER") 8.0^22.0 "^DD",9002313.02,9002313.02,0) FIELD^^360^66 "^DD",9002313.02,9002313.02,0,"DDA") N "^DD",9002313.02,9002313.02,0,"DT") 3101025 "^DD",9002313.02,9002313.02,0,"IX","AD",9002313.02,.04) "^DD",9002313.02,9002313.02,0,"IX","AE",9002313.02,.05) "^DD",9002313.02,9002313.02,0,"IX","AF",9002313.02,401) "^DD",9002313.02,9002313.02,0,"IX","AG",9002313.02,902) "^DD",9002313.02,9002313.02,0,"IX","B",9002313.02,.01) "^DD",9002313.02,9002313.02,0,"IX","C",9002313.02,1.01) "^DD",9002313.02,9002313.02,0,"NM","BPS CLAIMS") "^DD",9002313.02,9002313.02,0,"PT",9002313.03,.01) "^DD",9002313.02,9002313.02,0,"PT",9002313.31,.03) "^DD",9002313.02,9002313.02,0,"PT",9002313.57,3) "^DD",9002313.02,9002313.02,0,"PT",9002313.57,401) "^DD",9002313.02,9002313.02,0,"PT",9002313.59,3) "^DD",9002313.02,9002313.02,0,"PT",9002313.59,401) "^DD",9002313.02,9002313.02,0,"VRPK") BPS "^DD",9002313.02,9002313.02,.01,0) CLAIM ID^F^^0;1^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.02,.01,1,0) ^.1 "^DD",9002313.02,9002313.02,.01,1,1,0) 9002313.02^B^MUMPS "^DD",9002313.02,9002313.02,.01,1,1,1) S ^BPSC("B",$E(X,1,32),DA)="" "^DD",9002313.02,9002313.02,.01,1,1,2) K ^BPSC("B",$E(X,1,32),DA) "^DD",9002313.02,9002313.02,.01,1,1,"DT") 3030725 "^DD",9002313.02,9002313.02,.01,3) Answer must be 1-32 characters in length. "^DD",9002313.02,9002313.02,.01,21,0) ^^4^4^3080604^ "^DD",9002313.02,9002313.02,.01,21,1,0) External Claim ID value. This value is a concatenation of the text 'VA' "^DD",9002313.02,9002313.02,.01,21,2,0) along with the current year, the pharmacy ID, the VA National Plan ID "^DD",9002313.02,9002313.02,.01,21,3,0) (without the alpha prefix), and a unique sequence number. Each of the "^DD",9002313.02,9002313.02,.01,21,4,0) four pieces is delimited by the equal sign ("="). "^DD",9002313.02,9002313.02,.01,"DT") 3080604 "^DD",9002313.02,9002313.02,.02,0) ELECTRONIC PAYER^P9002313.92'^BPSF(9002313.92,^0;2^Q "^DD",9002313.02,9002313.02,.02,3) Enter the payer sheet for the claim "^DD",9002313.02,9002313.02,.02,21,0) ^.001^1^1^3101001^^ "^DD",9002313.02,9002313.02,.02,21,1,0) This is the payer sheet used by the claim "^DD",9002313.02,9002313.02,.02,"DT") 3080102 "^DD",9002313.02,9002313.02,.04,0) TRANSMIT FLAG^S^1:YES (BATCH FILE);0:NO;2:YES (POINT OF SALE);^0;4^Q "^DD",9002313.02,9002313.02,.04,1,0) ^.1 "^DD",9002313.02,9002313.02,.04,1,1,0) 9002313.02^AD "^DD",9002313.02,9002313.02,.04,1,1,1) S ^BPSC("AD",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.02,.04,1,1,2) K ^BPSC("AD",$E(X,1,30),DA) "^DD",9002313.02,9002313.02,.04,1,1,"DT") 2950524 "^DD",9002313.02,9002313.02,.04,3) Specify if this claim should be transmitted and the mode. "^DD",9002313.02,9002313.02,.04,21,0) ^.001^2^2^3050316^^ "^DD",9002313.02,9002313.02,.04,21,1,0) Numerical code to indicate a transmit status. Current values are 0 for "^DD",9002313.02,9002313.02,.04,21,2,0) 'No' 1 for 'Yes' Batch and 2 for 'Yes' Point of Sale. "^DD",9002313.02,9002313.02,.04,"DT") 3080102 "^DD",9002313.02,9002313.02,.05,0) TRANSMITTED ON^DO^^0;5^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",9002313.02,9002313.02,.05,.1) "^DD",9002313.02,9002313.02,.05,1,0) ^.1 "^DD",9002313.02,9002313.02,.05,1,1,0) 9002313.02^AE "^DD",9002313.02,9002313.02,.05,1,1,1) S ^BPSC("AE",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.02,.05,1,1,2) K ^BPSC("AE",$E(X,1,30),DA) "^DD",9002313.02,9002313.02,.05,1,1,"DT") 2950622 "^DD",9002313.02,9002313.02,.05,2) S Y(0)=Y S Y=$$FM2EXT^BPSOSU1(Y) "^DD",9002313.02,9002313.02,.05,2.1) S Y=$$FM2EXT^BPSOSU1(Y) "^DD",9002313.02,9002313.02,.05,3) Enter Date/Time this claim was transmitted "^DD",9002313.02,9002313.02,.05,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,.05,21,1,0) Date on which the data was transmitted. "^DD",9002313.02,9002313.02,.05,"DT") 3080102 "^DD",9002313.02,9002313.02,.06,0) CREATED ON^DO^^0;6^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",9002313.02,9002313.02,.06,2) S Y(0)=Y S Y=$$FM2EXT^BPSOSU1(Y) "^DD",9002313.02,9002313.02,.06,2.1) S Y=$$FM2EXT^BPSOSU1(Y) "^DD",9002313.02,9002313.02,.06,3) Enter Date/Time this claim was created "^DD",9002313.02,9002313.02,.06,21,0) ^^1^1^3031125^^ "^DD",9002313.02,9002313.02,.06,21,1,0) Date on which this record was created. "^DD",9002313.02,9002313.02,.06,"DT") 3080102 "^DD",9002313.02,9002313.02,.07,0) AUTO REVERSE FLAG^S^0:NO;1:UNRELEASED CLAIM;2:INPATIENT CLAIM;^0;7^Q "^DD",9002313.02,9002313.02,.07,3) If auto-reversed, enter the type of auto-reversal "^DD",9002313.02,9002313.02,.07,21,0) ^^3^3^3060105^ "^DD",9002313.02,9002313.02,.07,21,1,0) This flag is marking ECME Claims that were automatically reversed because "^DD",9002313.02,9002313.02,.07,21,2,0) the Prescription was not released in time or the claim was an inpatient "^DD",9002313.02,9002313.02,.07,21,3,0) claim. "^DD",9002313.02,9002313.02,.07,"DT") 3060105 "^DD",9002313.02,9002313.02,.08,0) TRANSACTION^P9002313.59'^BPST(^0;8^Q "^DD",9002313.02,9002313.02,.08,3) Enter the transaction for the claim. "^DD",9002313.02,9002313.02,.08,21,0) ^.001^1^1^3081229^^^ "^DD",9002313.02,9002313.02,.08,21,1,0) This is the ECME transaction that generates the claim. "^DD",9002313.02,9002313.02,.08,"DT") 3081229 "^DD",9002313.02,9002313.02,1.01,0) PATIENT NAME^F^^1;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<1) X "^DD",9002313.02,9002313.02,1.01,1,0) ^.1 "^DD",9002313.02,9002313.02,1.01,1,1,0) 9002313.02^C "^DD",9002313.02,9002313.02,1.01,1,1,1) S ^BPSC("C",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.02,1.01,1,1,2) K ^BPSC("C",$E(X,1,30),DA) "^DD",9002313.02,9002313.02,1.01,1,1,"DT") 2950606 "^DD",9002313.02,9002313.02,1.01,3) Answer must be 1-30 characters in length. "^DD",9002313.02,9002313.02,1.01,21,0) ^^2^2^3040331^ "^DD",9002313.02,9002313.02,1.01,21,1,0) Patient name extracted from the VA patient file. This entry is free text "^DD",9002313.02,9002313.02,1.01,21,2,0) to accommodate the NCPDP formatting requirements. "^DD",9002313.02,9002313.02,1.01,"DT") 3080102 "^DD",9002313.02,9002313.02,1.04,0) GROUP INSURANCE PLAN^P355.3'^IBA(355.3,^1;4^Q "^DD",9002313.02,9002313.02,1.04,3) Enter the Group Insurance "^DD",9002313.02,9002313.02,1.04,21,0) ^^1^1^3061120^ "^DD",9002313.02,9002313.02,1.04,21,1,0) Internal identifier number for the Group Insurance Record "^DD",9002313.02,9002313.02,1.04,"DT") 3080102 "^DD",9002313.02,9002313.02,101,0) BIN NUMBER^F^^100;1^K:$L(X)>6!($L(X)<6) X "^DD",9002313.02,9002313.02,101,3) Answer must be 6 characters in length. "^DD",9002313.02,9002313.02,101,21,0) ^^1^1^3031124^ "^DD",9002313.02,9002313.02,101,21,1,0) Card Issuer ID or Bank ID Number used for network routing. "^DD",9002313.02,9002313.02,101,"DT") 3080102 "^DD",9002313.02,9002313.02,102,0) VERSION RELEASE NUMBER^F^^100;2^K:$L(X)>2!($L(X)<2) X "^DD",9002313.02,9002313.02,102,3) Answer must be 2 characters in length. "^DD",9002313.02,9002313.02,102,21,0) ^^2^2^3031124^ "^DD",9002313.02,9002313.02,102,21,1,0) Code identifying the Enrollment Standard format of the file sent or "^DD",9002313.02,9002313.02,102,21,2,0) received. "^DD",9002313.02,9002313.02,102,"DT") 3080102 "^DD",9002313.02,9002313.02,103,0) TRANSACTION CODE^F^^100;3^K:$L(X)>2!($L(X)<2) X "^DD",9002313.02,9002313.02,103,3) Answer must be 2 characters in length. "^DD",9002313.02,9002313.02,103,21,0) ^^15^15^3031124^ "^DD",9002313.02,9002313.02,103,21,1,0) Code to identify the transaction type for this claim. "^DD",9002313.02,9002313.02,103,21,2,0) E1=Eligibility Verification "^DD",9002313.02,9002313.02,103,21,3,0) B1=Billing "^DD",9002313.02,9002313.02,103,21,4,0) B2=Reversal "^DD",9002313.02,9002313.02,103,21,5,0) B3=Rebill "^DD",9002313.02,9002313.02,103,21,6,0) P1=P.A. Request & Billing "^DD",9002313.02,9002313.02,103,21,7,0) P2=P.A. Reversal "^DD",9002313.02,9002313.02,103,21,8,0) P3=P.A. Inquiry "^DD",9002313.02,9002313.02,103,21,9,0) P4=P.A. Request Only "^DD",9002313.02,9002313.02,103,21,10,0) N1=Information Reporting "^DD",9002313.02,9002313.02,103,21,11,0) N2=Information Reporting Reversal "^DD",9002313.02,9002313.02,103,21,12,0) N3=Information Reporting Rebill "^DD",9002313.02,9002313.02,103,21,13,0) C1=Controlled Substance Reporting "^DD",9002313.02,9002313.02,103,21,14,0) C2=Controlled Substance Reporting Reversal "^DD",9002313.02,9002313.02,103,21,15,0) C3=Controlled Substance Reporting Rebill "^DD",9002313.02,9002313.02,103,"DT") 3080102 "^DD",9002313.02,9002313.02,104,0) PROCESSOR CONTROL NUMBER^F^^100;4^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.02,104,3) Answer must be 10 characters in length. "^DD",9002313.02,9002313.02,104,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,104,21,1,0) Number which will uniquely identify the submitter of the claim. NCPDP "^DD",9002313.02,9002313.02,104,21,2,0) field 104-A4. "^DD",9002313.02,9002313.02,104,"DT") 3080102 "^DD",9002313.02,9002313.02,109,0) TRANSACTION COUNT^F^^100;9^K:$L(X)>1!($L(X)<1) X "^DD",9002313.02,9002313.02,109,3) Answer must be 1 character in length. "^DD",9002313.02,9002313.02,109,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,109,21,1,0) Count of transactions in the transmission. NCPDP standard field 109-A9. "^DD",9002313.02,9002313.02,109,23,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,109,23,1,0) A transaction count of >1 is not allowed for Eligibility and Prior "^DD",9002313.02,9002313.02,109,23,2,0) Authorization transactions. REQUEST TRANSACTION HEADER SEGMENT. "^DD",9002313.02,9002313.02,109,"DT") 3080102 "^DD",9002313.02,9002313.02,110,0) SOFTWARE VENDER CERT ID^F^^100;10^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.02,110,3) Answer must be 10 characters in length. "^DD",9002313.02,9002313.02,110,21,0) ^^2^2^3080604^ "^DD",9002313.02,9002313.02,110,21,1,0) Certification number which Identifies the patient's insurance carrier. "^DD",9002313.02,9002313.02,110,21,2,0) NCPDP standard field 110-AK. "^DD",9002313.02,9002313.02,110,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,110,23,1,0) REQUEST TRANSACTION HEADER SEGMENT. "^DD",9002313.02,9002313.02,110,"DT") 3080604 "^DD",9002313.02,9002313.02,114,0) MEDICAID SUBROGATION ICN/TCN^F^^110;4^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.02,114,.1) MEDICAID SUBROGATION INTERNAL CONTROL NUMBER/TRANSACTION CONTROL NUMBER (ICN/TCN) "^DD",9002313.02,9002313.02,114,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.02,114,21,0) ^.001^2^2^3101019^^^^ "^DD",9002313.02,9002313.02,114,21,1,0) This is used to store NCPDP field 114-N4 (Medicaid Subrogation Internal Control Number/Transaction Control Number (ICN/TCN)), "^DD",9002313.02,9002313.02,114,21,2,0) which is defined as "Claim number assigned by the Medicaid Agency." "^DD",9002313.02,9002313.02,114,23,0) ^.001^2^2^3101019^^^^ "^DD",9002313.02,9002313.02,114,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.02,114,23,2,0) RESPONSE CLAIM SEGMENT. "^DD",9002313.02,9002313.02,114,"DT") 3101004 "^DD",9002313.02,9002313.02,115,0) MEDICAID ID NUMBER^F^^110;5^K:$L(X)>20!($L(X)<1) X "^DD",9002313.02,9002313.02,115,3) Answer must be 1-20 characters. "^DD",9002313.02,9002313.02,115,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,115,21,1,0) This is used to store NCPDP field 115-N5 (Medicaid ID Number), "^DD",9002313.02,9002313.02,115,21,2,0) which is defined as "A unique member identification number assigned by the Medicaid Agency." "^DD",9002313.02,9002313.02,115,23,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,115,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,115,23,2,0) RESPONSE INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,115,"DT") 3100831 "^DD",9002313.02,9002313.02,116,0) MEDICAID AGENCY NUMBER^F^^110;6^K:$L(X)>15!($L(X)<1) X "^DD",9002313.02,9002313.02,116,3) Answer must be 1-15 characters. "^DD",9002313.02,9002313.02,116,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,116,21,1,0) This is used to store NCPDP field 116-N6 (Medicaid Agency Number), "^DD",9002313.02,9002313.02,116,21,2,0) which is defined as "Number assigned by processor to identify the individual Medicaid Agency or representative." "^DD",9002313.02,9002313.02,116,23,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,116,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,116,23,2,0) RESPONSE INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,116,"DT") 3100831 "^DD",9002313.02,9002313.02,201,0) SERVICE PROVIDER ID^F^^200;1^K:$L(X)>15!($L(X)<15) X "^DD",9002313.02,9002313.02,201,3) Answer must be 15 characters in length "^DD",9002313.02,9002313.02,201,21,0) ^.001^1^1^3101001^^ "^DD",9002313.02,9002313.02,201,21,1,0) ID assigned to a pharmacy or provider. NCPDP standard field 201-B1. "^DD",9002313.02,9002313.02,201,23,0) ^.001^2^2^3101001^^ "^DD",9002313.02,9002313.02,201,23,1,0) REQUEST TRANSACTION HEADER SEGMENT. "^DD",9002313.02,9002313.02,201,23,2,0) RESPONSE HEADER SEGMENT. "^DD",9002313.02,9002313.02,201,"DT") 3080102 "^DD",9002313.02,9002313.02,202,0) SERVICE PROVIDER ID QUAL^F^^200;2^K:$L(X)>2!($L(X)<2) X "^DD",9002313.02,9002313.02,202,3) Answer must be 2 characters in length. "^DD",9002313.02,9002313.02,202,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,202,21,1,0) Qualifier indicating which ID number was used. NCPDP standard field "^DD",9002313.02,9002313.02,202,21,2,0) 202-B2. "^DD",9002313.02,9002313.02,202,23,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,202,23,1,0) REQUEST TRANSACTION HEADER SEGMENT. "^DD",9002313.02,9002313.02,202,23,2,0) RESPONSE HEADER SEGMENT. "^DD",9002313.02,9002313.02,202,"DT") 3080102 "^DD",9002313.02,9002313.02,301,0) GROUP ID^F^^300;1^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.02,301,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.02,301,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,301,21,1,0) ID assigned to the cardholder group or employer group. NCPDP standard "^DD",9002313.02,9002313.02,301,21,2,0) field 301-C1. "^DD",9002313.02,9002313.02,301,23,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,301,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,301,23,2,0) RESPONSE INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,301,"DT") 3080102 "^DD",9002313.02,9002313.02,302,0) CARDHOLDER ID^F^^300;2^K:$L(X)>20!($L(X)<2) X "^DD",9002313.02,9002313.02,302,3) Answer must be 2-20 characters in length "^DD",9002313.02,9002313.02,302,21,0) ^.001^2^2^3101020^^ "^DD",9002313.02,9002313.02,302,21,1,0) Insurance ID assigned to the cardholder or identification number used by "^DD",9002313.02,9002313.02,302,21,2,0) the plan. NCPDP standard field 302-C2. "^DD",9002313.02,9002313.02,302,23,0) ^.001^2^2^3101020^^ "^DD",9002313.02,9002313.02,302,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,302,23,2,0) RESPONSE INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,302,"DT") 3080102 "^DD",9002313.02,9002313.02,303,0) PERSON CODE^F^^300;3^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.02,303,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.02,303,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,303,21,1,0) Code assigned to a specific person within a family. NCPDP standard field "^DD",9002313.02,9002313.02,303,21,2,0) 303-C3. "^DD",9002313.02,9002313.02,303,23,0) ^^8^8^3080102^ "^DD",9002313.02,9002313.02,303,23,1,0) Regarding the Telecommunication Standard: "^DD",9002313.02,9002313.02,303,23,2,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,303,23,3,0) - - - - - - - - - - - - - - - - - - - - - - - "^DD",9002313.02,9002313.02,303,23,4,0) Enrollment Standard Examples: "^DD",9002313.02,9002313.02,303,23,5,0) Examples: "^DD",9002313.02,9002313.02,303,23,6,0) 001=Cardholder "^DD",9002313.02,9002313.02,303,23,7,0) 002=Spouse "^DD",9002313.02,9002313.02,303,23,8,0) 003-999=Dependents and Others (including second spouses, etc.) "^DD",9002313.02,9002313.02,303,"DT") 3080102 "^DD",9002313.02,9002313.02,304,0) DATE OF BIRTH^F^^300;4^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.02,304,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.02,9002313.02,304,2.1) S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.02,9002313.02,304,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.02,304,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,304,21,1,0) Date of birth of patient. NCPDP standard field 304-C4. "^DD",9002313.02,9002313.02,304,23,0) ^^8^8^3080102^ "^DD",9002313.02,9002313.02,304,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.02,304,23,2,0) CC=Century "^DD",9002313.02,9002313.02,304,23,3,0) YY=Year "^DD",9002313.02,9002313.02,304,23,4,0) MM=Month "^DD",9002313.02,9002313.02,304,23,5,0) DD=Day "^DD",9002313.02,9002313.02,304,23,6,0) Examples: If a patient was born on July 27, 1970, this field would "^DD",9002313.02,9002313.02,304,23,7,0) reflect: 19700727. "^DD",9002313.02,9002313.02,304,23,8,0) REQUEST PATIENT SEGMENT. RESPONSE PATIENT SEGMENT. "^DD",9002313.02,9002313.02,304,"DT") 3080102 "^DD",9002313.02,9002313.02,305,0) PATIENT GENDER CODE^FO^^300;5^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.02,305,2) S Y(0)=Y S Y=$S(Y="C51":"MALE",Y="C52":"FEMALE",1:Y) "^DD",9002313.02,9002313.02,305,2.1) S Y=$S(Y="C51":"MALE",Y="C52":"FEMALE",1:Y) "^DD",9002313.02,9002313.02,305,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.02,305,21,0) ^^6^6^3080613^ "^DD",9002313.02,9002313.02,305,21,1,0) One of three codes to indicate the gender of the patient. "^DD",9002313.02,9002313.02,305,21,2,0) 0 = Not Specific "^DD",9002313.02,9002313.02,305,21,3,0) 1 = Male "^DD",9002313.02,9002313.02,305,21,4,0) 2 = Female "^DD",9002313.02,9002313.02,305,21,5,0) "^DD",9002313.02,9002313.02,305,21,6,0) NCPDP standard field 305-C5. "^DD",9002313.02,9002313.02,305,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,305,23,1,0) REQUEST PATIENT SEGMENT. "^DD",9002313.02,9002313.02,305,"DT") 3080613 "^DD",9002313.02,9002313.02,306,0) PATIENT RELATIONSHIP CODE^FO^^300;6^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.02,306,2) S Y(0)=Y S Y=$S(Y="C60":"NOT SPECIFIED",Y="C61":"CARDHOLDER",Y="C62":"SPOUSE",Y="C63":"CHILD",Y="C64":"OTHER",1:Y) "^DD",9002313.02,9002313.02,306,2.1) S Y=$S(Y="C60":"NOT SPECIFIED",Y="C61":"CARDHOLDER",Y="C62":"SPOUSE",Y="C63":"CHILD",Y="C64":"OTHER",1:Y) "^DD",9002313.02,9002313.02,306,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.02,306,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,306,21,1,0) Code indicating relationship of patient to cardholder. NCPDP standard "^DD",9002313.02,9002313.02,306,21,2,0) field 306-C6. "^DD",9002313.02,9002313.02,306,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,306,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,306,"DT") 3110309 "^DD",9002313.02,9002313.02,307,0) PLACE OF SERVICE^F^^300;7^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.02,307,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.02,307,21,0) ^^15^15^3080102^ "^DD",9002313.02,9002313.02,307,21,1,0) Code identifying the location of the patient when receiving pharmacy "^DD",9002313.02,9002313.02,307,21,2,0) services. NCPDP standard field 307-C7. (was PATIENT LOCATION) "^DD",9002313.02,9002313.02,307,21,3,0) "^DD",9002313.02,9002313.02,307,21,4,0) Ø=Not Specified "^DD",9002313.02,9002313.02,307,21,5,0) 1=Home "^DD",9002313.02,9002313.02,307,21,6,0) 2=Inter-Care "^DD",9002313.02,9002313.02,307,21,7,0) 3=Nursing Home "^DD",9002313.02,9002313.02,307,21,8,0) 4=Long Term/Extended Care "^DD",9002313.02,9002313.02,307,21,9,0) 5=Rest Home "^DD",9002313.02,9002313.02,307,21,10,0) 6=Boarding Home "^DD",9002313.02,9002313.02,307,21,11,0) 7=Skilled Care Facility "^DD",9002313.02,9002313.02,307,21,12,0) 8=Sub-Acute Care Facility "^DD",9002313.02,9002313.02,307,21,13,0) 9=Acute Care Facility "^DD",9002313.02,9002313.02,307,21,14,0) 1Ø=Outpatient "^DD",9002313.02,9002313.02,307,21,15,0) 11=Hospice "^DD",9002313.02,9002313.02,307,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,307,23,1,0) REQUEST PATIENT SEGMENT. "^DD",9002313.02,9002313.02,307,"DT") 3080102 "^DD",9002313.02,9002313.02,309,0) ELIGIBILITY CLARIFICATION CODE^F^^300;9^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.02,309,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.02,309,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,309,21,1,0) Code indicating that the pharmacy is clarifying eligibility based on "^DD",9002313.02,9002313.02,309,21,2,0) receiving a denial. NCPDP standard field 309-C9. "^DD",9002313.02,9002313.02,309,23,0) ^^4^4^3080102^ "^DD",9002313.02,9002313.02,309,23,1,0) Examples: The patient has become a student but eligibility has not yet "^DD",9002313.02,9002313.02,309,23,2,0) been updated. The pharmacy can indicate "3" so that the carrier may "^DD",9002313.02,9002313.02,309,23,3,0) override eligibility for this patient. "^DD",9002313.02,9002313.02,309,23,4,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,309,"DT") 3080102 "^DD",9002313.02,9002313.02,310,0) PATIENT FIRST NAME^F^^300;10^K:$L(X)>14!($L(X)<14) X "^DD",9002313.02,9002313.02,310,3) Answer must be 14 characters in length "^DD",9002313.02,9002313.02,310,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,310,21,1,0) First name of patient receiving the prescription. NCPDP standard field "^DD",9002313.02,9002313.02,310,21,2,0) 310-CA. "^DD",9002313.02,9002313.02,310,23,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,310,23,1,0) REQUEST PATIENT SEGMENT. "^DD",9002313.02,9002313.02,310,23,2,0) RESPONSE PATIENT SEGMENT "^DD",9002313.02,9002313.02,310,"DT") 3080102 "^DD",9002313.02,9002313.02,311,0) PATIENT LAST NAME^F^^300;11^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.02,311,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.02,311,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,311,21,1,0) Last Name of patient receiving the prescription. NCPDP standard field "^DD",9002313.02,9002313.02,311,21,2,0) 311-CB. "^DD",9002313.02,9002313.02,311,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,311,23,1,0) REQUEST PATIENT SEGMENT. RESPONSE PATIENT SEGMENT "^DD",9002313.02,9002313.02,311,"DT") 3080102 "^DD",9002313.02,9002313.02,312,0) CARDHOLDER FIRST NAME^F^^300;12^K:$L(X)>14!($L(X)<14) X "^DD",9002313.02,9002313.02,312,3) Answer must be 14 characters in length "^DD",9002313.02,9002313.02,312,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,312,21,1,0) First name of the Cardholder/Subscriber. NCPDP standard field 312-CC. "^DD",9002313.02,9002313.02,312,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,312,23,1,0) REQUEST INSURANCE SEGMENT "^DD",9002313.02,9002313.02,312,"DT") 3080102 "^DD",9002313.02,9002313.02,313,0) CARDHOLDER LAST NAME^F^^300;13^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.02,313,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.02,313,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,313,21,1,0) Last name of the cardholder/subscriber. NCPDP standard field 313-CD. "^DD",9002313.02,9002313.02,313,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,313,23,1,0) REQUEST INSURANCE SEGMENT "^DD",9002313.02,9002313.02,313,"DT") 3080102 "^DD",9002313.02,9002313.02,314,0) HOME PLAN^F^^300;14^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.02,314,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.02,314,21,0) ^^3^3^3080102^ "^DD",9002313.02,9002313.02,314,21,1,0) Code identifying the Blue Cross or Blue Shield plan ID which indicates "^DD",9002313.02,9002313.02,314,21,2,0) where the member's coverage has been designated. Usually where the member "^DD",9002313.02,9002313.02,314,21,3,0) lives or purchased their coverage. NCPDP standard field 314-CE. "^DD",9002313.02,9002313.02,314,23,0) ^^4^4^3080102^ "^DD",9002313.02,9002313.02,314,23,1,0) Used for interstate processing between Blue Cross and Blue Shield plans. "^DD",9002313.02,9002313.02,314,23,2,0) The Blue Cross codes are in the range less than 600 and Blue Shield codes "^DD",9002313.02,9002313.02,314,23,3,0) are greater than 599. "^DD",9002313.02,9002313.02,314,23,4,0) REQUEST INSURANCE SEGMENT "^DD",9002313.02,9002313.02,314,"DT") 3080102 "^DD",9002313.02,9002313.02,322,0) PATIENT STREET ADDRESS^F^^321;2^K:$L(X)>32!($L(X)<32) X "^DD",9002313.02,9002313.02,322,3) Answer must be 32 characters in length "^DD",9002313.02,9002313.02,322,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,322,21,1,0) Free-form text for Patient address information. NCPDP standard field "^DD",9002313.02,9002313.02,322,21,2,0) 322-CM. "^DD",9002313.02,9002313.02,322,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,322,23,1,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,322,"DT") 3080102 "^DD",9002313.02,9002313.02,323,0) PATIENT CITY ADDRESS^F^^321;3^K:$L(X)>22!($L(X)<22) X "^DD",9002313.02,9002313.02,323,3) Answer must be 22 characters in length "^DD",9002313.02,9002313.02,323,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,323,21,1,0) Free-form text for city name. NCPDP standard field 323-CN. "^DD",9002313.02,9002313.02,323,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,323,23,1,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,323,"DT") 3080102 "^DD",9002313.02,9002313.02,324,0) PATIENT STATE PROV ADDRESS^F^^321;4^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.02,324,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.02,324,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,324,21,1,0) Standard State/Province Code as defined by appropriate government "^DD",9002313.02,9002313.02,324,21,2,0) agency. NCPDP standard field 324-CO. "^DD",9002313.02,9002313.02,324,23,0) ^^3^3^3080102^ "^DD",9002313.02,9002313.02,324,23,1,0) Standard United States and Canadian province two-letter postal service "^DD",9002313.02,9002313.02,324,23,2,0) abbreviations should be used. "^DD",9002313.02,9002313.02,324,23,3,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,324,"DT") 3080102 "^DD",9002313.02,9002313.02,325,0) PATIENT ZIP POSTAL ZONE^F^^321;5^K:$L(X)>17!($L(X)<1) X "^DD",9002313.02,9002313.02,325,3) Answer must be 1-17 characters in length "^DD",9002313.02,9002313.02,325,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,325,21,1,0) Code defining international postal zone excluding punctuation and blanks "^DD",9002313.02,9002313.02,325,21,2,0) (zip code for US). NCPDP standard field 325-CP. "^DD",9002313.02,9002313.02,325,23,0) ^^9^9^3080102^ "^DD",9002313.02,9002313.02,325,23,1,0) This left-justified field contains the five-digit zip code, and may "^DD",9002313.02,9002313.02,325,23,2,0) include the four-digit expanded zip code in which the patient is located. "^DD",9002313.02,9002313.02,325,23,3,0) "^DD",9002313.02,9002313.02,325,23,4,0) Examples: If the zip code is 98765-4321, this field would reflect: "^DD",9002313.02,9002313.02,325,23,5,0) 987654321. "^DD",9002313.02,9002313.02,325,23,6,0) "^DD",9002313.02,9002313.02,325,23,7,0) If the zip code is 98765, this field would reflect: 98765 left justified. "^DD",9002313.02,9002313.02,325,23,8,0) "^DD",9002313.02,9002313.02,325,23,9,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,325,"DT") 3080102 "^DD",9002313.02,9002313.02,326,0) PATIENT PHONE NUMBER^F^^321;6^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.02,326,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.02,326,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,326,21,1,0) Ten-digit phone number of patient. NCPDP standard field 326-CQ. "^DD",9002313.02,9002313.02,326,23,0) ^^9^9^3080102^ "^DD",9002313.02,9002313.02,326,23,1,0) Format=AAAEEENNNN "^DD",9002313.02,9002313.02,326,23,2,0) AAA=Area Code "^DD",9002313.02,9002313.02,326,23,3,0) EEE=Exchange "^DD",9002313.02,9002313.02,326,23,4,0) NNNN=Number "^DD",9002313.02,9002313.02,326,23,5,0) "^DD",9002313.02,9002313.02,326,23,6,0) Examples: If the phone number is (313) 555-1212, this field would "^DD",9002313.02,9002313.02,326,23,7,0) reflect: 3135551212. "^DD",9002313.02,9002313.02,326,23,8,0) "^DD",9002313.02,9002313.02,326,23,9,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,326,"DT") 3080102 "^DD",9002313.02,9002313.02,331,0) PATIENT ID QUALIFIER^F^^330;1^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.02,331,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.02,331,21,0) ^^7^7^3080102^ "^DD",9002313.02,9002313.02,331,21,1,0) Code qualifying the 'Patient ID'(332-CY). NCPDP standard field 331-CX. "^DD",9002313.02,9002313.02,331,21,2,0) "^DD",9002313.02,9002313.02,331,21,3,0) Blank=Not Specified "^DD",9002313.02,9002313.02,331,21,4,0) Ø1=Social Security Number "^DD",9002313.02,9002313.02,331,21,5,0) Ø2=Driver's License Number "^DD",9002313.02,9002313.02,331,21,6,0) Ø3=U.S. Military ID "^DD",9002313.02,9002313.02,331,21,7,0) 99=Other "^DD",9002313.02,9002313.02,331,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,331,23,1,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,331,"DT") 3080102 "^DD",9002313.02,9002313.02,332,0) PATIENT ID^F^^330;2^K:$L(X)>22!($L(X)<22) X "^DD",9002313.02,9002313.02,332,3) Answer must be 22 characters in length "^DD",9002313.02,9002313.02,332,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,332,21,1,0) ID assigned to the patient. NCPDP standard field 332-CY. "^DD",9002313.02,9002313.02,332,23,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,332,23,1,0) Qualified by Patient Id Qualifier (331-CX). "^DD",9002313.02,9002313.02,332,23,2,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,332,"DT") 3080102 "^DD",9002313.02,9002313.02,333,0) EMPLOYER ID^F^^330;3^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.02,333,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.02,333,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,333,21,1,0) ID assigned to employer. NCPDP standard field 333-CZ. "^DD",9002313.02,9002313.02,333,23,0) ^^6^6^3080102^ "^DD",9002313.02,9002313.02,333,23,1,0) The Internal Revenue Service, Department of the Treasury, assigns the "^DD",9002313.02,9002313.02,333,23,2,0) Employer ID. The format of this field is nine-digits with a hyphen, as "^DD",9002313.02,9002313.02,333,23,3,0) in 00-0000000. The hyphen must be transmitted as part of the Employer ID "^DD",9002313.02,9002313.02,333,23,4,0) Number. Information on the Employer ID may be found at "^DD",9002313.02,9002313.02,333,23,5,0) http://www.irs.ustreas.gov/. "^DD",9002313.02,9002313.02,333,23,6,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,333,"DT") 3080102 "^DD",9002313.02,9002313.02,334,0) SMOKER INDICATOR^F^^330;4^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.02,334,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.02,334,21,0) ^^6^6^3080102^ "^DD",9002313.02,9002313.02,334,21,1,0) Code indicating the patient as a smoker or non-smoker. NCPDP standard "^DD",9002313.02,9002313.02,334,21,2,0) field 334-1C. "^DD",9002313.02,9002313.02,334,21,3,0) "^DD",9002313.02,9002313.02,334,21,4,0) Blank=Not Specified "^DD",9002313.02,9002313.02,334,21,5,0) 1=Non-Smoker "^DD",9002313.02,9002313.02,334,21,6,0) 2=Smoker "^DD",9002313.02,9002313.02,334,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,334,23,1,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,334,"DT") 3080102 "^DD",9002313.02,9002313.02,335,0) PREGNANCY INDICATOR^F^^330;5^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.02,335,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.02,335,21,0) ^^6^6^3080102^ "^DD",9002313.02,9002313.02,335,21,1,0) Code indicating the patient as pregnant or non-pregnant. NCPDP standard "^DD",9002313.02,9002313.02,335,21,2,0) field 335-2C. "^DD",9002313.02,9002313.02,335,21,3,0) "^DD",9002313.02,9002313.02,335,21,4,0) Blank=Not Specified "^DD",9002313.02,9002313.02,335,21,5,0) 1=Not pregnant "^DD",9002313.02,9002313.02,335,21,6,0) 2=Pregnant "^DD",9002313.02,9002313.02,335,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,335,23,1,0) REQUEST PATIENT SEGMENT "^DD",9002313.02,9002313.02,335,"DT") 3080102 "^DD",9002313.02,9002313.02,336,0) FACILITY ID^F^^330;6^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.02,336,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.02,336,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.02,336,21,1,0) ID assigned to the patient's clinic/host party. NCPDP standard field "^DD",9002313.02,9002313.02,336,21,2,0) 336-8C. "^DD",9002313.02,9002313.02,336,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.02,336,23,1,0) REQUEST INSURANCE SEGMENT "^DD",9002313.02,9002313.02,336,"DT") 3080102 "^DD",9002313.02,9002313.02,350,0) PATIENT E-MAIL ADDRESS^F^^340;10^K:$L(X)>82!($L(X)<1) X "^DD",9002313.02,9002313.02,350,3) Answer must be 1-82 characters in length. "^DD",9002313.02,9002313.02,350,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,350,21,1,0) This is used to store NCPDP field 350-HN (Patient E-Mail Address), "^DD",9002313.02,9002313.02,350,21,2,0) which is defined as "The E-Mail address of the patient (member)." "^DD",9002313.02,9002313.02,350,"DT") 3100727 "^DD",9002313.02,9002313.02,356,0) OTHER PAYER CARDHOLDER ID^F^^350;6^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.02,356,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.02,356,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,356,21,1,0) This is used to store NCPDP field 356-NU (Other Payer Cardholder ID), "^DD",9002313.02,9002313.02,356,21,2,0) which is defined as "Cardholder ID for this member that is associated with the Payer noted." "^DD",9002313.02,9002313.02,356,23,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,356,23,1,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.02,9002313.02,356,23,2,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,356,"DT") 3100831 "^DD",9002313.02,9002313.02,359,0) MEDIGAP ID^F^^350;9^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.02,359,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.02,359,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,359,21,1,0) This is used to store NCPDP field 359-2A (Medigap ID), "^DD",9002313.02,9002313.02,359,21,2,0) which is defined as "Patient's ID assigned by the Medigap Insurer." "^DD",9002313.02,9002313.02,359,23,0) ^.001^1^1^3101004^^^^ "^DD",9002313.02,9002313.02,359,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,359,"DT") 3100831 "^DD",9002313.02,9002313.02,360,0) MEDICAID INDICATOR^F^^350;10^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.02,360,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.02,360,21,0) ^.001^2^2^3101007^^ "^DD",9002313.02,9002313.02,360,21,1,0) This is used to store NCPDP field 360-2B (Medicaid Indicator), "^DD",9002313.02,9002313.02,360,21,2,0) which is defined as "Two character State Postal Code indicating the state where Medicaid coverage exists." "^DD",9002313.02,9002313.02,360,23,0) ^^1^1^3101007^ "^DD",9002313.02,9002313.02,360,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,360,"DT") 3101007 "^DD",9002313.02,9002313.02,361,0) PROVIDER ACCEPT ASSGNMT INDCTR^F^^360;1^K:$L(X)>3!($L(X)<1) X "^DD",9002313.02,9002313.02,361,.1) PROVIDER ACCEPT ASSIGNMENT INDICATOR "^DD",9002313.02,9002313.02,361,3) Answer must be 1-3 characters. "^DD",9002313.02,9002313.02,361,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,361,21,1,0) This is used to store NCPDP field 361-2D (Provider Accept Assignment Indicator), "^DD",9002313.02,9002313.02,361,21,2,0) which is defined as "Code indicating whether the provider accepts assignment." "^DD",9002313.02,9002313.02,361,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.02,9002313.02,361,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,361,"DT") 3100901 "^DD",9002313.02,9002313.02,384,0) PATIENT RESIDENCE^F^^380;4^K:$L(X)>2!($L(X)<1) X "^DD",9002313.02,9002313.02,384,3) Answer must be 1-2 characters. "^DD",9002313.02,9002313.02,384,21,0) 3^.001^2^2^3100929^^ "^DD",9002313.02,9002313.02,384,21,1,0) This is used to store NCPDP field 384-4X (Patient Residence), "^DD",9002313.02,9002313.02,384,21,2,0) which is defined as "Code identifying the patient's place of residence." "^DD",9002313.02,9002313.02,384,"DT") 3100727 "^DD",9002313.02,9002313.02,400,0) TRANSACTIONS^9002313.0201A^^400;0 "^DD",9002313.02,9002313.02,400,21,0) ^^3^3^3101022^ "^DD",9002313.02,9002313.02,400,21,1,0) This subfile has the transactions that are included in this request. "^DD",9002313.02,9002313.02,400,21,2,0) There is only one for reversals and eligibility verification request and "^DD",9002313.02,9002313.02,400,21,3,0) up to four for a billing request. "^DD",9002313.02,9002313.02,400,"DT") 3100922 "^DD",9002313.02,9002313.02,401,0) DATE OF SERVICE^F^^401;1^K:$L(X)>8!($L(X)<8) X "^DD",9002313.02,9002313.02,401,1,0) ^.1 "^DD",9002313.02,9002313.02,401,1,1,0) 9002313.02^AF "^DD",9002313.02,9002313.02,401,1,1,1) S ^BPSC("AF",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.02,401,1,1,2) K ^BPSC("AF",$E(X,1,30),DA) "^DD",9002313.02,9002313.02,401,1,1,"DT") 2950724 "^DD",9002313.02,9002313.02,401,3) Answer must be 8 characters in length "^DD",9002313.02,9002313.02,401,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.02,401,21,1,0) Date prescription was dispensed. NCPDP standard field 401-D1. "^DD",9002313.02,9002313.02,401,23,0) ^^12^12^3080104^ "^DD",9002313.02,9002313.02,401,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.02,401,23,2,0) "^DD",9002313.02,9002313.02,401,23,3,0) CC=Century "^DD",9002313.02,9002313.02,401,23,4,0) YY=Year "^DD",9002313.02,9002313.02,401,23,5,0) MM=Month "^DD",9002313.02,9002313.02,401,23,6,0) DD=Day "^DD",9002313.02,9002313.02,401,23,7,0) "^DD",9002313.02,9002313.02,401,23,8,0) Examples: If the prescription was dispensed on April 22, 2000, this field "^DD",9002313.02,9002313.02,401,23,9,0) would reflect 20000422. "^DD",9002313.02,9002313.02,401,23,10,0) "^DD",9002313.02,9002313.02,401,23,11,0) REQUEST TRANSACTION HEADER SEGMENT. "^DD",9002313.02,9002313.02,401,23,12,0) RESPONSE HEADER SEGMENT. "^DD",9002313.02,9002313.02,401,"DT") 3080604 "^DD",9002313.02,9002313.02,524,0) PLAN ID^F^^520;4^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.02,524,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.02,524,21,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.02,524,21,1,0) Assigned by the processor to identify a set of parameters, benefit, or "^DD",9002313.02,9002313.02,524,21,2,0) coverage criteria used to adjudicate a claim. NCPDP standard field "^DD",9002313.02,9002313.02,524,21,3,0) 524-FO. "^DD",9002313.02,9002313.02,524,23,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.02,524,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,524,23,2,0) RESPONSE INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,524,"DT") 3080104 "^DD",9002313.02,9002313.02,901,0) CLOSED^S^0:NO;1:YES;^900;1^Q "^DD",9002313.02,9002313.02,901,3) Enter if this claim is closed or not. "^DD",9002313.02,9002313.02,901,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.02,901,21,1,0) Specify if the claim has been closed (no longer needed for followup) or "^DD",9002313.02,9002313.02,901,21,2,0) not. "^DD",9002313.02,9002313.02,901,"DT") 3080104 "^DD",9002313.02,9002313.02,902,0) DATE CLOSED^D^^900;2^S %DT="ESTX" D ^%DT S X=Y K:X<1 X "^DD",9002313.02,9002313.02,902,1,0) ^.1 "^DD",9002313.02,9002313.02,902,1,1,0) 9002313.02^AG "^DD",9002313.02,9002313.02,902,1,1,1) S ^BPSC("AG",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.02,902,1,1,2) K ^BPSC("AG",$E(X,1,30),DA) "^DD",9002313.02,9002313.02,902,1,1,"DT") 3040518 "^DD",9002313.02,9002313.02,902,3) Enter the date this claim was closed. "^DD",9002313.02,9002313.02,902,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.02,902,21,1,0) This is automatically populated with the date a claim was closed. "^DD",9002313.02,9002313.02,902,"DT") 3080104 "^DD",9002313.02,9002313.02,903,0) CLOSED BY^P200'^VA(200,^900;3^Q "^DD",9002313.02,9002313.02,903,3) Enter the person who closed this claim. "^DD",9002313.02,9002313.02,903,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.02,903,21,1,0) This is automatically populated with the user who closed the claim. "^DD",9002313.02,9002313.02,903,"DT") 3080104 "^DD",9002313.02,9002313.02,904,0) CLOSED REASON^*P356.8'^IBE(356.8,^900;4^S DIC("S")="I $P(^IBE(356.8,+Y,0),U,2)" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X "^DD",9002313.02,9002313.02,904,3) Enter the Claim Close Reason. "^DD",9002313.02,9002313.02,904,12) Only ECME-supported non-billable reasons can be entered. "^DD",9002313.02,9002313.02,904,12.1) S DIC("S")="I $P(^IBE(356.8,+Y,0),U,2)" "^DD",9002313.02,9002313.02,904,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.02,904,21,1,0) The ECME-supported non-billable reason entered by the user or defaulted by "^DD",9002313.02,9002313.02,904,21,2,0) the system. "^DD",9002313.02,9002313.02,904,"DT") 3080104 "^DD",9002313.02,9002313.02,905,0) DROP TO PAPER^S^D:DROP TO PAPER;N:NON-BILLABLE;^900;5^Q "^DD",9002313.02,9002313.02,905,3) Enter D if this claim should be billed on a paper claim. "^DD",9002313.02,9002313.02,905,21,0) ^.001^4^4^3050518^^^ "^DD",9002313.02,9002313.02,905,21,1,0) If close reason is 90 DAY RX FILL NOT COVERED or "^DD",9002313.02,9002313.02,905,21,2,0) NOT A CONTRACTED PROVIDER then user will be prompted: "^DD",9002313.02,9002313.02,905,21,3,0) Treat as (N)on-Billable Episode or (D)rop Bill to Paper? "^DD",9002313.02,9002313.02,905,21,4,0) the answer is stored in this field and sent to IB "^DD",9002313.02,9002313.02,905,"DT") 3080104 "^DD",9002313.02,9002313.02,906,0) DATE REOPENED^D^^900;6^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",9002313.02,9002313.02,906,3) Enter the date and time when the claim was re-opened "^DD",9002313.02,9002313.02,906,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.02,906,21,1,0) Date and time when the claim was re-opened. "^DD",9002313.02,9002313.02,906,"DT") 3080104 "^DD",9002313.02,9002313.02,907,0) REOPENED BY^P200'^VA(200,^900;7^Q "^DD",9002313.02,9002313.02,907,3) Enter the user who re-opened the claim "^DD",9002313.02,9002313.02,907,21,0) ^^1^1^3060523^ "^DD",9002313.02,9002313.02,907,21,1,0) The system user who re-opened the claim. "^DD",9002313.02,9002313.02,907,"DT") 3060614 "^DD",9002313.02,9002313.02,908,0) REOPENED COMMENT^F^^900;8^K:$L(X)>40!($L(X)<1) X "^DD",9002313.02,9002313.02,908,3) Enter the reason for the re-opening of the claim "^DD",9002313.02,9002313.02,908,21,0) ^^1^1^3060614^ "^DD",9002313.02,9002313.02,908,21,1,0) User comments for the re-opening of the claim. "^DD",9002313.02,9002313.02,908,"DT") 3060614 "^DD",9002313.02,9002313.02,990,0) OTHER PAYER BIN NUMBER^F^^980;10^K:$L(X)>8!($L(X)<1) X "^DD",9002313.02,9002313.02,990,3) Answer must be 1-8 characters. "^DD",9002313.02,9002313.02,990,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,990,21,1,0) This is used to store NCPDP field 990-MG (Other Payer BIN Number), "^DD",9002313.02,9002313.02,990,21,2,0) which is defined as "The secondary, tertiary, etc. card issuer or bank ID number used for network routing." "^DD",9002313.02,9002313.02,990,23,0) ^.001^1^1^3101004^^^^ "^DD",9002313.02,9002313.02,990,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,990,"DT") 3100831 "^DD",9002313.02,9002313.02,991,0) OTHER PAYER PROCESSOR CNTRL NO^F^^990;1^K:$L(X)>12!($L(X)<1) X "^DD",9002313.02,9002313.02,991,.1) OTHER PAYER PROCESSOR CONTROL NUMBER "^DD",9002313.02,9002313.02,991,3) Answer must be 1-12 characters. "^DD",9002313.02,9002313.02,991,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,991,21,1,0) This is used to store NCPDP field 991-MH (Other Payer Processor Control Number), "^DD",9002313.02,9002313.02,991,21,2,0) which is defined as "A number that uniquely identifies the secondary, tertiary, etc. payer to the processor." "^DD",9002313.02,9002313.02,991,23,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,991,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,991,23,2,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.02,9002313.02,991,"DT") 3100831 "^DD",9002313.02,9002313.02,992,0) OTHER PAYER GROUP ID^F^^990;2^K:$L(X)>17!($L(X)<1) X "^DD",9002313.02,9002313.02,992,3) Answer must be 1-17 characters. "^DD",9002313.02,9002313.02,992,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,992,21,1,0) This is used to store NCPDP field 992-MJ (Other Payer Group ID), "^DD",9002313.02,9002313.02,992,21,2,0) which is defined as "ID assigned to the cardholder group or employer group by the secondary, tertiary, etc. payer." "^DD",9002313.02,9002313.02,992,23,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,992,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,992,23,2,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.02,9002313.02,992,"DT") 3100831 "^DD",9002313.02,9002313.02,997,0) CMS PART D DEFINED QLFD FACLTY^F^^990;7^K:$L(X)>3!($L(X)<1) X "^DD",9002313.02,9002313.02,997,.1) CMS PART D DEFINED QUALIFIED FACILITY "^DD",9002313.02,9002313.02,997,3) Answer must be 1-3 characters. "^DD",9002313.02,9002313.02,997,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02,997,21,1,0) This is used to store NCPDP field 997-G2 (CMS Part D Defined Qualified Facility), "^DD",9002313.02,9002313.02,997,21,2,0) which is defined as "Indicates that the patient resides in a facility that qualifies for the CMS Part D benefit." "^DD",9002313.02,9002313.02,997,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.02,9002313.02,997,23,1,0) REQUEST INSURANCE SEGMENT. "^DD",9002313.02,9002313.02,997,"DT") 3100831 "^DD",9002313.02,9002313.02,9999,0) RAW DATA SENT^9002313.29999^^M;0 "^DD",9002313.02,9002313.02,9999,3) Enter the Raw data transmitted to the payer. "^DD",9002313.02,9002313.02,9999,21,0) ^^1^1^3040331^ "^DD",9002313.02,9002313.02,9999,21,1,0) An exact copy of the record sent via the communications protocol. "^DD",9002313.02,9002313.0201,0) TRANSACTIONS SUB-FIELD^^357^145 "^DD",9002313.02,9002313.0201,0,"DT") 3101025 "^DD",9002313.02,9002313.0201,0,"IX","B",9002313.0201,.01) "^DD",9002313.02,9002313.0201,0,"NM","TRANSACTIONS") "^DD",9002313.02,9002313.0201,0,"UP") 9002313.02 "^DD",9002313.02,9002313.0201,.01,0) TRANSACTION ORDER^MNJ9,0^^0;1^K:+X'=X!(X>999999999)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.02,9002313.0201,.01,1,0) ^.1 "^DD",9002313.02,9002313.0201,.01,1,1,0) 9002313.0201^B "^DD",9002313.02,9002313.0201,.01,1,1,1) S ^BPSC(DA(1),400,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.0201,.01,1,1,2) K ^BPSC(DA(1),400,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.0201,.01,3) Type a number between 1 and 999999999, 0 decimal digits. "^DD",9002313.02,9002313.0201,.01,21,0) ^^3^3^3101022^ "^DD",9002313.02,9002313.0201,.01,21,1,0) This is the numeric value to indicate the order of the transactions. This "^DD",9002313.02,9002313.0201,.01,21,2,0) is a sequential value starting at 1 to store multiple transactions on "^DD",9002313.02,9002313.0201,.01,21,3,0) this request. "^DD",9002313.02,9002313.0201,.01,"DT") 3101022 "^DD",9002313.02,9002313.0201,.04,0) MEDICATION NAME^F^^0;4^K:$L(X)>50!($L(X)<1) X "^DD",9002313.02,9002313.0201,.04,3) Answer must be 1-50 characters in length. "^DD",9002313.02,9002313.0201,.04,21,0) ^^1^1^3031125^ "^DD",9002313.02,9002313.0201,.04,21,1,0) Name of the med ordered. "^DD",9002313.02,9002313.0201,.04,"DT") 3080102 "^DD",9002313.02,9002313.0201,.05,0) PRESCRIPTION NUMBER^P52'^PSRX(^0;5^Q "^DD",9002313.02,9002313.0201,.05,3) Enter the Prescription for this medication "^DD",9002313.02,9002313.0201,.05,21,0) ^^1^1^3070227^ "^DD",9002313.02,9002313.0201,.05,21,1,0) This is the prescription associated with the claim "^DD",9002313.02,9002313.0201,.05,"DT") 3080102 "^DD",9002313.02,9002313.0201,113,0) MEDICAID PAID AMOUNT^F^^110;3^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.0201,113,3) Answer must be 1-10 characters. "^DD",9002313.02,9002313.0201,113,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,113,21,1,0) This is used to store NCPDP field 113-N3 (Medicaid Paid Amount), "^DD",9002313.02,9002313.0201,113,21,2,0) which is defined as "Amount paid by the Medicaid Agency." "^DD",9002313.02,9002313.0201,113,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,113,23,1,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,113,"DT") 3100901 "^DD",9002313.02,9002313.0201,117,0) BILLING ENTITY TYPE INDICATOR^F^^110;7^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,117,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,117,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,117,21,1,0) This is used to store NCPDP field 117-TR (Billing Entity Type Indicator), "^DD",9002313.02,9002313.0201,117,21,2,0) which is defined as "A code that identifies the entity submitting the billing transaction." "^DD",9002313.02,9002313.0201,117,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,117,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,117,"DT") 3100901 "^DD",9002313.02,9002313.0201,118,0) PAY TO QUALIFIER^F^^110;8^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,118,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,118,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,118,21,1,0) This is used to store NCPDP field 118-TS (Pay To Qualifier), "^DD",9002313.02,9002313.0201,118,21,2,0) which is defined as "Code qualifying the Pay To ID (119-TT)." "^DD",9002313.02,9002313.0201,118,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,118,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,118,"DT") 3100901 "^DD",9002313.02,9002313.0201,119,0) PAY TO ID^F^^110;9^K:$L(X)>17!($L(X)<1) X "^DD",9002313.02,9002313.0201,119,3) Answer must be 1-17 characters. "^DD",9002313.02,9002313.0201,119,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,119,21,1,0) This is used to store NCPDP field 119-TT (Pay To ID), "^DD",9002313.02,9002313.0201,119,21,2,0) which is defined as "Identifying number of the entity to receive payment for claim." "^DD",9002313.02,9002313.0201,119,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,119,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,119,"DT") 3100901 "^DD",9002313.02,9002313.0201,120,0) PAY TO NAME^F^^110;10^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.0201,120,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.0201,120,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,120,21,1,0) This is used to store NCPDP field 120-TU (Pay To Name), "^DD",9002313.02,9002313.0201,120,21,2,0) which is defined as "Name of the entity to receive payment for claim." "^DD",9002313.02,9002313.0201,120,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,120,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,120,"DT") 3100901 "^DD",9002313.02,9002313.0201,121,0) PAY TO STREET ADDRESS^F^^120;1^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.0201,121,3) Answer must be 1-32 characters. "^DD",9002313.02,9002313.0201,121,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,121,21,1,0) This is used to store NCPDP field 121-TV (Pay To Street Address), "^DD",9002313.02,9002313.0201,121,21,2,0) which is defined as "Street address of the entity to receive payment for claim." "^DD",9002313.02,9002313.0201,121,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,121,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,121,"DT") 3100901 "^DD",9002313.02,9002313.0201,122,0) PAY TO CITY ADDRESS^F^^120;2^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.0201,122,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.0201,122,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,122,21,1,0) This is used to store NCPDP field 122-TW (Pay To City Address), "^DD",9002313.02,9002313.0201,122,21,2,0) which is defined as "City of the entity to receive payment for claim." "^DD",9002313.02,9002313.0201,122,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,122,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,122,"DT") 3100901 "^DD",9002313.02,9002313.0201,123,0) PAY TO STATE/PROVINCE ADDRESS^F^^120;3^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,123,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,123,21,0) ^.001^1^1^3100929^^^ "^DD",9002313.02,9002313.0201,123,21,1,0) This is used to store NCPDP field 123-TX (Pay to State/Province Address). "^DD",9002313.02,9002313.0201,123,23,0) ^.001^1^1^3100929^^ "^DD",9002313.02,9002313.0201,123,23,1,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,123,"DT") 3100901 "^DD",9002313.02,9002313.0201,124,0) PAY TO ZIP/POSTAL ZONE^F^^120;4^K:$L(X)>17!($L(X)<1) X "^DD",9002313.02,9002313.0201,124,3) Answer must be 1-17 characters. "^DD",9002313.02,9002313.0201,124,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.02,9002313.0201,124,21,1,0) This is used to store NCPDP field 124-TY (Pay To Zip/Postal Zone), "^DD",9002313.02,9002313.0201,124,21,2,0) which is defined as "Code defining international postal zone excluding punctuation and blanks (zip code for US)." "^DD",9002313.02,9002313.0201,124,23,0) ^.001^3^3^3100929^^ "^DD",9002313.02,9002313.0201,124,23,1,0) Examples: If the zip code is 98765-4321, this field would reflect: 987654321. "^DD",9002313.02,9002313.0201,124,23,2,0) If the zip code is 98765, this field would reflect: 98765 left justified. "^DD",9002313.02,9002313.0201,124,23,3,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,124,"DT") 3100901 "^DD",9002313.02,9002313.0201,125,0) GENERIC EQVLNT PRODUCT ID QLFR^F^^120;5^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,125,.1) GENERIC EQUIVALENT PRODUCT ID QUALIFIER "^DD",9002313.02,9002313.0201,125,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,125,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.02,9002313.0201,125,21,1,0) This is used to store NCPDP field 125-TZ (Generic Equivalent Product ID Qualifier), "^DD",9002313.02,9002313.0201,125,21,2,0) which is defined as "Code qualifying the Generic Equivalent Product ID (126-UA)." "^DD",9002313.02,9002313.0201,125,23,0) ^.001^2^2^3100929^^ "^DD",9002313.02,9002313.0201,125,23,1,0) Comments: Qualifies Generic Equivalent Product ID (126-UA). "^DD",9002313.02,9002313.0201,125,23,2,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,125,"DT") 3100901 "^DD",9002313.02,9002313.0201,126,0) GENERIC EQUIVALENT PRODUCT ID^F^^120;6^K:$L(X)>21!($L(X)<1) X "^DD",9002313.02,9002313.0201,126,3) Answer must be 1-21 characters. "^DD",9002313.02,9002313.0201,126,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.02,9002313.0201,126,21,1,0) This is used to store NCPDP field 126-UA (Generic Equivalent Product ID), "^DD",9002313.02,9002313.0201,126,21,2,0) which is defined as "Identifies the generic equivalent of the brand product dispensed." "^DD",9002313.02,9002313.0201,126,23,0) ^.001^3^3^3100929^^ "^DD",9002313.02,9002313.0201,126,23,1,0) Comments: Qualified by Generic Equivalent Product ID Qualifier (125-TZ). "^DD",9002313.02,9002313.0201,126,23,2,0) Qualifier (118-TS). "^DD",9002313.02,9002313.0201,126,23,3,0) REQUEST WORKERS' COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,126,"DT") 3100901 "^DD",9002313.02,9002313.0201,147,0) PHARMACY SERVICE TYPE^F^^140;7^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,147,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,147,21,0) ^.001^3^3^3101004^^^ "^DD",9002313.02,9002313.0201,147,21,1,0) This is used to store NCPDP field 147-U7 (Pharmacy Service Type), "^DD",9002313.02,9002313.0201,147,21,2,0) which is defined as "The type of service being performed by a pharmacy when different contractual terms exist between a payer and the pharmacy, "^DD",9002313.02,9002313.0201,147,21,3,0) or when benefits are based upon the type of service performed." "^DD",9002313.02,9002313.0201,147,23,0) ^.001^1^1^3101004^^ "^DD",9002313.02,9002313.0201,147,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,147,"DT") 3100831 "^DD",9002313.02,9002313.0201,308,0) OTHER COVERAGE CODE^F^^300;8^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,308,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,308,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.0201,308,21,1,0) Code indicating whether or not the patient has other insurance coverage. "^DD",9002313.02,9002313.0201,308,21,2,0) NCPDP standard field 308-C8. "^DD",9002313.02,9002313.0201,308,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,308,23,1,0) REQUEST CLAIM SEGMENT "^DD",9002313.02,9002313.0201,308,"DT") 3080102 "^DD",9002313.02,9002313.0201,315,0) EMPLOYER NAME^F^^310;5^K:$L(X)>32!($L(X)<32) X "^DD",9002313.02,9002313.0201,315,3) Answer must be 32 characters in length "^DD",9002313.02,9002313.0201,315,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,315,21,1,0) Complete name of employer. NCPDP standard field 315-CF. "^DD",9002313.02,9002313.0201,315,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,315,23,1,0) REQUEST WORKER'S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,315,"DT") 3080102 "^DD",9002313.02,9002313.0201,316,0) EMPLOYER STREET ADDRESS^F^^310;6^K:$L(X)>32!($L(X)<32) X "^DD",9002313.02,9002313.0201,316,3) Answer must be 32 characters in length "^DD",9002313.02,9002313.0201,316,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.0201,316,21,1,0) The Street address of the insured's employer. NCPDP standard field "^DD",9002313.02,9002313.0201,316,21,2,0) 316-CG. "^DD",9002313.02,9002313.0201,316,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,316,23,1,0) REQUEST WORKER S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,316,"DT") 3080102 "^DD",9002313.02,9002313.0201,317,0) EMPLOYER CITY ADDRESS^F^^310;7^K:$L(X)>22!($L(X)<22) X "^DD",9002313.02,9002313.0201,317,3) Answer must be 22 characters in length "^DD",9002313.02,9002313.0201,317,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,317,21,1,0) Free-form text for city name. NCPDP standard field 317-CH. "^DD",9002313.02,9002313.0201,317,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,317,23,1,0) REQUEST WORKER'S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,317,"DT") 3080102 "^DD",9002313.02,9002313.0201,318,0) EMPLOYER STATE PROV ADDRESS^F^^310;8^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,318,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,318,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.0201,318,21,1,0) Standard State/Province Code as defined by appropriate government "^DD",9002313.02,9002313.0201,318,21,2,0) agency. NCPDP standard field 318-CI. "^DD",9002313.02,9002313.0201,318,23,0) ^^3^3^3080102^ "^DD",9002313.02,9002313.0201,318,23,1,0) Standard United States and Canadian province two-letter postal service "^DD",9002313.02,9002313.0201,318,23,2,0) abbreviations should be used. "^DD",9002313.02,9002313.0201,318,23,3,0) REQUEST WORKER'S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,318,"DT") 3080102 "^DD",9002313.02,9002313.0201,319,0) EMPLOYER ZIP POSTAL ZONE^F^^310;9^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,319,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,319,21,0) ^^2^2^3080102^ "^DD",9002313.02,9002313.0201,319,21,1,0) Code defining international postal zone excluding punctuation and blanks "^DD",9002313.02,9002313.0201,319,21,2,0) (zip code for US). NCPDP standard field 319-CJ. "^DD",9002313.02,9002313.0201,319,23,0) ^^9^9^3080102^ "^DD",9002313.02,9002313.0201,319,23,1,0) This left-justified field contains the five-digit zip code and may "^DD",9002313.02,9002313.0201,319,23,2,0) include the four-digit expanded zip code in which the employer is located. "^DD",9002313.02,9002313.0201,319,23,3,0) "^DD",9002313.02,9002313.0201,319,23,4,0) Examples: If the zip code is 98765-4321, this field would reflect: "^DD",9002313.02,9002313.0201,319,23,5,0) 987654321. "^DD",9002313.02,9002313.0201,319,23,6,0) "^DD",9002313.02,9002313.0201,319,23,7,0) If the zip code is 98765, this field would reflect: 98765 left justified. "^DD",9002313.02,9002313.0201,319,23,8,0) "^DD",9002313.02,9002313.0201,319,23,9,0) REQUEST WORKER S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,319,"DT") 3080102 "^DD",9002313.02,9002313.0201,320,0) EMPLOYER PHONE NUMBER^F^^310;10^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,320,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,320,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,320,21,1,0) Ten digit phone number of employer. NCPDP standard field 320-CK. "^DD",9002313.02,9002313.0201,320,23,0) ^^9^9^3080102^ "^DD",9002313.02,9002313.0201,320,23,1,0) Format=AAAEEENNNN "^DD",9002313.02,9002313.0201,320,23,2,0) "^DD",9002313.02,9002313.0201,320,23,3,0) AAA=Area Code "^DD",9002313.02,9002313.0201,320,23,4,0) EEE=Exchange Code "^DD",9002313.02,9002313.0201,320,23,5,0) NNNN=Number "^DD",9002313.02,9002313.0201,320,23,6,0) "^DD",9002313.02,9002313.0201,320,23,7,0) Examples: A phone number of 212-555-1212 would reflect: 2125551212. "^DD",9002313.02,9002313.0201,320,23,8,0) "^DD",9002313.02,9002313.0201,320,23,9,0) REQUEST WORKER'S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,320,"DT") 3080102 "^DD",9002313.02,9002313.0201,321,0) EMPLOYER CONTACT NAME^F^^320;1^K:$L(X)>32!($L(X)<32) X "^DD",9002313.02,9002313.0201,321,3) Answer must be 32 characters in length "^DD",9002313.02,9002313.0201,321,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,321,21,1,0) Employer primary contact. NCPDP standard field 321-CL. "^DD",9002313.02,9002313.0201,321,23,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,321,23,1,0) REQUEST WORKER'S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,321,"DT") 3080102 "^DD",9002313.02,9002313.0201,327,0) CARRIER ID^F^^320;7^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,327,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,327,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,327,21,1,0) Carrier code assigned in Worker's Compensation Program. NCPDP standard "^DD",9002313.02,9002313.0201,327,21,2,0) field 327-CR. "^DD",9002313.02,9002313.0201,327,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,327,23,1,0) REQUEST WORKER'S COMPENSATION SEGMENT "^DD",9002313.02,9002313.0201,327,"DT") 3080103 "^DD",9002313.02,9002313.0201,330,0) ALTERNATE ID^F^^320;10^K:$L(X)>22!($L(X)<22) X "^DD",9002313.02,9002313.0201,330,3) Answer must be 22 characters in length "^DD",9002313.02,9002313.0201,330,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,330,21,1,0) Person identifier to be used for controlled product reporting. Identifier "^DD",9002313.02,9002313.0201,330,21,2,0) may be that of the patient or the person picking up the prescription as "^DD",9002313.02,9002313.0201,330,21,3,0) required by the governing body. NCPDP standard field 330-CW. "^DD",9002313.02,9002313.0201,330,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,330,23,1,0) REQUEST CLAIM SEGMENT "^DD",9002313.02,9002313.0201,330,"DT") 3080103 "^DD",9002313.02,9002313.0201,337,0) COB OTHER PAYMENTS COUNT^F^^330;7^K:$L(X)>1!($L(X)<1) X "^DD",9002313.02,9002313.0201,337,3) Answer must be 1 character in length. "^DD",9002313.02,9002313.0201,337,21,0) ^.001^1^1^3101004^^ "^DD",9002313.02,9002313.0201,337,21,1,0) Count of other payment occurrences. "^DD",9002313.02,9002313.0201,337,"DT") 3080102 "^DD",9002313.02,9002313.0201,337.01,0) COB OTHER PAYMENTS^9002313.0401A^^337;0 "^DD",9002313.02,9002313.0201,337.01,21,0) ^^1^1^3080604^ "^DD",9002313.02,9002313.0201,337.01,21,1,0) Multiple counter to store other coordination of benefit payments. "^DD",9002313.02,9002313.0201,337.01,"DT") 3080102 "^DD",9002313.02,9002313.0201,343,0) DISPENSING STATUS^F^^340;3^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,343,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,343,21,0) ^^4^4^3080103^ "^DD",9002313.02,9002313.0201,343,21,1,0) Code indicating the quantity dispensed is a partial fill or the "^DD",9002313.02,9002313.0201,343,21,2,0) completion of a partial fill. Used only in situations where inventory "^DD",9002313.02,9002313.0201,343,21,3,0) shortages do not allow the full quantity to be dispensed. NCPDP standard "^DD",9002313.02,9002313.0201,343,21,4,0) field 343-HD. "^DD",9002313.02,9002313.0201,343,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,343,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,343,"DT") 3080103 "^DD",9002313.02,9002313.0201,344,0) QUANTITY ORDERED^F^^340;4^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,344,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,344,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,344,21,1,0) Metric decimal quantity of medication that would be dispensed on original "^DD",9002313.02,9002313.0201,344,21,2,0) filling if inventory were available. Used in association with a 'P' or "^DD",9002313.02,9002313.0201,344,21,3,0) 'C' in Dispensing Status (343-HD). NCPDP standard field 344-HF. "^DD",9002313.02,9002313.0201,344,23,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,344,23,1,0) Format=9999999.999 "^DD",9002313.02,9002313.0201,344,23,2,0) "^DD",9002313.02,9002313.0201,344,23,3,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,344,"DT") 3080103 "^DD",9002313.02,9002313.0201,345,0) DAYS SUPPLY ORDERED^F^^340;5^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.0201,345,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.0201,345,21,0) ^^4^4^3080103^ "^DD",9002313.02,9002313.0201,345,21,1,0) Days supply for metric decimal quantity of medication that would be "^DD",9002313.02,9002313.0201,345,21,2,0) dispensed on original dispensing if inventory were available. Used in "^DD",9002313.02,9002313.0201,345,21,3,0) association with a 'P' or 'C' in Dispensing Status (343-HD). NCPDP "^DD",9002313.02,9002313.0201,345,21,4,0) standard field 345-HG. "^DD",9002313.02,9002313.0201,345,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,345,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,345,"DT") 3080103 "^DD",9002313.02,9002313.0201,354,0) SUBM CLARIFICATION CODE COUNT^F^^350;4^K:$L(X)>3!($L(X)<1) X "^DD",9002313.02,9002313.0201,354,.1) SUBMISSION CLARIFICATION CODE COUNT "^DD",9002313.02,9002313.0201,354,3) Answer must be 1-3 characters. "^DD",9002313.02,9002313.0201,354,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.0201,354,21,1,0) This is used to store NCPDP field 354-NX (Submission Clarification Code Count), "^DD",9002313.02,9002313.0201,354,21,2,0) which is defined as "Count of the Submission Clarification Code (420-DK) occurrences." "^DD",9002313.02,9002313.0201,354,"DT") 3100825 "^DD",9002313.02,9002313.0201,354.01,0) SUBMISSION CLARIFICATION MLTPL^9002313.02354^^354.01;0 "^DD",9002313.02,9002313.0201,354.01,21,0) ^.001^1^1^3101020^^ "^DD",9002313.02,9002313.0201,354.01,21,1,0) This sub-file stores Submission Clarification values. "^DD",9002313.02,9002313.0201,354.01,"DT") 3100727 "^DD",9002313.02,9002313.0201,357,0) DELAY REASON CODE^F^^350;7^K:$L(X)>2!($L(X)<1) X "^DD",9002313.02,9002313.0201,357,3) Answer must be 1-2 characters. "^DD",9002313.02,9002313.0201,357,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.0201,357,21,1,0) This is used to store NCPDP field 357-NV (Delay Reason Code), "^DD",9002313.02,9002313.0201,357,21,2,0) which is defined as "Code to specify the reason that submission of the transactions has been delayed." "^DD",9002313.02,9002313.0201,357,"DT") 3100727 "^DD",9002313.02,9002313.0201,364,0) PRESCRIBER FIRST NAME^F^^360;4^K:$L(X)>14!($L(X)<1) X "^DD",9002313.02,9002313.0201,364,3) Answer must be 1-14 characters. "^DD",9002313.02,9002313.0201,364,21,0) ^.001^1^1^3101004^^^^ "^DD",9002313.02,9002313.0201,364,21,1,0) This is used to store NCPDP field 364-2J (Prescriber First Name). "^DD",9002313.02,9002313.0201,364,"DT") 3100727 "^DD",9002313.02,9002313.0201,365,0) PRESCRIBER STREET ADDRESS^F^^360;5^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.0201,365,3) Answer must be 1-32 characters. "^DD",9002313.02,9002313.0201,365,21,0) ^.001^2^2^3100929^^ "^DD",9002313.02,9002313.0201,365,21,1,0) This is used to store NCPDP field 365-2K (Prescriber Street Address), "^DD",9002313.02,9002313.0201,365,21,2,0) which is defined as "Free form text for prescriber address information." "^DD",9002313.02,9002313.0201,365,"DT") 3100727 "^DD",9002313.02,9002313.0201,366,0) PRESCRIBER CITY ADDRESS^F^^360;6^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.0201,366,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.0201,366,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.02,9002313.0201,366,21,1,0) This is used to store NCPDP field 366-2M (Prescriber City Address), "^DD",9002313.02,9002313.0201,366,21,2,0) which is defined as "Free form text for prescriber city name." "^DD",9002313.02,9002313.0201,366,"DT") 3100727 "^DD",9002313.02,9002313.0201,367,0) PRESCRIBER STATE/PROV ADDRESS^F^^360;7^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,367,.1) PRESCRIBER STATE/PROVINCE ADDRESS "^DD",9002313.02,9002313.0201,367,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,367,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.02,9002313.0201,367,21,1,0) This is used to store NCPDP field 367-2N (Prescriber State/Province Address), "^DD",9002313.02,9002313.0201,367,21,2,0) which is defined as "Standard state /province code as defined by appropriate government agency." "^DD",9002313.02,9002313.0201,367,"DT") 3100825 "^DD",9002313.02,9002313.0201,368,0) PRESCRIBER ZIP/POSTAL ZONE^F^^360;8^K:$L(X)>11!($L(X)<1) X "^DD",9002313.02,9002313.0201,368,3) Answer must be 1-11 characters. "^DD",9002313.02,9002313.0201,368,21,0) ^.001^2^2^3100929^^ "^DD",9002313.02,9002313.0201,368,21,1,0) This is used to store NCPDP field 368-2P (Prescriber Zip/Postal Zone), "^DD",9002313.02,9002313.0201,368,21,2,0) which is defined as "Code defining international postal zone excluding punctuation and blanks." "^DD",9002313.02,9002313.0201,368,"DT") 3100727 "^DD",9002313.02,9002313.0201,369,0) ADDITIONAL DOCUMNTN TYPE ID^F^^360;9^K:$L(X)>5!($L(X)<1) X "^DD",9002313.02,9002313.0201,369,.1) ADDITIONAL DOCUMENTATION TYPE ID "^DD",9002313.02,9002313.0201,369,3) Answer must be 1-5 characters. "^DD",9002313.02,9002313.0201,369,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.0201,369,21,1,0) This is used to store NCPDP field 369-2Q (Additional Documentation Type ID), "^DD",9002313.02,9002313.0201,369,21,2,0) which is defined as "Unique identifier for the data being submitted." "^DD",9002313.02,9002313.0201,369,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.02,9002313.0201,369,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,369,"DT") 3101004 "^DD",9002313.02,9002313.0201,370,0) LENGTH OF NEED^F^^360;10^K:$L(X)>5!($L(X)<1) X "^DD",9002313.02,9002313.0201,370,3) Answer must be 1-5 characters. "^DD",9002313.02,9002313.0201,370,21,0) ^.001^3^3^3101004^^^^ "^DD",9002313.02,9002313.0201,370,21,1,0) This is used to store NCPDP field 370-2R (Length of Need), "^DD",9002313.02,9002313.0201,370,21,2,0) which is defined as "Length of time the physician expects the patient to require use of the ordered item. "^DD",9002313.02,9002313.0201,370,21,3,0) Qualified by Length of Need Qualifier (371-2S)." "^DD",9002313.02,9002313.0201,370,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.02,9002313.0201,370,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,370,"DT") 3100902 "^DD",9002313.02,9002313.0201,371,0) LENGTH OF NEED QUALIFIER^F^^370;1^K:$L(X)>5!($L(X)<1) X "^DD",9002313.02,9002313.0201,371,3) Answer must be 1-5 characters. "^DD",9002313.02,9002313.0201,371,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.0201,371,21,1,0) This is used to store NCPDP field 371-2S (Length of Need Qualifier), "^DD",9002313.02,9002313.0201,371,21,2,0) which is defined as "Code qualifying the length of need." "^DD",9002313.02,9002313.0201,371,23,0) ^.001^3^3^3101004^^ "^DD",9002313.02,9002313.0201,371,23,1,0) Qualifies Length of Need (370-2R). "^DD",9002313.02,9002313.0201,371,23,2,0) Note: If value is 6, length of need would be 1. "^DD",9002313.02,9002313.0201,371,23,3,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,371,"DT") 3100902 "^DD",9002313.02,9002313.0201,372,0) PRESCRIBER/SUPPLIER DT SIGNED^F^^370;2^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.0201,372,.1) PRESCRIBER/SUPPLIER DATE SIGNED "^DD",9002313.02,9002313.0201,372,3) Answer must be 1-10 characters in length. "^DD",9002313.02,9002313.0201,372,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.0201,372,21,1,0) This is used to store NCPDP field 372-2T (Prescriber/Supplier Date Signed), "^DD",9002313.02,9002313.0201,372,21,2,0) which is defined as "The date the form was completed and signed by the ordering physician." "^DD",9002313.02,9002313.0201,372,23,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.0201,372,23,1,0) Format = CCYYMMDD "^DD",9002313.02,9002313.0201,372,23,2,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,372,"DT") 3101025 "^DD",9002313.02,9002313.0201,373,0) REQUEST STATUS^F^^370;3^K:$L(X)>3!($L(X)<1) X "^DD",9002313.02,9002313.0201,373,3) Answer must be 1-3 characters. "^DD",9002313.02,9002313.0201,373,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.0201,373,21,1,0) This is used to store NCPDP field 373-2U (Request Status), "^DD",9002313.02,9002313.0201,373,21,2,0) which is defined as "Code identifying type of request." "^DD",9002313.02,9002313.0201,373,23,0) ^.001^1^1^3101004^^ "^DD",9002313.02,9002313.0201,373,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,373,"DT") 3100902 "^DD",9002313.02,9002313.0201,374,0) REQUEST PERIOD BEGIN DATE^F^^370;4^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.0201,374,3) Answer must be 1-10 characters. "^DD",9002313.02,9002313.0201,374,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.0201,374,21,1,0) This is used to store NCPDP field 374-2V (Request Period Begin Date), "^DD",9002313.02,9002313.0201,374,21,2,0) which is defined as "The beginning date of need." "^DD",9002313.02,9002313.0201,374,23,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.0201,374,23,1,0) Format = CCYYMMDD "^DD",9002313.02,9002313.0201,374,23,2,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,374,"DT") 3100902 "^DD",9002313.02,9002313.0201,375,0) REQUEST PD RECERT/REVISED DATE^F^^370;5^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.0201,375,.1) REQUEST PERIOD RECERT/REVISED DATE "^DD",9002313.02,9002313.0201,375,3) Answer must be 1-10 characters. "^DD",9002313.02,9002313.0201,375,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.0201,375,21,1,0) This is used to store NCPDP field 375-2W (Request Period Recert/Revised Date), "^DD",9002313.02,9002313.0201,375,21,2,0) which is defined as "The effective date of the revision or re-certification provided by the certifying physician." "^DD",9002313.02,9002313.0201,375,23,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.0201,375,23,1,0) Format = CCYYMMDD "^DD",9002313.02,9002313.0201,375,23,2,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,375,"DT") 3100902 "^DD",9002313.02,9002313.0201,376,0) SUPPORTING DOCUMENTATION^F^^370;6^K:$L(X)>67!($L(X)<1) X "^DD",9002313.02,9002313.0201,376,3) Answer must be 1-67 characters. "^DD",9002313.02,9002313.0201,376,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.0201,376,21,1,0) This is used to store NCPDP field 376-2X (Supporting Documentation), "^DD",9002313.02,9002313.0201,376,21,2,0) which is defined as "Free text message." "^DD",9002313.02,9002313.0201,376,23,0) ^.001^1^1^3101004^^ "^DD",9002313.02,9002313.0201,376,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,376,"DT") 3100902 "^DD",9002313.02,9002313.0201,377,0) QUESTION NUMBER/LETTER COUNT^F^^370;7^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,377,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,377,21,0) ^.001^2^2^3101005^^^ "^DD",9002313.02,9002313.0201,377,21,1,0) This is used to store NCPDP field 377-2Z (Question Number/Letter Count), "^DD",9002313.02,9002313.0201,377,21,2,0) which is defined as "Count of Question Number/Letter occurrences." "^DD",9002313.02,9002313.0201,377,23,0) ^.001^1^1^3101005^^ "^DD",9002313.02,9002313.0201,377,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.0201,377,"DT") 3100902 "^DD",9002313.02,9002313.0201,377.01,0) QUESTION NUMBER/LETTER MLTPL^9002313.023771^^377.01;0 "^DD",9002313.02,9002313.0201,377.01,21,0) ^.001^1^1^3101020^^ "^DD",9002313.02,9002313.0201,377.01,21,1,0) This sub-file stores Question Number/Letter values. "^DD",9002313.02,9002313.0201,385,0) FACILITY NAME^F^^380;5^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.0201,385,3) Answer must be 1-32 characters. "^DD",9002313.02,9002313.0201,385,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,385,21,1,0) This is used to store NCPDP field 385-3Q (Facility Name), "^DD",9002313.02,9002313.0201,385,21,2,0) which is defined as "Name identifying the location of the service rendered." "^DD",9002313.02,9002313.0201,385,23,0) ^^2^2^3100901^ "^DD",9002313.02,9002313.0201,385,23,1,0) Note: This is not the name of the dispensing pharmacy. "^DD",9002313.02,9002313.0201,385,23,2,0) REQUEST FACILITY SEGMENT "^DD",9002313.02,9002313.0201,385,"DT") 3100901 "^DD",9002313.02,9002313.0201,386,0) FACILITY STREET ADDRESS^F^^380;6^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.0201,386,3) Answer must be 1-32 characters. "^DD",9002313.02,9002313.0201,386,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0201,386,21,1,0) This is used to store NCPDP field 386-3U (Facility Street Address), "^DD",9002313.02,9002313.0201,386,21,2,0) which is defined as "Free form text for Facility address information." "^DD",9002313.02,9002313.0201,386,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0201,386,23,1,0) REQUEST FACILITY SEGMENT "^DD",9002313.02,9002313.0201,386,"DT") 3100901 "^DD",9002313.02,9002313.0201,387,0) FACILITY STATE/PROV ADDRESS^F^^380;7^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0201,387,.1) FACILITY STATE/PROVINCE ADDRESS "^DD",9002313.02,9002313.0201,387,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0201,387,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.02,9002313.0201,387,21,1,0) This is used to store NCPDP field 387-3V (Facility State/Province Address), "^DD",9002313.02,9002313.0201,387,21,2,0) which is defined as "Standard state /province code as defined by appropriate government agency." "^DD",9002313.02,9002313.0201,387,23,0) ^.001^1^1^3101014^^ "^DD",9002313.02,9002313.0201,387,23,1,0) REQUEST FACILITY SEGMENT. "^DD",9002313.02,9002313.0201,387,"DT") 3100901 "^DD",9002313.02,9002313.0201,388,0) FACILITY CITY ADDRESS^F^^380;8^K:$L(X)>22!($L(X)<1) X "^DD",9002313.02,9002313.0201,388,3) Answer must be 1-22 characters. "^DD",9002313.02,9002313.0201,388,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.02,9002313.0201,388,21,1,0) This is used to store NCPDP field 388-5J (Facility City Address), "^DD",9002313.02,9002313.0201,388,21,2,0) which is defined as "Free form text for facility city name." "^DD",9002313.02,9002313.0201,388,23,0) ^.001^1^1^3101014^^ "^DD",9002313.02,9002313.0201,388,23,1,0) REQUEST FACILITY SEGMENT. "^DD",9002313.02,9002313.0201,388,"DT") 3100901 "^DD",9002313.02,9002313.0201,389,0) FACILITY ZIP/POSTAL ZONE^F^^380;9^K:$L(X)>18!($L(X)<1) X "^DD",9002313.02,9002313.0201,389,3) Answer must be 1-18 characters. "^DD",9002313.02,9002313.0201,389,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.02,9002313.0201,389,21,1,0) This is used to store NCPDP field 389-6D (Facility Zip/Postal Zone), "^DD",9002313.02,9002313.0201,389,21,2,0) which is defined as "Code defining international postal zone excluding punctuation and blanks." "^DD",9002313.02,9002313.0201,389,23,0) ^.001^1^1^3101014^^ "^DD",9002313.02,9002313.0201,389,23,1,0) REQUEST FACILITY SEGMENT. "^DD",9002313.02,9002313.0201,389,"DT") 3100901 "^DD",9002313.02,9002313.0201,390,0) NARRATIVE MESSAGE^F^^389;2^K:$L(X)>202!($L(X)<1) X "^DD",9002313.02,9002313.0201,390,3) Answer must be 1-202 characters. "^DD",9002313.02,9002313.0201,390,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.0201,390,21,1,0) This is used to store NCPDP field 390-BM (Narrative Message), "^DD",9002313.02,9002313.0201,390,21,2,0) which is defined as "Free form text." "^DD",9002313.02,9002313.0201,390,23,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.0201,390,23,1,0) REQUEST NARRATIVE SEGMENT. "^DD",9002313.02,9002313.0201,390,23,2,0) This field is the 2nd piece of node 389 because of its length. "^DD",9002313.02,9002313.0201,390,"DT") 3100902 "^DD",9002313.02,9002313.0201,391,0) PATIENT ASSIGNMENT INDICATOR^F^^390;1^K:$L(X)>3!($L(X)<1) X "^DD",9002313.02,9002313.0201,391,3) Answer must be 1-3 characters. "^DD",9002313.02,9002313.0201,391,21,0) ^.001^2^2^3100929^^^^ "^DD",9002313.02,9002313.0201,391,21,1,0) This is used to store NCPDP field 391-MT (Patient Assignment Indicator (Direct Member Reimbursement Indicator)), "^DD",9002313.02,9002313.0201,391,21,2,0) which is defined as "Code to indicate a patient's choice on assignment of benefits." "^DD",9002313.02,9002313.0201,391,"DT") 3100727 "^DD",9002313.02,9002313.0201,401,0) DATE OF SERVICE^FO^^400;1^K:$L(X)>8!($L(X)<8) X "^DD",9002313.02,9002313.0201,401,2) S Y(0)=Y S Y=$$FM2EXT^BPSOSU1(Y-17000000) "^DD",9002313.02,9002313.0201,401,2.1) S Y=$$FM2EXT^BPSOSU1(Y-17000000) "^DD",9002313.02,9002313.0201,401,3) Answer must be 8 characters in length "^DD",9002313.02,9002313.0201,401,21,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.0201,401,21,1,0) Identifies date the prescription was filled or professional service "^DD",9002313.02,9002313.0201,401,21,2,0) rendered or subsequent payer began coverage following Part A expiration "^DD",9002313.02,9002313.0201,401,21,3,0) in a long-term care setting only. NCPDP standard field 401-D1. "^DD",9002313.02,9002313.0201,401,23,0) ^^12^12^3080104^ "^DD",9002313.02,9002313.0201,401,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,401,23,2,0) "^DD",9002313.02,9002313.0201,401,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,401,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,401,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,401,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,401,23,7,0) "^DD",9002313.02,9002313.0201,401,23,8,0) Examples: If the prescription was dispensed on April 22, 2000, this field "^DD",9002313.02,9002313.0201,401,23,9,0) would reflect 20000422. "^DD",9002313.02,9002313.0201,401,23,10,0) "^DD",9002313.02,9002313.0201,401,23,11,0) REQUEST TRANSACTION HEADER SEGMENT. "^DD",9002313.02,9002313.0201,401,23,12,0) RESPONSE HEADER SEGMENT. "^DD",9002313.02,9002313.0201,401,"DT") 3080104 "^DD",9002313.02,9002313.0201,402,0) PRESCRIPTION/SERVICE REF NO^F^^400;2^K:$L(X)>14!($L(X)<1) X "^DD",9002313.02,9002313.0201,402,.1) PRESCRIPTION/SERVICE REFERENCE NUMBER "^DD",9002313.02,9002313.0201,402,3) Answer must be 1-14 characters. "^DD",9002313.02,9002313.0201,402,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0201,402,21,1,0) This is the reference number assigned by the provider for the dispensed drug/product and/or service provided. "^DD",9002313.02,9002313.0201,402,21,2,0) It is NCPDP field 402-D2. The VA uses the Prescription IEN for this field. "^DD",9002313.02,9002313.0201,402,23,0) ^.001^3^3^3101020^^^^ "^DD",9002313.02,9002313.0201,402,23,1,0) Qualified by Prescription/Service Reference Number Qualifier (455-EM). "^DD",9002313.02,9002313.0201,402,23,2,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,402,23,3,0) RESPONSE CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,402,"DT") 3100929 "^DD",9002313.02,9002313.0201,403,0) FILL NUMBER^F^^400;3^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,403,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,403,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,403,21,1,0) The fill/refill number, starting at 0 for the original fill. The code "^DD",9002313.02,9002313.0201,403,21,2,0) indicating whether the prescription is an original or a refill. NCPDP "^DD",9002313.02,9002313.0201,403,21,3,0) standard field 403-D3. "^DD",9002313.02,9002313.0201,403,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,403,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,403,"DT") 3080103 "^DD",9002313.02,9002313.0201,405,0) DAYS SUPPLY^F^^400;5^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.0201,405,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.0201,405,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,405,21,1,0) Estimated number of days the prescription will last. NCPDP standard "^DD",9002313.02,9002313.0201,405,21,2,0) field 405-D5. "^DD",9002313.02,9002313.0201,405,23,0) ^^4^4^3080103^ "^DD",9002313.02,9002313.0201,405,23,1,0) Examples: The prescription is estimated to last 30 days. This field would "^DD",9002313.02,9002313.0201,405,23,2,0) reflect: 30. "^DD",9002313.02,9002313.0201,405,23,3,0) "^DD",9002313.02,9002313.0201,405,23,4,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,405,"DT") 3080103 "^DD",9002313.02,9002313.0201,406,0) COMPOUND CODE^F^^400;6^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,406,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,406,21,0) ^.001^2^2^3101001^^ "^DD",9002313.02,9002313.0201,406,21,1,0) Field indicating whether this prescription was a compound (1) or not a "^DD",9002313.02,9002313.0201,406,21,2,0) compound (0). "^DD",9002313.02,9002313.0201,406,23,0) ^.001^1^1^3101001^^ "^DD",9002313.02,9002313.0201,406,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,406,"DT") 3080103 "^DD",9002313.02,9002313.0201,407,0) PRODUCT SERVICE ID^F^^400;7^K:$L(X)>21!($L(X)<21) X "^DD",9002313.02,9002313.0201,407,3) Answer must be 21 characters in length "^DD",9002313.02,9002313.0201,407,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,407,21,1,0) ID of the product dispensed or service provided. NDC code in our case. "^DD",9002313.02,9002313.0201,407,21,2,0) NCPDP standard field 407-D7. "^DD",9002313.02,9002313.0201,407,23,0) ^^10^10^3080103^ "^DD",9002313.02,9002313.0201,407,23,1,0) Format=MMMMMDDDDPP "^DD",9002313.02,9002313.0201,407,23,2,0) "^DD",9002313.02,9002313.0201,407,23,3,0) MMMMM=Manufacturer's Assigned Number "^DD",9002313.02,9002313.0201,407,23,4,0) DDDD=Drug ID "^DD",9002313.02,9002313.0201,407,23,5,0) PP=Package Size "^DD",9002313.02,9002313.0201,407,23,6,0) "^DD",9002313.02,9002313.0201,407,23,7,0) Comments: Qualified by Product/Service ID Qualifier (436-E1) If "^DD",9002313.02,9002313.0201,407,23,8,0) Product Service ID Qualifier (436-E1) is 03=NDC "^DD",9002313.02,9002313.0201,407,23,9,0) "^DD",9002313.02,9002313.0201,407,23,10,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,407,"DT") 3080103 "^DD",9002313.02,9002313.0201,408,0) DISPENSE AS WRITTEN^F^^400;8^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,408,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,408,21,0) ^^2^2^3080604^ "^DD",9002313.02,9002313.0201,408,21,1,0) Code indicating whether or not the prescriber's instructions regarding "^DD",9002313.02,9002313.0201,408,21,2,0) generic substitution were followed. NCPDP standard field 408-D8. "^DD",9002313.02,9002313.0201,408,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,408,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,408,"DT") 3080604 "^DD",9002313.02,9002313.0201,409,0) INGREDIENT COST SUBMITTED^F^^400;9^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,409,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,409,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,409,21,1,0) Submitted product component cost of the dispensed prescription. This "^DD",9002313.02,9002313.0201,409,21,2,0) amount is included in the 'Gross Amount Due' (430-DU). "^DD",9002313.02,9002313.0201,409,23,0) ^^9^9^3080103^ "^DD",9002313.02,9002313.0201,409,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,409,23,2,0) "^DD",9002313.02,9002313.0201,409,23,3,0) Comments: This field can be further defined by using the Basis of Cost "^DD",9002313.02,9002313.0201,409,23,4,0) Determination Field 423-DN. "^DD",9002313.02,9002313.0201,409,23,5,0) "^DD",9002313.02,9002313.0201,409,23,6,0) Examples: If the ingredient cost submitted is $65.00, this field would "^DD",9002313.02,9002313.0201,409,23,7,0) reflect: 650{. "^DD",9002313.02,9002313.0201,409,23,8,0) "^DD",9002313.02,9002313.0201,409,23,9,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,409,"DT") 3080103 "^DD",9002313.02,9002313.0201,411,0) PRESCRIBER ID^F^^400;11^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,411,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,411,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,411,21,1,0) ID assigned to the prescriber. "^DD",9002313.02,9002313.0201,411,23,0) ^^6^6^3080103^ "^DD",9002313.02,9002313.0201,411,23,1,0) Regarding the Telecommunication Standard: "^DD",9002313.02,9002313.0201,411,23,2,0) "^DD",9002313.02,9002313.0201,411,23,3,0) Comments: Qualified by Prescriber ID Qualifier (466-EZ) for the "^DD",9002313.02,9002313.0201,411,23,4,0) Telecommunications Standard. "^DD",9002313.02,9002313.0201,411,23,5,0) "^DD",9002313.02,9002313.0201,411,23,6,0) REQUEST PRESCRIBER SEGMENT "^DD",9002313.02,9002313.0201,411,"DT") 3080103 "^DD",9002313.02,9002313.0201,412,0) DISPENSING FEE SUBMITTED^F^^400;12^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,412,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,412,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,412,21,1,0) Dispensing fee submitted by the pharmacy. This amount is included in the "^DD",9002313.02,9002313.0201,412,21,2,0) 'Gross Amount Due' (430-DU). To be utilized for Tricare. NCPDP standard "^DD",9002313.02,9002313.0201,412,21,3,0) field 412-DC. "^DD",9002313.02,9002313.0201,412,23,0) ^^6^6^3080103^ "^DD",9002313.02,9002313.0201,412,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,412,23,2,0) "^DD",9002313.02,9002313.0201,412,23,3,0) Examples: If the pharmacy submitted a $5.62 dispensing fee, this field "^DD",9002313.02,9002313.0201,412,23,4,0) would reflect: 56B. "^DD",9002313.02,9002313.0201,412,23,5,0) "^DD",9002313.02,9002313.0201,412,23,6,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,412,"DT") 3080103 "^DD",9002313.02,9002313.0201,414,0) DATE PRESCRIPTION WRITTEN^F^^400;14^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,414,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,414,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,414,21,1,0) Date prescription was written. This will be the fill/refill date for "^DD",9002313.02,9002313.0201,414,21,2,0) local fills, the released date for CMOP. NCPDP standard field 414-DE. "^DD",9002313.02,9002313.0201,414,23,0) ^^11^11^3080103^ "^DD",9002313.02,9002313.0201,414,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,414,23,2,0) "^DD",9002313.02,9002313.0201,414,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,414,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,414,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,414,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,414,23,7,0) "^DD",9002313.02,9002313.0201,414,23,8,0) Examples: For a prescription written on August 1, 1999, field would "^DD",9002313.02,9002313.0201,414,23,9,0) reflect: 19990801. "^DD",9002313.02,9002313.0201,414,23,10,0) "^DD",9002313.02,9002313.0201,414,23,11,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,414,"DT") 3080103 "^DD",9002313.02,9002313.0201,415,0) NUMBER OF REFILLS AUTHORIZED^F^^400;15^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,415,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,415,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,415,21,1,0) Number of refills authorized by the prescriber. The number of refills "^DD",9002313.02,9002313.0201,415,21,2,0) allowed that was entered during order entry. NCPDP standard field 415-DF. "^DD",9002313.02,9002313.0201,415,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,415,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,415,"DT") 3080103 "^DD",9002313.02,9002313.0201,418,0) LEVEL OF SERVICE^F^^400;18^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,418,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,418,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,418,21,1,0) Coding indicating the type of service the provider rendered. Not "^DD",9002313.02,9002313.0201,418,21,2,0) utilized, populated with DI00. NCPDP standard field 418-DI. "^DD",9002313.02,9002313.0201,418,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,418,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,418,"DT") 3080103 "^DD",9002313.02,9002313.0201,419,0) PRESCRIPTION ORIGIN CODE^F^^400;19^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,419,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,419,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,419,21,1,0) Code indicating the origin of the prescription. "^DD",9002313.02,9002313.0201,419,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,419,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,419,"DT") 3080103 "^DD",9002313.02,9002313.0201,420,0) *SUBMISSION CLARIFICATION CODE^F^^400;20^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,420,3) Answer must be 4 characters in length. "^DD",9002313.02,9002313.0201,420,21,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.0201,420,21,1,0) * This field is no longer used in NCPDP version D.0. * "^DD",9002313.02,9002313.0201,420,23,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0201,420,23,1,0) This field is now located in: "^DD",9002313.02,9002313.0201,420,23,2,0) SUBMISSION CLARIFICATION MLTPL (sub-file #9002313.02354). "^DD",9002313.02,9002313.0201,420,"DT") 3100831 "^DD",9002313.02,9002313.0201,421,0) PRIMARY CARE PROVIDER ID^F^^400;21^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,421,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,421,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,421,21,1,0) ID assigned to the primary care provider. Used when the patient is "^DD",9002313.02,9002313.0201,421,21,2,0) referred to a secondary care provider. NCPDP standard field 421-DL. "^DD",9002313.02,9002313.0201,421,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,421,23,1,0) Qualified by Primary Care Provider ID Qualifier (468-2E). "^DD",9002313.02,9002313.0201,421,23,2,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,421,"DT") 3080103 "^DD",9002313.02,9002313.0201,423,0) BASIS OF COST DETERMINATION^F^^400;23^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,423,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,423,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,423,21,1,0) Code indicating the method by which 'Ingredient Cost Submitted' (Field "^DD",9002313.02,9002313.0201,423,21,2,0) 409-D9) was calculated. How the amount charged was determined. NCPDP "^DD",9002313.02,9002313.0201,423,21,3,0) standard field 423-DN. "^DD",9002313.02,9002313.0201,423,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,423,23,1,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,423,"DT") 3080103 "^DD",9002313.02,9002313.0201,424,0) DIAGNOSIS CODE^F^^400;24^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,424,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,424,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,424,21,1,0) Code identifying the diagnosis of the patient. Not used for third party "^DD",9002313.02,9002313.0201,424,21,2,0) billing as of this date - so it is not used, but may be used in the "^DD",9002313.02,9002313.0201,424,21,3,0) future. NCPDP standard field 424-DO. "^DD",9002313.02,9002313.0201,424,23,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,424,23,1,0) Qualified by a Diagnosis Code Qualifier (492-WE). The format must "^DD",9002313.02,9002313.0201,424,23,2,0) adhere to the owner's code set rules and formats. "^DD",9002313.02,9002313.0201,424,23,3,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0201,424,"DT") 3080103 "^DD",9002313.02,9002313.0201,426,0) USUAL AND CUSTOMARY CHARGE^F^^400;26^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,426,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,426,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,426,21,1,0) Amount charged cash customers for the prescription exclusive of sales tax "^DD",9002313.02,9002313.0201,426,21,2,0) or other amounts claimed. NCPDP standard field 426-DQ. "^DD",9002313.02,9002313.0201,426,23,0) ^^6^6^3080103^ "^DD",9002313.02,9002313.0201,426,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,426,23,2,0) "^DD",9002313.02,9002313.0201,426,23,3,0) Examples: If the usual and customary charge is $32.56, this field would "^DD",9002313.02,9002313.0201,426,23,4,0) reflect: 325F. "^DD",9002313.02,9002313.0201,426,23,5,0) "^DD",9002313.02,9002313.0201,426,23,6,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,426,"DT") 3080103 "^DD",9002313.02,9002313.0201,427,0) PRESCRIBER LAST NAME^F^^420;27^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,427,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,427,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,427,21,1,0) Last Name of the Prescriber. NCPDP standard field 427-DR. "^DD",9002313.02,9002313.0201,427,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,427,23,1,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,427,"DT") 3080103 "^DD",9002313.02,9002313.0201,429,0) SPECIAL PACKAGING INDICATOR^F^^400;29^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,429,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,429,21,0) ^^7^7^3080103^ "^DD",9002313.02,9002313.0201,429,21,1,0) Code indicating the type of Unit Dose dispensing. NCPDP standard field "^DD",9002313.02,9002313.0201,429,21,2,0) 429-DT. "^DD",9002313.02,9002313.0201,429,21,3,0) "^DD",9002313.02,9002313.0201,429,21,4,0) 0=Not Specified "^DD",9002313.02,9002313.0201,429,21,5,0) 1=Not Unit Dose "^DD",9002313.02,9002313.0201,429,21,6,0) 2=Manufacturer Unit Dose "^DD",9002313.02,9002313.0201,429,21,7,0) 3=Pharmacy Unit Dose "^DD",9002313.02,9002313.0201,429,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,429,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,429,"DT") 3080103 "^DD",9002313.02,9002313.0201,430,0) GROSS AMOUNT DUE^F^^400;30^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,430,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,430,21,0) ^^9^9^3080103^ "^DD",9002313.02,9002313.0201,430,21,1,0) Total price claimed from all sources. For prescription claim request, "^DD",9002313.02,9002313.0201,430,21,2,0) field represents a sum of Ingredient Cost Submitted (409-D9), Dispensing "^DD",9002313.02,9002313.0201,430,21,3,0) Fee Submitted (412-DC), Flat Sales Tax Amount Submitted (481-HA), "^DD",9002313.02,9002313.0201,430,21,4,0) Percentage Sales Tax Amount Submitted (482-GE), Incentive Amount "^DD",9002313.02,9002313.0201,430,21,5,0) Submitted (438-E3), Other Amount Claimed (480-H9). For service claim "^DD",9002313.02,9002313.0201,430,21,6,0) request, field represents a sum of Professional Services Fee Submitted "^DD",9002313.02,9002313.0201,430,21,7,0) (477-BE), Flat Sales Tax Amount Submitted (481-HA), Percentage Sales Tax "^DD",9002313.02,9002313.0201,430,21,8,0) Amount Submitted (482-GE), Other Amount Claimed (480-H9). NCPDP standard "^DD",9002313.02,9002313.0201,430,21,9,0) field 430-DU. "^DD",9002313.02,9002313.0201,430,23,0) ^^6^6^3080103^ "^DD",9002313.02,9002313.0201,430,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,430,23,2,0) "^DD",9002313.02,9002313.0201,430,23,3,0) Examples: If the gross amount due is $14.95, this field would reflect: "^DD",9002313.02,9002313.0201,430,23,4,0) 149E. "^DD",9002313.02,9002313.0201,430,23,5,0) "^DD",9002313.02,9002313.0201,430,23,6,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,430,"DT") 3080103 "^DD",9002313.02,9002313.0201,431,0) OTHER PAYER AMOUNT^F^^430;1^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,431,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,431,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,431,21,1,0) Amount of any payment known by the pharmacy from other sources. NCPDP "^DD",9002313.02,9002313.0201,431,21,2,0) standard field 431-DV. "^DD",9002313.02,9002313.0201,431,23,0) ^.001^6^6^3101020^^ "^DD",9002313.02,9002313.0201,431,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,431,23,2,0) "^DD",9002313.02,9002313.0201,431,23,3,0) Examples: If the other payer amount paid is $32.56, this field would "^DD",9002313.02,9002313.0201,431,23,4,0) reflect: 325F. "^DD",9002313.02,9002313.0201,431,23,5,0) "^DD",9002313.02,9002313.0201,431,23,6,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0201,431,"DT") 3080103 "^DD",9002313.02,9002313.0201,433,0) PATIENT PAID AMOUNT SUBMITTED^F^^430;3^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,433,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,433,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,433,21,1,0) Amount the pharmacy received from the patient for the prescription "^DD",9002313.02,9002313.0201,433,21,2,0) dispensed. "^DD",9002313.02,9002313.0201,433,23,0) ^^10^10^3080103^ "^DD",9002313.02,9002313.0201,433,23,1,0) This field is not used in coordination of benefit transactions to pass "^DD",9002313.02,9002313.0201,433,23,2,0) patent liability information to a downstream payer. See Other "^DD",9002313.02,9002313.0201,433,23,3,0) Payer-Patient Responsibility Amount (352-NQ). "^DD",9002313.02,9002313.0201,433,23,4,0) "^DD",9002313.02,9002313.0201,433,23,5,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,433,23,6,0) "^DD",9002313.02,9002313.0201,433,23,7,0) Examples: If the patient paid amount submitted is $10.50, this field "^DD",9002313.02,9002313.0201,433,23,8,0) would reflect: 105{. "^DD",9002313.02,9002313.0201,433,23,9,0) "^DD",9002313.02,9002313.0201,433,23,10,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,433,"DT") 3080103 "^DD",9002313.02,9002313.0201,434,0) DATE OF INJURY^F^^430;4^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,434,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,434,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,434,21,1,0) Date on which the injury occurred. NCPDP standard field 434-DY. "^DD",9002313.02,9002313.0201,434,23,0) ^^11^11^3080103^ "^DD",9002313.02,9002313.0201,434,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,434,23,2,0) "^DD",9002313.02,9002313.0201,434,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,434,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,434,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,434,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,434,23,7,0) "^DD",9002313.02,9002313.0201,434,23,8,0) Examples: If injury occurred on July 1, 1999, field would reflect: "^DD",9002313.02,9002313.0201,434,23,9,0) 19990701. "^DD",9002313.02,9002313.0201,434,23,10,0) "^DD",9002313.02,9002313.0201,434,23,11,0) REQUEST WORKER S COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,434,"DT") 3080103 "^DD",9002313.02,9002313.0201,435,0) CLAIM REFERENCE ID^F^^430;5^K:$L(X)>32!($L(X)<32) X "^DD",9002313.02,9002313.0201,435,3) Answer must be 32 characters in length "^DD",9002313.02,9002313.0201,435,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,435,21,1,0) Identifies the claim number assigned by Worker s Compensation Program. "^DD",9002313.02,9002313.0201,435,21,2,0) NCPDP standard field 435-DZ. "^DD",9002313.02,9002313.0201,435,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,435,23,1,0) REQUEST WORKER S COMPENSATION SEGMENT. "^DD",9002313.02,9002313.0201,435,"DT") 3080103 "^DD",9002313.02,9002313.0201,436,0) PRODUCT SERVICE ID QUALIFIER^F^^430;6^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,436,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,436,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,436,21,1,0) Code qualifying the value in 'Product/Service ID' (407-D7). NCPDP "^DD",9002313.02,9002313.0201,436,21,2,0) standard field 436-E1. "^DD",9002313.02,9002313.0201,436,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,436,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,436,"DT") 3080103 "^DD",9002313.02,9002313.0201,438,0) INCENTIVE AMOUNT SUBMITTED^F^^430;8^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,438,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,438,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,438,21,1,0) Amount represents a fee that is submitted by the pharmacy for "^DD",9002313.02,9002313.0201,438,21,2,0) contractually agreed upon services. This amount is included in the 'Gross "^DD",9002313.02,9002313.0201,438,21,3,0) Amount Due' (430-DU). "^DD",9002313.02,9002313.0201,438,23,0) ^^6^6^3080103^ "^DD",9002313.02,9002313.0201,438,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,438,23,2,0) "^DD",9002313.02,9002313.0201,438,23,3,0) Examples: If the incentive amount submitted is $4.50, this field would "^DD",9002313.02,9002313.0201,438,23,4,0) reflect: 45{. "^DD",9002313.02,9002313.0201,438,23,5,0) "^DD",9002313.02,9002313.0201,438,23,6,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,438,"DT") 3080103 "^DD",9002313.02,9002313.0201,442,0) QUANTITY DISPENSED^F^^440;2^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,442,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,442,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,442,21,1,0) Quantity dispensed expressed in metric decimal units. NCPDP standard "^DD",9002313.02,9002313.0201,442,21,2,0) field 442-E7. "^DD",9002313.02,9002313.0201,442,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,442,23,1,0) Format=9999999.999 "^DD",9002313.02,9002313.0201,442,23,2,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,442,"DT") 3080103 "^DD",9002313.02,9002313.0201,443,0) OTHER PAYER DATE^F^^440;3^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,443,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,443,21,0) ^^2^2^3080604^ "^DD",9002313.02,9002313.0201,443,21,1,0) Payment or denial date of the claim submitted to the other payer. Used "^DD",9002313.02,9002313.0201,443,21,2,0) for coordination of benefits. NCPDP standard field 443-E8. "^DD",9002313.02,9002313.0201,443,23,0) ^^11^11^3080604^ "^DD",9002313.02,9002313.0201,443,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,443,23,2,0) "^DD",9002313.02,9002313.0201,443,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,443,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,443,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,443,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,443,23,7,0) "^DD",9002313.02,9002313.0201,443,23,8,0) Examples: If the primary payer denial date was August 1,1999, this field "^DD",9002313.02,9002313.0201,443,23,9,0) would reflect: 19990801. "^DD",9002313.02,9002313.0201,443,23,10,0) "^DD",9002313.02,9002313.0201,443,23,11,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT "^DD",9002313.02,9002313.0201,443,"DT") 3080604 "^DD",9002313.02,9002313.0201,444,0) PROVIDER ID^F^^440;4^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,444,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,444,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,444,21,1,0) Unique ID assigned to the person responsible for the dispensing of the "^DD",9002313.02,9002313.0201,444,21,2,0) prescription or provision of the service. "^DD",9002313.02,9002313.0201,444,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,444,23,1,0) Qualified by Provider ID Qualifier (465-EY). "^DD",9002313.02,9002313.0201,444,23,2,0) REQUEST PHARMACY PROVIDER SEGMENT. "^DD",9002313.02,9002313.0201,444,"DT") 3080103 "^DD",9002313.02,9002313.0201,445,0) ORIGINAL PRESCRIBED PROD CODE^F^^440;5^K:$L(X)>21!($L(X)<21) X "^DD",9002313.02,9002313.0201,445,3) Answer must be 21 characters in length "^DD",9002313.02,9002313.0201,445,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,445,21,1,0) Code of the initially prescribed product or service. NCPDP standard "^DD",9002313.02,9002313.0201,445,21,2,0) field 445-EA. "^DD",9002313.02,9002313.0201,445,23,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0201,445,23,1,0) Qualified by Originally Prescribed Product/Service Code Qualifier "^DD",9002313.02,9002313.0201,445,23,2,0) (453-EJ). "^DD",9002313.02,9002313.0201,445,23,3,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,445,"DT") 3080103 "^DD",9002313.02,9002313.0201,446,0) ORIGINALLY PRESCRIBED QUANTITY^F^^440;6^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,446,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,446,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,446,21,1,0) Product initially prescribed amount expressed in metric decimal units. "^DD",9002313.02,9002313.0201,446,21,2,0) NCPDP standard field 446-EB. "^DD",9002313.02,9002313.0201,446,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,446,23,1,0) Format=9999999.999 "^DD",9002313.02,9002313.0201,446,23,2,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,446,"DT") 3080103 "^DD",9002313.02,9002313.0201,447,0) COMPOUND INGREDIENT COUNT^F^^440;7^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,447,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,447,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0201,447,21,1,0) Count of compound product IDs (both active and inactive) in the compound "^DD",9002313.02,9002313.0201,447,21,2,0) mixture submitted. NCPDP standard field 447-EC. "^DD",9002313.02,9002313.0201,447,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0201,447,23,1,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0201,447,"DT") 3080103 "^DD",9002313.02,9002313.0201,447.01,0) COMPOUND REPEATING FIELDS^9002313.0501A^^447;0 "^DD",9002313.02,9002313.0201,447.01,3) "^DD",9002313.02,9002313.0201,447.01,21,0) ^^1^1^3080604^ "^DD",9002313.02,9002313.0201,447.01,21,1,0) Multiple to store multiple compounds in a prescription. "^DD",9002313.02,9002313.0201,447.01,"DT") 3080102 "^DD",9002313.02,9002313.0201,450,0) COMPOUND DOSAGE DESCRIPTION^F^^440;10^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,450,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,450,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,450,21,1,0) Dosage form of the complete compound mixture. NCPDP standard field "^DD",9002313.02,9002313.0201,450,21,2,0) 450-EF. "^DD",9002313.02,9002313.0201,450,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,450,23,1,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0201,450,"DT") 3080104 "^DD",9002313.02,9002313.0201,451,0) COMPOUND DISPENSING INDICATOR^F^^450;1^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,451,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,451,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,451,21,1,0) NCPDP standard product billing codes. NCPDP standard field 451-EG. "^DD",9002313.02,9002313.0201,451,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,451,23,1,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0201,451,"DT") 3080104 "^DD",9002313.02,9002313.0201,452,0) COMPOUND ROUTE OF ADMIN^F^^450;2^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,452,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,452,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,452,21,1,0) Code for the route of administration of the complete compound mixture. "^DD",9002313.02,9002313.0201,452,21,2,0) NCPDP standard field 452-EH. "^DD",9002313.02,9002313.0201,452,"DT") 3080104 "^DD",9002313.02,9002313.0201,453,0) ORIGINAL PRODUCT SERVICE ID^F^^450;3^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,453,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,453,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,453,21,1,0) Code qualifying the value in 'Originally Prescribed Product/Service Code' "^DD",9002313.02,9002313.0201,453,21,2,0) (Field 445-EA). NCPDP standard field 453-EJ. "^DD",9002313.02,9002313.0201,453,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,453,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,453,"DT") 3080104 "^DD",9002313.02,9002313.0201,454,0) SCHEDULED RX ID NUMBER^F^^450;4^K:$L(X)>14!($L(X)<14) X "^DD",9002313.02,9002313.0201,454,3) Answer must be 14 characters in length "^DD",9002313.02,9002313.0201,454,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,454,21,1,0) The serial number of the prescription blank/form. NCPDP standard field "^DD",9002313.02,9002313.0201,454,21,2,0) 454-EK. "^DD",9002313.02,9002313.0201,454,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,454,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,454,"DT") 3080104 "^DD",9002313.02,9002313.0201,455,0) PRESCRIPTION SERVICE REFERENCE^F^^450;5^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,455,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,455,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,455,21,1,0) Indicates the type of billing submitted. NCPDP standard field 455-EM. "^DD",9002313.02,9002313.0201,455,23,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.0201,455,23,1,0) Qualifies Prescription/Service Reference Number (402-D2). "^DD",9002313.02,9002313.0201,455,23,2,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,455,23,3,0) RESPONSE CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,455,"DT") 3080104 "^DD",9002313.02,9002313.0201,456,0) ASSOCIATED RX/SERVICE REF NO^F^^450;6^K:$L(X)>14!($L(X)<14) X "^DD",9002313.02,9002313.0201,456,.1) ASSOCIATED PRESCRIPTION/SERVICE REFERENCE NUMBER "^DD",9002313.02,9002313.0201,456,3) Answer must be 14 characters in length. "^DD",9002313.02,9002313.0201,456,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0201,456,21,1,0) This is the Related Prescription/Service Reference Number (402-D2) "^DD",9002313.02,9002313.0201,456,21,2,0) to which the service is associated. It is NCPDP field 456-EN. "^DD",9002313.02,9002313.0201,456,23,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.0201,456,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,456,"DT") 3101004 "^DD",9002313.02,9002313.0201,457,0) ASSOCIATED PRESCRIPTION DATE^F^^450;7^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,457,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,457,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,457,21,1,0) Date of the Associated Prescription/Service Reference Number (456-EN). "^DD",9002313.02,9002313.0201,457,21,2,0) NCPDP standard field 457-EP. "^DD",9002313.02,9002313.0201,457,23,0) ^^8^8^3080104^ "^DD",9002313.02,9002313.0201,457,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,457,23,2,0) "^DD",9002313.02,9002313.0201,457,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,457,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,457,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,457,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,457,23,7,0) "^DD",9002313.02,9002313.0201,457,23,8,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,457,"DT") 3080104 "^DD",9002313.02,9002313.0201,458,0) PROCEDURE MODIFIER CODE COUNT^F^^450;8^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,458,3) Answer must be 4 characters in length. "^DD",9002313.02,9002313.0201,458,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0201,458,21,1,0) This is the count of the Procedure Modifier Code (459-ER) occurrences. "^DD",9002313.02,9002313.0201,458,21,2,0) It is NCPDP field 458-SE. "^DD",9002313.02,9002313.0201,458,23,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.0201,458,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,458,"DT") 3101004 "^DD",9002313.02,9002313.0201,459,0) PROCEDURE MODIFIER CODE^9002313.201459A^^459;0 "^DD",9002313.02,9002313.0201,459,21,0) ^^1^1^3031216^ "^DD",9002313.02,9002313.0201,459,21,1,0) Multiple for storing procedure code information. "^DD",9002313.02,9002313.0201,459,"DT") 3080102 "^DD",9002313.02,9002313.0201,460,0) QUANTITY PRESCRIBED^F^^450;10^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,460,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,460,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,460,21,1,0) Amount expressed in metric decimal units. Quantity prescribed during "^DD",9002313.02,9002313.0201,460,21,2,0) order entry. NCPDP standard field 460-ET. "^DD",9002313.02,9002313.0201,460,23,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,460,23,1,0) Format=9999999.999 "^DD",9002313.02,9002313.0201,460,23,2,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,460,"DT") 3080104 "^DD",9002313.02,9002313.0201,461,0) PRIOR AUTHORIZATION TYPE CODE^F^^460;1^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,461,3) Answer must be 4 characters in length. "^DD",9002313.02,9002313.0201,461,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,461,21,1,0) Code clarifying the Prior Authorization Number Submitted (462-EV) or "^DD",9002313.02,9002313.0201,461,21,2,0) benefit/plan exemption. NCPDP standard field 461-EU. "^DD",9002313.02,9002313.0201,461,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,461,23,1,0) REQUEST CLAIM SEGMENT "^DD",9002313.02,9002313.0201,461,"DT") 3080104 "^DD",9002313.02,9002313.0201,462,0) PRIOR AUTHORIZATION SUBMITTED^F^^460;2^K:$L(X)>13!($L(X)<13) X "^DD",9002313.02,9002313.0201,462,3) Answer must be 13 characters in length. "^DD",9002313.02,9002313.0201,462,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,462,21,1,0) Number submitted by the provider to identify the prior authorization. "^DD",9002313.02,9002313.0201,462,21,2,0) NCPDP standard field 462-EV. "^DD",9002313.02,9002313.0201,462,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,462,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,462,"DT") 3080104 "^DD",9002313.02,9002313.0201,463,0) INTERMEDIARY AUTH TYPE ID^F^^460;3^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,463,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,463,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,463,21,1,0) Value indicating that authorization occurred for intermediary "^DD",9002313.02,9002313.0201,463,21,2,0) processing. NCPDP standard field 463-EW. "^DD",9002313.02,9002313.0201,463,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,463,23,1,0) REQUEST CLAIM SEGMENT "^DD",9002313.02,9002313.0201,463,"DT") 3080104 "^DD",9002313.02,9002313.0201,464,0) INTERMEDIARY AUTHORIZATION ID^F^^460;4^K:$L(X)>13!($L(X)<13) X "^DD",9002313.02,9002313.0201,464,3) Answer must be 13 characters in length "^DD",9002313.02,9002313.0201,464,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,464,21,1,0) Value indicating intermediary authorization occurred. NCPDP standard "^DD",9002313.02,9002313.0201,464,21,2,0) field 464-EX. "^DD",9002313.02,9002313.0201,464,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,464,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,464,"DT") 3080104 "^DD",9002313.02,9002313.0201,465,0) PROVIDER ID QUALIFIER^F^^460;5^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,465,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,465,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,465,21,1,0) Code qualifying the Provider ID (444-E9). NCPDP standard field 465-EY. "^DD",9002313.02,9002313.0201,465,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,465,23,1,0) REQUEST PHARMACY PROVIDER SEGMENT. "^DD",9002313.02,9002313.0201,465,"DT") 3080104 "^DD",9002313.02,9002313.0201,466,0) PRESCRIBER ID QUALIFIER^F^^460;6^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,466,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,466,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,466,21,1,0) Code qualifying the Prescriber ID (411-DB). NCPDP standard field 466-EZ. "^DD",9002313.02,9002313.0201,466,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,466,23,1,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,466,"DT") 3080104 "^DD",9002313.02,9002313.0201,467,0) PRESCRIBER LOCATION CODE^F^^460;7^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.0201,467,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.0201,467,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,467,21,1,0) Location address code assigned to the prescriber as identified in the "^DD",9002313.02,9002313.0201,467,21,2,0) National Provider System (NPS). NCPDP standard field 467-1E. "^DD",9002313.02,9002313.0201,467,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,467,23,1,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,467,"DT") 3080104 "^DD",9002313.02,9002313.0201,468,0) PC PROVIDER ID QUALIFIER^F^^460;8^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,468,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,468,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,468,21,1,0) Code qualifying the Primary Care Provider ID (421-DL). NCPDP standard "^DD",9002313.02,9002313.0201,468,21,2,0) field 468-2E. "^DD",9002313.02,9002313.0201,468,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,468,23,1,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,468,"DT") 3080104 "^DD",9002313.02,9002313.0201,469,0) PC PROVIDER LOCATION CODE^F^^460;9^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.0201,469,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.0201,469,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,469,21,1,0) Location address code assigned to the primary care provider as identified "^DD",9002313.02,9002313.0201,469,21,2,0) in the National Provider System (NPS). NCPDP standard field 469-H5. "^DD",9002313.02,9002313.0201,469,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,469,23,1,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,469,"DT") 3080104 "^DD",9002313.02,9002313.0201,470,0) PC PROVIDER LAST NAME^F^^460;10^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,470,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,470,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,470,21,1,0) Last name of the Primary Care Provider. NCPDP standard field 470-4E. "^DD",9002313.02,9002313.0201,470,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,470,23,1,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,470,"DT") 3080104 "^DD",9002313.02,9002313.0201,471,0) OTHER PAYER REJECT COUNT^F^^470;1^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,471,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,471,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,471,21,1,0) Count of Other Payer Reject Code (472-6E) occurrences. NCPDP standard "^DD",9002313.02,9002313.0201,471,21,2,0) field 471-5E. "^DD",9002313.02,9002313.0201,471,23,0) ^.001^4^4^3101020^^^^ "^DD",9002313.02,9002313.0201,471,23,1,0) Number of reject codes identified by the previous "Other Payer" in "^DD",9002313.02,9002313.0201,471,23,2,0) Reject Count (510-FA). "^DD",9002313.02,9002313.0201,471,23,3,0) "^DD",9002313.02,9002313.0201,471,23,4,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0201,471,"DT") 3080604 "^DD",9002313.02,9002313.0201,473.01,0) DUR PPS REPEATING FIELDS^9002313.1001A^^473.01;0 "^DD",9002313.02,9002313.0201,473.01,21,0) ^.001^1^1^3040126^^ "^DD",9002313.02,9002313.0201,473.01,21,1,0) Count of Drug Utilization sub-records. "^DD",9002313.02,9002313.0201,473.01,"DT") 3080102 "^DD",9002313.02,9002313.0201,477,0) PROFESSIONAL FEE SUBMITTED^F^^470;7^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,477,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,477,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,477,21,1,0) Amount submitted by the provider for professional services rendered. "^DD",9002313.02,9002313.0201,477,21,2,0) NCPDP standard field 477-BE. "^DD",9002313.02,9002313.0201,477,23,0) ^.001^6^6^3101020^^^ "^DD",9002313.02,9002313.0201,477,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,477,23,2,0) "^DD",9002313.02,9002313.0201,477,23,3,0) Examples: If the Professional Service Fee Submitted is $7.00, this field "^DD",9002313.02,9002313.0201,477,23,4,0) would reflect: 70{. "^DD",9002313.02,9002313.0201,477,23,5,0) "^DD",9002313.02,9002313.0201,477,23,6,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,477,"DT") 3080104 "^DD",9002313.02,9002313.0201,478,0) OTHER AMT CLAIMED SUBMTTD CNT^F^^470;8^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,478,.1) OTHER AMOUNT CLAIMED SUBMITTED COUNT "^DD",9002313.02,9002313.0201,478,3) Answer must be 3 characters in length. "^DD",9002313.02,9002313.0201,478,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0201,478,21,1,0) This is NCPDP field 478-H7 (Other Amount Claimed Submitted Count). "^DD",9002313.02,9002313.0201,478,21,2,0) It is the count of 'Other Amount Claimed Submitted' occurrences. "^DD",9002313.02,9002313.0201,478,23,0) ^.001^5^5^3101020^^^^ "^DD",9002313.02,9002313.0201,478,23,1,0) Fields included in the set/logical grouping are: "^DD",9002313.02,9002313.0201,478,23,2,0) Other Amount Claimed Submitted Qualifier (479-H8), "^DD",9002313.02,9002313.0201,478,23,3,0) Other Amount Claim Submitted (480-H9). "^DD",9002313.02,9002313.0201,478,23,4,0) "^DD",9002313.02,9002313.0201,478,23,5,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,478,"DT") 3101013 "^DD",9002313.02,9002313.0201,478.01,0) OTHER AMT CLAIMED MULTIPLE^9002313.0601A^^478.01;0 "^DD",9002313.02,9002313.0201,478.01,21,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.0201,478.01,21,1,0) This sub-file stores Other Amount Claimed values. "^DD",9002313.02,9002313.0201,478.01,"DT") 3101013 "^DD",9002313.02,9002313.0201,481,0) FLAT SALES TAX SUBMITTED^F^^480;1^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,481,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,481,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,481,21,1,0) Flat sales tax submitted for prescription. This amount is included in the "^DD",9002313.02,9002313.0201,481,21,2,0) Gross Amount Due (430-DU). NCPDP standard field 481-HA. "^DD",9002313.02,9002313.0201,481,23,0) ^^13^13^3080104^ "^DD",9002313.02,9002313.0201,481,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,481,23,2,0) "^DD",9002313.02,9002313.0201,481,23,3,0) The submission of sales tax is governed by regulatory agencies (state, "^DD",9002313.02,9002313.0201,481,23,4,0) local, parish, etc). If the sales tax reported is a flat rate, then it is "^DD",9002313.02,9002313.0201,481,23,5,0) a fixed amount for a certain dollar value (for example for $xxx it is a "^DD",9002313.02,9002313.0201,481,23,6,0) certain amount). For example, for $1ØØ the flat rate is $1.99. This flat "^DD",9002313.02,9002313.0201,481,23,7,0) rate is then reported in Flat Sales Tax Amount Submitted "^DD",9002313.02,9002313.0201,481,23,8,0) (481-HA). "^DD",9002313.02,9002313.0201,481,23,9,0) "^DD",9002313.02,9002313.0201,481,23,10,0) Examples: If the flat sales tax amount submitted is $3.08, this "^DD",9002313.02,9002313.0201,481,23,11,0) field would reflect: 30H. "^DD",9002313.02,9002313.0201,481,23,12,0) "^DD",9002313.02,9002313.0201,481,23,13,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,481,"DT") 3080104 "^DD",9002313.02,9002313.0201,482,0) PERCENTAGE SALES TAX SUBMITTED^F^^480;2^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,482,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,482,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,482,21,1,0) Percentage sales tax submitted. NCPDP standard field 482-GE. "^DD",9002313.02,9002313.0201,482,23,0) ^^9^9^3080104^ "^DD",9002313.02,9002313.0201,482,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0201,482,23,2,0) "^DD",9002313.02,9002313.0201,482,23,3,0) Comments: The submission of sales tax is governed by regulatory agencies "^DD",9002313.02,9002313.0201,482,23,4,0) (state, local, parish, etc).. "^DD",9002313.02,9002313.0201,482,23,5,0) "^DD",9002313.02,9002313.0201,482,23,6,0) Examples: If the percentage sales tax amount submitted is $4.47, this "^DD",9002313.02,9002313.0201,482,23,7,0) field would reflect: 44G. "^DD",9002313.02,9002313.0201,482,23,8,0) "^DD",9002313.02,9002313.0201,482,23,9,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,482,"DT") 3080104 "^DD",9002313.02,9002313.0201,483,0) PERCENTAGE SALES TAX RATE^F^^480;3^K:$L(X)>9!($L(X)<9) X "^DD",9002313.02,9002313.0201,483,3) Answer must be 9 characters in length "^DD",9002313.02,9002313.0201,483,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,483,21,1,0) Percentage sales tax rate used to calculate Percentage Sales Tax Amount "^DD",9002313.02,9002313.0201,483,21,2,0) Submitted (482-GE). NCPDP standard field 483-HE. "^DD",9002313.02,9002313.0201,483,23,0) ^^6^6^3080104^ "^DD",9002313.02,9002313.0201,483,23,1,0) The submission of sales tax is governed by regulatory agencies (state, "^DD",9002313.02,9002313.0201,483,23,2,0) local, parish, etc). "^DD",9002313.02,9002313.0201,483,23,3,0) "^DD",9002313.02,9002313.0201,483,23,4,0) Format=s999.9999 "^DD",9002313.02,9002313.0201,483,23,5,0) "^DD",9002313.02,9002313.0201,483,23,6,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,483,"DT") 3080104 "^DD",9002313.02,9002313.0201,484,0) PERCENTAGE SALES TAX BASIS^F^^480;4^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,484,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,484,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,484,21,1,0) Code indicating the basis for percentage sales tax. NCPDP standard field "^DD",9002313.02,9002313.0201,484,21,2,0) 484-JE. "^DD",9002313.02,9002313.0201,484,23,0) ^^4^4^3080104^ "^DD",9002313.02,9002313.0201,484,23,1,0) The submission of sales tax is governed by regulatory agencies (state, "^DD",9002313.02,9002313.0201,484,23,2,0) local, parish, etc). "^DD",9002313.02,9002313.0201,484,23,3,0) "^DD",9002313.02,9002313.0201,484,23,4,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0201,484,"DT") 3080104 "^DD",9002313.02,9002313.0201,485,0) COUPON TYPE^F^^480;5^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,485,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,485,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,485,21,1,0) Code indicating the type of coupon being used. NCPDP standard field "^DD",9002313.02,9002313.0201,485,21,2,0) 485-KE. "^DD",9002313.02,9002313.0201,485,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,485,23,1,0) REQUEST COUPON SEGMENT. "^DD",9002313.02,9002313.0201,485,"DT") 3080104 "^DD",9002313.02,9002313.0201,486,0) COUPON NUMBER^F^^480;6^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,486,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,486,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,486,21,1,0) Unique serial number assigned to the prescription coupons. NCPDP "^DD",9002313.02,9002313.0201,486,21,2,0) standard field 486-ME. "^DD",9002313.02,9002313.0201,486,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,486,23,1,0) REQUEST COUPON SEGMENT. "^DD",9002313.02,9002313.0201,486,"DT") 3080104 "^DD",9002313.02,9002313.0201,487,0) COUPON VALUE AMOUNT^F^^480;7^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,487,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,487,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,487,21,1,0) Value of the coupon. NCPDP standard field 487-NE. "^DD",9002313.02,9002313.0201,487,23,0) ^^6^6^3080104^ "^DD",9002313.02,9002313.0201,487,23,1,0) Format=s$$$$$$vcc "^DD",9002313.02,9002313.0201,487,23,2,0) "^DD",9002313.02,9002313.0201,487,23,3,0) Examples: If the coupon value amount is $10.00, this field would reflect: "^DD",9002313.02,9002313.0201,487,23,4,0) 100{. "^DD",9002313.02,9002313.0201,487,23,5,0) "^DD",9002313.02,9002313.0201,487,23,6,0) REQUEST COUPON SEGMENT. "^DD",9002313.02,9002313.0201,487,"DT") 3080104 "^DD",9002313.02,9002313.0201,491,0) DIAGNOSIS CODE COUNT^F^^490;1^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,491,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,491,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,491,21,1,0) Count of diagnosis occurrences. NCPDP standard field 491-VE. "^DD",9002313.02,9002313.0201,491,23,0) ^^4^4^3080104^ "^DD",9002313.02,9002313.0201,491,23,1,0) Fields included in the set/logical grouping are: "^DD",9002313.02,9002313.0201,491,23,2,0) Diagnosis Code Qualifier (492-WE) "^DD",9002313.02,9002313.0201,491,23,3,0) Diagnosis Code (424-DO) "^DD",9002313.02,9002313.0201,491,23,4,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0201,491,"DT") 3080104 "^DD",9002313.02,9002313.0201,491.01,0) CLINICAL DIAGNOSIS^9002313.0701A^^491.01;0 "^DD",9002313.02,9002313.0201,491.01,21,0) ^^1^1^3080102^ "^DD",9002313.02,9002313.0201,491.01,21,1,0) Diagnosis sub-records. "^DD",9002313.02,9002313.0201,491.01,"DT") 3080102 "^DD",9002313.02,9002313.0201,493,0) CLINICAL INFORMATION COUNT^F^^493;1^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,493,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,493,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,493,21,1,0) Counter number of clinical information measurement set/logical grouping. "^DD",9002313.02,9002313.0201,493,21,2,0) NCPDP standard field 493-XE. "^DD",9002313.02,9002313.0201,493,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,493,23,1,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0201,493,"DT") 3080104 "^DD",9002313.02,9002313.0201,493.01,0) CLINICAL INFORMATION^9002313.0801A^^493.01;0 "^DD",9002313.02,9002313.0201,493.01,21,0) ^.001^1^1^3040126^^^ "^DD",9002313.02,9002313.0201,493.01,21,1,0) Count of clinical information sub-records. "^DD",9002313.02,9002313.0201,493.01,"DT") 3080102 "^DD",9002313.02,9002313.0201,498.01,0) REQUEST TYPE^F^^498;1^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0201,498.01,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0201,498.01,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.01,21,1,0) Code identifying type of prior authorization request. NCPDP standard "^DD",9002313.02,9002313.0201,498.01,21,2,0) field 498-PA. "^DD",9002313.02,9002313.0201,498.01,23,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.01,23,1,0) Used by processor to distinguish reason for prior authorization request. "^DD",9002313.02,9002313.0201,498.01,23,2,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.01,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.02,0) REQUEST PERIOD BEGIN DATE^F^^498;2^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,498.02,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,498.02,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.02,21,1,0) Beginning date for a prior authorization request. NCPDP standard field "^DD",9002313.02,9002313.0201,498.02,21,2,0) 498-PB. "^DD",9002313.02,9002313.0201,498.02,23,0) ^^11^11^3080104^ "^DD",9002313.02,9002313.0201,498.02,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,498.02,23,2,0) "^DD",9002313.02,9002313.0201,498.02,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,498.02,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,498.02,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,498.02,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,498.02,23,7,0) "^DD",9002313.02,9002313.0201,498.02,23,8,0) Used by processor to determine starting date of a prior authorization "^DD",9002313.02,9002313.0201,498.02,23,9,0) request. "^DD",9002313.02,9002313.0201,498.02,23,10,0) "^DD",9002313.02,9002313.0201,498.02,23,11,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.02,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.03,0) REQUEST PERIOD END DATE^F^^498;3^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0201,498.03,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0201,498.03,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.03,21,1,0) End date for a prior authorization request. NCPDP standard field 498-PC. "^DD",9002313.02,9002313.0201,498.03,23,0) ^^10^10^3080104^ "^DD",9002313.02,9002313.0201,498.03,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0201,498.03,23,2,0) "^DD",9002313.02,9002313.0201,498.03,23,3,0) CC=Century "^DD",9002313.02,9002313.0201,498.03,23,4,0) YY=Year "^DD",9002313.02,9002313.0201,498.03,23,5,0) MM=Month "^DD",9002313.02,9002313.0201,498.03,23,6,0) DD=Day "^DD",9002313.02,9002313.0201,498.03,23,7,0) Used by processor to determine the ending date for a prior authorization "^DD",9002313.02,9002313.0201,498.03,23,8,0) request. "^DD",9002313.02,9002313.0201,498.03,23,9,0) "^DD",9002313.02,9002313.0201,498.03,23,10,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.03,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.04,0) BASIS OF REQUEST^F^^498;4^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,498.04,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,498.04,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.04,21,1,0) Code describing the reason for prior authorization request. NCPDP "^DD",9002313.02,9002313.0201,498.04,21,2,0) standard field 498-PD. "^DD",9002313.02,9002313.0201,498.04,23,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.0201,498.04,23,1,0) Used by processor to determine appropriate modules and editing for the "^DD",9002313.02,9002313.0201,498.04,23,2,0) prior authorization transaction. "^DD",9002313.02,9002313.0201,498.04,23,3,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.04,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.05,0) AUTHORIZED REP FIRST NAME^F^^498;5^K:$L(X)>14!($L(X)<14) X "^DD",9002313.02,9002313.0201,498.05,3) Answer must be 14 characters in length "^DD",9002313.02,9002313.0201,498.05,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.05,21,1,0) First name of the patients authorized representative. NCPDP standard "^DD",9002313.02,9002313.0201,498.05,21,2,0) field 498-PE. "^DD",9002313.02,9002313.0201,498.05,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.05,23,1,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.05,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.06,0) AUTHORIZED REP LAST NAME^F^^498;6^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,498.06,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,498.06,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.06,21,1,0) Last name of the patients authorized representative. NCPDP standard "^DD",9002313.02,9002313.0201,498.06,21,2,0) field 498-PF. "^DD",9002313.02,9002313.0201,498.06,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.06,23,1,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.06,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.07,0) AUTHORIZED REP STREET ADDRESS^F^^498;7^K:$L(X)>32!($L(X)<32) X "^DD",9002313.02,9002313.0201,498.07,3) Answer must be 32 characters in length "^DD",9002313.02,9002313.0201,498.07,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.07,21,1,0) Free-form text for address information. NCPDP standard field 498-PG. "^DD",9002313.02,9002313.0201,498.07,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.07,23,1,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.07,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.08,0) AUTHORIZED REP CITY ADDRESS^F^^498;8^K:$L(X)>22!($L(X)<22) X "^DD",9002313.02,9002313.0201,498.08,3) Answer must be 22 characters in length "^DD",9002313.02,9002313.0201,498.08,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.08,21,1,0) Free-form text for city name. NCPDP standard field 498-PH. "^DD",9002313.02,9002313.0201,498.08,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.08,23,1,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.08,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.09,0) AUTHORIZED REP STATE PROV^F^^498;9^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,498.09,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0201,498.09,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.09,21,1,0) Authorized Rep's State or Province. NCPDP standard field 498-PJ. "^DD",9002313.02,9002313.0201,498.09,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.09,23,1,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.09,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.11,0) AUTHORIZED REP ZIP^F^^498;11^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0201,498.11,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0201,498.11,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.11,21,1,0) Authorized Rep's Zip Code. NCPDP standard field 498-PK. "^DD",9002313.02,9002313.0201,498.11,23,0) ^^4^4^3080104^ "^DD",9002313.02,9002313.0201,498.11,23,1,0) This left-justified field contains the five-digit zip code, and may "^DD",9002313.02,9002313.0201,498.11,23,2,0) include the four-digit expanded zip code in which the patient's "^DD",9002313.02,9002313.0201,498.11,23,3,0) authorized representative is located. "^DD",9002313.02,9002313.0201,498.11,23,4,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.11,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.12,0) PRESCRIBER PHONE NUMBER^F^^498;12^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0201,498.12,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0201,498.12,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,498.12,21,1,0) Ten digit phone number of the prescriber. NCPDP standard field 498-PM. "^DD",9002313.02,9002313.0201,498.12,23,0) ^^10^10^3080104^ "^DD",9002313.02,9002313.0201,498.12,23,1,0) Format=AAAEEENNNN "^DD",9002313.02,9002313.0201,498.12,23,2,0) "^DD",9002313.02,9002313.0201,498.12,23,3,0) AAA=Area Code "^DD",9002313.02,9002313.0201,498.12,23,4,0) EEE=Exchange Code "^DD",9002313.02,9002313.0201,498.12,23,5,0) NNNN=Number "^DD",9002313.02,9002313.0201,498.12,23,6,0) "^DD",9002313.02,9002313.0201,498.12,23,7,0) Examples: This field would reflect the telephone number of (414) 555-1212 "^DD",9002313.02,9002313.0201,498.12,23,8,0) as 4145551212. "^DD",9002313.02,9002313.0201,498.12,23,9,0) "^DD",9002313.02,9002313.0201,498.12,23,10,0) REQUEST PRESCRIBER SEGMENT. "^DD",9002313.02,9002313.0201,498.12,"DT") 3080104 "^DD",9002313.02,9002313.0201,498.13,0) PRIOR AUTH SUPPORTING DOCUMNTN^9002313.0901^^498.13;0 "^DD",9002313.02,9002313.0201,498.13,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0201,498.13,21,1,0) This is a free text message. "^DD",9002313.02,9002313.0201,498.13,21,2,0) It is NCPDP field 498-PP. "^DD",9002313.02,9002313.0201,498.13,23,0) ^.001^4^4^3101020^^^^ "^DD",9002313.02,9002313.0201,498.13,23,1,0) Could be used, if applicable, to supply information not already included "^DD",9002313.02,9002313.0201,498.13,23,2,0) in NCPDP data fields that may be required to process a prior "^DD",9002313.02,9002313.0201,498.13,23,3,0) authorization transaction. "^DD",9002313.02,9002313.0201,498.13,23,4,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.13,"DT") 3101004 "^DD",9002313.02,9002313.0201,498.14,0) PRIOR AUTH NUMBER ASSIGNED^F^^498;14^K:$L(X)>13!($L(X)<13) X "^DD",9002313.02,9002313.0201,498.14,3) Answer must be 13 characters in length "^DD",9002313.02,9002313.0201,498.14,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,498.14,21,1,0) Unique number identifying the prior authorization assigned by the "^DD",9002313.02,9002313.0201,498.14,21,2,0) processor. NCPDP standard field 498-PY. "^DD",9002313.02,9002313.0201,498.14,23,0) ^^4^4^3080104^ "^DD",9002313.02,9002313.0201,498.14,23,1,0) Provided to the pharmacy by the processor to be used by the pharmacy for "^DD",9002313.02,9002313.0201,498.14,23,2,0) billing, and if applicable, reversal purposes. "^DD",9002313.02,9002313.0201,498.14,23,3,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.14,23,4,0) RESPONSE PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,498.14,"DT") 3080104 "^DD",9002313.02,9002313.0201,503,0) AUTHORIZATION NUMBER^F^^500;3^K:$L(X)>22!($L(X)<22) X "^DD",9002313.02,9002313.0201,503,3) Answer must be 22 characters in length "^DD",9002313.02,9002313.0201,503,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,503,21,1,0) Unique number identifying the prior authorization assigned by the "^DD",9002313.02,9002313.0201,503,21,2,0) processor. NCPDP standard field 503-F3. "^DD",9002313.02,9002313.0201,503,23,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0201,503,23,1,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0201,503,23,2,0) RESPONSE STATUS SEGMENT. "^DD",9002313.02,9002313.0201,503,"DT") 3080104 "^DD",9002313.02,9002313.0201,600,0) UNIT OF MEASURE^F^^600;1^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0201,600,3) Enter the Unit of Measure (4 characters) "^DD",9002313.02,9002313.0201,600,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,600,21,1,0) Unit of measure of the prescription. NCPDP standard field 600-28. "^DD",9002313.02,9002313.0201,600,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0201,600,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.0201,600,"DT") 3080104 "^DD",9002313.02,9002313.0201,880,0) TRANSACTION REFERENCE NUMBER^F^^870;10^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.0201,880,3) Answer must be 1-10 characters. "^DD",9002313.02,9002313.0201,880,21,0) ^.001^4^4^3101005^^^^ "^DD",9002313.02,9002313.0201,880,21,1,0) This is used to store NCPDP field 880-K5 (Transaction Reference Number), "^DD",9002313.02,9002313.0201,880,21,2,0) which is defined as "A reference number assigned by the provider to each of the data records in the batch or real-time transactions. "^DD",9002313.02,9002313.0201,880,21,3,0) The purpose of this number is to facilitate the process of matching the transaction response to the transaction. "^DD",9002313.02,9002313.0201,880,21,4,0) The transaction reference number assigned should be returned in the response." "^DD",9002313.02,9002313.0201,880,"DT") 3100727 "^DD",9002313.02,9002313.0201,995,0) ROUTE OF ADMINISTRATION^F^^990;5^K:$L(X)>11!($L(X)<1) X "^DD",9002313.02,9002313.0201,995,3) Answer must be 1-11 characters. "^DD",9002313.02,9002313.0201,995,21,0) ^.001^2^2^3100929^^ "^DD",9002313.02,9002313.0201,995,21,1,0) This is used to store NCPDP field 995-E2 (Route of Administration), "^DD",9002313.02,9002313.0201,995,21,2,0) which is defined as "This is an override to the default route referenced for the product. For a multi-ingredient compound, it is the route of the complete compound mixture." "^DD",9002313.02,9002313.0201,995,"DT") 3100727 "^DD",9002313.02,9002313.0201,996,0) COMPOUND TYPE^F^^990;6^K:$L(X)>2!($L(X)<1) X "^DD",9002313.02,9002313.0201,996,3) Answer must be 1-2 characters. "^DD",9002313.02,9002313.0201,996,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.02,9002313.0201,996,21,1,0) This is used to store NCPDP field 996-G1 (Compound Type), "^DD",9002313.02,9002313.0201,996,21,2,0) which is defined as "Clarifies the type of compound." "^DD",9002313.02,9002313.0201,996,"DT") 3100727 "^DD",9002313.02,9002313.02354,0) SUBMISSION CLARIFICATION MLTPL SUB-FIELD^^420^2 "^DD",9002313.02,9002313.02354,0,"DT") 3100924 "^DD",9002313.02,9002313.02354,0,"IX","B",9002313.02354,.01) "^DD",9002313.02,9002313.02354,0,"NM","SUBMISSION CLARIFICATION MLTPL") "^DD",9002313.02,9002313.02354,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.02354,.01,0) SUBMISSION CLRFCTN CODE CNTR^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.02,9002313.02354,.01,.1) SUBMISSION CLARIFICATION CODE COUNTER "^DD",9002313.02,9002313.02354,.01,1,0) ^.1 "^DD",9002313.02,9002313.02354,.01,1,1,0) 9002313.02354^B "^DD",9002313.02,9002313.02354,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),354.01,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.02354,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),354.01,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.02354,.01,3) Type a Number between 1 and 99, 0 Decimal Digits. "^DD",9002313.02,9002313.02354,.01,21,0) ^.001^1^1^3101020^^^ "^DD",9002313.02,9002313.02354,.01,21,1,0) This is a sequential counter of the Submission Clarification occurrences. "^DD",9002313.02,9002313.02354,.01,"DT") 3100819 "^DD",9002313.02,9002313.02354,420,0) SUBMISSION CLARIFICATION CODE^F^^1;1^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.02354,420,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.02354,420,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.02,9002313.02354,420,21,1,0) This is used to store NCPDP field 420-DK (Submission Clarification Code), "^DD",9002313.02,9002313.02354,420,21,2,0) which is defined as "Code indicating that the pharmacist is clarifying the submission." "^DD",9002313.02,9002313.02354,420,23,0) ^.001^10^10^3101004^^^ "^DD",9002313.02,9002313.02354,420,23,1,0) Examples: Since the patient will be out of "^DD",9002313.02,9002313.02354,420,23,2,0) state for the next three months, they have "^DD",9002313.02,9002313.02354,420,23,3,0) requested a three month supply of their "^DD",9002313.02,9002313.02354,420,23,4,0) medication. This situation can cause the "^DD",9002313.02,9002313.02354,420,23,5,0) claim to reject, because it was refilled too "^DD",9002313.02,9002313.02354,420,23,6,0) soon. By indicating an 03, the processor is "^DD",9002313.02,9002313.02354,420,23,7,0) made aware of the situation, and can properly "^DD",9002313.02,9002313.02354,420,23,8,0) adjudicate the claim. "^DD",9002313.02,9002313.02354,420,23,9,0) "^DD",9002313.02,9002313.02354,420,23,10,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.02354,420,"DT") 3100924 "^DD",9002313.02,9002313.023771,0) QUESTION NUMBER/LETTER MLTPL SUB-FIELD^^383^7 "^DD",9002313.02,9002313.023771,0,"DT") 3100902 "^DD",9002313.02,9002313.023771,0,"IX","B",9002313.023771,.01) "^DD",9002313.02,9002313.023771,0,"NM","QUESTION NUMBER/LETTER MLTPL") "^DD",9002313.02,9002313.023771,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.023771,.01,0) QUESTION NUMBER/LETTER COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.02,9002313.023771,.01,1,0) ^.1 "^DD",9002313.02,9002313.023771,.01,1,1,0) 9002313.023771^B "^DD",9002313.02,9002313.023771,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),377.01,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.023771,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),377.01,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.023771,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.02,9002313.023771,.01,21,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.023771,.01,21,1,0) This is a sequential counter of Question Number/Letter occurrences. "^DD",9002313.02,9002313.023771,.01,23,0) ^.001^9^9^3101020^^^^ "^DD",9002313.02,9002313.023771,.01,23,1,0) Integer counter incremented as needed by BPS* software. "^DD",9002313.02,9002313.023771,.01,23,2,0) "^DD",9002313.02,9002313.023771,.01,23,3,0) Fields included in the set/logical grouping are: "^DD",9002313.02,9002313.023771,.01,23,4,0) Question Number/Letter (378-4B), "^DD",9002313.02,9002313.023771,.01,23,5,0) Question Percent Response (379-4D), "^DD",9002313.02,9002313.023771,.01,23,6,0) Question Date Response (380-4G), "^DD",9002313.02,9002313.023771,.01,23,7,0) Question Dollar Amount Response (381-4H), "^DD",9002313.02,9002313.023771,.01,23,8,0) Question Numeric Response (382-4J), "^DD",9002313.02,9002313.023771,.01,23,9,0) Question Alphanumeric Response (383-4K). "^DD",9002313.02,9002313.023771,.01,"DT") 3100902 "^DD",9002313.02,9002313.023771,378,0) QUESTION NUMBER/LETTER^F^^0;2^K:$L(X)>5!($L(X)<1) X "^DD",9002313.02,9002313.023771,378,3) Answer must be 1-5 characters. "^DD",9002313.02,9002313.023771,378,21,0) ^.001^3^3^3101004^^ "^DD",9002313.02,9002313.023771,378,21,1,0) This is used to store NCPDP field 378-4B (Question Number/Letter), "^DD",9002313.02,9002313.023771,378,21,2,0) which is defined as "Identifies the question number/letter that the question response "^DD",9002313.02,9002313.023771,378,21,3,0) applies to (part of the question information)." "^DD",9002313.02,9002313.023771,378,23,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.023771,378,23,1,0) Values to be determined by Trading Partner Agreement. "^DD",9002313.02,9002313.023771,378,23,2,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.023771,378,"DT") 3100902 "^DD",9002313.02,9002313.023771,379,0) QUESTION PERCENT RESPONSE^F^^0;3^K:$L(X)>7!($L(X)<1) X "^DD",9002313.02,9002313.023771,379,3) Answer must be 1-7 characters. "^DD",9002313.02,9002313.023771,379,21,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.023771,379,21,1,0) This is used to store NCPDP field 379-4D (Question Percent Response), "^DD",9002313.02,9002313.023771,379,21,2,0) which is defined as "Percent response to a question (part of the question information)." "^DD",9002313.02,9002313.023771,379,23,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.023771,379,23,1,0) Examples: 25.75% = 02575 or 0.5% = 0005 "^DD",9002313.02,9002313.023771,379,23,2,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.023771,379,"DT") 3100902 "^DD",9002313.02,9002313.023771,380,0) QUESTION DATE RESPONSE^F^^0;4^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.023771,380,3) Answer must be 1-10 characters. "^DD",9002313.02,9002313.023771,380,21,0) ^.001^2^2^3101004^^ "^DD",9002313.02,9002313.023771,380,21,1,0) This is used to store NCPDP field 380-4G (Question Date Response), "^DD",9002313.02,9002313.023771,380,21,2,0) which is defined as "Date response to a question (part of the question information)." "^DD",9002313.02,9002313.023771,380,23,0) ^.001^3^3^3101004^^ "^DD",9002313.02,9002313.023771,380,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.023771,380,23,2,0) "^DD",9002313.02,9002313.023771,380,23,3,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.023771,380,"DT") 3100902 "^DD",9002313.02,9002313.023771,381,0) QUESTION DOLLAR AMT RESPONSE^F^^0;5^K:$L(X)>13!($L(X)<1) X "^DD",9002313.02,9002313.023771,381,.1) QUESTION DOLLAR AMOUNT RESPONSE "^DD",9002313.02,9002313.023771,381,3) Answer must be 1-13 characters. "^DD",9002313.02,9002313.023771,381,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.023771,381,21,1,0) This is used to store NCPDP field 381-4H (Question Dollar Amount Response), "^DD",9002313.02,9002313.023771,381,21,2,0) which is defined as "Dollar Amount response to a question (part of the question information)." "^DD",9002313.02,9002313.023771,381,23,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.023771,381,23,1,0) Format=s$$$$$$$$$cc "^DD",9002313.02,9002313.023771,381,23,2,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.023771,381,"DT") 3100902 "^DD",9002313.02,9002313.023771,382,0) QUESTION NUMERIC RESPONSE^F^^0;6^K:$L(X)>13!($L(X)<1) X "^DD",9002313.02,9002313.023771,382,3) Answer must be 1-13 characters. "^DD",9002313.02,9002313.023771,382,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.023771,382,21,1,0) This is used to store NCPDP field 382-4J (Question Numeric Response), "^DD",9002313.02,9002313.023771,382,21,2,0) which is defined as "Numeric response to a question (part of the question information)." "^DD",9002313.02,9002313.023771,382,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.02,9002313.023771,382,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.023771,382,"DT") 3100902 "^DD",9002313.02,9002313.023771,383,0) QUESTION ALPHANUMERIC RESPONSE^F^^0;7^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.023771,383,3) Answer must be 1-32 characters. "^DD",9002313.02,9002313.023771,383,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.02,9002313.023771,383,21,1,0) This is used to store NCPDP field 383-4K (Question Alphanumeric Response), "^DD",9002313.02,9002313.023771,383,21,2,0) which is defined as "Alphanumeric response to a question (part of the question information)." "^DD",9002313.02,9002313.023771,383,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.02,9002313.023771,383,23,1,0) REQUEST ADDITIONAL DOCUMENTATION SEGMENT. "^DD",9002313.02,9002313.023771,383,"DT") 3100902 "^DD",9002313.02,9002313.0401,0) COB OTHER PAYMENTS SUB-FIELD^^392.01^14 "^DD",9002313.02,9002313.0401,0,"DT") 3100901 "^DD",9002313.02,9002313.0401,0,"IX","B",9002313.0401,.01) "^DD",9002313.02,9002313.0401,0,"NM","COB OTHER PAYMENTS") "^DD",9002313.02,9002313.0401,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.0401,.01,0) COB OTHER PAYMENT COUNTER^F^^0;1^K:$L(X)>1!($L(X)<1) X "^DD",9002313.02,9002313.0401,.01,1,0) ^.1 "^DD",9002313.02,9002313.0401,.01,1,1,0) 9002313.0401^B "^DD",9002313.02,9002313.0401,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),337,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.0401,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),337,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.0401,.01,3) Answer must be 1 character in length. "^DD",9002313.02,9002313.0401,.01,21,0) ^^2^2^3080604^ "^DD",9002313.02,9002313.0401,.01,21,1,0) This is a multiple counter field to store multiple COB payments received "^DD",9002313.02,9002313.0401,.01,21,2,0) from other payers. "^DD",9002313.02,9002313.0401,.01,"DT") 3080604 "^DD",9002313.02,9002313.0401,338,0) OTHER PAYER COVERAGE TYPE^F^^0;2^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0401,338,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0401,338,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0401,338,21,1,0) Code identifying the type of Other Payer ID (340-7C). NCPDP standard "^DD",9002313.02,9002313.0401,338,21,2,0) field 338-5C. "^DD",9002313.02,9002313.0401,338,23,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0401,338,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,338,23,2,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,338,"DT") 3080103 "^DD",9002313.02,9002313.0401,339,0) OTHER PAYER ID QUALIFIER^F^^0;3^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0401,339,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0401,339,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0401,339,21,1,0) Code qualifying the Other Payer ID (340-7C). NCPDP standard field 339-6C. "^DD",9002313.02,9002313.0401,339,23,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0401,339,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,339,23,2,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.02,9002313.0401,339,"DT") 3080103 "^DD",9002313.02,9002313.0401,340,0) OTHER PAYER ID^F^^0;4^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0401,340,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0401,340,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0401,340,21,1,0) ID assigned to the payer. NCPDP standard field 340-7C. "^DD",9002313.02,9002313.0401,340,23,0) ^.001^3^3^3101020^^^^ "^DD",9002313.02,9002313.0401,340,23,1,0) Qualified by Other Payer ID Qualifier (339-6C). "^DD",9002313.02,9002313.0401,340,23,2,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,340,23,3,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.02,9002313.0401,340,"DT") 3080103 "^DD",9002313.02,9002313.0401,341,0) OTHER PAYER AMOUNT PAID COUNT^F^^0;6^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.0401,341,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.0401,341,21,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0401,341,21,1,0) Count of the payer amount paid occurrences. NCPDP standard field 341-HB. "^DD",9002313.02,9002313.0401,341,23,0) ^.001^1^1^3101021^^^^ "^DD",9002313.02,9002313.0401,341,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,341,"DT") 3080103 "^DD",9002313.02,9002313.0401,342,0) OTHER PAYER AMT PAID MULTIPLE^9002313.401342A^^1;0 "^DD",9002313.02,9002313.0401,342,21,0) ^.001^1^1^3101021^^^^ "^DD",9002313.02,9002313.0401,342,21,1,0) This sub-file stores Other Paid Amount Qualifier values. "^DD",9002313.02,9002313.0401,342,23,0) ^.001^1^1^3101021^^^^ "^DD",9002313.02,9002313.0401,342,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,342,"DT") 3101014 "^DD",9002313.02,9002313.0401,353,0) OTHER PAYER-PAT RESP AMT COUNT^F^^0;8^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0401,353,.1) OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT COUNT "^DD",9002313.02,9002313.0401,353,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0401,353,21,0) ^.001^3^3^3101014^^^^ "^DD",9002313.02,9002313.0401,353,21,1,0) This is used to store NCPDP field 353-NR (Other Payer-Patient Responsibility Amount Count), "^DD",9002313.02,9002313.0401,353,21,2,0) which is defined as "Count of Other Payer-Patient Responsibility Amount (352-NQ) and "^DD",9002313.02,9002313.0401,353,21,3,0) Other Payer-Patient Responsibility Amount Qualifier (351-NP) occurrences." "^DD",9002313.02,9002313.0401,353,23,0) ^.001^1^1^3101014^^^ "^DD",9002313.02,9002313.0401,353,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,353,"DT") 3100901 "^DD",9002313.02,9002313.0401,353.01,0) OTHER PAYER-PATIENT RESP MLTPL^9002313.401353^^3;0 "^DD",9002313.02,9002313.0401,353.01,21,0) ^.001^1^1^3101021^^^^ "^DD",9002313.02,9002313.0401,353.01,21,1,0) This sub-file stores OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT values. "^DD",9002313.02,9002313.0401,392,0) BENEFIT STAGE COUNT^F^^0;9^K:$L(X)>3!($L(X)<1) X "^DD",9002313.02,9002313.0401,392,3) Answer must be 1-3 characters. "^DD",9002313.02,9002313.0401,392,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0401,392,21,1,0) This is used to store NCPDP field 392-MU (Benefit Stage Count), "^DD",9002313.02,9002313.0401,392,21,2,0) which is defined as "Count of Benefit Stage Amount (394-MW) occurrences." "^DD",9002313.02,9002313.0401,392,23,0) ^^2^2^3100901^ "^DD",9002313.02,9002313.0401,392,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT "^DD",9002313.02,9002313.0401,392,23,2,0) RESPONSE PRICING SEGMENT. "^DD",9002313.02,9002313.0401,392,"DT") 3100901 "^DD",9002313.02,9002313.0401,392.01,0) BENEFIT STAGE MLTPL^9002313.401392^^4;0 "^DD",9002313.02,9002313.0401,392.01,21,0) ^.001^1^1^3101021^^^ "^DD",9002313.02,9002313.0401,392.01,21,1,0) This sub-file stores BENEFIT STAGE values. "^DD",9002313.02,9002313.0401,443,0) OTHER PAYER DATE^FO^^0;5^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0401,443,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1($E(Y,3,10)) "^DD",9002313.02,9002313.0401,443,2.1) S Y=$$FM3EXT^BPSOSU1($E(Y,3,10)) "^DD",9002313.02,9002313.0401,443,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0401,443,21,0) ^^2^2^3080613^^ "^DD",9002313.02,9002313.0401,443,21,1,0) Payment or denial date of the claim submitted to the other payer. Used "^DD",9002313.02,9002313.0401,443,21,2,0) for coordination of benefits. "^DD",9002313.02,9002313.0401,443,23,0) ^.001^10^10^3101014^^ "^DD",9002313.02,9002313.0401,443,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0401,443,23,2,0) CC=Century "^DD",9002313.02,9002313.0401,443,23,3,0) YY=Year "^DD",9002313.02,9002313.0401,443,23,4,0) MM=Month "^DD",9002313.02,9002313.0401,443,23,5,0) DD=Day "^DD",9002313.02,9002313.0401,443,23,6,0) "^DD",9002313.02,9002313.0401,443,23,7,0) Examples: If the other payer denial date was August 1,1999, this field "^DD",9002313.02,9002313.0401,443,23,8,0) would reflect: 19990801. "^DD",9002313.02,9002313.0401,443,23,9,0) "^DD",9002313.02,9002313.0401,443,23,10,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,443,"DT") 3090309 "^DD",9002313.02,9002313.0401,471,0) OTHER PAYER REJECT COUNT^F^^0;7^K:$L(X)>2!($L(X)<2) X "^DD",9002313.02,9002313.0401,471,3) Answer must be 2 characters in length. "^DD",9002313.02,9002313.0401,471,21,0) ^^1^1^3031125^ "^DD",9002313.02,9002313.0401,471,21,1,0) Count of 'Other Payer Reject Code' (472) occurrences. "^DD",9002313.02,9002313.0401,471,"DT") 3080102 "^DD",9002313.02,9002313.0401,472,0) OTHER PAYER REJECT CODE MLTPL^9002313.401472A^^2;0 "^DD",9002313.02,9002313.0401,472,21,0) ^.001^1^1^3101020^^^ "^DD",9002313.02,9002313.0401,472,21,1,0) This sub-file is to store reject values received from other payers. "^DD",9002313.02,9002313.0401,472,"DT") 3101014 "^DD",9002313.02,9002313.0401,993,0) INTERNAL CONTROL NUMBER^F^^0;10^K:$L(X)>32!($L(X)<1) X "^DD",9002313.02,9002313.0401,993,3) Answer must be 1-32 characters. "^DD",9002313.02,9002313.0401,993,21,0) ^.001^3^3^3101014^^^ "^DD",9002313.02,9002313.0401,993,21,1,0) This is used to store NCPDP field 993-A7 (Internal Control Number), "^DD",9002313.02,9002313.0401,993,21,2,0) which is defined as "Number assigned by the processor to identify an adjudicated claim when "^DD",9002313.02,9002313.0401,993,21,3,0) supplied in payer-to-payer coordination of benefits only." "^DD",9002313.02,9002313.0401,993,23,0) ^.001^2^2^3101014^^ "^DD",9002313.02,9002313.0401,993,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.0401,993,23,2,0) RESPONSE STATUS SEGMENT. "^DD",9002313.02,9002313.0401,993,"DT") 3100901 "^DD",9002313.02,9002313.0501,0) COMPOUND REPEATING FIELDS SUB-FIELD^^362.01^8 "^DD",9002313.02,9002313.0501,0,"DT") 3100901 "^DD",9002313.02,9002313.0501,0,"IX","B",9002313.0501,.01) "^DD",9002313.02,9002313.0501,0,"NM","COMPOUND REPEATING FIELDS") "^DD",9002313.02,9002313.0501,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.0501,.01,0) COMPOUND REPEATING COUNT^F^^0;1^K:$L(X)>1!($L(X)<1) X "^DD",9002313.02,9002313.0501,.01,1,0) ^.1 "^DD",9002313.02,9002313.0501,.01,1,1,0) 9002313.0501^B "^DD",9002313.02,9002313.0501,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),447,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.0501,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),447,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.0501,.01,3) Answer must be 1 character in length. "^DD",9002313.02,9002313.0501,.01,21,0) ^^1^1^3031216^ "^DD",9002313.02,9002313.0501,.01,21,1,0) Count of Compounds for this medication. "^DD",9002313.02,9002313.0501,.01,"DT") 3080102 "^DD",9002313.02,9002313.0501,362,0) COMPND INGRED MDFR CODE COUNT^F^^0;7^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.0501,362,.1) COMPOUND INGREDIENT MODIFIER CODE COUNT "^DD",9002313.02,9002313.0501,362,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.0501,362,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.0501,362,21,1,0) This is used to store NCPDP field 362-2G (Compound Ingredient Modifier Code Count), "^DD",9002313.02,9002313.0501,362,21,2,0) which is defined as "Code indicating the number of Compound Ingredient Modifier Code (363-2H)" "^DD",9002313.02,9002313.0501,362,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.0501,362,23,1,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0501,362,"DT") 3100901 "^DD",9002313.02,9002313.0501,362.01,0) COMPND INGRED MDFR MLTPL^9002313.05011^^1;0 "^DD",9002313.02,9002313.0501,362.01,21,0) ^^1^1^3101021^ "^DD",9002313.02,9002313.0501,362.01,21,1,0) This sub-file stores Compound Ingredient Modifier values. "^DD",9002313.02,9002313.0501,448,0) COMPOUND INGREDIENT QUANTITY^F^^0;4^K:$L(X)>12!($L(X)<12) X "^DD",9002313.02,9002313.0501,448,3) Answer must be 12 characters in length "^DD",9002313.02,9002313.0501,448,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,448,21,1,0) Amount expressed in metric decimal units of the product included in the "^DD",9002313.02,9002313.0501,448,21,2,0) compound mixture. NCPDP standard field 448-ED. "^DD",9002313.02,9002313.0501,448,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,448,23,1,0) Format=9999999.999 "^DD",9002313.02,9002313.0501,448,23,2,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0501,448,"DT") 3080103 "^DD",9002313.02,9002313.0501,449,0) COMPOUND INGREDIENT DRUG COST^F^^0;5^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0501,449,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0501,449,21,0) ^^3^3^3080103^ "^DD",9002313.02,9002313.0501,449,21,1,0) Ingredient cost for the metric decimal quantity of the product included "^DD",9002313.02,9002313.0501,449,21,2,0) in the compound mixture indicated in Compound Ingredient Quantity "^DD",9002313.02,9002313.0501,449,21,3,0) (Field 448-ED). NCPDP standard field 449-EE. "^DD",9002313.02,9002313.0501,449,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,449,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0501,449,23,2,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0501,449,"DT") 3080103 "^DD",9002313.02,9002313.0501,488,0) COMPUND PRODUCT ID QUALIFIER^F^^0;2^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0501,488,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0501,488,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,488,21,1,0) Code qualifying the type of product dispensed. NCPDP standard field "^DD",9002313.02,9002313.0501,488,21,2,0) 488-RE. "^DD",9002313.02,9002313.0501,488,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,488,23,1,0) Qualifies Compound Product ID (489-TE). "^DD",9002313.02,9002313.0501,488,23,2,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0501,488,"DT") 3080103 "^DD",9002313.02,9002313.0501,489,0) COMPOUND PRODUCT ID^F^^0;3^K:$L(X)>21!($L(X)<21) X "^DD",9002313.02,9002313.0501,489,3) Answer must be 21 characters in length "^DD",9002313.02,9002313.0501,489,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,489,21,1,0) Product identification of an ingredient used in a compound. NCPDP "^DD",9002313.02,9002313.0501,489,21,2,0) standard field 489-TE. "^DD",9002313.02,9002313.0501,489,23,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,489,23,1,0) Qualified by Compound Product ID Qualifier (488-RE). "^DD",9002313.02,9002313.0501,489,23,2,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0501,489,"DT") 3080103 "^DD",9002313.02,9002313.0501,490,0) COMPOUND INGREDIENT COST BASIS^F^^0;6^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0501,490,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0501,490,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.0501,490,21,1,0) Code indicating the method by which the drug cost of an ingredient used "^DD",9002313.02,9002313.0501,490,21,2,0) in a compound was calculated. NCPDP standard field 490-UE. "^DD",9002313.02,9002313.0501,490,23,0) ^^1^1^3080103^ "^DD",9002313.02,9002313.0501,490,23,1,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.0501,490,"DT") 3080103 "^DD",9002313.02,9002313.05011,0) COMPND INGRED MDFR MLTPL SUB-FIELD^^363^2 "^DD",9002313.02,9002313.05011,0,"DT") 3100901 "^DD",9002313.02,9002313.05011,0,"IX","B",9002313.05011,.01) "^DD",9002313.02,9002313.05011,0,"NM","COMPND INGRED MDFR MLTPL") "^DD",9002313.02,9002313.05011,0,"UP") 9002313.0501 "^DD",9002313.02,9002313.05011,.01,0) COMPND INGRED MDFR COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.02,9002313.05011,.01,1,0) ^.1 "^DD",9002313.02,9002313.05011,.01,1,1,0) 9002313.05011^B "^DD",9002313.02,9002313.05011,.01,1,1,1) S ^BPSC(DA(3),400,DA(2),447,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.05011,.01,1,1,2) K ^BPSC(DA(3),400,DA(2),447,DA(1),1,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.05011,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.02,9002313.05011,.01,21,0) ^^1^1^3101021^ "^DD",9002313.02,9002313.05011,.01,21,1,0) This is a sequential counter of Compound Ingredient Modifier entries. "^DD",9002313.02,9002313.05011,.01,"DT") 3100901 "^DD",9002313.02,9002313.05011,363,0) COMPOUND INGRED MODIFIER CODE^F^^0;2^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.05011,363,.1) COMPOUND INGREDIENT MODIFIER CODE "^DD",9002313.02,9002313.05011,363,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.05011,363,21,0) ^.001^3^3^3100901^^ "^DD",9002313.02,9002313.05011,363,21,1,0) This is used to store NCPDP field 363-2H (Compound Ingredient Modifier Code), "^DD",9002313.02,9002313.05011,363,21,2,0) which is defined as "Identifies special circumstances related to the dispensing/payment "^DD",9002313.02,9002313.05011,363,21,3,0) of the product as identified in the Compound Product ID (498-TE)." "^DD",9002313.02,9002313.05011,363,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.05011,363,23,1,0) REQUEST COMPOUND SEGMENT. "^DD",9002313.02,9002313.05011,363,"DT") 3100901 "^DD",9002313.02,9002313.0601,0) OTHER AMT CLAIMED MULTIPLE SUB-FIELD^^480^3 "^DD",9002313.02,9002313.0601,0,"DT") 3101006 "^DD",9002313.02,9002313.0601,0,"IX","B",9002313.0601,.01) "^DD",9002313.02,9002313.0601,0,"NM","OTHER AMT CLAIMED MULTIPLE") "^DD",9002313.02,9002313.0601,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.0601,.01,0) OTHER AMT CLAIMED COUNTER^F^^0;1^K:$L(X)>2!($L(X)<1) X "^DD",9002313.02,9002313.0601,.01,1,0) ^.1 "^DD",9002313.02,9002313.0601,.01,1,1,0) 9002313.0601^B "^DD",9002313.02,9002313.0601,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),478.01,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.0601,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),478.01,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.0601,.01,3) Answer must be 1-2 characters. "^DD",9002313.02,9002313.0601,.01,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0601,.01,21,1,0) This is the number of other claimed amount entries in the sub-file. "^DD",9002313.02,9002313.0601,.01,21,2,0) It is used for coordination of benefits. "^DD",9002313.02,9002313.0601,.01,23,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.0601,.01,23,1,0) Sequential counter of Other Amount Claimed occurrences. "^DD",9002313.02,9002313.0601,.01,"DT") 3101013 "^DD",9002313.02,9002313.0601,479,0) OTHER AMT CLAIMED SUBMTTD QLFR^F^^0;2^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0601,479,.1) OTHER AMOUNT CLAIMED SUBMITTED QUALIFIER "^DD",9002313.02,9002313.0601,479,3) Answer must be 4 characters in length. "^DD",9002313.02,9002313.0601,479,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0601,479,21,1,0) This is the code identifying the additional incurred cost claimed in Other Amount Claimed Submitted (480-H9). "^DD",9002313.02,9002313.0601,479,21,2,0) It is NCPDP field 479-H8. "^DD",9002313.02,9002313.0601,479,23,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.0601,479,23,1,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0601,479,"DT") 3101006 "^DD",9002313.02,9002313.0601,480,0) OTHER AMOUNT CLAIMED SUBMITTED^F^^0;3^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0601,480,3) Answer must be 10 characters in length. "^DD",9002313.02,9002313.0601,480,21,0) ^.001^2^2^3101020^^^^ "^DD",9002313.02,9002313.0601,480,21,1,0) This is the amount representing the additional incurred costs for a dispensed prescription or service. "^DD",9002313.02,9002313.0601,480,21,2,0) It is NCPDP field 480-H9. "^DD",9002313.02,9002313.0601,480,23,0) ^.001^8^8^3101020^^^^ "^DD",9002313.02,9002313.0601,480,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.0601,480,23,2,0) "^DD",9002313.02,9002313.0601,480,23,3,0) Qualified by Other Amount Claimed Submitted Qualifier (479-H8). "^DD",9002313.02,9002313.0601,480,23,4,0) "^DD",9002313.02,9002313.0601,480,23,5,0) Examples: If the other amount claimed submitted is $12.55, this field "^DD",9002313.02,9002313.0601,480,23,6,0) would reflect: 125E. "^DD",9002313.02,9002313.0601,480,23,7,0) "^DD",9002313.02,9002313.0601,480,23,8,0) REQUEST PRICING SEGMENT. "^DD",9002313.02,9002313.0601,480,"DT") 3101006 "^DD",9002313.02,9002313.0701,0) CLINICAL DIAGNOSIS SUB-FIELD^^492^3 "^DD",9002313.02,9002313.0701,0,"DT") 3080104 "^DD",9002313.02,9002313.0701,0,"IX","B",9002313.0701,.01) "^DD",9002313.02,9002313.0701,0,"NM","CLINICAL DIAGNOSIS") "^DD",9002313.02,9002313.0701,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.0701,.01,0) DIAGNOSIS COUNTER^F^^0;1^K:$L(X)>1!($L(X)<1) X "^DD",9002313.02,9002313.0701,.01,1,0) ^.1 "^DD",9002313.02,9002313.0701,.01,1,1,0) 9002313.0701^B "^DD",9002313.02,9002313.0701,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),491.01,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.0701,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),491.01,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.0701,.01,3) Answer must be 1 character in length. "^DD",9002313.02,9002313.0701,.01,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0701,.01,21,1,0) The number of diagnosis codes defined for this medication order. "^DD",9002313.02,9002313.0701,.01,"DT") 3080104 "^DD",9002313.02,9002313.0701,424,0) DIAGNOSIS CODE^F^^0;3^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0701,424,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0701,424,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0701,424,21,1,0) Code identifying the diagnosis of the patient. NCPDP standard field "^DD",9002313.02,9002313.0701,424,21,2,0) 424-DO. "^DD",9002313.02,9002313.0701,424,23,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.0701,424,23,1,0) Qualified by a Diagnosis Code Qualifier (492-WE). The format must "^DD",9002313.02,9002313.0701,424,23,2,0) adhere to the owner's code set rules and formats. "^DD",9002313.02,9002313.0701,424,23,3,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0701,424,"DT") 3080104 "^DD",9002313.02,9002313.0701,492,0) DIAGNOSIS CODE QUALIFIER^F^^0;2^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0701,492,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0701,492,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0701,492,21,1,0) Code qualifying the Diagnosis Code (424-DO). NCPDP standard field 492-WE. "^DD",9002313.02,9002313.0701,492,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0701,492,23,1,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0701,492,"DT") 3080104 "^DD",9002313.02,9002313.0801,0) CLINICAL INFORMATION SUB-FIELD^^499^6 "^DD",9002313.02,9002313.0801,0,"DT") 3080104 "^DD",9002313.02,9002313.0801,0,"IX","B",9002313.0801,.01) "^DD",9002313.02,9002313.0801,0,"NM","CLINICAL INFORMATION") "^DD",9002313.02,9002313.0801,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.0801,.01,0) CLINICAL INFORMATION COUNT^F^^0;1^K:$L(X)>1!($L(X)<1) X "^DD",9002313.02,9002313.0801,.01,1,0) ^.1 "^DD",9002313.02,9002313.0801,.01,1,1,0) 9002313.0801^B "^DD",9002313.02,9002313.0801,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),493.01,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.0801,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),493.01,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.0801,.01,3) Answer must be 1 character in length. "^DD",9002313.02,9002313.0801,.01,21,0) ^^1^1^3040126^ "^DD",9002313.02,9002313.0801,.01,21,1,0) The number of clinical indicator records for the medication order. "^DD",9002313.02,9002313.0801,.01,"DT") 3080104 "^DD",9002313.02,9002313.0801,494,0) MEASUREMENT DATE^F^^0;2^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.0801,494,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.0801,494,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0801,494,21,1,0) Date clinical information was collected or measured. NCPDP standard "^DD",9002313.02,9002313.0801,494,21,2,0) field 494-ZE. "^DD",9002313.02,9002313.0801,494,23,0) ^^8^8^3080104^ "^DD",9002313.02,9002313.0801,494,23,1,0) Format=CCYYMMDD "^DD",9002313.02,9002313.0801,494,23,2,0) "^DD",9002313.02,9002313.0801,494,23,3,0) CC=Century "^DD",9002313.02,9002313.0801,494,23,4,0) YY=Year "^DD",9002313.02,9002313.0801,494,23,5,0) MM=Month "^DD",9002313.02,9002313.0801,494,23,6,0) DD=Day "^DD",9002313.02,9002313.0801,494,23,7,0) "^DD",9002313.02,9002313.0801,494,23,8,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0801,494,"DT") 3080104 "^DD",9002313.02,9002313.0801,495,0) MEASUREMENT TIME^F^^0;3^K:$L(X)>6!($L(X)<6) X "^DD",9002313.02,9002313.0801,495,3) Answer must be 6 characters in length "^DD",9002313.02,9002313.0801,495,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0801,495,21,1,0) Time clinical information was collected or measured. NCPDP standard "^DD",9002313.02,9002313.0801,495,21,2,0) field 495-H1. "^DD",9002313.02,9002313.0801,495,23,0) ^^8^8^3080104^ "^DD",9002313.02,9002313.0801,495,23,1,0) Format: HHMM "^DD",9002313.02,9002313.0801,495,23,2,0) "^DD",9002313.02,9002313.0801,495,23,3,0) HH=Hour "^DD",9002313.02,9002313.0801,495,23,4,0) MM=Minute "^DD",9002313.02,9002313.0801,495,23,5,0) "^DD",9002313.02,9002313.0801,495,23,6,0) Examples: Reported in military time. Two o'clock P.M.=1400. "^DD",9002313.02,9002313.0801,495,23,7,0) "^DD",9002313.02,9002313.0801,495,23,8,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0801,495,"DT") 3080104 "^DD",9002313.02,9002313.0801,496,0) MEASUREMENT DIMENSION^F^^0;4^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0801,496,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0801,496,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0801,496,21,1,0) Code indicating the clinical domain of the observed value in Measurement "^DD",9002313.02,9002313.0801,496,21,2,0) Value (499-H4). NCPDP standard field 496-H2. "^DD",9002313.02,9002313.0801,496,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0801,496,23,1,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0801,496,"DT") 3080104 "^DD",9002313.02,9002313.0801,497,0) MEASUREMENT UNIT^F^^0;5^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.0801,497,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.0801,497,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.0801,497,21,1,0) Code indicating the metric or English units used with the clinical "^DD",9002313.02,9002313.0801,497,21,2,0) information. NCPDP standard field 497-H3. "^DD",9002313.02,9002313.0801,497,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0801,497,23,1,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0801,497,"DT") 3080104 "^DD",9002313.02,9002313.0801,499,0) MEASUREMENT VALUE^F^^0;6^K:$L(X)>17!($L(X)<17) X "^DD",9002313.02,9002313.0801,499,3) Answer must be 17 characters in length "^DD",9002313.02,9002313.0801,499,21,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.0801,499,21,1,0) Actual value of clinical information. NCPDP standard field 499-H4. "^DD",9002313.02,9002313.0801,499,23,0) ^^4^4^3080104^ "^DD",9002313.02,9002313.0801,499,23,1,0) Blood pressure entered in XXX/YYY format in which XXX=systolic, "^DD",9002313.02,9002313.0801,499,23,2,0) /=divider, and YYY is diastolic. Temperature entered in XXX.X format "^DD",9002313.02,9002313.0801,499,23,3,0) always including decimal point. "^DD",9002313.02,9002313.0801,499,23,4,0) REQUEST CLINICAL SEGMENT. "^DD",9002313.02,9002313.0801,499,"DT") 3080104 "^DD",9002313.02,9002313.0901,0) PRIOR AUTH SUPPORTING DOCUMNTN SUB-FIELD^^.01^1 "^DD",9002313.02,9002313.0901,0,"DT") 3020801 "^DD",9002313.02,9002313.0901,0,"NM","PRIOR AUTH SUPPORTING DOCUMNTN") "^DD",9002313.02,9002313.0901,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.0901,.01,0) PRIOR AUTH SUPPORTING DOCUMNTN^WL^^0;1^Q "^DD",9002313.02,9002313.0901,.01,.1) PRIOR AUTHORIZATION SUPPORTING DOCUMENTATION "^DD",9002313.02,9002313.0901,.01,3) Enter free text any prior authorization supporting information. "^DD",9002313.02,9002313.0901,.01,21,0) ^^1^1^3101004^ "^DD",9002313.02,9002313.0901,.01,21,1,0) This is used to store NCPDP field 498-PP (Prior Authorization Supporting Documentation). "^DD",9002313.02,9002313.0901,.01,23,0) ^.001^4^4^3101004^^ "^DD",9002313.02,9002313.0901,.01,23,1,0) Could be used, if applicable, to supply information not already included "^DD",9002313.02,9002313.0901,.01,23,2,0) in NCPDP data fields that may be required to process a prior "^DD",9002313.02,9002313.0901,.01,23,3,0) authorization transaction. "^DD",9002313.02,9002313.0901,.01,23,4,0) REQUEST PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.02,9002313.0901,.01,"DT") 3101004 "^DD",9002313.02,9002313.1001,0) DUR PPS REPEATING FIELDS SUB-FIELD^^476^7 "^DD",9002313.02,9002313.1001,0,"DT") 3080102 "^DD",9002313.02,9002313.1001,0,"IX","B",9002313.1001,.01) "^DD",9002313.02,9002313.1001,0,"NM","DUR PPS REPEATING FIELDS") "^DD",9002313.02,9002313.1001,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.1001,.01,0) DUR PPS CODE COUNT^F^^0;1^K:$L(X)>3!($L(X)<3) X "^DD",9002313.02,9002313.1001,.01,1,0) ^.1 "^DD",9002313.02,9002313.1001,.01,1,1,0) 9002313.1001^B "^DD",9002313.02,9002313.1001,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),473.01,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.1001,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),473.01,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.1001,.01,3) Answer must be 3 characters in length "^DD",9002313.02,9002313.1001,.01,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,.01,21,1,0) The number of DUR messages that were returned in the response message. "^DD",9002313.02,9002313.1001,.01,21,2,0) NCPDP standard field 473-7E. "^DD",9002313.02,9002313.1001,.01,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.1001,.01,23,1,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,.01,"DT") 3080104 "^DD",9002313.02,9002313.1001,439,0) REASON FOR SERVICE CODE^F^^0;2^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.1001,439,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.1001,439,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,439,21,1,0) Code identifying the type of utilization conflict detected or the reason "^DD",9002313.02,9002313.1001,439,21,2,0) for the pharmacist's professional service. NCPDP standard field 439-E4. "^DD",9002313.02,9002313.1001,439,23,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,439,23,1,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,439,23,2,0) RESPONSE DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,439,"DT") 3080104 "^DD",9002313.02,9002313.1001,440,0) PROFESSIONAL SERVICE CODE^F^^0;3^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.1001,440,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.1001,440,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,440,21,1,0) Code identifying the type of utilization conflict detected or the reason "^DD",9002313.02,9002313.1001,440,21,2,0) for the pharmacist's professional service. NCPDP standard field 440-E5. "^DD",9002313.02,9002313.1001,440,23,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.1001,440,23,1,0) If the pharmacist spoke with the patient as a result of a conflict code "^DD",9002313.02,9002313.1001,440,23,2,0) being transmitted on a prescription, the field would reflect P0. "^DD",9002313.02,9002313.1001,440,23,3,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,440,"DT") 3080104 "^DD",9002313.02,9002313.1001,441,0) RESULT OF SERVICE CODE^F^^0;4^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.1001,441,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.1001,441,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,441,21,1,0) Action taken by a pharmacist in response to a conflict or the result of a "^DD",9002313.02,9002313.1001,441,21,2,0) pharmacist's professional service. NCPDP standard field 441-E6. "^DD",9002313.02,9002313.1001,441,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.1001,441,23,1,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,441,"DT") 3080104 "^DD",9002313.02,9002313.1001,474,0) DUR PPS LEVEL OF EFFORT^F^^0;5^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.1001,474,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.1001,474,21,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.1001,474,21,1,0) Code indicating the level of effort as determined by the complexity of "^DD",9002313.02,9002313.1001,474,21,2,0) decision making or resources utilized by a pharmacist to perform a "^DD",9002313.02,9002313.1001,474,21,3,0) professional service. NCPDP standard field 474-8E. "^DD",9002313.02,9002313.1001,474,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.1001,474,23,1,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,474,"DT") 3080104 "^DD",9002313.02,9002313.1001,475,0) DUR COAGENT ID QUALIFIER^F^^0;6^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.1001,475,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.1001,475,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,475,21,1,0) Code qualifying the value in DUR Co-Agent ID (476-H6). NCPDP standard "^DD",9002313.02,9002313.1001,475,21,2,0) field 475-J9. "^DD",9002313.02,9002313.1001,475,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.1001,475,23,1,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,475,"DT") 3080104 "^DD",9002313.02,9002313.1001,476,0) DUR COAGENT ID^F^^0;7^K:$L(X)>21!($L(X)<21) X "^DD",9002313.02,9002313.1001,476,3) Answer must be 21 characters in length "^DD",9002313.02,9002313.1001,476,21,0) ^^3^3^3080104^ "^DD",9002313.02,9002313.1001,476,21,1,0) Identifies the co-existing agent contributing to the DUR event (drug or "^DD",9002313.02,9002313.1001,476,21,2,0) disease conflicting with the prescribed drug or prompting pharmacist "^DD",9002313.02,9002313.1001,476,21,3,0) professional service). NCPDP standard field 476-H6. "^DD",9002313.02,9002313.1001,476,23,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.1001,476,23,1,0) Qualified by DUR Co-Agent ID Qualifier (475-J9). "^DD",9002313.02,9002313.1001,476,23,2,0) REQUEST DUR/PPS SEGMENT. "^DD",9002313.02,9002313.1001,476,"DT") 3080104 "^DD",9002313.02,9002313.201459,0) PROCEDURE MODIFIER CODE SUB-FIELD^^.01^1 "^DD",9002313.02,9002313.201459,0,"DT") 3080104 "^DD",9002313.02,9002313.201459,0,"IX","B",9002313.201459,.01) "^DD",9002313.02,9002313.201459,0,"NM","PROCEDURE MODIFIER CODE") "^DD",9002313.02,9002313.201459,0,"UP") 9002313.0201 "^DD",9002313.02,9002313.201459,.01,0) PROCEDURE MODIFIER CODE^F^^0;1^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.201459,.01,1,0) ^.1 "^DD",9002313.02,9002313.201459,.01,1,1,0) 9002313.201459^B "^DD",9002313.02,9002313.201459,.01,1,1,1) S ^BPSC(DA(2),400,DA(1),459,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.201459,.01,1,1,2) K ^BPSC(DA(2),400,DA(1),459,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.201459,.01,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.201459,.01,21,0) ^^2^2^3080104^ "^DD",9002313.02,9002313.201459,.01,21,1,0) Identifies special circumstances related to the performance of the "^DD",9002313.02,9002313.201459,.01,21,2,0) service. NCPDP standard field 459-ER. "^DD",9002313.02,9002313.201459,.01,23,0) ^^1^1^3080104^ "^DD",9002313.02,9002313.201459,.01,23,1,0) REQUEST CLAIM SEGMENT. "^DD",9002313.02,9002313.201459,.01,"DT") 3080104 "^DD",9002313.02,9002313.29999,0) RAW DATA SENT SUB-FIELD^^.01^1 "^DD",9002313.02,9002313.29999,0,"DT") 3000830 "^DD",9002313.02,9002313.29999,0,"NM","RAW DATA SENT") "^DD",9002313.02,9002313.29999,0,"UP") 9002313.02 "^DD",9002313.02,9002313.29999,.01,0) RAW DATA SENT^WL^^0;1^Q "^DD",9002313.02,9002313.29999,.01,21,0) ^^4^4^3031124^^ "^DD",9002313.02,9002313.29999,.01,21,1,0) A copy of the raw packet is saved here. "^DD",9002313.02,9002313.29999,.01,21,2,0) It's intended to be of help in times of dispute. "^DD",9002313.02,9002313.29999,.01,21,3,0) This field could be winnowed before the rest of the 9002313.02 is winnowed. "^DD",9002313.02,9002313.29999,.01,21,4,0) For instance, it might make sense to only keep a month of these around. "^DD",9002313.02,9002313.29999,.01,"DT") 3031124 "^DD",9002313.02,9002313.401342,0) OTHER PAYER AMT PAID MULTIPLE SUB-FIELD^^431^2 "^DD",9002313.02,9002313.401342,0,"DT") 3080103 "^DD",9002313.02,9002313.401342,0,"IX","B",9002313.401342,.01) "^DD",9002313.02,9002313.401342,0,"NM","OTHER PAYER AMT PAID MULTIPLE") "^DD",9002313.02,9002313.401342,0,"UP") 9002313.0401 "^DD",9002313.02,9002313.401342,.01,0) OTHER PAYER AMT PAID QUALIFIER^F^^0;1^K:$L(X)>4!($L(X)<4) X "^DD",9002313.02,9002313.401342,.01,1,0) ^.1 "^DD",9002313.02,9002313.401342,.01,1,1,0) 9002313.401342^B "^DD",9002313.02,9002313.401342,.01,1,1,1) S ^BPSC(DA(3),400,DA(2),337,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.401342,.01,1,1,2) K ^BPSC(DA(3),400,DA(2),337,DA(1),1,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.401342,.01,3) Answer must be 4 characters in length "^DD",9002313.02,9002313.401342,.01,21,0) ^^2^2^3080604^ "^DD",9002313.02,9002313.401342,.01,21,1,0) Code qualifying the Other Payer Amount Paid (431-DV). NCPDP standard "^DD",9002313.02,9002313.401342,.01,21,2,0) field 342-HC. "^DD",9002313.02,9002313.401342,.01,23,0) ^^1^1^3080604^^ "^DD",9002313.02,9002313.401342,.01,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401342,.01,"DT") 3080604 "^DD",9002313.02,9002313.401342,431,0) OTHER PAYER AMOUNT PAID^F^^0;2^K:$L(X)>10!($L(X)<10) X "^DD",9002313.02,9002313.401342,431,3) Answer must be 10 characters in length "^DD",9002313.02,9002313.401342,431,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.401342,431,21,1,0) Amount of any payment known by the pharmacy from other sources (including "^DD",9002313.02,9002313.401342,431,21,2,0) coupons). NCPDP standard field 431-DV. "^DD",9002313.02,9002313.401342,431,23,0) ^.001^6^6^3101020^^^^ "^DD",9002313.02,9002313.401342,431,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.401342,431,23,2,0) "^DD",9002313.02,9002313.401342,431,23,3,0) Examples: If the other payer amount paid is $32.56, this field would "^DD",9002313.02,9002313.401342,431,23,4,0) reflect: 325F. "^DD",9002313.02,9002313.401342,431,23,5,0) "^DD",9002313.02,9002313.401342,431,23,6,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401342,431,"DT") 3080103 "^DD",9002313.02,9002313.401353,0) OTHER PAYER-PATIENT RESP MLTPL SUB-FIELD^^352^3 "^DD",9002313.02,9002313.401353,0,"DT") 3100901 "^DD",9002313.02,9002313.401353,0,"IX","B",9002313.401353,.01) "^DD",9002313.02,9002313.401353,0,"NM","OTHER PAYER-PATIENT RESP MLTPL") "^DD",9002313.02,9002313.401353,0,"UP") 9002313.0401 "^DD",9002313.02,9002313.401353,.01,0) OTHER PAYER-PATIENT COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.02,9002313.401353,.01,1,0) ^.1 "^DD",9002313.02,9002313.401353,.01,1,1,0) 9002313.401353^B "^DD",9002313.02,9002313.401353,.01,1,1,1) S ^BPSC(DA(3),400,DA(2),337,DA(1),3,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.401353,.01,1,1,2) K ^BPSC(DA(3),400,DA(2),337,DA(1),3,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.401353,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.02,9002313.401353,.01,21,0) ^.001^1^1^3101020^^ "^DD",9002313.02,9002313.401353,.01,21,1,0) This is an integer counter incremented by software. "^DD",9002313.02,9002313.401353,.01,"DT") 3100901 "^DD",9002313.02,9002313.401353,351,0) OTHER PAYER-PT RESP AMT QUALFR^F^^0;2^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.401353,351,.1) OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT QUALIFIER "^DD",9002313.02,9002313.401353,351,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.401353,351,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.401353,351,21,1,0) This is used to store NCPDP field 351-NP (Other Payer-Patient Responsibility Amount Qualifier), "^DD",9002313.02,9002313.401353,351,21,2,0) which is defined as "Code qualifying the Other Payer-Patient Responsibility Amount (352-NQ)." "^DD",9002313.02,9002313.401353,351,23,0) ^^3^3^3100901^ "^DD",9002313.02,9002313.401353,351,23,1,0) Comments: This field is submitted by the pharmacist for the purpose of qualifying "^DD",9002313.02,9002313.401353,351,23,2,0) the entry in the Other Payer-Patient Responsibility Amount field. "^DD",9002313.02,9002313.401353,351,23,3,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401353,351,"DT") 3100901 "^DD",9002313.02,9002313.401353,352,0) OTHER PAYER-PATIENT RESP AMT^F^^0;3^K:$L(X)>12!($L(X)<1) X "^DD",9002313.02,9002313.401353,352,.1) OTHER PAYER-PATIENT RESPONSIBILITY AMOUNT "^DD",9002313.02,9002313.401353,352,3) Answer must be 1-12 characters. "^DD",9002313.02,9002313.401353,352,21,0) ^.001^2^2^3100901^^ "^DD",9002313.02,9002313.401353,352,21,1,0) This is used to store NCPDP field 352-NQ (Other Payer-Patient Responsibility Amount), "^DD",9002313.02,9002313.401353,352,21,2,0) which is defined as "The patient's cost share from a previous payer." "^DD",9002313.02,9002313.401353,352,23,0) ^^1^1^3100901^ "^DD",9002313.02,9002313.401353,352,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401353,352,"DT") 3100901 "^DD",9002313.02,9002313.401392,0) BENEFIT STAGE MLTPL SUB-FIELD^^394^3 "^DD",9002313.02,9002313.401392,0,"DT") 3100901 "^DD",9002313.02,9002313.401392,0,"IX","B",9002313.401392,.01) "^DD",9002313.02,9002313.401392,0,"NM","BENEFIT STAGE MLTPL") "^DD",9002313.02,9002313.401392,0,"UP") 9002313.0401 "^DD",9002313.02,9002313.401392,.01,0) BENEFIT STAGE COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.02,9002313.401392,.01,1,0) ^.1 "^DD",9002313.02,9002313.401392,.01,1,1,0) 9002313.401392^B "^DD",9002313.02,9002313.401392,.01,1,1,1) S ^BPSC(DA(3),400,DA(2),337,DA(1),4,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.401392,.01,1,1,2) K ^BPSC(DA(3),400,DA(2),337,DA(1),4,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.401392,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.02,9002313.401392,.01,21,0) ^^1^1^3101021^ "^DD",9002313.02,9002313.401392,.01,21,1,0) This is a sequential counter incremented by software. "^DD",9002313.02,9002313.401392,.01,"DT") 3100901 "^DD",9002313.02,9002313.401392,393,0) BENEFIT STAGE QUALIFIER^F^^0;2^K:$L(X)>4!($L(X)<1) X "^DD",9002313.02,9002313.401392,393,3) Answer must be 1-4 characters. "^DD",9002313.02,9002313.401392,393,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.02,9002313.401392,393,21,1,0) This is used to store NCPDP field 393-MV (Benefit Stage Qualifier), "^DD",9002313.02,9002313.401392,393,21,2,0) which is defined as "Code qualifying the Benefit Stage Amount (394-MW)." "^DD",9002313.02,9002313.401392,393,23,0) ^.001^2^2^3101014^^ "^DD",9002313.02,9002313.401392,393,23,1,0) Comments: Qualifies Benefit Stage Amount (392-MW). "^DD",9002313.02,9002313.401392,393,23,2,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401392,393,"DT") 3100901 "^DD",9002313.02,9002313.401392,394,0) BENEFIT STAGE AMOUNT^F^^0;3^K:$L(X)>10!($L(X)<1) X "^DD",9002313.02,9002313.401392,394,3) Answer must be 1-10 characters. "^DD",9002313.02,9002313.401392,394,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.02,9002313.401392,394,21,1,0) This is used to store NCPDP field 394-MW (Benefit Stage Amount), "^DD",9002313.02,9002313.401392,394,21,2,0) which is defined as "The amount of claim allocated to the Medicare stage identified by the Benefit Stage Qualifier (393-MV)." "^DD",9002313.02,9002313.401392,394,23,0) ^.001^3^3^3101014^^ "^DD",9002313.02,9002313.401392,394,23,1,0) Format=s$$$$$$cc "^DD",9002313.02,9002313.401392,394,23,2,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401392,394,23,3,0) RESPONSE PRICING SEGMENT. "^DD",9002313.02,9002313.401392,394,"DT") 3100901 "^DD",9002313.02,9002313.401472,0) OTHER PAYER REJECT CODE MLTPL SUB-FIELD^^.01^1 "^DD",9002313.02,9002313.401472,0,"DT") 3080103 "^DD",9002313.02,9002313.401472,0,"IX","B",9002313.401472,.01) "^DD",9002313.02,9002313.401472,0,"NM","OTHER PAYER REJECT CODE MLTPL") "^DD",9002313.02,9002313.401472,0,"UP") 9002313.0401 "^DD",9002313.02,9002313.401472,.01,0) OTHER PAYER REJECT CODE^F^^0;1^K:$L(X)>5!($L(X)<5) X "^DD",9002313.02,9002313.401472,.01,1,0) ^.1 "^DD",9002313.02,9002313.401472,.01,1,1,0) 9002313.401472^B "^DD",9002313.02,9002313.401472,.01,1,1,1) S ^BPSC(DA(3),400,DA(2),337,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",9002313.02,9002313.401472,.01,1,1,2) K ^BPSC(DA(3),400,DA(2),337,DA(1),2,"B",$E(X,1,30),DA) "^DD",9002313.02,9002313.401472,.01,3) Answer must be 5 characters in length "^DD",9002313.02,9002313.401472,.01,21,0) ^^2^2^3080103^ "^DD",9002313.02,9002313.401472,.01,21,1,0) The error encountered by the previous "Other Payer" in Reject Code "^DD",9002313.02,9002313.401472,.01,21,2,0) (511-FB). NCPDP standard field 472-6E. "^DD",9002313.02,9002313.401472,.01,23,0) ^.001^1^1^3101020^^^^ "^DD",9002313.02,9002313.401472,.01,23,1,0) REQUEST COORDINATION OF BENEFITS/OTHER PAYMENT SEGMENT. "^DD",9002313.02,9002313.401472,.01,"DT") 3080103 "^DD",9002313.03,9002313.03,0) FIELD^^311^23 "^DD",9002313.03,9002313.03,0,"DDA") N "^DD",9002313.03,9002313.03,0,"DT") 3101027 "^DD",9002313.03,9002313.03,0,"IX","AC",9002313.0301,501) "^DD",9002313.03,9002313.03,0,"IX","AE",9002313.03,.02) "^DD",9002313.03,9002313.03,0,"IX","B",9002313.03,.01) "^DD",9002313.03,9002313.03,0,"NM","BPS RESPONSES") "^DD",9002313.03,9002313.03,0,"PT",355.33,.17) "^DD",9002313.03,9002313.03,0,"PT",9002313.57,4) "^DD",9002313.03,9002313.03,0,"PT",9002313.57,402) "^DD",9002313.03,9002313.03,0,"PT",9002313.59,4) "^DD",9002313.03,9002313.03,0,"PT",9002313.59,402) "^DD",9002313.03,9002313.03,0,"VRPK") BPS "^DD",9002313.03,9002313.03,.01,0) BPS CLAIM^RP9002313.02'^BPSC(^0;1^Q "^DD",9002313.03,9002313.03,.01,1,0) ^.1 "^DD",9002313.03,9002313.03,.01,1,1,0) 9002313.03^B "^DD",9002313.03,9002313.03,.01,1,1,1) S ^BPSR("B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.03,.01,1,1,2) K ^BPSR("B",$E(X,1,30),DA) "^DD",9002313.03,9002313.03,.01,3) Select the BPS Claim. "^DD",9002313.03,9002313.03,.01,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,.01,21,1,0) Identifier for BPS responses. "^DD",9002313.03,9002313.03,.01,"DT") 3080207 "^DD",9002313.03,9002313.03,.02,0) DATE RESPONSE RECEIVED^D^^0;2^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",9002313.03,9002313.03,.02,1,0) ^.1 "^DD",9002313.03,9002313.03,.02,1,1,0) 9002313.03^AE "^DD",9002313.03,9002313.03,.02,1,1,1) S ^BPSR("AE",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.03,.02,1,1,2) K ^BPSR("AE",$E(X,1,30),DA) "^DD",9002313.03,9002313.03,.02,1,1,"DT") 2950724 "^DD",9002313.03,9002313.03,.02,3) Enter the date the Response was received. "^DD",9002313.03,9002313.03,.02,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,.02,21,1,0) Date that response was received on the system. "^DD",9002313.03,9002313.03,.02,"DT") 3080207 "^DD",9002313.03,9002313.03,102,0) VERSION RELEASE NUMBER^F^^100;2^K:$L(X)>2!($L(X)<2) X "^DD",9002313.03,9002313.03,102,3) Answer must be 2 characters in length. "^DD",9002313.03,9002313.03,102,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,102,21,1,0) NCPDP Version/Release Number. "^DD",9002313.03,9002313.03,102,"DT") 3080207 "^DD",9002313.03,9002313.03,103,0) TRANSACTION CODE^F^^100;3^K:$L(X)>2!($L(X)<2) X "^DD",9002313.03,9002313.03,103,3) Answer must be 2 characters in length. "^DD",9002313.03,9002313.03,103,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,103,21,1,0) Code identifying the type of transaction. "^DD",9002313.03,9002313.03,103,"DT") 3080207 "^DD",9002313.03,9002313.03,109,0) TRANSACTION COUNT^NJ1,0^^100;9^K:+X'=X!(X>4)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.03,109,3) Type a number between 1 and 4, 0 Decimal Digits "^DD",9002313.03,9002313.03,109,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.03,109,21,1,0) Count of transactions in the transmission. "^DD",9002313.03,9002313.03,109,"DT") 3080618 "^DD",9002313.03,9002313.03,115,0) MEDICAID ID INDICATOR^F^^100;15^K:$L(X)>22!($L(X)<1) X "^DD",9002313.03,9002313.03,115,3) Answer must be 1-22 characters. "^DD",9002313.03,9002313.03,115,21,0) ^.001^2^2^3100929^^^^ "^DD",9002313.03,9002313.03,115,21,1,0) This is used to store NCPDP field 115-N5 (Medicaid ID Number), "^DD",9002313.03,9002313.03,115,21,2,0) which is defined as "A unique member identification number assigned by the Medicaid Agency." "^DD",9002313.03,9002313.03,115,"DT") 3100722 "^DD",9002313.03,9002313.03,116,0) MEDICAID AGENCY NUMBER^F^^100;16^K:$L(X)>17!($L(X)<1) X "^DD",9002313.03,9002313.03,116,3) Answer must be 1-17 characters. "^DD",9002313.03,9002313.03,116,21,0) ^.001^3^3^3100929^^^ "^DD",9002313.03,9002313.03,116,21,1,0) This is used to store NCPDP field 116-N6 (Medicaid Agency Number), "^DD",9002313.03,9002313.03,116,21,2,0) which is defined as "Number assigned by processor to identify the individual Medicaid Agency "^DD",9002313.03,9002313.03,116,21,3,0) or representative." "^DD",9002313.03,9002313.03,116,"DT") 3100722 "^DD",9002313.03,9002313.03,201,0) SERVICE PROVIDER ID^F^^200;1^K:$L(X)>15!($L(X)<1) X "^DD",9002313.03,9002313.03,201,3) Answer must be 1-15 characters in length. "^DD",9002313.03,9002313.03,201,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,201,21,1,0) ID assigned to a pharmacy or provider. "^DD",9002313.03,9002313.03,201,"DT") 3080207 "^DD",9002313.03,9002313.03,202,0) SERVICE PROVIDER ID QUALIFIER^F^^200;2^K:$L(X)>2!($L(X)<1) X "^DD",9002313.03,9002313.03,202,3) Answer must be 1-2 characters in length. "^DD",9002313.03,9002313.03,202,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,202,21,1,0) Code qualifying the 'Service Provider ID' (2Ø1) "^DD",9002313.03,9002313.03,202,"DT") 3080207 "^DD",9002313.03,9002313.03,301,0) GROUP ID^F^^300;1^K:$L(X)>15!($L(X)<1) X "^DD",9002313.03,9002313.03,301,3) Answer must be 1-15 characters in length. "^DD",9002313.03,9002313.03,301,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,301,21,1,0) ID assigned to the cardholder group or employer group. "^DD",9002313.03,9002313.03,301,"DT") 3080207 "^DD",9002313.03,9002313.03,302,0) CARDHOLDER ID^F^^300;2^K:$L(X)>22!($L(X)<1) X "^DD",9002313.03,9002313.03,302,3) Answer must be 1-22 characters. "^DD",9002313.03,9002313.03,302,21,0) ^.001^3^3^3100929^^^ "^DD",9002313.03,9002313.03,302,21,1,0) This is used to store NCPDP field 302-C2 (Cardholder ID), "^DD",9002313.03,9002313.03,302,21,2,0) which is defined as "Insurance ID assigned to the cardholder or identification number used by "^DD",9002313.03,9002313.03,302,21,3,0) the plan." "^DD",9002313.03,9002313.03,302,"DT") 3100722 "^DD",9002313.03,9002313.03,304,0) DATE OF BIRTH^F^^300;4^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.03,304,3) Answer must be 1-10 characters. "^DD",9002313.03,9002313.03,304,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.03,304,21,1,0) This is used to store NCPDP field 304-C4 (Date Of Birth), "^DD",9002313.03,9002313.03,304,21,2,0) which is defined as "Date of birth of patient." "^DD",9002313.03,9002313.03,304,"DT") 3100722 "^DD",9002313.03,9002313.03,310,0) PATIENT FIRST NAME^F^^300;10^K:$L(X)>14!($L(X)<1) X "^DD",9002313.03,9002313.03,310,3) Answer must be 1-14 characters. "^DD",9002313.03,9002313.03,310,21,0) ^.001^2^2^3100930^^^ "^DD",9002313.03,9002313.03,310,21,1,0) This is used to store NCPDP field 310-CA (Patient First Name), "^DD",9002313.03,9002313.03,310,21,2,0) which is defined as "Individual first name." "^DD",9002313.03,9002313.03,310,"DT") 3100722 "^DD",9002313.03,9002313.03,311,0) PATIENT LAST NAME^F^^310;1^K:$L(X)>17!($L(X)<1) X "^DD",9002313.03,9002313.03,311,3) Answer must be 1-17 characters in length. "^DD",9002313.03,9002313.03,311,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.03,9002313.03,311,21,1,0) This is used to store NCPDP field 311-CB (Patient Last Name), "^DD",9002313.03,9002313.03,311,21,2,0) which is defined as "Individual last name." "^DD",9002313.03,9002313.03,311,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.03,9002313.03,311,23,1,0) REQUEST PATIENT SEGMENT. RESPONSE PATIENT SEGMENT. "^DD",9002313.03,9002313.03,311,"DT") 3100831 "^DD",9002313.03,9002313.03,401,0) DATE OF SERVICE^FO^^400;1^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.03,401,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.03,401,2.1) S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.03,401,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.03,401,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.03,401,21,1,0) Identifies date the prescription was filled or professional service "^DD",9002313.03,9002313.03,401,21,2,0) rendered. "^DD",9002313.03,9002313.03,401,"DT") 3080618 "^DD",9002313.03,9002313.03,501,0) RESPONSE STATUS^S^A:ACCEPTED;R:REJECTED;^500;1^Q "^DD",9002313.03,9002313.03,501,3) Enter the status of the response from the payer. "^DD",9002313.03,9002313.03,501,21,0) ^^1^1^3080617^ "^DD",9002313.03,9002313.03,501,21,1,0) A code indicating the status of this response. "^DD",9002313.03,9002313.03,501,"DT") 3080617 "^DD",9002313.03,9002313.03,504,0) MESSAGE^F^^504;1^K:$L(X)>250!($L(X)<1) X "^DD",9002313.03,9002313.03,504,3) Answer must be 1-250 characters in length. "^DD",9002313.03,9002313.03,504,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,504,21,1,0) Free form message. "^DD",9002313.03,9002313.03,504,"DT") 3080207 "^DD",9002313.03,9002313.03,524,0) PLAN IDENTIFICATION^F^^500;24^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.03,524,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.03,524,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.03,524,21,1,0) Assigned by the processor to identify a set of parameters, benefit, or "^DD",9002313.03,9002313.03,524,21,2,0) coverage criteria used to adjudicate a claim. "^DD",9002313.03,9002313.03,524,"DT") 3080207 "^DD",9002313.03,9002313.03,545,0) NETWORK REIMBURSEMENT ID^F^^540;5^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.03,545,3) Answer must be 1-10 characters in length. "^DD",9002313.03,9002313.03,545,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.03,545,21,1,0) Field defined by the processor. It identifies the network, for the covered "^DD",9002313.03,9002313.03,545,21,2,0) member, used to calculate the reimbursement to the pharmacy. "^DD",9002313.03,9002313.03,545,"DT") 3080207 "^DD",9002313.03,9002313.03,568,0) PAYER ID QUALIFIER^S^01:NATIONAL PAYER ID;02:HCN;03:BIN;04:NAIC;99:OTHER;^560;8^Q "^DD",9002313.03,9002313.03,568,3) Enter a code specifying the type of payer ID. "^DD",9002313.03,9002313.03,568,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.03,568,21,1,0) Code indicating the type of payer ID. "^DD",9002313.03,9002313.03,568,"DT") 3080618 "^DD",9002313.03,9002313.03,569,0) PAYER ID^F^^560;9^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.03,569,3) Answer must be 1-10 characters in length. "^DD",9002313.03,9002313.03,569,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.03,569,21,1,0) Payer identification - the payer this claim was submitted to. "^DD",9002313.03,9002313.03,569,"DT") 3080207 "^DD",9002313.03,9002313.03,1000,0) RESPONSES^9002313.0301A^^1000;0 "^DD",9002313.03,9002313.03,1000,21,0) ^^1^1^3101025^ "^DD",9002313.03,9002313.03,1000,21,1,0) This is the transaction response data returned by the third-party payer. "^DD",9002313.03,9002313.03,1000,"DT") 3080207 "^DD",9002313.03,9002313.03,9999,0) RAW DATA RECEIVED^9002313.39999^^M;0 "^DD",9002313.03,9002313.03,9999,3) Enter the raw NCPDP data received from the payer. "^DD",9002313.03,9002313.03,9999,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.03,9999,21,1,0) This is to store the raw data received from the payer. "^DD",9002313.03,9002313.0301,0) RESPONSES SUB-FIELD^^987^86 "^DD",9002313.03,9002313.0301,0,"DT") 3101027 "^DD",9002313.03,9002313.0301,0,"IX","B",9002313.0301,.01) "^DD",9002313.03,9002313.0301,0,"NM","RESPONSES") "^DD",9002313.03,9002313.0301,0,"UP") 9002313.03 "^DD",9002313.03,9002313.0301,.01,0) TRANSACTION ORDER^MMNJ9,0^^0;1^K:+X'=X!(X>999999999)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.0301,.01,1,0) ^.1 "^DD",9002313.03,9002313.0301,.01,1,1,0) 9002313.0301^B "^DD",9002313.03,9002313.0301,.01,1,1,1) S ^BPSR(DA(1),1000,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.0301,.01,1,1,2) K ^BPSR(DA(1),1000,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.0301,.01,3) Type a number between 1 and 999999999, 0 decimal digits. "^DD",9002313.03,9002313.0301,.01,21,0) ^.001^2^2^3101026^^ "^DD",9002313.03,9002313.0301,.01,21,1,0) This sequential value indicates the number of this transaction within the "^DD",9002313.03,9002313.0301,.01,21,2,0) transaction set. "^DD",9002313.03,9002313.0301,.01,"DT") 3101026 "^DD",9002313.03,9002313.0301,112,0) TRANSACTION RESPONSE STATUS^S^A:APPROVED;C:CAPTURED;D:DUPLICATE OF PAID;F:PA DEFERRED;P:PAID;Q:DUPLICATE OF CAPTURED;R:REJECTED;S:DUPLICATE OF APPROVED;^110;2^Q "^DD",9002313.03,9002313.0301,112,3) Enter the status of this transaction. "^DD",9002313.03,9002313.0301,112,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,112,21,1,0) Code indicating the status of the transaction. "^DD",9002313.03,9002313.0301,112,"DT") 3080207 "^DD",9002313.03,9002313.0301,114,0) MEDICAID SUBROGATION ICN/TCN^F^^100;14^K:$L(X)>22!($L(X)<1) X "^DD",9002313.03,9002313.0301,114,.1) MEDICAID SUBROGATION INTERNAL CONTROL NUMBER/TRANSACTION CONTROL NUMBER (ICN/TCN) "^DD",9002313.03,9002313.0301,114,3) Answer must be 1-22 characters. "^DD",9002313.03,9002313.0301,114,21,0) ^.001^2^2^3101019^^^^ "^DD",9002313.03,9002313.0301,114,21,1,0) This is used to store NCPDP field 114-N4 (Medicaid Subrogation Internal Control Number/Transaction Control Number (ICN/TCN), "^DD",9002313.03,9002313.0301,114,21,2,0) which is defined as "Claim number assigned by the Medicaid Agency." "^DD",9002313.03,9002313.0301,114,"DT") 3100722 "^DD",9002313.03,9002313.0301,128,0) SPENDING ACCOUNT AMT REMAINING^FO^^120;8^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,128,.1) SPENDING ACCOUNT AMOUNT REMAINING "^DD",9002313.03,9002313.0301,128,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,128,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,128,3) Answer must be 1-8 characters "^DD",9002313.03,9002313.0301,128,21,0) ^.001^3^3^3101026^^^ "^DD",9002313.03,9002313.0301,128,21,1,0) This is used to store NCPDP field 128-UC (Spending Account Amount Remaining), "^DD",9002313.03,9002313.0301,128,21,2,0) which is defined as "The balance from the patient's spending account after this transaction "^DD",9002313.03,9002313.0301,128,21,3,0) was applied." "^DD",9002313.03,9002313.0301,128,"DT") 3101026 "^DD",9002313.03,9002313.0301,129,0) HEALTH PLAN-FUNDED ASSTNCE AMT^FO^^120;9^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,129,.1) HEALTH PLAN-FUNDED ASSISTANCE AMOUNT "^DD",9002313.03,9002313.0301,129,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,129,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,129,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,129,21,0) ^.001^5^5^3101026^^^ "^DD",9002313.03,9002313.0301,129,21,1,0) This is used to store NCPDP field 129-UD (Health Plan-funded Assistance Amount), "^DD",9002313.03,9002313.0301,129,21,2,0) which is defined as "The amount from the health plan-funded assistance account for the patient "^DD",9002313.03,9002313.0301,129,21,3,0) that was applied to reduce Patient Pay Amount (505-F5). This amount is "^DD",9002313.03,9002313.0301,129,21,4,0) used in Healthcare Reimbursement Account (HRA) benefits only. This field "^DD",9002313.03,9002313.0301,129,21,5,0) is always a negative amount or zero." "^DD",9002313.03,9002313.0301,129,"DT") 3101026 "^DD",9002313.03,9002313.0301,130,0) ADDITIONAL MESSAGE INFO COUNT^F^^120;10^K:$L(X)>4!($L(X)<1) X "^DD",9002313.03,9002313.0301,130,.1) ADDITIONAL MESSAGE INFORMATION COUNT "^DD",9002313.03,9002313.0301,130,3) Answer must be 1-4 characters. "^DD",9002313.03,9002313.0301,130,21,0) ^.001^3^3^3101026^^^ "^DD",9002313.03,9002313.0301,130,21,1,0) This is used to store NCPDP field 130-UF (Additional Message Information Count), "^DD",9002313.03,9002313.0301,130,21,2,0) which is defined as "Count of the 'Additional Message Information' (526-FQ) occurrences that "^DD",9002313.03,9002313.0301,130,21,3,0) follow." "^DD",9002313.03,9002313.0301,130,"DT") 3100929 "^DD",9002313.03,9002313.0301,130.01,0) ADDITIONAL MESSAGE MLTPL^9002313.13001A^^130.01;0 "^DD",9002313.03,9002313.0301,130.01,21,0) ^.001^1^1^3101021^^^^ "^DD",9002313.03,9002313.0301,130.01,21,1,0) This sub-file contains Additional Message information. "^DD",9002313.03,9002313.0301,130.01,"DT") 3100831 "^DD",9002313.03,9002313.0301,133,0) AMT ATTRIB TO PRVDR NTWRK SEL^FO^^130;3^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,133,.1) AMOUNT ATTRIBUTED TO PROVIDER NETWORK SELECTION "^DD",9002313.03,9002313.0301,133,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,133,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,133,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,133,21,0) ^.001^3^3^3101026^^^^ "^DD",9002313.03,9002313.0301,133,21,1,0) This is used to store NCPDP field 133-UJ (Amount Attributed to Provider Network Selection), "^DD",9002313.03,9002313.0301,133,21,2,0) which is defined as "Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,133,21,3,0) Amount' (505-F5) that is due to the patient's provider network selection." "^DD",9002313.03,9002313.0301,133,"DT") 3101026 "^DD",9002313.03,9002313.0301,134,0) AMT ATTR PROD SEL BRAND DRUG^FO^^130;4^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,134,.1) AMOUNT ATTRIBUTED TO PRODUCT SELECTION/BRAND DRUG "^DD",9002313.03,9002313.0301,134,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,134,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,134,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,134,21,0) ^.001^4^4^3101026^^^^ "^DD",9002313.03,9002313.0301,134,21,1,0) This is used to store NCPDP field 134-UK (Amount Attributed to Product Selection/Brand Drug), "^DD",9002313.03,9002313.0301,134,21,2,0) which is defined as "Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,134,21,3,0) Amount' (505-F5) that is due to the patient's selection of a Brand "^DD",9002313.03,9002313.0301,134,21,4,0) product." "^DD",9002313.03,9002313.0301,134,"DT") 3101026 "^DD",9002313.03,9002313.0301,135,0) AMT ATTR PRD NON-PREF FRMLRY^FO^^130;5^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,135,.1) AMOUNT ATTRIBUTED TO PRODUCT SELECTION/NON-PREFERRED FORMULARY SELECTION "^DD",9002313.03,9002313.0301,135,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,135,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,135,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,135,21,0) ^.001^4^4^3101026^^^^ "^DD",9002313.03,9002313.0301,135,21,1,0) This is used to store NCPDP field 135-UM (Amount Attributed to Product Selection/Non-Preferred Formulary Selection), "^DD",9002313.03,9002313.0301,135,21,2,0) which is defined as "Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,135,21,3,0) Amount' (505-F5) that is due to the patient's selection of a "^DD",9002313.03,9002313.0301,135,21,4,0) Non-Preferred Formulary product." "^DD",9002313.03,9002313.0301,135,"DT") 3101026 "^DD",9002313.03,9002313.0301,136,0) AMT ATTR BRAND NON-PREF FRMLRY^FO^^130;6^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,136,.1) AMOUNT ATTRIBUTED TO PRODUCT SELECTION/BRAND NON-PREFERRED FORMULARY SELECTION "^DD",9002313.03,9002313.0301,136,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,136,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,136,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,136,21,0) ^.001^4^4^3101026^^^^ "^DD",9002313.03,9002313.0301,136,21,1,0) This is used to store NCPDP field 136-UN (Amount Attributed to Product Selection/Brand Non-Preferred Formulary Selection), "^DD",9002313.03,9002313.0301,136,21,2,0) which is defined as "Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,136,21,3,0) Amount' (505-F5) that is due to the patient's selection of a Brand "^DD",9002313.03,9002313.0301,136,21,4,0) Non-Preferred Formulary product." "^DD",9002313.03,9002313.0301,136,"DT") 3101026 "^DD",9002313.03,9002313.0301,137,0) AMOUNT ATTRIB TO COVERAGE GAP^FO^^130;7^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,137,.1) AMOUNT ATTRIBUTED TO COVERAGE GAP "^DD",9002313.03,9002313.0301,137,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,137,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,137,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,137,21,0) ^.001^6^6^3101026^^^ "^DD",9002313.03,9002313.0301,137,21,1,0) This is used to store NCPDP field 137-UP (Amount Attributed to Coverage Gap), "^DD",9002313.03,9002313.0301,137,21,2,0) which is defined as "Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,137,21,3,0) Amount' (505-F5) that is due to the patient being in the coverage gap "^DD",9002313.03,9002313.0301,137,21,4,0) (for example Medicare Part D Coverage Gap (donut hole)). A coverage gap "^DD",9002313.03,9002313.0301,137,21,5,0) is defined as the period or amount during which the previous coverage "^DD",9002313.03,9002313.0301,137,21,6,0) ends and before an additional coverage begins." "^DD",9002313.03,9002313.0301,137,"DT") 3101026 "^DD",9002313.03,9002313.0301,138,0) CMS LICS LEVEL^F^^130;8^K:$L(X)>22!($L(X)<1) X "^DD",9002313.03,9002313.0301,138,.1) CMS LOW INCOME COST SHARING (LICS) LEVEL "^DD",9002313.03,9002313.0301,138,3) Answer must be 1-22 characters. "^DD",9002313.03,9002313.0301,138,21,0) ^.001^3^3^3100929^^ "^DD",9002313.03,9002313.0301,138,21,1,0) This is used to store NCPDP field 138-UQ (CMS Low Income Cost Sharing (LICS) Level), "^DD",9002313.03,9002313.0301,138,21,2,0) which is defined as "Free form text that provides the low-income subsidy copay level for a "^DD",9002313.03,9002313.0301,138,21,3,0) Part D patient." "^DD",9002313.03,9002313.0301,138,"DT") 3100722 "^DD",9002313.03,9002313.0301,139,0) MEDICARE PART D COVERAGE CODE^F^^130;9^K:$L(X)>2!($L(X)<1) X "^DD",9002313.03,9002313.0301,139,3) Answer must be 1-2 characters. "^DD",9002313.03,9002313.0301,139,21,0) ^.001^2^2^3101026^^^^ "^DD",9002313.03,9002313.0301,139,21,1,0) This is used to store NCPDP field 139-UR (Medicare Part D Coverage Code), "^DD",9002313.03,9002313.0301,139,21,2,0) which is defined as "Code indicating the position of Medicare Part D in the billing order." "^DD",9002313.03,9002313.0301,139,"DT") 3101026 "^DD",9002313.03,9002313.0301,140,0) NEXT MEDICARE PART D EFFCTV DT^F^^130;10^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.0301,140,.1) NEXT MEDICARE PART D EFFECTIVE DATE "^DD",9002313.03,9002313.0301,140,3) Answer must be 1-10 characters. "^DD",9002313.03,9002313.0301,140,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.03,9002313.0301,140,21,1,0) This is used to store NCPDP field 140-US (Next Medicare Part D Effective Date), "^DD",9002313.03,9002313.0301,140,21,2,0) which is defined as "Future date Part D coverage begins for the patient." "^DD",9002313.03,9002313.0301,140,"DT") 3100722 "^DD",9002313.03,9002313.0301,141,0) NEXT MEDICARE PART D TERM DATE^F^^140;1^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.0301,141,.1) NEXT MEDICARE PART D TERMINATION DATE "^DD",9002313.03,9002313.0301,141,3) Answer must be 1-10 characters. "^DD",9002313.03,9002313.0301,141,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.0301,141,21,1,0) This is used to store NCPDP field 141-UT (Next Medicare Part D Termination Date), "^DD",9002313.03,9002313.0301,141,21,2,0) which is defined as "Future date Part D coverage ends for the patient." "^DD",9002313.03,9002313.0301,141,"DT") 3100819 "^DD",9002313.03,9002313.0301,148,0) INGRED COST CNTRCTD REIMB AMT^FO^^140;8^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,148,.1) INGREDIENT COST CONTRACTED/REIMBURSABLE AMOUNT "^DD",9002313.03,9002313.0301,148,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,148,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,148,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,148,21,0) ^.001^4^4^3101026^^^^ "^DD",9002313.03,9002313.0301,148,21,1,0) This is used to store NCPDP field 148-U8 (Ingredient Cost Contracted/Reimbursable Amount), "^DD",9002313.03,9002313.0301,148,21,2,0) which is defined as "Informational field used when Other Payer-Patient Responsibility Amount "^DD",9002313.03,9002313.0301,148,21,3,0) (352-NQ) or Patient Pay Amount (505-F5) is used for reimbursement. Amount "^DD",9002313.03,9002313.0301,148,21,4,0) is equal to contracted or reimbursable amount for product being dispensed." "^DD",9002313.03,9002313.0301,148,"DT") 3101026 "^DD",9002313.03,9002313.0301,149,0) DISP FEE CNTRCTD REIMB AMOUNT^FO^^140;9^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,149,.1) DISPENSING FEE CONTRACTED/REIMBURSABLE AMOUNT "^DD",9002313.03,9002313.0301,149,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,149,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,149,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,149,21,0) ^.001^5^5^3101026^^^^ "^DD",9002313.03,9002313.0301,149,21,1,0) This is used to store NCPDP field 149-U9 (Dispensing Fee Contracted/Reimbursable Amount), "^DD",9002313.03,9002313.0301,149,21,2,0) which is defined as "Informational field used when Other Payer-Patient Responsibility Amount "^DD",9002313.03,9002313.0301,149,21,3,0) (352-NQ) or Patient Pay Amount (505-F5) is used for reimbursement. Amount "^DD",9002313.03,9002313.0301,149,21,4,0) is equal to contracted or reimbursable dispensing fee for product being "^DD",9002313.03,9002313.0301,149,21,5,0) dispensed." "^DD",9002313.03,9002313.0301,149,"DT") 3101026 "^DD",9002313.03,9002313.0301,240,0) CONTRACT NUMBER^F^^230;10^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.0301,240,3) Answer must be 1-10 characters. "^DD",9002313.03,9002313.0301,240,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.0301,240,21,1,0) This is used to store NCPDP field 240-U1 (Contract Number), "^DD",9002313.03,9002313.0301,240,21,2,0) which is defined as "Account Number assigned during installation for segments of business." "^DD",9002313.03,9002313.0301,240,"DT") 3100722 "^DD",9002313.03,9002313.0301,346,0) BASIS OF CALC-DISPENSING FEE^S^00:NOT SPECIFIED;01:QUANTITY DISPENSED;02:QUANTITY INTENDED TO BE DISP;03:USUAL & CUSTOMARY/PRORATED;04:WAIVED DUE TO PARTIAL FILL;99:OTHER;^340;6^Q "^DD",9002313.03,9002313.0301,346,.1) BASIS OF CALCULATION-DISPENSING FEE "^DD",9002313.03,9002313.0301,346,3) Enter the basis for the dispensing fee paid. "^DD",9002313.03,9002313.0301,346,21,0) ^^2^2^3101025^ "^DD",9002313.03,9002313.0301,346,21,1,0) This is used to store NCPDP field 346-HH (Basis Of Calculation-Dispensing Fee), "^DD",9002313.03,9002313.0301,346,21,2,0) which is defined as "Code indicating how the reimbursement amount was calculated for Dispensing Fee Paid (507-F7)." "^DD",9002313.03,9002313.0301,346,23,0) ^^1^1^3101025^ "^DD",9002313.03,9002313.0301,346,23,1,0) RESPONSE PRICING SEGMENT. "^DD",9002313.03,9002313.0301,346,"DT") 3101025 "^DD",9002313.03,9002313.0301,347,0) BASIS FOR COPAY^S^00:NOT SPECIFIED;01:QUANTITY DISPENSED;02:QUANTITY INTENDED TO BE DISPENSED;03:USUAL & CUSTOMARY/PRORATED;04:WAIVED DO TO PARTIAL FILL;99:OTHER;^340;7^Q "^DD",9002313.03,9002313.0301,347,3) Enter the basis for the copayment amount. "^DD",9002313.03,9002313.0301,347,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.0301,347,21,1,0) Code indicating how the reimbursement amount was calculated for 'Patient "^DD",9002313.03,9002313.0301,347,21,2,0) Pay Amount'(5Ø5). "^DD",9002313.03,9002313.0301,347,"DT") 3080207 "^DD",9002313.03,9002313.0301,348,0) BASIS OF CALC-FLAT SALES TAX^S^00:NOT SPECIFIED;01:QUANTITY DISPENSED;02:QUANTITY INTENDED TO BE DISPENSED;^340;8^Q "^DD",9002313.03,9002313.0301,348,.1) BASIS OF CALCULATION-FLAT SALES TAX "^DD",9002313.03,9002313.0301,348,3) Enter the basis for the flat tax paid. "^DD",9002313.03,9002313.0301,348,21,0) ^.001^2^2^3100901^^ "^DD",9002313.03,9002313.0301,348,21,1,0) This is used to store NCPDP field 348-HK (Basis Of Calculation-Flat Sales Tax), "^DD",9002313.03,9002313.0301,348,21,2,0) which is defined as "Code indicating how the reimbursement amount was calculated for Flat Sales Tax Amount Paid (558-AW)." "^DD",9002313.03,9002313.0301,348,23,0) ^^1^1^3100901^ "^DD",9002313.03,9002313.0301,348,23,1,0) RESPONSE PRICING SEGMENT. "^DD",9002313.03,9002313.0301,348,"DT") 3100901 "^DD",9002313.03,9002313.0301,349,0) BASIS FOR PERCENTAGE TAX^S^00:NOT SPECIFIED;01:QUANTITY DISPENSED;02:QUANTITY INTENDED TO BE DISPENSED;^340;9^Q "^DD",9002313.03,9002313.0301,349,3) Enter the basis for the percentage tax paid. "^DD",9002313.03,9002313.0301,349,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.0301,349,21,1,0) Code indicating how the reimbursement amount was calculated for "^DD",9002313.03,9002313.0301,349,21,2,0) 'Percentage Sales Tax Amount Paid' (559). "^DD",9002313.03,9002313.0301,349,"DT") 3080207 "^DD",9002313.03,9002313.0301,355,0) OTHER PAYER ID COUNT^F^^350;5^K:$L(X)>3!($L(X)<1) X "^DD",9002313.03,9002313.0301,355,3) Answer must be 1-3 characters. "^DD",9002313.03,9002313.0301,355,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.03,9002313.0301,355,21,1,0) This is used to store NCPDP field 355-NT (Other Payer ID Count), "^DD",9002313.03,9002313.0301,355,21,2,0) which is defined as "Count of other payers with payment responsibility." "^DD",9002313.03,9002313.0301,355,"DT") 3100722 "^DD",9002313.03,9002313.0301,355.01,0) OTHER PAYER ID MLTPL^9002313.035501A^^355.01;0 "^DD",9002313.03,9002313.0301,355.01,21,0) ^.001^1^1^3101020^^^ "^DD",9002313.03,9002313.0301,355.01,21,1,0) This sub-file contains OTHER PAYER ID values. "^DD",9002313.03,9002313.0301,355.01,"DT") 3100831 "^DD",9002313.03,9002313.0301,392,0) BENEFIT STAGE COUNT^F^^390;2^K:$L(X)>3!($L(X)<1) X "^DD",9002313.03,9002313.0301,392,3) Answer must be 1-3 characters. "^DD",9002313.03,9002313.0301,392,21,0) ^.001^2^2^3100929^^^ "^DD",9002313.03,9002313.0301,392,21,1,0) This is used to store NCPDP field 392-MU (Benefit Stage Count), "^DD",9002313.03,9002313.0301,392,21,2,0) which is defined as "Count of 'Benefit Stage Amount' (394-MW) occurrences." "^DD",9002313.03,9002313.0301,392,"DT") 3100722 "^DD",9002313.03,9002313.0301,392.01,0) BENEFIT STAGE INFO^9002313.039201A^^392.01;0 "^DD",9002313.03,9002313.0301,392.01,21,0) ^.001^1^1^3101020^^^^ "^DD",9002313.03,9002313.0301,392.01,21,1,0) This sub-file contains Benefit Stage values. "^DD",9002313.03,9002313.0301,392.01,"DT") 3100818 "^DD",9002313.03,9002313.0301,402,0) PRESCRIPTION REFERENCE NUMBER^F^^400;2^K:$L(X)>14!($L(X)<1) X "^DD",9002313.03,9002313.0301,402,.1) PRESCRIPTION/SERVICE REFERENCE NUMBER "^DD",9002313.03,9002313.0301,402,3) Answer must be 1-14 characters. "^DD",9002313.03,9002313.0301,402,21,0) 4^.001^2^2^3101014^^^ "^DD",9002313.03,9002313.0301,402,21,1,0) This is used to store NCPDP field 402-D2 (Prescription/Service Reference Number), "^DD",9002313.03,9002313.0301,402,21,2,0) which is defined as "Reference number assigned by the provider for the dispensed drug/product and/or service provided." "^DD",9002313.03,9002313.0301,402,23,0) ^.001^2^2^3101014^^^^ "^DD",9002313.03,9002313.0301,402,23,1,0) Qualified by Prescription/Service Reference Number Qualifier (455-EM). "^DD",9002313.03,9002313.0301,402,23,2,0) REQUEST CLAIM SEGMENT. RESPONSE CLAIM SEGMENT. "^DD",9002313.03,9002313.0301,402,"DT") 3101004 "^DD",9002313.03,9002313.0301,455,0) RX REFERENCE NUMBER QUALIFIER^S^1:RX BILLING;2:SERVICE BILLING;^450;5^Q "^DD",9002313.03,9002313.0301,455,3) Answer must be 1 character in length. "^DD",9002313.03,9002313.0301,455,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,455,21,1,0) Indicates the type of billing submitted. "^DD",9002313.03,9002313.0301,455,"DT") 3080207 "^DD",9002313.03,9002313.0301,498.14,0) PRIOR AUTH NUMBER-ASSIGNED^F^^498;6^K:$L(X)>11!($L(X)<1) X "^DD",9002313.03,9002313.0301,498.14,.1) PRIOR AUTHORIZATION NUMBER-ASSIGNED "^DD",9002313.03,9002313.0301,498.14,3) Answer must be 1-11 characters in length. "^DD",9002313.03,9002313.0301,498.14,21,0) ^.001^2^2^3100901^^ "^DD",9002313.03,9002313.0301,498.14,21,1,0) This is used to store NCPDP field 498-PY (Prior Authorization Number-Assigned), "^DD",9002313.03,9002313.0301,498.14,21,2,0) which is defined as "Unique number identifying the prior authorization assigned by the processor." "^DD",9002313.03,9002313.0301,498.14,"DT") 3100901 "^DD",9002313.03,9002313.0301,498.51,0) DATE OF PRIOR AUTHORIZATION^FO^^498;1^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,498.51,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.0301,498.51,2.1) S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.0301,498.51,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,498.51,21,0) ^^1^1^3031124^ "^DD",9002313.03,9002313.0301,498.51,21,1,0) Date the prior authorization request was processed. "^DD",9002313.03,9002313.0301,498.51,"DT") 3080618 "^DD",9002313.03,9002313.0301,498.52,0) PRIOR AUTHORIZATION START^FO^^498;2^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,498.52,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.0301,498.52,2.1) S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.0301,498.52,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,498.52,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,498.52,21,1,0) Date the prior authorization became effective. "^DD",9002313.03,9002313.0301,498.52,"DT") 3080618 "^DD",9002313.03,9002313.0301,498.53,0) PRIOR AUTHORIZATION END^FO^^498;3^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,498.53,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.0301,498.53,2.1) S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.0301,498.53,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,498.53,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,498.53,21,1,0) Date the prior authorization expires. "^DD",9002313.03,9002313.0301,498.53,"DT") 3080618 "^DD",9002313.03,9002313.0301,498.54,0) PRIOR AUTH NO REFILLS AUTHRZD^NJ2,0^^498;4^K:+X'=X!(X>99)!(X<0)!(X?.E1"."1N.N) X "^DD",9002313.03,9002313.0301,498.54,.1) PRIOR AUTHORIZATION NUMBER OF REFILLS AUTHORIZED "^DD",9002313.03,9002313.0301,498.54,3) Type a number between 0 and 99, 0 decimal digits. "^DD",9002313.03,9002313.0301,498.54,21,0) ^.001^2^2^3101014^^^^ "^DD",9002313.03,9002313.0301,498.54,21,1,0) This is used to store NCPDP field 498-PW (Prior Authorization Number Of Refills Authorized), "^DD",9002313.03,9002313.0301,498.54,21,2,0) which is defined as "Number of refills authorized by the prior authorization." "^DD",9002313.03,9002313.0301,498.54,23,0) ^.001^1^1^3101014^^^^ "^DD",9002313.03,9002313.0301,498.54,23,1,0) RESPONSE PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.03,9002313.0301,498.54,"DT") 3101014 "^DD",9002313.03,9002313.0301,498.55,0) PRIOR AUTH QTY ACCUMULATED^F^^498;5^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.0301,498.55,.1) PRIOR AUTHORIZATION QUANTITY ACCUMULATED "^DD",9002313.03,9002313.0301,498.55,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.0301,498.55,21,0) ^.001^2^2^3100929^^^^ "^DD",9002313.03,9002313.0301,498.55,21,1,0) This is used to store NCPDP field 498-PX (Prior Authorization Quantity Accumulated), "^DD",9002313.03,9002313.0301,498.55,21,2,0) which is defined as "Accumulated authorized amount expressed in metric decimal units." "^DD",9002313.03,9002313.0301,498.55,23,0) ^.001^3^3^3100929^^^^ "^DD",9002313.03,9002313.0301,498.55,23,1,0) Format=9999999.999 "^DD",9002313.03,9002313.0301,498.55,23,2,0) Comments: Provided to the pharmacy by the processor to determine quantity remaining for billing. "^DD",9002313.03,9002313.0301,498.55,23,3,0) RESPONSE PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.03,9002313.0301,498.55,"DT") 3100901 "^DD",9002313.03,9002313.0301,498.57,0) PRIOR AUTHORIZATION QUANTITY^F^^498;7^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.0301,498.57,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.0301,498.57,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.03,9002313.0301,498.57,21,1,0) This is used to store NCPDP field 498-RA (Prior Authorization Quantity), "^DD",9002313.03,9002313.0301,498.57,21,2,0) which is defined as "Amount authorized expressed in metric decimal units." "^DD",9002313.03,9002313.0301,498.57,23,0) ^.001^3^3^3101004^^^^ "^DD",9002313.03,9002313.0301,498.57,23,1,0) Format=9999999.999 "^DD",9002313.03,9002313.0301,498.57,23,2,0) Comments: Provided to the pharmacy by the processor to convey the number of units authorized. "^DD",9002313.03,9002313.0301,498.57,23,3,0) RESPONSE PRIOR AUTHORIZATION SEGMENT. "^DD",9002313.03,9002313.0301,498.57,"DT") 3100901 "^DD",9002313.03,9002313.0301,498.58,0) PRIOR AUTHORIZATION AMOUNT^F^^498;8^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,498.58,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,498.58,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,498.58,21,1,0) Amount authorized in the prior authorization. "^DD",9002313.03,9002313.0301,498.58,"DT") 3080207 "^DD",9002313.03,9002313.0301,501,0) HEADER RESPONSE STATUS^S^A:ACCEPTED;R:REJECTED CLAIM;P:CLAIM PAYABLE;C:CLAIM CAPTURED;D:DUPLICATE CLAIM;DP:DUPLICATE OF PAYABLE CLAIM;DC:DUPLICATE OF CAPTURED CLAIM;^500;1^Q "^DD",9002313.03,9002313.0301,501,1,0) ^.1 "^DD",9002313.03,9002313.0301,501,1,1,0) 9002313.03^AC "^DD",9002313.03,9002313.0301,501,1,1,1) S ^BPSR("AC",$E(X,1,30),DA(1),DA)="" "^DD",9002313.03,9002313.0301,501,1,1,2) K ^BPSR("AC",$E(X,1,30),DA(1),DA) "^DD",9002313.03,9002313.0301,501,1,1,"DT") 2950622 "^DD",9002313.03,9002313.0301,501,3) Enter the status of the response. "^DD",9002313.03,9002313.0301,501,21,0) ^^1^1^3101022^ "^DD",9002313.03,9002313.0301,501,21,1,0) This is used to store NCPDP field 501-F1 (Header Response Status). "^DD",9002313.03,9002313.0301,501,"DT") 3101022 "^DD",9002313.03,9002313.0301,503,0) AUTHORIZATION NUMBER^F^^500;3^K:$L(X)>20!($L(X)<14) X "^DD",9002313.03,9002313.0301,503,3) Answer must be 14-20 characters in length. "^DD",9002313.03,9002313.0301,503,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,503,21,1,0) Number assigned by the processor to identify an authorized transaction. "^DD",9002313.03,9002313.0301,503,"DT") 3080207 "^DD",9002313.03,9002313.0301,504,0) MESSAGE^F^^504;1^K:$L(X)>250!($L(X)<1) X "^DD",9002313.03,9002313.0301,504,3) Answer must be 1-250 characters in length. "^DD",9002313.03,9002313.0301,504,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,504,21,1,0) Free text message from payer. "^DD",9002313.03,9002313.0301,504,"DT") 3080207 "^DD",9002313.03,9002313.0301,505,0) PATIENT PAY AMOUNT^FO^^500;5^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,505,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,505,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,505,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,505,21,0) ^^4^4^3080207^ "^DD",9002313.03,9002313.0301,505,21,1,0) Amount that is calculated by the processor and returned to the pharmacy as "^DD",9002313.03,9002313.0301,505,21,2,0) the TOTAL amount to be paid by the patient to the pharmacy; the patient's "^DD",9002313.03,9002313.0301,505,21,3,0) total cost share, including co-payments, amounts applied to deductible, "^DD",9002313.03,9002313.0301,505,21,4,0) over maximum amounts, penalties, etc. "^DD",9002313.03,9002313.0301,505,"DT") 3080207 "^DD",9002313.03,9002313.0301,506,0) INGREDIENT COST PAID^FO^^500;6^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,506,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,506,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,506,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,506,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,506,21,1,0) Drug ingredient cost paid included in the 'Total Amount Paid' (5Ø9). "^DD",9002313.03,9002313.0301,506,"DT") 3080207 "^DD",9002313.03,9002313.0301,507,0) DISPENSING FEE PAID^FO^^500;7^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,507,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,507,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,507,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,507,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,507,21,1,0) Dispensing fee paid included in the 'Total Amount Paid' (5Ø9). "^DD",9002313.03,9002313.0301,507,"DT") 3080207 "^DD",9002313.03,9002313.0301,509,0) TOTAL AMOUNT PAID^FO^^500;9^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,509,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,509,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,509,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,509,21,0) ^^6^6^3080207^ "^DD",9002313.03,9002313.0301,509,21,1,0) Total amount to be paid by the claims processor (i.e. pharmacy "^DD",9002313.03,9002313.0301,509,21,2,0) receivable). Represents a sum of 'Ingredient Cost Paid' (5Ø6), 'Dispensing "^DD",9002313.03,9002313.0301,509,21,3,0) Fee Paid' (5Ø7), 'Flat Sales Tax Amount Paid' (558), 'Percentage Sales Tax "^DD",9002313.03,9002313.0301,509,21,4,0) Amount Paid' (559), 'Incentive Amount Paid' (521), 'Professional Service "^DD",9002313.03,9002313.0301,509,21,5,0) Fee Paid' (562), 'Other Amount Paid' (565), less 'Patient Pay Amount' "^DD",9002313.03,9002313.0301,509,21,6,0) (5Ø5) and 'Other Payer Amount Recognized' (566). "^DD",9002313.03,9002313.0301,509,"DT") 3080207 "^DD",9002313.03,9002313.0301,510,0) REJECT COUNT^F^^500;10^K:$L(X)>2!($L(X)<2) X "^DD",9002313.03,9002313.0301,510,3) Answer must be 2 characters in length. "^DD",9002313.03,9002313.0301,510,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,510,21,1,0) Count of 'Reject Code' (511) occurrences. "^DD",9002313.03,9002313.0301,510,"DT") 3080207 "^DD",9002313.03,9002313.0301,511,0) REJECT CODE^9002313.03511A^^511;0 "^DD",9002313.03,9002313.0301,511,3) Select a NCPDP reject code "^DD",9002313.03,9002313.0301,511,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,511,21,1,0) Multiple rejection codes. "^DD",9002313.03,9002313.0301,511,"DT") 3080207 "^DD",9002313.03,9002313.0301,512,0) ACCUMULATED DEDUCTIBLE AMOUNT^FO^^500;12^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,512,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),9,2) "^DD",9002313.03,9002313.0301,512,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),9,2) "^DD",9002313.03,9002313.0301,512,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,512,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,512,21,1,0) Amount in dollars met by the patient/family in a deductible plan. "^DD",9002313.03,9002313.0301,512,"DT") 3080207 "^DD",9002313.03,9002313.0301,513,0) REMAINING DEDUCTIBLE AMOUNT^FO^^500;13^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,513,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),9,2) "^DD",9002313.03,9002313.0301,513,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),9,2) "^DD",9002313.03,9002313.0301,513,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,513,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,513,21,1,0) Amount not met by the patient/family in the deductible plan. "^DD",9002313.03,9002313.0301,513,"DT") 3080207 "^DD",9002313.03,9002313.0301,514,0) REMAINING BENEFIT AMOUNT^FO^^500;14^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,514,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),9,2) "^DD",9002313.03,9002313.0301,514,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),9,2) "^DD",9002313.03,9002313.0301,514,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,514,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,514,21,1,0) Amount remaining in a patient/family plan with a periodic maximum benefit. "^DD",9002313.03,9002313.0301,514,"DT") 3080207 "^DD",9002313.03,9002313.0301,517,0) AMT APPLD PERIODIC DEDUCTIBLE^FO^^500;17^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,517,.1) AMOUNT APPLIED TO PERIODIC DEDUCTIBLE "^DD",9002313.03,9002313.0301,517,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,517,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,517,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,517,21,0) ^.001^3^3^3101026^^^^ "^DD",9002313.03,9002313.0301,517,21,1,0) This is used to store NCPDP field 517-FH (Amount Applied To Periodic Deductible), "^DD",9002313.03,9002313.0301,517,21,2,0) which is defined as "Amount to be collected from a patient that is included in "^DD",9002313.03,9002313.0301,517,21,3,0) 'Patient Pay Amount' (505-F5) that is applied to a periodic deductible." "^DD",9002313.03,9002313.0301,517,"DT") 3101026 "^DD",9002313.03,9002313.0301,518,0) AMOUNT OF COPAY^FO^^500;18^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,518,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,518,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,518,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,518,21,0) ^.001^3^3^3101026^^^^ "^DD",9002313.03,9002313.0301,518,21,1,0) This is used to store NCPDP field 518-FI (Amount Of Copay), which is defined as "Amount "^DD",9002313.03,9002313.0301,518,21,2,0) to be collected from the patient that is included in 'Patient Pay Amount' (505-F5) that "^DD",9002313.03,9002313.0301,518,21,3,0) is due to a per prescription copay." "^DD",9002313.03,9002313.0301,518,"DT") 3101026 "^DD",9002313.03,9002313.0301,519,0) AMT ATTRIB TO PROD SELECTION^FO^^500;19^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,519,.1) AMOUNT ATTRIBUTED TO PRODUCT SELECTION "^DD",9002313.03,9002313.0301,519,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,519,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,519,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,519,21,0) ^.001^3^3^3101026^^^^ "^DD",9002313.03,9002313.0301,519,21,1,0) This is used to store NCPDP field 519-FJ (Amount Attributed To Product Selection), "^DD",9002313.03,9002313.0301,519,21,2,0) which is defined as "Amount to be collected from the patient that is included in "^DD",9002313.03,9002313.0301,519,21,3,0) 'Patient Pay Amount' (505-F5) that is due to the patients selection of drug product." "^DD",9002313.03,9002313.0301,519,"DT") 3101026 "^DD",9002313.03,9002313.0301,520,0) AMT EXCEEDING PERIOD BNFT MAX^FO^^500;20^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,520,.1) AMOUNT EXCEEDING PERIODIC BENEFIT MAXIMUM "^DD",9002313.03,9002313.0301,520,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,520,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,520,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,520,21,0) ^.001^4^4^3101026^^^^ "^DD",9002313.03,9002313.0301,520,21,1,0) This is used to store NCPDP field 520-FK (Amount Exceeding Periodic Benefit Maximum), "^DD",9002313.03,9002313.0301,520,21,2,0) which is defined as "Amount to be collected from the patient that is included "^DD",9002313.03,9002313.0301,520,21,3,0) in 'Patient Pay Amount' (505-F5) that is due to the patient exceeding "^DD",9002313.03,9002313.0301,520,21,4,0) a periodic benefit maximum." "^DD",9002313.03,9002313.0301,520,"DT") 3101026 "^DD",9002313.03,9002313.0301,521,0) INCENTIVE AMOUNT PAID^FO^^500;21^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,521,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,521,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,521,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,521,21,0) ^^3^3^3080207^ "^DD",9002313.03,9002313.0301,521,21,1,0) Amount represents the contractually agreed upon incentive fee paid for "^DD",9002313.03,9002313.0301,521,21,2,0) specific services rendered. Amount is included in the 'Total Amount Paid' "^DD",9002313.03,9002313.0301,521,21,3,0) (5Ø9). "^DD",9002313.03,9002313.0301,521,"DT") 3080207 "^DD",9002313.03,9002313.0301,522,0) BASIS OF REIMB DETERMINATION^F^^500;22^K:$L(X)>2!($L(X)<2) X "^DD",9002313.03,9002313.0301,522,.1) BASIS OF REIMBURSEMENT DETERMINATION "^DD",9002313.03,9002313.0301,522,3) Answer must be 2 characters in length. "^DD",9002313.03,9002313.0301,522,21,0) ^.001^2^2^3100901^^ "^DD",9002313.03,9002313.0301,522,21,1,0) This is used to store NCPDP field 522-FM (Basis Of Reimbursement Determination), "^DD",9002313.03,9002313.0301,522,21,2,0) which is defined as "Code identifying how the reimbursement amount was calculated for Ingredient Cost Paid (506-F6)." "^DD",9002313.03,9002313.0301,522,23,0) ^^1^1^3100901^ "^DD",9002313.03,9002313.0301,522,23,1,0) RESPONSE PRICING SEGMENT. "^DD",9002313.03,9002313.0301,522,"DT") 3100901 "^DD",9002313.03,9002313.0301,523,0) AMOUNT ATTRIBUTED TO SALES TAX^FO^^500;23^K:$L(X)>8!($L(X)<6) X "^DD",9002313.03,9002313.0301,523,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,523,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,523,3) Answer must be 6-8 characters in length. "^DD",9002313.03,9002313.0301,523,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.0301,523,21,1,0) Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,523,21,2,0) Amount' (5Ø5) that is due to sales tax paid. "^DD",9002313.03,9002313.0301,523,"DT") 3080207 "^DD",9002313.03,9002313.0301,525,0) DUR RESPONSE DATA^F^^525;1^K:$L(X)>250!($L(X)<1) X "^DD",9002313.03,9002313.0301,525,3) Answer must be 1-250 characters in length. "^DD",9002313.03,9002313.0301,525,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,525,21,1,0) Text that provides additional detail regarding a DUR conflict. "^DD",9002313.03,9002313.0301,525,"DT") 3080207 "^DD",9002313.03,9002313.0301,526,0) *ADDITIONAL MESSAGE INFORMATIO^F^^526;1^K:$L(X)>250!($L(X)<1) X "^DD",9002313.03,9002313.0301,526,.1) *ADDITIONAL MESSAGE INFORMATION "^DD",9002313.03,9002313.0301,526,3) Answer must be 1-250 characters in length. "^DD",9002313.03,9002313.0301,526,21,0) ^^1^1^3101025^ "^DD",9002313.03,9002313.0301,526,21,1,0) * This field is no longer used in NCPDP vD.0. * "^DD",9002313.03,9002313.0301,526,23,0) ^^2^2^3101025^ "^DD",9002313.03,9002313.0301,526,23,1,0) In BPS*1.0*10, this data for this field was moved to the ADDITIONAL "^DD",9002313.03,9002313.0301,526,23,2,0) MESSAGE MLTPL (#9002313.13001) subfile. "^DD",9002313.03,9002313.0301,526,"DT") 3101025 "^DD",9002313.03,9002313.0301,547,0) APPROVED MESSAGE CODE COUNT^F^^540;7^K:$L(X)>1!($L(X)<1) X "^DD",9002313.03,9002313.0301,547,3) Answer must be 1 character in length. "^DD",9002313.03,9002313.0301,547,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,547,21,1,0) Count of the 'Approved Message Code' (548-6F) occurrences. "^DD",9002313.03,9002313.0301,547,"DT") 3080207 "^DD",9002313.03,9002313.0301,548,0) APPROVED MESSAGE CODE^9002313.301548A^^548;0 "^DD",9002313.03,9002313.0301,548,"DT") 3080207 "^DD",9002313.03,9002313.0301,549,0) HELP DESK PHONE QUALIFIER^F^^540;9^K:$L(X)>2!($L(X)<1) X "^DD",9002313.03,9002313.0301,549,3) Answer must be 1-2 characters in length. "^DD",9002313.03,9002313.0301,549,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,549,21,1,0) Code qualifying the phone number in the 'Help Desk Phone Number' (55Ø). "^DD",9002313.03,9002313.0301,549,"DT") 3080207 "^DD",9002313.03,9002313.0301,550,0) HELP DESK PHONE NUMBER^F^^540;10^K:$L(X)>18!($L(X)<1) X "^DD",9002313.03,9002313.0301,550,3) Answer must be 1-18 characters in length. "^DD",9002313.03,9002313.0301,550,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,550,21,1,0) Ten digit phone number of the help desk. "^DD",9002313.03,9002313.0301,550,"DT") 3080207 "^DD",9002313.03,9002313.0301,551,0) PREFERRED PRODUCT COUNT^NJ1,0^^550;1^K:+X'=X!(X>9)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.0301,551,3) Type a number between 1 and 9, 0 Decimal Digits "^DD",9002313.03,9002313.0301,551,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.0301,551,21,1,0) Count of preferred product occurrences. "^DD",9002313.03,9002313.0301,551,"DT") 3080618 "^DD",9002313.03,9002313.0301,551.01,0) PREFERRED PRODUCT REPEATING^9002313.1301A^^551.01;0 "^DD",9002313.03,9002313.0301,551.01,3) "^DD",9002313.03,9002313.0301,551.01,"DT") 3080207 "^DD",9002313.03,9002313.0301,557,0) TAX EXEMPT INDICATOR^S^1:PAYER/PLAN IS TAX EXEMPT;2:NOT TAX EXEMPT;3:PATIENT IS TAX EXEMPT;4:PAYER/PLAN AND PATIENT TAX EXEMPT;^550;7^Q "^DD",9002313.03,9002313.0301,557,3) Enter a code specifying tax exempt status. "^DD",9002313.03,9002313.0301,557,21,0) ^^1^1^3080617^ "^DD",9002313.03,9002313.0301,557,21,1,0) Code indicating the payer and/or patient is exempt from taxes. "^DD",9002313.03,9002313.0301,557,"DT") 3080617 "^DD",9002313.03,9002313.0301,558,0) FLAT SALES TAX PAID^FO^^550;8^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,558,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,558,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,558,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,558,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,558,21,1,0) Flat sales tax paid which is included in the 'Total Amount Paid' (5Ø9). "^DD",9002313.03,9002313.0301,558,"DT") 3080207 "^DD",9002313.03,9002313.0301,559,0) PERCENTAGE SALES TAX PAID^FO^^550;9^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,559,2) S Y(0)=Y S Y=$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,559,2.1) S Y=$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,559,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,559,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.0301,559,21,1,0) Amount of percentage sales tax paid which is included in the 'Total Amount "^DD",9002313.03,9002313.0301,559,21,2,0) Paid' (5Ø9). "^DD",9002313.03,9002313.0301,559,"DT") 3080207 "^DD",9002313.03,9002313.0301,560,0) PERCENTAGE SALES TAX RATE PAID^FO^^550;10^K:$L(X)>7!($L(X)<7) X "^DD",9002313.03,9002313.0301,560,2) S Y(0)=Y S Y=$J($$DFF2EXT^BPSECFM(Y)/100,7,4) "^DD",9002313.03,9002313.0301,560,2.1) S Y=$J($$DFF2EXT^BPSECFM(Y)/100,7,4) "^DD",9002313.03,9002313.0301,560,3) Answer must be 7 characters in length. "^DD",9002313.03,9002313.0301,560,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.0301,560,21,1,0) Percentage sales tax rate used to calculate 'Percentage Sales Tax Amount "^DD",9002313.03,9002313.0301,560,21,2,0) Paid' (559). "^DD",9002313.03,9002313.0301,560,"DT") 3080207 "^DD",9002313.03,9002313.0301,561,0) PERCENTAGE SALES TAX BASIS PD^S^01:GROSS AMOUNT DUE;02:INGREDIENT COST;03:INGREDIENT COST + DISPENSING FEE;^560;1^Q "^DD",9002313.03,9002313.0301,561,.1) PERCENTAGE SALES TAX BASIS PAID "^DD",9002313.03,9002313.0301,561,3) Enter the basis for the percentage sales tax paid. "^DD",9002313.03,9002313.0301,561,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.03,9002313.0301,561,21,1,0) This is used to store NCPDP field 561-AZ (Percentage Sales Tax Basis Paid), "^DD",9002313.03,9002313.0301,561,21,2,0) which is defined as "Code indicating the percentage sales tax paid basis." "^DD",9002313.03,9002313.0301,561,23,0) ^.001^1^1^3101014^^ "^DD",9002313.03,9002313.0301,561,23,1,0) RESPONSE PRICING SEGMENT. "^DD",9002313.03,9002313.0301,561,"DT") 3100901 "^DD",9002313.03,9002313.0301,562,0) PROFESSIONAL SERVICE FEE PAID^FO^^560;2^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,562,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,562,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,562,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,562,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,562,21,1,0) Amount submitted by the provider for professional services rendered. "^DD",9002313.03,9002313.0301,562,"DT") 3080207 "^DD",9002313.03,9002313.0301,563,0) OTHER AMOUNT PAID COUNT^F^^560;3^K:$L(X)>1!($L(X)<1) X "^DD",9002313.03,9002313.0301,563,3) Answer must be 1 character in length. "^DD",9002313.03,9002313.0301,563,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,563,21,1,0) Count of the other amount paid occurrences. "^DD",9002313.03,9002313.0301,563,"DT") 3080207 "^DD",9002313.03,9002313.0301,563.01,0) OTHER AMOUNTS PAID^9002313.1401A^^563.01;0 "^DD",9002313.03,9002313.0301,563.01,3) "^DD",9002313.03,9002313.0301,563.01,"DT") 3080207 "^DD",9002313.03,9002313.0301,566,0) OTHER PAYER AMOUNT RECOGNIZED^FO^^560;6^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.0301,566,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,566,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.0301,566,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.0301,566,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,566,21,1,0) Total dollar amount of any payment from another source including coupons. "^DD",9002313.03,9002313.0301,566,"DT") 3080207 "^DD",9002313.03,9002313.0301,567.01,0) DUR PPS^9002313.1101A^^567.01;0 "^DD",9002313.03,9002313.0301,567.01,3) "^DD",9002313.03,9002313.0301,567.01,"DT") 3080207 "^DD",9002313.03,9002313.0301,571,0) AMOUNT ATTRIBUTED TO PROC FEE^FO^^570;1^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,571,.1) AMOUNT ATTRIBUTED TO PROCESSOR FEE "^DD",9002313.03,9002313.0301,571,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,571,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,571,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,571,21,0) ^.001^4^4^3101026^^^^ "^DD",9002313.03,9002313.0301,571,21,1,0) This is used to store NCPDP field 571-NZ (Amount Attributed to Processor Fee), "^DD",9002313.03,9002313.0301,571,21,2,0) which is defined as "Amount to be collected from the patient that is included in Patient Pay "^DD",9002313.03,9002313.0301,571,21,3,0) Amount (505-F5) that is due to the processing fee imposed by the "^DD",9002313.03,9002313.0301,571,21,4,0) processor." "^DD",9002313.03,9002313.0301,571,"DT") 3101026 "^DD",9002313.03,9002313.0301,572,0) AMOUNT OF COINSURANCE^FO^^570;2^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,572,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,572,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,572,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,572,21,0) ^.001^3^3^3101026^^^ "^DD",9002313.03,9002313.0301,572,21,1,0) This is used to store NCPDP field 572-4U (Amount of Coinsurance), "^DD",9002313.03,9002313.0301,572,21,2,0) which is defined as "Amount to be collected from the patient that is included in 'Patient Pay "^DD",9002313.03,9002313.0301,572,21,3,0) Amount' (505-F5) that is due to a per prescription coinsurance." "^DD",9002313.03,9002313.0301,572,"DT") 3101026 "^DD",9002313.03,9002313.0301,573,0) BASIS OF CALC-COINSURANCE^F^^570;3^K:$L(X)>4!($L(X)<1) X "^DD",9002313.03,9002313.0301,573,.1) BASIS OF CALCULATION-COINSURANCE "^DD",9002313.03,9002313.0301,573,3) Answer must be 1-4 characters. "^DD",9002313.03,9002313.0301,573,21,0) ^.001^3^3^3100929^^^^ "^DD",9002313.03,9002313.0301,573,21,1,0) This is used to store NCPDP field 573-4V (Basis of Calculation-Coinsurance), "^DD",9002313.03,9002313.0301,573,21,2,0) which is defined as "Code indicating how the Coinsurance reimbursement amount was calculated "^DD",9002313.03,9002313.0301,573,21,3,0) for 'Patient Pay Amount' (505-F5)." "^DD",9002313.03,9002313.0301,573,"DT") 3100929 "^DD",9002313.03,9002313.0301,574,0) PLAN SALES TAX AMOUNT^FO^^570;4^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,574,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,574,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,574,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,574,21,0) ^.001^3^3^3101026^^^ "^DD",9002313.03,9002313.0301,574,21,1,0) This is used to store NCPDP field 574-2Y (Plan Sales Tax Amount), "^DD",9002313.03,9002313.0301,574,21,2,0) which is defined as "Plan sales tax responsibility. This field is not a component of the "^DD",9002313.03,9002313.0301,574,21,3,0) Patient Pay Amount (505-F5) formula." "^DD",9002313.03,9002313.0301,574,"DT") 3101026 "^DD",9002313.03,9002313.0301,575,0) PATIENT SALES TAX^FO^^570;5^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,575,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,575,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,575,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.0301,575,21,0) ^.001^3^3^3101026^^^ "^DD",9002313.03,9002313.0301,575,21,1,0) This is used to store NCPDP field 575-EQ (Patient Sales Tax Amount), "^DD",9002313.03,9002313.0301,575,21,2,0) which is defined as "Patient sales tax responsibility. This field is not a component of the "^DD",9002313.03,9002313.0301,575,21,3,0) Patient Pay Amount (505-F5) formula." "^DD",9002313.03,9002313.0301,575,"DT") 3101026 "^DD",9002313.03,9002313.0301,577,0) ESTIMATED GENERIC SAVINGS^F^^570;7^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.0301,577,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,577,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.0301,577,3) Answer must be 1-8 characters in length. "^DD",9002313.03,9002313.0301,577,21,0) ^.001^4^4^3100929^^ "^DD",9002313.03,9002313.0301,577,21,1,0) This is used to store NCPDP field 577-G3 (Estimated Generic Savings), "^DD",9002313.03,9002313.0301,577,21,2,0) which is defined as "The amount, not included in the Total Amount Paid (509-F9), that the "^DD",9002313.03,9002313.0301,577,21,3,0) patient would have saved if they had chosen the generic drug instead of "^DD",9002313.03,9002313.0301,577,21,4,0) the brand drug." "^DD",9002313.03,9002313.0301,577,"DT") 3101027 "^DD",9002313.03,9002313.0301,757,0) BENEFIT ID^F^^750;7^K:$L(X)>17!($L(X)<1) X "^DD",9002313.03,9002313.0301,757,3) Answer must be 1-17 characters. "^DD",9002313.03,9002313.0301,757,21,0) ^.001^3^3^3100929^^ "^DD",9002313.03,9002313.0301,757,21,1,0) This is used to store NCPDP field 757-U6 (Benefit ID), "^DD",9002313.03,9002313.0301,757,21,2,0) which is defined as "Assigned by processor to identify a set of parameters, benefits, or "^DD",9002313.03,9002313.0301,757,21,3,0) coverage criteria used to adjudicate a claim." "^DD",9002313.03,9002313.0301,757,"DT") 3100722 "^DD",9002313.03,9002313.0301,880,0) TRANSACTION REFERENCE NUMBER^F^^870;10^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.0301,880,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.0301,880,21,0) ^.001^1^1^3101014^^ "^DD",9002313.03,9002313.0301,880,21,1,0) This is used to store NCPDP field 880-K5 (Transaction Reference Number). "^DD",9002313.03,9002313.0301,880,"DT") 3100818 "^DD",9002313.03,9002313.0301,926,0) FORMULARY ID^F^^920;6^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.0301,926,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.0301,926,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.0301,926,21,1,0) This is used to store NCPDP field 926-FF (Formulary ID), "^DD",9002313.03,9002313.0301,926,21,2,0) which is defined as "ID for the formulary list." "^DD",9002313.03,9002313.0301,926,"DT") 3100722 "^DD",9002313.03,9002313.0301,987,0) URL^F^^987;1^K:$L(X)>250!($L(X)<1) X "^DD",9002313.03,9002313.0301,987,3) Answer must be 1-250 characters. "^DD",9002313.03,9002313.0301,987,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.0301,987,21,1,0) This is used to store NCPDP field 987-MA (URL), "^DD",9002313.03,9002313.0301,987,21,2,0) which is defined as "The web page address." "^DD",9002313.03,9002313.0301,987,"DT") 3100722 "^DD",9002313.03,9002313.0301,993,0) INTERNAL CONTROL NUMBER^F^^990;3^K:$L(X)>32!($L(X)<1) X "^DD",9002313.03,9002313.0301,993,3) Answer must be 1-32 characters. "^DD",9002313.03,9002313.0301,993,21,0) ^.001^3^3^3100929^^ "^DD",9002313.03,9002313.0301,993,21,1,0) This is used to store NCPDP field 993-A7 (Internal Control Number), "^DD",9002313.03,9002313.0301,993,21,2,0) which is defined as "Number assigned by the processor to identify an adjudicated claim when "^DD",9002313.03,9002313.0301,993,21,3,0) supplied in payer-to-payer coordination of benefits only." "^DD",9002313.03,9002313.0301,993,"DT") 3100722 "^DD",9002313.03,9002313.0301,1000,0) DUPLICATE RESPONSE DATA^F^^1000;1^K:$L(X)>85!($L(X)<1) X "^DD",9002313.03,9002313.0301,1000,3) Answer must be 1-85 characters in length. "^DD",9002313.03,9002313.0301,1000,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.0301,1000,21,1,0) Response text to indicate duplicated data. "^DD",9002313.03,9002313.0301,1000,"DT") 3080207 "^DD",9002313.03,9002313.03511,0) REJECT CODE SUB-FIELD^^546^2 "^DD",9002313.03,9002313.03511,0,"DT") 3080618 "^DD",9002313.03,9002313.03511,0,"IX","B",9002313.03511,.01) "^DD",9002313.03,9002313.03511,0,"NM","REJECT CODE") "^DD",9002313.03,9002313.03511,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.03511,.01,0) REJECT CODE^MFO^^0;1^K:$L(X)>3!($L(X)<1) X "^DD",9002313.03,9002313.03511,.01,1,0) ^.1 "^DD",9002313.03,9002313.03511,.01,1,1,0) 9002313.03511^B "^DD",9002313.03,9002313.03511,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),511,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.03511,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),511,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.03511,.01,2) S Y(0)=Y S Y=$$TRANREJ^BPSECFM(Y) "^DD",9002313.03,9002313.03511,.01,2.1) S Y=$$TRANREJ^BPSECFM(Y) "^DD",9002313.03,9002313.03511,.01,3) Answer must be 1-3 characters in length. "^DD",9002313.03,9002313.03511,.01,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.03511,.01,21,1,0) The code returned in the response indicating the reason(s) why the claim "^DD",9002313.03,9002313.03511,.01,21,2,0) was rejected. "^DD",9002313.03,9002313.03511,.01,"DT") 3080207 "^DD",9002313.03,9002313.03511,546,0) REJECT FIELD OCCURRENCE^NJ2,0^^0;2^K:+X'=X!(X>99)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.03511,546,3) Type a number between 0 and 99, 0 Decimal Digits "^DD",9002313.03,9002313.03511,546,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.03511,546,21,1,0) The number of times a particular field caused a rejection to be triggered. "^DD",9002313.03,9002313.03511,546,"DT") 3080618 "^DD",9002313.03,9002313.035501,0) OTHER PAYER ID MLTPL SUB-FIELD^^127^12 "^DD",9002313.03,9002313.035501,0,"DT") 3100831 "^DD",9002313.03,9002313.035501,0,"IX","B",9002313.035501,.01) "^DD",9002313.03,9002313.035501,0,"NM","OTHER PAYER ID MLTPL") "^DD",9002313.03,9002313.035501,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.035501,.01,0) OTHER PAYER ID COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.03,9002313.035501,.01,1,0) ^.1 "^DD",9002313.03,9002313.035501,.01,1,1,0) 9002313.035501^B "^DD",9002313.03,9002313.035501,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),355.01,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.035501,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),355.01,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.035501,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.03,9002313.035501,.01,21,0) ^.001^1^1^3101020^^^ "^DD",9002313.03,9002313.035501,.01,21,1,0) This is a sequential counter of the Other Payer ID occurrences. "^DD",9002313.03,9002313.035501,.01,23,0) ^.001^1^1^3101020^^^ "^DD",9002313.03,9002313.035501,.01,23,1,0) Counter incremented by BPS* software. "^DD",9002313.03,9002313.035501,.01,"DT") 3100722 "^DD",9002313.03,9002313.035501,127,0) OTHER PAYER HELP DESK PHONE NO^F^^0;6^K:$L(X)>20!($L(X)<1) X "^DD",9002313.03,9002313.035501,127,.1) OTHER PAYER HELP DESK PHONE NUMBER "^DD",9002313.03,9002313.035501,127,3) Answer must be 1-20 characters. "^DD",9002313.03,9002313.035501,127,21,0) ^.001^2^2^3101014^^^^ "^DD",9002313.03,9002313.035501,127,21,1,0) This is used to store NCPDP field 127-UB (Other Payer Help Desk Phone Number), "^DD",9002313.03,9002313.035501,127,21,2,0) which is defined as "Phone number of the other payer's help desk." "^DD",9002313.03,9002313.035501,127,23,0) ^.001^10^10^3101014^^^^ "^DD",9002313.03,9002313.035501,127,23,1,0) Format=AAAEEENNNNXXXXXXXX "^DD",9002313.03,9002313.035501,127,23,2,0) AAA=Area Code "^DD",9002313.03,9002313.035501,127,23,3,0) EEE=Exchange Code "^DD",9002313.03,9002313.035501,127,23,4,0) NNNN=Number "^DD",9002313.03,9002313.035501,127,23,5,0) XXXXXXXX=Extension "^DD",9002313.03,9002313.035501,127,23,6,0) Examples: "^DD",9002313.03,9002313.035501,127,23,7,0) A phone number of 212-555-1212 would reflect: 2125551212. "^DD",9002313.03,9002313.035501,127,23,8,0) With an extension of 123 the same number would reflect: 2125551212123 or 2125551212x123 or 2125551212ext123. "^DD",9002313.03,9002313.035501,127,23,9,0) "^DD",9002313.03,9002313.035501,127,23,10,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.03,9002313.035501,127,"DT") 3100831 "^DD",9002313.03,9002313.035501,142,0) OTHER PAYER PERSON CODE^F^^0;2^K:$L(X)>5!($L(X)<1) X "^DD",9002313.03,9002313.035501,142,3) Answer must be 1-5 characters. "^DD",9002313.03,9002313.035501,142,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.03,9002313.035501,142,21,1,0) This is used to store NCPDP field 142-UV (Other Payer Person Code), "^DD",9002313.03,9002313.035501,142,21,2,0) which is defined as "Code assigned by the other payer to a specific person within a family." "^DD",9002313.03,9002313.035501,142,23,0) ^.001^1^1^3101004^^^ "^DD",9002313.03,9002313.035501,142,23,1,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.03,9002313.035501,142,"DT") 3100831 "^DD",9002313.03,9002313.035501,143,0) OTHER PAYER PATIENT REL CODE^F^^0;3^K:$L(X)>3!($L(X)<1) X "^DD",9002313.03,9002313.035501,143,.1) OTHER PAYER PATIENT RELATIONSHIP CODE "^DD",9002313.03,9002313.035501,143,3) Answer must be 1-3 characters. "^DD",9002313.03,9002313.035501,143,21,0) ^.001^2^2^3101004^^^ "^DD",9002313.03,9002313.035501,143,21,1,0) This is used to store NCPDP field 143-UW (Other Payer-Patient Relationship Code), "^DD",9002313.03,9002313.035501,143,21,2,0) which is defined as "Code assigned by the other payer to indicate the relationship of patient to cardholder." "^DD",9002313.03,9002313.035501,143,23,0) ^.001^1^1^3101004^^ "^DD",9002313.03,9002313.035501,143,23,1,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.03,9002313.035501,143,"DT") 3100831 "^DD",9002313.03,9002313.035501,144,0) OTHER PAYER EFFECTIVE DATE^F^^0;4^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.035501,144,3) Answer must be 1-10 characters. "^DD",9002313.03,9002313.035501,144,21,0) ^.001^1^1^3101014^^^^ "^DD",9002313.03,9002313.035501,144,21,1,0) This is used to store NCPDP field 144-UX (Other Payer Benefit Effective Date). "^DD",9002313.03,9002313.035501,144,23,0) ^.001^7^7^3101014^^^^ "^DD",9002313.03,9002313.035501,144,23,1,0) Format=CCYYMMDD "^DD",9002313.03,9002313.035501,144,23,2,0) CC=Century "^DD",9002313.03,9002313.035501,144,23,3,0) YY=Year "^DD",9002313.03,9002313.035501,144,23,4,0) MM=Month "^DD",9002313.03,9002313.035501,144,23,5,0) DD=Day "^DD",9002313.03,9002313.035501,144,23,6,0) "^DD",9002313.03,9002313.035501,144,23,7,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.03,9002313.035501,144,"DT") 3100831 "^DD",9002313.03,9002313.035501,145,0) OTHER PAYER TERMINATION DATE^F^^0;5^K:$L(X)>10!($L(X)<1) X "^DD",9002313.03,9002313.035501,145,3) Answer must be 1-10 characters. "^DD",9002313.03,9002313.035501,145,21,0) ^.001^2^2^3101004^^^^ "^DD",9002313.03,9002313.035501,145,21,1,0) This is used to store NCPDP field 145-UY (Other Payer Benefit Termination Date), "^DD",9002313.03,9002313.035501,145,21,2,0) which is defined as "Other Payer's termination date of the patient's benefit." "^DD",9002313.03,9002313.035501,145,23,0) ^.001^6^6^3101004^^^ "^DD",9002313.03,9002313.035501,145,23,1,0) Format=CCYYMMDD "^DD",9002313.03,9002313.035501,145,23,2,0) CC=Century "^DD",9002313.03,9002313.035501,145,23,3,0) YY=Year "^DD",9002313.03,9002313.035501,145,23,4,0) MM=Month "^DD",9002313.03,9002313.035501,145,23,5,0) DD=Day "^DD",9002313.03,9002313.035501,145,23,6,0) RESPONSE COORDINATION OF BENEFITS/OTHER PAYERS SEGMENT. "^DD",9002313.03,9002313.035501,145,"DT") 3100831 "^DD",9002313.03,9002313.035501,338,0) OTHER PAYER COVERAGE TYPE^F^^1;1^K:$L(X)>4!($L(X)<1) X "^DD",9002313.03,9002313.035501,338,3) Answer must be 1-4 characters. "^DD",9002313.03,9002313.035501,338,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.035501,338,21,1,0) This is used to store NCPDP field 338-5C (Other Payer Coverage Type), "^DD",9002313.03,9002313.035501,338,21,2,0) which is defined as "Code identifying the type of 'Other Payer ID' (340-7C)." "^DD",9002313.03,9002313.035501,338,"DT") 3100722 "^DD",9002313.03,9002313.035501,339,0) OTHER PAYER ID QUALIFIER^F^^1;2^K:$L(X)>4!($L(X)<1) X "^DD",9002313.03,9002313.035501,339,3) Answer must be 1-4 characters. "^DD",9002313.03,9002313.035501,339,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.035501,339,21,1,0) This is used to store NCPDP field 339-6C (Other Payer ID Qualifier), "^DD",9002313.03,9002313.035501,339,21,2,0) which is defined as "Code qualifying the 'Other Payer ID' (340-7C)." "^DD",9002313.03,9002313.035501,339,"DT") 3100722 "^DD",9002313.03,9002313.035501,340,0) OTHER PAYER ID^F^^1;3^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.035501,340,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.035501,340,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.035501,340,21,1,0) This is used to store NCPDP field 340-7C (Other Payer ID), "^DD",9002313.03,9002313.035501,340,21,2,0) which is defined as "ID assigned to the payer." "^DD",9002313.03,9002313.035501,340,"DT") 3100722 "^DD",9002313.03,9002313.035501,356,0) OTHER PAYER CARDHOLDER ID^F^^1;5^K:$L(X)>22!($L(X)<1) X "^DD",9002313.03,9002313.035501,356,3) Answer must be 1-22 characters. "^DD",9002313.03,9002313.035501,356,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.035501,356,21,1,0) This is used to store NCPDP field 356-NU (Other Payer Cardholder ID), "^DD",9002313.03,9002313.035501,356,21,2,0) which is defined as "Cardholder ID for this member that is associated with the Payer noted." "^DD",9002313.03,9002313.035501,356,"DT") 3100722 "^DD",9002313.03,9002313.035501,991,0) OTHER PAYER PROCESSOR CNTRL NO^F^^1;4^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.035501,991,.1) OTHER PAYER PROCESSOR CONTROL NUMBER "^DD",9002313.03,9002313.035501,991,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.035501,991,21,0) ^.001^3^3^3100929^^ "^DD",9002313.03,9002313.035501,991,21,1,0) This is used to store NCPDP field 991-MH (Other Payer Processor Control Number), "^DD",9002313.03,9002313.035501,991,21,2,0) which is defined as "A number that uniquely identifies the secondary, tertiary, etc. payer to "^DD",9002313.03,9002313.035501,991,21,3,0) the processor." "^DD",9002313.03,9002313.035501,991,"DT") 3100722 "^DD",9002313.03,9002313.035501,992,0) OTHER PAYER GROUP ID^F^^1;6^K:$L(X)>17!($L(X)<1) X "^DD",9002313.03,9002313.035501,992,3) Answer must be 1-17 characters. "^DD",9002313.03,9002313.035501,992,21,0) ^.001^3^3^3100929^^ "^DD",9002313.03,9002313.035501,992,21,1,0) This is used to store NCPDP field 992-MJ (Other Payer Group ID), "^DD",9002313.03,9002313.035501,992,21,2,0) which is defined as "ID assigned to the cardholder group or employer group by the secondary, "^DD",9002313.03,9002313.035501,992,21,3,0) tertiary, etc. payer." "^DD",9002313.03,9002313.035501,992,"DT") 3100722 "^DD",9002313.03,9002313.039201,0) BENEFIT STAGE INFO SUB-FIELD^^394^3 "^DD",9002313.03,9002313.039201,0,"DT") 3101026 "^DD",9002313.03,9002313.039201,0,"IX","B",9002313.039201,.01) "^DD",9002313.03,9002313.039201,0,"NM","BENEFIT STAGE INFO") "^DD",9002313.03,9002313.039201,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.039201,.01,0) BENEFIT STAGE COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.03,9002313.039201,.01,1,0) ^.1 "^DD",9002313.03,9002313.039201,.01,1,1,0) 9002313.039201^B "^DD",9002313.03,9002313.039201,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),392.01,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.039201,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),392.01,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.039201,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.03,9002313.039201,.01,21,0) ^.001^1^1^3101020^^^ "^DD",9002313.03,9002313.039201,.01,21,1,0) This is a sequential counter of the Benefit Stage occurrences. "^DD",9002313.03,9002313.039201,.01,23,0) ^.001^1^1^3101020^^ "^DD",9002313.03,9002313.039201,.01,23,1,0) Counter incremented by BPS* software. "^DD",9002313.03,9002313.039201,.01,"DT") 3100722 "^DD",9002313.03,9002313.039201,393,0) BENEFIT STAGE QUALIFIER^F^^0;2^K:$L(X)>4!($L(X)<1) X "^DD",9002313.03,9002313.039201,393,3) Answer must be 1-4 characters. "^DD",9002313.03,9002313.039201,393,21,0) ^.001^1^1^3101014^^ "^DD",9002313.03,9002313.039201,393,21,1,0) This is used to store NCPDP field 393-MV (Benefit Stage Qualifier). "^DD",9002313.03,9002313.039201,393,"DT") 3100818 "^DD",9002313.03,9002313.039201,394,0) BENEFIT STAGE AMOUNT^FO^^0;3^K:$L(X)>8!($L(X)<1) X "^DD",9002313.03,9002313.039201,394,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.039201,394,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),8,2) "^DD",9002313.03,9002313.039201,394,3) Answer must be 1-8 characters. "^DD",9002313.03,9002313.039201,394,21,0) ^.001^1^1^3101026^^^ "^DD",9002313.03,9002313.039201,394,21,1,0) This is used to store NCPDP field 394-MW (Benefit Stage Amount). "^DD",9002313.03,9002313.039201,394,"DT") 3101026 "^DD",9002313.03,9002313.1101,0) DUR PPS SUB-FIELD^^570^10 "^DD",9002313.03,9002313.1101,0,"DT") 3100901 "^DD",9002313.03,9002313.1101,0,"IX","B",9002313.1101,.01) "^DD",9002313.03,9002313.1101,0,"NM","DUR PPS") "^DD",9002313.03,9002313.1101,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.1101,.01,0) DUR PPS RESPONSE^NJ1,0^^0;1^K:+X'=X!(X>9)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.1101,.01,1,0) ^.1 "^DD",9002313.03,9002313.1101,.01,1,1,0) 9002313.1101^B "^DD",9002313.03,9002313.1101,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),567.01,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.1101,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),567.01,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.1101,.01,3) Type a number between 1 and 9, 0 Decimal Digits "^DD",9002313.03,9002313.1101,.01,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.1101,.01,21,1,0) Counter number for each DUR/PPS set/logical grouping. "^DD",9002313.03,9002313.1101,.01,"DT") 3080618 "^DD",9002313.03,9002313.1101,439,0) REASON FOR SERVICE CODE^FO^^0;2^K:$L(X)>2!($L(X)<1) X "^DD",9002313.03,9002313.1101,439,2) S Y(0)=Y S Y=$$TRANSCD^BPSECFM(Y) "^DD",9002313.03,9002313.1101,439,2.1) S Y=$$TRANSCD^BPSECFM(Y) "^DD",9002313.03,9002313.1101,439,3) Answer must be 1-2 characters in length. "^DD",9002313.03,9002313.1101,439,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.1101,439,21,1,0) Code identifying the type of utilization conflict detected or the reason "^DD",9002313.03,9002313.1101,439,21,2,0) for the pharmacist's professional service. "^DD",9002313.03,9002313.1101,439,"DT") 3080207 "^DD",9002313.03,9002313.1101,528,0) CLINICAL SIGNIFICANCE CODE^S^1:MAJOR;2:MODERATE;3:MINOR;9:UNDETERMINED;^0;3^Q "^DD",9002313.03,9002313.1101,528,3) Enter a code indicating the clinical significance. "^DD",9002313.03,9002313.1101,528,21,0) ^^2^2^3080617^ "^DD",9002313.03,9002313.1101,528,21,1,0) Code identifying the significance or severity level of a clinical event as "^DD",9002313.03,9002313.1101,528,21,2,0) contained in the originating data base. "^DD",9002313.03,9002313.1101,528,"DT") 3080617 "^DD",9002313.03,9002313.1101,529,0) OTHER PHARMACY INDICATOR^S^0:NOT SPECIFIED;1:YOUR PHARMACY;2:OTHER PHARMACY SAME CHAIN;3:OTHER PHARMACY;^0;4^Q "^DD",9002313.03,9002313.1101,529,3) Enter a code for the type of pharmacy dispensing the conflicting drug. "^DD",9002313.03,9002313.1101,529,21,0) ^^2^2^3080617^ "^DD",9002313.03,9002313.1101,529,21,1,0) Indicator telling whether the medication that caused the DUR to be "^DD",9002313.03,9002313.1101,529,21,2,0) triggered came from the current pharmacy, or an outside pharmacy. "^DD",9002313.03,9002313.1101,529,"DT") 3080617 "^DD",9002313.03,9002313.1101,530,0) PREVIOUS DATE OF FILL^FO^^0;5^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.1101,530,2) S Y(0)=Y S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.1101,530,2.1) S Y=$$FM3EXT^BPSOSU1(Y) "^DD",9002313.03,9002313.1101,530,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.1101,530,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.1101,530,21,1,0) Date prescription was previously filled. "^DD",9002313.03,9002313.1101,530,"DT") 3080618 "^DD",9002313.03,9002313.1101,531,0) QUANTITY OF PREVIOUS FILL^F^^0;6^K:$L(X)>12!($L(X)<1) X "^DD",9002313.03,9002313.1101,531,3) Answer must be 1-12 characters. "^DD",9002313.03,9002313.1101,531,21,0) ^.001^2^2^3101014^^^ "^DD",9002313.03,9002313.1101,531,21,1,0) This is used to store NCPDP field 531-FV (Quantity Of Previous Fill), "^DD",9002313.03,9002313.1101,531,21,2,0) which is defined as "Amount expressed in metric decimal units of the conflicting agent that was previously filled." "^DD",9002313.03,9002313.1101,531,23,0) ^.001^2^2^3101014^^ "^DD",9002313.03,9002313.1101,531,23,1,0) Format=9999999.999 "^DD",9002313.03,9002313.1101,531,23,2,0) RESPONSE DUR/PPS SEGMENT. "^DD",9002313.03,9002313.1101,531,"DT") 3100901 "^DD",9002313.03,9002313.1101,532,0) DATABASE INDICATOR^S^1:FIRST DATABANK;2:MEDI-SPAN PRODUCT LINE;3:MICROMEDEX/MEDICAL ECONOMICS;4:PROCESSOR DEVELOPED;5:OTHER;6:REDBOOK;7:MULTUM;^0;7^Q "^DD",9002313.03,9002313.1101,532,3) Enter a code identifying the source of DUR information. "^DD",9002313.03,9002313.1101,532,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.1101,532,21,1,0) Code identifying the source of drug information used for DUR processing. "^DD",9002313.03,9002313.1101,532,"DT") 3080618 "^DD",9002313.03,9002313.1101,533,0) OTHER PRESCRIBER INDICATOR^S^0:NOT SPECIFIED;1:SAME PRESCRIBER;2:OTHER PRESCRIBER;^0;8^Q "^DD",9002313.03,9002313.1101,533,3) Enter a code for the prescriber of the previously filled conflicting prescription. "^DD",9002313.03,9002313.1101,533,21,0) ^^2^2^3080618^ "^DD",9002313.03,9002313.1101,533,21,1,0) Code comparing the prescriber of the current prescription to the "^DD",9002313.03,9002313.1101,533,21,2,0) prescriber of the previously filled conflicting prescription. "^DD",9002313.03,9002313.1101,533,"DT") 3080618 "^DD",9002313.03,9002313.1101,544,0) DUR FREE TEXT MESSAGE^F^^0;9^K:$L(X)>30!($L(X)<1) X "^DD",9002313.03,9002313.1101,544,3) Answer must be 1-30 characters in length. "^DD",9002313.03,9002313.1101,544,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.1101,544,21,1,0) Text that provides additional detail regarding a DUR conflict. "^DD",9002313.03,9002313.1101,544,"DT") 3080207 "^DD",9002313.03,9002313.1101,570,0) DUR ADDITIONAL TEXT^F^^1;1^K:$L(X)>102!($L(X)<1) X "^DD",9002313.03,9002313.1101,570,3) Answer must be 1-102 characters. "^DD",9002313.03,9002313.1101,570,21,0) ^.001^2^2^3100929^^ "^DD",9002313.03,9002313.1101,570,21,1,0) This is used to store NCPDP field 570-NS (DUR Additional Text), "^DD",9002313.03,9002313.1101,570,21,2,0) which is defined as "Descriptive information that further defines the referenced DUR alert." "^DD",9002313.03,9002313.1101,570,"DT") 3100722 "^DD",9002313.03,9002313.13001,0) ADDITIONAL MESSAGE MLTPL SUB-FIELD^^526^4 "^DD",9002313.03,9002313.13001,0,"DT") 3100929 "^DD",9002313.03,9002313.13001,0,"IX","B",9002313.13001,.01) "^DD",9002313.03,9002313.13001,0,"NM","ADDITIONAL MESSAGE MLTPL") "^DD",9002313.03,9002313.13001,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.13001,.01,0) ADDITIONAL MESSAGE COUNTER^NJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.03,9002313.13001,.01,1,0) ^.1 "^DD",9002313.03,9002313.13001,.01,1,1,0) 9002313.13001^B "^DD",9002313.03,9002313.13001,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),130.01,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.13001,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),130.01,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.13001,.01,3) Type a number between 1 and 99, 0 decimal digits. "^DD",9002313.03,9002313.13001,.01,21,0) ^.001^1^1^3101020^^^^ "^DD",9002313.03,9002313.13001,.01,21,1,0) This is a sequential counter of the Additional Message occurrences. "^DD",9002313.03,9002313.13001,.01,23,0) ^.001^1^1^3101020^^^^ "^DD",9002313.03,9002313.13001,.01,23,1,0) Counter incremented by BPS* software. "^DD",9002313.03,9002313.13001,.01,"DT") 3100722 "^DD",9002313.03,9002313.13001,131,0) ADDITIONAL MSG INFO CONTINUITY^F^^0;2^K:$L(X)>3!($L(X)<1) X "^DD",9002313.03,9002313.13001,131,.1) ADDITIONAL MESSAGE INFORMATION CONTINUITY "^DD",9002313.03,9002313.13001,131,3) Answer must be 1-3 characters. "^DD",9002313.03,9002313.13001,131,21,0) ^.001^1^1^3101019^^^^ "^DD",9002313.03,9002313.13001,131,21,1,0) This is used to store NCPDP field 131-UG (Additional Message Information Continuity). "^DD",9002313.03,9002313.13001,131,23,0) ^.001^1^1^3101019^^^^ "^DD",9002313.03,9002313.13001,131,23,1,0) RESPONSE STATUS SEGMENT. "^DD",9002313.03,9002313.13001,131,"DT") 3100929 "^DD",9002313.03,9002313.13001,132,0) ADDITIONAL MSG INFO QUALIFIER^F^^0;3^K:$L(X)>4!($L(X)<1) X "^DD",9002313.03,9002313.13001,132,.1) ADDITIONAL MESSAGE INFORMATION QUALIFIER "^DD",9002313.03,9002313.13001,132,3) Answer must be 1-4 characters. "^DD",9002313.03,9002313.13001,132,21,0) ^.001^1^1^3101019^^^^ "^DD",9002313.03,9002313.13001,132,21,1,0) This is used to store NCPDP field 132-UH (Additional Message Information Qualifier). "^DD",9002313.03,9002313.13001,132,23,0) ^.001^2^2^3101019^^^ "^DD",9002313.03,9002313.13001,132,23,1,0) Qualifies Additional Message Information (526-FQ). "^DD",9002313.03,9002313.13001,132,23,2,0) RESPONSE STATUS SEGMENT. "^DD",9002313.03,9002313.13001,132,"DT") 3100929 "^DD",9002313.03,9002313.13001,526,0) ADDITIONAL MESSAGE INFO^F^^1;1^K:$L(X)>250!($L(X)<1) X "^DD",9002313.03,9002313.13001,526,.1) ADDITIONAL MESSAGE INFORMATION "^DD",9002313.03,9002313.13001,526,3) Answer must be 1-250 characters. "^DD",9002313.03,9002313.13001,526,21,0) ^.001^1^1^3101019^^^^ "^DD",9002313.03,9002313.13001,526,21,1,0) This is used to store NCPDP field 526-FQ (Additional Message Information). "^DD",9002313.03,9002313.13001,526,23,0) ^.001^1^1^3101019^^^ "^DD",9002313.03,9002313.13001,526,23,1,0) RESPONSE STATUS SEGMENT. "^DD",9002313.03,9002313.13001,526,"DT") 3100929 "^DD",9002313.03,9002313.1301,0) PREFERRED PRODUCT REPEATING SUB-FIELD^^556^6 "^DD",9002313.03,9002313.1301,0,"DT") 3080618 "^DD",9002313.03,9002313.1301,0,"IX","B",9002313.1301,.01) "^DD",9002313.03,9002313.1301,0,"NM","PREFERRED PRODUCT REPEATING") "^DD",9002313.03,9002313.1301,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.1301,.01,0) PREFERRED PRODUCT COUNTER^NJ1,0^^0;1^K:+X'=X!(X>9)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.1301,.01,1,0) ^.1 "^DD",9002313.03,9002313.1301,.01,1,1,0) 9002313.1301^B "^DD",9002313.03,9002313.1301,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),551.01,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.1301,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),551.01,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.1301,.01,3) Type a number between 1 and 9, 0 Decimal Digits "^DD",9002313.03,9002313.1301,.01,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.1301,.01,21,1,0) Sequential counter of the Preferred Product occurrences. "^DD",9002313.03,9002313.1301,.01,"DT") 3080618 "^DD",9002313.03,9002313.1301,552,0) PREFERRED PRODUCT ID QUALIFIER^F^^1;1^K:$L(X)>2!($L(X)<1) X "^DD",9002313.03,9002313.1301,552,3) Answer must be 1-2 characters in length. "^DD",9002313.03,9002313.1301,552,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.1301,552,21,1,0) Code qualifying the type of product ID submitted in 'Preferred Product ID' "^DD",9002313.03,9002313.1301,552,21,2,0) (553). "^DD",9002313.03,9002313.1301,552,"DT") 3080207 "^DD",9002313.03,9002313.1301,553,0) PREFERRED PRODUCT ID^F^^1;2^K:$L(X)>19!($L(X)<1) X "^DD",9002313.03,9002313.1301,553,3) Answer must be 1-19 characters in length. "^DD",9002313.03,9002313.1301,553,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.1301,553,21,1,0) Alternate product recommended by the plan. "^DD",9002313.03,9002313.1301,553,"DT") 3080207 "^DD",9002313.03,9002313.1301,554,0) PREFERRED PRODUCT INCENTIVE^FO^^1;3^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.1301,554,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.1301,554,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.1301,554,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.1301,554,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.1301,554,21,1,0) Amount of pharmacy incentive available for substitution of preferred "^DD",9002313.03,9002313.1301,554,21,2,0) product. "^DD",9002313.03,9002313.1301,554,"DT") 3080207 "^DD",9002313.03,9002313.1301,555,0) PREFRD PRODUCT COPAY INCENTIVE^FO^^1;4^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.1301,555,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.1301,555,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.1301,555,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.1301,555,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.1301,555,21,1,0) Amount of patient's copay/cost-share incentive for preferred product. "^DD",9002313.03,9002313.1301,555,"DT") 3080207 "^DD",9002313.03,9002313.1301,556,0) PREFERRED PRODUCT DESCRIPTION^F^^1;5^K:$L(X)>40!($L(X)<1) X "^DD",9002313.03,9002313.1301,556,3) Answer must be 1-40 characters in length. "^DD",9002313.03,9002313.1301,556,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.1301,556,21,1,0) Free text message. "^DD",9002313.03,9002313.1301,556,"DT") 3080207 "^DD",9002313.03,9002313.1401,0) OTHER AMOUNTS PAID SUB-FIELD^^565^3 "^DD",9002313.03,9002313.1401,0,"DT") 3080618 "^DD",9002313.03,9002313.1401,0,"IX","B",9002313.1401,.01) "^DD",9002313.03,9002313.1401,0,"NM","OTHER AMOUNTS PAID") "^DD",9002313.03,9002313.1401,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.1401,.01,0) OTHER AMOUNT PAID COUNTER^NJ1,0^^0;1^K:+X'=X!(X>9)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.03,9002313.1401,.01,1,0) ^.1 "^DD",9002313.03,9002313.1401,.01,1,1,0) 9002313.1401^B "^DD",9002313.03,9002313.1401,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),563.01,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.1401,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),563.01,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.1401,.01,3) Type a number between 1 and 9, 0 Decimal Digits "^DD",9002313.03,9002313.1401,.01,21,0) ^^1^1^3080618^ "^DD",9002313.03,9002313.1401,.01,21,1,0) Count of the other amount paid occurrences. "^DD",9002313.03,9002313.1401,.01,"DT") 3080618 "^DD",9002313.03,9002313.1401,564,0) OTHER AMOUNT PAID QUALIFIER^F^^1;1^K:$L(X)>2!($L(X)<1) X "^DD",9002313.03,9002313.1401,564,3) Answer must be 1-2 characters in length. "^DD",9002313.03,9002313.1401,564,21,0) ^^1^1^3080207^ "^DD",9002313.03,9002313.1401,564,21,1,0) Code clarifying the value in the 'Other Amount Paid' (565). "^DD",9002313.03,9002313.1401,564,"DT") 3080207 "^DD",9002313.03,9002313.1401,565,0) OTHER AMOUNT PAID^FO^^1;2^K:$L(X)>8!($L(X)<8) X "^DD",9002313.03,9002313.1401,565,2) S Y(0)=Y S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.1401,565,2.1) S Y="$"_$J($$DFF2EXT^BPSECFM(Y),7,2) "^DD",9002313.03,9002313.1401,565,3) Answer must be 8 characters in length. "^DD",9002313.03,9002313.1401,565,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.1401,565,21,1,0) Amount paid for additional costs claimed in 'Other Amount Claimed "^DD",9002313.03,9002313.1401,565,21,2,0) Submitted' (48Ø). "^DD",9002313.03,9002313.1401,565,"DT") 3080207 "^DD",9002313.03,9002313.301548,0) APPROVED MESSAGE CODE SUB-FIELD^^.01^1 "^DD",9002313.03,9002313.301548,0,"DT") 3020808 "^DD",9002313.03,9002313.301548,0,"IX","B",9002313.301548,.01) "^DD",9002313.03,9002313.301548,0,"NM","APPROVED MESSAGE CODE") "^DD",9002313.03,9002313.301548,0,"UP") 9002313.0301 "^DD",9002313.03,9002313.301548,.01,0) APPROVED MESSAGE CODE^F^^0;1^K:$L(X)>3!($L(X)<1) X "^DD",9002313.03,9002313.301548,.01,1,0) ^.1 "^DD",9002313.03,9002313.301548,.01,1,1,0) 9002313.301548^B "^DD",9002313.03,9002313.301548,.01,1,1,1) S ^BPSR(DA(2),1000,DA(1),548,"B",$E(X,1,30),DA)="" "^DD",9002313.03,9002313.301548,.01,1,1,2) K ^BPSR(DA(2),1000,DA(1),548,"B",$E(X,1,30),DA) "^DD",9002313.03,9002313.301548,.01,3) Answer must be 1-3 characters in length. "^DD",9002313.03,9002313.301548,.01,21,0) ^^2^2^3080207^ "^DD",9002313.03,9002313.301548,.01,21,1,0) Message code, on an approved claim/service, communicating the need for an "^DD",9002313.03,9002313.301548,.01,21,2,0) additional follow-up. "^DD",9002313.03,9002313.301548,.01,"DT") 3080207 "^DD",9002313.03,9002313.39999,0) RAW DATA RECEIVED SUB-FIELD^^.01^1 "^DD",9002313.03,9002313.39999,0,"DT") 3000830 "^DD",9002313.03,9002313.39999,0,"NM","RAW DATA RECEIVED") "^DD",9002313.03,9002313.39999,0,"UP") 9002313.03 "^DD",9002313.03,9002313.39999,.01,0) RAW DATA RECEIVED^WL^^0;1^Q "^DD",9002313.03,9002313.39999,.01,21,0) ^^3^3^3080618^ "^DD",9002313.03,9002313.39999,.01,21,1,0) A copy of the raw data packet received. This could be of use in diagnosing "^DD",9002313.03,9002313.39999,.01,21,2,0) weird problems, such as the time a packet was apparently shifted two "^DD",9002313.03,9002313.39999,.01,21,3,0) places. "^DD",9002313.03,9002313.39999,.01,"DT") 3080618 "^DD",9002313.15,9002313.15,.04,0) PROBER CLAIM^P9002313.59'^BPST(^0;4^Q "^DD",9002313.15,9002313.15,.04,3) Enter the prober transaction to use for the retry. "^DD",9002313.15,9002313.15,.04,21,0) ^^2^2^3110318^ "^DD",9002313.15,9002313.15,.04,21,1,0) This is the transaction in the BPS TRANSACTION file that will be used to "^DD",9002313.15,9002313.15,.04,21,2,0) probe the payer to see if they are no longer asleep. "^DD",9002313.15,9002313.15,.04,"DT") 3110318 "^DD",9002313.19,9002313.19,0) FIELD^^.03^3 "^DD",9002313.19,9002313.19,0,"DDA") N "^DD",9002313.19,9002313.19,0,"DT") 3100930 "^DD",9002313.19,9002313.19,0,"ID",.02) W " ",$P(^(0),U,2) "^DD",9002313.19,9002313.19,0,"IX","B",9002313.19,.01) "^DD",9002313.19,9002313.19,0,"NM","BPS NCPDP PATIENT RELATIONSHIP CODE") "^DD",9002313.19,9002313.19,.01,0) CODE^RNJ1,0^^0;1^K:+X'=X!(X>4)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.19,9002313.19,.01,1,0) ^.1 "^DD",9002313.19,9002313.19,.01,1,1,0) 9002313.19^B "^DD",9002313.19,9002313.19,.01,1,1,1) S ^BPS(9002313.19,"B",$E(X,1,30),DA)="" "^DD",9002313.19,9002313.19,.01,1,1,2) K ^BPS(9002313.19,"B",$E(X,1,30),DA) "^DD",9002313.19,9002313.19,.01,3) Type a number between 0 and 4. "^DD",9002313.19,9002313.19,.01,21,0) ^^1^1^3101020^ "^DD",9002313.19,9002313.19,.01,21,1,0) This is the NCPDP standard PATIENT RELATIONSHIP CODE. "^DD",9002313.19,9002313.19,.01,"DT") 3101020 "^DD",9002313.19,9002313.19,.02,0) BRIEF DESCRIPTION^F^^0;2^K:$L(X)>30!($L(X)<1) X "^DD",9002313.19,9002313.19,.02,3) Enter a brief description (up to 30 characters) of the Patient Relationship code. "^DD",9002313.19,9002313.19,.02,21,0) ^^2^2^3101020^ "^DD",9002313.19,9002313.19,.02,21,1,0) This is the brief description of the NCPDP standard Patient Relationship "^DD",9002313.19,9002313.19,.02,21,2,0) Code. "^DD",9002313.19,9002313.19,.02,"DT") 3101020 "^DD",9002313.19,9002313.19,.03,0) FULL DESCRIPTION^9002313.191^^1;0 "^DD",9002313.19,9002313.19,.03,21,0) ^^2^2^3101020^ "^DD",9002313.19,9002313.19,.03,21,1,0) This is the full description for the Patient Relationship Code from the "^DD",9002313.19,9002313.19,.03,21,2,0) NCPDP standard. "^DD",9002313.19,9002313.191,0) FULL DESCRIPTION SUB-FIELD^^.01^1 "^DD",9002313.19,9002313.191,0,"DT") 3100930 "^DD",9002313.19,9002313.191,0,"NM","FULL DESCRIPTION") "^DD",9002313.19,9002313.191,0,"UP") 9002313.19 "^DD",9002313.19,9002313.191,.01,0) FULL DESCRIPTION^Wx^^0;1 "^DD",9002313.19,9002313.191,.01,3) Enter the full description as stated in the NCPDP standard. "^DD",9002313.19,9002313.191,.01,21,0) ^^2^2^3101020^ "^DD",9002313.19,9002313.191,.01,21,1,0) This is the full description for the Patient Relationship Code from the "^DD",9002313.19,9002313.191,.01,21,2,0) NCPDP standard. "^DD",9002313.19,9002313.191,.01,"DT") 3101020 "^DD",9002313.21,9002313.21,0) FIELD^^1^2 "^DD",9002313.21,9002313.21,0,"DDA") N "^DD",9002313.21,9002313.21,0,"DT") 3050509 "^DD",9002313.21,9002313.21,0,"ID",1) W " ",$P(^(0),U,2) "^DD",9002313.21,9002313.21,0,"IX","B",9002313.21,.01) "^DD",9002313.21,9002313.21,0,"NM","BPS NCPDP PROFESSIONAL SERVICE CODE") "^DD",9002313.21,9002313.21,0,"VRPK") BPS "^DD",9002313.21,9002313.21,.01,0) CODE^RF^^0;1^K:$L(X)>5!($L(X)<1)!'(X'?1P.E) X "^DD",9002313.21,9002313.21,.01,1,0) ^.1 "^DD",9002313.21,9002313.21,.01,1,1,0) 9002313.21^B "^DD",9002313.21,9002313.21,.01,1,1,1) S ^BPS(9002313.21,"B",$E(X,1,30),DA)="" "^DD",9002313.21,9002313.21,.01,1,1,2) K ^BPS(9002313.21,"B",$E(X,1,30),DA) "^DD",9002313.21,9002313.21,.01,3) Answer must be 1-5 characters in length "^DD",9002313.21,9002313.21,.01,21,0) ^^2^2^3050624^ "^DD",9002313.21,9002313.21,.01,21,1,0) Code identifying pharmacist intervention when a conflict code has been identified or service has been "^DD",9002313.21,9002313.21,.01,21,2,0) rendered. "^DD",9002313.21,9002313.21,.01,"DT") 3050509 "^DD",9002313.21,9002313.21,1,0) DESCRIPTION^F^^0;2^K:$L(X)>50!($L(X)<1) X "^DD",9002313.21,9002313.21,1,3) Answer must be 1-50 characters in length "^DD",9002313.21,9002313.21,1,21,0) ^.001^1^1^3050624^^ "^DD",9002313.21,9002313.21,1,21,1,0) Description of the NCPDP PROFESSIONAL SERVICE CODE use to override DUR rejects (e.g., PHARMACIST CONSULTED OTHER SOURCE,PRESCRIBER CONSULTED). "^DD",9002313.21,9002313.21,1,"DT") 3050509 "^DD",9002313.22,9002313.22,0) FIELD^^1^2 "^DD",9002313.22,9002313.22,0,"DDA") N "^DD",9002313.22,9002313.22,0,"DT") 3050509 "^DD",9002313.22,9002313.22,0,"ID",1) W " ",$P(^(0),U,2) "^DD",9002313.22,9002313.22,0,"IX","B",9002313.22,.01) "^DD",9002313.22,9002313.22,0,"NM","BPS NCPDP RESULT OF SERVICE CODE") "^DD",9002313.22,9002313.22,0,"VRPK") BPS "^DD",9002313.22,9002313.22,.01,0) CODE^RF^^0;1^K:$L(X)>5!($L(X)<1)!'(X'?1P.E) X "^DD",9002313.22,9002313.22,.01,1,0) ^.1 "^DD",9002313.22,9002313.22,.01,1,1,0) 9002313.22^B "^DD",9002313.22,9002313.22,.01,1,1,1) S ^BPS(9002313.22,"B",$E(X,1,30),DA)="" "^DD",9002313.22,9002313.22,.01,1,1,2) K ^BPS(9002313.22,"B",$E(X,1,30),DA) "^DD",9002313.22,9002313.22,.01,3) Answer must be 1-5 characters in length "^DD",9002313.22,9002313.22,.01,21,0) ^.001^1^1^3050624^^^ "^DD",9002313.22,9002313.22,.01,21,1,0) Action taken by a pharmacist in response to a conflict or the result of a pharmacist's professional service. "^DD",9002313.22,9002313.22,.01,"DT") 3050509 "^DD",9002313.22,9002313.22,1,0) DESCRIPTION^F^^0;2^K:$L(X)>50!($L(X)<1) X "^DD",9002313.22,9002313.22,1,3) Answer must be 1-50 characters in length "^DD",9002313.22,9002313.22,1,21,0) ^^1^1^3050624^ "^DD",9002313.22,9002313.22,1,21,1,0) Description of the NCPDP RESULT OF SERVICE CODE used to override DUR rejects (e.g., FILLED, WITH DIFFERENT DOSAGE FORM,THERAPY CHANGED) "^DD",9002313.22,9002313.22,1,"DT") 3050509 "^DD",9002313.23,9002313.23,0) FIELD^^1^2 "^DD",9002313.23,9002313.23,0,"DDA") N "^DD",9002313.23,9002313.23,0,"DT") 3050512 "^DD",9002313.23,9002313.23,0,"ID",1) W " ",$P(^(0),U,2) "^DD",9002313.23,9002313.23,0,"IX","B",9002313.23,.01) "^DD",9002313.23,9002313.23,0,"NM","BPS NCPDP REASON FOR SERVICE CODE") "^DD",9002313.23,9002313.23,0,"VRPK") BPS "^DD",9002313.23,9002313.23,.01,0) CODE^RF^^0;1^K:$L(X)>5!($L(X)<1)!'(X'?1P.E) X "^DD",9002313.23,9002313.23,.01,1,0) ^.1 "^DD",9002313.23,9002313.23,.01,1,1,0) 9002313.23^B "^DD",9002313.23,9002313.23,.01,1,1,1) S ^BPS(9002313.23,"B",$E(X,1,30),DA)="" "^DD",9002313.23,9002313.23,.01,1,1,2) K ^BPS(9002313.23,"B",$E(X,1,30),DA) "^DD",9002313.23,9002313.23,.01,3) Answer must be 1-5 characters in length "^DD",9002313.23,9002313.23,.01,21,0) ^^1^1^3050624^ "^DD",9002313.23,9002313.23,.01,21,1,0) Code identifying the type of utilization conflict detected or the reason for the pharmacist's professional service. "^DD",9002313.23,9002313.23,.01,"DT") 3050512 "^DD",9002313.23,9002313.23,1,0) DESCRIPTION^F^^0;2^K:$L(X)>60!($L(X)<1) X "^DD",9002313.23,9002313.23,1,3) Answer must be 1-60 characters in length "^DD",9002313.23,9002313.23,1,21,0) ^.001^1^1^3050624^^ "^DD",9002313.23,9002313.23,1,21,1,0) Description of the NCPDP REASON FOR SERVICE CODE used to override DUR rejects (e.g., SUBOPTIMAL DRUG/INDICATION, LABORATORY TEST NEEDED). "^DD",9002313.23,9002313.23,1,"DT") 3050624 "^DD",9002313.24,9002313.24,0) FIELD^^1^2 "^DD",9002313.24,9002313.24,0,"DDA") N "^DD",9002313.24,9002313.24,0,"DT") 3050627 "^DD",9002313.24,9002313.24,0,"ID",1) W " ",$P(^(0),U,2) "^DD",9002313.24,9002313.24,0,"IX","B",9002313.24,.01) "^DD",9002313.24,9002313.24,0,"NM","BPS NCPDP DAW CODE") "^DD",9002313.24,9002313.24,0,"VRPK") BPS "^DD",9002313.24,9002313.24,.01,0) CODE^RF^^0;1^K:$L(X)>2!($L(X)<1)!'(X'?1P.E) X "^DD",9002313.24,9002313.24,.01,1,0) ^.1 "^DD",9002313.24,9002313.24,.01,1,1,0) 9002313.24^B "^DD",9002313.24,9002313.24,.01,1,1,1) S ^BPS(9002313.24,"B",$E(X,1,30),DA)="" "^DD",9002313.24,9002313.24,.01,1,1,2) K ^BPS(9002313.24,"B",$E(X,1,30),DA) "^DD",9002313.24,9002313.24,.01,3) Answer must be 1-2 characters in length "^DD",9002313.24,9002313.24,.01,21,0) ^^1^1^3050627^ "^DD",9002313.24,9002313.24,.01,21,1,0) Code indicating whether or not the prescriber's instructions regarding generic substitution were followed. "^DD",9002313.24,9002313.24,.01,"DT") 3050627 "^DD",9002313.24,9002313.24,1,0) DESCRIPTION^F^^0;2^K:$L(X)>100!($L(X)<1) X "^DD",9002313.24,9002313.24,1,3) Answer must be 1-100 characters in length "^DD",9002313.24,9002313.24,1,21,0) ^^1^1^3050627^ "^DD",9002313.24,9002313.24,1,21,1,0) Description of the DAW code (e.g., SUBSTITUTION NOT ALLOWED BY PRESCRIBER). "^DD",9002313.24,9002313.24,1,"DT") 3050627 "^DD",9002313.26,9002313.26,0) FIELD^^.03^3 "^DD",9002313.26,9002313.26,0,"DDA") N "^DD",9002313.26,9002313.26,0,"DT") 3101105 "^DD",9002313.26,9002313.26,0,"ID",.02) W " ",$P(^(0),U,2) "^DD",9002313.26,9002313.26,0,"IX","B",9002313.26,.01) "^DD",9002313.26,9002313.26,0,"NM","BPS NCPDP PRIOR AUTHORIZATION TYPE CODE") "^DD",9002313.26,9002313.26,0,"VRPK") BPS "^DD",9002313.26,9002313.26,.01,0) CODE^RNJ2,0^^0;1^K:+X'=X!(X>99)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.26,9002313.26,.01,1,0) ^.1 "^DD",9002313.26,9002313.26,.01,1,1,0) 9002313.26^B "^DD",9002313.26,9002313.26,.01,1,1,1) S ^BPS(9002313.26,"B",$E(X,1,30),DA)="" "^DD",9002313.26,9002313.26,.01,1,1,2) K ^BPS(9002313.26,"B",$E(X,1,30),DA) "^DD",9002313.26,9002313.26,.01,3) Enter the NCPDP code that will be submitted for the prior auth. "^DD",9002313.26,9002313.26,.01,21,0) ^^2^2^3080312^ "^DD",9002313.26,9002313.26,.01,21,1,0) This is the code that is transmitted to the payer for the prior "^DD",9002313.26,9002313.26,.01,21,2,0) authorization type. "^DD",9002313.26,9002313.26,.01,"DT") 3080312 "^DD",9002313.26,9002313.26,.02,0) BRIEF DESCRIPTION^F^^0;2^K:$L(X)>40!($L(X)<1) X "^DD",9002313.26,9002313.26,.02,3) Enter a brief description of 1-40 characters in length. "^DD",9002313.26,9002313.26,.02,21,0) ^.001^2^2^3100816^^ "^DD",9002313.26,9002313.26,.02,21,1,0) This is the brief description of the code that is defined in the NCPDP "^DD",9002313.26,9002313.26,.02,21,2,0) standard. "^DD",9002313.26,9002313.26,.02,"DT") 3101105 "^DD",9002313.26,9002313.26,.03,0) FULL DESCRIPTION^9002313.261^^1;0 "^DD",9002313.26,9002313.26,.03,3) Enter the full description for the Prior Auth Type Code. "^DD",9002313.26,9002313.26,.03,21,0) ^^1^1^3080616^^ "^DD",9002313.26,9002313.26,.03,21,1,0) This is the full description of the code as stated in the NCPDP standards. "^DD",9002313.26,9002313.261,0) FULL DESCRIPTION SUB-FIELD^^.01^1 "^DD",9002313.26,9002313.261,0,"DT") 3080312 "^DD",9002313.26,9002313.261,0,"NM","FULL DESCRIPTION") "^DD",9002313.26,9002313.261,0,"UP") 9002313.26 "^DD",9002313.26,9002313.261,.01,0) FULL DESCRIPTION^Wx^^0;1 "^DD",9002313.26,9002313.261,.01,3) Enter the full description for the Prior Auth Type Code "^DD",9002313.26,9002313.261,.01,"DT") 3080616 "^DD",9002313.27,9002313.27,0) FIELD^^.03^3 "^DD",9002313.27,9002313.27,0,"DDA") N "^DD",9002313.27,9002313.27,0,"DT") 3101014 "^DD",9002313.27,9002313.27,0,"ID",.02) W " ",$P(^(0),U,2) "^DD",9002313.27,9002313.27,0,"IX","B",9002313.27,.01) "^DD",9002313.27,9002313.27,0,"NM","BPS NCPDP PATIENT RESIDENCE CODE") "^DD",9002313.27,9002313.27,.01,0) CODE^RNJ2,0^^0;1^K:+X'=X!(X>15)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.27,9002313.27,.01,1,0) ^.1 "^DD",9002313.27,9002313.27,.01,1,1,0) 9002313.27^B "^DD",9002313.27,9002313.27,.01,1,1,1) S ^BPS(9002313.27,"B",$E(X,1,30),DA)="" "^DD",9002313.27,9002313.27,.01,1,1,2) K ^BPS(9002313.27,"B",$E(X,1,30),DA) "^DD",9002313.27,9002313.27,.01,3) Type a code number between 0 and 15. "^DD",9002313.27,9002313.27,.01,21,0) ^^2^2^3101020^ "^DD",9002313.27,9002313.27,.01,21,1,0) This is the NCPDP standard code identifying the patient's place of "^DD",9002313.27,9002313.27,.01,21,2,0) residence. "^DD",9002313.27,9002313.27,.01,"DT") 3101020 "^DD",9002313.27,9002313.27,.02,0) BRIEF DESCRIPTION^RF^^0;2^K:$L(X)>30!($L(X)<1) X "^DD",9002313.27,9002313.27,.02,3) Enter a brief description (up to 30 characters) of the Patient Residence code. "^DD",9002313.27,9002313.27,.02,21,0) ^^1^1^3101020^ "^DD",9002313.27,9002313.27,.02,21,1,0) This is a short description of the NCPDP code meaning. "^DD",9002313.27,9002313.27,.02,"DT") 3101020 "^DD",9002313.27,9002313.27,.03,0) FULL DESCRIPTION^9002313.271^^1;0 "^DD",9002313.27,9002313.27,.03,21,0) ^^2^2^3101020^ "^DD",9002313.27,9002313.27,.03,21,1,0) This is the full description for the Patient Residence Code from the NCPDP "^DD",9002313.27,9002313.27,.03,21,2,0) standard. "^DD",9002313.27,9002313.271,0) FULL DESCRIPTION SUB-FIELD^^.01^1 "^DD",9002313.27,9002313.271,0,"DT") 3100817 "^DD",9002313.27,9002313.271,0,"NM","FULL DESCRIPTION") "^DD",9002313.27,9002313.271,0,"UP") 9002313.27 "^DD",9002313.27,9002313.271,.01,0) FULL DESCRIPTION^Wx^^0;1^Q "^DD",9002313.27,9002313.271,.01,3) Enter the full description for the Patient Residence Code. "^DD",9002313.27,9002313.271,.01,21,0) ^^2^2^3101020^ "^DD",9002313.27,9002313.271,.01,21,1,0) This is the full description for the Patient Residence Code from the NCPDP "^DD",9002313.27,9002313.271,.01,21,2,0) standard. "^DD",9002313.27,9002313.271,.01,"DT") 3101020 "^DD",9002313.28,9002313.28,0) FIELD^^.03^3 "^DD",9002313.28,9002313.28,0,"DDA") N "^DD",9002313.28,9002313.28,0,"DT") 3100818 "^DD",9002313.28,9002313.28,0,"ID",.02) W " ",$P(^(0),U,2) "^DD",9002313.28,9002313.28,0,"IX","B",9002313.28,.01) "^DD",9002313.28,9002313.28,0,"NM","BPS NCPDP PHARMACY SERVICE TYPE") "^DD",9002313.28,9002313.28,.01,0) CODE^RNJ2,0^^0;1^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.28,9002313.28,.01,.1) "^DD",9002313.28,9002313.28,.01,1,0) ^.1 "^DD",9002313.28,9002313.28,.01,1,1,0) 9002313.28^B "^DD",9002313.28,9002313.28,.01,1,1,1) S ^BPS(9002313.28,"B",$E(X,1,30),DA)="" "^DD",9002313.28,9002313.28,.01,1,1,2) K ^BPS(9002313.28,"B",$E(X,1,30),DA) "^DD",9002313.28,9002313.28,.01,3) Enter a value between 1 and 99. "^DD",9002313.28,9002313.28,.01,21,0) ^^1^1^3101020^ "^DD",9002313.28,9002313.28,.01,21,1,0) This is the NCPDP standard Pharmacy Service Type Code. "^DD",9002313.28,9002313.28,.01,"DT") 3101022 "^DD",9002313.28,9002313.28,.02,0) BRIEF DESCRIPTION^F^^0;2^K:$L(X)>30!($L(X)<1) X "^DD",9002313.28,9002313.28,.02,3) Enter a brief description (up to 30 characters) of the Pharmacy Service Type code. "^DD",9002313.28,9002313.28,.02,21,0) ^^1^1^3101020^ "^DD",9002313.28,9002313.28,.02,21,1,0) This is the brief description of Pharmacy Service Type code. "^DD",9002313.28,9002313.28,.02,"DT") 3101020 "^DD",9002313.28,9002313.28,.03,0) FULL DESCRIPTION^9002313.281^^1;0 "^DD",9002313.28,9002313.28,.03,21,0) ^^2^2^3101020^ "^DD",9002313.28,9002313.28,.03,21,1,0) This is the full description of the Pharmacy Service Type Code as stated "^DD",9002313.28,9002313.28,.03,21,2,0) in the NCPDP standard. "^DD",9002313.28,9002313.281,0) FULL DESCRIPTION SUB-FIELD^^.01^1 "^DD",9002313.28,9002313.281,0,"DT") 3100818 "^DD",9002313.28,9002313.281,0,"NM","FULL DESCRIPTION") "^DD",9002313.28,9002313.281,0,"UP") 9002313.28 "^DD",9002313.28,9002313.281,.01,0) FULL DESCRIPTION^Wx^^0;1 "^DD",9002313.28,9002313.281,.01,3) Enter the full description of the code as stated in the NCPDP standard. "^DD",9002313.28,9002313.281,.01,21,0) ^^2^2^3101020^ "^DD",9002313.28,9002313.281,.01,21,1,0) This is the full description of the Pharmacy Service Type Code as stated "^DD",9002313.28,9002313.281,.01,21,2,0) in the NCPDP standard. "^DD",9002313.28,9002313.281,.01,"DT") 3101020 "^DD",9002313.29,9002313.29,0) FIELD^^.03^3 "^DD",9002313.29,9002313.29,0,"DDA") N "^DD",9002313.29,9002313.29,0,"DT") 3100819 "^DD",9002313.29,9002313.29,0,"ID",.02) W " ",$P(^(0),U,2) "^DD",9002313.29,9002313.29,0,"IX","B",9002313.29,.01) "^DD",9002313.29,9002313.29,0,"NM","BPS NCPDP DELAY REASON CODE") "^DD",9002313.29,9002313.29,0,"PT",9002313.77,2.1) "^DD",9002313.29,9002313.29,.01,0) CODE^RNJ2,0^^0;1^K:+X'=X!(X>14)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.29,9002313.29,.01,1,0) ^.1 "^DD",9002313.29,9002313.29,.01,1,1,0) 9002313.29^B "^DD",9002313.29,9002313.29,.01,1,1,1) S ^BPS(9002313.29,"B",$E(X,1,30),DA)="" "^DD",9002313.29,9002313.29,.01,1,1,2) K ^BPS(9002313.29,"B",$E(X,1,30),DA) "^DD",9002313.29,9002313.29,.01,3) Enter a NCPDP code number between 1 and 14. "^DD",9002313.29,9002313.29,.01,21,0) ^^1^1^3101020^ "^DD",9002313.29,9002313.29,.01,21,1,0) This is the NCPDP standard code identifying the delay reason. "^DD",9002313.29,9002313.29,.01,"DT") 3101020 "^DD",9002313.29,9002313.29,.02,0) BRIEF DESCRIPTION^F^^0;2^K:$L(X)>30!($L(X)<1) X "^DD",9002313.29,9002313.29,.02,3) Enter a brief description (up to 30 characters) of the Delay Reason code. "^DD",9002313.29,9002313.29,.02,21,0) ^^2^2^3101020^ "^DD",9002313.29,9002313.29,.02,21,1,0) This is the brief description of the Delay Reason Code that is defined in "^DD",9002313.29,9002313.29,.02,21,2,0) the NCPDP standard. "^DD",9002313.29,9002313.29,.02,"DT") 3101020 "^DD",9002313.29,9002313.29,.03,0) FULL DESCRIPTION^9002313.291^^1;0 "^DD",9002313.29,9002313.29,.03,21,0) ^^2^2^3101020^ "^DD",9002313.29,9002313.29,.03,21,1,0) This is the full description of the Delay Reason Code from the NCPDP "^DD",9002313.29,9002313.29,.03,21,2,0) standard. "^DD",9002313.29,9002313.291,0) FULL DESCRIPTION SUB-FIELD^^.01^1 "^DD",9002313.29,9002313.291,0,"DT") 3100819 "^DD",9002313.29,9002313.291,0,"NM","FULL DESCRIPTION") "^DD",9002313.29,9002313.291,0,"UP") 9002313.29 "^DD",9002313.29,9002313.291,.01,0) FULL DESCRIPTION^Wx^^0;1 "^DD",9002313.29,9002313.291,.01,3) Enter the full description for the Delay Reason Code. "^DD",9002313.29,9002313.291,.01,21,0) ^^2^2^3101020^ "^DD",9002313.29,9002313.291,.01,21,1,0) This is the full description of the Delay Reason Code from the NCPDP "^DD",9002313.29,9002313.291,.01,21,2,0) standard. "^DD",9002313.29,9002313.291,.01,"DT") 3101020 "^DD",9002313.31,9002313.31,.04,0) BILLING PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;4^Q "^DD",9002313.31,9002313.31,.04,3) Enter the billing payer sheet to be used for this certification claim. "^DD",9002313.31,9002313.31,.04,21,0) ^^2^2^3110104^ "^DD",9002313.31,9002313.31,.04,21,1,0) This is the payer sheet to be used for Certification Testing when the test "^DD",9002313.31,9002313.31,.04,21,2,0) claim is a billing request. "^DD",9002313.31,9002313.31,.04,"DT") 3110105 "^DD",9002313.31,9002313.31,.05,0) REVERSAL PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;5^Q "^DD",9002313.31,9002313.31,.05,3) Enter the reversal payer sheet used for certification testing. "^DD",9002313.31,9002313.31,.05,21,0) ^^2^2^3110104^ "^DD",9002313.31,9002313.31,.05,21,1,0) This is the payer sheet that will be used for certification testing when "^DD",9002313.31,9002313.31,.05,21,2,0) the test is a reversal. "^DD",9002313.31,9002313.31,.05,"DT") 3110105 "^DD",9002313.31,9002313.31,.06,0) MAX CLAIMS PER TRANSMISSION^NJ1,0^^0;6^K:+X'=X!(X>4)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.31,9002313.31,.06,3) Type a number between 1 and 4, 0 decimal digits. "^DD",9002313.31,9002313.31,.06,21,0) ^^2^2^3110104^ "^DD",9002313.31,9002313.31,.06,21,1,0) This is the maximum number of claims that can be bundled in a "^DD",9002313.31,9002313.31,.06,21,2,0) transmission. If not entered, the certification code will set this to 1. "^DD",9002313.31,9002313.31,.06,"DT") 3110104 "^DD",9002313.31,9002313.31,.07,0) COB INDICATOR^S^1:PRIMARY;2:SECONDARY;3:TERTIARY;^0;7^Q "^DD",9002313.31,9002313.31,.07,3) Enter whether this claim is for the primary, secondary, or tertiary payer. "^DD",9002313.31,9002313.31,.07,21,0) ^^2^2^3101223^ "^DD",9002313.31,9002313.31,.07,21,1,0) This field is used to indicate the order of the payer (first-primary, "^DD",9002313.31,9002313.31,.07,21,2,0) second-secondary, third-tertiary). "^DD",9002313.31,9002313.31,.07,"DT") 3110105 "^DD",9002313.31,9002313.31,.08,0) ELIGIBILITY PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;8^Q "^DD",9002313.31,9002313.31,.08,3) Enter the eligibility payer sheet to be used for this certification claim. "^DD",9002313.31,9002313.31,.08,21,0) ^^2^2^3110817^ "^DD",9002313.31,9002313.31,.08,21,1,0) This is the payer sheet to be used for Certification Testing when the "^DD",9002313.31,9002313.31,.08,21,2,0) test claim is an eligibility verification claim. "^DD",9002313.31,9002313.31,.08,"DT") 3110817 "^DD",9002313.31,9002313.312,2,0) SUB CLARIFICATION CODE MULT^9002313.3122A^^2;0 "^DD",9002313.31,9002313.312,2,21,0) ^^2^2^3101217^ "^DD",9002313.31,9002313.312,2,21,1,0) This multiple will store the submission clarification codes, which will "^DD",9002313.31,9002313.312,2,21,2,0) be used to populate the NCPDP field 420-DK. "^DD",9002313.31,9002313.312,2,"DT") 3101220 "^DD",9002313.31,9002313.312,3,0) COB MULTIPLE^9002313.3123A^^3;0 "^DD",9002313.31,9002313.312,3,21,0) ^^2^2^3101217^ "^DD",9002313.31,9002313.312,3,21,1,0) This multiple structure stores information about each of the other payers "^DD",9002313.31,9002313.312,3,21,2,0) involved in the payment or rejection of the claim. "^DD",9002313.31,9002313.312,4,0) OTHER AMT CLAIMED MULT^9002313.3124A^^4;0 "^DD",9002313.31,9002313.312,4,21,0) ^^1^1^3110809^ "^DD",9002313.31,9002313.312,4,21,1,0) This multiple can contain up to three occurrences of less common charges. "^DD",9002313.31,9002313.3122,0) SUB CLARIFICATION CODE MULT SUB-FIELD^^.01^1 "^DD",9002313.31,9002313.3122,0,"DT") 3101217 "^DD",9002313.31,9002313.3122,0,"IX","B",9002313.3122,.01) "^DD",9002313.31,9002313.3122,0,"NM","SUB CLARIFICATION CODE MULT") "^DD",9002313.31,9002313.3122,0,"UP") 9002313.312 "^DD",9002313.31,9002313.3122,.01,0) SUBMISSION CLARIFICATION CODE^MF^^0;1^K:$L(X)>2!($L(X)<1) X "^DD",9002313.31,9002313.3122,.01,1,0) ^.1 "^DD",9002313.31,9002313.3122,.01,1,1,0) 9002313.3122^B "^DD",9002313.31,9002313.3122,.01,1,1,1) S ^BPS(9002313.31,DA(2),2,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.3122,.01,1,1,2) K ^BPS(9002313.31,DA(2),2,DA(1),2,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.3122,.01,3) Answer must be 1-2 characters in length. "^DD",9002313.31,9002313.3122,.01,21,0) ^^2^2^3101217^ "^DD",9002313.31,9002313.3122,.01,21,1,0) This will be used to populate the 420-DK field, which is the code "^DD",9002313.31,9002313.3122,.01,21,2,0) indicating that the pharmacist is clarifying the submission. "^DD",9002313.31,9002313.3122,.01,"DT") 3101220 "^DD",9002313.31,9002313.3123,0) COB MULTIPLE SUB-FIELD^^4^11 "^DD",9002313.31,9002313.3123,0,"DT") 3110805 "^DD",9002313.31,9002313.3123,0,"IX","B",9002313.3123,.01) "^DD",9002313.31,9002313.3123,0,"NM","COB MULTIPLE") "^DD",9002313.31,9002313.3123,0,"UP") 9002313.312 "^DD",9002313.31,9002313.3123,.01,0) OTHER PAYER COUNTER^MNJ1,0^^0;1^K:+X'=X!(X>9)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.31,9002313.3123,.01,1,0) ^.1 "^DD",9002313.31,9002313.3123,.01,1,1,0) 9002313.3123^B "^DD",9002313.31,9002313.3123,.01,1,1,1) S ^BPS(9002313.31,DA(2),2,DA(1),3,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.3123,.01,1,1,2) K ^BPS(9002313.31,DA(2),2,DA(1),3,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.3123,.01,3) Type a number between 1 and 9, 0 decimal digits. "^DD",9002313.31,9002313.3123,.01,21,0) ^^1^1^3110105^ "^DD",9002313.31,9002313.3123,.01,21,1,0) This is a counter field to store the count of the other payers. "^DD",9002313.31,9002313.3123,.01,"DT") 3110105 "^DD",9002313.31,9002313.3123,.02,0) OTHER PAYER COVERAGE TYPE^S^01:PRIMARY;02:SECONDARY;03:TERTIARY;04:COUPON;05:COMPOSITE;^0;2^Q "^DD",9002313.31,9002313.3123,.02,3) Select the other payer coverage type. "^DD",9002313.31,9002313.3123,.02,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,.02,21,1,0) This stores the value for NCPDP field 338-5C, which is the code indicating "^DD",9002313.31,9002313.3123,.02,21,2,0) whether the other payer is primary, secondary, etc. "^DD",9002313.31,9002313.3123,.02,"DT") 3110105 "^DD",9002313.31,9002313.3123,.03,0) OTHER PAYER ID QUALIFIER^S^01:NATIONAL PAYER ID;02:HEALTH INDUSTRY NUMBER (HIN);03:BANK IDENTIFICATION NUMBER (BIN);04:NAT. ASSOC. OF INS. COM. (NAIC);09:COUPON;99:OTHER;^0;3^Q "^DD",9002313.31,9002313.3123,.03,3) Select the Other Payer ID Qualifier. "^DD",9002313.31,9002313.3123,.03,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,.03,21,1,0) This value will be placed in the NCPDP field 339-6C, which is the code "^DD",9002313.31,9002313.3123,.03,21,2,0) qualifying the 'Other Payer ID' (340-7C) field. "^DD",9002313.31,9002313.3123,.03,"DT") 3110105 "^DD",9002313.31,9002313.3123,.04,0) OTHER PAYER ID^F^^0;4^K:$L(X)>10!($L(X)<1) X "^DD",9002313.31,9002313.3123,.04,3) Enter the Other Payer ID (1-10 characters). "^DD",9002313.31,9002313.3123,.04,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,.04,21,1,0) This will be used for the value in NCPDP field 340-7C, which is the ID "^DD",9002313.31,9002313.3123,.04,21,2,0) assigned to the Other Payer. "^DD",9002313.31,9002313.3123,.04,"DT") 3110105 "^DD",9002313.31,9002313.3123,.05,0) OTHER PAYER DATE^D^^0;5^S %DT="EX" D ^%DT S X=Y K:X<1 X "^DD",9002313.31,9002313.3123,.05,3) Enter the payment/denial date of the claim submitted to the other payer. "^DD",9002313.31,9002313.3123,.05,21,0) ^^2^2^3110210^ "^DD",9002313.31,9002313.3123,.05,21,1,0) This will be used for NCPDP field 443-E8, which is the payment or denial "^DD",9002313.31,9002313.3123,.05,21,2,0) date of the claim submitted to the other payer. "^DD",9002313.31,9002313.3123,.05,"DT") 3110210 "^DD",9002313.31,9002313.3123,.06,0) OTHER PAYER AMOUNT PAID COUNT^NJ1,0^^0;6^K:+X'=X!(X>9)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.31,9002313.3123,.06,3) Enter the count (0-9) of the Other Payer Paid Amount occurrences. "^DD",9002313.31,9002313.3123,.06,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,.06,21,1,0) This will be used for NCPDP field 341-HB, which is the count of the Other "^DD",9002313.31,9002313.3123,.06,21,2,0) Payer Paid Amount occurrences. "^DD",9002313.31,9002313.3123,.06,"DT") 3110105 "^DD",9002313.31,9002313.3123,.07,0) OTHER PAYER REJECT COUNT^NJ2,0^^0;7^K:+X'=X!(X>20)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.31,9002313.3123,.07,3) Enter the count (0-20) of the Other Payer Reject Code occurrences. "^DD",9002313.31,9002313.3123,.07,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,.07,21,1,0) This is used for NCPDP field 471-5E, which is the count of Other Payer "^DD",9002313.31,9002313.3123,.07,21,2,0) Reject Code occurrences. "^DD",9002313.31,9002313.3123,.07,"DT") 3110105 "^DD",9002313.31,9002313.3123,1,0) OTHER PAYER AMT PAID MULTIPLE^9002313.31231A^^1;0 "^DD",9002313.31,9002313.3123,1,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,1,21,1,0) This multiple can contain up to 9 occurrences of paid amounts from the "^DD",9002313.31,9002313.3123,1,21,2,0) other payer. "^DD",9002313.31,9002313.3123,2,0) OTHER PAYER REJECT MULTIPLE^9002313.31232A^^2;0 "^DD",9002313.31,9002313.3123,2,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.3123,2,21,1,0) This multiple will store the reject codes returned by the other payer. "^DD",9002313.31,9002313.3123,2,21,2,0) There can be up to 20 occurrences per the NCPDP documentation. "^DD",9002313.31,9002313.3123,3,0) OTHER PAYER PATIENT RESP MULT^9002313.31233A^^3;0 "^DD",9002313.31,9002313.3123,3,21,0) ^^2^2^3101217^ "^DD",9002313.31,9002313.3123,3,21,1,0) This multiple holds the paid amounts that are the responsibility of the "^DD",9002313.31,9002313.3123,3,21,2,0) patient from a previous payer. "^DD",9002313.31,9002313.3123,4,0) BENEFIT STAGE MULT^9002313.31234A^^4;0 "^DD",9002313.31,9002313.3123,4,21,0) ^^2^2^3110809^ "^DD",9002313.31,9002313.3123,4,21,1,0) This multiple can contain up to four occurrences of Medicare Part D "^DD",9002313.31,9002313.3123,4,21,2,0) beneficiary benefit stages. "^DD",9002313.31,9002313.31231,0) OTHER PAYER AMT PAID MULTIPLE SUB-FIELD^^.02^2 "^DD",9002313.31,9002313.31231,0,"DT") 3101217 "^DD",9002313.31,9002313.31231,0,"IX","B",9002313.31231,.01) "^DD",9002313.31,9002313.31231,0,"NM","OTHER PAYER AMT PAID MULTIPLE") "^DD",9002313.31,9002313.31231,0,"UP") 9002313.3123 "^DD",9002313.31,9002313.31231,.01,0) OTHER PAYER AMT PAID^MNJ9,2^^0;1^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>999999)!(X<0)!(X?.E1"."3.N) X "^DD",9002313.31,9002313.31231,.01,1,0) ^.1 "^DD",9002313.31,9002313.31231,.01,1,1,0) 9002313.31231^B "^DD",9002313.31,9002313.31231,.01,1,1,1) S ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.31231,.01,1,1,2) K ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),1,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.31231,.01,3) Type a dollar amount between 0 and 999999, 2 decimal digits. "^DD",9002313.31,9002313.31231,.01,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.31231,.01,21,1,0) This will be used for NCPDP field 431-DV, which is the amount of any "^DD",9002313.31,9002313.31231,.01,21,2,0) payment from the other payer. "^DD",9002313.31,9002313.31231,.01,"DT") 3110105 "^DD",9002313.31,9002313.31231,.02,0) OTHER PAYER AMT PAID QUALIFIER^S^01:DELIVERY;02:SHIPPING;03:POSTAGE;04:ADMINISTRATIVE;05:INCENTIVE;06:COGNITIVE SERVICE;07:DRUG BENEFIT;08:SUM OF ALL REIMBURSEMENT;98:COUPON;99:OHTER;^0;2^Q "^DD",9002313.31,9002313.31231,.02,3) Enter the qualifier for the Other Amount Paid. "^DD",9002313.31,9002313.31231,.02,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.31231,.02,21,1,0) This will go into NCPDP field 342-HC, which qualifies the payment amount "^DD",9002313.31,9002313.31231,.02,21,2,0) in the Other Payer Amount Paid. "^DD",9002313.31,9002313.31231,.02,"DT") 3110105 "^DD",9002313.31,9002313.31232,0) OTHER PAYER REJECT MULTIPLE SUB-FIELD^^.01^1 "^DD",9002313.31,9002313.31232,0,"DT") 3101217 "^DD",9002313.31,9002313.31232,0,"IX","B",9002313.31232,.01) "^DD",9002313.31,9002313.31232,0,"NM","OTHER PAYER REJECT MULTIPLE") "^DD",9002313.31,9002313.31232,0,"UP") 9002313.3123 "^DD",9002313.31,9002313.31232,.01,0) OTHER PAYER REJECT CODE^MF^^0;1^K:$L(X)>3!($L(X)<1) X "^DD",9002313.31,9002313.31232,.01,1,0) ^.1 "^DD",9002313.31,9002313.31232,.01,1,1,0) 9002313.31232^B "^DD",9002313.31,9002313.31232,.01,1,1,1) S ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),2,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.31232,.01,1,1,2) K ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),2,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.31232,.01,3) Enter a reject code returned by the Other Payer. "^DD",9002313.31,9002313.31232,.01,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.31232,.01,21,1,0) This will be used for field 472-6E, which is the reject code returned by "^DD",9002313.31,9002313.31232,.01,21,2,0) the other payer. "^DD",9002313.31,9002313.31232,.01,"DT") 3110105 "^DD",9002313.31,9002313.31233,0) OTHER PAYER PATIENT RESP MULT SUB-FIELD^^.02^2 "^DD",9002313.31,9002313.31233,0,"DT") 3110805 "^DD",9002313.31,9002313.31233,0,"IX","B",9002313.31233,.01) "^DD",9002313.31,9002313.31233,0,"NM","OTHER PAYER PATIENT RESP MULT") "^DD",9002313.31,9002313.31233,0,"UP") 9002313.3123 "^DD",9002313.31,9002313.31233,.01,0) OTHER PAYER PATIENT PAID AMT^MNJ9,2^^0;1^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>999999)!(X<0)!(X?.E1"."3.N) X "^DD",9002313.31,9002313.31233,.01,1,0) ^.1 "^DD",9002313.31,9002313.31233,.01,1,1,0) 9002313.31233^B "^DD",9002313.31,9002313.31233,.01,1,1,1) S ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),3,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.31233,.01,1,1,2) K ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),3,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.31233,.01,3) Type a dollar amount between 0 and 999999, 2 decimal digits. "^DD",9002313.31,9002313.31233,.01,21,0) ^^2^2^3101217^ "^DD",9002313.31,9002313.31233,.01,21,1,0) This field has the data for NCPDP field 352-NQ, which is the patient's "^DD",9002313.31,9002313.31233,.01,21,2,0) cost share from a previous payer. "^DD",9002313.31,9002313.31233,.01,"DT") 3101217 "^DD",9002313.31,9002313.31233,.02,0) OTHER PAYER PATIENT RESP QUAL^S^01:DEDUCTIBLE;02:BRAND DRUG;03:SALES TAX;04:PERIODIC BENEFIT;05:COPAY;06:PATIENT PAY AMOUNT;07:COINSURANCE;08:NON-FORUMLARY DRUG;09:HEALTH PLAN ASSISTANCE AMOUNT;10:PRODUCT NETWORK SELECTION;12:COVERAGE GAP;^0;2^Q "^DD",9002313.31,9002313.31233,.02,3) Enter the qualifier for the Other Payer Patient Responsibility Amount. "^DD",9002313.31,9002313.31233,.02,21,0) ^^2^2^3110105^ "^DD",9002313.31,9002313.31233,.02,21,1,0) This will be used for NCPDP field 351-NP, which qualifies the payment in "^DD",9002313.31,9002313.31233,.02,21,2,0) the Other Payer-Patient Responsibility Paid Amount. "^DD",9002313.31,9002313.31233,.02,"DT") 3110805 "^DD",9002313.31,9002313.31234,0) BENEFIT STAGE MULT SUB-FIELD^^.02^2 "^DD",9002313.31,9002313.31234,0,"DT") 3110727 "^DD",9002313.31,9002313.31234,0,"IX","B",9002313.31234,.01) "^DD",9002313.31,9002313.31234,0,"NM","BENEFIT STAGE MULT") "^DD",9002313.31,9002313.31234,0,"UP") 9002313.3123 "^DD",9002313.31,9002313.31234,.01,0) BENEFIT STAGE AMOUNT^MNJ9,2^^0;1^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>999999)!(X<0)!(X?.E1"."3.N) X "^DD",9002313.31,9002313.31234,.01,1,0) ^.1 "^DD",9002313.31,9002313.31234,.01,1,1,0) 9002313.31234^B "^DD",9002313.31,9002313.31234,.01,1,1,1) S ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),4,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.31234,.01,1,1,2) K ^BPS(9002313.31,DA(3),2,DA(2),3,DA(1),4,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.31234,.01,3) Type a dollar amount between 0 and 999999, 2 decimal digits. "^DD",9002313.31,9002313.31234,.01,21,0) ^^3^3^3110809^ "^DD",9002313.31,9002313.31234,.01,21,1,0) This will be used for NCPDP field 394-MW (Benefit Stage Amount), which is "^DD",9002313.31,9002313.31234,.01,21,2,0) the amount of claim allocated to the Medicare stage identified by field "^DD",9002313.31,9002313.31234,.01,21,3,0) 393-MV (Benefit Stage Qualifier). "^DD",9002313.31,9002313.31234,.01,"DT") 3110809 "^DD",9002313.31,9002313.31234,.02,0) BENEFIT STAGE QUALIFIER^S^1:DEDUCTIBLE;2:INITIAL BENEFIT;3:COVERAGE GAP;4:CATASTROPHIC COVERAGE;^0;2^Q "^DD",9002313.31,9002313.31234,.02,3) Enter the code that describes the Benefit Stage Amount. "^DD",9002313.31,9002313.31234,.02,21,0) ^^2^2^3110809^ "^DD",9002313.31,9002313.31234,.02,21,1,0) This is used for NCPDP field 393-MV (Benefit Stage Qualifier), which is "^DD",9002313.31,9002313.31234,.02,21,2,0) used to qualify the Benefit Stage Amount. "^DD",9002313.31,9002313.31234,.02,"DT") 3110809 "^DD",9002313.31,9002313.3124,0) OTHER AMT CLAIMED MULT SUB-FIELD^^.02^2 "^DD",9002313.31,9002313.3124,0,"DT") 3110822 "^DD",9002313.31,9002313.3124,0,"IX","B",9002313.3124,.01) "^DD",9002313.31,9002313.3124,0,"NM","OTHER AMT CLAIMED MULT") "^DD",9002313.31,9002313.3124,0,"UP") 9002313.312 "^DD",9002313.31,9002313.3124,.01,0) OTHER AMOUNT CLAIMED SUBMITTED^MNJ9,2^^0;1^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>999999)!(X<0)!(X?.E1"."3.N) X "^DD",9002313.31,9002313.3124,.01,1,0) ^.1 "^DD",9002313.31,9002313.3124,.01,1,1,0) 9002313.3124^B "^DD",9002313.31,9002313.3124,.01,1,1,1) S ^BPS(9002313.31,DA(2),2,DA(1),4,"B",$E(X,1,30),DA)="" "^DD",9002313.31,9002313.3124,.01,1,1,2) K ^BPS(9002313.31,DA(2),2,DA(1),4,"B",$E(X,1,30),DA) "^DD",9002313.31,9002313.3124,.01,3) Type a dollar amount between 0 and 999999, 2 decimal digits. "^DD",9002313.31,9002313.3124,.01,21,0) ^^3^3^3110817^ "^DD",9002313.31,9002313.3124,.01,21,1,0) This will be used for NCPDP field 480-H9 (Other Claim Amount Submitted), "^DD",9002313.31,9002313.3124,.01,21,2,0) which holds the dollar amount that represents the additional incurred "^DD",9002313.31,9002313.3124,.01,21,3,0) costs for a dispensed prescription. "^DD",9002313.31,9002313.3124,.01,"DT") 3110817 "^DD",9002313.31,9002313.3124,.02,0) OTHER AMOUNT CLAIMED QUALIFIER^S^01:DELIVERY COST;02:SHIPPING COST;03:POSTAGE COST;04:ADMINISTRATIVE COST;09:COMPOUND PREP COST SUBMITTED;99:OTHER;^0;2^Q "^DD",9002313.31,9002313.3124,.02,3) Enter the code that describes the Other Amount Claimed Submitted. "^DD",9002313.31,9002313.3124,.02,21,0) ^^3^3^3110809^ "^DD",9002313.31,9002313.3124,.02,21,1,0) This will be used for NCPDP field 479-H8 (Other Amount Claimed Submitted "^DD",9002313.31,9002313.3124,.02,21,2,0) Qualifier), which is used to describe the dollar amount in the 480-H9 "^DD",9002313.31,9002313.3124,.02,21,3,0) field. "^DD",9002313.31,9002313.3124,.02,"DT") 3110822 "^DD",9002313.32,9002313.32,.02,0) TYPE^S^R:REVERSAL;RS:RESUBMIT WITH REVERSAL;S:SUBMIT;E:ELIGIBILITY;^0;2^Q "^DD",9002313.32,9002313.32,.02,3) Enter the type of submission that is being sent to the payer. "^DD",9002313.32,9002313.32,.02,21,0) ^^1^1^3101021^ "^DD",9002313.32,9002313.32,.02,21,1,0) This is the type of request that is being overridden. "^DD",9002313.32,9002313.32,.02,"DT") 3101021 "^DD",9002313.32,9002313.32,.08,0) ELIGIBILITY RESPONSE^S^A:ACCEPTED;R:REJECTED;S:STRANDED;^0;8^Q "^DD",9002313.32,9002313.32,.08,3) Enter the response override for eligibility verification payer sheets. "^DD",9002313.32,9002313.32,.08,21,0) ^^4^4^3101020^ "^DD",9002313.32,9002313.32,.08,21,1,0) This is the override value that will be used for the payer response for "^DD",9002313.32,9002313.32,.08,21,2,0) eligibility verification requests. The value will be used to populate the "^DD",9002313.32,9002313.32,.08,21,3,0) 112 (Transaction Response Status) and 501 (Response Status) fields of BPS "^DD",9002313.32,9002313.32,.08,21,4,0) Responses. "^DD",9002313.32,9002313.32,.08,"DT") 3101020 "^DD",9002313.57,9002313.57,1.05,0) POLICY NUMBER^NJ4,0^^1;5^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.57,9002313.57,1.05,3) Enter the policy number that will be processed for this request (0-9999). "^DD",9002313.57,9002313.57,1.05,21,0) ^^2^2^3101018^ "^DD",9002313.57,9002313.57,1.05,21,1,0) This is the policy number that is being processed for this eligibility "^DD",9002313.57,9002313.57,1.05,21,2,0) verification request. "^DD",9002313.57,9002313.57,1.05,"DT") 3101018 "^DD",9002313.57,9002313.57,19,0) TRANSACTION TYPE^S^C:CLAIM;E:ELIGIBILITY;U:UNCLAIM;^0;15^Q "^DD",9002313.57,9002313.57,19,3) Answer with the type of transaction that will be processed for this NCPDP request. "^DD",9002313.57,9002313.57,19,21,0) ^^4^4^3101018^ "^DD",9002313.57,9002313.57,19,21,1,0) This is the type of transaction that is being processed: "^DD",9002313.57,9002313.57,19,21,2,0) CLAIM - An NCPDP billing request. "^DD",9002313.57,9002313.57,19,21,3,0) UNCLAIM - An NCPDP reversal request. "^DD",9002313.57,9002313.57,19,21,4,0) ELIGIBILITY - An eligibility verification request. "^DD",9002313.57,9002313.57,19,"DT") 3101018 "^DD",9002313.57,9002313.57,1201,0) RX ACTION^F^^12;1^K:$L(X)>4!($L(X)<1) X "^DD",9002313.57,9002313.57,1201,3) Enter the mnemonic that indicates what type of action should be performed (1-4 characters). "^DD",9002313.57,9002313.57,1201,21,0) ^^4^4^3110210^ "^DD",9002313.57,9002313.57,1201,21,1,0) This is the action that is being performed on this request. It is either "^DD",9002313.57,9002313.57,1201,21,2,0) the BWHERE parameter passed into BPSNCPDP or 'ELIG' for an eligibility "^DD",9002313.57,9002313.57,1201,21,3,0) verification request. The list of BWHERE values are documented at the "^DD",9002313.57,9002313.57,1201,21,4,0) top of routine BPSNCPD3. "^DD",9002313.57,9002313.57,1201,"DT") 3110210 "^DD",9002313.57,9002313.57902,902.02,0) B1 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;2^Q "^DD",9002313.57,9002313.57902,902.02,3) Answer with a billing payer sheet to be used for this payer. "^DD",9002313.57,9002313.57902,902.02,21,0) ^^3^3^3101018^ "^DD",9002313.57,9002313.57902,902.02,21,1,0) This the payer sheet used to submit billing request for this particular "^DD",9002313.57,9002313.57902,902.02,21,2,0) insurer. Billing request transmissions will be formatted per the "^DD",9002313.57,9002313.57902,902.02,21,3,0) specifications in this payer sheet. "^DD",9002313.57,9002313.57902,902.02,"DT") 3101018 "^DD",9002313.57,9002313.57902,902.21,0) B3 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;4^Q "^DD",9002313.57,9002313.57902,902.21,3) Enter the rebill payer sheet used for this payer. "^DD",9002313.57,9002313.57902,902.21,21,0) ^^3^3^3101018^ "^DD",9002313.57,9002313.57902,902.21,21,1,0) This is the payer sheet to be used for a rebill request for this "^DD",9002313.57,9002313.57902,902.21,21,2,0) insurer. Rebill transmission will be formatted per the specifications in "^DD",9002313.57,9002313.57902,902.21,21,3,0) this payer sheet. "^DD",9002313.57,9002313.57902,902.21,"DT") 3101018 "^DD",9002313.57,9002313.57902,902.34,0) E1 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;9^Q "^DD",9002313.57,9002313.57902,902.34,3) Enter the eligibility verification payer sheet for the payer. "^DD",9002313.57,9002313.57902,902.34,21,0) ^^3^3^3101018^ "^DD",9002313.57,9002313.57902,902.34,21,1,0) This is the payer sheet to be used for eligibility verification requests "^DD",9002313.57,9002313.57902,902.34,21,2,0) for this insurer. Eligibility verification transmissions will be "^DD",9002313.57,9002313.57902,902.34,21,3,0) formatted per the specifications in this payer sheet. "^DD",9002313.57,9002313.57902,902.34,"DT") 3101018 "^DD",9002313.57,9002313.57902,902.35,0) POLICY NUMBER^NJ4,0^^0;12^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.57,9002313.57902,902.35,3) Enter the policy number for this insurer (0-9999). "^DD",9002313.57,9002313.57902,902.35,21,0) ^^2^2^3101018^ "^DD",9002313.57,9002313.57902,902.35,21,1,0) This is the policy number assigned for this particular patient and "^DD",9002313.57,9002313.57902,902.35,21,2,0) insurer. "^DD",9002313.57,9002313.57902,902.35,"DT") 3101018 "^DD",9002313.57,9002313.57902,902.36,0) MAXIMUM NCPDP TRANSACTIONS^NJ5,0^^1;9^K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.57,9002313.57902,902.36,3) Enter the maximum number of transactions allowed in a request (1-9999). "^DD",9002313.57,9002313.57902,902.36,21,0) ^^2^2^3101018^ "^DD",9002313.57,9002313.57902,902.36,21,1,0) This is the maximum number of transactions that can be bundled in a "^DD",9002313.57,9002313.57902,902.36,21,2,0) transmission. It is specified by the NCPDP processor. "^DD",9002313.57,9002313.57902,902.36,"DT") 3101018 "^DD",9002313.58,9002313.58,209,0) RESULT - ELIGIBILITY ACCEPTED^NJ9,0^^R;9^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.58,9002313.58,209,3) Enter the number of eligibility requests that are accepted (1-999999999). "^DD",9002313.58,9002313.58,209,21,0) ^^2^2^3101013^ "^DD",9002313.58,9002313.58,209,21,1,0) This field stores the number of eligibility verification requests that "^DD",9002313.58,9002313.58,209,21,2,0) were accepted by the third-party payer. "^DD",9002313.58,9002313.58,209,"DT") 3101013 "^DD",9002313.58,9002313.58,210,0) RESULT - ELIGIBILITY REJECTED^NJ9,0^^R;10^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.58,9002313.58,210,3) Enter the number of eligibility requests that were rejected (1-999999999). "^DD",9002313.58,9002313.58,210,21,0) ^^2^2^3101012^ "^DD",9002313.58,9002313.58,210,21,1,0) This field stores the number of eligibility verification requests that "^DD",9002313.58,9002313.58,210,21,2,0) were rejected by the third-party payer. "^DD",9002313.58,9002313.58,210,"DT") 3101013 "^DD",9002313.59,9002313.59,1.05,0) POLICY NUMBER^NJ4,0^^1;5^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.59,9002313.59,1.05,3) Enter the policy number that will be processed for this request (0-9999). "^DD",9002313.59,9002313.59,1.05,21,0) ^^2^2^3101014^ "^DD",9002313.59,9002313.59,1.05,21,1,0) This is the policy number that is being processed for this "^DD",9002313.59,9002313.59,1.05,21,2,0) eligibility verification request. "^DD",9002313.59,9002313.59,1.05,"DT") 3101014 "^DD",9002313.59,9002313.59,19,0) TRANSACTION TYPE^S^C:CLAIM;E:ELIGIBILITY;U:UNCLAIM;^0;15^Q "^DD",9002313.59,9002313.59,19,3) Answer with the type of transaction that will be processed for this NCPDP request. "^DD",9002313.59,9002313.59,19,21,0) ^^4^4^3101014^ "^DD",9002313.59,9002313.59,19,21,1,0) This is the type of transaction that is being processed: "^DD",9002313.59,9002313.59,19,21,2,0) CLAIM - An NCPDP billing request. "^DD",9002313.59,9002313.59,19,21,3,0) UNCLAIM - An NCPDP reversal request. "^DD",9002313.59,9002313.59,19,21,4,0) ELIGIBILITY - An eligibility verification request. "^DD",9002313.59,9002313.59,19,"DT") 3101014 "^DD",9002313.59,9002313.59,1201,0) RX ACTION^F^^12;1^K:$L(X)>4!($L(X)<1) X "^DD",9002313.59,9002313.59,1201,3) Enter the mnemonic that indicates what type of action should be performed (1-4 characters). "^DD",9002313.59,9002313.59,1201,21,0) ^^4^4^3110210^ "^DD",9002313.59,9002313.59,1201,21,1,0) This is the action that is being performed on this request. It is either "^DD",9002313.59,9002313.59,1201,21,2,0) the BWHERE parameter passed into BPSNCPDP or 'ELIG' for an eligibility "^DD",9002313.59,9002313.59,1201,21,3,0) verification request. The list of BWHERE values are documented at the top "^DD",9002313.59,9002313.59,1201,21,4,0) of routine BPSNCPD3. "^DD",9002313.59,9002313.59,1201,"DT") 3110210 "^DD",9002313.59,9002313.59902,902.02,0) B1 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;2^Q "^DD",9002313.59,9002313.59902,902.02,3) Answer with a billing payer sheet to be used for this payer. "^DD",9002313.59,9002313.59902,902.02,21,0) ^^3^3^3101014^ "^DD",9002313.59,9002313.59902,902.02,21,1,0) This is the payer sheet used to submit billing request for this particular "^DD",9002313.59,9002313.59902,902.02,21,2,0) insurer. Billing request transmissions will be formatted per the "^DD",9002313.59,9002313.59902,902.02,21,3,0) specifications in this payer sheet. "^DD",9002313.59,9002313.59902,902.02,"DT") 3101014 "^DD",9002313.59,9002313.59902,902.21,0) B3 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;4^Q "^DD",9002313.59,9002313.59902,902.21,3) Enter the rebill payer sheet used for this payer. "^DD",9002313.59,9002313.59902,902.21,21,0) ^^3^3^3101014^ "^DD",9002313.59,9002313.59902,902.21,21,1,0) This is the payer sheet to be used for a rebill request for this "^DD",9002313.59,9002313.59902,902.21,21,2,0) insurer. Rebill transmission will be formatted per the specifications in "^DD",9002313.59,9002313.59902,902.21,21,3,0) this payer sheet. "^DD",9002313.59,9002313.59902,902.21,"DT") 3101014 "^DD",9002313.59,9002313.59902,902.34,0) E1 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;9^Q "^DD",9002313.59,9002313.59902,902.34,3) Enter the eligibility verification payer sheet for the payer. "^DD",9002313.59,9002313.59902,902.34,21,0) ^^3^3^3101014^ "^DD",9002313.59,9002313.59902,902.34,21,1,0) This is the payer sheet to be used for eligibility verification requests "^DD",9002313.59,9002313.59902,902.34,21,2,0) for this insurer. Eligibility verification transmissions will be "^DD",9002313.59,9002313.59902,902.34,21,3,0) formatted per the specifications in this payer sheet. "^DD",9002313.59,9002313.59902,902.34,"DT") 3101014 "^DD",9002313.59,9002313.59902,902.35,0) POLICY NUMBER^NJ4,0^^0;12^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.59,9002313.59902,902.35,3) Enter the policy number for this insurer (0-9999). "^DD",9002313.59,9002313.59902,902.35,21,0) ^^2^2^3101014^ "^DD",9002313.59,9002313.59902,902.35,21,1,0) This is the policy number assigned for this particular patient and "^DD",9002313.59,9002313.59902,902.35,21,2,0) insurer. "^DD",9002313.59,9002313.59902,902.35,"DT") 3101014 "^DD",9002313.59,9002313.59902,902.36,0) MAXIMUM NCPDP TRANSACTIONS^NJ5,0^^1;9^K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.59,9002313.59902,902.36,3) Enter the maximum number of transactions allowed in a request (1-9999). "^DD",9002313.59,9002313.59902,902.36,21,0) ^^2^2^3101014^ "^DD",9002313.59,9002313.59902,902.36,21,1,0) This is the maximum number of transactions that can be bundled in a "^DD",9002313.59,9002313.59902,902.36,21,2,0) transmission. It is specified by the NCPDP processor. "^DD",9002313.59,9002313.59902,902.36,"DT") 3101014 "^DD",9002313.77,9002313.77,.01,0) KEY1^RNJ13,0^^0;1^K:+X'=X!(X>9999999999999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.77,9002313.77,.01,1,0) ^.1 "^DD",9002313.77,9002313.77,.01,1,1,0) 9002313.77^B "^DD",9002313.77,9002313.77,.01,1,1,1) S ^BPS(9002313.77,"B",$E(X,1,30),DA)="" "^DD",9002313.77,9002313.77,.01,1,1,2) K ^BPS(9002313.77,"B",$E(X,1,30),DA) "^DD",9002313.77,9002313.77,.01,3) Enter the first key of the request (1-9999999999999). "^DD",9002313.77,9002313.77,.01,21,0) ^^3^3^3101019^ "^DD",9002313.77,9002313.77,.01,21,1,0) For claim requests and reversals, this is the prescription IEN that "^DD",9002313.77,9002313.77,.01,21,2,0) will be processed. For Eligibility Verification requests, "^DD",9002313.77,9002313.77,.01,21,3,0) this is the Patient IEN that will be processed. "^DD",9002313.77,9002313.77,.01,"DT") 3101019 "^DD",9002313.77,9002313.77,.02,0) KEY2^RNJ4,0^^0;2^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.77,9002313.77,.02,3) Enter the second key of the request (0-9999). "^DD",9002313.77,9002313.77,.02,21,0) ^^4^4^3101018^ "^DD",9002313.77,9002313.77,.02,21,1,0) For billing requests and reversals, this is the fill number where 0 is the "^DD",9002313.77,9002313.77,.02,21,2,0) original fill and 1-999 are refills. For eligibility verification "^DD",9002313.77,9002313.77,.02,21,3,0) requests, this is the policy number plus 9000. So, for policy number 4, "^DD",9002313.77,9002313.77,.02,21,4,0) this would be 9004. "^DD",9002313.77,9002313.77,.02,"DT") 3101018 "^DD",9002313.77,9002313.77,.06,0) ECME TRANSACTION RECORD^P9002313.59'^BPST(^0;6^Q "^DD",9002313.77,9002313.77,.06,1,0) ^.1 "^DD",9002313.77,9002313.77,.06,1,1,0) 9002313.77^C "^DD",9002313.77,9002313.77,.06,1,1,1) S ^BPS(9002313.77,"C",$E(X,1,30),DA)="" "^DD",9002313.77,9002313.77,.06,1,1,2) K ^BPS(9002313.77,"C",$E(X,1,30),DA) "^DD",9002313.77,9002313.77,.06,1,1,"DT") 3080404 "^DD",9002313.77,9002313.77,.06,3) Enter the transaction record from the BPS Transaction file. "^DD",9002313.77,9002313.77,.06,21,0) ^^3^3^3101019^ "^DD",9002313.77,9002313.77,.06,21,1,0) This is the BPS Transaction. It is not initially populated but is "^DD",9002313.77,9002313.77,.06,21,2,0) populated after the request is activated and the BPS Transaction record is "^DD",9002313.77,9002313.77,.06,21,3,0) created. "^DD",9002313.77,9002313.77,.06,"DT") 3101019 "^DD",9002313.77,9002313.77,1.01,0) RX ACTION^F^^1;1^K:$L(X)>4!($L(X)<1) X "^DD",9002313.77,9002313.77,1.01,3) Enter the mnemonic that indicates what type of action should be performed (1-4 characters). "^DD",9002313.77,9002313.77,1.01,21,0) ^^4^4^3110210^ "^DD",9002313.77,9002313.77,1.01,21,1,0) This is the action that is being performed on this request. It is either "^DD",9002313.77,9002313.77,1.01,21,2,0) the BWHERE parameter passed into BPSNCPDP or 'ELIG' for an eligibility "^DD",9002313.77,9002313.77,1.01,21,3,0) verification request. The list of BWHERE values are documented at the "^DD",9002313.77,9002313.77,1.01,21,4,0) top of routine BPSNCPD3. "^DD",9002313.77,9002313.77,1.01,23,0) ^^1^1^3100929^ "^DD",9002313.77,9002313.77,1.01,23,1,0) The RX Actions are documented at the top of routine BPSNCPD3. "^DD",9002313.77,9002313.77,1.01,"DT") 3110210 "^DD",9002313.77,9002313.77,1.02,0) OUTPATIENT SITE^P59'^PS(59,^1;2^Q "^DD",9002313.77,9002313.77,1.02,3) Enter the Outpatient Site associated with the request. "^DD",9002313.77,9002313.77,1.02,21,0) ^^2^2^3101019^ "^DD",9002313.77,9002313.77,1.02,21,1,0) This is the outpatient site that will be used to generate the NPI number "^DD",9002313.77,9002313.77,1.02,21,2,0) for the Service Provider ID (201-B1) field of a NCPDP request. "^DD",9002313.77,9002313.77,1.02,"DT") 3101019 "^DD",9002313.77,9002313.77,1.04,0) TRANSACTION TYPE^S^C:CLAIM;E:ELIGIBILITY;U:UNCLAIM;^1;4^Q "^DD",9002313.77,9002313.77,1.04,3) Answer with the type of transaction that will be processed for this NCPDP request. "^DD",9002313.77,9002313.77,1.04,21,0) ^^4^4^3101018^ "^DD",9002313.77,9002313.77,1.04,21,1,0) This is the type of transaction that is being processed: "^DD",9002313.77,9002313.77,1.04,21,2,0) CLAIM - An NCPDP billing request. "^DD",9002313.77,9002313.77,1.04,21,3,0) UNCLAIM - An NCPDP reversal request. "^DD",9002313.77,9002313.77,1.04,21,4,0) ELIGIBILITY - An eligibility verification request. "^DD",9002313.77,9002313.77,1.04,"DT") 3101018 "^DD",9002313.77,9002313.77,1.13,0) RX NUMBER^P52'^PSRX(^1;13^Q "^DD",9002313.77,9002313.77,1.13,3) Enter the prescription to be processed for this request. "^DD",9002313.77,9002313.77,1.13,21,0) ^^4^4^3101018^ "^DD",9002313.77,9002313.77,1.13,21,1,0) For billing requests and reversal, this is the prescription that will be "^DD",9002313.77,9002313.77,1.13,21,2,0) processed for the request. If an eligibility verification request is "^DD",9002313.77,9002313.77,1.13,21,3,0) initiated from the ECME User Screen, this field will also be populated "^DD",9002313.77,9002313.77,1.13,21,4,0) and will be used to get the Prescriber information from the prescription. "^DD",9002313.77,9002313.77,1.13,"DT") 3101018 "^DD",9002313.77,9002313.77,1.14,0) FILL NO^NJ2,0^^1;14^K:+X'=X!(X>99)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.77,9002313.77,1.14,3) Enter the fill number that will be processed for this request (1-99). "^DD",9002313.77,9002313.77,1.14,21,0) ^^5^5^3101019^ "^DD",9002313.77,9002313.77,1.14,21,1,0) For billing requests and reversals, this is the fill number to be "^DD",9002313.77,9002313.77,1.14,21,2,0) processed, where 0 is the original fill and 1-99 are refills. If an "^DD",9002313.77,9002313.77,1.14,21,3,0) eligibility verification request is initiated from the ECME User Screen, "^DD",9002313.77,9002313.77,1.14,21,4,0) this field will also be populated and will be used to get the Prescriber "^DD",9002313.77,9002313.77,1.14,21,5,0) information from the prescription. "^DD",9002313.77,9002313.77,1.14,"DT") 3101019 "^DD",9002313.77,9002313.77,1.15,0) PATIENT^P2'^DPT(^1;15^Q "^DD",9002313.77,9002313.77,1.15,3) Enter the patient associated with this request. "^DD",9002313.77,9002313.77,1.15,21,0) ^^3^3^3101018^ "^DD",9002313.77,9002313.77,1.15,21,1,0) For billing requests and reversals, this is the patient associated with "^DD",9002313.77,9002313.77,1.15,21,2,0) the prescription. For eligibility verification requests, this is the "^DD",9002313.77,9002313.77,1.15,21,3,0) patient for which the insurance is being verified. "^DD",9002313.77,9002313.77,1.15,"DT") 3110511 "^DD",9002313.77,9002313.77,1.16,0) POLICY NUMBER^NJ4,0^^1;16^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.77,9002313.77,1.16,3) Enter the policy number for the request (0-9999). "^DD",9002313.77,9002313.77,1.16,21,0) ^^2^2^3101018^ "^DD",9002313.77,9002313.77,1.16,21,1,0) This is the policy number of the patient that is being verified in an "^DD",9002313.77,9002313.77,1.16,21,2,0) eligibility verification request. "^DD",9002313.77,9002313.77,1.16,"DT") 3101018 "^DD",9002313.77,9002313.77,2.01,0) DATE OF SERVICE^D^^2;1^S %DT="E" D ^%DT S X=Y K:X<1 X "^DD",9002313.77,9002313.77,2.01,3) Enter the date of service to be used on this NCPDP request. "^DD",9002313.77,9002313.77,2.01,21,0) ^^3^3^3110706^ "^DD",9002313.77,9002313.77,2.01,21,1,0) This is the date of service that will be used to populate the 401-D1 "^DD",9002313.77,9002313.77,2.01,21,2,0) field of the NCPDP request. It is generally the fill/refill date of the "^DD",9002313.77,9002313.77,2.01,21,3,0) prescription but may also be the release date. "^DD",9002313.77,9002313.77,2.01,"DT") 3110706 "^DD",9002313.77,9002313.77,2.05,0) CLARIFICATION CODE^F^^2;5^K:$L(X)>8!($L(X)<1) X "^DD",9002313.77,9002313.77,2.05,3) Enter between 1 and 3 Submission Clarification Codes separated by "~". "^DD",9002313.77,9002313.77,2.05,21,0) ^^9^9^3101230^ "^DD",9002313.77,9002313.77,2.05,21,1,0) The Submission Clarification Code is entered by the pharmacist and passed "^DD",9002313.77,9002313.77,2.05,21,2,0) by Outpatient Pharmacy to ECME to put into the claim to support/justify "^DD",9002313.77,9002313.77,2.05,21,3,0) the claim request when the payer rejects it. Valid clarification codes are "^DD",9002313.77,9002313.77,2.05,21,4,0) selected from BPS NCPDP CLARIFICATION CODES file (#9002313.25). These "^DD",9002313.77,9002313.77,2.05,21,5,0) codes justify an earlier fill date to the payer. For example if a patient "^DD",9002313.77,9002313.77,2.05,21,6,0) needed an early refill due to being on vacation when the prescription "^DD",9002313.77,9002313.77,2.05,21,7,0) would normally be filled, a VACATION SUPPLY clarification code can be used "^DD",9002313.77,9002313.77,2.05,21,8,0) as justification to the payer for filling the prescription thereby "^DD",9002313.77,9002313.77,2.05,21,9,0) mitigating any claims rejections. "^DD",9002313.77,9002313.77,2.05,23,0) ^^3^3^3110222^ "^DD",9002313.77,9002313.77,2.05,23,1,0) Up to 3 Submission Clarification Codes can be submitted, They are stored "^DD",9002313.77,9002313.77,2.05,23,2,0) in this free text field as follows: "^DD",9002313.77,9002313.77,2.05,23,3,0) SCC1~SCC2~SCC3 "^DD",9002313.77,9002313.77,2.05,"DT") 3110222 "^DD",9002313.77,9002313.77,2.1,0) DELAY REASON CODE^P9002313.29'^BPS(9002313.29,^2;10^Q "^DD",9002313.77,9002313.77,2.1,3) Enter the delay reason code that will be used for NCPDP request. "^DD",9002313.77,9002313.77,2.1,21,0) ^^4^4^3101019^ "^DD",9002313.77,9002313.77,2.1,21,1,0) This is the Delay Reason Code that is entered by the user from the IB Back "^DD",9002313.77,9002313.77,2.1,21,2,0) Billing Option of Claims Tracking and passed to ECME. It will be be put "^DD",9002313.77,9002313.77,2.1,21,3,0) into field 357-NV of the billing request that is created for third-party "^DD",9002313.77,9002313.77,2.1,21,4,0) billing. "^DD",9002313.77,9002313.77,2.1,"DT") 3101019 "^DD",9002313.77,9002313.77,9.01,0) INACTIVATION REASON^F^^9;1^K:$L(X)>100!($L(X)<1) X "^DD",9002313.77,9002313.77,9.01,3) Enter the reason the request was inactivated (1-100 characters). "^DD",9002313.77,9002313.77,9.01,21,0) ^^2^2^3101018^ "^DD",9002313.77,9002313.77,9.01,21,1,0) When a request is inactivated, the reason that it was inactivated will be "^DD",9002313.77,9002313.77,9.01,21,2,0) stored here so that the cause of the inactivation can be investigated. "^DD",9002313.77,9002313.77,9.01,"DT") 3101018 "^DD",9002313.78,9002313.78,.01,0) TRANSACTION ID^RNJ20,5^^0;1^K:+X'=X!(X>99999999999999)!(X<1)!(X?.E1"."6.N) X "^DD",9002313.78,9002313.78,.01,.1) "^DD",9002313.78,9002313.78,.01,1,0) ^.1 "^DD",9002313.78,9002313.78,.01,1,1,0) 9002313.78^B "^DD",9002313.78,9002313.78,.01,1,1,1) S ^BPS(9002313.78,"B",$E(X,1,30),DA)="" "^DD",9002313.78,9002313.78,.01,1,1,2) K ^BPS(9002313.78,"B",$E(X,1,30),DA) "^DD",9002313.78,9002313.78,.01,3) Enter the numeric identifier for the record (1- 99999999999999, 5 Decimal Digits). "^DD",9002313.78,9002313.78,.01,21,0) ^^8^8^3101020^ "^DD",9002313.78,9002313.78,.01,21,1,0) This is a numeric identifier that follows the same format as the IEN "^DD",9002313.78,9002313.78,.01,21,2,0) of the BPS TRANSACTION (#9002313.59) file. For billing requests and "^DD",9002313.78,9002313.78,.01,21,3,0) reversals, this is the Prescription IEN, followed by a decimal point, "^DD",9002313.78,9002313.78,.01,21,4,0) followed by the Fill Number left-padded with zeros up to four places and "^DD",9002313.78,9002313.78,.01,21,5,0) then followed by the COB indicator (1-Primary, 2-Secondary, 3-Tertiary). "^DD",9002313.78,9002313.78,.01,21,6,0) For a Eligibility Verification request, this is the Patient IEN, followed "^DD",9002313.78,9002313.78,.01,21,7,0) by a decimal point, followed by the Policy Number (with 9000 added to it) "^DD",9002313.78,9002313.78,.01,21,8,0) and then followed by 1. "^DD",9002313.78,9002313.78,.01,23,0) ^^9^9^3101020^ "^DD",9002313.78,9002313.78,.01,23,1,0) At the point that the BPS INSURER DATA record is created, the BPS "^DD",9002313.78,9002313.78,.01,23,2,0) TRANSACTION record may not be defined so this field uses the same format "^DD",9002313.78,9002313.78,.01,23,3,0) but cannot be a pointer. The value for this field is created by "^DD",9002313.78,9002313.78,.01,23,4,0) calling IEN^BPSOSRX, which is the same call that is done to determine the "^DD",9002313.78,9002313.78,.01,23,5,0) IEN of the BPS transaction file. Since the code that creates "^DD",9002313.78,9002313.78,.01,23,6,0) the value for this field and the code that calculates the IEN of the BPS "^DD",9002313.78,9002313.78,.01,23,7,0) Transaction field use the same API (and parameters), they both will have "^DD",9002313.78,9002313.78,.01,23,8,0) the same value and thus, the data does not need to be updated when the BPS "^DD",9002313.78,9002313.78,.01,23,9,0) Transaction record is created (it is already correct). "^DD",9002313.78,9002313.78,.01,"DT") 3101020 "^DD",9002313.78,9002313.78,.02,0) B1 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;2^Q "^DD",9002313.78,9002313.78,.02,3) Answer with the billing request payer sheet to be used for this payer. "^DD",9002313.78,9002313.78,.02,21,0) ^^3^3^3101019^ "^DD",9002313.78,9002313.78,.02,21,1,0) This is the payer sheet used to a submit billing request for this "^DD",9002313.78,9002313.78,.02,21,2,0) particular insurer. Billing request transmissions will be formatted per "^DD",9002313.78,9002313.78,.02,21,3,0) the specifications in this payer sheet. "^DD",9002313.78,9002313.78,.02,"DT") 3101019 "^DD",9002313.78,9002313.78,.04,0) B3 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;4^Q "^DD",9002313.78,9002313.78,.04,3) Enter the rebill payer sheet used for this payer. "^DD",9002313.78,9002313.78,.04,21,0) ^^3^3^3101018^ "^DD",9002313.78,9002313.78,.04,21,1,0) This is the payer sheet to be used for a rebill request for this insurer. "^DD",9002313.78,9002313.78,.04,21,2,0) Rebill transmission will be formatted per the specifications in this "^DD",9002313.78,9002313.78,.04,21,3,0) payer sheet. "^DD",9002313.78,9002313.78,.04,"DT") 3101018 "^DD",9002313.78,9002313.78,.1,0) E1 PAYER SHEET^P9002313.92'^BPSF(9002313.92,^0;10^Q "^DD",9002313.78,9002313.78,.1,3) Enter the eligibility verification payer sheet for the payer. "^DD",9002313.78,9002313.78,.1,21,0) ^^3^3^3101018^ "^DD",9002313.78,9002313.78,.1,21,1,0) This is the payer sheet to be used for eligibility verification requests "^DD",9002313.78,9002313.78,.1,21,2,0) for this insurer. Eligibility verification transmissions will be "^DD",9002313.78,9002313.78,.1,21,3,0) formatted per the specifications in this payer sheet. "^DD",9002313.78,9002313.78,.1,"DT") 3101018 "^DD",9002313.78,9002313.78,.11,0) POLICY NUMBER^NJ4,0^^0;11^K:+X'=X!(X>9999)!(X<0)!(X?.E1"."1.N) X "^DD",9002313.78,9002313.78,.11,3) Enter the policy number for this insurer (0-9999). "^DD",9002313.78,9002313.78,.11,21,0) ^^2^2^3101018^ "^DD",9002313.78,9002313.78,.11,21,1,0) This is the policy number assigned for this particular patient and "^DD",9002313.78,9002313.78,.11,21,2,0) insurer. "^DD",9002313.78,9002313.78,.11,"DT") 3101018 "^DD",9002313.78,9002313.78,2.07,0) MAXIMUM NCPDP TRANSACTIONS^NJ5,0^^2;7^K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.78,9002313.78,2.07,3) Enter the maximum number of transactions allowed in a request (1-9999). "^DD",9002313.78,9002313.78,2.07,21,0) ^^2^2^3101018^ "^DD",9002313.78,9002313.78,2.07,21,1,0) This is the maximum number of transactions that can be bundled in a "^DD",9002313.78,9002313.78,2.07,21,2,0) transmission. It is specified by the NCPDP processor. "^DD",9002313.78,9002313.78,2.07,"DT") 3101018 "^DD",9002313.78,9002313.78,4.01,0) B1 PAYER SHEET NAME^F^^4;1^K:$L(X)>30!($L(X)<3) X "^DD",9002313.78,9002313.78,4.01,3) Enter the name of the payer sheet that will be used for billing requests (3-30 characters). "^DD",9002313.78,9002313.78,4.01,21,0) ^^3^3^3101019^ "^DD",9002313.78,9002313.78,4.01,21,1,0) This is the name of the Billing Request Payer Sheet, which comes from the "^DD",9002313.78,9002313.78,4.01,21,2,0) RECORD FORMAT NAME (#.01) field of the BPS NCPDP FORMATS (#9002313.92) "^DD",9002313.78,9002313.78,4.01,21,3,0) file. "^DD",9002313.78,9002313.78,4.01,"DT") 3101019 "^DD",9002313.78,9002313.78,4.03,0) B3 PAYER SHEET NAME^F^^4;3^K:$L(X)>30!($L(X)<3) X "^DD",9002313.78,9002313.78,4.03,3) Enter the name of the payer sheet that will be used for rebill requests (3-30 characters). "^DD",9002313.78,9002313.78,4.03,21,0) ^^3^3^3101019^ "^DD",9002313.78,9002313.78,4.03,21,1,0) This is the name of the Rebill Payer Sheet, which comes from the "^DD",9002313.78,9002313.78,4.03,21,2,0) RECORD FORMAT NAME (#.01) field of the BPS NCPDP FORMATS (#9002313.92) "^DD",9002313.78,9002313.78,4.03,21,3,0) file. "^DD",9002313.78,9002313.78,4.03,"DT") 3101019 "^DD",9002313.78,9002313.78,4.04,0) E1 PAYER SHEET NAME^F^^4;4^K:$L(X)>30!($L(X)<3) X "^DD",9002313.78,9002313.78,4.04,3) Enter the name of the payer sheet that will be used for eligibility verification requests (3-30 characters). "^DD",9002313.78,9002313.78,4.04,21,0) ^^3^3^3101019^ "^DD",9002313.78,9002313.78,4.04,21,1,0) This is the name of the Eligibility Payer Sheet, which comes from the "^DD",9002313.78,9002313.78,4.04,21,2,0) RECORD FORMAT NAME (#.01) field of the BPS NCPDP FORMATS (#9002313.92) "^DD",9002313.78,9002313.78,4.04,21,3,0) file. "^DD",9002313.78,9002313.78,4.04,"DT") 3101019 "^DD",9002313.91,9002313.91,0) FIELD^^1.01^12 "^DD",9002313.91,9002313.91,0,"DDA") N "^DD",9002313.91,9002313.91,0,"DT") 3100915 "^DD",9002313.91,9002313.91,0,"ID",.03) W " ",$P(^(0),U,3) "^DD",9002313.91,9002313.91,0,"IX","B",9002313.91,.01) "^DD",9002313.91,9002313.91,0,"IX","C",9002313.91,.03) "^DD",9002313.91,9002313.91,0,"IX","D",9002313.91,.06) "^DD",9002313.91,9002313.91,0,"NM","BPS NCPDP FIELD DEFS") "^DD",9002313.91,9002313.91,0,"PT",9002313.311,.01) "^DD",9002313.91,9002313.91,0,"PT",9002313.3121,.01) "^DD",9002313.91,9002313.91,0,"PT",9002313.5111,.01) "^DD",9002313.91,9002313.91,0,"PT",9002313.9205,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9206,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9207,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9208,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9209,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.921,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9213,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9214,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9215,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9216,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9217,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9218,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9219,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.922,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9223,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9224,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.9225,.02) "^DD",9002313.91,9002313.91,0,"PT",9002313.94,.01) "^DD",9002313.91,9002313.91,0,"PT",102000102,.03) "^DD",9002313.91,9002313.91,0,"VRPK") BPS "^DD",9002313.91,9002313.91,.01,0) NCPDP FIELD NUMBER^RNJ6,2^^0;1^K:+X'=X!(X>997)!(X<0)!(X?.E1"."3N.N) X "^DD",9002313.91,9002313.91,.01,1,0) ^.1 "^DD",9002313.91,9002313.91,.01,1,1,0) 9002313.91^B "^DD",9002313.91,9002313.91,.01,1,1,1) S ^BPSF(9002313.91,"B",$E(X,1,30),DA)="" "^DD",9002313.91,9002313.91,.01,1,1,2) K ^BPSF(9002313.91,"B",$E(X,1,30),DA) "^DD",9002313.91,9002313.91,.01,3) Enter the NCPDP field number (0-997, 2 Decimal Digits). "^DD",9002313.91,9002313.91,.01,21,0) ^^1^1^3101014^ "^DD",9002313.91,9002313.91,.01,21,1,0) This is the NCPDP field number as specified in the NCPDP data dictionary. "^DD",9002313.91,9002313.91,.01,"DT") 3101014 "^DD",9002313.91,9002313.91,.03,0) NAME^F^^0;3^K:$L(X)>30!($L(X)<3) X "^DD",9002313.91,9002313.91,.03,1,0) ^.1 "^DD",9002313.91,9002313.91,.03,1,1,0) 9002313.91^C "^DD",9002313.91,9002313.91,.03,1,1,1) S ^BPSF(9002313.91,"C",$E(X,1,30),DA)="" "^DD",9002313.91,9002313.91,.03,1,1,2) K ^BPSF(9002313.91,"C",$E(X,1,30),DA) "^DD",9002313.91,9002313.91,.03,1,1,"DT") 3001007 "^DD",9002313.91,9002313.91,.03,3) Answer must be 3-30 characters in length. "^DD",9002313.91,9002313.91,.03,21,0) ^^2^2^3071227^ "^DD",9002313.91,9002313.91,.03,21,1,0) Descriptive name the tells what the field is within the pharmacy "^DD",9002313.91,9002313.91,.03,21,2,0) environment. "^DD",9002313.91,9002313.91,.03,"DT") 3071227 "^DD",9002313.91,9002313.91,.04,0) FORMAT^S^N:NUMERIC;A/N:ALPHA/NUMERIC;D:SIGNED NUMERIC;^0;4^Q "^DD",9002313.91,9002313.91,.04,3) Enter the field's format type. "^DD",9002313.91,9002313.91,.04,21,0) ^^1^1^3071227^ "^DD",9002313.91,9002313.91,.04,21,1,0) This is the format of the field used within the NCPDP standard. "^DD",9002313.91,9002313.91,.04,"DT") 3071227 "^DD",9002313.91,9002313.91,.06,0) ID^F^^5;1^K:$L(X)>2!($L(X)<2) X "^DD",9002313.91,9002313.91,.06,1,0) ^.1 "^DD",9002313.91,9002313.91,.06,1,1,0) 9002313.91^D "^DD",9002313.91,9002313.91,.06,1,1,1) S ^BPSF(9002313.91,"D",$E(X,1,30),DA)="" "^DD",9002313.91,9002313.91,.06,1,1,2) K ^BPSF(9002313.91,"D",$E(X,1,30),DA) "^DD",9002313.91,9002313.91,.06,1,1,"%D",0) ^^3^3^3020807^ "^DD",9002313.91,9002313.91,.06,1,1,"%D",1,0) Cross reference of the 5.1 Field ID. This cross reference will be used in "^DD",9002313.91,9002313.91,.06,1,1,"%D",2,0) the processing of the response as a means of translating the value to a "^DD",9002313.91,9002313.91,.06,1,1,"%D",3,0) field number. "^DD",9002313.91,9002313.91,.06,1,1,"DT") 3020807 "^DD",9002313.91,9002313.91,.06,3) Answer must be 2 characters in length. "^DD",9002313.91,9002313.91,.06,21,0) ^^3^3^3071227^ "^DD",9002313.91,9002313.91,.06,21,1,0) The same as the .02 field, but for specific use when creating 5.1 "^DD",9002313.91,9002313.91,.06,21,2,0) claims. The 5.1 fields were separated because 3.x and 5.1 claims were "^DD",9002313.91,9002313.91,.06,21,3,0) being submitted concurrently. "^DD",9002313.91,9002313.91,.06,"DT") 3071227 "^DD",9002313.91,9002313.91,.07,0) LENGTH^NJ4,0^^5;2^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1.N) X "^DD",9002313.91,9002313.91,.07,3) Type a number between 1 and 9999, 0 Decimal Digits "^DD",9002313.91,9002313.91,.07,21,0) ^^1^1^3040121^ "^DD",9002313.91,9002313.91,.07,21,1,0) Length of the field from the 5.1 NCPDP standard. "^DD",9002313.91,9002313.91,.07,"DT") 3071227 "^DD",9002313.91,9002313.91,.08,0) D0 LENGTH^NJ3,0^^0;8^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.91,9002313.91,.08,3) Enter the length of the NCPDP field per the NCPDP data dictionary (1-999). "^DD",9002313.91,9002313.91,.08,21,0) ^^2^2^3101014^ "^DD",9002313.91,9002313.91,.08,21,1,0) This is the NCPDP length as specified in the NCPDP Telecommunication "^DD",9002313.91,9002313.91,.08,21,2,0) Standard version D.0 data dictionary. "^DD",9002313.91,9002313.91,.08,"DT") 3101014 "^DD",9002313.91,9002313.91,.09,0) D0 FORMAT^S^N:NUMERIC;A/N:ALPHANUMERIC;D:SIGNED NUMERIC;^0;9^Q "^DD",9002313.91,9002313.91,.09,3) Enter the data type for the field based on the NCPDP data dictionary. "^DD",9002313.91,9002313.91,.09,21,0) ^^2^2^3101014^ "^DD",9002313.91,9002313.91,.09,21,1,0) This is the NCPDP data type as specified in the NCPDP Telecommunication "^DD",9002313.91,9002313.91,.09,21,2,0) Standard version D.0 data dictionary. "^DD",9002313.91,9002313.91,.09,"DT") 3101014 "^DD",9002313.91,9002313.91,1.01,0) STANDARD NCPDP FIELD NAME^F^^1;1^K:$L(X)>100!($L(X)<1) X "^DD",9002313.91,9002313.91,1.01,3) Enter the full NCPDP field name based on the NCPDP data dictionary (1-100 characters). "^DD",9002313.91,9002313.91,1.01,21,0) ^^3^3^3101014^ "^DD",9002313.91,9002313.91,1.01,21,1,0) This field is used for those NCPDP field names that were too long to fit "^DD",9002313.91,9002313.91,1.01,21,2,0) in the NAME (#.03) field. For those fields, this field will "^DD",9002313.91,9002313.91,1.01,21,3,0) have the full NCPDP field name. "^DD",9002313.91,9002313.91,1.01,"DT") 3110706 "^DD",9002313.91,9002313.91,10,0) GET CODE^9002313.9101^^10;0 "^DD",9002313.91,9002313.91,10,3) Enter the M code to extract the data for this field. "^DD",9002313.91,9002313.91,10,9) @ "^DD",9002313.91,9002313.91,10,21,0) ^.001^2^2^3101001^^ "^DD",9002313.91,9002313.91,10,21,1,0) M code that tells the BPS system where to find the "^DD",9002313.91,9002313.91,10,21,2,0) particular piece of data for this field. "^DD",9002313.91,9002313.91,10,"DT") 3071227 "^DD",9002313.91,9002313.91,20,0) D0 FORMAT CODE^9002313.9102^^20;0 "^DD",9002313.91,9002313.91,20,9) @ "^DD",9002313.91,9002313.91,20,21,0) ^^4^4^3101014^ "^DD",9002313.91,9002313.91,20,21,1,0) This field holds the M code used to format the data according to the "^DD",9002313.91,9002313.91,20,21,2,0) specifications of the NCPDP Telecommunication Standard version D.0 data "^DD",9002313.91,9002313.91,20,21,3,0) dictionary. For instance, alphanumeric fields are right-padded with "^DD",9002313.91,9002313.91,20,21,4,0) spaces up to the length of the specified by the NCPDP standard. "^DD",9002313.91,9002313.91,20,"DT") 3101005 "^DD",9002313.91,9002313.91,30,0) SET CODE^9002313.9103^^30;0 "^DD",9002313.91,9002313.91,30,3) Enter the M code for the field's data storage. "^DD",9002313.91,9002313.91,30,9) @ "^DD",9002313.91,9002313.91,30,21,0) ^^1^1^3040326^ "^DD",9002313.91,9002313.91,30,21,1,0) M code to store the data in the appropriate segment within the claim. "^DD",9002313.91,9002313.91,30,"DT") 3071227 "^DD",9002313.91,9002313.91,40,0) FORMAT CODE^9002313.9104^^25;0 "^DD",9002313.91,9002313.91,40,3) Enter the M code to format the data in NCPDP format. "^DD",9002313.91,9002313.91,40,9) @ "^DD",9002313.91,9002313.91,40,21,0) ^^2^2^3071227^ "^DD",9002313.91,9002313.91,40,21,1,0) M code to format the data before storing it in the claim. 5.1 was "^DD",9002313.91,9002313.91,40,21,2,0) separate because 3.2 and 5.1 claims were being submitted at the same time. "^DD",9002313.91,9002313.91,40,"DT") 3071227 "^DD",9002313.91,9002313.9101,0) GET CODE SUB-FIELD^^.01^1 "^DD",9002313.91,9002313.9101,0,"DT") 3071227 "^DD",9002313.91,9002313.9101,0,"NM","GET CODE") "^DD",9002313.91,9002313.9101,0,"UP") 9002313.91 "^DD",9002313.91,9002313.9101,.01,0) GET CODE^WL^^0;1^Q "^DD",9002313.91,9002313.9101,.01,3) Enter the M code to extract the data for this field. "^DD",9002313.91,9002313.9101,.01,9) @ "^DD",9002313.91,9002313.9101,.01,"DT") 3071227 "^DD",9002313.91,9002313.9102,0) D0 FORMAT CODE SUB-FIELD^^.01^1 "^DD",9002313.91,9002313.9102,0,"DT") 3100721 "^DD",9002313.91,9002313.9102,0,"NM","D0 FORMAT CODE") "^DD",9002313.91,9002313.9102,0,"UP") 9002313.91 "^DD",9002313.91,9002313.9102,.01,0) D0 FORMAT CODE^WLx^^0;1^Q "^DD",9002313.91,9002313.9102,.01,"DT") 3101014 "^DD",9002313.91,9002313.9103,0) SET CODE SUB-FIELD^^.01^1 "^DD",9002313.91,9002313.9103,0,"DT") 2950420 "^DD",9002313.91,9002313.9103,0,"NM","SET CODE") "^DD",9002313.91,9002313.9103,0,"UP") 9002313.91 "^DD",9002313.91,9002313.9103,.01,0) SET CODE^WL^^0;1^Q "^DD",9002313.91,9002313.9103,.01,3) Enter the M code for the field's data storage. "^DD",9002313.91,9002313.9103,.01,9) @ "^DD",9002313.91,9002313.9103,.01,"DT") 3071227 "^DD",9002313.91,9002313.9104,0) FORMAT CODE SUB-FIELD^^.01^1 "^DD",9002313.91,9002313.9104,0,"DT") 3020724 "^DD",9002313.91,9002313.9104,0,"NM","FORMAT CODE") "^DD",9002313.91,9002313.9104,0,"UP") 9002313.91 "^DD",9002313.91,9002313.9104,.01,0) FORMAT CODE^WL^^0;1^Q "^DD",9002313.91,9002313.9104,.01,3) Enter the M code to format the data in NCPDP format. "^DD",9002313.91,9002313.9104,.01,9) @ "^DD",9002313.91,9002313.9104,.01,"DT") 3071227 "^DD",9002313.92,9002313.92,1.02,0) VERSION^S^51:Version 5.1;D0:Version D.0;^1;2^Q "^DD",9002313.92,9002313.92,1.02,3) Enter the NCPDP version for this payer sheet. "^DD",9002313.92,9002313.92,1.02,21,0) ^^2^2^3101019^ "^DD",9002313.92,9002313.92,1.02,21,1,0) This is the NCPDP Version Number. The request that is created will "^DD",9002313.92,9002313.92,1.02,21,2,0) follow the specification of this NCPDP Version. "^DD",9002313.92,9002313.92,1.02,"DT") 3110706 "^DD",9002313.92,9002313.92,100,0) TRANSACTION HEADER SEGMENT^9002313.9205A^^100;0 "^DD",9002313.92,9002313.92,100,"DT") 3071227 "^DD",9002313.92,9002313.92,110,0) PATIENT SEGMENT^9002313.9206A^^110;0 "^DD",9002313.92,9002313.92,110,"DT") 3101020 "^DD",9002313.92,9002313.92,120,0) INSURANCE SEGMENT^9002313.9207A^^120;0 "^DD",9002313.92,9002313.92,120,"DT") 3071227 "^DD",9002313.92,9002313.92,130,0) CLAIM SEGMENT^9002313.9208A^^130;0 "^DD",9002313.92,9002313.92,130,"DT") 3101006 "^DD",9002313.92,9002313.92,140,0) PHARMACY PROVIDER SEGMENT^9002313.9209A^^140;0 "^DD",9002313.92,9002313.92,140,"DT") 3071227 "^DD",9002313.92,9002313.92,150,0) PRESCRIBER SEGMENT^9002313.921A^^150;0 "^DD",9002313.92,9002313.92,150,"DT") 3071227 "^DD",9002313.92,9002313.92,160,0) COB OTHER PAYMENTS SEGMENT^9002313.9213A^^160;0 "^DD",9002313.92,9002313.92,160,"DT") 3071227 "^DD",9002313.92,9002313.92,170,0) WORKERS COMP SEGMENT^9002313.9214A^^170;0 "^DD",9002313.92,9002313.92,170,"DT") 3080616 "^DD",9002313.92,9002313.92,180,0) DUR PPS SEGMENT^9002313.9215A^^180;0 "^DD",9002313.92,9002313.92,180,"DT") 3071227 "^DD",9002313.92,9002313.92,190,0) PRICING SEGMENT^9002313.9216A^^190;0 "^DD",9002313.92,9002313.92,190,"DT") 3071227 "^DD",9002313.92,9002313.92,200,0) COUPON SEGMENT^9002313.9217A^^200;0 "^DD",9002313.92,9002313.92,200,"DT") 3071227 "^DD",9002313.92,9002313.92,210,0) COMPOUND SEGMENT^9002313.9218A^^210;0 "^DD",9002313.92,9002313.92,210,"DT") 3071227 "^DD",9002313.92,9002313.92,220,0) PRIOR AUTH SEGMENT^9002313.9219A^^220;0 "^DD",9002313.92,9002313.92,220,"DT") 3071227 "^DD",9002313.92,9002313.92,230,0) CLINICAL SEGMENT^9002313.922A^^230;0 "^DD",9002313.92,9002313.92,230,"DT") 3071227 "^DD",9002313.92,9002313.92,240,0) ADDL DOC SEGMENT^9002313.9223A^^240;0 "^DD",9002313.92,9002313.92,240,21,0) ^.001^2^2^3101020^^ "^DD",9002313.92,9002313.92,240,21,1,0) This subfile holds the fields and processing rules for the Additional "^DD",9002313.92,9002313.92,240,21,2,0) Documentation Segment. "^DD",9002313.92,9002313.92,240,"DT") 3100928 "^DD",9002313.92,9002313.92,250,0) FACILITY SEGMENT^9002313.9224A^^250;0 "^DD",9002313.92,9002313.92,250,21,0) ^.001^2^2^3101020^^ "^DD",9002313.92,9002313.92,250,21,1,0) This subfile holds the fields and processing rules for the Facility "^DD",9002313.92,9002313.92,250,21,2,0) segment. "^DD",9002313.92,9002313.92,260,0) NARRATIVE SEGMENT^9002313.9225A^^260;0 "^DD",9002313.92,9002313.92,260,21,0) ^.001^2^2^3101020^^ "^DD",9002313.92,9002313.92,260,21,1,0) This subfile holds the fields and processing rules for the Narrative "^DD",9002313.92,9002313.92,260,21,2,0) segment. "^DD",9002313.92,9002313.92,260,"DT") 3100928 "^DD",9002313.92,9002313.9205,0) TRANSACTION HEADER SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9205,0,"NM","TRANSACTION HEADER SEGMENT") "^DD",9002313.92,9002313.9205,.01,0) TRANSACTION HEADER ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9205,.01,1,0) ^.1 "^DD",9002313.92,9002313.9205,.01,1,1,0) 9002313.9205^B "^DD",9002313.92,9002313.9205,.01,1,1,1) S ^BPSF(9002313.92,DA(1),100,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9205,.01,1,1,2) K ^BPSF(9002313.92,DA(1),100,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9205,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9205,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9205,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9205,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9205,.01,"DT") 3101019 "^DD",9002313.92,9002313.9205,1,0) SPECIAL CODE^9002313.92051^^1;0 "^DD",9002313.92,9002313.9205,1,3) Enter M code used to create the Transaction Header Segment. "^DD",9002313.92,9002313.9205,1,9) @ "^DD",9002313.92,9002313.9205,1,21,0) ^.001^1^1^3101018^^ "^DD",9002313.92,9002313.9205,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9205,1,"DT") 3071227 "^DD",9002313.92,9002313.92051,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92051,0,"DT") 3071227 "^DD",9002313.92,9002313.92051,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92051,0,"UP") 9002313.9205 "^DD",9002313.92,9002313.92051,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92051,.01,3) Enter M code used to create the Transaction Header Segment. "^DD",9002313.92,9002313.92051,.01,"DT") 3071227 "^DD",9002313.92,9002313.9206,0) PATIENT SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9206,0,"NM","PATIENT SEGMENT") "^DD",9002313.92,9002313.9206,.01,0) PATIENT SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9206,.01,1,0) ^.1 "^DD",9002313.92,9002313.9206,.01,1,1,0) 9002313.9206^B "^DD",9002313.92,9002313.9206,.01,1,1,1) S ^BPSF(9002313.92,DA(1),110,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9206,.01,1,1,2) K ^BPSF(9002313.92,DA(1),110,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9206,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9206,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9206,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9206,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9206,.01,"DT") 3101019 "^DD",9002313.92,9002313.9206,1,0) SPECIAL CODE^9002313.92061^^1;0 "^DD",9002313.92,9002313.9206,1,3) Enter M code used to create the Patient Segment. "^DD",9002313.92,9002313.9206,1,9) @ "^DD",9002313.92,9002313.9206,1,21,0) ^^1^1^3071227^ "^DD",9002313.92,9002313.9206,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9206,1,"DT") 3071227 "^DD",9002313.92,9002313.92061,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92061,0,"DT") 3020801 "^DD",9002313.92,9002313.92061,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92061,0,"UP") 9002313.9206 "^DD",9002313.92,9002313.92061,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92061,.01,3) Enter M code used to create the Patient Segment. "^DD",9002313.92,9002313.92061,.01,"DT") 3071227 "^DD",9002313.92,9002313.9207,0) INSURANCE SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9207,0,"NM","INSURANCE SEGMENT") "^DD",9002313.92,9002313.9207,.01,0) INSURANCE SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9207,.01,1,0) ^.1 "^DD",9002313.92,9002313.9207,.01,1,1,0) 9002313.9207^B "^DD",9002313.92,9002313.9207,.01,1,1,1) S ^BPSF(9002313.92,DA(1),120,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9207,.01,1,1,2) K ^BPSF(9002313.92,DA(1),120,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9207,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9207,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9207,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9207,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9207,.01,"DT") 3101019 "^DD",9002313.92,9002313.9207,1,0) SPECIAL CODE^9002313.92071^^1;0 "^DD",9002313.92,9002313.9207,1,3) Enter M code used to create the Insurance Segment. "^DD",9002313.92,9002313.9207,1,9) @ "^DD",9002313.92,9002313.9207,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9207,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9207,1,"DT") 3071227 "^DD",9002313.92,9002313.92071,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92071,0,"DT") 3020801 "^DD",9002313.92,9002313.92071,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92071,0,"UP") 9002313.9207 "^DD",9002313.92,9002313.92071,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92071,.01,3) Enter M code used to create the Insurance Segment. "^DD",9002313.92,9002313.92071,.01,"DT") 3071227 "^DD",9002313.92,9002313.9208,0) CLAIM SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9208,0,"NM","CLAIM SEGMENT") "^DD",9002313.92,9002313.9208,.01,0) CLAIM SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9208,.01,1,0) ^.1 "^DD",9002313.92,9002313.9208,.01,1,1,0) 9002313.9208^B "^DD",9002313.92,9002313.9208,.01,1,1,1) S ^BPSF(9002313.92,DA(1),130,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9208,.01,1,1,2) K ^BPSF(9002313.92,DA(1),130,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9208,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9208,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9208,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9208,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9208,.01,"DT") 3101019 "^DD",9002313.92,9002313.9208,1,0) SPECIAL CODE^9002313.92081^^1;0 "^DD",9002313.92,9002313.9208,1,3) Enter M code used to create the Claim Segment. "^DD",9002313.92,9002313.9208,1,9) @ "^DD",9002313.92,9002313.9208,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9208,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9208,1,"DT") 3071227 "^DD",9002313.92,9002313.92081,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92081,0,"DT") 3020801 "^DD",9002313.92,9002313.92081,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92081,0,"UP") 9002313.9208 "^DD",9002313.92,9002313.92081,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92081,.01,3) Enter M code used to create the Claim Segment. "^DD",9002313.92,9002313.92081,.01,"DT") 3071227 "^DD",9002313.92,9002313.9209,0) PHARMACY PROVIDER SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9209,0,"NM","PHARMACY PROVIDER SEGMENT") "^DD",9002313.92,9002313.9209,.01,0) PHARMACY PROVIDER ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9209,.01,1,0) ^.1 "^DD",9002313.92,9002313.9209,.01,1,1,0) 9002313.9209^B "^DD",9002313.92,9002313.9209,.01,1,1,1) S ^BPSF(9002313.92,DA(1),140,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9209,.01,1,1,2) K ^BPSF(9002313.92,DA(1),140,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9209,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9209,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9209,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9209,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9209,.01,"DT") 3101019 "^DD",9002313.92,9002313.9209,1,0) SPECIAL CODE^9002313.92091^^1;0 "^DD",9002313.92,9002313.9209,1,3) Enter M code used to create the Pharmacy Provider Segment. "^DD",9002313.92,9002313.9209,1,9) @ "^DD",9002313.92,9002313.9209,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9209,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9209,1,"DT") 3071227 "^DD",9002313.92,9002313.92091,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92091,0,"DT") 3020801 "^DD",9002313.92,9002313.92091,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92091,0,"UP") 9002313.9209 "^DD",9002313.92,9002313.92091,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92091,.01,3) Enter M code used to create the Pharmacy Provider Segment. "^DD",9002313.92,9002313.92091,.01,"DT") 3071227 "^DD",9002313.92,9002313.921,0) PRESCRIBER SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.921,0,"NM","PRESCRIBER SEGMENT") "^DD",9002313.92,9002313.921,.01,0) PRESCRIBER SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.921,.01,1,0) ^.1 "^DD",9002313.92,9002313.921,.01,1,1,0) 9002313.921^B "^DD",9002313.92,9002313.921,.01,1,1,1) S ^BPSF(9002313.92,DA(1),150,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.921,.01,1,1,2) K ^BPSF(9002313.92,DA(1),150,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.921,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.921,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.921,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.921,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.921,.01,"DT") 3101019 "^DD",9002313.92,9002313.921,1,0) SPECIAL CODE^9002313.9211^^1;0 "^DD",9002313.92,9002313.921,1,3) Enter M code used to create the Prescriber Segment. "^DD",9002313.92,9002313.921,1,9) @ "^DD",9002313.92,9002313.921,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.921,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.921,1,"DT") 3071227 "^DD",9002313.92,9002313.9211,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.9211,0,"DT") 3020801 "^DD",9002313.92,9002313.9211,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.9211,0,"UP") 9002313.921 "^DD",9002313.92,9002313.9211,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.9211,.01,3) Enter M code used to create the Prescriber Segment. "^DD",9002313.92,9002313.9211,.01,"DT") 3071227 "^DD",9002313.92,9002313.9213,0) COB OTHER PAYMENTS SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9213,0,"NM","COB OTHER PAYMENTS SEGMENT") "^DD",9002313.92,9002313.9213,.01,0) COB OTHER PAYMENTS ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9213,.01,1,0) ^.1 "^DD",9002313.92,9002313.9213,.01,1,1,0) 9002313.9213^B "^DD",9002313.92,9002313.9213,.01,1,1,1) S ^BPSF(9002313.92,DA(1),160,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9213,.01,1,1,2) K ^BPSF(9002313.92,DA(1),160,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9213,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9213,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9213,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9213,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9213,.01,"DT") 3101019 "^DD",9002313.92,9002313.9213,1,0) SPECIAL CODE^9002313.92131^^1;0 "^DD",9002313.92,9002313.9213,1,3) Enter M code used to create the COB Other Payments Segment. "^DD",9002313.92,9002313.9213,1,9) @ "^DD",9002313.92,9002313.9213,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9213,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9213,1,"DT") 3071227 "^DD",9002313.92,9002313.92131,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92131,0,"DT") 3020801 "^DD",9002313.92,9002313.92131,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92131,0,"UP") 9002313.9213 "^DD",9002313.92,9002313.92131,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92131,.01,3) Enter M code used to create the COB Other Payments Segment. "^DD",9002313.92,9002313.92131,.01,"DT") 3071227 "^DD",9002313.92,9002313.9214,0) WORKERS COMP SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9214,0,"NM","WORKERS COMP SEGMENT") "^DD",9002313.92,9002313.9214,.01,0) WORKERS COMP SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9214,.01,1,0) ^.1 "^DD",9002313.92,9002313.9214,.01,1,1,0) 9002313.9214^B "^DD",9002313.92,9002313.9214,.01,1,1,1) S ^BPSF(9002313.92,DA(1),170,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9214,.01,1,1,2) K ^BPSF(9002313.92,DA(1),170,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9214,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9214,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9214,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9214,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9214,.01,"DT") 3101019 "^DD",9002313.92,9002313.9214,1,0) SPECIAL CODE^9002313.92141^^1;0 "^DD",9002313.92,9002313.9214,1,3) Enter M code used to create the Worker's Comp Segment. "^DD",9002313.92,9002313.9214,1,9) @ "^DD",9002313.92,9002313.9214,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9214,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9214,1,"DT") 3071227 "^DD",9002313.92,9002313.92141,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92141,0,"DT") 3020801 "^DD",9002313.92,9002313.92141,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92141,0,"UP") 9002313.9214 "^DD",9002313.92,9002313.92141,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92141,.01,3) Enter M code used to create the Worker's Comp Segment. "^DD",9002313.92,9002313.92141,.01,"DT") 3071227 "^DD",9002313.92,9002313.9215,0) DUR PPS SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9215,0,"NM","DUR PPS SEGMENT") "^DD",9002313.92,9002313.9215,.01,0) DUR PPS SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9215,.01,1,0) ^.1 "^DD",9002313.92,9002313.9215,.01,1,1,0) 9002313.9215^B "^DD",9002313.92,9002313.9215,.01,1,1,1) S ^BPSF(9002313.92,DA(1),180,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9215,.01,1,1,2) K ^BPSF(9002313.92,DA(1),180,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9215,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9215,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9215,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9215,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9215,.01,"DT") 3101019 "^DD",9002313.92,9002313.9215,1,0) SPECIAL CODE^9002313.92151^^1;0 "^DD",9002313.92,9002313.9215,1,3) Enter M code used to create the DUR PPS Segment. "^DD",9002313.92,9002313.9215,1,9) @ "^DD",9002313.92,9002313.9215,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9215,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9215,1,"DT") 3071227 "^DD",9002313.92,9002313.92151,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92151,0,"DT") 3020801 "^DD",9002313.92,9002313.92151,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92151,0,"UP") 9002313.9215 "^DD",9002313.92,9002313.92151,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92151,.01,3) Enter M code used to create the DUR PPS Segment. "^DD",9002313.92,9002313.92151,.01,"DT") 3071227 "^DD",9002313.92,9002313.9216,0) PRICING SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9216,0,"NM","PRICING SEGMENT") "^DD",9002313.92,9002313.9216,.01,0) PRICING SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9216,.01,1,0) ^.1 "^DD",9002313.92,9002313.9216,.01,1,1,0) 9002313.9216^B "^DD",9002313.92,9002313.9216,.01,1,1,1) S ^BPSF(9002313.92,DA(1),190,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9216,.01,1,1,2) K ^BPSF(9002313.92,DA(1),190,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9216,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9216,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9216,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9216,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9216,.01,"DT") 3101019 "^DD",9002313.92,9002313.9216,1,0) SPECIAL CODE^9002313.92161^^1;0 "^DD",9002313.92,9002313.9216,1,3) Enter M code used to create the Pricing Segment. "^DD",9002313.92,9002313.9216,1,9) @ "^DD",9002313.92,9002313.9216,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9216,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9216,1,"DT") 3071227 "^DD",9002313.92,9002313.92161,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92161,0,"DT") 3020801 "^DD",9002313.92,9002313.92161,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92161,0,"UP") 9002313.9216 "^DD",9002313.92,9002313.92161,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92161,.01,3) Enter M code used to create the Pricing Segment. "^DD",9002313.92,9002313.92161,.01,"DT") 3071227 "^DD",9002313.92,9002313.9217,0) COUPON SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9217,0,"NM","COUPON SEGMENT") "^DD",9002313.92,9002313.9217,.01,0) COUPON SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9217,.01,1,0) ^.1 "^DD",9002313.92,9002313.9217,.01,1,1,0) 9002313.9217^B "^DD",9002313.92,9002313.9217,.01,1,1,1) S ^BPSF(9002313.92,DA(1),200,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9217,.01,1,1,2) K ^BPSF(9002313.92,DA(1),200,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9217,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9217,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9217,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9217,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9217,.01,"DT") 3101019 "^DD",9002313.92,9002313.9217,1,0) SPECIAL CODE^9002313.92171^^1;0 "^DD",9002313.92,9002313.9217,1,3) Enter M code used to create the Coupon Segment. "^DD",9002313.92,9002313.9217,1,9) @ "^DD",9002313.92,9002313.9217,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9217,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9217,1,"DT") 3071227 "^DD",9002313.92,9002313.92171,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92171,0,"DT") 3020801 "^DD",9002313.92,9002313.92171,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92171,0,"UP") 9002313.9217 "^DD",9002313.92,9002313.92171,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92171,.01,3) Enter M code used to create the Coupon Segment. "^DD",9002313.92,9002313.92171,.01,"DT") 3071227 "^DD",9002313.92,9002313.9218,0) COMPOUND SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9218,0,"NM","COMPOUND SEGMENT") "^DD",9002313.92,9002313.9218,.01,0) COMPOUND SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9218,.01,1,0) ^.1 "^DD",9002313.92,9002313.9218,.01,1,1,0) 9002313.9218^B "^DD",9002313.92,9002313.9218,.01,1,1,1) S ^BPSF(9002313.92,DA(1),210,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9218,.01,1,1,2) K ^BPSF(9002313.92,DA(1),210,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9218,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9218,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9218,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9218,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9218,.01,"DT") 3101019 "^DD",9002313.92,9002313.9218,1,0) SPECIAL CODE^9002313.92181^^1;0 "^DD",9002313.92,9002313.9218,1,3) Enter M code used to create the Compound Segment. "^DD",9002313.92,9002313.9218,1,9) @ "^DD",9002313.92,9002313.9218,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9218,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9218,1,"DT") 3071227 "^DD",9002313.92,9002313.92181,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92181,0,"DT") 3020801 "^DD",9002313.92,9002313.92181,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92181,0,"UP") 9002313.9218 "^DD",9002313.92,9002313.92181,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92181,.01,3) Enter M code used to create the Compound Segment. "^DD",9002313.92,9002313.92181,.01,"DT") 3071227 "^DD",9002313.92,9002313.9219,0) PRIOR AUTH SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9219,0,"NM","PRIOR AUTH SEGMENT") "^DD",9002313.92,9002313.9219,.01,0) PRIOR AUTH SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9219,.01,1,0) ^.1 "^DD",9002313.92,9002313.9219,.01,1,1,0) 9002313.9219^B "^DD",9002313.92,9002313.9219,.01,1,1,1) S ^BPSF(9002313.92,DA(1),220,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9219,.01,1,1,2) K ^BPSF(9002313.92,DA(1),220,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9219,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9219,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9219,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9219,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9219,.01,"DT") 3101019 "^DD",9002313.92,9002313.9219,1,0) SPECIAL CODE^9002313.92191^^1;0 "^DD",9002313.92,9002313.9219,1,3) Enter M code used to create the Prior Auth Segment. "^DD",9002313.92,9002313.9219,1,9) @ "^DD",9002313.92,9002313.9219,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.9219,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.9219,1,"DT") 3071227 "^DD",9002313.92,9002313.92191,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92191,0,"DT") 3020801 "^DD",9002313.92,9002313.92191,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92191,0,"UP") 9002313.9219 "^DD",9002313.92,9002313.92191,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.92191,.01,3) Enter M code used to create the Prior Auth Segment. "^DD",9002313.92,9002313.92191,.01,"DT") 3071227 "^DD",9002313.92,9002313.922,0) CLINICAL SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.922,0,"NM","CLINICAL SEGMENT") "^DD",9002313.92,9002313.922,.01,0) CLINICAL SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.922,.01,1,0) ^.1 "^DD",9002313.92,9002313.922,.01,1,1,0) 9002313.922^B "^DD",9002313.92,9002313.922,.01,1,1,1) S ^BPSF(9002313.92,DA(1),230,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.922,.01,1,1,2) K ^BPSF(9002313.92,DA(1),230,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.922,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.922,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.922,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.922,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.922,.01,"DT") 3101019 "^DD",9002313.92,9002313.922,1,0) SPECIAL CODE^9002313.9221^^1;0 "^DD",9002313.92,9002313.922,1,3) Enter M code used to create the Clinical Segment. "^DD",9002313.92,9002313.922,1,9) @ "^DD",9002313.92,9002313.922,1,21,0) ^^1^1^3040220^ "^DD",9002313.92,9002313.922,1,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.922,1,"DT") 3071227 "^DD",9002313.92,9002313.9221,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.9221,0,"DT") 3020801 "^DD",9002313.92,9002313.9221,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.9221,0,"UP") 9002313.922 "^DD",9002313.92,9002313.9221,.01,0) SPECIAL CODE^WL^^0;1^Q "^DD",9002313.92,9002313.9221,.01,3) Enter M code used to create the Clinical Segment. "^DD",9002313.92,9002313.9221,.01,"DT") 3071227 "^DD",9002313.92,9002313.9223,0) ADDL DOC SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9223,0,"DT") 3100930 "^DD",9002313.92,9002313.9223,0,"IX","B",9002313.9223,.01) "^DD",9002313.92,9002313.9223,0,"NM","ADDL DOC SEGMENT") "^DD",9002313.92,9002313.9223,0,"UP") 9002313.92 "^DD",9002313.92,9002313.9223,.01,0) ADDL DOCUMENTATION ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9223,.01,1,0) ^.1 "^DD",9002313.92,9002313.9223,.01,1,1,0) 9002313.9223^B "^DD",9002313.92,9002313.9223,.01,1,1,1) S ^BPSF(9002313.92,DA(1),240,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9223,.01,1,1,2) K ^BPSF(9002313.92,DA(1),240,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9223,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9223,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9223,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9223,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9223,.01,"DT") 3101019 "^DD",9002313.92,9002313.9223,.02,0) NCPDP FIELD NUMBER^P9002313.91'^BPSF(9002313.91,^0;2^Q "^DD",9002313.92,9002313.9223,.02,3) Select the NCPDP field number belonging to the Additional Documentation Segment. "^DD",9002313.92,9002313.9223,.02,21,0) ^^1^1^3101019^ "^DD",9002313.92,9002313.9223,.02,21,1,0) This is the NCPDP field that belongs to this segment of the payer sheet. "^DD",9002313.92,9002313.9223,.02,"DT") 3110706 "^DD",9002313.92,9002313.9223,.03,0) PROCESSING MODE^S^D:DEFAULT;S:STANDARD;X:SPECIAL;?:UNKNOWN;^0;3^Q "^DD",9002313.92,9002313.9223,.03,3) Specify the mode for processing this field. "^DD",9002313.92,9002313.9223,.03,21,0) ^^1^1^3101019^ "^DD",9002313.92,9002313.9223,.03,21,1,0) This is the processing mode that will be used for this field. "^DD",9002313.92,9002313.9223,.03,"DT") 3101019 "^DD",9002313.92,9002313.9223,1,0) SPECIAL CODE^9002313.92231^^1;0 "^DD",9002313.92,9002313.9223,1,9) @ "^DD",9002313.92,9002313.9223,1,21,0) ^.001^1^1^3101103^^ "^DD",9002313.92,9002313.9223,1,21,1,0) This is the M code that is executed when the Processing Mode is "X". "^DD",9002313.92,9002313.9223,2,0) PROGRAMMING NOTES^9002313.92232^^2;0 "^DD",9002313.92,9002313.9223,2,21,0) ^^1^1^3101020^ "^DD",9002313.92,9002313.9223,2,21,1,0) This is an optional description of the special code. "^DD",9002313.92,9002313.92231,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92231,0,"DT") 3100928 "^DD",9002313.92,9002313.92231,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92231,0,"UP") 9002313.9223 "^DD",9002313.92,9002313.92231,.01,0) SPECIAL CODE^WLx^^0;1^Q "^DD",9002313.92,9002313.92231,.01,3) Enter M code used to create the Additional Documentation Segment. "^DD",9002313.92,9002313.92231,.01,21,0) ^^1^1^3101015^ "^DD",9002313.92,9002313.92231,.01,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.92231,.01,"DT") 3101015 "^DD",9002313.92,9002313.92232,0) PROGRAMMING NOTES SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92232,0,"DT") 3100928 "^DD",9002313.92,9002313.92232,0,"NM","PROGRAMMING NOTES") "^DD",9002313.92,9002313.92232,0,"UP") 9002313.9223 "^DD",9002313.92,9002313.92232,.01,0) PROGRAMMING NOTES^WLx^^0;1^Q "^DD",9002313.92,9002313.92232,.01,3) Enter notes relating to the M code. "^DD",9002313.92,9002313.92232,.01,21,0) ^^1^1^3101015^ "^DD",9002313.92,9002313.92232,.01,21,1,0) Description of what is being accomplished by executing the special code. "^DD",9002313.92,9002313.92232,.01,"DT") 3101015 "^DD",9002313.92,9002313.9224,0) FACILITY SEGMENT SUB-FIELD^^1^5 "^DD",9002313.92,9002313.9224,0,"DT") 3100930 "^DD",9002313.92,9002313.9224,0,"IX","B",9002313.9224,.01) "^DD",9002313.92,9002313.9224,0,"NM","FACILITY SEGMENT") "^DD",9002313.92,9002313.9224,0,"UP") 9002313.92 "^DD",9002313.92,9002313.9224,.01,0) FACILITY SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9224,.01,1,0) ^.1 "^DD",9002313.92,9002313.9224,.01,1,1,0) 9002313.9224^B "^DD",9002313.92,9002313.9224,.01,1,1,1) S ^BPSF(9002313.92,DA(1),250,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9224,.01,1,1,2) K ^BPSF(9002313.92,DA(1),250,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9224,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9224,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9224,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9224,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9224,.01,"DT") 3101021 "^DD",9002313.92,9002313.9224,.01,"V",0) ^.12P "^DD",9002313.92,9002313.9224,.02,0) NCPDP FIELD NUMBER^P9002313.91'^BPSF(9002313.91,^0;2^Q "^DD",9002313.92,9002313.9224,.02,3) Select the NCPDP field number belonging to the Facility Segment. "^DD",9002313.92,9002313.9224,.02,21,0) ^^1^1^3101019^ "^DD",9002313.92,9002313.9224,.02,21,1,0) This is the NCPDP field that belongs to this segment of the payer sheet. "^DD",9002313.92,9002313.9224,.02,"DT") 3110706 "^DD",9002313.92,9002313.9224,.03,0) PROCESSING MODE^S^D:DEFAULT;S:STANDARD;X:SPECIAL;?:UNKNOWN;^0;3^Q "^DD",9002313.92,9002313.9224,.03,3) Specify the mode for processing this field. "^DD",9002313.92,9002313.9224,.03,21,0) ^^1^1^3101019^ "^DD",9002313.92,9002313.9224,.03,21,1,0) This is the processing mode that will be used for this field. "^DD",9002313.92,9002313.9224,.03,"DT") 3101019 "^DD",9002313.92,9002313.9224,1,0) SPECIAL CODE^9002313.92241^^1;0 "^DD",9002313.92,9002313.9224,1,9) @ "^DD",9002313.92,9002313.9224,1,21,0) ^^1^1^3101020^ "^DD",9002313.92,9002313.9224,1,21,1,0) This is the M code that is executed when the Processing Mode is "X". "^DD",9002313.92,9002313.9224,2,0) PROGRAMMING NOTES^9002313.92242^^2;0 "^DD",9002313.92,9002313.9224,2,21,0) ^^1^1^3101020^ "^DD",9002313.92,9002313.9224,2,21,1,0) This is an optional description of the special code. "^DD",9002313.92,9002313.92241,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92241,0,"DT") 3100928 "^DD",9002313.92,9002313.92241,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92241,0,"UP") 9002313.9224 "^DD",9002313.92,9002313.92241,.01,0) SPECIAL CODE^WLx^^0;1^Q "^DD",9002313.92,9002313.92241,.01,3) Enter M code used to create the Facility Segment "^DD",9002313.92,9002313.92241,.01,21,0) ^^1^1^3100928^ "^DD",9002313.92,9002313.92241,.01,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.92241,.01,"DT") 3100928 "^DD",9002313.92,9002313.92242,0) PROGRAMMING NOTES SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92242,0,"DT") 3100928 "^DD",9002313.92,9002313.92242,0,"NM","PROGRAMMING NOTES") "^DD",9002313.92,9002313.92242,0,"UP") 9002313.9224 "^DD",9002313.92,9002313.92242,.01,0) PROGRAMMING NOTES^WLx^^0;1^Q "^DD",9002313.92,9002313.92242,.01,3) Enter notes relating to the M code. "^DD",9002313.92,9002313.92242,.01,21,0) ^^1^1^3100928^ "^DD",9002313.92,9002313.92242,.01,21,1,0) Description of what is being accomplished by executing the special code. "^DD",9002313.92,9002313.92242,.01,"DT") 3100928 "^DD",9002313.92,9002313.9225,0) NARRATIVE SEGMENT SUB-FIELD^^2^5 "^DD",9002313.92,9002313.9225,0,"DT") 3100930 "^DD",9002313.92,9002313.9225,0,"IX","B",9002313.9225,.01) "^DD",9002313.92,9002313.9225,0,"NM","NARRATIVE SEGMENT") "^DD",9002313.92,9002313.9225,0,"UP") 9002313.92 "^DD",9002313.92,9002313.9225,.01,0) NARRATIVE SEGMENT ORDER^MNJ4,0^^0;1^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",9002313.92,9002313.9225,.01,1,0) ^.1 "^DD",9002313.92,9002313.9225,.01,1,1,0) 9002313.9225^B "^DD",9002313.92,9002313.9225,.01,1,1,1) S ^BPSF(9002313.92,DA(1),260,"B",$E(X,1,30),DA)="" "^DD",9002313.92,9002313.9225,.01,1,1,2) K ^BPSF(9002313.92,DA(1),260,"B",$E(X,1,30),DA) "^DD",9002313.92,9002313.9225,.01,3) Type a number between 1 and 9999, 0 decimal digits. "^DD",9002313.92,9002313.9225,.01,21,0) ^^2^2^3101020^ "^DD",9002313.92,9002313.9225,.01,21,1,0) This field indicates the order of the NCPDP field as it will appear on "^DD",9002313.92,9002313.9225,.01,21,2,0) an NCPDP request. "^DD",9002313.92,9002313.9225,.01,"DT") 3101019 "^DD",9002313.92,9002313.9225,.01,"V",0) ^.12P "^DD",9002313.92,9002313.9225,.02,0) NCPDP FIELD NUMBER^P9002313.91'^BPSF(9002313.91,^0;2^Q "^DD",9002313.92,9002313.9225,.02,3) Select the NCPDP field number belonging to the Narrative Segment. "^DD",9002313.92,9002313.9225,.02,21,0) ^^1^1^3101019^ "^DD",9002313.92,9002313.9225,.02,21,1,0) This is the NCPDP field that belongs to this segment of the payer sheet. "^DD",9002313.92,9002313.9225,.02,"DT") 3101019 "^DD",9002313.92,9002313.9225,.03,0) PROCESSING MODE^S^D:DEFAULT;S:STANDARD;X:SPECIAL;?:UNKNOWN;^0;3^Q "^DD",9002313.92,9002313.9225,.03,3) Specify the mode for processing this field. "^DD",9002313.92,9002313.9225,.03,21,0) ^^1^1^3101019^ "^DD",9002313.92,9002313.9225,.03,21,1,0) This is the processing mode that will be used for this field. "^DD",9002313.92,9002313.9225,.03,"DT") 3101019 "^DD",9002313.92,9002313.9225,1,0) SPECIAL CODE^9002313.92251^^1;0 "^DD",9002313.92,9002313.9225,1,9) @ "^DD",9002313.92,9002313.9225,1,21,0) ^^1^1^3101020^ "^DD",9002313.92,9002313.9225,1,21,1,0) This is the M code that is executed when the Processing Mode is "X". "^DD",9002313.92,9002313.9225,2,0) PROGRAMMING NOTES^9002313.92252^^2;0 "^DD",9002313.92,9002313.9225,2,21,0) ^^1^1^3101020^ "^DD",9002313.92,9002313.9225,2,21,1,0) This is an optional description of the special code. "^DD",9002313.92,9002313.92251,0) SPECIAL CODE SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92251,0,"DT") 3100928 "^DD",9002313.92,9002313.92251,0,"NM","SPECIAL CODE") "^DD",9002313.92,9002313.92251,0,"UP") 9002313.9225 "^DD",9002313.92,9002313.92251,.01,0) SPECIAL CODE^WLx^^0;1^Q "^DD",9002313.92,9002313.92251,.01,3) Enter M code used to create the Facility Segment. "^DD",9002313.92,9002313.92251,.01,21,0) ^^1^1^3101017^ "^DD",9002313.92,9002313.92251,.01,21,1,0) When Processing Mode "X" is in effect, the special M code to be executed. "^DD",9002313.92,9002313.92251,.01,"DT") 3101017 "^DD",9002313.92,9002313.92252,0) PROGRAMMING NOTES SUB-FIELD^^.01^1 "^DD",9002313.92,9002313.92252,0,"DT") 3100928 "^DD",9002313.92,9002313.92252,0,"NM","PROGRAMMING NOTES") "^DD",9002313.92,9002313.92252,0,"UP") 9002313.9225 "^DD",9002313.92,9002313.92252,.01,0) PROGRAMMING NOTES^WLx^^0;1^Q "^DD",9002313.92,9002313.92252,.01,3) Enter notes relating to the M code. "^DD",9002313.92,9002313.92252,.01,21,0) ^^1^1^3100928^ "^DD",9002313.92,9002313.92252,.01,21,1,0) Description of what is being accomplished by executing the special code. "^DD",9002313.92,9002313.92252,.01,"DT") 3100928 "^DD",9002313.93,9002313.93,0) FIELD^^.02^2 "^DD",9002313.93,9002313.93,0,"DDA") N "^DD",9002313.93,9002313.93,0,"DT") 3030820 "^DD",9002313.93,9002313.93,0,"ID",.02) W " ",$P(^(0),U,2) "^DD",9002313.93,9002313.93,0,"IX","B",9002313.93,.01) "^DD",9002313.93,9002313.93,0,"NM","BPS NCPDP REJECT CODES") "^DD",9002313.93,9002313.93,0,"PT",52.8651,.01) "^DD",9002313.93,9002313.93,0,"PT",350.912,.01) "^DD",9002313.93,9002313.93,0,"PT",366.16,.03) "^DD",9002313.93,9002313.93,0,"PT",9002313.321,.01) "^DD",9002313.93,9002313.93,0,"VRPK") BPS "^DD",9002313.93,9002313.93,.01,0) CODE^RF^^0;1^K:$L(X)>3!($L(X)<2) X "^DD",9002313.93,9002313.93,.01,1,0) ^.1 "^DD",9002313.93,9002313.93,.01,1,1,0) 9002313.93^B "^DD",9002313.93,9002313.93,.01,1,1,1) S ^BPSF(9002313.93,"B",$E(X,1,30),DA)="" "^DD",9002313.93,9002313.93,.01,1,1,2) K ^BPSF(9002313.93,"B",$E(X,1,30),DA) "^DD",9002313.93,9002313.93,.01,3) Enter the Reject Code that is returned from the payer. "^DD",9002313.93,9002313.93,.01,21,0) ^^2^2^3080529^ "^DD",9002313.93,9002313.93,.01,21,1,0) Reject Code returned by the payer for the reason of the rejection. This "^DD",9002313.93,9002313.93,.01,21,2,0) is based on the NCPDP standards. "^DD",9002313.93,9002313.93,.01,"DT") 3080529 "^DD",9002313.93,9002313.93,.02,0) EXPLANATION^F^^0;2^K:$L(X)>70!($L(X)<1) X "^DD",9002313.93,9002313.93,.02,3) Enter the description of the reject code. "^DD",9002313.93,9002313.93,.02,21,0) ^^1^1^3080529^ "^DD",9002313.93,9002313.93,.02,21,1,0) Textual explanation of the claim rejection. "^DD",9002313.93,9002313.93,.02,"DT") 3080529 "^DD",9002313.94,9002313.94,0) FIELD^^1^3 "^DD",9002313.94,9002313.94,0,"DDA") N "^DD",9002313.94,9002313.94,0,"DT") 3101006 "^DD",9002313.94,9002313.94,0,"IX","B",9002313.94,.01) "^DD",9002313.94,9002313.94,0,"NM","BPS NCPDP FIELD CODES") "^DD",9002313.94,9002313.94,.01,0) NCPDP FIELD NUMBER^RP9002313.91'^BPSF(9002313.91,^0;1^Q "^DD",9002313.94,9002313.94,.01,1,0) ^.1 "^DD",9002313.94,9002313.94,.01,1,1,0) 9002313.94^B "^DD",9002313.94,9002313.94,.01,1,1,1) S ^BPS(9002313.94,"B",$E(X,1,30),DA)="" "^DD",9002313.94,9002313.94,.01,1,1,2) K ^BPS(9002313.94,"B",$E(X,1,30),DA) "^DD",9002313.94,9002313.94,.01,3) Enter the NCPDP field number (0-997, 2 Decimal Digits). "^DD",9002313.94,9002313.94,.01,21,0) ^^1^1^3101020^ "^DD",9002313.94,9002313.94,.01,21,1,0) This is the NCPDP field number as specified in the NCPDP data dictionary. "^DD",9002313.94,9002313.94,.01,"DT") 3101020 "^DD",9002313.94,9002313.94,1,0) CODE^9002313.941A^^1;0 "^DD",9002313.94,9002313.94,1,21,0) ^^3^3^3101021^ "^DD",9002313.94,9002313.94,1,21,1,0) The CODE multiple is used to identify NCPDP standard codes associated with "^DD",9002313.94,9002313.94,1,21,2,0) a NCPDP field. Refer to the NCPDP Eternal Code List for approved data "^DD",9002313.94,9002313.94,1,21,3,0) element codes for each version of the standard. "^DD",9002313.94,9002313.941,0) CODE SUB-FIELD^^2^3 "^DD",9002313.94,9002313.941,0,"DT") 3101006 "^DD",9002313.94,9002313.941,0,"IX","B",9002313.941,.01) "^DD",9002313.94,9002313.941,0,"NM","CODE") "^DD",9002313.94,9002313.941,0,"UP") 9002313.94 "^DD",9002313.94,9002313.941,.01,0) CODE^MF^^0;1^K:$L(X)>10!($L(X)<1) X "^DD",9002313.94,9002313.941,.01,1,0) ^.1 "^DD",9002313.94,9002313.941,.01,1,1,0) 9002313.941^B "^DD",9002313.94,9002313.941,.01,1,1,1) S ^BPS(9002313.94,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002313.94,9002313.941,.01,1,1,2) K ^BPS(9002313.94,DA(1),1,"B",$E(X,1,30),DA) "^DD",9002313.94,9002313.941,.01,3) Answer must be 1-10 characters in length. "^DD",9002313.94,9002313.941,.01,21,0) ^^3^3^3101021^ "^DD",9002313.94,9002313.941,.01,21,1,0) This is the NCPDP code related to a NCPDP standard data element identified "^DD",9002313.94,9002313.941,.01,21,2,0) by the NCPDP FIELD NUMBER. Refer to the NCPDP External Code List for "^DD",9002313.94,9002313.941,.01,21,3,0) approved data element codes for each version of the standard. "^DD",9002313.94,9002313.941,.01,"DT") 3101021 "^DD",9002313.94,9002313.941,1,0) DESCRIPTION^F^^0;2^K:$L(X)>200!($L(X)<1) X "^DD",9002313.94,9002313.941,1,3) Enter the full description of the NCPDP code. "^DD",9002313.94,9002313.941,1,21,0) ^^1^1^3101020^ "^DD",9002313.94,9002313.941,1,21,1,0) This is the full description of the code from the NCPDP standard. "^DD",9002313.94,9002313.941,1,"DT") 3101020 "^DD",9002313.94,9002313.941,2,0) NCPDP VERSION^9002313.9412SA^^1;0 "^DD",9002313.94,9002313.941,2,21,0) ^^4^4^3101021^ "^DD",9002313.94,9002313.941,2,21,1,0) The NCPDP VERSION multiple identifies the specific NCPDP version related "^DD",9002313.94,9002313.941,2,21,2,0) to the CODE. NCPDP field codes may change between versions of the "^DD",9002313.94,9002313.941,2,21,3,0) standard. Refer to the NCPDP External Code List to identify versions for a "^DD",9002313.94,9002313.941,2,21,4,0) specific NCPDP code. "^DD",9002313.94,9002313.9412,0) NCPDP VERSION SUB-FIELD^^1^2 "^DD",9002313.94,9002313.9412,0,"DT") 3101006 "^DD",9002313.94,9002313.9412,0,"IX","B",9002313.9412,.01) "^DD",9002313.94,9002313.9412,0,"NM","NCPDP VERSION") "^DD",9002313.94,9002313.9412,0,"UP") 9002313.941 "^DD",9002313.94,9002313.9412,.01,0) NCPDP VERSION^MS^51:5.1;D0:D.0;^0;1^Q "^DD",9002313.94,9002313.9412,.01,1,0) ^.1 "^DD",9002313.94,9002313.9412,.01,1,1,0) 9002313.9412^B "^DD",9002313.94,9002313.9412,.01,1,1,1) S ^BPS(9002313.94,DA(2),1,DA(1),1,"B",$E(X,1,30),DA)="" "^DD",9002313.94,9002313.9412,.01,1,1,2) K ^BPS(9002313.94,DA(2),1,DA(1),1,"B",$E(X,1,30),DA) "^DD",9002313.94,9002313.9412,.01,3) Enter the version number for this NCPDP Field Code. "^DD",9002313.94,9002313.9412,.01,21,0) ^^1^1^3101020^ "^DD",9002313.94,9002313.9412,.01,21,1,0) This is the NCPDP version number for the NCPDP field code. "^DD",9002313.94,9002313.9412,.01,"DT") 3101020 "^DD",9002313.94,9002313.9412,1,0) DEFAULT^S^1:YES;0:NO;^0;2^Q "^DD",9002313.94,9002313.9412,1,3) Is this the default version? "^DD",9002313.94,9002313.9412,1,21,0) ^^2^2^3101021^ "^DD",9002313.94,9002313.9412,1,21,1,0) This indicates if the NCPDP field code is the default code for the NCPDP "^DD",9002313.94,9002313.9412,1,21,2,0) version. "^DD",9002313.94,9002313.9412,1,"DT") 3101021 "^DD",9002313.99,9002313.99,.08,0) DEFAULT ELIGIBILITY PHARMACY^P9002313.56'^BPS(9002313.56,^0;8^Q "^DD",9002313.99,9002313.99,.08,3) Enter the default BPS Pharmacy to use for Eligibility requests. "^DD",9002313.99,9002313.99,.08,21,0) ^^3^3^3101012^ "^DD",9002313.99,9002313.99,.08,21,1,0) This is the default BPS PHARMACY that will be used for eligibility "^DD",9002313.99,9002313.99,.08,21,2,0) verification submissions when the submission is not associated with "^DD",9002313.99,9002313.99,.08,21,3,0) an RX/Fill. "^DD",9002313.99,9002313.99,.08,"DT") 3101013 "^DIC",9002313.02,9002313.02,0) BPS CLAIMS^9002313.02 "^DIC",9002313.02,9002313.02,0,"GL") ^BPSC( "^DIC",9002313.02,9002313.02,"%",0) ^1.005^^0 "^DIC",9002313.02,9002313.02,"%","B","ABSP",1) "^DIC",9002313.02,9002313.02,"%D",0) ^^16^16^3100930^ "^DIC",9002313.02,9002313.02,"%D",1,0) Intermediate form of transmissions. Fields are stored in formatted form. "^DIC",9002313.02,9002313.02,"%D",2,0) Raw packet is also stored. "^DIC",9002313.02,9002313.02,"%D",3,0) "^DIC",9002313.02,9002313.02,"%D",4,0) Most fields are in Free Text format to accommodate NCPDP Standard "^DIC",9002313.02,9002313.02,"%D",5,0) formatting criteria and required field lengths. Fields other than those "^DIC",9002313.02,9002313.02,"%D",6,0) with decimals in the number correlate directly to the field numbers "^DIC",9002313.02,9002313.02,"%D",7,0) supplied in the NCPDP Data Dictionary. "^DIC",9002313.02,9002313.02,"%D",8,0) "^DIC",9002313.02,9002313.02,"%D",9,0) While many of the fields in this file indicate coded values, they are "^DIC",9002313.02,9002313.02,"%D",10,0) NCPDP coded values preceded by the NCPDP field identifier to be used "^DIC",9002313.02,9002313.02,"%D",11,0) in the NCPDP transmission. Example: Compound Code is either a 1 or 0. "^DIC",9002313.02,9002313.02,"%D",12,0) The NCPDP field identifier for 'Compound Code' is 'D6'. The field length "^DIC",9002313.02,9002313.02,"%D",13,0) is 3 thereby allowing the identifier for that field to be included in the "^DIC",9002313.02,9002313.02,"%D",14,0) data stored in that field. So, 'D61' is stored for that field. "^DIC",9002313.02,9002313.02,"%D",15,0) "^DIC",9002313.02,9002313.02,"%D",16,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.02,"B","BPS CLAIMS",9002313.02) "^DIC",9002313.03,9002313.03,0) BPS RESPONSES^9002313.03P "^DIC",9002313.03,9002313.03,0,"GL") ^BPSR( "^DIC",9002313.03,9002313.03,"%",0) ^1.005^^0 "^DIC",9002313.03,9002313.03,"%","B","ABSP",1) "^DIC",9002313.03,9002313.03,"%D",0) ^^5^5^3101025^ "^DIC",9002313.03,9002313.03,"%D",1,0) This file stores the response information returned by the third-party "^DIC",9002313.03,9002313.03,"%D",2,0) payer. Most of the fields have 'raw' NCPCP data so it is formatted per the "^DIC",9002313.03,9002313.03,"%D",3,0) NCPDP specifications. "^DIC",9002313.03,9002313.03,"%D",4,0) "^DIC",9002313.03,9002313.03,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.03,"B","BPS RESPONSES",9002313.03) "^DIC",9002313.19,9002313.19,0) BPS NCPDP PATIENT RELATIONSHIP CODE^9002313.19 "^DIC",9002313.19,9002313.19,0,"GL") ^BPS(9002313.19, "^DIC",9002313.19,9002313.19,"%",0) ^1.005^^ "^DIC",9002313.19,9002313.19,"%D",0) ^1.001^5^5^3101110^^^ "^DIC",9002313.19,9002313.19,"%D",1,0) This file comes with standard NCPDP Patient Relationship "^DIC",9002313.19,9002313.19,"%D",2,0) data to be used in submitting claims. The file and data should never be "^DIC",9002313.19,9002313.19,"%D",3,0) locally modified, edited or changed. "^DIC",9002313.19,9002313.19,"%D",4,0) "^DIC",9002313.19,9002313.19,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.19,"B","BPS NCPDP PATIENT RELATIONSHIP CODE",9002313.19) "^DIC",9002313.21,9002313.21,0) BPS NCPDP PROFESSIONAL SERVICE CODE^9002313.21 "^DIC",9002313.21,9002313.21,0,"GL") ^BPS(9002313.21, "^DIC",9002313.21,9002313.21,"%",0) ^1.005^^0 "^DIC",9002313.21,9002313.21,"%D",0) ^1.001^5^5^3100817^^^^ "^DIC",9002313.21,9002313.21,"%D",1,0) NCPDPD field 44Ø-E5 - Professional Service Code "^DIC",9002313.21,9002313.21,"%D",2,0) "^DIC",9002313.21,9002313.21,"%D",3,0) This file is used to store the possible NCPDP PROFESSIONAL SERVICE CODE "^DIC",9002313.21,9002313.21,"%D",4,0) values, which are used for overriding DUR rejects. No local changes "^DIC",9002313.21,9002313.21,"%D",5,0) should ever be made to this file. "^DIC",9002313.21,"B","BPS NCPDP PROFESSIONAL SERVICE CODE",9002313.21) "^DIC",9002313.22,9002313.22,0) BPS NCPDP RESULT OF SERVICE CODE^9002313.22 "^DIC",9002313.22,9002313.22,0,"GL") ^BPS(9002313.22, "^DIC",9002313.22,9002313.22,"%",0) ^1.005^^0 "^DIC",9002313.22,9002313.22,"%D",0) ^1.001^7^7^3100817^^^^ "^DIC",9002313.22,9002313.22,"%D",1,0) NCPDPD field 441-E6 - Result of Service Code "^DIC",9002313.22,9002313.22,"%D",2,0) "^DIC",9002313.22,9002313.22,"%D",3,0) This file is used to store the possible NCPDP RESULT OF SERVICE CODE "^DIC",9002313.22,9002313.22,"%D",4,0) values, which are used for overriding DUR rejects. "^DIC",9002313.22,9002313.22,"%D",5,0) No local changes should ever be made to this file. "^DIC",9002313.22,9002313.22,"%D",6,0) "^DIC",9002313.22,9002313.22,"%D",7,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.22,"B","BPS NCPDP RESULT OF SERVICE CODE",9002313.22) "^DIC",9002313.23,9002313.23,0) BPS NCPDP REASON FOR SERVICE CODE^9002313.23 "^DIC",9002313.23,9002313.23,0,"GL") ^BPS(9002313.23, "^DIC",9002313.23,9002313.23,"%",0) ^1.005^^0 "^DIC",9002313.23,9002313.23,"%D",0) ^1.001^7^7^3100817^^^^ "^DIC",9002313.23,9002313.23,"%D",1,0) NCPDP field 439-E4 - Reason for Service Code "^DIC",9002313.23,9002313.23,"%D",2,0) "^DIC",9002313.23,9002313.23,"%D",3,0) This file is used to store the possible NCPDP REASON FOR SERVICE CODE "^DIC",9002313.23,9002313.23,"%D",4,0) values, which are used for overriding DUR rejects. No local changes "^DIC",9002313.23,9002313.23,"%D",5,0) should ever be made to this file. "^DIC",9002313.23,9002313.23,"%D",6,0) "^DIC",9002313.23,9002313.23,"%D",7,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.23,"B","BPS NCPDP REASON FOR SERVICE CODE",9002313.23) "^DIC",9002313.24,9002313.24,0) BPS NCPDP DAW CODE^9002313.24 "^DIC",9002313.24,9002313.24,0,"GL") ^BPS(9002313.24, "^DIC",9002313.24,9002313.24,"%",0) ^1.005^^0 "^DIC",9002313.24,9002313.24,"%D",0) ^^7^7^3101115^ "^DIC",9002313.24,9002313.24,"%D",1,0) NCPDP field 4Ø8-D8 DISPENSE AS WRITTEN (DAW)/PRODUCT SELECTION CODE "^DIC",9002313.24,9002313.24,"%D",2,0) "^DIC",9002313.24,9002313.24,"%D",3,0) This file is used to store NCPDP DAW (Dispense As Written) codes, which "^DIC",9002313.24,9002313.24,"%D",4,0) are used for prescription electronic claim transmission to third party payers. "^DIC",9002313.24,9002313.24,"%D",5,0) No local changes should ever be made to this file. "^DIC",9002313.24,9002313.24,"%D",6,0) "^DIC",9002313.24,9002313.24,"%D",7,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.24,"B","BPS NCPDP DAW CODE",9002313.24) "^DIC",9002313.26,9002313.26,0) BPS NCPDP PRIOR AUTHORIZATION TYPE CODE^9002313.26 "^DIC",9002313.26,9002313.26,0,"GL") ^BPS(9002313.26, "^DIC",9002313.26,9002313.26,"%",0) ^1.005^^0 "^DIC",9002313.26,9002313.26,"%D",0) ^1.001^5^5^3101115^^ "^DIC",9002313.26,9002313.26,"%D",1,0) This file comes with standard NCPDPD prior authorization data to be used in "^DIC",9002313.26,9002313.26,"%D",2,0) submitting claims. The file and data should never be "^DIC",9002313.26,9002313.26,"%D",3,0) locally modified, edited or changed. "^DIC",9002313.26,9002313.26,"%D",4,0) "^DIC",9002313.26,9002313.26,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.26,"B","BPS NCPDP PRIOR AUTHORIZATION TYPE CODE",9002313.26) "^DIC",9002313.27,9002313.27,0) BPS NCPDP PATIENT RESIDENCE CODE^9002313.27 "^DIC",9002313.27,9002313.27,0,"GL") ^BPS(9002313.27, "^DIC",9002313.27,9002313.27,"%",0) ^1.005^^ "^DIC",9002313.27,9002313.27,"%D",0) ^1.001^5^5^3101110^^ "^DIC",9002313.27,9002313.27,"%D",1,0) This file comes with standard NCPDP Patient Residence "^DIC",9002313.27,9002313.27,"%D",2,0) data to be used in submitting claims. The file and data should never be "^DIC",9002313.27,9002313.27,"%D",3,0) locally modified, edited or changed. "^DIC",9002313.27,9002313.27,"%D",4,0) "^DIC",9002313.27,9002313.27,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.27,"B","BPS NCPDP PATIENT RESIDENCE CODE",9002313.27) "^DIC",9002313.28,9002313.28,0) BPS NCPDP PHARMACY SERVICE TYPE^9002313.28 "^DIC",9002313.28,9002313.28,0,"GL") ^BPS(9002313.28, "^DIC",9002313.28,9002313.28,"%",0) ^1.005^^ "^DIC",9002313.28,9002313.28,"%D",0) ^1.001^5^5^3101110^^ "^DIC",9002313.28,9002313.28,"%D",1,0) This file comes with standard NCPDP Pharmacy Service Type "^DIC",9002313.28,9002313.28,"%D",2,0) data to be used in submitting claims. The file and data should never be "^DIC",9002313.28,9002313.28,"%D",3,0) locally modified, edited or changed. "^DIC",9002313.28,9002313.28,"%D",4,0) "^DIC",9002313.28,9002313.28,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.28,"B","BPS NCPDP PHARMACY SERVICE TYPE",9002313.28) "^DIC",9002313.29,9002313.29,0) BPS NCPDP DELAY REASON CODE^9002313.29 "^DIC",9002313.29,9002313.29,0,"GL") ^BPS(9002313.29, "^DIC",9002313.29,9002313.29,"%",0) ^1.005^^ "^DIC",9002313.29,9002313.29,"%D",0) ^1.001^5^5^3101110^^^ "^DIC",9002313.29,9002313.29,"%D",1,0) This file comes with standard NCPDP Delay Reason Code "^DIC",9002313.29,9002313.29,"%D",2,0) data to be used in submitting claims. The file and data should never be "^DIC",9002313.29,9002313.29,"%D",3,0) locally modified, edited or changed. "^DIC",9002313.29,9002313.29,"%D",4,0) "^DIC",9002313.29,9002313.29,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.29,"B","BPS NCPDP DELAY REASON CODE",9002313.29) "^DIC",9002313.91,9002313.91,0) BPS NCPDP FIELD DEFS^9002313.91 "^DIC",9002313.91,9002313.91,0,"GL") ^BPSF(9002313.91, "^DIC",9002313.91,9002313.91,"%",0) ^1.005^^0 "^DIC",9002313.91,9002313.91,"%","B","ABSP",1) "^DIC",9002313.91,9002313.91,"%D",0) ^1.001^4^4^3100925^^^^ "^DIC",9002313.91,9002313.91,"%D",1,0) The NCPDP Data Dictionary Individual fields which combine into formatted "^DIC",9002313.91,9002313.91,"%D",2,0) packets. "^DIC",9002313.91,9002313.91,"%D",3,0) "^DIC",9002313.91,9002313.91,"%D",4,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.91,"B","BPS NCPDP FIELD DEFS",9002313.91) "^DIC",9002313.93,9002313.93,0) BPS NCPDP REJECT CODES^9002313.93 "^DIC",9002313.93,9002313.93,0,"GL") ^BPSF(9002313.93, "^DIC",9002313.93,9002313.93,"%",0) ^1.005^^0 "^DIC",9002313.93,9002313.93,"%","B","ABSP",1) "^DIC",9002313.93,9002313.93,"%D",0) ^1.001^8^8^3100817^^ "^DIC",9002313.93,9002313.93,"%D",1,0) NCPDP field 511-FB REJECT CODE "^DIC",9002313.93,9002313.93,"%D",2,0) "^DIC",9002313.93,9002313.93,"%D",3,0) This file is used to store the possible NCPDP REJECT CODES, that can be "^DIC",9002313.93,9002313.93,"%D",4,0) returned by the payer. No local changes should ever be made to this "^DIC",9002313.93,9002313.93,"%D",5,0) file. The data stored in this file are based on the NCPDP standards and "^DIC",9002313.93,9002313.93,"%D",6,0) are nationally distributed. "^DIC",9002313.93,9002313.93,"%D",7,0) "^DIC",9002313.93,9002313.93,"%D",8,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.93,"B","BPS NCPDP REJECT CODES",9002313.93) "^DIC",9002313.94,9002313.94,0) BPS NCPDP FIELD CODES^9002313.94 "^DIC",9002313.94,9002313.94,0,"GL") ^BPS(9002313.94, "^DIC",9002313.94,9002313.94,"%",0) ^1.005^^ "^DIC",9002313.94,9002313.94,"%D",0) ^1.001^5^5^3101110^^ "^DIC",9002313.94,9002313.94,"%D",1,0) This file comes with standard NCPDP Field Code data to be "^DIC",9002313.94,9002313.94,"%D",2,0) used in submitting claims. The file and data should never be locally "^DIC",9002313.94,9002313.94,"%D",3,0) modified, edited or changed. "^DIC",9002313.94,9002313.94,"%D",4,0) "^DIC",9002313.94,9002313.94,"%D",5,0) Per VHA Directive 2004-038, this file definition should not be modified. "^DIC",9002313.94,"B","BPS NCPDP FIELD CODES",9002313.94) **INSTALL NAME** PSO*7.0*359 "BLD",8105,0) PSO*7.0*359^OUTPATIENT PHARMACY^0^3110830^y "BLD",8105,1,0) ^^1^1^3101029^ "BLD",8105,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "BLD",8105,4,0) ^9.64PA^52^1 "BLD",8105,4,52,0) 52 "BLD",8105,4,52,2,0) ^9.641^52.25^1 "BLD",8105,4,52,2,52.25,0) REJECT INFO (sub-file) "BLD",8105,4,52,2,52.25,1,0) ^9.6411^24^3 "BLD",8105,4,52,2,52.25,1,24,0) CLARIFICATION CODE "BLD",8105,4,52,2,52.25,1,25,0) PRIOR AUTHORIZATION TYPE "BLD",8105,4,52,2,52.25,1,28,0) DUR ADD MSG TEXT "BLD",8105,4,52,222) y^y^p^^^^n^^n "BLD",8105,4,52,224) "BLD",8105,4,"APDD",52,52.25) "BLD",8105,4,"APDD",52,52.25,24) "BLD",8105,4,"APDD",52,52.25,25) "BLD",8105,4,"APDD",52,52.25,28) "BLD",8105,4,"B",52,52) "BLD",8105,6.3) 27 "BLD",8105,"ABPKG") n "BLD",8105,"INID") ^y "BLD",8105,"INIT") POST^PSO7P359 "BLD",8105,"KRN",0) ^9.67PA^779.2^20 "BLD",8105,"KRN",.4,0) .4 "BLD",8105,"KRN",.401,0) .401 "BLD",8105,"KRN",.402,0) .402 "BLD",8105,"KRN",.403,0) .403 "BLD",8105,"KRN",.5,0) .5 "BLD",8105,"KRN",.84,0) .84 "BLD",8105,"KRN",3.6,0) 3.6 "BLD",8105,"KRN",3.8,0) 3.8 "BLD",8105,"KRN",9.2,0) 9.2 "BLD",8105,"KRN",9.2,"NM",0) ^9.68A^^ "BLD",8105,"KRN",9.8,0) 9.8 "BLD",8105,"KRN",9.8,"NM",0) ^9.68A^14^14 "BLD",8105,"KRN",9.8,"NM",1,0) PSORXVW^^0^B67653959 "BLD",8105,"KRN",9.8,"NM",2,0) PSOBPSU2^^0^B55533133 "BLD",8105,"KRN",9.8,"NM",3,0) PSORXVW1^^0^B67070082 "BLD",8105,"KRN",9.8,"NM",4,0) PSOREJP1^^0^B78046825 "BLD",8105,"KRN",9.8,"NM",5,0) PSOREJUT^^0^B53275324 "BLD",8105,"KRN",9.8,"NM",6,0) PSOREJU2^^0^B49130506 "BLD",8105,"KRN",9.8,"NM",7,0) PSOBPSU1^^0^B53744697 "BLD",8105,"KRN",9.8,"NM",8,0) PSOREJP3^^0^B107041706 "BLD",8105,"KRN",9.8,"NM",9,0) PSOREJU3^^0^B68707597 "BLD",8105,"KRN",9.8,"NM",10,0) PSOBORP3^^0^B185906920 "BLD",8105,"KRN",9.8,"NM",11,0) PSOREJU1^^0^B77096006 "BLD",8105,"KRN",9.8,"NM",12,0) PSOREJU4^^0^B31952299 "BLD",8105,"KRN",9.8,"NM",13,0) PSOREJP5^^0^B31405315 "BLD",8105,"KRN",9.8,"NM",14,0) PSOLSET^^0^B30029461 "BLD",8105,"KRN",9.8,"NM","B","PSOBORP3",10) "BLD",8105,"KRN",9.8,"NM","B","PSOBPSU1",7) "BLD",8105,"KRN",9.8,"NM","B","PSOBPSU2",2) "BLD",8105,"KRN",9.8,"NM","B","PSOLSET",14) "BLD",8105,"KRN",9.8,"NM","B","PSOREJP1",4) "BLD",8105,"KRN",9.8,"NM","B","PSOREJP3",8) "BLD",8105,"KRN",9.8,"NM","B","PSOREJP5",13) "BLD",8105,"KRN",9.8,"NM","B","PSOREJU1",11) "BLD",8105,"KRN",9.8,"NM","B","PSOREJU2",6) "BLD",8105,"KRN",9.8,"NM","B","PSOREJU3",9) "BLD",8105,"KRN",9.8,"NM","B","PSOREJU4",12) "BLD",8105,"KRN",9.8,"NM","B","PSOREJUT",5) "BLD",8105,"KRN",9.8,"NM","B","PSORXVW",1) "BLD",8105,"KRN",9.8,"NM","B","PSORXVW1",3) "BLD",8105,"KRN",19,0) 19 "BLD",8105,"KRN",19,"NM",0) ^9.68A^^ "BLD",8105,"KRN",19.1,0) 19.1 "BLD",8105,"KRN",101,0) 101 "BLD",8105,"KRN",101,"NM",0) ^9.68A^6^3 "BLD",8105,"KRN",101,"NM",4,0) PSO REJECT DISPLAY ADDITIONAL INFO^^0 "BLD",8105,"KRN",101,"NM",5,0) PSO REJECT DISPLAY HIDDEN MENU^^2 "BLD",8105,"KRN",101,"NM",6,0) PSO HIDDEN ACTIONS #1^^2 "BLD",8105,"KRN",101,"NM","B","PSO HIDDEN ACTIONS #1",6) "BLD",8105,"KRN",101,"NM","B","PSO REJECT DISPLAY ADDITIONAL INFO",4) "BLD",8105,"KRN",101,"NM","B","PSO REJECT DISPLAY HIDDEN MENU",5) "BLD",8105,"KRN",409.61,0) 409.61 "BLD",8105,"KRN",409.61,"NM",0) ^9.68A^1^1 "BLD",8105,"KRN",409.61,"NM",1,0) PSO REJECT DISPLAY ADDTNL INFO^^0 "BLD",8105,"KRN",409.61,"NM","B","PSO REJECT DISPLAY ADDTNL INFO",1) "BLD",8105,"KRN",771,0) 771 "BLD",8105,"KRN",779.2,0) 779.2 "BLD",8105,"KRN",870,0) 870 "BLD",8105,"KRN",8989.51,0) 8989.51 "BLD",8105,"KRN",8989.52,0) 8989.52 "BLD",8105,"KRN",8994,0) 8994 "BLD",8105,"KRN","B",.4,.4) "BLD",8105,"KRN","B",.401,.401) "BLD",8105,"KRN","B",.402,.402) "BLD",8105,"KRN","B",.403,.403) "BLD",8105,"KRN","B",.5,.5) "BLD",8105,"KRN","B",.84,.84) "BLD",8105,"KRN","B",3.6,3.6) "BLD",8105,"KRN","B",3.8,3.8) "BLD",8105,"KRN","B",9.2,9.2) "BLD",8105,"KRN","B",9.8,9.8) "BLD",8105,"KRN","B",19,19) "BLD",8105,"KRN","B",19.1,19.1) "BLD",8105,"KRN","B",101,101) "BLD",8105,"KRN","B",409.61,409.61) "BLD",8105,"KRN","B",771,771) "BLD",8105,"KRN","B",779.2,779.2) "BLD",8105,"KRN","B",870,870) "BLD",8105,"KRN","B",8989.51,8989.51) "BLD",8105,"KRN","B",8989.52,8989.52) "BLD",8105,"KRN","B",8994,8994) "BLD",8105,"QUES",0) ^9.62^^ "BLD",8105,"REQB",0) ^9.611^1^1 "BLD",8105,"REQB",1,0) PSO*7.0*358^2 "BLD",8105,"REQB","B","PSO*7.0*358",1) "FIA",52) PRESCRIPTION "FIA",52,0) ^PSRX( "FIA",52,0,0) 52I "FIA",52,0,1) y^y^p^^^^n^^n "FIA",52,0,10) "FIA",52,0,11) "FIA",52,0,"RLRO") "FIA",52,0,"VR") 7.0^PSO "FIA",52,52) 1 "FIA",52,52.25) 1 "FIA",52,52.25,24) "FIA",52,52.25,25) "FIA",52,52.25,28) "INIT") POST^PSO7P359 "KRN",101,3058,-1) 2^6 "KRN",101,3058,0) PSO HIDDEN ACTIONS #1^Outpatient Pharmacy Hidden Actions #1^^M^1167^^^^^^^206 "KRN",101,3058,10,0) ^101.01PA^16^16 "KRN",101,3058,10,16,0) 4889^ARI^34^ "KRN",101,3058,10,16,"^") PSO REJECT DISPLAY ADDITIONAL INFO "KRN",101,4163,-1) 2^5 "KRN",101,4163,0) PSO REJECT DISPLAY HIDDEN MENU^Reject Display Hidden Menu^^M^1167^^^^^^^ "KRN",101,4163,10,0) ^101.01PA^22^22 "KRN",101,4163,10,22,0) 4889^ARI^25^ "KRN",101,4163,10,22,"^") PSO REJECT DISPLAY ADDITIONAL INFO "KRN",101,4889,-1) 0^4 "KRN",101,4889,0) PSO REJECT DISPLAY ADDITIONAL INFO^View Addtnl Rej Info^^A^^^^^^^^OUTPATIENT PHARMACY "KRN",101,4889,4) ^^^ARI "KRN",101,4889,20) D ADDTXT^PSOREJP5 "KRN",101,4889,99) 62140,44793 "KRN",409.61,891,-1) 0^1 "KRN",409.61,891,0) PSO REJECT DISPLAY ADDTNL INFO^2^^80^7^20^0^1^^^Additional Reject Info^1^^1 "KRN",409.61,891,1) ^VALM HIDDEN ACTIONS "KRN",409.61,891,"ARRAY") ^TMP("PSOREJP2",$J) "KRN",409.61,891,"FNL") D EXIT^PSOREJP5 "KRN",409.61,891,"HDR") D HDR^PSOREJP5 "KRN",409.61,891,"HLP") D HELP^PSOREJP5 "KRN",409.61,891,"INIT") D INIT^PSOREJP5 "MBREQ") 1 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "PKG",206,-1) 1^1 "PKG",206,0) OUTPATIENT PHARMACY^PSO^OUTPATIENT LABELS, PROFILE, INVENTORY, PRESCRIPTIONS "PKG",206,20,0) ^9.402P^^ "PKG",206,22,0) ^9.49I^1^1 "PKG",206,22,1,0) 7.0^3021122^3021202^66481 "PKG",206,22,1,"PAH",1,0) 359^3110830 "PKG",206,22,1,"PAH",1,1,0) ^^1^1^3110830 "PKG",206,22,1,"PAH",1,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 15 "RTN","PSO7P359") 0^^B1514691 "RTN","PSO7P359",1,0) PSO7P359 ;BIRM/BNT - Post-intall for PSO*7*359 ;02/16/11 "RTN","PSO7P359",2,0) ;;7.0;OUTPATIENT PHARMACY;**359**;DEC 1997;Build 27 "RTN","PSO7P359",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","PSO7P359",4,0) ; "RTN","PSO7P359",5,0) Q "RTN","PSO7P359",6,0) ; "RTN","PSO7P359",7,0) ; "RTN","PSO7P359",8,0) POST ; Entry Point for post-install "RTN","PSO7P359",9,0) D MES^XPDUTL(" Starting post-install of PSO*7*359") "RTN","PSO7P359",10,0) N PSORDHM,PSOHA1,XQORM,I "RTN","PSO7P359",11,0) ; Remove ^XUTL entry for hidden action menu protocols "RTN","PSO7P359",12,0) ; Get the IEN for the PSO REJECT DISPLAY HIDDEN MENU "RTN","PSO7P359",13,0) S PSORDHM=$O(^ORD(101,"B","PSO REJECT DISPLAY HIDDEN MENU",0)) "RTN","PSO7P359",14,0) ; Get the IEN for the PSO HIDDEN ACTIONS #1 "RTN","PSO7P359",15,0) S PSOHA1=$O(^ORD(101,"B","PSO HIDDEN ACTIONS #1",0)) "RTN","PSO7P359",16,0) ; "RTN","PSO7P359",17,0) F I=PSORDHM,PSOHA1 S XQORM=I_";ORD(101," I $D(^XUTL("XQORM",XQORM)) D "RTN","PSO7P359",18,0) . D MES^XPDUTL(" Removing cached hidden menu for "_$P(^ORD(101,I,0),U,1)) "RTN","PSO7P359",19,0) . K ^XUTL("XQORM",XQORM) "RTN","PSO7P359",20,0) ; "RTN","PSO7P359",21,0) D MES^XPDUTL(" Finished post-install of PSO*7*359") "RTN","PSO7P359",22,0) Q "RTN","PSOBORP3") 0^10^B185906920 "RTN","PSOBORP3",1,0) PSOBORP3 ;ALBANY/BLD - TRICARE BYPASS/OVERRIDE AUDIT REPORT ;7/1/2010 "RTN","PSOBORP3",2,0) ;;7.0;OUTPATIENT PHARMACY;**358,359**;DEC 1997;Build 27 "RTN","PSOBORP3",3,0) ; "RTN","PSOBORP3",4,0) ;Uses API "RTN","PSOBORP3",5,0) ;this routine will process the Tricare Bypass / Override Report based on the filtering criteria in routine PSOBORP0 "RTN","PSOBORP3",6,0) ; "RTN","PSOBORP3",7,0) ; "RTN","PSOBORP3",8,0) EN(PSOSEL) ; "RTN","PSOBORP3",9,0) ; "RTN","PSOBORP3",10,0) ;THE INFORMATION FOR THE TRICARE BYPASS / OVERRIDE REPORT WILL BE GATHERED BY LOOPING THROUGH "RTN","PSOBORP3",11,0) ;FILE 52.87 (PSO TRICARE AUDIT LOG FILE) TO RETRIEVE THE INFORMATION BASED UPON THE FILTERING "RTN","PSOBORP3",12,0) ;REQUIREMENTS IN ROUTINE PSOBORP0. "RTN","PSOBORP3",13,0) ; "RTN","PSOBORP3",14,0) ; SEE TRICARE BYPASS / OVERRIDE REPORT SDD FOR MOCK UP OF REPORT "RTN","PSOBORP3",15,0) ; "RTN","PSOBORP3",16,0) ; "RTN","PSOBORP3",17,0) N ACTDT,AMT,BEGDT,DASH,DETSUM,ENDDT,EQUAL,HDR1,HDR2,HDR3,HDR4,HDR5,HDR6,MEAN,PAGE,PAGENBR,RXCNT "RTN","PSOBORP3",18,0) N PSONOW,RJHDR,SPACE,STAR,PSOAUD,SUBTOTAL,SUBTOT,PROVTOT,PRORXTOT "RTN","PSOBORP3",19,0) D INIT "RTN","PSOBORP3",20,0) D PROCESS^PSOBORP2(.PSOSEL,.PSOAUD) ;process file 52.87 (Tricare Audit File) "RTN","PSOBORP3",21,0) W:'PSOEXCEL @IOF D HDR "RTN","PSOBORP3",22,0) I PSOSEL("SUM_DETAIL")="S" D SUMMARY(.PSOSEL,.PSOAUD) "RTN","PSOBORP3",23,0) I PSOSEL("SUM_DETAIL")="D" D DETAIL(.PSOSEL,.PSOAUD) "RTN","PSOBORP3",24,0) ; "RTN","PSOBORP3",25,0) D END^PSOBORP2 "RTN","PSOBORP3",26,0) Q "RTN","PSOBORP3",27,0) ; "RTN","PSOBORP3",28,0) DETAIL(PSOSEL,PSOAUD) ;for detail report "RTN","PSOBORP3",29,0) ; "RTN","PSOBORP3",30,0) N PAGELOC,AMT,PROV "RTN","PSOBORP3",31,0) N GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL "RTN","PSOBORP3",32,0) ; "RTN","PSOBORP3",33,0) I PSOEXCEL D EDETAIL(.PSOSEL,.PSOAUD) Q ;if Excel format chosen "RTN","PSOBORP3",34,0) S PAGENBR=1 "RTN","PSOBORP3",35,0) D DETHDR "RTN","PSOBORP3",36,0) ; "RTN","PSOBORP3",37,0) S (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,PRORXTOT,PROVTOT,SUBTOTAL)="" "RTN","PSOBORP3",38,0) ; "RTN","PSOBORP3",39,0) I PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R") D Q "RTN","PSOBORP3",40,0) .F S DIVISION=$O(PSOAUD(DIVISION)) Q:DIVISION=""!($G(PSOUT)) D "RTN","PSOBORP3",41,0) ..S (PROVTOT,PRORXTOT,DIVTOT,DIVRXTOT)="" "RTN","PSOBORP3",42,0) ..I ($Y+8)>IOSL D DETHDR Q:$G(PSOUT) "RTN","PSOBORP3",43,0) ..W !!,$E(DASH,1,110) "RTN","PSOBORP3",44,0) ..W !,"DIVISION: ",DIVISION "RTN","PSOBORP3",45,0) ..F S TCTYPE=$O(PSOAUD(DIVISION,TCTYPE)) Q:TCTYPE=""!($G(PSOUT)) D "RTN","PSOBORP3",46,0) ...S TCT=TCTYPE,(TCRXTOT,TCTOTAL)="" D TCHDR(TCT) "RTN","PSOBORP3",47,0) ...F S PROVIDER=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER)) Q:PROVIDER=""!($G(PSOUT)) D "RTN","PSOBORP3",48,0) ....S (PROVTOT,PRORXTOT)="" "RTN","PSOBORP3",49,0) ....F S ACTDT=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT)) Q:ACTDT=""!($G(PSOUT)) D "RTN","PSOBORP3",50,0) .....S PROV=PROVIDER "RTN","PSOBORP3",51,0) .....S AMT=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9) "RTN","PSOBORP3",52,0) .....S PROVTOT=$FN(PROVTOT+AMT,"T",2) "RTN","PSOBORP3",53,0) .....S PRORXTOT=PRORXTOT+1 "RTN","PSOBORP3",54,0) .....S TCTOTAL=$FN(TCTOTAL+AMT,"T",2) "RTN","PSOBORP3",55,0) .....S TCRXTOT=TCRXTOT+1 "RTN","PSOBORP3",56,0) .....S DIVTOT=$FN(DIVTOT+AMT,"T",2) "RTN","PSOBORP3",57,0) .....S DIVRXTOT=DIVRXTOT+1 "RTN","PSOBORP3",58,0) .....S GRDTOTAL=$FN(GRDTOTAL+AMT,"T",2) "RTN","PSOBORP3",59,0) .....S GRDRXTOT=GRDRXTOT+1 "RTN","PSOBORP3",60,0) .....Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D TCDSUMP(TCT,PROV,ACTDT) ;detail print "RTN","PSOBORP3",61,0) ....Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D PROVTOT(TCT,PROV,PROVTOT,PRORXTOT) "RTN","PSOBORP3",62,0) ...Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D TCTOT(TCTOTAL,TCRXTOT,TCT) "RTN","PSOBORP3",63,0) ..Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D DIVTOTP(DIVTOT,DIVRXTOT) "RTN","PSOBORP3",64,0) .Q:$G(PSOUT) D:($Y+8)>IOSL DETHDR Q:$G(PSOUT) D GRDTOTP(GRDTOTAL,GRDRXTOT) "RTN","PSOBORP3",65,0) ; "RTN","PSOBORP3",66,0) Q "RTN","PSOBORP3",67,0) ; "RTN","PSOBORP3",68,0) EDETAIL(PSOSEL,PSOAUD) ;for detail report "RTN","PSOBORP3",69,0) ; "RTN","PSOBORP3",70,0) N PAGELOC,AMT "RTN","PSOBORP3",71,0) N GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL,PROV "RTN","PSOBORP3",72,0) ; "RTN","PSOBORP3",73,0) S PAGENBR=1 "RTN","PSOBORP3",74,0) D DETHDR "RTN","PSOBORP3",75,0) ; "RTN","PSOBORP3",76,0) S (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCTYPE,PROVIDER,PROVTOT,PROVRXT,SUBTOT,SUBTOTAL)="" "RTN","PSOBORP3",77,0) ; "RTN","PSOBORP3",78,0) I PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R") D Q "RTN","PSOBORP3",79,0) .F S DIVISION=$O(PSOAUD(DIVISION)) Q:DIVISION=""!($G(PSOUT)) D "RTN","PSOBORP3",80,0) ..F S TCTYPE=$O(PSOAUD(DIVISION,TCTYPE)) Q:TCTYPE=""!($G(PSOUT)) D "RTN","PSOBORP3",81,0) ...S TCT=TCTYPE "RTN","PSOBORP3",82,0) ...F S PROVIDER=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER)) Q:PROVIDER=""!($G(PSOUT)) D "RTN","PSOBORP3",83,0) ....F S ACTDT=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT)) Q:ACTDT=""!($G(PSOUT)) D "RTN","PSOBORP3",84,0) .....S PROV=PROVIDER "RTN","PSOBORP3",85,0) .....S AMT=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9) "RTN","PSOBORP3",86,0) .....Q:$G(PSOUT) D TCDSUMP(TCTYPE,PROV,ACTDT) ;detail print "RTN","PSOBORP3",87,0) ....Q:$G(PSOUT) "RTN","PSOBORP3",88,0) ...Q:$G(PSOUT) "RTN","PSOBORP3",89,0) ..Q:$G(PSOUT) "RTN","PSOBORP3",90,0) .Q:$G(PSOUT) "RTN","PSOBORP3",91,0) ; "RTN","PSOBORP3",92,0) Q "RTN","PSOBORP3",93,0) ; "RTN","PSOBORP3",94,0) SUMMARY(PSOSEL,PSOAUD) ;for summary report "RTN","PSOBORP3",95,0) ; "RTN","PSOBORP3",96,0) N AMT,ACTDT,ACTDATE,DIVISION,PROVIDER,PHAMCST,PAGELOC,PROVIDER,TCTOTAL,TCTYPE,RXTOTAL,RXCNT,GRDTOTAL,SUBTOT,MEAN "RTN","PSOBORP3",97,0) ; "RTN","PSOBORP3",98,0) S PAGENBR=1 "RTN","PSOBORP3",99,0) D SUMHDR "RTN","PSOBORP3",100,0) S (GRDTOTAL,DIVISION,DIVTOT,DIVRXTOT,RXCNT,GRDRXTOT,ACTDT,TCTOTAL,TCRXTOT,TCTYPE,PROVIDER,PROVTOT,PRORXTOT,SUBTOTAL)="" "RTN","PSOBORP3",101,0) ; "RTN","PSOBORP3",102,0) ;subtotals by provider "RTN","PSOBORP3",103,0) I PSOSEL("TOTALS BY")="P"!(PSOSEL("TOTALS BY")="R") D "RTN","PSOBORP3",104,0) .F S DIVISION=$O(PSOAUD(DIVISION)) Q:DIVISION=""!($G(PSOUT)) D "RTN","PSOBORP3",105,0) ..S (PROVTOT,PRORXTOT,RXCNT,DIVTOT,DIVRXTOT)="" "RTN","PSOBORP3",106,0) ..I ($Y+8)>IOSL D SUMHDR Q:$G(PSOUT) "RTN","PSOBORP3",107,0) ..W !!,$E(DASH,1,110) "RTN","PSOBORP3",108,0) ..W !,"DIVISION: ",DIVISION "RTN","PSOBORP3",109,0) ..F S TCTYPE=$O(PSOAUD(DIVISION,TCTYPE)) Q:TCTYPE=""!($G(PSOUT)) D "RTN","PSOBORP3",110,0) ...S TCT=TCTYPE,(TCRXTOT,TCTOTAL)="" D TCHDR(TCT) "RTN","PSOBORP3",111,0) ...F S PROVIDER=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER)) Q:PROVIDER=""!($G(PSOUT)) D "RTN","PSOBORP3",112,0) ....S (PROVTOT,PRORXTOT)=0 "RTN","PSOBORP3",113,0) ....F S ACTDT=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT)) Q:ACTDT=""!($G(PSOUT)) D "RTN","PSOBORP3",114,0) .....S PROV=PROVIDER "RTN","PSOBORP3",115,0) .....S AMT=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9) "RTN","PSOBORP3",116,0) .....S PROVTOT=$FN(PROVTOT+AMT,"T",2) "RTN","PSOBORP3",117,0) .....S PRORXTOT=PRORXTOT+1 "RTN","PSOBORP3",118,0) .....S TCTOTAL=$FN(TCTOTAL+AMT,"T",2) "RTN","PSOBORP3",119,0) .....S TCRXTOT=TCRXTOT+1 "RTN","PSOBORP3",120,0) .....S DIVTOT=$FN(DIVTOT+AMT,"T",2) "RTN","PSOBORP3",121,0) .....S DIVRXTOT=DIVRXTOT+1 "RTN","PSOBORP3",122,0) .....S GRDTOTAL=$FN(GRDTOTAL+AMT,"T",2) "RTN","PSOBORP3",123,0) .....S GRDRXTOT=GRDRXTOT+1 "RTN","PSOBORP3",124,0) ....Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D TCSSUMP(PROVTOT,PRORXTOT,TCT,PROV) ;summary print "RTN","PSOBORP3",125,0) ...Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D TCTOT(TCTOTAL,TCRXTOT,TCT) "RTN","PSOBORP3",126,0) ..Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D DIVTOTP(DIVTOT,DIVRXTOT) "RTN","PSOBORP3",127,0) .Q:$G(PSOUT) D:($Y+8)>IOSL SUMHDR Q:$G(PSOUT) D GRDTOTP(GRDTOTAL,GRDRXTOT) "RTN","PSOBORP3",128,0) ; "RTN","PSOBORP3",129,0) Q "RTN","PSOBORP3",130,0) ; "RTN","PSOBORP3",131,0) SUMHDR ; "RTN","PSOBORP3",132,0) ;this will print the header and page breaks for summary report. "RTN","PSOBORP3",133,0) ; "RTN","PSOBORP3",134,0) ; "RTN","PSOBORP3",135,0) I PAGENBR>1 D PAUSE^PSOBORP1 Q:$G(PSOUT) W @IOF "RTN","PSOBORP3",136,0) S PAGELOC=132-($L(PAGE)+$L(PAGENBR)) "RTN","PSOBORP3",137,0) W !,HDR1,?PAGELOC,PAGE,PAGENBR S PAGENBR=PAGENBR+1 "RTN","PSOBORP3",138,0) W !,HDR2,!,HDR3,!,HDR4 W !,$E(EQUAL,1,110) "RTN","PSOBORP3",139,0) ; "RTN","PSOBORP3",140,0) Q "RTN","PSOBORP3",141,0) ; "RTN","PSOBORP3",142,0) DETHDR ; "RTN","PSOBORP3",143,0) ;this will print the header and page breaks for the detail report "RTN","PSOBORP3",144,0) ; "RTN","PSOBORP3",145,0) I PAGENBR>1,PSOEXCEL Q ;if Excel spreadsheet format "RTN","PSOBORP3",146,0) ; "RTN","PSOBORP3",147,0) I PAGENBR>1 D PAUSE^PSOBORP1 Q:$G(PSOUT) W @IOF "RTN","PSOBORP3",148,0) S PAGELOC=132-($L(PAGE)+$L(PAGENBR)) "RTN","PSOBORP3",149,0) I 'PSOEXCEL D "RTN","PSOBORP3",150,0) .W !,HDR1,?PAGELOC,PAGE,PAGENBR S PAGENBR=PAGENBR+1 "RTN","PSOBORP3",151,0) .W !,HDR2,!,HDR3,!,HDR4,!,$E(EQUAL,1,110),!,HDR5,!,HDR6,!,$E(EQUAL,1,110) "RTN","PSOBORP3",152,0) ; "RTN","PSOBORP3",153,0) I PSOEXCEL D "RTN","PSOBORP3",154,0) .W !,"BENEFICIARY NAME"_"^"_"ID"_"^"_"RX#"_"^"_"REF/ECME#"_"^"_"RX DATE"_"^"_"FILL LOC"_"^"_"STATUS"_"^"_"ACTION DATE"_"^"_"USER NAME"_"^"_"$BILLED" "RTN","PSOBORP3",155,0) .W "^"_"QTY"_"^"_"NDC#"_"^"_"DRUG"_"^"_"REJECT CODE(S)"_"^"_"REJECT CODE"_"^"_"REJECT EXPLANATION"_"^"_"TRICARE JUSTIFICATION" "RTN","PSOBORP3",156,0) ; "RTN","PSOBORP3",157,0) Q "RTN","PSOBORP3",158,0) ; "RTN","PSOBORP3",159,0) PROVTOT(TCT,PROVIDER,PROVTOT,PROVRXT) ;prints totals by provider "RTN","PSOBORP3",160,0) ; "RTN","PSOBORP3",161,0) Q:PSOEXCEL ;if Excel spreadsheet format "RTN","PSOBORP3",162,0) ; "RTN","PSOBORP3",163,0) Q:TCTYPE="TRICARE INPATIENT" "RTN","PSOBORP3",164,0) W !!,?10,PROV "RTN","PSOBORP3",165,0) W !,?10,"SUBTOTALS",?51,PROVTOT "RTN","PSOBORP3",166,0) W !,?10,"RX COUNT",?51,PROVRXT "RTN","PSOBORP3",167,0) W !,?10,"MEAN",?51,$FN(PROVTOT/PROVRXT,"T",2),! "RTN","PSOBORP3",168,0) S (PROVRXT,PROVTOT)="" "RTN","PSOBORP3",169,0) ; "RTN","PSOBORP3",170,0) Q "RTN","PSOBORP3",171,0) ; "RTN","PSOBORP3",172,0) ; "RTN","PSOBORP3",173,0) TCTOT(TCTOTAL,TCRXTOT,TCTYPE) ; "RTN","PSOBORP3",174,0) ;print tctypes totals "RTN","PSOBORP3",175,0) ; "RTN","PSOBORP3",176,0) Q:PSOEXCEL ;if Excel spreadsheet format "RTN","PSOBORP3",177,0) ; "RTN","PSOBORP3",178,0) W !!,?5,TCTYPE "RTN","PSOBORP3",179,0) W !,?5,"SUBTOTALS",?51,TCTOTAL "RTN","PSOBORP3",180,0) W !,?5,"RX COUNT",?51,TCRXTOT "RTN","PSOBORP3",181,0) W !,?5,"MEAN",?51,$FN(TCTOTAL/TCRXTOT,"T",2) "RTN","PSOBORP3",182,0) ; "RTN","PSOBORP3",183,0) ; "RTN","PSOBORP3",184,0) Q "RTN","PSOBORP3",185,0) ; "RTN","PSOBORP3",186,0) DIVTOTP(DIVTOT,DIVRXTOT) ; "RTN","PSOBORP3",187,0) ;print the totals for a division "RTN","PSOBORP3",188,0) ; "RTN","PSOBORP3",189,0) Q:PSOEXCEL ;if Excel spreadsheet format "RTN","PSOBORP3",190,0) ; "RTN","PSOBORP3",191,0) W !!,"DIVISION ",DIVISION,?51,$E(DASH,1,13) "RTN","PSOBORP3",192,0) W !,"SUBTOTALS",?51,DIVTOT "RTN","PSOBORP3",193,0) W !,"RX COUNT",?51,DIVRXTOT "RTN","PSOBORP3",194,0) W !,"MEAN",?51,$FN(DIVTOT/DIVRXTOT,"T",2) "RTN","PSOBORP3",195,0) ; "RTN","PSOBORP3",196,0) Q "RTN","PSOBORP3",197,0) ; "RTN","PSOBORP3",198,0) GRDTOTP(GRDTOTAL,GRDRXTOT) ; "RTN","PSOBORP3",199,0) ; "RTN","PSOBORP3",200,0) Q:PSOEXCEL ;if Excel spreadsheet format "RTN","PSOBORP3",201,0) ; "RTN","PSOBORP3",202,0) N I "RTN","PSOBORP3",203,0) ; "RTN","PSOBORP3",204,0) I '$D(PSOAUD) W !!,?26,"NO INFORMATION FOUND..." Q "RTN","PSOBORP3",205,0) F I=1:1:2 W !,?51,$E(DASH,1,13) "RTN","PSOBORP3",206,0) W !!!,"GRAND TOTALS",?51,GRDTOTAL "RTN","PSOBORP3",207,0) W !,"RX COUNT",?51,GRDRXTOT "RTN","PSOBORP3",208,0) W !,"MEAN",?51,$FN(GRDTOTAL/GRDRXTOT,"T",2) "RTN","PSOBORP3",209,0) W !,?51,$E(DASH,1,13) "RTN","PSOBORP3",210,0) ; "RTN","PSOBORP3",211,0) Q "RTN","PSOBORP3",212,0) ; "RTN","PSOBORP3",213,0) ; "RTN","PSOBORP3",214,0) TCDSUMP(TCTYPE,PROVIDER,ACTDT) ;print the summary "RTN","PSOBORP3",215,0) ; "RTN","PSOBORP3",216,0) N AMTBILL,DFN,NAME,ID,REFILL,RXNBR,RX,ECMENBR,RXDATE,RXINFO,RXQTY,NDCNBR,RXDRUG,VADM,USER,TRIJUST "RTN","PSOBORP3",217,0) S RJHDR=$E(STAR,1,30)_$E(SPACE,1,3)_TCTYPE_$E(SPACE,1,3)_$E(STAR,1,(57-$L(TCTYPE))) "RTN","PSOBORP3",218,0) S DFN=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",4) "RTN","PSOBORP3",219,0) D DEM^VADPT "RTN","PSOBORP3",220,0) S NAME=VADM(1) "RTN","PSOBORP3",221,0) S ID=$P(VADM(2),"^",1),ID=$E(ID,$L(ID)-3,999) "RTN","PSOBORP3",222,0) S RXNBR=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",2) "RTN","PSOBORP3",223,0) S RX=$$GET1^DIQ(52,RXNBR,.01) "RTN","PSOBORP3",224,0) S REFILL=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",3) "RTN","PSOBORP3",225,0) S ECMENBR=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",10) I ECMENBR="" S ECMENBR="N/A" "RTN","PSOBORP3",226,0) S ECMENBR=REFILL_"/"_ECMENBR "RTN","PSOBORP3",227,0) S RXDATE=$$DATTIM($P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",6)) "RTN","PSOBORP3",228,0) S RXINFO=$$RXINFO(RXNBR) "RTN","PSOBORP3",229,0) S USER=$P(^VA(200,$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,1)),"^",4),0),"^",1) "RTN","PSOBORP3",230,0) S AMTBILL=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",9) "RTN","PSOBORP3",231,0) S RXQTY=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",11) "RTN","PSOBORP3",232,0) S NDCNBR=$TR($P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",7),"-","") "RTN","PSOBORP3",233,0) S RXDRUG=$E($P($G(^PSDRUG($P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,0)),"^",8),0)),"^",1),1,24) "RTN","PSOBORP3",234,0) S TRIJUST=$P($G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,2)),"^",1) "RTN","PSOBORP3",235,0) ; "RTN","PSOBORP3",236,0) ;for standard output "RTN","PSOBORP3",237,0) I 'PSOEXCEL D "RTN","PSOBORP3",238,0) .W !!,$E(NAME,1,30)_"/"_ID,?36,RX,?54,ECMENBR,?72,RXDATE,?90,RXINFO "RTN","PSOBORP3",239,0) .W !,?4,$$DATTIM($P(ACTDT,".",1)),?22,$E(USER,1,20),?58,$FN(AMTBILL,"T",2),?72,RXQTY,?84,NDCNBR,?103,RXDRUG "RTN","PSOBORP3",240,0) .I $D(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3)) D NCPDPRC(.PSOAUD) "RTN","PSOBORP3",241,0) .; "RTN","PSOBORP3",242,0) .;tricare justification "RTN","PSOBORP3",243,0) .I $E(IOST,1,2)="C-" D "RTN","PSOBORP3",244,0) ..I $L(TRIJUST)>125 W !,?4,$E(TRIJUST,1,125)_"..." "RTN","PSOBORP3",245,0) ..I $L(TRIJUST)<125 W !,?4,TRIJUST "RTN","PSOBORP3",246,0) ; "RTN","PSOBORP3",247,0) ;if Excell format is selected "RTN","PSOBORP3",248,0) I PSOEXCEL D "RTN","PSOBORP3",249,0) .N REJIEN,FILE,FIELD,NCPDIEN,RJCDS,REJEXP "RTN","PSOBORP3",250,0) .S REJIEN=0,FILE=9002313.93,FIELD=.02,RJCDS="",REJEXP="" "RTN","PSOBORP3",251,0) .I $D(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3)) F S REJIEN=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN)) Q:'REJIEN D "RTN","PSOBORP3",252,0) ..S NCPDIEN=$G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN)) "RTN","PSOBORP3",253,0) ..S RJCDS=$S($G(RJCDS)="":NCPDIEN,1:RJCDS_","_NCPDIEN) "RTN","PSOBORP3",254,0) .I RJCDS'="",$P(RJCDS,":",1)'="eT" S REJEXP=$$GET1^DIQ(FILE,+$P(RJCDS,",",1),FIELD) "RTN","PSOBORP3",255,0) .I RJCDS'="",$P(RJCDS,":",1)="eT" S REJEXP="TRICARE-DRUG NON BILLABLE" "RTN","PSOBORP3",256,0) .W !,$E(NAME,1,30)_"^"_ID_"^"_RX_"^"_ECMENBR_"^"_RXDATE_"^"_RXINFO_"^"_$$DATTIM($P(ACTDT,".",1))_"^"_$E(USER,1,20)_"^"_$FN(AMTBILL,"T",2)_"^"_RXQTY_"^"_NDCNBR_"^"_RXDRUG_"^"_RJCDS_"^"_$P(RJCDS,",",1)_"^"_REJEXP_"^"_TRIJUST "RTN","PSOBORP3",257,0) ; "RTN","PSOBORP3",258,0) Q "RTN","PSOBORP3",259,0) ; "RTN","PSOBORP3",260,0) NCPDPRC(PSOAUD) ; "RTN","PSOBORP3",261,0) ;writes the NCPD reject code "RTN","PSOBORP3",262,0) ; "RTN","PSOBORP3",263,0) N REJIEN,FILE,FIELD,NCPDIEN,REJTXT "RTN","PSOBORP3",264,0) S REJIEN=0,FILE=9002313.93,FIELD=.02 "RTN","PSOBORP3",265,0) F S REJIEN=$O(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN)) Q:'REJIEN D "RTN","PSOBORP3",266,0) .S NCPDIEN=$G(PSOAUD(DIVISION,TCTYPE,PROVIDER,ACTDT,3,REJIEN)) "RTN","PSOBORP3",267,0) .I NCPDIEN'="eT" S REJTXT=$$GET1^DIQ(FILE,+NCPDIEN,FIELD) "RTN","PSOBORP3",268,0) .I NCPDIEN="eT" S REJTXT="TRICARE-DRUG NON BILLABLE" "RTN","PSOBORP3",269,0) .I 'PSOEXCEL W !,?4,NCPDIEN_":"_REJTXT "RTN","PSOBORP3",270,0) .I PSOEXCEL W !,NCPDIEN_":"_REJTXT "RTN","PSOBORP3",271,0) ; "RTN","PSOBORP3",272,0) Q "RTN","PSOBORP3",273,0) ; "RTN","PSOBORP3",274,0) RXINFO(RXNBR) ; "RTN","PSOBORP3",275,0) ;this will return the data needed for the RX INFO on the Audit Report. "RTN","PSOBORP3",276,0) ; "RTN","PSOBORP3",277,0) ; "RTN","PSOBORP3",278,0) N RFL,CMOP,RXSTATUS,FILLOC,BILLTYPE,RELDATE,RELSTATUS "RTN","PSOBORP3",279,0) S RFL=$$LSTRFL^PSOBPSU1(RXNBR) "RTN","PSOBORP3",280,0) S BILLTYPE="**" "RTN","PSOBORP3",281,0) S FILLOC=$$MWC^PSOBPSU2(RXNBR,RFL) "RTN","PSOBORP3",282,0) S RXSTATUS=$$GET1^DIQ(52,RXNBR,100,"I") "RTN","PSOBORP3",283,0) S RXSTATUS=$$RXSTANAM(RXSTATUS) "RTN","PSOBORP3",284,0) S RELDATE=$$RXRLDT^PSOBPSUT(RXNBR,RFL) "RTN","PSOBORP3",285,0) S RELSTATUS=$S(RELDATE'="":"R",1:"N") "RTN","PSOBORP3",286,0) I 'PSOEXCEL Q FILLOC_" "_BILLTYPE_" "_RXSTATUS_"/"_RELSTATUS "RTN","PSOBORP3",287,0) I PSOEXCEL Q FILLOC_"^"_RXSTATUS_"/"_RELSTATUS "RTN","PSOBORP3",288,0) ; "RTN","PSOBORP3",289,0) RXSTANAM(BPRXSTAT) ;*/ "RTN","PSOBORP3",290,0) Q:BPRXSTAT=0 "AC" ; ACTIVE; "RTN","PSOBORP3",291,0) Q:BPRXSTAT=1 "NV" ; NON-VERIFIED; "RTN","PSOBORP3",292,0) Q:BPRXSTAT=3 "HL" ; HOLD; "RTN","PSOBORP3",293,0) Q:BPRXSTAT=5 "SU" ; SUSPENDED; "RTN","PSOBORP3",294,0) Q:BPRXSTAT=11 "EX" ; EXPIRED; "RTN","PSOBORP3",295,0) Q:BPRXSTAT=12 "DS" ; DISCONTINUED; "RTN","PSOBORP3",296,0) Q:BPRXSTAT=13 "DL" ; DELETED; "RTN","PSOBORP3",297,0) Q:BPRXSTAT=14 "DS" ; DISCONTINUED BY PROVIDER; "RTN","PSOBORP3",298,0) Q:BPRXSTAT=15 "DS" ; DISCONTINUED (EDIT); "RTN","PSOBORP3",299,0) Q:BPRXSTAT=16 "HL" ; PROVIDER HOLD; "RTN","PSOBORP3",300,0) Q:BPRXSTAT=-1 "??" "RTN","PSOBORP3",301,0) Q "" "RTN","PSOBORP3",302,0) ; "RTN","PSOBORP3",303,0) ; "RTN","PSOBORP3",304,0) TCSSUMP(SUBTOT,RXCNT,TCTYPE,PROVIDER,PHARMCST) ;print the summary "RTN","PSOBORP3",305,0) ; "RTN","PSOBORP3",306,0) I TCTYPE="TRICARE INPATIENT" Q "RTN","PSOBORP3",307,0) S RJHDR=$E(STAR,1,30)_$E(SPACE,1,3)_TCTYPE_$E(SPACE,1,3)_$E(STAR,1,(57-$L(TCTYPE))) "RTN","PSOBORP3",308,0) ; "RTN","PSOBORP3",309,0) ;subtotals by provider "RTN","PSOBORP3",310,0) W !!,?7,$S(PSOSEL("TOTALS BY")="P":"PROVIDER: ",1:"PHARMACIST: "),PROVIDER,?44,$E(DASH,1,13) "RTN","PSOBORP3",311,0) W !,?7,"SUB-TOTALS",?51,SUBTOT "RTN","PSOBORP3",312,0) W !,?7,"RX COUNT",?51,RXCNT "RTN","PSOBORP3",313,0) W !,?7,"MEAN",?51,$FN(SUBTOT/RXCNT,"T",2),! "RTN","PSOBORP3",314,0) ; "RTN","PSOBORP3",315,0) Q "RTN","PSOBORP3",316,0) ; "RTN","PSOBORP3",317,0) TCHDR(TCTYPE) ;print report header "RTN","PSOBORP3",318,0) ; "RTN","PSOBORP3",319,0) S (SUBTOT,RXCNT)="" "RTN","PSOBORP3",320,0) I 'PSOEXCEL D Q "RTN","PSOBORP3",321,0) .S RJHDR=$E(STAR,1,30)_$E(SPACE,1,3)_TCTYPE_$E(SPACE,1,3)_$E(STAR,1,(57-$L(TCTYPE))) "RTN","PSOBORP3",322,0) .W !!,RJHDR "RTN","PSOBORP3",323,0) ; "RTN","PSOBORP3",324,0) ; "RTN","PSOBORP3",325,0) Q "RTN","PSOBORP3",326,0) ; "RTN","PSOBORP3",327,0) HDR ; "RTN","PSOBORP3",328,0) ; "RTN","PSOBORP3",329,0) ; "RTN","PSOBORP3",330,0) S HDR1="TRICARE BYPASS/OVERRIDE AUDIT REPORT - "_DETSUM_" Print Date: "_PSONOW "RTN","PSOBORP3",331,0) S HDR2="DIVISION(S): "_$$DIVISION() "RTN","PSOBORP3",332,0) S HDR3="TC TYPES: "_$$HDR4(.PSOSEL) "RTN","PSOBORP3",333,0) S HDR4="ALL PRESCRIPTIONS BY AUDIT DATE: From "_BEGDT_" through "_ENDDT "RTN","PSOBORP3",334,0) I PSOSEL("SUM_DETAIL")="D" D "RTN","PSOBORP3",335,0) .S HDR5="BENEFICIARY NAME/ID"_$E(SPACE,1,17)_"RX#"_$E(SPACE,1,15)_"REF/ECME#"_$E(SPACE,1,9)_"RX DATE"_$E(SPACE,1,11)_"RX INFO" "RTN","PSOBORP3",336,0) .S HDR6=$E(SPACE,1,4)_"ACTION DATE"_$E(SPACE,1,8)_"USER NAME"_$E(SPACE,1,26)_"$BILLED "_$E(SPACE,1,6)_"QTY"_$E(SPACE,1,9)_"NDC#"_$E(SPACE,1,15)_"DRUG" "RTN","PSOBORP3",337,0) ; "RTN","PSOBORP3",338,0) ; "RTN","PSOBORP3",339,0) Q "RTN","PSOBORP3",340,0) ; "RTN","PSOBORP3",341,0) HDR4(PSOSEL) ; "RTN","PSOBORP3",342,0) ; "RTN","PSOBORP3",343,0) N TCTYPE,RCODE "RTN","PSOBORP3",344,0) S (RCODE,TCTYPE)="" "RTN","PSOBORP3",345,0) F S TCTYPE=$O(PSOSEL("REJECT CODES",TCTYPE)) Q:TCTYPE="" D "RTN","PSOBORP3",346,0) .I $G(RCODE)="" S RCODE=PSOSEL("REJECT CODES",TCTYPE) "RTN","PSOBORP3",347,0) .E S RCODE=RCODE_", "_PSOSEL("REJECT CODES",TCTYPE) "RTN","PSOBORP3",348,0) ; "RTN","PSOBORP3",349,0) Q RCODE "RTN","PSOBORP3",350,0) ; "RTN","PSOBORP3",351,0) ; "RTN","PSOBORP3",352,0) DIVISION() ;list of divisions for header "RTN","PSOBORP3",353,0) ; "RTN","PSOBORP3",354,0) N DIV,DIVISION "RTN","PSOBORP3",355,0) S (DIVISION,DIV)="" "RTN","PSOBORP3",356,0) I PSOSEL("DIVISION")="A" Q "ALL" "RTN","PSOBORP3",357,0) F S DIV=$O(PSOSEL("DIVISION",DIV)) Q:DIV="" D "RTN","PSOBORP3",358,0) .I DIVISION="" S DIVISION=$P(PSOSEL("DIVISION",DIV),"^",2) Q "RTN","PSOBORP3",359,0) .S DIVISION=DIVISION_$P(PSOSEL("DIVISION",DIV),"^",2) "RTN","PSOBORP3",360,0) Q DIVISION "RTN","PSOBORP3",361,0) ; "RTN","PSOBORP3",362,0) ; "RTN","PSOBORP3",363,0) REJECTS() ;list the reject types for the header "RTN","PSOBORP3",364,0) ; "RTN","PSOBORP3",365,0) N REJ,REJECTS "RTN","PSOBORP3",366,0) S (REJECTS,REJ)="" "RTN","PSOBORP3",367,0) F S REJ=$O(PSOSEL("REJECT CODES",REJ)) Q:REJ="" D "RTN","PSOBORP3",368,0) .I REJECTS="" S REJECTS=$S(REJ="I":"TRICARE INPATIENT",REJ="N":"TRICARE NON-BILLABLE PRODUCT",REJ="R":"TRICARE REJECT OVERRIDE",1:"ALL") "RTN","PSOBORP3",369,0) .E S REJECTS=REJECTS_" "_$S(REJ="I":"TRICARE INPATIENT",REJ="N":"TRICARE NON-BILLABLE PRODUCT",REJ="R":"TRICARE REJECT OVERRIDE",1:"ALL") "RTN","PSOBORP3",370,0) ; "RTN","PSOBORP3",371,0) Q REJECTS "RTN","PSOBORP3",372,0) ; "RTN","PSOBORP3",373,0) ; "RTN","PSOBORP3",374,0) INIT ; "RTN","PSOBORP3",375,0) ; "RTN","PSOBORP3",376,0) N %,Y "RTN","PSOBORP3",377,0) D NOW^%DTC S Y=% D DD^%DT S PSONOW=Y "RTN","PSOBORP3",378,0) S $P(SPACE," ",150)="" "RTN","PSOBORP3",379,0) S $P(DASH,"-",150)="" "RTN","PSOBORP3",380,0) S $P(EQUAL,"=",150)="" "RTN","PSOBORP3",381,0) S $P(STAR,"*",150)="" "RTN","PSOBORP3",382,0) S PAGE="PAGE: " "RTN","PSOBORP3",383,0) S DETSUM=$S(PSOSEL("SUM_DETAIL")="S":"SUMMARY",1:"DETAIL") "RTN","PSOBORP3",384,0) S BEGDT=$$DATTIM(PSOSEL("BEGIN DATE")) "RTN","PSOBORP3",385,0) S ENDDT=$$DATTIM(PSOSEL("END DATE")) "RTN","PSOBORP3",386,0) S PSOEXCEL=$G(PSOSEL("EXCEL")) "RTN","PSOBORP3",387,0) K SUBTOTAL,MEAN,SUBTOT,DIVISION,PROVIDER,TCTYPE,TCTYPE,RXCNT "RTN","PSOBORP3",388,0) ; "RTN","PSOBORP3",389,0) Q "RTN","PSOBORP3",390,0) ; "RTN","PSOBORP3",391,0) ;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format "RTN","PSOBORP3",392,0) ; "RTN","PSOBORP3",393,0) DATTIM(X) ; "RTN","PSOBORP3",394,0) N DATE,BPT,BPM,BPH,BPAP "RTN","PSOBORP3",395,0) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"") "RTN","PSOBORP3",396,0) S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT)) "RTN","PSOBORP3",397,0) S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4) "RTN","PSOBORP3",398,0) S BPAP="AM" I BPH>12 S BPH=BPH-12,BPAP="PM" S:$L(BPH)<2 BPH="0"_BPH "RTN","PSOBORP3",399,0) I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP "RTN","PSOBORP3",400,0) Q $G(DATE) "RTN","PSOBORP3",401,0) ; "RTN","PSOBPSU1") 0^7^B53744697 "RTN","PSOBPSU1",1,0) PSOBPSU1 ;BIRM/MFR - BPS (ECME) Utilities 1 ;10/15/04 "RTN","PSOBPSU1",2,0) ;;7.0;OUTPATIENT PHARMACY;**148,260,281,287,303,289,290,358,359**;DEC 1997;Build 27 "RTN","PSOBPSU1",3,0) ;Reference to $$EN^BPSNCPDP supported by IA 4415 & 4304 "RTN","PSOBPSU1",4,0) ;References to $$NDCFMT^PSSNDCUT,$$GETNDC^PSSNDCUT supported by IA 4707 "RTN","PSOBPSU1",5,0) ;References to $$ECMEON^BPSUTIL,$$CMOPON^BPSUTIL supported by IA 4410 "RTN","PSOBPSU1",6,0) ;References to $$STORESP^IBNCPDP supported by IA 4299 "RTN","PSOBPSU1",7,0) ;Reference to $$CLAIM^BPSBUTL supported by IA 4719 "RTN","PSOBPSU1",8,0) ; "RTN","PSOBPSU1",9,0) ECMESND(RX,RFL,DATE,FROM,NDC,CMOP,RVTX,OVRC,CNDC,RESP,IGSW,ALTX,CLA,PA,RXCOB) ; - Sends Rx Release "RTN","PSOBPSU1",10,0) ;information to ECME/IB and updates NDC in the files 50 & 52; DBIA4304 "RTN","PSOBPSU1",11,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU1",12,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU1",13,0) ; (r) DATE - Date of Service "RTN","PSOBPSU1",14,0) ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api) "RTN","PSOBPSU1",15,0) ; (o) NDC - NDC Number (If not passed, will be retrieved from DRUG file) "RTN","PSOBPSU1",16,0) ; (o) CMOP - CMOP Rx (1-YES/0-NO) (Default: 0) "RTN","PSOBPSU1",17,0) ; (o) RVTX - REVERSE text (e.g., RX EDIT, RX RELEASE-NDC CHANGE, etc) "RTN","PSOBPSU1",18,0) ; (o) OVRC - Set of 3 NCPDP override codes separated by "^": "RTN","PSOBPSU1",19,0) ; Piece 1: NCPDP Professional Service Code for overriding DUR REJECTS "RTN","PSOBPSU1",20,0) ; Piece 2: NCPDP Reason for Service Code for overriding DUR REJECTS "RTN","PSOBPSU1",21,0) ; Piece 3: NCPDP Result of Service Code for overriding DUR REJECTS "RTN","PSOBPSU1",22,0) ; (o) CNDC - Changed NDC? 1 - Yes / 0 - No (Default: NO) "RTN","PSOBPSU1",23,0) ; (o) IGSW - Ignore Switches (Master and CMOP)? 1 - Yes / 0 - No (Default: NO) "RTN","PSOBPSU1",24,0) ; (o) ALTX - Alternative Text to be placed in the Rx ECME Activity Log "RTN","PSOBPSU1",25,0) ; (o) CLA - NCPDP Clarification Code(s) for overriding DUR/RTS REJECTS "RTN","PSOBPSU1",26,0) ; (o) PA - NCPDP Prior Authorization Type and Number (separated by "^") "RTN","PSOBPSU1",27,0) ; (o) RXCOB- Payer Sequence "RTN","PSOBPSU1",28,0) ;Output: RESP - Response from $$EN^BPSNCPDP api "RTN","PSOBPSU1",29,0) ; "RTN","PSOBPSU1",30,0) N ACT,NDCACT,DA,PSOELIG,ACT1 "RTN","PSOBPSU1",31,0) I '$D(RFL) S RFL=$$LSTRFL(RX) "RTN","PSOBPSU1",32,0) ; - ECME is not turned ON for the Rx's Division "RTN","PSOBPSU1",33,0) I '$G(IGSW),'$$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^ECME SWITCH OFF" Q "RTN","PSOBPSU1",34,0) ; - ECME CMOP is not turned ON for the Rx's Division "RTN","PSOBPSU1",35,0) I '$G(IGSW),$G(CMOP),'$$CMOPON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RFL)) S RESP="-1^CMOP SWITCH OFF" Q "RTN","PSOBPSU1",36,0) ; - Saving the NDC to be displayed on the ECME Act Log "RTN","PSOBPSU1",37,0) I $G(CNDC) D "RTN","PSOBPSU1",38,0) . I $G(NDC)'="" S NDCACT=NDC Q "RTN","PSOBPSU1",39,0) . S NDCACT=$$GETNDC^PSONDCUT(RX,RFL) "RTN","PSOBPSU1",40,0) I $$NDCFMT^PSSNDCUT($G(NDC))="" D "RTN","PSOBPSU1",41,0) . S NDC=$$GETNDC^PSSNDCUT($$GET1^DIQ(52,RX,6,"I"),$$RXSITE^PSOBPSUT(RX,RFL),+$G(CMOP)) "RTN","PSOBPSU1",42,0) . I $G(NDC)'="" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1) "RTN","PSOBPSU1",43,0) S PPDU="",PPDU=$$GPPDU^PSONDCUT(RX,RFL,NDC,,1,FROM) K PPDU "RTN","PSOBPSU1",44,0) ; - Creating ECME Act Log in file 52 "RTN","PSOBPSU1",45,0) S ACT="" I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" S ACT="Rev/Resubmit" "RTN","PSOBPSU1",46,0) S ACT=ACT_" ECME:" "RTN","PSOBPSU1",47,0) ; - Marked any 'unresolved' REJECTS as 'resolved' (Reason: 1 - Claim re-submitted) "RTN","PSOBPSU1",48,0) N CLSCOM,COD1,COD2,COD3 "RTN","PSOBPSU1",49,0) S COD2=$P($G(OVRC),"^"),COD1=$P($G(OVRC),"^",2),COD3=$P($G(OVRC),"^",3) "RTN","PSOBPSU1",50,0) I $G(COD3)'="" S CLSCOM="DUR Override Codes "_COD1_"/"_COD2_"/"_COD3_" submitted." "RTN","PSOBPSU1",51,0) I $G(CLA)'="" S CLSCOM="Clarification Code(s) "_CLA_" submitted." "RTN","PSOBPSU1",52,0) I $G(PA)'="" S CLSCOM="Prior Authorization Code ("_$P(PA,"^")_"/"_$P(PA,"^",2)_") submitted." "RTN","PSOBPSU1",53,0) D CLSALL^PSOREJUT(RX,RFL,DUZ,1,$G(CLSCOM),$G(COD1),$G(COD2),$G(COD3),$G(CLA),$G(PA)) "RTN","PSOBPSU1",54,0) ; - Call to ECME (NEWing STAT because ECME was overwriting it - Important variable for CMOP release PSXVND) "RTN","PSOBPSU1",55,0) N STAT "RTN","PSOBPSU1",56,0) I $G(RVTX)="",FROM="ED" S RVTX="RX EDITED" "RTN","PSOBPSU1",57,0) S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL,.DATE),FROM,NDC,$G(RVTX),$G(OVRC),,$G(CLA),$G(PA),$G(RXCOB)) "RTN","PSOBPSU1",58,0) I $$STATUS^PSOBPSUT(RX,RFL)="E PAYABLE" D SAVNDC^PSONDCUT(RX,RFL,NDC,+$G(CMOP),1,FROM) "RTN","PSOBPSU1",59,0) ; "RTN","PSOBPSU1",60,0) ; - Reseting the Re-transmission flag "RTN","PSOBPSU1",61,0) D RETRXF^PSOREJU2(RX,RFL,0) "RTN","PSOBPSU1",62,0) ; Storing eligibility flag "RTN","PSOBPSU1",63,0) S PSOELIG=$P(RESP,"^",3) D:PSOELIG'="" ELIG^PSOBPSU2(RX,RFL,PSOELIG) "RTN","PSOBPSU1",64,0) ; "RTN","PSOBPSU1",65,0) ;7/8/2010; bld ; added for tricare bypass/override audit file "RTN","PSOBPSU1",66,0) I $P(RESP,"^",2)="TRICARE INPATIENT/DISCHARGE" D "RTN","PSOBPSU1",67,0) .D EN^PSOBORP2(RX,RFL,RESP) "RTN","PSOBPSU1",68,0) ; "RTN","PSOBPSU1",69,0) ; "RTN","PSOBPSU1",70,0) ; - Logging ECME Act Log to file 52 "RTN","PSOBPSU1",71,0) I $G(ALTX)="" D "RTN","PSOBPSU1",72,0) . N X,ROUTE S (ROUTE,X)="" "RTN","PSOBPSU1",73,0) . S ROUTE=$S(FROM="RF":$$GET1^DIQ(52.1,RFL_","_RX_",",2),FROM="OF":$$GET1^DIQ(52,RX_",",11),1:"") "RTN","PSOBPSU1",74,0) . S:FROM="OF" X=ROUTE_" FILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" "RTN","PSOBPSU1",75,0) . S:FROM="RF" X=ROUTE_" REFILL(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" "RTN","PSOBPSU1",76,0) . S:FROM="RN" X="RX RENEWED(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" "RTN","PSOBPSU1",77,0) . S:FROM="PL" X="PRINTED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" "RTN","PSOBPSU1",78,0) . S:FROM="PE"!(FROM="PP") X="PULLED FROM SUSPENSE(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" "RTN","PSOBPSU1",79,0) . S:FROM="PC" X="CMOP TRANSMISSION(NDC:"_$$GETNDC^PSONDCUT(RX,RFL)_")" "RTN","PSOBPSU1",80,0) . S:FROM="RRL" X="RELEASED RX PREVIOUSLY REVERSED" "RTN","PSOBPSU1",81,0) . S:FROM="ED" X="RX EDITED" "RTN","PSOBPSU1",82,0) . S:$G(RVTX)'="" X=RVTX "RTN","PSOBPSU1",83,0) . S:$G(OVRC)'="" X="DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")" "RTN","PSOBPSU1",84,0) . S:$G(CNDC) X=X_"(NDC:"_NDCACT_")" S ACT=ACT_X "RTN","PSOBPSU1",85,0) . S ACT=ACT_$$STS(RX,RFL,RESP) "RTN","PSOBPSU1",86,0) I $G(ALTX)'="" S ACT=ACT_ALTX_$$STS(RX,RFL,RESP) "RTN","PSOBPSU1",87,0) I +RESP=2 S ACT="Not ECME Billable: "_$P(RESP,"^",2) "RTN","PSOBPSU1",88,0) I +RESP=6 S ACT=$P(RESP,"^",2) "RTN","PSOBPSU1",89,0) I +RESP=10 S ACT="ECME reversed/NOT re-submitted: "_$P(RESP,"^",2) "RTN","PSOBPSU1",90,0) S:PSOELIG="T" ACT="TRICARE-"_ACT "RTN","PSOBPSU1",91,0) S ACT1="" "RTN","PSOBPSU1",92,0) I $P(RESP,"^",6),$P(RESP,"^",7)'="" S ACT1="-"_$S($P(RESP,"^",6)="2":"s",$P(RESP,"^",6)="3":"t",1:"p")_$P(RESP,"^",7) "RTN","PSOBPSU1",93,0) S ACT=$E(ACT_ACT1,1,75) "RTN","PSOBPSU1",94,0) D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) "RTN","PSOBPSU1",95,0) D ELOG^PSOBPSU2(RESP) ;-Logs an ECME Act Log if Rx Qty is different than Billing Qty "RTN","PSOBPSU1",96,0) I PSOELIG="T",$P(RESP,"^",2)'="TRICARE INPATIENT/DISCHARGE" D TRICCHK^PSOREJU3(RX,RFL,RESP,FROM,$G(RVTX)) "RTN","PSOBPSU1",97,0) Q "RTN","PSOBPSU1",98,0) ; "RTN","PSOBPSU1",99,0) REVERSE(RX,RFL,FROM,RSN,RTXT,IGRL,NDC) ; - Reverse a claim and close all OPEN/UNRESOLVED Rejects "RTN","PSOBPSU1",100,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU1",101,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU1",102,0) ; (r) FROM - Function within OP (See BWHERE param. in EN^BPSNCPDP api) "RTN","PSOBPSU1",103,0) ; (o) RSN - Close Reason (2:RX ON HOLD;4: RX RETURNED TO STOCK,5:RX DELETED,etc...) "RTN","PSOBPSU1",104,0) ; (o) RTXT - Close Reason TEXT (Usually no passed if RSN is passed) "RTN","PSOBPSU1",105,0) ; (o) IGRL - Ignore RELEASE DATE, reverse anyway "RTN","PSOBPSU1",106,0) ; (o) NDC - NDC number related to the reversal (Note: might be an invalid NDC) "RTN","PSOBPSU1",107,0) I '$D(RFL) S RFL=$$LSTRFL(RX) "RTN","PSOBPSU1",108,0) N PSOET S PSOET=$$PSOET^PSOREJP3(RX,RFL) ;cnf, PSO*7.0*358 "RTN","PSOBPSU1",109,0) I 'PSOET,$$STATUS^PSOBPSUT(RX,RFL)="" Q ;cnf, PSO*7.0*358, add PSOET check, allow reversal for TRICARE non-billable reject "RTN","PSOBPSU1",110,0) N RESP,STS,ACT,STAT,DA,STATUS,NOACT,REVECME S RSN=+$G(RSN),RTXT=$G(RTXT),REVECME=1 "RTN","PSOBPSU1",111,0) I RTXT="",RSN D "RTN","PSOBPSU1",112,0) . S:RSN=2 RTXT="RX PLACED ON HOLD" S:RSN=3 RTXT="RX SUSPENDED" S:RSN=4 RTXT="RX RETURNED TO STOCK" "RTN","PSOBPSU1",113,0) . S:RSN=5 RTXT="RX DELETED" S:RSN=7 RTXT="RX DISCONTINUED" S:RSN=8 RTXT="RX EDITED" "RTN","PSOBPSU1",114,0) D CLSALL^PSOREJUT(RX,RFL,DUZ,RSN,RTXT) "RTN","PSOBPSU1",115,0) I '$G(IGRL),$$RXRLDT^PSOBPSUT(RX,RFL) Q "RTN","PSOBPSU1",116,0) ; - Reseting the Re-transmission flag if Rx is being suspended "RTN","PSOBPSU1",117,0) I RSN=3!($$GET1^DIQ(52,RX,100,"I")=5) D RETRXF^PSOREJU2(RX,RFL,1) "RTN","PSOBPSU1",118,0) S STATUS=$$STATUS^PSOBPSUT(RX,RFL),NOACT=0 "RTN","PSOBPSU1",119,0) I STATUS'="E PAYABLE",STATUS'="IN PROGRESS",STATUS'="E REVERSAL REJECTED",STATUS'="E REVERSAL STRANDED",STATUS'="E DUPLICATE" S NOACT=1 "RTN","PSOBPSU1",120,0) ; Only perform ECME reversal for a released CMOP if rx/fill is Discontinued. "RTN","PSOBPSU1",121,0) I FROM="DC",$$CMOP^PSOBPSUT(RX,RFL) S REVECME=0 "RTN","PSOBPSU1",122,0) I REVECME S RESP=$$EN^BPSNCPDP(RX,RFL,$$DOS(RX,RFL),FROM,$$GETNDC^PSONDCUT(RX,RFL),RTXT) "RTN","PSOBPSU1",123,0) N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC) "RTN","PSOBPSU1",124,0) ; - Logging ECME Act Log "RTN","PSOBPSU1",125,0) I '$G(NOACT),REVECME D "RTN","PSOBPSU1",126,0) . S ACT=$S(PSOTRIC:"TRICARE ",1:"")_"Reversal sent to ECME: "_RTXT_$S($G(NDC)'="":" ("_NDC_")",1:"")_$$STS(RX,RFL,+RESP) "RTN","PSOBPSU1",127,0) . D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) "RTN","PSOBPSU1",128,0) Q "RTN","PSOBPSU1",129,0) ; "RTN","PSOBPSU1",130,0) DOS(RX,RFL,DATE) ; Return the Date Of Service for ECME "RTN","PSOBPSU1",131,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU1",132,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU1",133,0) ; (o) DATE - Possible Date Of Service "RTN","PSOBPSU1",134,0) ;Output: DOS - Actual Date Of Service "RTN","PSOBPSU1",135,0) I '$D(RFL) S RFL=$$LSTRFL(RX) "RTN","PSOBPSU1",136,0) ; - Retrieving FILL DATE from file 52 if not passed "RTN","PSOBPSU1",137,0) I $G(DATE)="" S DATE=$$RXRLDT^PSOBPSUT(RX,RFL) "RTN","PSOBPSU1",138,0) ; - Retrieving FILL DATE from file 52 if not passed "RTN","PSOBPSU1",139,0) I 'DATE S DATE=$$RXFLDT^PSOBPSUT(RX,RFL) "RTN","PSOBPSU1",140,0) ; - Future Date not allowed "RTN","PSOBPSU1",141,0) I DATE>DT!'DATE S DATE=DT "RTN","PSOBPSU1",142,0) Q (DATE\1) "RTN","PSOBPSU1",143,0) ; "RTN","PSOBPSU1",144,0) RELEASE(RX,RFL,USR) ; - Notifies IB that the Rx was RELEASED "RTN","PSOBPSU1",145,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU1",146,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU1",147,0) ; (o) USR - User responsible for releasing the Rx (Default: .5 - Postmaster) "RTN","PSOBPSU1",148,0) N IBAR,RXAR,FLDT,RFAR,PSOIBN "RTN","PSOBPSU1",149,0) S:'$D(RFL) RFL=$$LSTRFL(RX) "RTN","PSOBPSU1",150,0) S:'$D(USR) USR=.5 "RTN","PSOBPSU1",151,0) D GETS^DIQ(52,RX_",",".01;2;6;7;8;22","I","RXAR") "RTN","PSOBPSU1",152,0) S DFN=+$G(RXAR(52,RX_",",2,"I")) "RTN","PSOBPSU1",153,0) S IBAR("PRESCRIPTION")=RX,IBAR("RX NO")=$G(RXAR(52,RX_",",.01,"I")) "RTN","PSOBPSU1",154,0) S IBAR("CLAIMID")=$P($$CLAIM^BPSBUTL(RX,RFL),U,6) "RTN","PSOBPSU1",155,0) S IBAR("USER")=USR "RTN","PSOBPSU1",156,0) S IBAR("DRUG")=RXAR(52,RX_",",6,"I"),IBAR("NDC")=$$GETNDC^PSONDCUT(RX,RFL) "RTN","PSOBPSU1",157,0) S FLDT=$$RXFLDT^PSOBPSUT(RX,RFL) I FLDT>DT S FLDT=DT "RTN","PSOBPSU1",158,0) S IBAR("FILL NUMBER")=RFL,IBAR("FILL DATE")=FLDT "RTN","PSOBPSU1",159,0) S IBAR("QTY")=$G(RXAR(52,RX_",",7,"I")),IBAR("DAYS SUPPLY")=$G(RXAR(52,RX_",",8,"I")) "RTN","PSOBPSU1",160,0) I RFL D "RTN","PSOBPSU1",161,0) . D GETS^DIQ(52.1,RFL_","_RX_",",".01;1;1.1","I","RFAR") "RTN","PSOBPSU1",162,0) . S IBAR("QTY")=$G(RFAR(52.1,RFL_","_RX_",",1,"I")) "RTN","PSOBPSU1",163,0) . S IBAR("DAYS SUPPLY")=$G(RFAR(52.1,RFL_","_RX_",",1.1,"I")) "RTN","PSOBPSU1",164,0) S IBAR("STATUS")="RELEASED" "RTN","PSOBPSU1",165,0) S PSOIBN=$$STORESP^IBNCPDP(DFN,.IBAR) "RTN","PSOBPSU1",166,0) Q "RTN","PSOBPSU1",167,0) ; "RTN","PSOBPSU1",168,0) LSTRFL(RX) ; - Returns the latest fill for the Rx "RTN","PSOBPSU1",169,0) ; Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU1",170,0) ;Output: LSTRFL - Most recent refill # "RTN","PSOBPSU1",171,0) N I,LSTRFL "RTN","PSOBPSU1",172,0) S (I,LSTRFL)=0 F S I=$O(^PSRX(RX,1,I)) Q:'I S LSTRFL=I "RTN","PSOBPSU1",173,0) Q LSTRFL "RTN","PSOBPSU1",174,0) ; "RTN","PSOBPSU1",175,0) ECMEACT(RX,RFL,COMM,USR) ; - Add an Act to the ECME Act Log (FILE 52) "RTN","PSOBPSU1",176,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU1",177,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU1",178,0) ; (r) COMM - Comments (up to 75 characters) "RTN","PSOBPSU1",179,0) ; (o) USR - User logging the comments (Default: DUZ) "RTN","PSOBPSU1",180,0) S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOBPSU1",181,0) D RXACT^PSOBPSU2(RX,RFL,COMM,"M",+$G(USR)) "RTN","PSOBPSU1",182,0) Q "RTN","PSOBPSU1",183,0) ; "RTN","PSOBPSU1",184,0) STS(RX,RFL,RSP) ; Adds the Status to the ECME Act Log according to Rx/fill claim status Response "RTN","PSOBPSU1",185,0) N STS "RTN","PSOBPSU1",186,0) S STS=$S($$STATUS^PSOBPSUT(RX,RFL)'="IN PROGRESS"&($$STATUS^PSOBPSUT(RX,RFL)'=""):"-"_$$STATUS^PSOBPSUT(RX,RFL),1:"") "RTN","PSOBPSU1",187,0) S:+RSP=1 STS="-NO SUBMISSION THROUGH ECME" S:+RSP=3 STS="-NO REVERSAL NEEDED" S:+RSP=4 STS="-NOT PROCESSED" "RTN","PSOBPSU1",188,0) S:+RSP=5 STS="-SOFTWARE ERROR"_$S($P($G(RESP),"^",2)'="":" ("_$P(RESP,"^",2)_")",1:"") "RTN","PSOBPSU1",189,0) I +RSP=2,$$STATUS^PSOBPSUT(RX,RFL)'="" S STS="-NOT BILLABLE:"_$S(PSOELIG="T":"TRICARE",PSOELIG="C":"CHAMPVA",1:"")_":"_$P(RSP,"^",2) "RTN","PSOBPSU1",190,0) Q STS "RTN","PSOBPSU2") 0^2^B55533133 "RTN","PSOBPSU2",1,0) PSOBPSU2 ;BIRM/MFR - BPS (ECME) Utilities 2 ;10/15/04 "RTN","PSOBPSU2",2,0) ;;7.0;OUTPATIENT PHARMACY;**260,287,289,341,290,358,359**;DEC 1997;Build 27 "RTN","PSOBPSU2",3,0) ;Reference to File 200 - NEW PERSON supported by IA 10060 "RTN","PSOBPSU2",4,0) ;Reference to DUR1^BPSNCPD3 supported by IA 4560 "RTN","PSOBPSU2",5,0) ;Reference to $$NCPDPQTY^PSSBPSUT supported by IA 4992 "RTN","PSOBPSU2",6,0) ;Reference to $$CLAIM^BPSBUTL supported by IA 4719 "RTN","PSOBPSU2",7,0) ; "RTN","PSOBPSU2",8,0) MWC(RX,RFL) ; Returns whether a prescription is (M)ail, (W)indow or (C)MOP "RTN","PSOBPSU2",9,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU2",10,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU2",11,0) ;Output: "M": MAIL / "W": WINDOW / "C": CMOP "RTN","PSOBPSU2",12,0) ; "RTN","PSOBPSU2",13,0) N MWC "RTN","PSOBPSU2",14,0) ; "RTN","PSOBPSU2",15,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOBPSU2",16,0) ; "RTN","PSOBPSU2",17,0) ; - MAIL/WINDOW fields (Original and Refill) "RTN","PSOBPSU2",18,0) I RFL S MWC=$$GET1^DIQ(52.1,RFL_","_RX,2,"I") "RTN","PSOBPSU2",19,0) E S MWC=$$GET1^DIQ(52,RX,11,"I") "RTN","PSOBPSU2",20,0) S:MWC="" MWC="W" "RTN","PSOBPSU2",21,0) ; "RTN","PSOBPSU2",22,0) ; - Checking the RX SUSPENSE file (#52.5) "RTN","PSOBPSU2",23,0) I $$GET1^DIQ(52,RX,100,"I")=5 D "RTN","PSOBPSU2",24,0) . N RXS S RXS=+$O(^PS(52.5,"B",RX,0)) Q:'RXS "RTN","PSOBPSU2",25,0) . I $$GET1^DIQ(52.5,RXS,3,"I")'="" S MWC="C" Q "RTN","PSOBPSU2",26,0) . S MWC="M" "RTN","PSOBPSU2",27,0) ; "RTN","PSOBPSU2",28,0) ; - Checking the CMOP EVENT sub-file (#52.01) "RTN","PSOBPSU2",29,0) I MWC'="C" D "RTN","PSOBPSU2",30,0) . N CMP S CMP=0 "RTN","PSOBPSU2",31,0) . F S CMP=$O(^PSRX(RX,4,CMP)) Q:'CMP D I MWC="C" Q "RTN","PSOBPSU2",32,0) . . I $$GET1^DIQ(52.01,CMP_","_RX,2,"I")=RFL S MWC="C" "RTN","PSOBPSU2",33,0) ; "RTN","PSOBPSU2",34,0) Q MWC "RTN","PSOBPSU2",35,0) ; "RTN","PSOBPSU2",36,0) RXACT(RX,RFL,COMM,TYPE,USR) ; - Add an Activity to the ECME Activity Log (PRESCRIPTION file) "RTN","PSOBPSU2",37,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOBPSU2",38,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOBPSU2",39,0) ; (r) COMM - Comments (up to 75 characters) "RTN","PSOBPSU2",40,0) ; (r) TYPE - Comments type: (M-ECME,E-Edit, etc...) See file #52 DD for all values "RTN","PSOBPSU2",41,0) ; (o) USR - User logging the comments (Default: DUZ) "RTN","PSOBPSU2",42,0) ; "RTN","PSOBPSU2",43,0) S:'$D(RFL) RFL=$$LSTRFL^PSOBPSU1(RX) S:'$D(USR) USR=DUZ "RTN","PSOBPSU2",44,0) S:'$D(^VA(200,+USR,0)) USR=DUZ S COMM=$E($G(COMM),1,75) "RTN","PSOBPSU2",45,0) ; "RTN","PSOBPSU2",46,0) I COMM="" Q "RTN","PSOBPSU2",47,0) I '$D(^PSRX(RX)) Q "RTN","PSOBPSU2",48,0) ; "RTN","PSOBPSU2",49,0) N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC) "RTN","PSOBPSU2",50,0) I $E(COMM,1,7)'="TRICARE",PSOTRIC S COMM=$E("TRICARE-"_COMM,1,75) "RTN","PSOBPSU2",51,0) N X,DIC,DA,DD,DO,DR,DINUM,Y,DLAYGO "RTN","PSOBPSU2",52,0) S DA(1)=RX,DIC="^PSRX("_RX_",""A"",",DLAYGO=52.3,DIC(0)="L" "RTN","PSOBPSU2",53,0) S DIC("DR")=".02///"_TYPE_";.03////"_USR_";.04///"_$S(TYPE'="M"&(RFL>5):RFL+1,1:RFL)_";.05///"_COMM "RTN","PSOBPSU2",54,0) S X=$$NOW^XLFDT() D FILE^DICN "RTN","PSOBPSU2",55,0) Q "RTN","PSOBPSU2",56,0) ; "RTN","PSOBPSU2",57,0) ECMENUM(RX,RFL) ; Returns the ECME number for a specific prescription and fill "RTN","PSOBPSU2",58,0) N ECMENUM "RTN","PSOBPSU2",59,0) I $G(RX)="" Q "" "RTN","PSOBPSU2",60,0) ; Check ECME # for Refill passed in "RTN","PSOBPSU2",61,0) I $G(RFL)'="" S ECMENUM=$$GETECME(RX,RFL) Q ECMENUM "RTN","PSOBPSU2",62,0) ; If Refill is null, check last refill "RTN","PSOBPSU2",63,0) S RFL=$$LSTRFL^PSOBPSU1(RX),ECMENUM=$$GETECME(RX,RFL) I ECMENUM'="" Q ECMENUM "RTN","PSOBPSU2",64,0) ; If no ECME # for last refill, step back through refills in reverse order "RTN","PSOBPSU2",65,0) F S RFL=RFL-1 Q:(RFL<0)!(ECMENUM'="") S ECMENUM=$$GETECME(RX,RFL) "RTN","PSOBPSU2",66,0) Q ECMENUM "RTN","PSOBPSU2",67,0) ; "RTN","PSOBPSU2",68,0) GETECME(RX,RFL) ; "RTN","PSOBPSU2",69,0) ;Internal function used by ECMENUM to get the ECME # from BPS "RTN","PSOBPSU2",70,0) N ECMENUM "RTN","PSOBPSU2",71,0) I $G(RX)="" Q "" "RTN","PSOBPSU2",72,0) I $G(RFL)="" Q "" "RTN","PSOBPSU2",73,0) S ECMENUM=$P($$CLAIM^BPSBUTL(RX,RFL),U,6) "RTN","PSOBPSU2",74,0) Q ECMENUM "RTN","PSOBPSU2",75,0) ; "RTN","PSOBPSU2",76,0) RXNUM(ECME) ; Returns the Rx number for a specific ECME number "RTN","PSOBPSU2",77,0) ; "RTN","PSOBPSU2",78,0) N FOUND,MAX,LFT,RAD,I,DIR,RX,X,Y,DIRUT "RTN","PSOBPSU2",79,0) S ECME=+ECME,LFT=0,FOUND=0 "RTN","PSOBPSU2",80,0) S MAX=$O(^PSRX(9999999999999),-1) ; MAX = largest Rx ien on file "RTN","PSOBPSU2",81,0) ; "RTN","PSOBPSU2",82,0) ; Attempt left digit matching logic in this case only "RTN","PSOBPSU2",83,0) I $L(MAX)>7,$L(ECME)'>7 D "RTN","PSOBPSU2",84,0) . S LFT=$E(MAX,1,$L(MAX)-7) ; LFT = left most digits "RTN","PSOBPSU2",85,0) . F RAD=LFT:-1:0 S RX=RAD*10000000+ECME I $D(^PSRX(RX,0)),$$ECMENUM(RX)'="" S FOUND=FOUND+1,FOUND(FOUND)=RX "RTN","PSOBPSU2",86,0) . Q "RTN","PSOBPSU2",87,0) ; "RTN","PSOBPSU2",88,0) ; Otherwise attempt a normal lookup "RTN","PSOBPSU2",89,0) E S RX=ECME I $D(^PSRX(RX,0)),$$ECMENUM(RX)'="" S FOUND=FOUND+1,FOUND(FOUND)=RX "RTN","PSOBPSU2",90,0) ; "RTN","PSOBPSU2",91,0) I 'FOUND S FOUND=-1 G RXNUMX ; Rx not found "RTN","PSOBPSU2",92,0) I FOUND=1 S FOUND=FOUND(1) G RXNUMX ; exactly 1 found "RTN","PSOBPSU2",93,0) ; "RTN","PSOBPSU2",94,0) ; More than 1 found so build a list and ask "RTN","PSOBPSU2",95,0) W ! F I=1:1:FOUND W !?5,I,". ",$$GET1^DIQ(52,FOUND(I),.01),?25,$$GET1^DIQ(52,FOUND(I),6) "RTN","PSOBPSU2",96,0) W ! S DIR(0)="NA^1:"_FOUND,DIR("A")="Select one: ",DIR("B")=1 "RTN","PSOBPSU2",97,0) D ^DIR I $D(DIRUT) S FOUND=-1 G RXNUMX "RTN","PSOBPSU2",98,0) S FOUND=FOUND(Y) "RTN","PSOBPSU2",99,0) ; "RTN","PSOBPSU2",100,0) RXNUMX ; "RTN","PSOBPSU2",101,0) Q FOUND "RTN","PSOBPSU2",102,0) ; "RTN","PSOBPSU2",103,0) ELIG(RX,RFL,PSOELIG) ;Stores eligibility flag "RTN","PSOBPSU2",104,0) I RFL>0,'$D(^PSRX(RX,1,RFL,0)) QUIT "RTN","PSOBPSU2",105,0) N DA,DIE,X,Y,PSOTRIC "RTN","PSOBPSU2",106,0) I 'RFL S DA=RX,DIE="^PSRX(",DR="85///"_PSOELIG D ^DIE "RTN","PSOBPSU2",107,0) I RFL S DA=RFL,DA(1)=RX,DIE="^PSRX("_DA(1)_",1,",DR="85///"_PSOELIG D ^DIE "RTN","PSOBPSU2",108,0) Q "RTN","PSOBPSU2",109,0) ; "RTN","PSOBPSU2",110,0) ECMESTAT(RX,RFL) ;called from local mail "RTN","PSOBPSU2",111,0) ;Input: "RTN","PSOBPSU2",112,0) ; RX = Prescription File IEN "RTN","PSOBPSU2",113,0) ; RFL = Refill "RTN","PSOBPSU2",114,0) ;Output: "RTN","PSOBPSU2",115,0) ; 0 for not allowed to print from suspense "RTN","PSOBPSU2",116,0) ; 1 for allowed to print from suspense "RTN","PSOBPSU2",117,0) ; "RTN","PSOBPSU2",118,0) N STATUS,SHDT,PSOTRIC,TRICCK "RTN","PSOBPSU2",119,0) S STATUS=$$STATUS^PSOBPSUT(RX,RFL) "RTN","PSOBPSU2",120,0) ;IN PROGRESS claims - try again. If still IN PROGRESS, do not allow to print "RTN","PSOBPSU2",121,0) I STATUS["IN PROGRESS" H 5 S STATUS=$$STATUS^PSOBPSUT(RX,RFL) I STATUS["IN PROGRESS" Q 0 "RTN","PSOBPSU2",122,0) ;no ECME status, allow to print. This will eliminate 90% of the cases "RTN","PSOBPSU2",123,0) I STATUS="" Q 1 "RTN","PSOBPSU2",124,0) ;check for Tricare rejects, not allowed to go to print until resolved. "RTN","PSOBPSU2",125,0) ;it does not matter much for this API but usually Tricare processing is done first. "RTN","PSOBPSU2",126,0) S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,.PSOTRIC) "RTN","PSOBPSU2",127,0) ;Add TRIAUD - if RX/RFL is in audit, allow to print even if not payable; PSO*7*358, cnf "RTN","PSOBPSU2",128,0) I PSOTRIC,STATUS'["PAYABLE",'$$TRIAUD^PSOREJU3(RX,RFL) Q 0 "RTN","PSOBPSU2",129,0) ;DUR (88)/RTS (79) reject codes are not allowed to print until resolved. "RTN","PSOBPSU2",130,0) I $$FIND^PSOREJUT(RX,RFL,,"79,88") Q 0 "RTN","PSOBPSU2",131,0) ;check for suspense hold date/host reject errors "RTN","PSOBPSU2",132,0) I $$DUR(RX,RFL)=0 Q 0 "RTN","PSOBPSU2",133,0) Q 1 "RTN","PSOBPSU2",134,0) ; "RTN","PSOBPSU2",135,0) ;Description: "RTN","PSOBPSU2",136,0) ;This function checks to see if a RX should be submitted to ECME "RTN","PSOBPSU2",137,0) ;Submit when: "RTN","PSOBPSU2",138,0) ; RX/Fill was not submitted before (STATUS="") "RTN","PSOBPSU2",139,0) ; Previous submission had Host Reject Error Code(s) "RTN","PSOBPSU2",140,0) ;Input: "RTN","PSOBPSU2",141,0) ; RX = Prescription file #52 IEN "RTN","PSOBPSU2",142,0) ; RFL = Refill number "RTN","PSOBPSU2",143,0) ;Returns: "RTN","PSOBPSU2",144,0) ; 1 = OK to resubmit "RTN","PSOBPSU2",145,0) ; 0 = Don't resubmit "RTN","PSOBPSU2",146,0) ECMEST2(RX,RFL) ; "RTN","PSOBPSU2",147,0) N STATUS "RTN","PSOBPSU2",148,0) S STATUS=$$STATUS^PSOBPSUT(RX,RFL) "RTN","PSOBPSU2",149,0) ; Never submitted before, OK to submit "RTN","PSOBPSU2",150,0) I STATUS="" Q 1 "RTN","PSOBPSU2",151,0) ; If status other than E REJECTED, don't resubmit "RTN","PSOBPSU2",152,0) I STATUS'="E REJECTED" Q 0 "RTN","PSOBPSU2",153,0) ; Check for host reject codes(s) "RTN","PSOBPSU2",154,0) Q $$HOSTREJ(RX,RFL,1) "RTN","PSOBPSU2",155,0) ; "RTN","PSOBPSU2",156,0) ;Description: ePharmacy "RTN","PSOBPSU2",157,0) ;This subroutine checks an RX/FILL for Host Reject Errors returned "RTN","PSOBPSU2",158,0) ;from previous ECME submissions. The host reject errors checked are M6, M8, NN, and 99. "RTN","PSOBPSU2",159,0) ;Note that host reject errors do not pass to the pharmacy reject worklist so it's necessary "RTN","PSOBPSU2",160,0) ;to check ECME for these type errors. "RTN","PSOBPSU2",161,0) ;Input: "RTN","PSOBPSU2",162,0) ; RX = Prescription File IEN "RTN","PSOBPSU2",163,0) ; RFL = Refill "RTN","PSOBPSU2",164,0) ; ONE = Either 1 or 0 - Defaults to 1 "RTN","PSOBPSU2",165,0) ; If 1, At least ONE reject code associated with the RX/FILL must "RTN","PSOBPSU2",166,0) ; match either M6, M8, NN, or 99. "RTN","PSOBPSU2",167,0) ; If 0, ALL reject codes must match either M6, M8, NN, or 99 "RTN","PSOBPSU2",168,0) ; REJ = (o) reject information from called from routine to be passed back. (contains data returned from DUR1^BPSNCPD3) "RTN","PSOBPSU2",169,0) ;Return: "RTN","PSOBPSU2",170,0) ; 0 = no host rejects exists based on ONE parameter "RTN","PSOBPSU2",171,0) ; 1 = host reject exists based on ONE parameter "RTN","PSOBPSU2",172,0) HOSTREJ(RX,RFL,ONE) ; called from PSXRPPL2 and this routine "RTN","PSOBPSU2",173,0) N IDX,TXT,CODE,HRCODE,HRQUIT,RETV,REJ,I "RTN","PSOBPSU2",174,0) S IDX="",(RETV,HRQUIT)=0 "RTN","PSOBPSU2",175,0) I '$D(ONE) S ONE=1 "RTN","PSOBPSU2",176,0) ;for print from suspense there will only be primary insurance or an index of 1 in REJ array "RTN","PSOBPSU2",177,0) D DUR1^BPSNCPD3(RX,RFL,.REJ) ; Get reject list from last submission if not present "RTN","PSOBPSU2",178,0) S TXT=$G(REJ(1,"REJ CODE LST")) "RTN","PSOBPSU2",179,0) Q:TXT="" 0 "RTN","PSOBPSU2",180,0) I ONE=0,TXT'["," S ONE=1 "RTN","PSOBPSU2",181,0) F I=1:1:$L(TXT,",") S CODE=$P(TXT,",",I) D Q:HRQUIT "RTN","PSOBPSU2",182,0) . F HRCODE=99,"M6","M8","NN" D Q:HRQUIT "RTN","PSOBPSU2",183,0) . . I CODE=HRCODE S RETV=1 I ONE S HRQUIT=1 Q "RTN","PSOBPSU2",184,0) . . I CODE'=HRCODE,RETV=1 S RETV=0,HRQUIT=1 Q "RTN","PSOBPSU2",185,0) Q RETV "RTN","PSOBPSU2",186,0) ; "RTN","PSOBPSU2",187,0) ;Description: "RTN","PSOBPSU2",188,0) ;Input: RX = Prescription file #52 IEN "RTN","PSOBPSU2",189,0) ; RFL = Refill number "RTN","PSOBPSU2",190,0) ;Returns: A value of 0 (zero) will be returned when reject codes M6, M8, "RTN","PSOBPSU2",191,0) ;NN, and 99 are present OR if on susp hold which means the prescription should not "RTN","PSOBPSU2",192,0) ;be printed from suspense. Otherwise, a value of 1(one) will be returned. "RTN","PSOBPSU2",193,0) DUR(RX,RFL) ; "RTN","PSOBPSU2",194,0) N REJ,IDX,TXT,CODE,SHOLD,SHCODE,ESTAT,SHDT "RTN","PSOBPSU2",195,0) S SHOLD=1,IDX="" "RTN","PSOBPSU2",196,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOBPSU2",197,0) S SHDT=$$SHDT(RX,RFL) ; Get suspense hold date for rx/refill "RTN","PSOBPSU2",198,0) I SHDT'="",SHDT'<$$FMADD^XLFDT(DT,1) Q 0 "RTN","PSOBPSU2",199,0) I $$HOSTREJ^PSOBPSU2(RX,RFL,1) I SHDT="" S SHOLD=0 D SHDTLOG(RX,RFL) "RTN","PSOBPSU2",200,0) Q SHOLD "RTN","PSOBPSU2",201,0) ; "RTN","PSOBPSU2",202,0) ;Description: This subroutine sets the EPHARMACY SUSPENSE HOLD DATE field "RTN","PSOBPSU2",203,0) ;for the rx or refill to tomorrow and adds an entry to the SUSPENSE Activity Log. "RTN","PSOBPSU2",204,0) ;Input: RX = Prescription File IEN "RTN","PSOBPSU2",205,0) ; RFL = Refill "RTN","PSOBPSU2",206,0) SHDTLOG(RX,RFL) ; "RTN","PSOBPSU2",207,0) N DA,DIE,DR,COMM,SHDT "RTN","PSOBPSU2",208,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOBPSU2",209,0) S SHDT=$$FMADD^XLFDT(DT,1) "RTN","PSOBPSU2",210,0) S COMM="SUSPENSE HOLD until "_$$FMTE^XLFDT(SHDT,"2D")_" due to host reject error." "RTN","PSOBPSU2",211,0) I RFL=0 S DA=RX,DIE="^PSRX(",DR="86///"_SHDT D ^DIE "RTN","PSOBPSU2",212,0) E S DA=RFL,DA(1)=RX,DIE="^PSRX("_DA(1)_",1,",DR="86///"_SHDT D ^DIE "RTN","PSOBPSU2",213,0) D RXACT(RX,RFL,COMM,"S",+$G(DUZ)) ; Create Activity Log entry "RTN","PSOBPSU2",214,0) Q "RTN","PSOBPSU2",215,0) ; "RTN","PSOBPSU2",216,0) ;Description: This function returns the EPHARMACY SUSPENSE HOLD DATE field "RTN","PSOBPSU2",217,0) ;for the rx or refill "RTN","PSOBPSU2",218,0) ;Input: RX = Prescription File IEN "RTN","PSOBPSU2",219,0) ; RFL = Refill "RTN","PSOBPSU2",220,0) SHDT(RX,RFL) ; "RTN","PSOBPSU2",221,0) N FILE,IENS "RTN","PSOBPSU2",222,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOBPSU2",223,0) S FILE=$S(RFL=0:52,1:52.1),IENS=$S(RFL=0:RX_",",1:RFL_","_RX_",") "RTN","PSOBPSU2",224,0) Q $$GET1^DIQ(FILE,IENS,86,"I") "RTN","PSOBPSU2",225,0) ; "RTN","PSOBPSU2",226,0) ELOG(RESP) ; - due to size of PSOBPSU1 exceeding limit "RTN","PSOBPSU2",227,0) ; -Logs an ECME Activity Log if Rx Qty is different than Billing Qty "RTN","PSOBPSU2",228,0) I '$G(RESP),$T(NCPDPQTY^PSSBPSUT)'="" D "RTN","PSOBPSU2",229,0) . N DRUG,RXQTY,BLQTY,BLDU,Z "RTN","PSOBPSU2",230,0) . S DRUG=$$GET1^DIQ(52,RX,6,"I") "RTN","PSOBPSU2",231,0) . S RXQTY=$S('RFL:$$GET1^DIQ(52,RX,7,"I"),1:$$GET1^DIQ(52.1,RFL_","_RX,1))/1 "RTN","PSOBPSU2",232,0) . S Z=$$NCPDPQTY^PSSBPSUT(DRUG,RXQTY),BLQTY=Z/1,BLDU=$P(Z,"^",2) "RTN","PSOBPSU2",233,0) . I RXQTY'=BLQTY D "RTN","PSOBPSU2",234,0) . . D RXACT(RX,RFL,"BILLING QUANTITY submitted: "_$J(BLQTY,0,$L($P(BLQTY,".",2)))_" ("_BLDU_")","M",DUZ) "RTN","PSOBPSU2",235,0) Q "RTN","PSOBPSU2",236,0) ; "RTN","PSOBPSU2",237,0) UPDFL(RXREC,SUB,INDT) ;update fill date with release date when NDC changes at CMOP and OPAI auto-release "RTN","PSOBPSU2",238,0) ;Input: RXREC = Prescription File IEN "RTN","PSOBPSU2",239,0) ; SUB = Refill "RTN","PSOBPSU2",240,0) ; INDT = Release date "RTN","PSOBPSU2",241,0) N DA,DIE,DR,PSOX,SFN,DEAD,SUB,XOK,OLD,X,II,EXDAT,OFILLD,COM,CNT,RFCNT,RF "RTN","PSOBPSU2",242,0) S DEAD=0,SFN="" "RTN","PSOBPSU2",243,0) S EXDAT=INDT I EXDAT["." S EXDAT=$P(EXDAT,".") "RTN","PSOBPSU2",244,0) I '$D(SUB) S SUB=0 F II=0:0 S II=$O(^PSRX(RXREC,1,II)) Q:'II S SUB=+II "RTN","PSOBPSU2",245,0) I 'SUB S OFILLD=$$GET1^DIQ(52,RXREC,22,"I") Q:OFILLD=EXDAT D "RTN","PSOBPSU2",246,0) .S (X,OLD)=$P(^PSRX(RXREC,2),"^",2),DA=RXREC,DR="22///"_EXDAT_";101///"_EXDAT,DIE=52 "RTN","PSOBPSU2",247,0) .D ^DIE K DIE,DA "RTN","PSOBPSU2",248,0) I SUB S (OLD,X)=+$P($G(^PSRX(RXREC,1,SUB,0)),"^"),DA(1)=RXREC,DA=SUB,OFILLD=$$GET1^DIQ(52.1,DA_","_RXREC,.01,"I") Q:OFILLD=EXDAT D "RTN","PSOBPSU2",249,0) . S DIE="^PSRX("_DA(1)_",1,",DR=".01///"_EXDAT D ^DIE K DIE S $P(^PSRX(RXREC,3),"^")=EXDAT "RTN","PSOBPSU2",250,0) Q:$D(DTOUT)!($D(DUOUT)) "RTN","PSOBPSU2",251,0) S DA=RXREC "RTN","PSOBPSU2",252,0) D AREC^PSOSUCH1 "RTN","PSOBPSU2",253,0) FIN ; "RTN","PSOBPSU2",254,0) Q "RTN","PSOLSET") 0^14^B30029461 "RTN","PSOLSET",1,0) PSOLSET ;BHAM ISC/SAB - site parameter set up ;12/03/92 "RTN","PSOLSET",2,0) VERS ;;7.0;OUTPATIENT PHARMACY;**10,22,32,40,120,247,359**;DEC 1997;Build 27 "RTN","PSOLSET",3,0) ;Reference to ^PS(59.7 supported by DBIA 694 "RTN","PSOLSET",4,0) ;Reference to ^PSX(550 supported by DBIA 2230 "RTN","PSOLSET",5,0) ;Reference to ^%ZIS(2 supported by DBIA 3435 "RTN","PSOLSET",6,0) ; "RTN","PSOLSET",7,0) I '$D(DUZ) W !,$C(7),"DUZ Number must be defined !!",! G LEAVE "RTN","PSOLSET",8,0) W !,"Outpatient Pharmacy software - Version "_$P($T(VERS),";",3) "RTN","PSOLSET",9,0) I $D(^XTMP("PSO_V7 INSTALL",0)) W !!,"Outpatient Pharmacy software is being installed. PLEASE TRY LATER!",! G LEAVE "RTN","PSOLSET",10,0) S PSOBAR1="",PSOBARS=0 ;make sure we have one "RTN","PSOLSET",11,0) S PSOCNT=0 F I=0:0 S I=$O(^PS(59,I)) Q:'I S PSOCNT=PSOCNT+1,Y=I "RTN","PSOLSET",12,0) G DIV1:PSOCNT W !,$C(7) S DIR("A",1)="Site parameters must be specified for at least one site." "RTN","PSOLSET",13,0) S DIR("A",2)="This is usually done by the package Co-ordinator.",DIR("A")="Do you want to continue: ",DIR("B")="YES",DIR(0)="SA^Y:YES;N:NO",DIR("?")="Enter Y to edit site parameters or N to exit." D ^DIR "RTN","PSOLSET",14,0) G LEAVE:"Y"'[$E(X) "RTN","PSOLSET",15,0) W ! D ^PSOSITED G PSOLSET "RTN","PSOLSET",16,0) DIV1 G:PSOCNT=1 DIV3 S DIR(0)="Y",DIR("?")="Enter 'Y' to select Division or 'N' to EXIT" "RTN","PSOLSET",17,0) DIV2 I PSOCNT>1 W ! S DIC("A")="Division: ",DIC=59,DIC(0)="AEMQ" "RTN","PSOLSET",18,0) S:$G(PSOVEX)'=1 DIC("S")="I $S('$D(^PS(59,+Y,""I"")):1,'^(""I""):1,DT'>^(""I""):1,1:0)" "RTN","PSOLSET",19,0) D ^DIC K DIC G:$D(DUOUT)!($D(DTOUT)) LEAVE "RTN","PSOLSET",20,0) I +Y<0 W $C(7),! S DIR("A",1)="A 'DIVISION' must be selected!",DIR("A")="Do you want to try again",DIR("B")="YES" D ^DIR G:'Y LEAVE G DIV2 "RTN","PSOLSET",21,0) DIV3 K DIR S PSOSITE=+Y W:PSOCNT>1 !!?10,"You are logged on under the ",$P(^PS(59,PSOSITE,0),"^")," division.",! S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOPAR7=$G(^PS(59,PSOSITE,"IB")),PSOSYS=$G(^PS(59.7,1,40.1)) D CUTDATE^PSOFUNC "RTN","PSOLSET",22,0) S PSOPINST=$P($G(^PS(59,PSOSITE,"INI")),"^") "RTN","PSOLSET",23,0) S (SITE,DA)=$P(^XMB(1,1,"XUS"),"^",17),DIC="4",DIQ(0)="IE",DR=".01;99",DIQ="PSXUTIL" D EN^DIQ1 S S3=$G(PSXUTIL(4,SITE,99,"I")),S2=$G(PSXUTIL(4,SITE,.01,"E")) K DA,DIC,DIQ(0),DR "RTN","PSOLSET",24,0) S PSXSYS=+$O(^PSX(550,"C",""))_"^"_$G(S3)_"^"_$G(S2),PSOINST=S3 "RTN","PSOLSET",25,0) K S3,S2,S1,PSXUTIL "RTN","PSOLSET",26,0) I $G(PSXSYS) D "RTN","PSOLSET",27,0) .K:($P($G(^PSX(550,+PSXSYS,0)),"^",2)'="A") PSXSYS "RTN","PSOLSET",28,0) .S Y=$$VERSION^XPDUTL("PSO") I Y>6.0 S PSXVER=1 "RTN","PSOLSET",29,0) E K PSXSYS "RTN","PSOLSET",30,0) S PSODIV=$S(($P(PSOSYS,"^",2))&('$P(PSOSYS,"^",3)):0,1:1) "RTN","PSOLSET",31,0) I $D(DUZ),$D(^VA(200,+DUZ,0)) S PSOCLC=DUZ "RTN","PSOLSET",32,0) PLBL I $P(PSOPAR,"^",8) D "RTN","PSOLSET",33,0) .S %ZIS="MNQ",%ZIS("A")="Select PROFILE PRINTER: " S:$G(PSOCLBL)&($D(PSOPROP)) %ZIS("B")=PSOPROP "RTN","PSOLSET",34,0) .D ^%ZIS K %ZIS,IO("Q"),IOP Q:POP S PSOPROP=ION D ^%ZISC "RTN","PSOLSET",35,0) LBL S %ZIS="MNQ",%ZIS("A")="Select LABEL PRINTER: " S:$G(PSOCLBL)&($D(PSOLAP))!($G(SUSPT)) %ZIS("B")=$S($G(SUSPT):PSLION,1:PSOLAP) "RTN","PSOLSET",36,0) D ^%ZIS K %ZIS,IO("Q"),IOP S:POP PSOQUIT=1 G:POP EXIT S @$S($G(SUSPT):"PSLION",1:"PSOLAP")=ION,PSOPIOST=$G(IOST(0)) "RTN","PSOLSET",37,0) N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST "RTN","PSOLSET",38,0) S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&$P(PSOPAR,"^",19),PSOIOS=IOS D ^%ZISC "RTN","PSOLSET",39,0) LASK I $G(PSOPIOST),$D(^%ZIS(2,PSOPIOST,55,"B","LL")) G EXIT "RTN","PSOLSET",40,0) K DIR S DIR("A")="OK to assume label alignment is correct",DIR("B")="YES",DIR(0)="Y",DIR("?")="Enter Y if labels are aligned, N if they need to be aligned." D ^DIR S:$D(DIRUT) PSOQUIT=1 G:Y!($D(DIRUT)) EXIT "RTN","PSOLSET",41,0) P2 S IOP=$G(PSOLAP) D ^%ZIS K IOP I POP W $C(7),!?5,"Printer is busy.",! G LASK "RTN","PSOLSET",42,0) U IO(0) W !,"Align labels so that a perforation is at the top of the",!,"print head and the left side is at column zero." "RTN","PSOLSET",43,0) W ! K DIR,DIRUT,DUOUT,DTOUT S DIR(0)="E" D ^DIR K DIR,DTOUT,DUOUT I $D(DIRUT) D ^%ZISC G EXIT "RTN","PSOLSET",44,0) D ^PSOLBLT D ^%ZISC "RTN","PSOLSET",45,0) K DIRUT,DIR S DIR("A")="Is this correct",DIR("B")="YES",DIR(0)="Y",DIR("?")="Enter Y if labels are aligned correctly, N if they need to be aligned." D ^DIR S:$D(DIRUT) PSOQUIT=1 G:Y!($D(DIRUT)) EXIT "RTN","PSOLSET",46,0) G P2 "RTN","PSOLSET",47,0) LEAVE S XQUIT="" G FINAL "RTN","PSOLSET",48,0) Q W !?10,$C(7),"Default printer for labels must be entered." G LBL "RTN","PSOLSET",49,0) ; "RTN","PSOLSET",50,0) EXIT D ^%ZISC Q:$G(PSOCLBL) "RTN","PSOLSET",51,0) D:'$G(PSOBFLAG) GROUP K I,IOP,X,Y,%ZIS,DIC,J,DIR,X,Y,DTOUT,DIROUT,DIRUT,DUOUT Q "RTN","PSOLSET",52,0) ; "RTN","PSOLSET",53,0) FINAL ;exit action from main menu - kill and quit "RTN","PSOLSET",54,0) K SITE,PSOCP,PSNP,PSL,PRCA,PSLION,PSOPINST "RTN","PSOLSET",55,0) K GROUPCNT,DISGROUP,PSOCAP,PSOINST,PSOION,PSONULBL,PSOSITE7,PFIO,PSOIOS,X,Y,PSOSYS,PSODIV,PSOPAR,PSOPAR7,PSOLAP,PSOPROP,PSOCLC,PSOCNT "RTN","PSOLSET",56,0) K PSODTCUT,PSOSITE,PSOPRPAS,PSOBAR1,PSOBAR0,PSOBARS,SIG,DIR,DIRUT,DTOUT,DIROUT,DUOUT,I,%ZIS,DIC,J,PSOREL "RTN","PSOLSET",57,0) Q "RTN","PSOLSET",58,0) GROUP ;display group "RTN","PSOLSET",59,0) S GROUPCNT=0,AGROUP="" I $D(^PS(59.3,0)) F S AGROUP=$O(^PS(59.3,"B",AGROUP)) Q:AGROUP="" D "RTN","PSOLSET",60,0) .S GROUPCNT=GROUPCNT+1 I GROUPCNT=1 S AGROUP1=AGROUP "RTN","PSOLSET",61,0) S:GROUPCNT=1 GRPNME=AGROUP1,II="" G:GROUPCNT>1 GROUP1 "RTN","PSOLSET",62,0) Q:'$D(GRPNME) F S II=$O(^PS(59.3,"B",GRPNME,II)) Q:II="" S DISGROUP=II "RTN","PSOLSET",63,0) K AGROUP,AGROUP1,GRPNME,II "RTN","PSOLSET",64,0) Q "RTN","PSOLSET",65,0) GROUP1 W ! S DIC("A")="Bingo Board Display: ",DIC=59.3,DIC(0)="AEMQZ",DIR(0)="Y",DIR("?")="Enter 'Y' to select Bingo Board Display or 'N' to EXIT" "RTN","PSOLSET",66,0) S:$P($G(^PS(59,PSOSITE,1)),"^",20) DIC("B")=$P($G(^PS(59,PSOSITE,1)),"^",20) "RTN","PSOLSET",67,0) D ^DIC K DIC Q:$D(DTOUT)!($D(DUOUT)) "RTN","PSOLSET",68,0) I +Y<0 W $C(7) S DIR("A",1)="A 'BINGO BOARD DISPLAY' should be selected!",DIR("A")="Do you want to try again",DIR("B")="YES",DIR("?")="A display group must be defined in order to run Bingo Board." D ^DIR Q:"Y"'[$E(X) G GROUP "RTN","PSOLSET",69,0) S DISGROUP=+Y "RTN","PSOLSET",70,0) K DIR,DIC,AGROUP,AGROUP1,GRPNME,II "RTN","PSOLSET",71,0) Q "RTN","PSOREJP1") 0^4^B78046825 "RTN","PSOREJP1",1,0) PSOREJP1 ;BIRM/MFR - Third Party Reject Display Screen ;04/29/05 "RTN","PSOREJP1",2,0) ;;7.0;OUTPATIENT PHARMACY;**148,247,260,281,287,289,290,358,359**;DEC 1997;Build 27 "RTN","PSOREJP1",3,0) ;Reference to File 9002313.93 - BPS NCPDP REJECT CODES supported by IA 4720 "RTN","PSOREJP1",4,0) ;Reference to ^PS(59.7 supported by IA 694 "RTN","PSOREJP1",5,0) ;Reference to ^PSDRUG("AQ" supported by IA 3165 "RTN","PSOREJP1",6,0) ;Reference to File 9002313.25 supported by IA 5064 "RTN","PSOREJP1",7,0) ; "RTN","PSOREJP1",8,0) EN(RX,REJ,CHANGE) ; Entry point "RTN","PSOREJP1",9,0) ; "RTN","PSOREJP1",10,0) ; - DO NOT change the IF logic below as both of them might get executed (intentional) "RTN","PSOREJP1",11,0) N FILL,LASTLN,PSOTRIC,PSOCODE,PSOTCODE "RTN","PSOREJP1",12,0) S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5) "RTN","PSOREJP1",13,0) S PSOTRIC="",PSOTRIC=$$TRIC(RX,FILL,PSOTRIC),PSOCODE=$$GET1^DIQ(52.25,REJ_","_RX,.01) "RTN","PSOREJP1",14,0) S PSOTCODE=0 S:PSOCODE'=79&(PSOCODE'=88)&(PSOTRIC) PSOTCODE=1 "RTN","PSOREJP1",15,0) I $$CLOSED(RX,REJ) D EN^VALM("PSO REJECT DISPLAY - RESOLVED") "RTN","PSOREJP1",16,0) I '$$CLOSED(RX,REJ)&(PSOTRIC) D EN^VALM("PSO REJECT TRICARE") ;cnf, PSO*7*358, replace PSOTCODE with PSOTRIC "RTN","PSOREJP1",17,0) I '$$CLOSED(RX,REJ)&('PSOTCODE)&('PSOTRIC) D EN^VALM("PSO REJECT DISPLAY") ;cnf, PSO*7*358, add PSOTRIC check "RTN","PSOREJP1",18,0) D FULL^VALM1 "RTN","PSOREJP1",19,0) Q "RTN","PSOREJP1",20,0) ; "RTN","PSOREJP1",21,0) HDR ; - Builds the Header section "RTN","PSOREJP1",22,0) N LINE1,LINE2,X "RTN","PSOREJP1",23,0) S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1),VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1) "RTN","PSOREJP1",24,0) ;cnf, PSO*7*358, add REJ to parameter list for RXINFO^PSOREJP3 "RTN","PSOREJP1",25,0) S VALMHDR(3)=$$RXINFO^PSOREJP3(RX,FILL,1),VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ) "RTN","PSOREJP1",26,0) Q "RTN","PSOREJP1",27,0) ; "RTN","PSOREJP1",28,0) TRIC(RX,RFL,PSOTRIC) ; - Return 1 for TRICARE or 0 (zero) for not TRICARE "RTN","PSOREJP1",29,0) S PSOTRIC="",PSOTRIC=$S(RFL=0&($$GET1^DIQ(52,RX_",",85,"I")="T"):1,$$GET1^DIQ(52.1,RFL_","_RX_",",85,"I")="T":1,1:0) "RTN","PSOREJP1",30,0) Q PSOTRIC "RTN","PSOREJP1",31,0) ; "RTN","PSOREJP1",32,0) INIT ; Builds the Body section "RTN","PSOREJP1",33,0) N DATA,LINE "RTN","PSOREJP1",34,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOREJP1",35,0) S PSOTRIC="",PSOTRIC=$$TRIC(RX,RFL,PSOTRIC) "RTN","PSOREJP1",36,0) F I=1:1:$G(LASTLN) D RESTORE^VALM10(I) "RTN","PSOREJP1",37,0) K ^TMP("PSOREJP1",$J) S VALMCNT=0,LINE=0 "RTN","PSOREJP1",38,0) D GET^PSOREJU2(RX,FILL,.DATA,REJ,1) "RTN","PSOREJP1",39,0) D REJ ; Display the REJECT Information "RTN","PSOREJP1",40,0) D OTH ; Display the Other Rejects Information "RTN","PSOREJP1",41,0) D COM^PSOREJP3 ; Display the Comment "RTN","PSOREJP1",42,0) D INS ; Display the Insurance Information "RTN","PSOREJP1",43,0) D CLS ; Display the Resolution Information "RTN","PSOREJP1",44,0) S VALMCNT=LINE "RTN","PSOREJP1",45,0) Q "RTN","PSOREJP1",46,0) ; "RTN","PSOREJP1",47,0) REJ ; - DUR Information "RTN","PSOREJP1",48,0) N TYPE,PFLDT,TREJ,TDATA,PSOTRIC,PSOET S TDATA="" "RTN","PSOREJP1",49,0) S PSOTRIC="",PSOTRIC=$$TRIC(RX,FILL,PSOTRIC) "RTN","PSOREJP1",50,0) D SETLN("REJECT Information"_$S($G(PSOTRIC):" (TRICARE)",1:""),1,1) "RTN","PSOREJP1",51,0) S TYPE=$S($G(DATA(REJ,"CODE"))=79:"79 - REFILL TOO SOON",1:"") "RTN","PSOREJP1",52,0) I TYPE="" S TYPE=DATA(REJ,"CODE")_" - "_$E($$EXP(DATA(REJ,"CODE")),1,23)_"-" "RTN","PSOREJP1",53,0) D SETLN("Reject Type : "_TYPE_" received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME"))),,,18) "RTN","PSOREJP1",54,0) ;cnf, PSO*7*358, if TRICARE non-billable then reset Status line "RTN","PSOREJP1",55,0) S PSOET=$$PSOET^PSOREJP3(RX,FILL) "RTN","PSOREJP1",56,0) I PSOET D SETLN("Status : NO CLAIM SUBMITTED") "RTN","PSOREJP1",57,0) I 'PSOET D SETLN("Reject Status : "_$G(DATA(REJ,"STATUS"))_" - "_$$STATUS^PSOBPSUT(RX,FILL),,,18) "RTN","PSOREJP1",58,0) D SET("PAYER MESSAGE",63) "RTN","PSOREJP1",59,0) D SET("REASON",63) "RTN","PSOREJP1",60,0) S PFLDT=$$FMTE^XLFDT($G(DATA(REJ,"PLAN PREVIOUS FILL DATE"))) "RTN","PSOREJP1",61,0) D SET("DUR TEXT",63,$S(PFLDT="":1,1:0)) "RTN","PSOREJP1",62,0) I PFLDT'="" D SETLN("Last Fill Date : "_PFLDT_" (from payer)",,1,18) "RTN","PSOREJP1",63,0) Q "RTN","PSOREJP1",64,0) ; "RTN","PSOREJP1",65,0) OTH ; - Other Rejects Information "RTN","PSOREJP1",66,0) N LST,I,RJC,J,LAST "RTN","PSOREJP1",67,0) S LST=$G(DATA(REJ,"OTHER REJECTS")) I LST="" Q "RTN","PSOREJP1",68,0) D SETLN() "RTN","PSOREJP1",69,0) D SETLN("OTHER REJECTS",1,1) "RTN","PSOREJP1",70,0) F I=1:1:$L(LST,",") S RJC=$P(LST,",",I) D "RTN","PSOREJP1",71,0) . S LAST=1 F J=(I+1):1:$L(LST,",") I $P(LST,",",J)'="" S LAST=0 Q "RTN","PSOREJP1",72,0) . I RJC'="" D SETLN(RJC_" - "_$$EXP(RJC),,$S(LAST:1,1:0),6) "RTN","PSOREJP1",73,0) Q "RTN","PSOREJP1",74,0) ; "RTN","PSOREJP1",75,0) INS ; - Insurance Information "RTN","PSOREJP1",76,0) D SETLN() "RTN","PSOREJP1",77,0) D SETLN("INSURANCE Information",1,1) "RTN","PSOREJP1",78,0) N PSOINS,PSOINS1,I "RTN","PSOREJP1",79,0) S PSOINS=$G(DATA(REJ,"INSURANCE NAME")) "RTN","PSOREJP1",80,0) F I=1:1:(50-($L(PSOINS)+18)) S PSOINS=PSOINS_" " "RTN","PSOREJP1",81,0) S PSOINS1=$G(DATA(REJ,"COB")) "RTN","PSOREJP1",82,0) I PSOINS1="SECONDARY" S PSOINS=PSOINS_"Coord. Of Benefits: "_PSOINS1 "RTN","PSOREJP1",83,0) D SETLN("Insurance : "_PSOINS,,,18) "RTN","PSOREJP1",84,0) D SETLN("Contact : "_$G(DATA(REJ,"PLAN CONTACT")),,,18) "RTN","PSOREJP1",85,0) D SETLN("Group Name : "_$G(DATA(REJ,"GROUP NAME")),,,18) "RTN","PSOREJP1",86,0) D SETLN("Group Number : "_$G(DATA(REJ,"GROUP NUMBER")),,,18) "RTN","PSOREJP1",87,0) D SETLN("Cardholder ID : "_$G(DATA(REJ,"CARDHOLDER ID")),,1,18) "RTN","PSOREJP1",88,0) Q "RTN","PSOREJP1",89,0) ; "RTN","PSOREJP1",90,0) CLS ; - Resolution Information "RTN","PSOREJP1",91,0) N X "RTN","PSOREJP1",92,0) I '$$CLOSED(RX,REJ) Q "RTN","PSOREJP1",93,0) D SETLN() "RTN","PSOREJP1",94,0) D SETLN("RESOLUTION Information",1,1) "RTN","PSOREJP1",95,0) D SETLN("Resolved By : "_$G(DATA(REJ,"CLOSED BY")),,,18) "RTN","PSOREJP1",96,0) D SETLN("Date/Time : "_$G(DATA(REJ,"CLOSED DATE/TIME")),,,18) "RTN","PSOREJP1",97,0) I $G(DATA(REJ,"CLOSE COMMENTS"))'="" D SET("CLOSE COMMENTS",63) "RTN","PSOREJP1",98,0) I $G(DATA(REJ,"COD1"))'="" D SETLN("Reason for Svc : "_$$OVRX^PSOREJU1(1,$G(DATA(REJ,"COD1"))),,,18) "RTN","PSOREJP1",99,0) I $G(DATA(REJ,"COD2"))'="" D SETLN("Profes. Svc : "_$$OVRX^PSOREJU1(2,$G(DATA(REJ,"COD2"))),,,18) "RTN","PSOREJP1",100,0) I $G(DATA(REJ,"COD3"))'="" D SETLN("Result of Svc : "_$$OVRX^PSOREJU1(3,$G(DATA(REJ,"COD3"))),,,18) "RTN","PSOREJP1",101,0) I $G(DATA(REJ,"CLA CODE"))'="" D "RTN","PSOREJP1",102,0) . N CLAPNTR S CLAPNTR=$$GET1^DIQ(52.25,REJ_","_RX_",",24,"I") "RTN","PSOREJP1",103,0) . S X=DATA(REJ,"CLA CODE")_" - "_$$GET1^DIQ(9002313.25,CLAPNTR,".02") "RTN","PSOREJP1",104,0) . D SETLN("Clarific. Code : "_X,,,18) "RTN","PSOREJP1",105,0) I $G(DATA(REJ,"PRIOR AUTH TYPE"))'="" D "RTN","PSOREJP1",106,0) . S X=$$GET1^DIQ(52.25,REJ_","_RX,25,"I")_" - "_(DATA(REJ,"PRIOR AUTH TYPE")) "RTN","PSOREJP1",107,0) . D SETLN("Prior Auth.Type: "_X,,,18),SETLN("Prior Auth. # : "_DATA(REJ,"PRIOR AUTH NUMBER"),,,18) "RTN","PSOREJP1",108,0) D SETLN("Reason : "_$G(DATA(REJ,"CLOSE REASON")),,1,18) "RTN","PSOREJP1",109,0) Q "RTN","PSOREJP1",110,0) ; "RTN","PSOREJP1",111,0) ; "RTN","PSOREJP1",112,0) SET(FIELD,L,UND) ; Sets the lines for fields that require text wrapping "RTN","PSOREJP1",113,0) N TXT,T "RTN","PSOREJP1",114,0) S TXT=DATA(REJ,FIELD) I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q "RTN","PSOREJP1",115,0) F I=1:1 Q:TXT="" D "RTN","PSOREJP1",116,0) . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q "RTN","PSOREJP1",117,0) . S T="",$E(T,81-L)=$E(TXT,1,L) D SETLN(T,,$S($E(TXT,L+1,999)=""&$G(UND):1,1:0),80-L) S TXT=$E(TXT,L+1,999) "RTN","PSOREJP1",118,0) Q "RTN","PSOREJP1",119,0) ; "RTN","PSOREJP1",120,0) LABEL(FIELD) ; Sets the label for the field "RTN","PSOREJP1",121,0) I FIELD="REASON" Q "Reason Code : " "RTN","PSOREJP1",122,0) I FIELD="PAYER MESSAGE" Q "Payer Addl Msg : " "RTN","PSOREJP1",123,0) I FIELD="DUR TEXT" Q $S(+$$ISDUR^PSOREJP5(RX,REJ):"+DUR Text : ",1:"DUR Text : ") "RTN","PSOREJP1",124,0) I FIELD="CLOSE COMMENTS" Q "Comments : " "RTN","PSOREJP1",125,0) Q "" "RTN","PSOREJP1",126,0) ; "RTN","PSOREJP1",127,0) VIEW ; - Rx View hidden action "RTN","PSOREJP1",128,0) N VALMCNT,TITLE "RTN","PSOREJP1",129,0) I $G(PSOBACK) D Q "RTN","PSOREJP1",130,0) . S VALMSG="Not available through Backdoor!",VALMBCK="R" "RTN","PSOREJP1",131,0) S TITLE=VALM("TITLE") "RTN","PSOREJP1",132,0) ; "RTN","PSOREJP1",133,0) ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE "RTN","PSOREJP1",134,0) DO "RTN","PSOREJP1",135,0) . N PSOVDA,DA,PS "RTN","PSOREJP1",136,0) . S (PSOVDA,DA)=RX,PS="REJECT" "RTN","PSOREJP1",137,0) . N RX,REJ,FILL,LINE,TITLE D DP^PSORXVW "RTN","PSOREJP1",138,0) ; "RTN","PSOREJP1",139,0) S VALMBCK="R",VALM("TITLE")=TITLE "RTN","PSOREJP1",140,0) Q "RTN","PSOREJP1",141,0) ; "RTN","PSOREJP1",142,0) EDT ; - Rx Edit hidden action "RTN","PSOREJP1",143,0) N VALMCNT,TITLE "RTN","PSOREJP1",144,0) I $G(PSOBACK) D Q "RTN","PSOREJP1",145,0) . S VALMSG="Not available through Backdoor!",VALMBCK="R" "RTN","PSOREJP1",146,0) S TITLE=VALM("TITLE") "RTN","PSOREJP1",147,0) ; "RTN","PSOREJP1",148,0) ; - DO structure used to avoid losing variables RX,FILL,REJ,LINE,TITLE "RTN","PSOREJP1",149,0) DO "RTN","PSOREJP1",150,0) . N PSOSITE,ORN,PSOPAR,PSOLIST "RTN","PSOREJP1",151,0) . S PSOSITE=$$RXSITE^PSOBPSUT(RX,FILL),ORN=RX "RTN","PSOREJP1",152,0) . S PSOPAR=$G(^PS(59,PSOSITE,1)),PSOLIST(1)=ORN_"," "RTN","PSOREJP1",153,0) . N RX,REJ,FILL,LINE,TITLE D EPH^PSORXEDT "RTN","PSOREJP1",154,0) ; "RTN","PSOREJP1",155,0) K VALMBCK I $$CLOSED(RX,REJ),$D(PSOSTFLT),PSOSTFLT="U" S CHANGE=1 Q "RTN","PSOREJP1",156,0) S VALMBCK="R",VALM("TITLE")=TITLE "RTN","PSOREJP1",157,0) Q "RTN","PSOREJP1",158,0) ; "RTN","PSOREJP1",159,0) OVR ; - Override a REJECT action "RTN","PSOREJP1",160,0) N PSOET "RTN","PSOREJP1",161,0) I $$CLOSED(RX,REJ,1) Q "RTN","PSOREJP1",162,0) ;cnf, PSO*7*358 "RTN","PSOREJP1",163,0) S PSOET=$$PSOET^PSOREJP3(RX,FILL) "RTN","PSOREJP1",164,0) I PSOET S VALMSG="OVR not allowed for TRICARE Non-Billable claim.",VALMBCK="R" Q "RTN","PSOREJP1",165,0) N COD1,COD2,COD3 "RTN","PSOREJP1",166,0) D FULL^VALM1 W ! "RTN","PSOREJP1",167,0) S COD1=$$OVRCOD^PSOREJU1(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^" S VALMBCK="R" Q "RTN","PSOREJP1",168,0) S COD2=$$OVRCOD^PSOREJU1(2) I COD2="^" S VALMBCK="R" Q "RTN","PSOREJP1",169,0) S COD3=$$OVRCOD^PSOREJU1(3) I COD3="^" S VALMBCK="R" Q "RTN","PSOREJP1",170,0) D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3) "RTN","PSOREJP1",171,0) D SEND^PSOREJP3(COD1,COD2,COD3) "RTN","PSOREJP1",172,0) Q "RTN","PSOREJP1",173,0) ; "RTN","PSOREJP1",174,0) RES ; - Re-submit a claim action "RTN","PSOREJP1",175,0) N PSOET "RTN","PSOREJP1",176,0) I $$CLOSED(RX,REJ,1) Q "RTN","PSOREJP1",177,0) ;cnf, PSO*7*358 "RTN","PSOREJP1",178,0) S PSOET=$$PSOET^PSOREJP3(RX,FILL) "RTN","PSOREJP1",179,0) I PSOET S VALMSG="RES not allowed for TRICARE Non-Billable claim.",VALMBCK="R" Q "RTN","PSOREJP1",180,0) D FULL^VALM1 W ! "RTN","PSOREJP1",181,0) D SEND^PSOREJP3() "RTN","PSOREJP1",182,0) Q "RTN","PSOREJP1",183,0) ; "RTN","PSOREJP1",184,0) CLA ; - Submit Clarification Code "RTN","PSOREJP1",185,0) N CLA,PSOET "RTN","PSOREJP1",186,0) I $$CLOSED(RX,REJ,1) Q "RTN","PSOREJP1",187,0) ;cnf, PSO*7*358 "RTN","PSOREJP1",188,0) S PSOET=$$PSOET^PSOREJP3(RX,FILL) "RTN","PSOREJP1",189,0) I PSOET S VALMSG="CLA not allowed for TRICARE Non-Billable claim.",VALMBCK="R" Q "RTN","PSOREJP1",190,0) D FULL^VALM1 W ! "RTN","PSOREJP1",191,0) S CLA=$$CLA^PSOREJU1() I CLA="^" S VALMBCK="R" Q "RTN","PSOREJP1",192,0) W ! D SEND^PSOREJP3(,,,CLA) "RTN","PSOREJP1",193,0) Q "RTN","PSOREJP1",194,0) ; "RTN","PSOREJP1",195,0) PA ; - Submit Prior Authorization "RTN","PSOREJP1",196,0) N PA,PSOET "RTN","PSOREJP1",197,0) I $$CLOSED(RX,REJ,1) Q "RTN","PSOREJP1",198,0) ;cnf, PSO*7*358 "RTN","PSOREJP1",199,0) S PSOET=$$PSOET^PSOREJP3(RX,FILL) "RTN","PSOREJP1",200,0) I PSOET S VALMSG="PA not allowed for TRICARE Non-Billable claim.",VALMBCK="R" Q "RTN","PSOREJP1",201,0) D FULL^VALM1 W ! "RTN","PSOREJP1",202,0) S PA=$$PA^PSOREJU2() I PA="^" S VALMBCK="R" Q "RTN","PSOREJP1",203,0) W ! D SEND^PSOREJP3(,,,,PA) "RTN","PSOREJP1",204,0) Q "RTN","PSOREJP1",205,0) ; "RTN","PSOREJP1",206,0) MP ; - Patient Medication Profile "RTN","PSOREJP1",207,0) I $G(PSOBACK) D Q "RTN","PSOREJP1",208,0) . S VALMSG="Not available through Backdoor!",VALMBCK="R" "RTN","PSOREJP1",209,0) N SITE,PATIENT "RTN","PSOREJP1",210,0) D FULL^VALM1 W ! "RTN","PSOREJP1",211,0) S SITE=+$$RXSITE^PSOBPSUT(RX,FILL) S:$G(PSOSITE) SITE=PSOSITE "RTN","PSOREJP1",212,0) S PATIENT=+$$GET1^DIQ(52,RX,2,"I") "RTN","PSOREJP1",213,0) D LST^PSOPMP0(SITE,PATIENT) S VALMBCK="R" "RTN","PSOREJP1",214,0) Q "RTN","PSOREJP1",215,0) ; "RTN","PSOREJP1",216,0) EXIT ; "RTN","PSOREJP1",217,0) K ^TMP("PSOREJP1",$J) "RTN","PSOREJP1",218,0) Q "RTN","PSOREJP1",219,0) ; "RTN","PSOREJP1",220,0) SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section "RTN","PSOREJP1",221,0) N X "RTN","PSOREJP1",222,0) S:$G(TEXT)="" $E(TEXT,80)="" "RTN","PSOREJP1",223,0) S:$L(TEXT)>80 TEXT=$E(TEXT,1,80) "RTN","PSOREJP1",224,0) S LINE=LINE+1,^TMP("PSOREJP1",$J,LINE,0)=$G(TEXT) "RTN","PSOREJP1",225,0) ; "RTN","PSOREJP1",226,0) I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE "RTN","PSOREJP1",227,0) ; "RTN","PSOREJP1",228,0) I $G(REV) D Q "RTN","PSOREJP1",229,0) . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM) "RTN","PSOREJP1",230,0) . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM) "RTN","PSOREJP1",231,0) I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM) "RTN","PSOREJP1",232,0) I $G(HIG) D "RTN","PSOREJP1",233,0) . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM) "RTN","PSOREJP1",234,0) Q "RTN","PSOREJP1",235,0) HELP ; "RTN","PSOREJP1",236,0) Q "RTN","PSOREJP1",237,0) ; "RTN","PSOREJP1",238,0) CLOSED(RX,REJ,MSG) ; Returns whether the REJECT is RESOLVED or NOT "RTN","PSOREJP1",239,0) I $$GET1^DIQ(52.25,REJ_","_RX,10,"I") D:$G(MSG) Q 1 "RTN","PSOREJP1",240,0) . S VALMSG="This Reject is marked resolved!",VALMBCK="R" W $C(7) "RTN","PSOREJP1",241,0) Q 0 "RTN","PSOREJP1",242,0) ; "RTN","PSOREJP1",243,0) REOPN(RX,REJ) ; Returns whether the REJECT was RE-OPENED or NOT "RTN","PSOREJP1",244,0) Q $S($$GET1^DIQ(52.25,REJ_","_RX,23)="":0,1:1) "RTN","PSOREJP1",245,0) ; "RTN","PSOREJP1",246,0) EXP(CODE) ; - Returns the explanation field (.02) for a reject code "RTN","PSOREJP1",247,0) ; Input: (r) CODE - .01 field (Code) value from file 9002313.93 "RTN","PSOREJP1",248,0) ; Output: .02 field (Explanation) value from file 9002313.93 "RTN","PSOREJP1",249,0) N DIC,X,Y "RTN","PSOREJP1",250,0) S DIC=9002313.93,DIC(0)="Z",X=CODE D ^DIC "RTN","PSOREJP1",251,0) Q $P($G(Y(0)),"^",2) "RTN","PSOREJP1",252,0) ; "RTN","PSOREJP1",253,0) OUT(RX) ; - Supported call by outside PROTOCOLs to act on specific REJECTs "RTN","PSOREJP1",254,0) N I,RFL,DATA,REJ,PSOBACK,VALMCNT,RXN "RTN","PSOREJP1",255,0) I '$D(^XUSEC("PSORPH",DUZ)) D Q "RTN","PSOREJP1",256,0) . S VALMSG="PSORPH key required to use the REJ action.",VALMBCK="R" "RTN","PSOREJP1",257,0) I $G(PS)="REJECT" D "RTN","PSOREJP1",258,0) . S VALMSG="REJ action is not available at this point.",VALMBCK="R" "RTN","PSOREJP1",259,0) S PSOBACK=1 "RTN","PSOREJP1",260,0) S (RFL,I)=0 F I=1:1 Q:'$D(^PSRX(RX,1,I)) S RFL=I "RTN","PSOREJP1",261,0) S X=$$FIND^PSOREJUT(RX,RFL,.DATA) S REJ=$O(DATA("")) "RTN","PSOREJP1",262,0) I '$G(REJ) S VALMSG="Invalid selection!",VALMBCK="R" Q "RTN","PSOREJP1",263,0) D EN(RX,REJ) S VALMBCK="R" "RTN","PSOREJP1",264,0) Q "RTN","PSOREJP1",265,0) ; "RTN","PSOREJP3") 0^8^B107041706 "RTN","PSOREJP3",1,0) PSOREJP3 ;ALB/SS - Third Party Reject Display Screen - Comments ;10/27/06 "RTN","PSOREJP3",2,0) ;;7.0;OUTPATIENT PHARMACY;**260,287,289,290,358,359**;DEC 1997;Build 27 "RTN","PSOREJP3",3,0) ; "RTN","PSOREJP3",4,0) COM ; Builds the Comments section in the Reject Display Screen "RTN","PSOREJP3",5,0) I +$O(^PSRX(RX,"REJ",REJ,"COM",0))=0 Q "RTN","PSOREJP3",6,0) D SETLN^PSOREJP1() "RTN","PSOREJP3",7,0) D SETLN^PSOREJP1("COMMENTS",1,1) "RTN","PSOREJP3",8,0) N DIWL,DIWR,LNCNT,MAXLN,PSL "RTN","PSOREJP3",9,0) N I,X,PSI,Y,LAST,PSOCOM,TXTLN "RTN","PSOREJP3",10,0) S PSI=999999 "RTN","PSOREJP3",11,0) F S PSI=$O(^PSRX(RX,"REJ",REJ,"COM",PSI),-1) Q:+PSI=0 D "RTN","PSOREJP3",12,0) . S PSCOM=$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,.01)_" - " "RTN","PSOREJP3",13,0) . S PSCOM=PSCOM_$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,2) "RTN","PSOREJP3",14,0) . S PSCOM=PSCOM_" ("_$$GET1^DIQ(52.2551,PSI_","_REJ_","_RX,1)_")" "RTN","PSOREJP3",15,0) . ;display comment "RTN","PSOREJP3",16,0) . K ^UTILITY($J,"W") S X=PSCOM,DIWL=1,DIWR=78 D ^DIWP "RTN","PSOREJP3",17,0) . F PSL=1:1 Q:('$D(^UTILITY($J,"W",1,PSL,0))) D "RTN","PSOREJP3",18,0) . . S LAST=0 I '$D(^UTILITY($J,"W",1,PSL+1)),'$O(^PSRX(RX,"REJ",REJ,"COM",PSI),-1) S LAST=1 "RTN","PSOREJP3",19,0) . . S TXTLN=$G(^UTILITY($J,"W",1,PSL,0)) "RTN","PSOREJP3",20,0) . . D SETLN^PSOREJP1($S(PSL=1:"- ",1:" ")_TXTLN,0,$S(LAST:1,1:0),1) "RTN","PSOREJP3",21,0) K ^UTILITY($J,"W") "RTN","PSOREJP3",22,0) Q "RTN","PSOREJP3",23,0) ; "RTN","PSOREJP3",24,0) ADDCOM ; - Add comment worklist action "RTN","PSOREJP3",25,0) N PSCOM "RTN","PSOREJP3",26,0) D FULL^VALM1 "RTN","PSOREJP3",27,0) S PSCOM=$$COMMENT("Comment: ",150) "RTN","PSOREJP3",28,0) I $L(PSCOM)>0,PSCOM'["^" D "RTN","PSOREJP3",29,0) . D SAVECOM(RX,REJ,PSCOM) ;save the comment "RTN","PSOREJP3",30,0) . D INIT^PSOREJP1 ;update screen "RTN","PSOREJP3",31,0) S VALMBCK="R" "RTN","PSOREJP3",32,0) Q "RTN","PSOREJP3",33,0) ; "RTN","PSOREJP3",34,0) ;Enter a comment "RTN","PSOREJP3",35,0) ;PSOTR -prompt string "RTN","PSOREJP3",36,0) ;PSMLEN -maxlen "RTN","PSOREJP3",37,0) ;returns: "RTN","PSOREJP3",38,0) ; "^" - if user chose to quit "RTN","PSOREJP3",39,0) ; "" - nothing entered or input has been discarded "RTN","PSOREJP3",40,0) ; otherwise - comment's text "RTN","PSOREJP3",41,0) COMMENT(PSOTR,PSMLEN) ;*/ "RTN","PSOREJP3",42,0) N DIR,DTOUT,DUOUT,PSQ "RTN","PSOREJP3",43,0) I '$D(PSOTR) S PSOTR="Comment " "RTN","PSOREJP3",44,0) I '$D(PSMLEN) S PSMLEN=150 "RTN","PSOREJP3",45,0) S DIR(0)="FA^1:150" "RTN","PSOREJP3",46,0) S DIR("A")=PSOTR "RTN","PSOREJP3",47,0) S DIR("?")="Enter a free text comment up to 150 characters long." "RTN","PSOREJP3",48,0) S PSQ=0 "RTN","PSOREJP3",49,0) F D Q:+PSQ'=0 "RTN","PSOREJP3",50,0) . W ! D ^DIR "RTN","PSOREJP3",51,0) . I $D(DUOUT)!($D(DTOUT)) S PSQ=-1 Q "RTN","PSOREJP3",52,0) . I $L(Y)'>PSMLEN S PSQ=1 Q "RTN","PSOREJP3",53,0) . W !!,"Enter a free text comment up to 150 characters long.",! "RTN","PSOREJP3",54,0) . S DIR("B")=$E(Y,1,PSMLEN) "RTN","PSOREJP3",55,0) Q:PSQ<0 "^" "RTN","PSOREJP3",56,0) Q:$L(Y)=0 "" "RTN","PSOREJP3",57,0) S PSQ=$$YESNO("Confirm","YES") "RTN","PSOREJP3",58,0) I PSQ=-1 Q "^" "RTN","PSOREJP3",59,0) I PSQ=0 Q "" "RTN","PSOREJP3",60,0) Q Y "RTN","PSOREJP3",61,0) ; "RTN","PSOREJP3",62,0) ; Ask "RTN","PSOREJP3",63,0) ; Input: "RTN","PSOREJP3",64,0) ; PSQSTR - question "RTN","PSOREJP3",65,0) ; PSDFL - default answer "RTN","PSOREJP3",66,0) ; Output: "RTN","PSOREJP3",67,0) ; 1 YES "RTN","PSOREJP3",68,0) ; 0 NO "RTN","PSOREJP3",69,0) ; -1 if cancelled "RTN","PSOREJP3",70,0) YESNO(PSQSTR,PSDFL) ; Default - YES "RTN","PSOREJP3",71,0) N DIR,Y,DUOUT "RTN","PSOREJP3",72,0) S DIR(0)="Y" "RTN","PSOREJP3",73,0) S DIR("A")=PSQSTR "RTN","PSOREJP3",74,0) S:$L($G(PSDFL)) DIR("B")=PSDFL "RTN","PSOREJP3",75,0) W ! D ^DIR "RTN","PSOREJP3",76,0) Q $S($G(DUOUT)!$G(DUOUT)!(Y="^"):-1,1:Y) "RTN","PSOREJP3",77,0) ; "RTN","PSOREJP3",78,0) ;Save comment "RTN","PSOREJP3",79,0) SAVECOM(PSRXIEN,PSREJIEN,PSCOMNT,DATETIME,USER) ; "RTN","PSOREJP3",80,0) N PSREC,PSDA,PSERR "RTN","PSOREJP3",81,0) I '$G(DATETIME) D NOW^%DTC S DATETIME=% "RTN","PSOREJP3",82,0) I '$G(USER) S USER=DUZ "RTN","PSOREJP3",83,0) D INSITEM(52.2551,PSRXIEN,PSREJIEN,DATETIME) "RTN","PSOREJP3",84,0) S PSREC=$O(^PSRX(PSRXIEN,"REJ",PSREJIEN,"COM","B",DATETIME,0)) "RTN","PSOREJP3",85,0) I PSREC>0 D "RTN","PSOREJP3",86,0) . S PSDA(52.2551,PSREC_","_PSREJIEN_","_PSRXIEN_",",1)=USER "RTN","PSOREJP3",87,0) . S PSDA(52.2551,PSREC_","_PSREJIEN_","_PSRXIEN_",",2)=$G(PSCOMNT) "RTN","PSOREJP3",88,0) . D FILE^DIE("","PSDA","PSERR") "RTN","PSOREJP3",89,0) Q "RTN","PSOREJP3",90,0) ; "RTN","PSOREJP3",91,0) ;/** "RTN","PSOREJP3",92,0) ;PSSFILE - subfile# (52.2551) for comment "RTN","PSOREJP3",93,0) ;PSIEN - ien for file in which the new subfile entry will be inserted "RTN","PSOREJP3",94,0) ;PSVAL01 - .01 value for the new entry "RTN","PSOREJP3",95,0) INSITEM(PSSFILE,PSIEN0,PSIEN1,PSVAL01) ;*/ "RTN","PSOREJP3",96,0) N PSSSI,PSIENS,PSFDA,PSER "RTN","PSOREJP3",97,0) S PSIENS="+1,"_PSIEN1_","_PSIEN0_"," "RTN","PSOREJP3",98,0) S PSFDA(PSSFILE,PSIENS,.01)=PSVAL01 "RTN","PSOREJP3",99,0) D UPDATE^DIE("","PSFDA","PSSSI","PSER") "RTN","PSOREJP3",100,0) I $D(PSER) D BMES^XPDUTL(PSER("DIERR",1,"TEXT",1)) "RTN","PSOREJP3",101,0) Q "RTN","PSOREJP3",102,0) ; "RTN","PSOREJP3",103,0) PRINT(RX,RFL) ; Print Label for specific Rx/Fill "RTN","PSOREJP3",104,0) I '$G(RX) Q "RTN","PSOREJP3",105,0) I $G(RFL)="" Q "RTN","PSOREJP3",106,0) ; "RTN","PSOREJP3",107,0) ; Some of these variables are used by LBL^PSOLSET but they are newed here "RTN","PSOREJP3",108,0) N PPL,PSOSITE,PSOPAR,PSOSYS,PSOBARS,PSOBAR0,PSOBAR1,PSOIOS,PSOBFLAG,PSOCLBL "RTN","PSOREJP3",109,0) N PSOQUIT,PSOPIOST,PSOLTEST,PSOTLBL,PSORXT "RTN","PSOREJP3",110,0) N DFN,PDUZ,RXFL,REPRINT,REJLBL,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT "RTN","PSOREJP3",111,0) N %ZIS,IOP,POP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTDTH,VAR "RTN","PSOREJP3",112,0) ; "RTN","PSOREJP3",113,0) ; Set the default label printer. We need to new it so we don't change the value that was "RTN","PSOREJP3",114,0) ; set by PSOLSET when the user first logged into OP so need to do a bit of work to new it and "RTN","PSOREJP3",115,0) ; reset it before the call to LBL^PSOLSET. "RTN","PSOREJP3",116,0) I $G(PSOLAP)]"" S PSOTLBL=PSOLAP N PSOLAP S PSOLAP=PSOTLBL,PSOCLBL=1 "RTN","PSOREJP3",117,0) E N PSOLAP S PSOCLBL="" "RTN","PSOREJP3",118,0) ; "RTN","PSOREJP3",119,0) ; Check if a label has already been printed and set REPRINT flag. "RTN","PSOREJP3",120,0) S REJLBL=0 F S REJLBL=$O(^PSRX(RX,"L",REJLBL)) Q:'REJLBL I +$$GET1^DIQ(52.032,REJLBL_","_RX,1,"I")=RFL S REPRINT=1 Q "RTN","PSOREJP3",121,0) ; "RTN","PSOREJP3",122,0) ; Define required variables "RTN","PSOREJP3",123,0) S PSOSITE=+$$RXSITE^PSOBPSUT(RX,RFL),PSOPAR=$G(^PS(59,PSOSITE,1)) "RTN","PSOREJP3",124,0) S DFN=$$GET1^DIQ(52,RX,2,"I"),PDUZ=DUZ,PSOSYS=$G(^PS(59.7,1,40.1)) "RTN","PSOREJP3",125,0) S PPL=RX I RFL S RXFL(RX)=RFL "RTN","PSOREJP3",126,0) ; "RTN","PSOREJP3",127,0) ; Get label print device and check alignment "RTN","PSOREJP3",128,0) W ! S PSOBFLAG=1 D LBL^PSOLSET I $G(PSOQUIT) Q "RTN","PSOREJP3",129,0) I $G(PSOLAP)="" W $C(7),!!,"No printer defined" K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR Q "RTN","PSOREJP3",130,0) ; "RTN","PSOREJP3",131,0) ; Call %ZIS to get device characteristics w/o reopening the printer. "RTN","PSOREJP3",132,0) ; We need to do this to check if queuing is forced for this device "RTN","PSOREJP3",133,0) ; Not checking the POP variable. If we don't get the device here, we will fall through to the "RTN","PSOREJP3",134,0) ; foreground process and try again "RTN","PSOREJP3",135,0) S IOP=PSOLAP,%ZIS="QN" D ^%ZIS "RTN","PSOREJP3",136,0) ; "RTN","PSOREJP3",137,0) ; If background printer, queue the job "RTN","PSOREJP3",138,0) I $D(IO("Q")) D Q "RTN","PSOREJP3",139,0) . S ZTRTN="DQ^PSOLBL",ZTDTH=$H,ZTIO=PSOLAP "RTN","PSOREJP3",140,0) . F VAR="PSOSYS","DFN","PSOPAR","PDUZ","PCOMX","PSOLAP","PPL","PSOSITE","RXY","PSOSUSPR","PSOBARS","PSOBAR1","PSOBAR0","PSODELE","PSOPULL","PSTAT","PSODBQ","PSOEXREP","PSOTREP","REPRINT" S:$D(@VAR) ZTSAVE(VAR)="" "RTN","PSOREJP3",141,0) . S ZTSAVE("PSORX(")="",ZTSAVE("RXRP(")="",ZTSAVE("RXPR(")="",ZTSAVE("RXRS(")="",ZTSAVE("RXFL(")="",ZTSAVE("PCOMH(")="" "RTN","PSOREJP3",142,0) . S ZTDESC="OUTPATIENT PHARMACY REJECT WORKLIST LABEL PRINT" "RTN","PSOREJP3",143,0) . D ^%ZISC,^%ZTLOAD "RTN","PSOREJP3",144,0) . W !!,"Label ",$S('$D(ZTSK):"NOT ",1:""),"queued to print",! I '$D(ZTSK) W $C(7) K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR "RTN","PSOREJP3",145,0) ; "RTN","PSOREJP3",146,0) ; If we gotten this far, open the device and print the label in the foreground "RTN","PSOREJP3",147,0) ; We also need to preserve the PSORX array, which gets killed by DQ^PSOLBL "RTN","PSOREJP3",148,0) K %ZIS S IOP=PSOLAP D ^%ZIS "RTN","PSOREJP3",149,0) I POP D ^%ZISC W $C(7),!!,"Printer is busy - NO label printed" K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR Q "RTN","PSOREJP3",150,0) K PSORXT M PSORXT=PSORX "RTN","PSOREJP3",151,0) D DQ^PSOLBL,^%ZISC "RTN","PSOREJP3",152,0) K PSORX M PSORX=PSORXT "RTN","PSOREJP3",153,0) Q "RTN","PSOREJP3",154,0) ; "RTN","PSOREJP3",155,0) RXINFO(RX,FILL,LINE,REJ) ; Returns header displayable Rx Information "RTN","PSOREJP3",156,0) N TXT,RXINFO,LBL,CMOP,DRG,PSOET "RTN","PSOREJP3",157,0) I LINE=1 D "RTN","PSOREJP3",158,0) . S RXINFO="Rx# : "_$$GET1^DIQ(52,RX,.01)_"/"_FILL "RTN","PSOREJP3",159,0) . ;cnf, PSO*7*358, add PSOET logic for Tricare non-billable "RTN","PSOREJP3",160,0) . S PSOET=$$PSOET(RX,FILL) "RTN","PSOREJP3",161,0) . S $E(RXINFO,27)="ECME#: "_$S(PSOET:"",1:$$ECMENUM^PSOBPSU2(RX,FILL)) "RTN","PSOREJP3",162,0) . S $E(RXINFO,49)="Date of Service: "_$S(PSOET:"",1:$$FMTE^XLFDT($$DOS^PSOBPSU1(RX,FILL))) "RTN","PSOREJP3",163,0) I LINE=2 D "RTN","PSOREJP3",164,0) . S DRG=$$GET1^DIQ(52,RX,6,"I"),CMOP=$S($D(^PSDRUG("AQ",DRG)):1,1:0) "RTN","PSOREJP3",165,0) . S RXINFO=$S(CMOP:"CMOP ",1:"")_"Drug",$E(RXINFO,10)=": "_$E($$GET1^DIQ(52,RX,6),1,43) "RTN","PSOREJP3",166,0) . S $E(RXINFO,56)="NDC Code: "_$$GETNDC^PSONDCUT(RX,FILL) "RTN","PSOREJP3",167,0) Q $G(RXINFO) "RTN","PSOREJP3",168,0) ; "RTN","PSOREJP3",169,0) SEND(COD1,COD2,COD3,CLA,PA) ; - Sends Claim to ECME and closes Reject "RTN","PSOREJP3",170,0) N DIR,OVRC,RESP,ALTXT,COM "RTN","PSOREJP3",171,0) S DIR(0)="Y",DIR("A")=" Confirm",DIR("B")="YES" "RTN","PSOREJP3",172,0) S DIR("A",1)=" When you confirm, a new claim will be submitted for" "RTN","PSOREJP3",173,0) S DIR("A",2)=" the prescription and this REJECT will be marked" "RTN","PSOREJP3",174,0) S DIR("A",3)=" resolved." "RTN","PSOREJP3",175,0) S DIR("A",4)=" " "RTN","PSOREJP3",176,0) W ! D ^DIR I $G(Y)=0!$D(DIRUT) S VALMBCK="R" Q "RTN","PSOREJP3",177,0) I $G(COD1)'="" S OVRC=$G(COD2)_"^"_$G(COD1)_"^"_$G(COD3) "RTN","PSOREJP3",178,0) S ALTXT="REJECT WORKLIST" "RTN","PSOREJP3",179,0) S:$G(OVRC)'="" ALTXT=ALTXT_"-DUR OVERRIDE CODES("_$G(COD1)_"/"_$G(COD2)_"/"_$G(COD3)_")" "RTN","PSOREJP3",180,0) S:$G(CLA) ALTXT=ALTXT_"(CLARIF. CODE="_CLA_")" "RTN","PSOREJP3",181,0) S:$G(PA) ALTXT=ALTXT_"(PRIOR AUTH.="_$TR(PA,"^","/")_")" "RTN","PSOREJP3",182,0) D ECMESND^PSOBPSU1(RX,FILL,,"ED",$$GETNDC^PSONDCUT(RX,FILL),,,$G(OVRC),,.RESP,,ALTXT,$G(CLA),$G(PA),$$PSOCOB^PSOREJP3(RX,FILL,REJ)) "RTN","PSOREJP3",183,0) I $G(RESP) D Q "RTN","PSOREJP3",184,0) . W !!?10,"Claim could not be submitted. Please try again later!" "RTN","PSOREJP3",185,0) . W !,?10,"Reason: ",$S($P(RESP,"^",2)="":"UNKNOWN",1:$P(RESP,"^",2)),$C(7) H 2 "RTN","PSOREJP3",186,0) ; "RTN","PSOREJP3",187,0) I $$PTLBL^PSOREJP2(RX,FILL) D PRINT(RX,FILL) "RTN","PSOREJP3",188,0) ; "RTN","PSOREJP3",189,0) N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC) "RTN","PSOREJP3",190,0) I $$GET1^DIQ(52,RX,100,"I")=5&(PSOTRIC) D "RTN","PSOREJP3",191,0) . Q:$$STATUS^PSOBPSUT(RX,FILL)'["PAYABLE" "RTN","PSOREJP3",192,0) . N XXX S XXX="" "RTN","PSOREJP3",193,0) . W !,"This prescription can be pulled early from suspense or the label will print" "RTN","PSOREJP3",194,0) . W !,"when PRINT FROM SUSPENSE occurs.",! "RTN","PSOREJP3",195,0) . R !,"Press enter to continue... ",XXX:60 "RTN","PSOREJP3",196,0) ; "RTN","PSOREJP3",197,0) I $D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1 "RTN","PSOREJP3",198,0) Q "RTN","PSOREJP3",199,0) ; "RTN","PSOREJP3",200,0) FILL ;Fill payable TRICARE Rx "RTN","PSOREJP3",201,0) N COM,OPNREJ,OPNREJ2,OPNREJ3,DCSTAT,PSOREL "RTN","PSOREJP3",202,0) S:'$G(PSOTRIC) PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC) ;cnf, PSO*7*358, add line "RTN","PSOREJP3",203,0) ;cnf, PSO*7*358, don't allow option if Tricare and released, PSOREL is set to the release date "RTN","PSOREJP3",204,0) S PSOREL=0 I PSOTRIC D "RTN","PSOREJP3",205,0) . I 'FILL S PSOREL=+$$GET1^DIQ(52,RX,31,"I") "RTN","PSOREJP3",206,0) . I FILL S PSOREL=+$$GET1^DIQ(52.1,FILL_","_RX,17,"I") "RTN","PSOREJP3",207,0) I PSOREL S VALMSG="Released Rxs may not be filled.",VALMBCK="R" Q "RTN","PSOREJP3",208,0) ;cnf, PSO*7*358, don't allow option if prescription has been discontinued "RTN","PSOREJP3",209,0) ; 12 - DISCONTINUED "RTN","PSOREJP3",210,0) ; 14 - DISCONTINUED BY PROVIDER "RTN","PSOREJP3",211,0) ; 15 - DISCONTINUED (EDIT) "RTN","PSOREJP3",212,0) S DCSTAT=$$GET1^DIQ(52,RX,100,"I") "RTN","PSOREJP3",213,0) I "/12/14/15/"[("/"_DCSTAT_"/") S VALMSG="Discontinued Rxs may not be filled.",VALMBCK="R" Q "RTN","PSOREJP3",214,0) D FULL^VALM1 "RTN","PSOREJP3",215,0) I $$CLOSED^PSOREJP1(RX,REJ) D Q "RTN","PSOREJP3",216,0) . S VALMSG="This Reject is marked resolved!",VALMBCK="R" "RTN","PSOREJP3",217,0) ;cnf, PSO*7*358 "RTN","PSOREJP3",218,0) S COM="" "RTN","PSOREJP3",219,0) I 'PSOTRIC&($$STATUS^PSOBPSUT(RX,FILL)'["PAYABLE") S VALMSG="Only Rxs with an E PAYABLE status may be filled.",VALMBCK="R" Q "RTN","PSOREJP3",220,0) I PSOTRIC&($$STATUS^PSOBPSUT(RX,FILL)'["PAYABLE") D FILLTR I $L($G(VALMSG)_$G(VALMBCK)) Q ;cnf, PSO*7*358 "RTN","PSOREJP3",221,0) S:COM="" COM="AUTOMATICALLY CLOSED" ;cnf, PSO*7*358, add condition "RTN","PSOREJP3",222,0) S (OPNREJ,OPNREJ2,OPNREJ3)="" "RTN","PSOREJP3",223,0) S OPNREJ2=0 F S OPNREJ2=$O(^PSRX(RX,"REJ",OPNREJ2)) Q:OPNREJ2=""!(OPNREJ2'?1N.N) S OPNREJ=OPNREJ_","_OPNREJ2 "RTN","PSOREJP3",224,0) S OPNREJ=$E(OPNREJ,2,999),OPNREJ2="" "RTN","PSOREJP3",225,0) W !?20,"[Closing all rejections for prescription "_$$GET1^DIQ(52,RX,".01")_":" "RTN","PSOREJP3",226,0) F I=1:1 S OPNREJ2=$P(OPNREJ,",",I) Q:OPNREJ2="" D "RTN","PSOREJP3",227,0) . S OPNREJ3="",OPNREJ3=$$GET1^DIQ(52.25,OPNREJ2_","_RX,".01") "RTN","PSOREJP3",228,0) . W !?25,OPNREJ3_" - "_$$GET1^DIQ(9002313.93,OPNREJ3,".02")_"..." "RTN","PSOREJP3",229,0) . D CLOSE^PSOREJUT(RX,FILL,OPNREJ2,DUZ,6,COM) W "OK]",!,$C(7) H 1 "RTN","PSOREJP3",230,0) I $$PTLBL^PSOREJP2(RX,FILL) D PRINT(RX,FILL) "RTN","PSOREJP3",231,0) S CHANGE=1 ;cnf, PSO*7*358, remove S VALMBCK="R" so user goes back to selection list "RTN","PSOREJP3",232,0) Q "RTN","PSOREJP3",233,0) ; "RTN","PSOREJP3",234,0) PSOCOB(RX,FILL,REJ) ; Returns RXCOB indicator for Worklist "RTN","PSOREJP3",235,0) N DATA1 "RTN","PSOREJP3",236,0) D GET^PSOREJU2(RX,FILL,.DATA1,REJ,1) "RTN","PSOREJP3",237,0) I $G(DATA1(REJ,"COB"))="PRIMARY" Q 1 "RTN","PSOREJP3",238,0) I $G(DATA1(REJ,"COB"))="" Q 1 "RTN","PSOREJP3",239,0) Q 2 "RTN","PSOREJP3",240,0) ; "RTN","PSOREJP3",241,0) DC ;Discontinue TRICARE Rx "RTN","PSOREJP3",242,0) N ACTION S ACTION="D" "RTN","PSOREJP3",243,0) D FULL^VALM1 "RTN","PSOREJP3",244,0) S ACTION=$$DC^PSOREJU1(RX,ACTION) "RTN","PSOREJP3",245,0) I ACTION="Q"!(ACTION="^") S VALMSG="NO ACTION TAKEN.",VALMBCK="R" Q "RTN","PSOREJP3",246,0) S CHANGE=1 "RTN","PSOREJP3",247,0) Q "RTN","PSOREJP3",248,0) ; "RTN","PSOREJP3",249,0) FILLTR ;TRICARE specific logic ;cnf, PSO*7*358 "RTN","PSOREJP3",250,0) ;COM is not new'd so the variable can be used in FILL tag "RTN","PSOREJP3",251,0) N CONT,PSOET,PSQSTR "RTN","PSOREJP3",252,0) ; "RTN","PSOREJP3",253,0) FILLTR2 ;Use for looping if user enters ^ in required comment field ;cnf, PSO*7*358 "RTN","PSOREJP3",254,0) ; "RTN","PSOREJP3",255,0) ;if tricare, not payable, and no security key, quit "RTN","PSOREJP3",256,0) ;reference to ^XUSEC( supported by IA 10076 "RTN","PSOREJP3",257,0) I '$D(^XUSEC("PSO TRICARE",DUZ)) S VALMSG="Action Requires security key",VALMBCK="R" Q "RTN","PSOREJP3",258,0) ; "RTN","PSOREJP3",259,0) ;if tricare, not payable, and user has security key, prompt to continue or not "RTN","PSOREJP3",260,0) S PSQSTR="You are bypassing claims processing. Do you wish to continue" "RTN","PSOREJP3",261,0) S CONT=$$YESNO(PSQSTR,"No") "RTN","PSOREJP3",262,0) I (CONT=-1)!('CONT) S VALMSG="NO ACTION TAKEN.",VALMBCK="R" Q "RTN","PSOREJP3",263,0) ; "RTN","PSOREJP3",264,0) ;check for valid electronic signature "RTN","PSOREJP3",265,0) I '$$SIG^PSOREJU1() S VALMBCK="R" Q ;quit if no valid electronic signature "RTN","PSOREJP3",266,0) ; "RTN","PSOREJP3",267,0) ;prompt user for required TRICARE Justification "RTN","PSOREJP3",268,0) S COM=$$TCOM() G:COM="^" FILLTR2 ;loop back to "continue?" question if ^ entry "RTN","PSOREJP3",269,0) ; "RTN","PSOREJP3",270,0) ;audit log "RTN","PSOREJP3",271,0) S PSOET=$$PSOET(RX,FILL) "RTN","PSOREJP3",272,0) D AUDIT^PSOTRI(RX,FILL,,COM,$S(PSOET:"N",1:"R")) "RTN","PSOREJP3",273,0) Q "RTN","PSOREJP3",274,0) ; "RTN","PSOREJP3",275,0) TCOM() ; - Ask for TRICARE Justification ;cnf, PSO*7*358 "RTN","PSOREJP3",276,0) N COM,DIR,DIRUT,X "RTN","PSOREJP3",277,0) W ! S DIR(0)="F^3:100" S DIR("A")="TRICARE Justification" D ^DIR "RTN","PSOREJP3",278,0) S COM=X I $D(DIRUT) S COM="^" "RTN","PSOREJP3",279,0) Q COM "RTN","PSOREJP3",280,0) ; "RTN","PSOREJP3",281,0) PSOET(RX,FILL) ; Returns flag for TRICARE non-billable and no claim submitted - cnf 8/9/2010 PSO*7*358 "RTN","PSOREJP3",282,0) ; Return 1 if rejection code is eT (pseudo-reject code) "RTN","PSOREJP3",283,0) ; 0 otherwise "RTN","PSOREJP3",284,0) ; "RTN","PSOREJP3",285,0) I '$G(RX) Q 0 "RTN","PSOREJP3",286,0) N X,TRIREJCD "RTN","PSOREJP3",287,0) S X=0 "RTN","PSOREJP3",288,0) S TRIREJCD=$T(TRIREJCD+1),TRIREJCD=$P(TRIREJCD,";;",2) "RTN","PSOREJP3",289,0) S X=$$FIND^PSOREJUT(RX,$G(FILL),,TRIREJCD) "RTN","PSOREJP3",290,0) Q X "RTN","PSOREJP3",291,0) ; "RTN","PSOREJP3",292,0) TRIREJCD ;TRICARE Reject Code, non-billable Rx ;cnf, PSO*7*358 "RTN","PSOREJP3",293,0) ;;eT;;referenced in ^PSOREJP3, ^PSOREJ "RTN","PSOREJP3",294,0) Q "RTN","PSOREJP5") 0^13^B31405315 "RTN","PSOREJP5",1,0) PSOREJP5 ;ALB/BNT - Third Party Reject Additional Reject Information Screen ;02/14/11 "RTN","PSOREJP5",2,0) ;;7.0;OUTPATIENT PHARMACY;**359**;DEC 1997;Build 27 "RTN","PSOREJP5",3,0) ; "RTN","PSOREJP5",4,0) ; Reference to BPSNCPD3 supported by IA 4560 "RTN","PSOREJP5",5,0) ; "RTN","PSOREJP5",6,0) EN ; -- main entry point for PSO REJECT DISPLAY ADDTNL INFO "RTN","PSOREJP5",7,0) D EN^VALM("PSO REJECT DISPLAY ADDTNL INFO") "RTN","PSOREJP5",8,0) Q "RTN","PSOREJP5",9,0) ; "RTN","PSOREJP5",10,0) ADDTXT ; Entry point for DUR Hidden action "RTN","PSOREJP5",11,0) I '$D(@(VALMAR)) Q "RTN","PSOREJP5",12,0) N FILL,LASTLN "RTN","PSOREJP5",13,0) S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5) "RTN","PSOREJP5",14,0) D FULL^VALM1 "RTN","PSOREJP5",15,0) D EN "RTN","PSOREJP5",16,0) Q "RTN","PSOREJP5",17,0) ; "RTN","PSOREJP5",18,0) ISDUR(RX,REJ) ; "RTN","PSOREJP5",19,0) ; Returns 1 if there is DUR PPS RESPONSE data for the reject "RTN","PSOREJP5",20,0) I '$G(RX) Q 0 "RTN","PSOREJP5",21,0) I '$G(REJ) Q 0 "RTN","PSOREJP5",22,0) N RXCOB,DURPPS,DURIEN "RTN","PSOREJP5",23,0) S DURIEN=$$RESPIEN(RX,REJ) "RTN","PSOREJP5",24,0) Q:DURIEN="" 0 "RTN","PSOREJP5",25,0) S RXCOB=$$RXCOB(RX,REJ) "RTN","PSOREJP5",26,0) I RXCOB="" S RXCOB=1 "RTN","PSOREJP5",27,0) D DURRESP^BPSNCPD3(DURIEN,.DURPPS,RXCOB) "RTN","PSOREJP5",28,0) I $G(DURPPS(RXCOB,"DUR PPS RESPONSE"))!($G(DURPPS(RXCOB,"MESSAGE"))]"")!($G(DURPPS(RXCOB,"PAYER MESSAGE",1))]"") Q 1 "RTN","PSOREJP5",29,0) Q 0 "RTN","PSOREJP5",30,0) ; "RTN","PSOREJP5",31,0) HDR ; -- header code "RTN","PSOREJP5",32,0) N LINE1,LINE2,X "RTN","PSOREJP5",33,0) S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1),VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1) "RTN","PSOREJP5",34,0) ;cnf, PSO*7*358, add REJ to parameter list for RXINFO^PSOREJP3 "RTN","PSOREJP5",35,0) S VALMHDR(3)=$$RXINFO^PSOREJP3(RX,FILL,1),VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ) "RTN","PSOREJP5",36,0) Q "RTN","PSOREJP5",37,0) ; "RTN","PSOREJP5",38,0) INIT ; -- init variables and list array "RTN","PSOREJP5",39,0) N DATA,LINE,RXCOB,ADDREJ,NDX,I,DURIEN,X "RTN","PSOREJP5",40,0) F I=1:1:$G(LASTLN) D RESTORE^VALM10(I) "RTN","PSOREJP5",41,0) K ^TMP("PSOREJP2",$J) S VALMCNT=0,LINE=0 "RTN","PSOREJP5",42,0) S DURIEN=$$RESPIEN(RX,REJ) "RTN","PSOREJP5",43,0) Q:DURIEN="" "RTN","PSOREJP5",44,0) S RXCOB=$$RXCOB(RX,REJ) "RTN","PSOREJP5",45,0) D DURRESP^BPSNCPD3(DURIEN,.ADDREJ,RXCOB) "RTN","PSOREJP5",46,0) I '+$G(ADDREJ(RXCOB,"DUR PPS RESPONSE")),$G(ADDREJ(RXCOB,"MESSAGE"))']"",$G(ADDREJ(RXCOB,"PAYER MESSAGE",1))="" D Q "RTN","PSOREJP5",47,0) . D SETLN() "RTN","PSOREJP5",48,0) . D SETLN("There is no additional reject information to display") "RTN","PSOREJP5",49,0) ; "RTN","PSOREJP5",50,0) D SETLN() "RTN","PSOREJP5",51,0) D SET("MESSAGE",80-$L($$LABEL("MESSAGE")),"",ADDREJ(RXCOB,"MESSAGE")) "RTN","PSOREJP5",52,0) ; "RTN","PSOREJP5",53,0) D SETLN() "RTN","PSOREJP5",54,0) D SET("PAYER ADDL MSG",80-$L($$LABEL("PAYER ADDL MSG")),"",$G(ADDREJ(RXCOB,"PAYER MESSAGE",1))) "RTN","PSOREJP5",55,0) S X="",$E(X,$L($$LABEL("PAYER ADDL MSG")))=" " "RTN","PSOREJP5",56,0) S I=1 F S I=$O(ADDREJ(RXCOB,"PAYER MESSAGE",I)) Q:'I D "RTN","PSOREJP5",57,0) . D SET("",80-$L($$LABEL("PAYER ADDL MSG")),"",X_ADDREJ(RXCOB,"PAYER MESSAGE",I)) "RTN","PSOREJP5",58,0) ; "RTN","PSOREJP5",59,0) S NDX="" "RTN","PSOREJP5",60,0) F S NDX=$O(ADDREJ(RXCOB,"DUR PPS",NDX)) Q:NDX="" D "RTN","PSOREJP5",61,0) . D SETLN() "RTN","PSOREJP5",62,0) . D SET("DUR PPS RESPONSE",80-$L($$LABEL("DUR PPS RESPONSE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR PPS RESPONSE")) "RTN","PSOREJP5",63,0) . D SET("REASON FOR SERVICE CODE",80-$L($$LABEL("REASON FOR SERVICE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"REASON FOR SERVICE CODE")) "RTN","PSOREJP5",64,0) . D SET("CLINICAL SIGNIFICANCE CODE",80-$L($$LABEL("CLINICAL SIGNIFICANCE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"CLINICAL SIGNIFICANCE CODE")) "RTN","PSOREJP5",65,0) . D SET("OTHER PHARMACY INDICATOR",80-$L($$LABEL("OTHER PHARMACY INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PHARMACY INDICATOR")) "RTN","PSOREJP5",66,0) . D SET("PREVIOUS DATE OF FILL",80-$L($$LABEL("PREVIOUS DATE OF FILL")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"PREVIOUS DATE OF FILL")) "RTN","PSOREJP5",67,0) . D SET("QUANTITY OF PREVIOUS FILL",80-$L($$LABEL("QUANTITY OF PREVIOUS FILL")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL")) "RTN","PSOREJP5",68,0) . D SET("DATABASE INDICATOR",80-$L($$LABEL("DATABASE INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DATABASE INDICATOR")) "RTN","PSOREJP5",69,0) . D SET("OTHER PRESCRIBER INDICATOR",80-$L($$LABEL("OTHER PRESCRIBER INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PRESCRIBER INDICATOR")) "RTN","PSOREJP5",70,0) . D SET("DUR FREE TEXT MESSAGE",80-$L($$LABEL("DUR FREE TEXT MESSAGE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR FREE TEXT MESSAGE")) "RTN","PSOREJP5",71,0) . D SET("DUR ADDITIONAL TEXT",80-$L($$LABEL("DUR ADDITIONAL TEXT")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR ADDITIONAL TEXT")) "RTN","PSOREJP5",72,0) S VALMCNT=LINE "RTN","PSOREJP5",73,0) Q "RTN","PSOREJP5",74,0) ; "RTN","PSOREJP5",75,0) LABEL(FIELD) ; Sets the label for the field "RTN","PSOREJP5",76,0) I FIELD="MESSAGE" Q "Payer Msg: " "RTN","PSOREJP5",77,0) I FIELD="PAYER ADDL MSG" Q "Payer Addl Msg: " "RTN","PSOREJP5",78,0) I FIELD="DUR PPS RESPONSE" Q "DUR Response: " "RTN","PSOREJP5",79,0) I FIELD="REASON FOR SERVICE CODE" Q "Reason Code: " "RTN","PSOREJP5",80,0) I FIELD="CLINICAL SIGNIFICANCE CODE" Q "Clinical Significance Code: " "RTN","PSOREJP5",81,0) I FIELD="OTHER PHARMACY INDICATOR" Q "Other Pharmacy Indicator: " "RTN","PSOREJP5",82,0) I FIELD="PREVIOUS DATE OF FILL" Q "Previous Date of Fill: " "RTN","PSOREJP5",83,0) I FIELD="QUANTITY OF PREVIOUS FILL" Q "Quantity of Previous Fill: " "RTN","PSOREJP5",84,0) I FIELD="DATABASE INDICATOR" Q "Database Indicator: " "RTN","PSOREJP5",85,0) I FIELD="OTHER PRESCRIBER INDICATOR" Q "Other Prescriber Indicator: " "RTN","PSOREJP5",86,0) I FIELD="DUR FREE TEXT MESSAGE" Q "DUR Text: " "RTN","PSOREJP5",87,0) I FIELD="DUR ADDITIONAL TEXT" Q "DUR Add Text: " "RTN","PSOREJP5",88,0) Q "" "RTN","PSOREJP5",89,0) ; "RTN","PSOREJP5",90,0) SET(FIELD,L,UND,TXT) ; Sets the lines for fields that require text wrapping "RTN","PSOREJP5",91,0) N T "RTN","PSOREJP5",92,0) I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q "RTN","PSOREJP5",93,0) F I=1:1 Q:TXT="" D "RTN","PSOREJP5",94,0) . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q "RTN","PSOREJP5",95,0) . S T="",$E(T,81-L)=$E(TXT,1,L) D SETLN(T,,$S($E(TXT,L+1,999)=""&$G(UND):1,1:0),80-L) S TXT=$E(TXT,L+1,999) "RTN","PSOREJP5",96,0) Q "RTN","PSOREJP5",97,0) ; "RTN","PSOREJP5",98,0) SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section "RTN","PSOREJP5",99,0) N X "RTN","PSOREJP5",100,0) S:$G(TEXT)="" $E(TEXT,80)="" "RTN","PSOREJP5",101,0) S:$L(TEXT)>80 TEXT=$E(TEXT,1,80) "RTN","PSOREJP5",102,0) S LINE=LINE+1,^TMP("PSOREJP2",$J,LINE,0)=$G(TEXT) "RTN","PSOREJP5",103,0) ; "RTN","PSOREJP5",104,0) I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE "RTN","PSOREJP5",105,0) ; "RTN","PSOREJP5",106,0) I $G(REV) D Q "RTN","PSOREJP5",107,0) . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM) "RTN","PSOREJP5",108,0) . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM) "RTN","PSOREJP5",109,0) I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM) "RTN","PSOREJP5",110,0) I $G(HIG) D "RTN","PSOREJP5",111,0) . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM) "RTN","PSOREJP5",112,0) Q "RTN","PSOREJP5",113,0) ; "RTN","PSOREJP5",114,0) RXCOB(RX,REJ) ; Return the COB Indicator for the reject "RTN","PSOREJP5",115,0) ; Input: RX = RX IEN "RTN","PSOREJP5",116,0) ; REJ = Reject Info multiple IEN "RTN","PSOREJP5",117,0) I '$G(RX) Q "" "RTN","PSOREJP5",118,0) I '$G(REJ) Q "" "RTN","PSOREJP5",119,0) N RXCOB "RTN","PSOREJP5",120,0) S RXCOB=$$GET1^DIQ(52.25,REJ_","_RX_",","27","I") "RTN","PSOREJP5",121,0) Q $S(+RXCOB>1:RXCOB,1:1) "RTN","PSOREJP5",122,0) ; "RTN","PSOREJP5",123,0) RESPIEN(RX,REJ) ; Return the RESPONSE ID from the Reject Info multiple "RTN","PSOREJP5",124,0) ; Input: RX = RX IEN "RTN","PSOREJP5",125,0) ; REJ = Reject Info multiple IEN "RTN","PSOREJP5",126,0) I '$G(RX) Q "" "RTN","PSOREJP5",127,0) I '$G(REJ) Q "" "RTN","PSOREJP5",128,0) Q $$GET1^DIQ(52.25,REJ_","_RX_",","16","I") "RTN","PSOREJP5",129,0) ; "RTN","PSOREJP5",130,0) HELP ; -- help code "RTN","PSOREJP5",131,0) S X="?" D DISP^XQORM1 W !! "RTN","PSOREJP5",132,0) Q "RTN","PSOREJP5",133,0) ; "RTN","PSOREJP5",134,0) EXIT ; -- exit code "RTN","PSOREJP5",135,0) Q "RTN","PSOREJP5",136,0) ; "RTN","PSOREJP5",137,0) EXPND ; -- expand code "RTN","PSOREJP5",138,0) Q "RTN","PSOREJP5",139,0) ; "RTN","PSOREJU1") 0^11^B77096006 "RTN","PSOREJU1",1,0) PSOREJU1 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04 "RTN","PSOREJU1",2,0) ;;7.0;OUTPATIENT PHARMACY;**148,247,260,287,289,358,359**;DEC 1997;Build 27 "RTN","PSOREJU1",3,0) ;Reference to File 9002313.21 - BPS NCPDP PROFESSIONAL SERVICE CODE supported by IA 4712 "RTN","PSOREJU1",4,0) ;Reference to File 9002313.22 - BPS NCPDP RESULT OF SERVICE CODE supported by IA 4713 "RTN","PSOREJU1",5,0) ;Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE supported by IA 4714 "RTN","PSOREJU1",6,0) ;Reference to File 9002313.25 - BPS NCPDP SUBMISSION CLARIFICATION CODE supported by IA 5064 "RTN","PSOREJU1",7,0) ;Reference to File 200 - NEW PERSON supported by IA 10060 "RTN","PSOREJU1",8,0) ;Reference to SIG^XUSESIG supported by IA 10050 "RTN","PSOREJU1",9,0) ; "RTN","PSOREJU1",10,0) ACTION(RX,REJ,OPTS,DEF) ; "RTN","PSOREJU1",11,0) ; Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU1",12,0) ; (r) REJ - REJECT ID (IEN) "RTN","PSOREJU1",13,0) ; (r) OPTS - Available options ("QIO" for QUIT/IGNORE/OVERRIDE) "RTN","PSOREJU1",14,0) ; (o) DEF - Default Option ("O", "I" or "Q") "RTN","PSOREJU1",15,0) ; Output: ACTION: "I^Comments" - Ignore Reject "RTN","PSOREJU1",16,0) ; "O^COD1^COD2^COD3" - Override with the Override codes COD1(Prof.),COD2(Reason) and COD3(Result) "RTN","PSOREJU1",17,0) ; "Q" - Quit "RTN","PSOREJU1",18,0) ; "^" - Up-arrow entered or timed out "RTN","PSOREJU1",19,0) ; "RTN","PSOREJU1",20,0) N ACTION,COM,OVR,X,DIR,DIRUT,Y "RTN","PSOREJU1",21,0) ; "RTN","PSOREJU1",22,0) I '$G(RX)!'$G(REJ) Q "RTN","PSOREJU1",23,0) I '$G(PSONBILL) Q:'$D(^PSRX(RX,"REJ",REJ)) "RTN","PSOREJU1",24,0) ; "RTN","PSOREJU1",25,0) ; - Display DUR/79 REJECT information "RTN","PSOREJU1",26,0) D DISPLAY^PSOREJU3(RX,REJ) "RTN","PSOREJU1",27,0) ; "RTN","PSOREJU1",28,0) ASK K ACTION,DIR,DIRUT "RTN","PSOREJU1",29,0) S DIR(0)="SO^",DIR("A")="" "RTN","PSOREJU1",30,0) S:(OPTS["O") DIR(0)=DIR(0)_"O:(O)VERRIDE - RESUBMIT WITH OVERRIDE CODES;",DIR("A")=DIR("A")_"(O)verride," "RTN","PSOREJU1",31,0) S:(OPTS["I") DIR(0)=DIR(0)_"I:(I)GNORE - FILL Rx WITHOUT CLAIM SUBMISSION;",DIR("A")=DIR("A")_"(I)gnore," "RTN","PSOREJU1",32,0) S:(OPTS["D") DIR(0)=DIR(0)_"D:(D)iscontinue - DO NOT FILL PRESCRIPTION;",DIR("A")=DIR("A")_"(D)iscontinue," "RTN","PSOREJU1",33,0) S:(OPTS["Q") DIR(0)=DIR(0)_"Q:(Q)UIT - SEND TO WORKLIST (REQUIRES INTERVENTION);",DIR("A")=DIR("A")_"(Q)uit," "RTN","PSOREJU1",34,0) S $E(DIR(0),$L(DIR(0)))="",$E(DIR("A"),$L(DIR("A")))="",DIR("??")="^D HELP^PSOREJU2("""_OPTS_""")" "RTN","PSOREJU1",35,0) S:$G(DEF)'="" DIR("B")=DEF D ^DIR I $D(DIRUT) W ! Q "Q" "RTN","PSOREJU1",36,0) ; "RTN","PSOREJU1",37,0) ; - STOP/QUIT Action "RTN","PSOREJU1",38,0) S ACTION=Y I ACTION="Q" Q ACTION "RTN","PSOREJU1",39,0) ; "RTN","PSOREJU1",40,0) ; - IGNORE Action "RTN","PSOREJU1",41,0) K DIR,DIRUT,X "RTN","PSOREJU1",42,0) ; "RTN","PSOREJU1",43,0) ;PSO*7.0*358, add logic for TRICARE ignore "RTN","PSOREJU1",44,0) I PSOTRIC,ACTION="I",'$$CONT W $C(7),!," ACTION NOT TAKEN!",! H 1 G ASK "RTN","PSOREJU1",45,0) ; "RTN","PSOREJU1",46,0) I ACTION="I" S:'PSOTRIC COM=$$COM() S:PSOTRIC COM=$$TCOM^PSOREJP3() G ASK:COM="^" G ASK:'$$SIG() S ACTION=ACTION_"^"_COM "RTN","PSOREJU1",47,0) ; "RTN","PSOREJU1",48,0) ; - OVERRIDE Action "RTN","PSOREJU1",49,0) I ACTION="O" D G ASK:OVR="^" "RTN","PSOREJU1",50,0) . S OVR=$$OVR() S ACTION=ACTION_"^"_OVR "RTN","PSOREJU1",51,0) ; "RTN","PSOREJU1",52,0) DC1 ;Discontinue "RTN","PSOREJU1",53,0) I ACTION="D" S ACTION=$$DC(RX,ACTION) I $D(DIRUT) S ACTION="D" D DISPLAY^PSOREJU3(RX,REJ) G ASK "RTN","PSOREJU1",54,0) ; "RTN","PSOREJU1",55,0) Q ACTION "RTN","PSOREJU1",56,0) ; "RTN","PSOREJU1",57,0) DC(RX,ACTION) ; - Discontinue inside and outside call "RTN","PSOREJU1",58,0) N RXN,MSG,REA,DA,PSCAN,RXNUM "RTN","PSOREJU1",59,0) S DA=RX,RXNUM="" "RTN","PSOREJU1",60,0) D NOOR^PSOCAN4 I $D(DIRUT) W $C(7)," ACTION NOT TAKEN!",! H 1 S PSORX("DFLG")=1,ACTION="Q" Q ACTION "RTN","PSOREJU1",61,0) D REQ^PSOCAN4 I $D(DIRUT) W $C(7)," ACTION NOT TAKEN!",! H 1 S PSORX("DFLG")=1,ACTION="Q" Q ACTION "RTN","PSOREJU1",62,0) S REA="C",RXNUM=$P(^PSRX(DA,0),"^") "RTN","PSOREJU1",63,0) S MSG="Discontinued "_$S($G(PSOFDR):" from Reject Processing Screen",1:"") "RTN","PSOREJU1",64,0) S PSCAN(RXNUM)=DA_"^C" "RTN","PSOREJU1",65,0) D CAN^PSOCAN "RTN","PSOREJU1",66,0) N PSOCKDC S PSOCKDC=1,PSOQFLAG=1,PSOLST(1)=52_"^"_DA_"^"_$$GET1^DIQ(52,RXNUM,100),ORN=1 "RTN","PSOREJU1",67,0) D ECME^PSORXL1 I '$G(PPL) S PPL="" ;remove rx from label print "RTN","PSOREJU1",68,0) Q ACTION "RTN","PSOREJU1",69,0) ; "RTN","PSOREJU1",70,0) CONT() ;- Ask to continue for bypassing claims processing ;PSO*7.0*358 "RTN","PSOREJU1",71,0) N DIR,DIRUT,Y "RTN","PSOREJU1",72,0) S DIR(0)="Y",DIR("A")="You are bypassing claims processing. Do you wish to continue",DIR("B")="NO" "RTN","PSOREJU1",73,0) D ^DIR I $D(DIRUT) S Y=0 "RTN","PSOREJU1",74,0) Q $G(Y) "RTN","PSOREJU1",75,0) ; "RTN","PSOREJU1",76,0) SIG() ; - Get electronic signature "RTN","PSOREJU1",77,0) N CODE,X,X1,Y "RTN","PSOREJU1",78,0) S CODE=$P($G(^VA(200,DUZ,20)),U,4),Y=0 I '$L(CODE) D Q Y "RTN","PSOREJU1",79,0) . W $C(7),!,"You do not have an electronic signature code." "RTN","PSOREJU1",80,0) . W !,"Please contact your IRM office." H 2 "RTN","PSOREJU1",81,0) D SIG^XUSESIG S Y=(X1'="") "RTN","PSOREJU1",82,0) Q Y "RTN","PSOREJU1",83,0) ; "RTN","PSOREJU1",84,0) COM() ; - Ask for CLOSE comments "RTN","PSOREJU1",85,0) K COM,DIR,DIRUT,X "RTN","PSOREJU1",86,0) W ! S DIR(0)="F^3:100" S DIR("A")="Comments" D ^DIR "RTN","PSOREJU1",87,0) S COM=X I $D(DIRUT) S COM="^" "RTN","PSOREJU1",88,0) Q COM "RTN","PSOREJU1",89,0) ; "RTN","PSOREJU1",90,0) OVR() ; - Ask for OVERRIDE codes "RTN","PSOREJU1",91,0) N COD1,COD2,COD3,DIR,DIRUT W ! "RTN","PSOREJU1",92,0) S COD1=$$OVRCOD(1,$$GET1^DIQ(52.25,REJ_","_RX,14)) I COD1="^" Q "^" "RTN","PSOREJU1",93,0) S COD2=$$OVRCOD(2) I COD2="^" Q "^" "RTN","PSOREJU1",94,0) S COD3=$$OVRCOD(3) I COD3="^" Q "^" "RTN","PSOREJU1",95,0) ; "RTN","PSOREJU1",96,0) D OVRDSP^PSOREJU1(COD1_"^"_COD2_"^"_COD3) W ! "RTN","PSOREJU1",97,0) ; "RTN","PSOREJU1",98,0) S DIR(0)="Y",DIR("A")=" Confirm? ",DIR("B")="YES" "RTN","PSOREJU1",99,0) D ^DIR I $G(Y)=0!$D(DIRUT) Q "^" "RTN","PSOREJU1",100,0) ; "RTN","PSOREJU1",101,0) Q (COD2_"^"_COD1_"^"_COD3) "RTN","PSOREJU1",102,0) ; "RTN","PSOREJU1",103,0) OVRDSP(LST) ; - Display the Override Codes "RTN","PSOREJU1",104,0) N I W ! "RTN","PSOREJU1",105,0) F I=1:1:3 D "RTN","PSOREJU1",106,0) . W !?5,$S(I=1:"Reason for Service Code : ",I=2:"Professional Service Code: ",1:"Result of Service Code : ") "RTN","PSOREJU1",107,0) . W $E($$OVRX(I,$P(LST,"^",I)),1,48) "RTN","PSOREJU1",108,0) Q "RTN","PSOREJU1",109,0) ; "RTN","PSOREJU1",110,0) CLA() ; - Ask for up to 3 Clarification Codes "RTN","PSOREJU1",111,0) N DIC,X,Y,PSOSCC,DTOUT,DUOUT,PSOQ,PSOI,I "RTN","PSOREJU1",112,0) S DIC(0)="QEAM",DIC=9002313.25,PSOQ=0,PSOSCC="" "RTN","PSOREJU1",113,0) F PSOI=1:1:3 Q:PSOQ S DIC("A")="Submission Clarification Code "_PSOI_": " D CLADIC "RTN","PSOREJU1",114,0) Q $S(PSOSCC="":"^",1:PSOSCC) "RTN","PSOREJU1",115,0) ; "RTN","PSOREJU1",116,0) CLADIC D ^DIC I ($D(DUOUT))!($D(DTOUT))!(Y=-1) S PSOQ=1 Q "RTN","PSOREJU1",117,0) F I=1:1:PSOI I $P(PSOSCC,"~",I)=$P(Y,U,2) W " Duplicates not allowed",! G CLADIC "RTN","PSOREJU1",118,0) S $P(PSOSCC,"~",PSOI)=$P(Y,U,2) "RTN","PSOREJU1",119,0) Q "RTN","PSOREJU1",120,0) ; "RTN","PSOREJU1",121,0) HDLG(RX,RFL,CODES,FROM,OPTS,DEF) ; - REJECT Handling "RTN","PSOREJU1",122,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU1",123,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOREJU1",124,0) ; (r) CODES - List of REJECT CODES to be handled separated by commas (default is "79,88") "RTN","PSOREJU1",125,0) ; (r) FROM - Same values as BWHERE param. in the EN^BPSNCPDP api "RTN","PSOREJU1",126,0) ; (r) OPTS - Available options ("IOQ" for IGNORE/OVERRIDE/QUIT) "RTN","PSOREJU1",127,0) ; (o) DEF - Default Option ("O", "I" or "Q") "RTN","PSOREJU1",128,0) ;Output: ACTION - "O"-Override, "I"-Ignore,"Q"-Quit,"^"-Up-arrow entered "RTN","PSOREJU1",129,0) ; "RTN","PSOREJU1",130,0) N REJDATA,NEWDATA,CODE,ACTION,REJ,RESP,REJCDI,PSOTRIC,DCODE S CODE="" "RTN","PSOREJU1",131,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOREJU1",132,0) S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC) "RTN","PSOREJU1",133,0) I PSOTRIC D ;note that Tricare Rejects need all codes, not just 79/88's "RTN","PSOREJU1",134,0) . S OPTS="DQ",DEF="Q",(DCODE,CODES)="" "RTN","PSOREJU1",135,0) . I $D(^XUSEC("PSO TRICARE",DUZ)) S OPTS=OPTS_"I" ;PSO*7.0*358, if user has security key, include IGNORE in TRICARE options "RTN","PSOREJU1",136,0) . F S DCODE=$O(^PSRX(RX,"REJ","B",DCODE)) Q:DCODE="" S CODES=CODES_","_DCODE "RTN","PSOREJU1",137,0) . S CODES=$E(CODES,2,9999) "RTN","PSOREJU1",138,0) . I CODES["88"!(CODES["79") S OPTS="ODQ" S:$D(^XUSEC("PSO TRICARE",DUZ)) OPTS=OPTS_"I" ;PSO*7.0*358, if user has security key, include IGNORE in TRICARE options "RTN","PSOREJU1",139,0) ; - In progress Rx not allowed to be filled "RTN","PSOREJU1",140,0) I PSOTRIC,$$STATUS^PSOBPSUT(RX,RFL)["IN PROGRESS" S ACTION="",(DEF,OPTS)="D" D TRICCHK^PSOREJU3(RX,RFL,"",FROM) D Q ACTION "RTN","PSOREJU1",141,0) . I $P(ACTION,"^")="D" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,7,,$P(ACTION,"^",2)) "RTN","PSOREJU1",142,0) ; "RTN","PSOREJU1",143,0) F REJCDI=1:1 S CODE=$P(CODES,",",REJCDI) Q:CODE="" D I ACTION="Q"!(ACTION="^") Q "RTN","PSOREJU1",144,0) . S ACTION="" "RTN","PSOREJU1",145,0) . I $$FIND^PSOREJUT(RX,RFL,.REJDATA,CODE) D "RTN","PSOREJU1",146,0) . . S REJ=$O(REJDATA("")) "RTN","PSOREJU1",147,0) . . S ACTION=$$ACTION(RX,REJ,OPTS,$G(DEF)) I ACTION="Q"!(ACTION="^") Q ;PSO*7.0*358,add PSOTRIC as parameter "RTN","PSOREJU1",148,0) . . ;PSO*7.0*358, put in Tricare audit if Ignore action and Tricare Rx "RTN","PSOREJU1",149,0) . . I $P(ACTION,"^")="I" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,$P(ACTION,"^",2)) D:PSOTRIC AUDIT^PSOTRI(RX,RFL,,$P(ACTION,"^",2),$S($$PSOET^PSOREJP3(RX,RFL):"N",1:"R")) Q "RTN","PSOREJU1",150,0) . . I $P(ACTION,"^")="O" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,1,,$P(ACTION,"^",3),$P(ACTION,"^",2),$P(ACTION,"^",4)) "RTN","PSOREJU1",151,0) . . I $P(ACTION,"^")="D" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,7,,$P(ACTION,"^",2)) Q "RTN","PSOREJU1",152,0) . . D ECMESND^PSOBPSU1(RX,RFL,,FROM,$$GETNDC^PSONDCUT(RX,RFL),,,$P(ACTION,"^",2,4),,.RESP) "RTN","PSOREJU1",153,0) . . I $G(RESP) D Q "RTN","PSOREJU1",154,0) . . . W !!?10,"Claim could not be submitted. Please try again later!" "RTN","PSOREJU1",155,0) . . . W !,?10,"Reason: ",$S($P(RESP,"^",2)="":"UNKNOWN",1:$P(RESP,"^",2)),$C(7) "RTN","PSOREJU1",156,0) . . K NEWDATA I $$FIND^PSOREJUT(RX,RFL,.NEWDATA,CODE) D I ACTION="Q"!(ACTION="^") Q "RTN","PSOREJU1",157,0) . . . S ACTION=$$ACTION(RX,$O(NEWDATA("")),OPTS,$G(DEF)) I ACTION="Q"!(ACTION="^") Q ;PSO*7.0*358,add PSOTRIC as parameter "RTN","PSOREJU1",158,0) . . . I $P(ACTION,"^")="I" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,$P(ACTION,"^",2)) "RTN","PSOREJU1",159,0) . . . I $P(ACTION,"^")="O" D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,1,,$P(ACTION,"^",3),$P(ACTION,"^",2),$P(ACTION,"^",4)) "RTN","PSOREJU1",160,0) Q ACTION "RTN","PSOREJU1",161,0) ; "RTN","PSOREJU1",162,0) OVRX(TYPE,CODE) ; - Returns the extended code/description of the NCPDP DUR override codes "RTN","PSOREJU1",163,0) ; Input: (r) TYPE - 1 (REASON FOR SERVICE), 2 (PROFESSIONAL SERVICE) or 3 (RESULT OF SERVICE) "RTN","PSOREJU1",164,0) ; (r) CODE - Table IEN "RTN","PSOREJU1",165,0) ; Output: "CODE - DESCRIPTION" "RTN","PSOREJU1",166,0) N FILE,DIC,X,Y "RTN","PSOREJU1",167,0) S FILE=9002313+$S(TYPE=1:.23,TYPE=2:.21,1:.22) "RTN","PSOREJU1",168,0) S DIC=FILE,X=CODE D ^DIC "RTN","PSOREJU1",169,0) I TYPE=1 Q CODE_" - "_$$GET1^DIQ(9002313.23,+Y,1) "RTN","PSOREJU1",170,0) I TYPE=2 Q CODE_" - "_$$GET1^DIQ(9002313.21,+Y,1) "RTN","PSOREJU1",171,0) I TYPE=3 Q CODE_" - "_$$GET1^DIQ(9002313.22,+Y,1) "RTN","PSOREJU1",172,0) Q "" "RTN","PSOREJU1",173,0) ; "RTN","PSOREJU1",174,0) ; "RTN","PSOREJU1",175,0) OVRCOD(TYPE,VALUE) ; - Prompt for NCPDP Override Codes "RTN","PSOREJU1",176,0) N DIC,X,Y,FILE,PRPT "RTN","PSOREJU1",177,0) ; "RTN","PSOREJU1",178,0) I TYPE=1 S FILE=9002313.23,PRPT="Reason for Service Code : " "RTN","PSOREJU1",179,0) I TYPE=2 S FILE=9002313.21,PRPT="Professional Service Code: " "RTN","PSOREJU1",180,0) I TYPE=3 S FILE=9002313.22,PRPT="Result of Service Code : " "RTN","PSOREJU1",181,0) S DIC=FILE,DIC(0)="Z" "RTN","PSOREJU1",182,0) I $G(VALUE)'="" S X=VALUE D ^DIC I Y>0 W !,PRPT,VALUE," ",$P(Y(0),"^",2) Q VALUE "RTN","PSOREJU1",183,0) S DIC=FILE,DIC(0)="AQE",DIC("A")=PRPT "RTN","PSOREJU1",184,0) D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) Q "^" "RTN","PSOREJU1",185,0) Q $P(Y,"^",2) "RTN","PSOREJU1",186,0) ; "RTN","PSOREJU1",187,0) SEL(FIELD,FILE,ARRAY,DEFAULT) ; - Provides field selection (one, multiple or ALL) "RTN","PSOREJU1",188,0) N DIC,DTOUT,DUOUT,QT,Y,X "RTN","PSOREJU1",189,0) W !!,"You may select a single or multiple "_FIELD_"S," "RTN","PSOREJU1",190,0) W !,"or enter ^ALL to select all "_FIELD_"S.",! "RTN","PSOREJU1",191,0) K ARRAY S DIC=FILE,DIC(0)="QEZAM",DIC("A")=FIELD_": " "RTN","PSOREJU1",192,0) I $G(DEFAULT)'="" S DIC("B")=DEFAULT "RTN","PSOREJU1",193,0) F D ^DIC Q:X="" D Q:$G(QT) "RTN","PSOREJU1",194,0) . I $$UP^XLFSTR(X)="^ALL" K ARRAY S ARRAY="ALL",QT=1 Q "RTN","PSOREJU1",195,0) . I $D(DTOUT)!$D(DUOUT) K ARRAY S ARRAY="^",QT=1 Q "RTN","PSOREJU1",196,0) . W " ",$P(Y,"^",2),$S($D(ARRAY(+Y)):" (already selected)",1:"") "RTN","PSOREJU1",197,0) . W ! S ARRAY(+Y)="",DIC("A")="ANOTHER ONE: " K DIC("B") "RTN","PSOREJU1",198,0) I '$D(ARRAY) S ARRAY="^" "RTN","PSOREJU1",199,0) Q "RTN","PSOREJU1",200,0) ; "RTN","PSOREJU1",201,0) LMREJ(RX,RFL,MSG,BCK) ; Used by ListManager hidden actions to detect unresolved 3rd Party Rejects "RTN","PSOREJU1",202,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU1",203,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOREJU1",204,0) ;Output: (o) MSG - Usually this will be used to set VALMSG variable, which should be passed in by ref. "RTN","PSOREJU1",205,0) ; (o) BCK - This will be used to set VALMBCK variable, which should be passed in by ref. "RTN","PSOREJU1",206,0) ; "RTN","PSOREJU1",207,0) I '$D(^PSRX(+RX)) Q 0 "RTN","PSOREJU1",208,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOREJU1",209,0) I $$FIND^PSOREJUT(RX,RFL) D Q 1 "RTN","PSOREJU1",210,0) . S MSG="NOT ALLOWED! Rx has OPEN 3rd Party Payer Reject.",BCK="R" W $C(7),$C(7) "RTN","PSOREJU1",211,0) Q 0 "RTN","PSOREJU1",212,0) ; "RTN","PSOREJU1",213,0) DUP(RX,RSP,CLOSED) ; Checks if REJECT has already been logged in the PRESCRIPTION file "RTN","PSOREJU1",214,0) ; Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU1",215,0) ; (o) RSP - Response IEN "RTN","PSOREJU1",216,0) ; (o) CLOSED - If CLOSED=1 and Reject is closed, then do not count as duplicate "RTN","PSOREJU1",217,0) ; Output: DUP - 1: Already logged (duplicate) "RTN","PSOREJU1",218,0) ; 0: Not yet logged on PRESCRIPTION file "RTN","PSOREJU1",219,0) N DUP,IDX "RTN","PSOREJU1",220,0) I $G(CLOSED)="" S CLOSED=0 "RTN","PSOREJU1",221,0) S (DUP,IDX)=0 "RTN","PSOREJU1",222,0) F S IDX=$O(^PSRX(RX,"REJ",IDX)) Q:'IDX D Q:DUP "RTN","PSOREJU1",223,0) . I +RSP=+$$GET1^DIQ(52.25,IDX_","_RX,16,"I") S DUP=1 "RTN","PSOREJU1",224,0) . I CLOSED=1,+$$GET1^DIQ(52.25,IDX_","_RX,9,"I")=1 S DUP=0 "RTN","PSOREJU1",225,0) Q DUP "RTN","PSOREJU1",226,0) ; "RTN","PSOREJU1",227,0) OTH(CODE,LST) ; Removes the current Reject code from the list "RTN","PSOREJU1",228,0) ; Input: (r) CODE - Current Reject Code (79 or 88) "RTN","PSOREJU1",229,0) ; (o) LST - List of all Reject codes with response (comma separated) "RTN","PSOREJU1",230,0) ; Output: OTH - List of OTHER Reject codes (w/out 79 or 88) "RTN","PSOREJU1",231,0) ; "RTN","PSOREJU1",232,0) N I,OTH "RTN","PSOREJU1",233,0) F I=1:1:$L(LST,",") D "RTN","PSOREJU1",234,0) . I $P(LST,",",I),$P(LST,",",I)'=CODE S OTH=$G(OTH)_","_$P(LST,",",I) "RTN","PSOREJU1",235,0) S $E(OTH)="" "RTN","PSOREJU1",236,0) Q OTH "RTN","PSOREJU1",237,0) ; "RTN","PSOREJU1",238,0) DAT(DAT) ; - External Date "RTN","PSOREJU1",239,0) S X=$$HL7TFM^XLFDT(DAT) I X<0 Q "" "RTN","PSOREJU1",240,0) Q X "RTN","PSOREJU1",241,0) ; "RTN","PSOREJU1",242,0) CLEAN(STR) ; Remove blanks from the end of a string and replaces ";" with "," "RTN","PSOREJU1",243,0) N LEN F LEN=$L(STR):-1:1 Q:$E(STR,LEN)'=" " "RTN","PSOREJU1",244,0) S STR=$TR(STR,";",",") "RTN","PSOREJU1",245,0) Q $E(STR,1,LEN) "RTN","PSOREJU2") 0^6^B49130506 "RTN","PSOREJU2",1,0) PSOREJU2 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04 "RTN","PSOREJU2",2,0) ;;7.0;OUTPATIENT PHARMACY;**148,260,287,341,290,358,359**;DEC 1997;Build 27 "RTN","PSOREJU2",3,0) ;Reference to $$NABP^BPSBUTL supported by IA 4719 "RTN","PSOREJU2",4,0) ;Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE supported by IA 4714 "RTN","PSOREJU2",5,0) ; "RTN","PSOREJU2",6,0) GET(RX,RFL,REJDATA,REJID,OKCL,CODE) ; "RTN","PSOREJU2",7,0) ; Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU2",8,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOREJU2",9,0) ; (r) REJDATA(REJECT IEN,FIELD) - Array where these Reject fields will be returned: "RTN","PSOREJU2",10,0) ; "CODE" - Reject Code (79 or 88) "RTN","PSOREJU2",11,0) ; "DATE/TIME" - DATE/TIME Reject was detected "RTN","PSOREJU2",12,0) ; "PAYER MESSAGE" - Message returned by the payer "RTN","PSOREJU2",13,0) ; "REASON" - Reject Reason description (from payer) "RTN","PSOREJU2",14,0) ; "INSURANCE NAME" - Patient's Insurance Company Name "RTN","PSOREJU2",15,0) ; "COB" - Coordination of Benefits "RTN","PSOREJU2",16,0) ; "GROUP NAME" - Patient's Insurance Group Name "RTN","PSOREJU2",17,0) ; "GROUP NUMBER" - Patient's Insurance Group Number "RTN","PSOREJU2",18,0) ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID "RTN","PSOREJU2",19,0) ; "PLAN CONTACT" - Plan's Contact (eg., "1-800-...") "RTN","PSOREJU2",20,0) ; "PLAN PREVIOUS FILL DATE" - Last time Rx was paid by payer "RTN","PSOREJU2",21,0) ; "STATUS" - REJECTS status ("OPEN/UNRESOLVED" or "CLOSED/RESOLVED") "RTN","PSOREJU2",22,0) ; "DUR TEXT" - Payer's DUR description "RTN","PSOREJU2",23,0) ; "DUR ADD MSG TEXT" - Payer's DUR additional description "RTN","PSOREJU2",24,0) ; "OTHER REJECTS" - Other Rejects on the same response "RTN","PSOREJU2",25,0) ; "REASON SVC CODE" - Reason for Service Code "RTN","PSOREJU2",26,0) ; If REJECT is closed, the following fields will be returned: "RTN","PSOREJU2",27,0) ; "CLA CODE" - Clarification Code submitted "RTN","PSOREJU2",28,0) ; "PRIOR AUTH TYPE" - Prior Authorization Type "RTN","PSOREJU2",29,0) ; "PRIOR AUTH NUMBER" - Prior Authorization Type "RTN","PSOREJU2",30,0) ; "CLOSED DATE/TIME" - DATE/TIME Reject was closed "RTN","PSOREJU2",31,0) ; "CLOSED BY" - Name of the user responsible for closing Reject "RTN","PSOREJU2",32,0) ; "CLOSE REASON" - Reason for closing Reject (text) "RTN","PSOREJU2",33,0) ; "CLOSE COMMENTS" - User entered comments at close "RTN","PSOREJU2",34,0) ; (o) REJID - REJECT IEN in the PRESCRIPTION file for retrieve this REJECT "RTN","PSOREJU2",35,0) ; (o) OKCL - If set to 1, CLOSED REJECTs will also be returned "RTN","PSOREJU2",36,0) ; (o) CODE - Only REJECTs with this CODE should be returned "RTN","PSOREJU2",37,0) ; "RTN","PSOREJU2",38,0) N REJS,ARRAY,REJFLD,IDX,COM,Z "RTN","PSOREJU2",39,0) ; "RTN","PSOREJU2",40,0) I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX) "RTN","PSOREJU2",41,0) ; "RTN","PSOREJU2",42,0) K REJDATA "RTN","PSOREJU2",43,0) I '$O(^PSRX(RX,"REJ",0)) Q "RTN","PSOREJU2",44,0) ; "RTN","PSOREJU2",45,0) K REJS S RFL=+$G(RFL) "RTN","PSOREJU2",46,0) I $G(REJID) D "RTN","PSOREJU2",47,0) . I +$P($G(^PSRX(RX,"REJ",REJID,0)),"^",4)'=RFL Q "RTN","PSOREJU2",48,0) . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",REJID,0)),"^",5) Q "RTN","PSOREJU2",49,0) . S REJS(REJID)="" "RTN","PSOREJU2",50,0) E D "RTN","PSOREJU2",51,0) . S IDX=999 "RTN","PSOREJU2",52,0) . F S IDX=$O(^PSRX(RX,"REJ",IDX),-1) Q:'IDX D "RTN","PSOREJU2",53,0) . . I +$P($G(^PSRX(RX,"REJ",IDX,0)),"^",4)'=RFL Q "RTN","PSOREJU2",54,0) . . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",IDX,0)),"^",5) Q "RTN","PSOREJU2",55,0) . . S REJS(IDX)="" "RTN","PSOREJU2",56,0) I '$D(REJS) Q "RTN","PSOREJU2",57,0) ; "RTN","PSOREJU2",58,0) S IDX=0 "RTN","PSOREJU2",59,0) F S IDX=$O(REJS(IDX)) Q:'IDX D "RTN","PSOREJU2",60,0) . K ARRAY D GETS^DIQ(52.25,IDX_","_RX_",","*","","ARRAY") "RTN","PSOREJU2",61,0) . K REJFLD M REJFLD=ARRAY(52.25,IDX_","_RX_",") "RTN","PSOREJU2",62,0) . I $G(CODE)'="",REJFLD(.01)'=CODE Q ;cnf, PSO*7.0*358, add check for '="" "RTN","PSOREJU2",63,0) . S REJDATA(IDX,"CODE")=$G(REJFLD(.01)) "RTN","PSOREJU2",64,0) . S REJDATA(IDX,"DATE/TIME")=$G(REJFLD(1)) "RTN","PSOREJU2",65,0) . S REJDATA(IDX,"PAYER MESSAGE")=$G(REJFLD(2)) "RTN","PSOREJU2",66,0) . S REJDATA(IDX,"REASON")=$G(REJFLD(3)) "RTN","PSOREJU2",67,0) . S REJDATA(IDX,"PHARMACIST")=$G(REJFLD(4)) "RTN","PSOREJU2",68,0) . S REJDATA(IDX,"INSURANCE NAME")=$G(REJFLD(20)) "RTN","PSOREJU2",69,0) . S REJDATA(IDX,"COB")=$G(REJFLD(27)) "RTN","PSOREJU2",70,0) . S REJDATA(IDX,"GROUP NAME")=$G(REJFLD(6)) "RTN","PSOREJU2",71,0) . S REJDATA(IDX,"GROUP NUMBER")=$G(REJFLD(21)) "RTN","PSOREJU2",72,0) . S REJDATA(IDX,"CARDHOLDER ID")=$G(REJFLD(22)) "RTN","PSOREJU2",73,0) . S REJDATA(IDX,"PLAN CONTACT")=$G(REJFLD(7)) "RTN","PSOREJU2",74,0) . S REJDATA(IDX,"PLAN PREVIOUS FILL DATE")=$G(REJFLD(8)) "RTN","PSOREJU2",75,0) . S REJDATA(IDX,"STATUS")=$G(REJFLD(9)) "RTN","PSOREJU2",76,0) . S REJDATA(IDX,"OTHER REJECTS")=$G(REJFLD(17)) "RTN","PSOREJU2",77,0) . S REJDATA(IDX,"DUR TEXT")=$G(REJFLD(18)) "RTN","PSOREJU2",78,0) . S REJDATA(IDX,"DUR ADD MSG TEXT")=$G(REJFLD(28)) "RTN","PSOREJU2",79,0) . S REJDATA(IDX,"REASON SVC CODE")=$G(REJFLD(14)) "RTN","PSOREJU2",80,0) . S REJDATA(IDX,"RESPONSE IEN")=$G(REJFLD(16)) "RTN","PSOREJU2",81,0) . I '$G(OKCL) Q "RTN","PSOREJU2",82,0) . S REJDATA(IDX,"CLOSED DATE/TIME")=$G(REJFLD(10)) "RTN","PSOREJU2",83,0) . S REJDATA(IDX,"CLOSED BY")=$G(REJFLD(11)) "RTN","PSOREJU2",84,0) . S REJDATA(IDX,"CLOSE REASON")=$G(REJFLD(12)) "RTN","PSOREJU2",85,0) . S REJDATA(IDX,"CLOSE COMMENTS")=$G(REJFLD(13)) "RTN","PSOREJU2",86,0) . S REJDATA(IDX,"COD1")=$G(REJFLD(14)) "RTN","PSOREJU2",87,0) . S REJDATA(IDX,"COD2")=$G(REJFLD(15)) "RTN","PSOREJU2",88,0) . S REJDATA(IDX,"COD3")=$G(REJFLD(19)) "RTN","PSOREJU2",89,0) . S REJDATA(IDX,"CLA CODE")=$G(REJFLD(24)) "RTN","PSOREJU2",90,0) . S REJDATA(IDX,"PRIOR AUTH TYPE")=$G(REJFLD(25)) "RTN","PSOREJU2",91,0) . S REJDATA(IDX,"PRIOR AUTH NUMBER")=$G(REJFLD(26)) "RTN","PSOREJU2",92,0) . S COM=0 F S COM=$O(^PSRX(RX,"REJ",IDX,"COM",COM)) Q:'COM D "RTN","PSOREJU2",93,0) . . S Z=^PSRX(RX,"REJ",IDX,"COM",COM,0) "RTN","PSOREJU2",94,0) . . S REJDATA(IDX,"COMMENTS",COM,"DATE/TIME")=$P(Z,"^") "RTN","PSOREJU2",95,0) . . S REJDATA(IDX,"COMMENTS",COM,"USER")=$P(Z,"^",2) "RTN","PSOREJU2",96,0) . . S REJDATA(IDX,"COMMENTS",COM,"COMMENTS")=$P(Z,"^",3) "RTN","PSOREJU2",97,0) Q "RTN","PSOREJU2",98,0) ; "RTN","PSOREJU2",99,0) HELP(OPTS) ; Display the Help Text for the DUR handling options (OVERRIDE/IGNORE/STOP/QUIT) "RTN","PSOREJU2",100,0) ; "RTN","PSOREJU2",101,0) I OPTS["O" D "RTN","PSOREJU2",102,0) . W !?1,"(O)verride - This option will provide the prompts for the code sets needed to" "RTN","PSOREJU2",103,0) . W !?1," override this reject and get a payable 3rd party claim. Before" "RTN","PSOREJU2",104,0) . W !?1," you select this option, you may need to call the 3rd party payer" "RTN","PSOREJU2",105,0) . W !?1," to determine which code sets are needed to override a particular" "RTN","PSOREJU2",106,0) . W !?1," reject. Once the proper override is accepted the label will print" "RTN","PSOREJU2",107,0) . W !?1," and the prescription can be filled." "RTN","PSOREJU2",108,0) ; "RTN","PSOREJU2",109,0) I OPTS["I" D "RTN","PSOREJU2",110,0) . W !?1,"(I)gnore - Choosing Ignore will by-pass 3rd party processing and will allow" "RTN","PSOREJU2",111,0) . W !?1," you to print a label and fill the prescription. This essentially" "RTN","PSOREJU2",112,0) . W !?1," ignores the clinical safety issues suggested by the 3rd party" "RTN","PSOREJU2",113,0) . W !?1," payer and will NOT result in a payable claim." "RTN","PSOREJU2",114,0) ; "RTN","PSOREJU2",115,0) I OPTS["Q" D "RTN","PSOREJU2",116,0) . W !?1,"(Q)uit - Choosing Quit will postpone the processing of this prescription" "RTN","PSOREJU2",117,0) . W !?1," until this 3rd party reject is resolved. A label will not be" "RTN","PSOREJU2",118,0) . W !?1," printed for this prescription and it can not be filled/dispensed" "RTN","PSOREJU2",119,0) . W !?1," until this reject is resolved. Rejects can be resolved through" "RTN","PSOREJU2",120,0) . W !?1," the Worklist option under the ePharmacy menu." "RTN","PSOREJU2",121,0) Q "RTN","PSOREJU2",122,0) ; "RTN","PSOREJU2",123,0) DVINFO(RX,RFL,LM) ; Returns header displayable Division Information "RTN","PSOREJU2",124,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU2",125,0) ; (o) RFL - Refill # (Default: most recent) "RTN","PSOREJU2",126,0) ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0 "RTN","PSOREJU2",127,0) N TXT,DVINFO,NCPNPI "RTN","PSOREJU2",128,0) S DVINFO="Division : "_$$GET1^DIQ(59,+$$RXSITE^PSOBPSUT(RX,RFL),.01) "RTN","PSOREJU2",129,0) S NCPNPI=$P($$NABP^BPSBUTL(RX,RFL)," ") "RTN","PSOREJU2",130,0) S $E(DVINFO,$S($G(LM):58,1:51))=$S($L(NCPNPI)=7:"NCPDP",1:" NPI")_"#: "_NCPNPI "RTN","PSOREJU2",131,0) Q DVINFO "RTN","PSOREJU2",132,0) ; "RTN","PSOREJU2",133,0) PTINFO(RX,LM) ; Returns header displayable Patient Information "RTN","PSOREJU2",134,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU2",135,0) ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0 "RTN","PSOREJU2",136,0) N DFN,VADM,PTINFO,SSN4 "RTN","PSOREJU2",137,0) S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT S SSN4=$P($G(VADM(2)),"^",2) "RTN","PSOREJU2",138,0) S PTINFO="Patient : "_$E($G(VADM(1)),1,$S($G(LM):24,1:20))_"("_$E(SSN4,$L(SSN4)-3,$L(SSN4))_")" "RTN","PSOREJU2",139,0) S PTINFO=PTINFO_" Sex: "_$P($G(VADM(5)),"^") "RTN","PSOREJU2",140,0) S $E(PTINFO,$S($G(LM):61,1:54))="DOB: "_$P($G(VADM(3)),"^",2)_"("_$P($G(VADM(4)),"^")_")" "RTN","PSOREJU2",141,0) Q PTINFO "RTN","PSOREJU2",142,0) ; "RTN","PSOREJU2",143,0) RETRXF(RX,RFL,ONOFF) ; - Set/Reset the Re-transmission flag "RTN","PSOREJU2",144,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU2",145,0) ; (r) RFL - Refill IEN (#52.1) "RTN","PSOREJU2",146,0) ; (o) ONOFF - Turn flag ON or OFF (1 - ON / 0 - OFF) (Default: OFF) "RTN","PSOREJU2",147,0) I RFL>0,'$D(^PSRX(RX,1,RFL,0)) QUIT "RTN","PSOREJU2",148,0) N DA,DIE,DR "RTN","PSOREJU2",149,0) S DR="82///"_$S($G(ONOFF):"YES",1:"@") "RTN","PSOREJU2",150,0) I 'RFL S DA=RX,DIE="^PSRX(" "RTN","PSOREJU2",151,0) I RFL S DA(1)=RX,DA=RFL,DIE="^PSRX("_RX_",1," "RTN","PSOREJU2",152,0) D ^DIE "RTN","PSOREJU2",153,0) Q "RTN","PSOREJU2",154,0) ; "RTN","PSOREJU2",155,0) REASON(TXT) ; Extracts the Reason for service code from the REASON text field "RTN","PSOREJU2",156,0) ; Input: (r) TXT - Reason text (e.g., NN Reason for Service Code Text) "RTN","PSOREJU2",157,0) ;Output: REASON - NN (if on valid and on file (#9002313.23), null otherwise) "RTN","PSOREJU2",158,0) N REASON,DIC,X,Y "RTN","PSOREJU2",159,0) S REASON=$P(TXT," ") I $L(REASON)'=2 Q "" "RTN","PSOREJU2",160,0) S DIC=9002313.23,X=REASON D ^DIC I Y<0 Q "" "RTN","PSOREJU2",161,0) Q REASON "RTN","PSOREJU2",162,0) ; "RTN","PSOREJU2",163,0) SETOPN(RX,REJ) ; - Set the Reject RE-OPENED flag to YES "RTN","PSOREJU2",164,0) ;Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU2",165,0) ; (r) REJ - Reject IEN (#52.25) "RTN","PSOREJU2",166,0) ; "RTN","PSOREJU2",167,0) I '$D(^PSRX(RX,"REJ",REJ)) Q "RTN","PSOREJU2",168,0) N DIE,DA,DR "RTN","PSOREJU2",169,0) S DIE="^PSRX("_RX_",""REJ"",",DA(1)=RX,DA=REJ,DR="23///YES" D ^DIE "RTN","PSOREJU2",170,0) Q "RTN","PSOREJU2",171,0) ; "RTN","PSOREJU2",172,0) PRT(FIELD,P,L) ; Sets the lines for fields that require text wrapping "RTN","PSOREJU2",173,0) ;Input: FIELD - Subscript name from the DATA(REJ,FIELD) array "RTN","PSOREJU2",174,0) ; P - Position where the content should be printed "RTN","PSOREJU2",175,0) ; L - Lenght of the text on each line "RTN","PSOREJU2",176,0) N TXT,I "RTN","PSOREJU2",177,0) S TXT=DATA(REJ,FIELD) I $L(TXT)'>L W ?P,TXT Q "RTN","PSOREJU2",178,0) F I=1:1 Q:TXT="" D "RTN","PSOREJU2",179,0) . I I=1 W ?P,$E(TXT,1,L),! S TXT=$E(TXT,L+1,999) Q "RTN","PSOREJU2",180,0) . W ?P,$E(TXT,1,L) S TXT=$E(TXT,L+1,999) W:TXT'="" ! "RTN","PSOREJU2",181,0) Q "RTN","PSOREJU2",182,0) ; "RTN","PSOREJU2",183,0) PA() ; - Ask for Prior Authorization Type and Number "RTN","PSOREJU2",184,0) ;Output:(PAT^PAN) PAT - Prior Authorization Type "RTN","PSOREJU2",185,0) ; (See DD File #9002313.26 for possible values) "RTN","PSOREJU2",186,0) ; PAN - Prior Authorization Number (11 digits) "RTN","PSOREJU2",187,0) ; "RTN","PSOREJU2",188,0) N X,DIC,DIROUT,DTOUT,DUOUT,PAN,PAT,Y "RTN","PSOREJU2",189,0) S DIC("B")=0 "RTN","PSOREJU2",190,0) S DIC(0)="QEAM",DIC=9002313.26,DIC("A")="Prior Authorization Type: " "RTN","PSOREJU2",191,0) D ^DIC "RTN","PSOREJU2",192,0) I ($D(DUOUT))!($D(DTOUT))!(Y=-1) Q "^" ;Check for "^" or timeout "RTN","PSOREJU2",193,0) S PAT=$P(Y,U,2) "RTN","PSOREJU2",194,0) ; "RTN","PSOREJU2",195,0) K DIR,DIC,X,Y "RTN","PSOREJU2",196,0) S DIR(0)="52.25,26",DIR("A")="Prior Authorization Number" "RTN","PSOREJU2",197,0) S DIR("?")="^D PANHLP^PSOREJU2",DIR("??")="" "RTN","PSOREJU2",198,0) D ^DIR I (Y["^")!$D(DIROUT) Q "^" "RTN","PSOREJU2",199,0) S PAN=Y "RTN","PSOREJU2",200,0) Q (PAT_"^"_PAN) "RTN","PSOREJU2",201,0) ; "RTN","PSOREJU2",202,0) PANHLP ; Prior Authorization Number Help "RTN","PSOREJU2",203,0) W "OR you may leave it blank if the claim does not require a number." "RTN","PSOREJU2",204,0) Q "RTN","PSOREJU3") 0^9^B68707597 "RTN","PSOREJU3",1,0) PSOREJU3 ;BIRM/LJE - BPS (ECME) - Clinical Rejects Utilities (3) ;04/25/08 "RTN","PSOREJU3",2,0) ;;7.0;OUTPATIENT PHARMACY;**287,290,358,359**;DEC 1997;Build 27 "RTN","PSOREJU3",3,0) ;References to 9002313.99 supported by IA 4305 "RTN","PSOREJU3",4,0) ;Reference to $$CLAIM^BPSBUTL supported by IA 4719 "RTN","PSOREJU3",5,0) ; "RTN","PSOREJU3",6,0) Q "RTN","PSOREJU3",7,0) ; "RTN","PSOREJU3",8,0) TRICCHK(RX,RFL,RESP,FROM,RVTX) ;check to see if Rx is non-billable or in an "In Progress" state on ECME "RTN","PSOREJU3",9,0) ; Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU3",10,0) ; (r) RFL - REFILL "RTN","PSOREJU3",11,0) ; (o) RESP - Response from $$EN^BPSNCPDP api "RTN","PSOREJU3",12,0) ; TRICCHK assumes that the calling routine has validated that the fill is Tricare. "RTN","PSOREJU3",13,0) ; "RTN","PSOREJU3",14,0) ; - \Need to be mindful of foreground and background processing. "RTN","PSOREJU3",15,0) ; "RTN","PSOREJU3",16,0) N ETOUT,ESTAT "RTN","PSOREJU3",17,0) S:'$D(FROM) FROM="" S ESTAT="",ESTAT=$P(RESP,"^",4),NFROM=0 I FROM="PL"!(FROM="PC") S NFROM=1 "RTN","PSOREJU3",18,0) Q:ESTAT["PAYABLE"!(ESTAT["REJECTED") "RTN","PSOREJU3",19,0) I ESTAT["IN PROGRESS",FROM="RRL"!($G(RVTX)="RX RELEASE-NDC CHANGE") D Q "RTN","PSOREJU3",20,0) . I 'NFROM D "RTN","PSOREJU3",21,0) . . W !!,"TRICARE Prescription "_$$GET1^DIQ(52,RX,".01")_" cannot be released until ECME 'IN PROGRESS'" "RTN","PSOREJU3",22,0) . . W !,"status is resolved payable.",!! "RTN","PSOREJU3",23,0) ; "RTN","PSOREJU3",24,0) I $D(RESP) D Q "RTN","PSOREJU3",25,0) . I +RESP=6 W:'NFROM&('$G(CMOP)) !!,"Inactive ECME Tricare",!! D Q "RTN","PSOREJU3",26,0) . . S ACT="Inactive ECME Tricare" D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) "RTN","PSOREJU3",27,0) . I +RESP=2!(+RESP=3) N PSONBILL S PSONBILL=1 D TRIC2 Q "RTN","PSOREJU3",28,0) . I +RESP=4!(ESTAT["IN PROGRESS") N PSONPROG S PSONPROG=1 D TRIC2 Q "RTN","PSOREJU3",29,0) Q "RTN","PSOREJU3",30,0) ; "RTN","PSOREJU3",31,0) TRIC2 ; "RTN","PSOREJU3",32,0) N ACTION,REJCOD,REJ,DIR,DIRUT,REA,DA,PSCAN,PSOTRIC,ZZZ "RTN","PSOREJU3",33,0) S PSOTRIC=1,REJ=9999999999 "RTN","PSOREJU3",34,0) I $G(CMOP)&($G(PSONPROG)) D TACT Q "RTN","PSOREJU3",35,0) Q:$G(CMOP) "RTN","PSOREJU3",36,0) I 'NFROM D DISPLAY(RX,REJ) "RTN","PSOREJU3",37,0) I 'NFROM&($G(PSONPROG)) D D SUSP Q "RTN","PSOREJU3",38,0) . W !!,"This prescription will be suspended. After the third party claim is resolved," "RTN","PSOREJU3",39,0) . W !,"it may be printed or pulled early from suspense.",! "RTN","PSOREJU3",40,0) . R !!,"Press to continue...",ZZZ:60,! "RTN","PSOREJU3",41,0) I NFROM&($G(PSONPROG)) D TACT Q "RTN","PSOREJU3",42,0) Q:NFROM "RTN","PSOREJU3",43,0) TRIC3 ; "RTN","PSOREJU3",44,0) D MSG "RTN","PSOREJU3",45,0) I FROM="PL"!(FROM="PC") D SUSP Q "RTN","PSOREJU3",46,0) ;cnf, PSO*7*358, add code for options "RTN","PSOREJU3",47,0) N ACTION,DIR,DIRUT,OPTS,DEF,COM "RTN","PSOREJU3",48,0) TRIC4 S DIR(0)="SO^",DIR("A")="",OPTS="DQ",DEF="D" "RTN","PSOREJU3",49,0) ;reference to ^XUSEC( supported by IA 10076 "RTN","PSOREJU3",50,0) I $D(^XUSEC("PSO TRICARE",DUZ)) S OPTS=OPTS_"I" ;PSO*7.0*358, if user has security key, include IGNORE in TRICARE options "RTN","PSOREJU3",51,0) S:(OPTS["D") DIR(0)=DIR(0)_"D:(D)iscontinue - DO NOT FILL PRESCRIPTION;",DIR("A")=DIR("A")_"(D)iscontinue," "RTN","PSOREJU3",52,0) S:(OPTS["Q") DIR(0)=DIR(0)_"Q:(Q)UIT - SEND TO WORKLIST (REQUIRES INTERVENTION);",DIR("A")=DIR("A")_"(Q)uit," "RTN","PSOREJU3",53,0) S:(OPTS["I") DIR(0)=DIR(0)_"I:(I)GNORE - FILL Rx WITHOUT CLAIM SUBMISSION;",DIR("A")=DIR("A")_"(I)gnore," "RTN","PSOREJU3",54,0) S $E(DIR(0),$L(DIR(0)))="",$E(DIR("A"),$L(DIR("A")))="",DIR("??")="^D HELP^PSOREJU2("""_OPTS_""")" "RTN","PSOREJU3",55,0) S:$G(DEF)'="" DIR("B")=DEF D ^DIR I $D(DIRUT) S Y="Q" W ! "RTN","PSOREJU3",56,0) ; "RTN","PSOREJU3",57,0) S ACTION=Y "RTN","PSOREJU3",58,0) I ACTION="D" S ACTION=$$DC^PSOREJU1(RX,ACTION) ;cnf, PSO*7*358 "RTN","PSOREJU3",59,0) I ACTION="Q" D WRKLST^PSOREJU4(RX,RFL,,DUZ,DT,1,"",RESP) ;cnf, PSO*7*358 "RTN","PSOREJU3",60,0) I ACTION="I" G TRIC4:'$$CONT^PSOREJU1() S COM=$$TCOM^PSOREJP3() G TRIC4:COM="^" G TRIC4:'$$SIG^PSOREJU1() D "RTN","PSOREJU3",61,0) . D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,6,COM) ;TRICARE non-billable should have only 1 reject - eT "RTN","PSOREJU3",62,0) . D AUDIT^PSOTRI(RX,RFL,,COM,$S($$PSOET^PSOREJP3(RX,RFL):"N",1:"R")) "RTN","PSOREJU3",63,0) Q "RTN","PSOREJU3",64,0) ; "RTN","PSOREJU3",65,0) MSG ; "RTN","PSOREJU3",66,0) W !!,"This is a non-billable Tricare prescription." ;cnf, PSO*7*358 "RTN","PSOREJU3",67,0) Q "RTN","PSOREJU3",68,0) SUSP ;Suspense Rx due to IN PROGRESS status in ECME "RTN","PSOREJU3",69,0) N DA,ACT,RX0,SD,RXS,PSOWFLG,DIK,RXN,XFLAG,RXP,DD,DO,X,Y,DIC,VALMSG,COMM,LFD,DFLG,RXCMOP "RTN","PSOREJU3",70,0) N PSOQFLAG,PSORXZD,PSOQFLAG,PSOKSPPL,PSOZXPPL,PSOZXPI,RXLTOP "RTN","PSOREJU3",71,0) S DA=RX D SUS^PSORXL1 "RTN","PSOREJU3",72,0) TACT ; "RTN","PSOREJU3",73,0) S ACT="TRICARE-Rx placed on Suspense due to"_$S($G(PSONPROG):" ECME IN PROGRESS status",$G(PSONBILL):"the Rx being Non-billable",1:"") "RTN","PSOREJU3",74,0) I '$G(DUZ) N DUZ S DUZ=.5 "RTN","PSOREJU3",75,0) D RXACT^PSOBPSU2(RX,RFL,ACT,"M",DUZ) "RTN","PSOREJU3",76,0) Q "RTN","PSOREJU3",77,0) ; "RTN","PSOREJU3",78,0) DISPLAY(RX,REJ,KEY) ; - Displays REJECT information "RTN","PSOREJU3",79,0) ; Input: (r) RX - Rx IEN (#52) "RTN","PSOREJU3",80,0) ; (r) REJ - REJECT ID (IEN) "RTN","PSOREJU3",81,0) ; (o) KEY - Display "Press any KEY to continue..." (1-YES/0-NO) (Default: 0) "RTN","PSOREJU3",82,0) ; "RTN","PSOREJU3",83,0) Q:$G(NFROM) "RTN","PSOREJU3",84,0) I '$G(RX)!'$G(REJ) Q "RTN","PSOREJU3",85,0) I '$D(^PSRX(RX,"REJ",REJ))&('$G(PSONBILL))&('$G(PSONPROG)) Q "RTN","PSOREJU3",86,0) ; "RTN","PSOREJU3",87,0) N DATA,RFL,LINE,% "RTN","PSOREJU3",88,0) S RFL=+$$GET1^DIQ(52.25,REJ_","_RX,5) "RTN","PSOREJU3",89,0) I '$G(PSONBILL)&('$G(PSONPROG)) D GET^PSOREJU2(RX,RFL,.DATA,REJ) I '$D(DATA(REJ)) Q "RTN","PSOREJU3",90,0) ; "RTN","PSOREJU3",91,0) D HDR "RTN","PSOREJU3",92,0) S $P(LINE,"-",74)="" W !?3,LINE "RTN","PSOREJU3",93,0) W !?3,$$DVINFO^PSOREJU2(RX,RFL) "RTN","PSOREJU3",94,0) W !?3,$$PTINFO^PSOREJU2(RX) "RTN","PSOREJU3",95,0) W !?3,"Rx/Drug : ",$$GET1^DIQ(52,RX,.01),"/",RFL," - ",$E($$GET1^DIQ(52,RX,6),1,20),?54 "RTN","PSOREJU3",96,0) W:'$G(PSONBILL)&('$G(PSONPROG)) "ECME#: ",$P($$CLAIM^BPSBUTL(RX,RFL),U,6) "RTN","PSOREJU3",97,0) D TYPE G DISP2:$G(PSONBILL)!($G(PSONPROG)) "RTN","PSOREJU3",98,0) I $G(DATA(REJ,"PAYER MESSAGE"))'="" W !?3,"Payer Message: " D PRT^PSOREJU2("PAYER MESSAGE",18,58) "RTN","PSOREJU3",99,0) I $G(DATA(REJ,"DUR TEXT"))'="" W !?3,"DUR Text : ",DATA(REJ,"DUR TEXT") "RTN","PSOREJU3",100,0) W !?3,"Insurance : ",DATA(REJ,"INSURANCE NAME"),?50,"Contact: ",DATA(REJ,"PLAN CONTACT") "RTN","PSOREJU3",101,0) W !?3,"Group Name : ",DATA(REJ,"GROUP NAME"),?45,"Group Number: ",DATA(REJ,"GROUP NUMBER") "RTN","PSOREJU3",102,0) I $G(DATA(REJ,"CARDHOLDER ID"))'="" W !?3,"Cardholder ID: ",DATA(REJ,"CARDHOLDER ID") "RTN","PSOREJU3",103,0) I DATA(REJ,"PLAN PREVIOUS FILL DATE")'="" D "RTN","PSOREJU3",104,0) . W !?3,"Last Fill Dt.: ",DATA(REJ,"PLAN PREVIOUS FILL DATE") "RTN","PSOREJU3",105,0) . W:DATA(REJ,"PLAN PREVIOUS FILL DATE")'="" " (from payer)" "RTN","PSOREJU3",106,0) DISP2 ; "RTN","PSOREJU3",107,0) W !?3,LINE,$C(7) I $G(KEY) W !?3,"Press to continue..." R %:DTIME W ! "RTN","PSOREJU3",108,0) Q "RTN","PSOREJU3",109,0) ; "RTN","PSOREJU3",110,0) TYPE ; "RTN","PSOREJU3",111,0) I $G(PSONBILL)!($G(PSONPROG)) D Q "RTN","PSOREJU3",112,0) . D NOW^%DTC S Y=% D DD^%DT "RTN","PSOREJU3",113,0) . W !?3,"Date/Time: "_$$FMTE^XLFDT(Y) "RTN","PSOREJU3",114,0) . W !?3,"Reason : ",$S($G(PSONBILL):"Drug not billable.",$G(PSONPROG):"ECME Status is in an 'IN PROGRESS' state and cannot be filled",1:"") "RTN","PSOREJU3",115,0) ; "RTN","PSOREJU3",116,0) I $G(DATA(REJ,"REASON"))'="" W !?3,"Reason : " D PRT^PSOREJU2("REASON",14,62) "RTN","PSOREJU3",117,0) N RTXT,OCODE,OTXT,I "RTN","PSOREJU3",118,0) S (OTXT,RTXT,OCODE)="",RTXT=$S(DATA(REJ,"CODE")=79:"REFILL TOO SOON",CODE=88:"DUR REJECT",1:$$EXP^PSOREJP1(CODE))_" ("_DATA(REJ,"CODE")_")" "RTN","PSOREJU3",119,0) F I=1:1 S OCODE=$P(DATA(REJ,"OTHER REJECTS"),",",I) Q:OCODE="" D "RTN","PSOREJU3",120,0) . S OTXT=OTXT_", "_$S(OCODE=79:"REFILL TOO SOON",OCODE=88:"DUR REJECT",1:$$EXP^PSOREJP1(OCODE))_" ("_OCODE_")" "RTN","PSOREJU3",121,0) S RTXT=RTXT_OTXT_". Received on "_$$FMTE^XLFDT($G(DATA(REJ,"DATE/TIME")))_"." "RTN","PSOREJU3",122,0) S OTXT="" "RTN","PSOREJU3",123,0) W !?3,"Reject(s): " D WRAP(RTXT,14) "RTN","PSOREJU3",124,0) Q "RTN","PSOREJU3",125,0) ; "RTN","PSOREJU3",126,0) WRAP(PSOTXT,INDENT) ; "RTN","PSOREJU3",127,0) N I,K,PSOWRAP,PSOMARG "RTN","PSOREJU3",128,0) S PSOWRAP=1,PSOMARG=$S('$G(PSORM):80,$D(IOM):IOM,1:80)-(INDENT+5) "RTN","PSOREJU3",129,0) W1 S:$L(PSOTXT)0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL") "RTN","PSORXVW1",40,0) .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(P1,"^",3) D ^DIC "RTN","PSORXVW1",41,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$E(RN,$L(RFT)+1,15)_$S(+Y:$P(Y,"^",2),1:$P(P1,"^",3)) "RTN","PSORXVW1",42,0) .;S:$P(P1,"^",5)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(P1,"^",5) "RTN","PSORXVW1",43,0) .I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D "RTN","PSORXVW1",44,0) ..S PSOACBRV=$P(P1,"^",5) "RTN","PSORXVW1",45,0) ..;PSO*7*240 Use fileman to format "RTN","PSORXVW1",46,0) ..K ^UTILITY($J,"W") S X="Comments: "_PSOACBRV,(DIWR,DIWL)=1,DIWF="C80" D ^DIWP F I=1:1:^UTILITY($J,"W",1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$G(^UTILITY($J,"W",1,I,0)) "RTN","PSORXVW1",47,0) .I $G(^PSRX(DA,"A",N,1))]"" S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",5)=$P(^PSRX(DA,"A",N,1),"^") I $P(^PSRX(DA,"A",N,1),"^",2)]"" S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_":"_$P(^PSRX(DA,"A",N,1),"^",2) "RTN","PSORXVW1",48,0) .I $O(^PSRX(DA,"A",N,2,0)) F I=0:0 S I=$O(^PSRX(RXN,"A",N,2,I)) Q:'I S MIG=^PSRX(RXN,"A",N,2,I,0) D "RTN","PSORXVW1",49,0) ..F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG) "RTN","PSORXVW1",50,0) K MIG,SG,I,^UTILITY($J,"W"),DIWF,DIWL,DIWR "RTN","PSORXVW1",51,0) Q "RTN","PSORXVW1",52,0) LBL ;label log "RTN","PSORXVW1",53,0) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Label Log:" "RTN","PSORXVW1",54,0) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Date Rx Ref Printed By",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="=" "RTN","PSORXVW1",55,0) I '$O(^PSRX(DA,"L",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Labels printed." Q "RTN","PSORXVW1",56,0) F L1=0:0 S L1=$O(^PSRX(DA,"L",L1)) Q:'L1 S LBL=^PSRX(DA,"L",L1,0),DTT=$P(^(0),"^") D DAT D "RTN","PSORXVW1",57,0) .S $P(RN," ",26)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=L1_" "_DAT_" ",RFT=$S($P(LBL,"^",2):"REFILL "_$P(LBL,"^",2),1:"ORIGINAL"),RFT=RFT_$E(RN,$L(RFT)+1,26) "RTN","PSORXVW1",58,0) .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(LBL,"^",4) D ^DIC "RTN","PSORXVW1",59,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$P(Y,"^",2),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(LBL,"^",3) "RTN","PSORXVW1",60,0) K DIC,X,Y Q "RTN","PSORXVW1",61,0) RF ;refill log "RTN","PSORXVW1",62,0) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Refill Log:" "RTN","PSORXVW1",63,0) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Log Date Refill Date Qty Routing Lot # Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="=" "RTN","PSORXVW1",64,0) S (RF,PL)=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF S PL=PL+1 "RTN","PSORXVW1",65,0) I 'PL S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Refills For this Prescription" Q "RTN","PSORXVW1",66,0) F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N S P1=^(N,0) D "RTN","PSORXVW1",67,0) .S DTT=$P(P1,"^",8)\1 D DAT S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" " "RTN","PSORXVW1",68,0) .S DTT=$P(P1,"^"),$P(RN," ",10)=" " D DAT "RTN","PSORXVW1",69,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_" "_$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15)_" "_$S($P(P1,"^",2)="M":"Mail",1:"Window")_" "_$P(P1,"^",6)_$E(RN,$L($P(P1,"^",6))+1,12) "RTN","PSORXVW1",70,0) .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+$P(P1,"^",5) D ^DIC "RTN","PSORXVW1",71,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_$E($S(+Y:$P(Y,"^",2),1:""),1,16) K DIC,X,Y "RTN","PSORXVW1",72,0) .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"Unknown"),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_$E(" ",$L(PSDIV)+1,8)_" " "RTN","PSORXVW1",73,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"Dispensed: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")_" " "RTN","PSORXVW1",74,0) .S RTS=$S($P(P1,"^",16):" Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" Released: "_$S($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:"")) "RTN","PSORXVW1",75,0) .I $$STATUS^PSOBPSUT(DA,N)'="",$$RXRLDT^PSOBPSUT(DA,N) S RTS=RTS_" NDC: "_$$GETNDC^PSONDCUT(DA,N) "RTN","PSORXVW1",76,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RTS "RTN","PSORXVW1",77,0) .S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Remarks: "_$P(P1,"^",3) "RTN","PSORXVW1",78,0) K RTS Q "RTN","PSORXVW1",79,0) PAR ;partial log "RTN","PSORXVW1",80,0) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Partial Fills:" "RTN","PSORXVW1",81,0) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="# Log Date Date Qty Routing Lot # Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="=" "RTN","PSORXVW1",82,0) I '$O(^PSRX(DA,"P",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Partials for this Prescription" Q "RTN","PSORXVW1",83,0) S N=0 F S N=$O(^PSRX(DA,"P",N)) Q:'N S P1=^(N,0),DTT=$P(P1,"^",8)\1 D DAT D "RTN","PSORXVW1",84,0) .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_" "_DAT_" ",QTY=$P(P1,"^",4)_$E(" ",$L($P(P1,"^",4))+1,15) "RTN","PSORXVW1",85,0) .S DTT=$P(P1,"^") D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_" "_QTY_" " "RTN","PSORXVW1",86,0) .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"UNKNOWN"),PSDIV=PSDIV_$E(" ",$L(PSDIV)+1,8) "RTN","PSORXVW1",87,0) .S MW=$S($P(P1,"^",2)="M":"Mail",1:"Window"),MW=MW_$E(" ",$L(MW)+1,10) "RTN","PSORXVW1",88,0) .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+$P(P1,"^",16) D ^DIC "RTN","PSORXVW1",89,0) .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_MW_" "_$P(P1,"^",6)_$E(" ",$L($P(P1,"^",6))+1,10)_$E($S(+Y:$P(Y,"^",2),1:""),1,16) "RTN","PSORXVW1",90,0) .S RTS=$S($P(P1,"^",16):" RETURNED TO STOCK: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" RELEASED: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")) "RTN","PSORXVW1",91,0) .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(P1,"^",7) D ^DIC "RTN","PSORXVW1",92,0) .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_" "_RTS ;_" Entry By: "_$P(Y,"^",2) K DIC,X,Y "RTN","PSORXVW1",93,0) .S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" REMARKS: "_$P(P1,"^",3) K RTS "RTN","PSORXVW1",94,0) Q "RTN","PSORXVW1",95,0) HLD ;hold info "RTN","PSORXVW1",96,0) S DTT=$P(^PSRX(DA,"H"),"^",3) D DAT S HLDR=$P(^DD(52,99,0),"^",3),HLDR=$S($P(^PSRX(DA,"H"),"^")'>8:$P(HLDR,";",$P(^PSRX(DA,"H"),"^")),1:$P(HLDR,";",9)),HLDR=$P(HLDR,":",2) "RTN","PSORXVW1",97,0) S $P(RN," ",60)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Reason: "_HLDR_$E(RN,$L("Hold Reason: "_HLDR)+1,60)_"Hold Date: "_DAT S:$P(^PSRX(DA,"H"),"^",2)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Comments: "_$P(^PSRX(DA,"H"),"^",2) "RTN","PSORXVW1",98,0) K RN,DAT,DTT,HLDR "RTN","PSORXVW1",99,0) Q "RTN","PSORXVW1",100,0) DAT S DAT="",DTT=DTT\1 Q:DTT'?7N S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3) "RTN","PSORXVW1",101,0) Q "RTN","PSORXVW1",102,0) INST ;formats instruction from front door "RTN","PSORXVW1",103,0) I $O(^PSRX(DA,"PI",0)) D "RTN","PSORXVW1",104,0) .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Instructions:" "RTN","PSORXVW1",105,0) .S T=0 F S T=$O(^PSRX(RXN,"PI",T)) Q:'T D ;PSO*210 "RTN","PSORXVW1",106,0) ..S MIG=^PSRX(RXN,"PI",T,0) "RTN","PSORXVW1",107,0) ..D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAL",$J)),21) "RTN","PSORXVW1",108,0) K T,TY,MIG,SG "RTN","PSORXVW1",109,0) Q "RTN","PSORXVW1",110,0) PC ;displays provider comments "RTN","PSORXVW1",111,0) I $O(^PSRX(DA,"PRC",0)) D "RTN","PSORXVW1",112,0) .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Provider Comments:" "RTN","PSORXVW1",113,0) .S T=0 F S T=$O(^PSRX(RXN,"PRC",T)) Q:'T D ;PSO*210 "RTN","PSORXVW1",114,0) ..S MIG=^PSRX(RXN,"PRC",T,0) "RTN","PSORXVW1",115,0) ..D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAL",$J)),21) "RTN","PSORXVW1",116,0) K T,TY,MIG,SG "RTN","PSORXVW1",117,0) Q "RTN","PSORXVW1",118,0) DOSE ;displays dosing instruction for both simple and complex Rxs. "RTN","PSORXVW1",119,0) D DOSE^PSORXVW2 "RTN","PSORXVW1",120,0) Q "RTN","PSORXVW1",121,0) ; "RTN","PSORXVW1",122,0) HLP ; Help Text for the VIEW PRESCRIPTION prompt "RTN","PSORXVW1",123,0) W !," A prescription number or ECME number may be entered. To look-up a" "RTN","PSORXVW1",124,0) W !," prescription by the ECME number, please enter ""E."" followed by the ECME" "RTN","PSORXVW1",125,0) W !," number with or without any leading zeros." "RTN","PSORXVW1",126,0) W !!," Or just",! "RTN","PSORXVW1",127,0) D LKP("?") "RTN","PSORXVW1",128,0) Q "RTN","PSORXVW1",129,0) LKP(INPUT) ; - Peforms Lookup on the PRESCRIPTION file "RTN","PSORXVW1",130,0) N DIC,X,Y "RTN","PSORXVW1",131,0) S DIC="^PSRX(",DIC(0)="QE",D="B",X=INPUT "RTN","PSORXVW1",132,0) S DIC("S")="I $P($G(^(0)),""^"",2),$D(^(""STA"")),$P($G(^(""STA"")),""^"")'=13" "RTN","PSORXVW1",133,0) D IX^DIC "RTN","PSORXVW1",134,0) Q Y "UP",52,52.25,-1) 52^REJ "UP",52,52.25,0) 52.25 "VER") 8.0^22.0 "^DD",52,52.25,24,0) CLARIFICATION CODE^F^^0;15^K:$L(X)>8!($L(X)<1) X "^DD",52,52.25,24,3) Enter between 1 and 3 Submission Clarification Codes separated by "~". "^DD",52,52.25,24,21,0) ^^3^3^3110503^ "^DD",52,52.25,24,21,1,0) This field contains up to 3 NCPDP Clarification Codes for the reject. "^DD",52,52.25,24,21,2,0) Clarification codes are copied from the CODE (#.01) field of the BPS "^DD",52,52.25,24,21,3,0) NCPDP CLARIFICATION CODES (#9002313.25) file. "^DD",52,52.25,24,23,0) ^^2^2^3110503^ "^DD",52,52.25,24,23,1,0) Up to 3 Submission Clarification Codes can be submitted. They are stored "^DD",52,52.25,24,23,2,0) in this free text field as follows: SCC1~SCC2~SCC3 "^DD",52,52.25,24,"DT") 3110503 "^DD",52,52.25,25,0) PRIOR AUTHORIZATION TYPE^NJ2,0^^0;16^K:+X'=X!(X>99)!(X<0)!(X?.E1"."1.N) X "^DD",52,52.25,25,3) Type a number between 0 and 99, 0 decimal digits. "^DD",52,52.25,25,4) "^DD",52,52.25,25,21,0) ^^3^3^3101021^ "^DD",52,52.25,25,21,1,0) This is the Prior Authorization Type that will be sent to ECME and placed "^DD",52,52.25,25,21,2,0) in NCPDP field 461-EU (Prior Authorization Type) on the NCPDP claim that "^DD",52,52.25,25,21,3,0) is sent to the third-party payer. "^DD",52,52.25,25,"DT") 3101021 "^DD",52,52.25,28,0) DUR ADD MSG TEXT^F^^5;1^K:$L(X)>100!($L(X)<1) X "^DD",52,52.25,28,3) Answer must be 1-100 characters in length. "^DD",52,52.25,28,21,0) ^^2^2^3100827^ "^DD",52,52.25,28,21,1,0) In case of a DUR reject (#88) the 3rd party payer may return additional "^DD",52,52.25,28,21,2,0) text in the DUR Additional Message NCPDP field (570-NS). "^DD",52,52.25,28,"DT") 3100827 **INSTALL NAME** IB*2.0*435 "BLD",8106,0) IB*2.0*435^INTEGRATED BILLING^0^3110830^y "BLD",8106,1,0) ^^1^1^3101115^ "BLD",8106,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "BLD",8106,4,0) ^9.64PA^366.14^4 "BLD",8106,4,355.33,0) 355.33 "BLD",8106,4,355.33,2,0) ^9.641^355.33^1 "BLD",8106,4,355.33,2,355.33,0) INSURANCE BUFFER (File-top level) "BLD",8106,4,355.33,2,355.33,1,0) ^9.6411^.17^1 "BLD",8106,4,355.33,2,355.33,1,.17,0) BPS RESPONSE "BLD",8106,4,355.33,222) y^y^p^^^^n^^n "BLD",8106,4,355.33,224) "BLD",8106,4,356,0) 356 "BLD",8106,4,356,2,0) ^9.641^356^1 "BLD",8106,4,356,2,356,0) CLAIMS TRACKING (File-top level) "BLD",8106,4,356,2,356,1,0) ^9.6411^1.1^1 "BLD",8106,4,356,2,356,1,1.1,0) ECME NUMBER "BLD",8106,4,356,222) y^y^p^^^^n^^n "BLD",8106,4,356,224) "BLD",8106,4,366.03,0) 366.03 "BLD",8106,4,366.03,2,0) ^9.641^366.03^1 "BLD",8106,4,366.03,2,366.03,0) PLAN (File-top level) "BLD",8106,4,366.03,2,366.03,1,0) ^9.6411^10.15^2 "BLD",8106,4,366.03,2,366.03,1,10.14,0) TEST ELIGIBILITY SHEET NAME "BLD",8106,4,366.03,2,366.03,1,10.15,0) ELIGIBILITY PAYER SHEET NAME "BLD",8106,4,366.03,222) y^y^p^^^^n^^n "BLD",8106,4,366.03,224) "BLD",8106,4,366.14,0) 366.14 "BLD",8106,4,366.14,2,0) ^9.641^366.141^1 "BLD",8106,4,366.14,2,366.141,0) EVENT (sub-file) "BLD",8106,4,366.14,2,366.141,1,0) ^9.6411^.12^2 "BLD",8106,4,366.14,2,366.141,1,.12,0) BCID "BLD",8106,4,366.14,2,366.141,1,.13,0) CLAIMID "BLD",8106,4,366.14,222) y^y^p^^^^n^^n "BLD",8106,4,366.14,224) "BLD",8106,4,"APDD",355.33,355.33) "BLD",8106,4,"APDD",355.33,355.33,.17) "BLD",8106,4,"APDD",356,356) "BLD",8106,4,"APDD",356,356,1.1) "BLD",8106,4,"APDD",366.03,366.03) "BLD",8106,4,"APDD",366.03,366.03,10.14) "BLD",8106,4,"APDD",366.03,366.03,10.15) "BLD",8106,4,"APDD",366.14,366.141) "BLD",8106,4,"APDD",366.14,366.141,.12) "BLD",8106,4,"APDD",366.14,366.141,.13) "BLD",8106,4,"B",355.33,355.33) "BLD",8106,4,"B",356,356) "BLD",8106,4,"B",366.03,366.03) "BLD",8106,4,"B",366.14,366.14) "BLD",8106,6.3) 27 "BLD",8106,10,0) ^9.63^^ "BLD",8106,"ABPKG") n "BLD",8106,"INID") ^y "BLD",8106,"INIT") IBY435PO "BLD",8106,"KRN",0) ^9.67PA^779.2^20 "BLD",8106,"KRN",.4,0) .4 "BLD",8106,"KRN",.401,0) .401 "BLD",8106,"KRN",.402,0) .402 "BLD",8106,"KRN",.403,0) .403 "BLD",8106,"KRN",.5,0) .5 "BLD",8106,"KRN",.84,0) .84 "BLD",8106,"KRN",3.6,0) 3.6 "BLD",8106,"KRN",3.8,0) 3.8 "BLD",8106,"KRN",9.2,0) 9.2 "BLD",8106,"KRN",9.8,0) 9.8 "BLD",8106,"KRN",9.8,"NM",0) ^9.68A^34^32 "BLD",8106,"KRN",9.8,"NM",1,0) IBNCPBB^^0^B95588054 "BLD",8106,"KRN",9.8,"NM",2,0) IBCNRZRX^^0^B13620171 "BLD",8106,"KRN",9.8,"NM",3,0) IBCNRE4^^0^B31384444 "BLD",8106,"KRN",9.8,"NM",4,0) IBCNRPSM^^0^B12153957 "BLD",8106,"KRN",9.8,"NM",5,0) IBNCPDP^^0^B5486206 "BLD",8106,"KRN",9.8,"NM",6,0) IBCNRU1^^0^B36756107 "BLD",8106,"KRN",9.8,"NM",7,0) IBNCPDP1^^0^B138462172 "BLD",8106,"KRN",9.8,"NM",8,0) IBNCPDP2^^0^B72289199 "BLD",8106,"KRN",9.8,"NM",9,0) IBCNSM^^0^B22946232 "BLD",8106,"KRN",9.8,"NM",10,0) IBNCPIV^^0^B54267861 "BLD",8106,"KRN",9.8,"NM",11,0) IBCNRHLT^^0^B14102069 "BLD",8106,"KRN",9.8,"NM",13,0) IBNCPDP3^^0^B84836012 "BLD",8106,"KRN",9.8,"NM",14,0) IBCNBLL^^0^B101908545 "BLD",8106,"KRN",9.8,"NM",15,0) IBCNBLE1^^0^B30221340 "BLD",8106,"KRN",9.8,"NM",16,0) IBCNEUT2^^0^B3063599 "BLD",8106,"KRN",9.8,"NM",17,0) IBCNEDE1^^0^B40267278 "BLD",8106,"KRN",9.8,"NM",18,0) IBCNBLE^^0^B79037653 "BLD",8106,"KRN",9.8,"NM",19,0) IBCNBLE2^^0^B76745962 "BLD",8106,"KRN",9.8,"NM",20,0) IBNCPDPU^^0^B95492067 "BLD",8106,"KRN",9.8,"NM",21,0) IBNCPEV^^0^B84626765 "BLD",8106,"KRN",9.8,"NM",22,0) IBOSCDC^^0^B46120180 "BLD",8106,"KRN",9.8,"NM",23,0) IBNCPDPE^^0^B17708957 "BLD",8106,"KRN",9.8,"NM",24,0) IBJTU2^^0^B10638422 "BLD",8106,"KRN",9.8,"NM",25,0) IBJTRX^^0^B61346654 "BLD",8106,"KRN",9.8,"NM",26,0) IBNCPDPI^^0^B13081373 "BLD",8106,"KRN",9.8,"NM",27,0) IBNCPDP4^^0^B55438909 "BLD",8106,"KRN",9.8,"NM",29,0) IBRFN^^0^B63404251 "BLD",8106,"KRN",9.8,"NM",30,0) IBNCPDPC^^0^B4153613 "BLD",8106,"KRN",9.8,"NM",31,0) IBNCPLOG^^0^B64598922 "BLD",8106,"KRN",9.8,"NM",32,0) IBNCPEV1^^0^B49201751 "BLD",8106,"KRN",9.8,"NM",33,0) IBOSCDC1^^0^B17703191 "BLD",8106,"KRN",9.8,"NM",34,0) IBNCPUT3^^0^B15136080 "BLD",8106,"KRN",9.8,"NM","B","IBCNBLE",18) "BLD",8106,"KRN",9.8,"NM","B","IBCNBLE1",15) "BLD",8106,"KRN",9.8,"NM","B","IBCNBLE2",19) "BLD",8106,"KRN",9.8,"NM","B","IBCNBLL",14) "BLD",8106,"KRN",9.8,"NM","B","IBCNEDE1",17) "BLD",8106,"KRN",9.8,"NM","B","IBCNEUT2",16) "BLD",8106,"KRN",9.8,"NM","B","IBCNRE4",3) "BLD",8106,"KRN",9.8,"NM","B","IBCNRHLT",11) "BLD",8106,"KRN",9.8,"NM","B","IBCNRPSM",4) "BLD",8106,"KRN",9.8,"NM","B","IBCNRU1",6) "BLD",8106,"KRN",9.8,"NM","B","IBCNRZRX",2) "BLD",8106,"KRN",9.8,"NM","B","IBCNSM",9) "BLD",8106,"KRN",9.8,"NM","B","IBJTRX",25) "BLD",8106,"KRN",9.8,"NM","B","IBJTU2",24) "BLD",8106,"KRN",9.8,"NM","B","IBNCPBB",1) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDP",5) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDP1",7) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDP2",8) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDP3",13) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDP4",27) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDPC",30) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDPE",23) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDPI",26) "BLD",8106,"KRN",9.8,"NM","B","IBNCPDPU",20) "BLD",8106,"KRN",9.8,"NM","B","IBNCPEV",21) "BLD",8106,"KRN",9.8,"NM","B","IBNCPEV1",32) "BLD",8106,"KRN",9.8,"NM","B","IBNCPIV",10) "BLD",8106,"KRN",9.8,"NM","B","IBNCPLOG",31) "BLD",8106,"KRN",9.8,"NM","B","IBNCPUT3",34) "BLD",8106,"KRN",9.8,"NM","B","IBOSCDC",22) "BLD",8106,"KRN",9.8,"NM","B","IBOSCDC1",33) "BLD",8106,"KRN",9.8,"NM","B","IBRFN",29) "BLD",8106,"KRN",19,0) 19 "BLD",8106,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",8106,"KRN",19,"NM",1,0) IBCNR ELIGIBILITY INQUIRY^^0 "BLD",8106,"KRN",19,"NM",2,0) IBCNR E-PHARMACY MENU^^2 "BLD",8106,"KRN",19,"NM","B","IBCNR E-PHARMACY MENU",2) "BLD",8106,"KRN",19,"NM","B","IBCNR ELIGIBILITY INQUIRY",1) "BLD",8106,"KRN",19.1,0) 19.1 "BLD",8106,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",8106,"KRN",101,0) 101 "BLD",8106,"KRN",101,"NM",0) ^9.68A^39^39 "BLD",8106,"KRN",101,"NM",1,0) IBNCPDP INS ELIG VER INQ MENU^^0 "BLD",8106,"KRN",101,"NM",2,0) IBNCPDP VIEW EXP POL^^4^ "BLD",8106,"KRN",101,"NM",3,0) IBNCPDP QUIT^^4^ "BLD",8106,"KRN",101,"NM",4,0) IBNCPDP INS ELIG SEND^^0 "BLD",8106,"KRN",101,"NM",5,0) IBNCPDP INS ELIG EFF DATE^^0 "BLD",8106,"KRN",101,"NM",6,0) IBNCPDP INS ELIG TOGGLE^^0 "BLD",8106,"KRN",101,"NM",7,0) IBNCPDP INS ELIG PAT^^0 "BLD",8106,"KRN",101,"NM",8,0) IBCNB LIST EPHARMACY VIEW^^0 "BLD",8106,"KRN",101,"NM",9,0) IBCNB LIST SCREEN MENU^^0 "BLD",8106,"KRN",101,"NM",10,0) IBCNB FAST EXIT^^0^ "BLD",8106,"KRN",101,"NM",11,0) IBJT CLAIM SCREEN MENU^^0 "BLD",8106,"KRN",101,"NM",12,0) IBJT BILL CHARGES SCREEN^^0 "BLD",8106,"KRN",101,"NM",13,0) IBJT BILL DX SCREEN^^0 "BLD",8106,"KRN",101,"NM",14,0) IBJT BILL PROCEDURES SCREEN^^0 "BLD",8106,"KRN",101,"NM",15,0) IBJT CHANGE BILL^^0 "BLD",8106,"KRN",101,"NM",16,0) IBJT AR ACCOUNT PROFILE SCREEN^^0 "BLD",8106,"KRN",101,"NM",17,0) IBJT CT/IR COMMUNICATIONS LIST SCREEN^^0 "BLD",8106,"KRN",101,"NM",18,0) IBJT AR COMMENT HISTORY SCREEN^^0 "BLD",8106,"KRN",101,"NM",19,0) IBJT HS HEALTH SUMMARY^^0 "BLD",8106,"KRN",101,"NM",20,0) IBJT ACTIVE LIST SCREEN SKIP^^0 "BLD",8106,"KRN",101,"NM",21,0) IBJT NS VIEW INS CO SCREEN^^0 "BLD",8106,"KRN",101,"NM",22,0) IBJT NS VIEW EXP POL SCREEN^^0 "BLD",8106,"KRN",101,"NM",23,0) IBJT NS VIEW AN BEN SCREEN^^0 "BLD",8106,"KRN",101,"NM",24,0) IBJT PT ELIGIBILITY SCREEN^^0 "BLD",8106,"KRN",101,"NM",25,0) IBJ EXIT^^0 "BLD",8106,"KRN",101,"NM",26,0) IBJT EDI STATUS SCREEN^^0 "BLD",8106,"KRN",101,"NM",27,0) IBCNE JT VIEW EXP ELIG BEN SCREEN^^0 "BLD",8106,"KRN",101,"NM",28,0) IBJT ECME RESP INFO SCREEN^^0 "BLD",8106,"KRN",101,"NM",29,0) IBCNB LIST PROCESS SCREEN^^0 "BLD",8106,"KRN",101,"NM",30,0) IBCNB LIST REJECT^^0 "BLD",8106,"KRN",101,"NM",31,0) IBCNB LIST ENTRY SCREEN^^0 "BLD",8106,"KRN",101,"NM",32,0) IBCNB LIST ADD^^0 "BLD",8106,"KRN",101,"NM",33,0) IBCNB LIST SORT^^0 "BLD",8106,"KRN",101,"NM",34,0) IBCNB LIST CHECK NAMES^^0 "BLD",8106,"KRN",101,"NM",35,0) IBCNB LIST POSITIVE VIEW^^0 "BLD",8106,"KRN",101,"NM",36,0) IBCNB LIST NEGATIVE VIEW^^0 "BLD",8106,"KRN",101,"NM",37,0) IBCNB LIST MEDICARE VIEW^^0 "BLD",8106,"KRN",101,"NM",38,0) IBCNB LIST APPOINTMENTS VIEW^^0 "BLD",8106,"KRN",101,"NM",39,0) IBJT ECME RESP INFO MENU^^0 "BLD",8106,"KRN",101,"NM","B","IBCNB FAST EXIT",10) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST ADD",32) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST APPOINTMENTS VIEW",38) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST CHECK NAMES",34) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST ENTRY SCREEN",31) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST EPHARMACY VIEW",8) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST MEDICARE VIEW",37) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST NEGATIVE VIEW",36) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST POSITIVE VIEW",35) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST PROCESS SCREEN",29) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST REJECT",30) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST SCREEN MENU",9) "BLD",8106,"KRN",101,"NM","B","IBCNB LIST SORT",33) "BLD",8106,"KRN",101,"NM","B","IBCNE JT VIEW EXP ELIG BEN SCREEN",27) "BLD",8106,"KRN",101,"NM","B","IBJ EXIT",25) "BLD",8106,"KRN",101,"NM","B","IBJT ACTIVE LIST SCREEN SKIP",20) "BLD",8106,"KRN",101,"NM","B","IBJT AR ACCOUNT PROFILE SCREEN",16) "BLD",8106,"KRN",101,"NM","B","IBJT AR COMMENT HISTORY SCREEN",18) "BLD",8106,"KRN",101,"NM","B","IBJT BILL CHARGES SCREEN",12) "BLD",8106,"KRN",101,"NM","B","IBJT BILL DX SCREEN",13) "BLD",8106,"KRN",101,"NM","B","IBJT BILL PROCEDURES SCREEN",14) "BLD",8106,"KRN",101,"NM","B","IBJT CHANGE BILL",15) "BLD",8106,"KRN",101,"NM","B","IBJT CLAIM SCREEN MENU",11) "BLD",8106,"KRN",101,"NM","B","IBJT CT/IR COMMUNICATIONS LIST SCREEN",17) "BLD",8106,"KRN",101,"NM","B","IBJT ECME RESP INFO MENU",39) "BLD",8106,"KRN",101,"NM","B","IBJT ECME RESP INFO SCREEN",28) "BLD",8106,"KRN",101,"NM","B","IBJT EDI STATUS SCREEN",26) "BLD",8106,"KRN",101,"NM","B","IBJT HS HEALTH SUMMARY",19) "BLD",8106,"KRN",101,"NM","B","IBJT NS VIEW AN BEN SCREEN",23) "BLD",8106,"KRN",101,"NM","B","IBJT NS VIEW EXP POL SCREEN",22) "BLD",8106,"KRN",101,"NM","B","IBJT NS VIEW INS CO SCREEN",21) "BLD",8106,"KRN",101,"NM","B","IBJT PT ELIGIBILITY SCREEN",24) "BLD",8106,"KRN",101,"NM","B","IBNCPDP INS ELIG EFF DATE",5) "BLD",8106,"KRN",101,"NM","B","IBNCPDP INS ELIG PAT",7) "BLD",8106,"KRN",101,"NM","B","IBNCPDP INS ELIG SEND",4) "BLD",8106,"KRN",101,"NM","B","IBNCPDP INS ELIG TOGGLE",6) "BLD",8106,"KRN",101,"NM","B","IBNCPDP INS ELIG VER INQ MENU",1) "BLD",8106,"KRN",101,"NM","B","IBNCPDP QUIT",3) "BLD",8106,"KRN",101,"NM","B","IBNCPDP VIEW EXP POL",2) "BLD",8106,"KRN",409.61,0) 409.61 "BLD",8106,"KRN",409.61,"NM",0) ^9.68A^2^2 "BLD",8106,"KRN",409.61,"NM",1,0) IBNCPDP INS ELIG VER INQ^^0 "BLD",8106,"KRN",409.61,"NM",2,0) IBJT ECME RESP INFO^^0 "BLD",8106,"KRN",409.61,"NM","B","IBJT ECME RESP INFO",2) "BLD",8106,"KRN",409.61,"NM","B","IBNCPDP INS ELIG VER INQ",1) "BLD",8106,"KRN",771,0) 771 "BLD",8106,"KRN",779.2,0) 779.2 "BLD",8106,"KRN",870,0) 870 "BLD",8106,"KRN",8989.51,0) 8989.51 "BLD",8106,"KRN",8989.52,0) 8989.52 "BLD",8106,"KRN",8994,0) 8994 "BLD",8106,"KRN","B",.4,.4) "BLD",8106,"KRN","B",.401,.401) "BLD",8106,"KRN","B",.402,.402) "BLD",8106,"KRN","B",.403,.403) "BLD",8106,"KRN","B",.5,.5) "BLD",8106,"KRN","B",.84,.84) "BLD",8106,"KRN","B",3.6,3.6) "BLD",8106,"KRN","B",3.8,3.8) "BLD",8106,"KRN","B",9.2,9.2) "BLD",8106,"KRN","B",9.8,9.8) "BLD",8106,"KRN","B",19,19) "BLD",8106,"KRN","B",19.1,19.1) "BLD",8106,"KRN","B",101,101) "BLD",8106,"KRN","B",409.61,409.61) "BLD",8106,"KRN","B",771,771) "BLD",8106,"KRN","B",779.2,779.2) "BLD",8106,"KRN","B",870,870) "BLD",8106,"KRN","B",8989.51,8989.51) "BLD",8106,"KRN","B",8989.52,8989.52) "BLD",8106,"KRN","B",8994,8994) "BLD",8106,"QUES",0) ^9.62^^ "BLD",8106,"REQB",0) ^9.611^3^2 "BLD",8106,"REQB",2,0) IB*2.0*437^2 "BLD",8106,"REQB",3,0) IB*2.0*438^2 "BLD",8106,"REQB","B","IB*2.0*437",2) "BLD",8106,"REQB","B","IB*2.0*438",3) "FIA",355.33) INSURANCE BUFFER "FIA",355.33,0) ^IBA(355.33, "FIA",355.33,0,0) 355.33DA "FIA",355.33,0,1) y^y^p^^^^n^^n "FIA",355.33,0,10) "FIA",355.33,0,11) "FIA",355.33,0,"RLRO") "FIA",355.33,0,"VR") 2.0^IB "FIA",355.33,355.33) 1 "FIA",355.33,355.33,.17) "FIA",356) CLAIMS TRACKING "FIA",356,0) ^IBT(356, "FIA",356,0,0) 356I "FIA",356,0,1) y^y^p^^^^n^^n "FIA",356,0,10) "FIA",356,0,11) "FIA",356,0,"RLRO") "FIA",356,0,"VR") 2.0^IB "FIA",356,356) 1 "FIA",356,356,1.1) "FIA",366.03) PLAN "FIA",366.03,0) ^IBCNR(366.03, "FIA",366.03,0,0) 366.03I "FIA",366.03,0,1) y^y^p^^^^n^^n "FIA",366.03,0,10) "FIA",366.03,0,11) "FIA",366.03,0,"RLRO") "FIA",366.03,0,"VR") 2.0^IB "FIA",366.03,366.03) 1 "FIA",366.03,366.03,10.14) "FIA",366.03,366.03,10.15) "FIA",366.14) IB NCPDP EVENT LOG "FIA",366.14,0) ^IBCNR(366.14, "FIA",366.14,0,0) 366.14D "FIA",366.14,0,1) y^y^p^^^^n^^n "FIA",366.14,0,10) "FIA",366.14,0,11) "FIA",366.14,0,"RLRO") "FIA",366.14,0,"VR") 2.0^IB "FIA",366.14,366.14) 1 "FIA",366.14,366.141) 1 "FIA",366.14,366.141,.12) "FIA",366.14,366.141,.13) "INIT") IBY435PO "KRN",19,12305,-1) 2^2 "KRN",19,12305,0) IBCNR E-PHARMACY MENU^e-Pharmacy Menu^^M^539^^^^^^^200 "KRN",19,12305,10,0) ^19.01IP^17^17 "KRN",19,12305,10,17,0) 13426^EPH "KRN",19,12305,10,17,"^") IBCNR ELIGIBILITY INQUIRY "KRN",19,12305,"U") E-PHARMACY MENU "KRN",19,13426,-1) 0^1 "KRN",19,13426,0) IBCNR ELIGIBILITY INQUIRY^Initiate e-Pharmacy Eligibility Inquiry^^R^^^^^^^^INTEGRATED BILLING "KRN",19,13426,1,0) ^^2^2^3100930^ "KRN",19,13426,1,1,0) This option allows a user to perform electronic ePharmacy insurance "KRN",19,13426,1,2,0) eligibility verification for valid ePharmacy insurance policies. "KRN",19,13426,25) EN^IBNCPIV "KRN",19,13426,"U") INITIATE E-PHARMACY ELIGIBILIT "KRN",101,39,-1) 0^4 "KRN",101,39,0) IBNCPDP INS ELIG SEND^Send Rx Ins Inquiry^^A^^^^^^^^ "KRN",101,39,20) D SEND^IBNCPIV "KRN",101,39,99) 62097,65030 "KRN",101,40,-1) 0^5 "KRN",101,40,0) IBNCPDP INS ELIG EFF DATE^Modify Effective Date^^A^^^^^^^^ "KRN",101,40,20) D CHGD^IBNCPIV "KRN",101,40,99) 62097,65030 "KRN",101,41,-1) 0^1 "KRN",101,41,0) IBNCPDP INS ELIG VER INQ MENU^Patient Insurance^^M^^^^^^^^ "KRN",101,41,4) 40^4 "KRN",101,41,10,0) ^101.01PA^6^6 "KRN",101,41,10,1,0) 4039^VP^2^ "KRN",101,41,10,1,"^") IBNCPDP VIEW EXP POL "KRN",101,41,10,2,0) 4040^EX^6^ "KRN",101,41,10,2,"^") IBNCPDP QUIT "KRN",101,41,10,3,0) 39^RX^1^ "KRN",101,41,10,3,"^") IBNCPDP INS ELIG SEND "KRN",101,41,10,4,0) 40^DT^4^ "KRN",101,41,10,4,"^") IBNCPDP INS ELIG EFF DATE "KRN",101,41,10,5,0) 42^AL^5^ "KRN",101,41,10,5,"^") IBNCPDP INS ELIG TOGGLE "KRN",101,41,10,6,0) 43^CP^3^ "KRN",101,41,10,6,"^") IBNCPDP INS ELIG PAT "KRN",101,41,15) I $G(IBFASTXT) S VALMBCK="Q" "KRN",101,41,20) K IBFASTXT "KRN",101,41,26) D SHOW^VALM "KRN",101,41,28) Select Action: "KRN",101,41,99) 62175,62393 "KRN",101,42,-1) 0^6 "KRN",101,42,0) IBNCPDP INS ELIG TOGGLE^All/Rx Only Ins Policies^^A^^^^^^^^ "KRN",101,42,20) D TOGGLE^IBNCPIV "KRN",101,42,99) 62097,65030 "KRN",101,43,-1) 0^7 "KRN",101,43,0) IBNCPDP INS ELIG PAT^Change Patient^^A^^^^^^^^ "KRN",101,43,20) D CP^IBNCPIV "KRN",101,43,99) 62097,65030 "KRN",101,45,-1) 0^27 "KRN",101,45,0) IBCNE JT VIEW EXP ELIG BEN SCREEN^Expand Benefits^^A^^^^^^^^INTEGRATED BILLING "KRN",101,45,1,0) ^^2^2^3090925^ "KRN",101,45,1,1,0) This is the action protocol for the Expanded eligibility/benefits screen "KRN",101,45,1,2,0) used from TPJI - Third Party Joint Inquiry. "KRN",101,45,20) D EBJT^IBCNES2 "KRN",101,45,99) 62097,65030 "KRN",101,60,-1) 0^35 "KRN",101,60,0) IBCNB LIST POSITIVE VIEW^Pos. Buffer^^A^^^^^^^^INSURANCE MANAGEMENT "KRN",101,60,1,0) ^^1^1^3091012^ "KRN",101,60,1,1,0) Positive Buffer View. "KRN",101,60,20) K IBCNSORT D EN1^IBCNBLL(1) "KRN",101,60,99) 62097,65030 "KRN",101,76,-1) 0^36 "KRN",101,76,0) IBCNB LIST NEGATIVE VIEW^Neg. Buffer^^A^^^^^^^^INSURANCE MANAGEMENT "KRN",101,76,1,0) ^^1^1^3091012^ "KRN",101,76,1,1,0) Negative Buffer View. "KRN",101,76,20) K IBCNSORT D EN1^IBCNBLL(2) "KRN",101,76,99) 62097,65030 "KRN",101,92,-1) 0^37 "KRN",101,92,0) IBCNB LIST MEDICARE VIEW^Medicare Buffer^^A^^^^^^^^INSURANCE MANAGEMENT "KRN",101,92,1,0) ^^1^1^3091012^ "KRN",101,92,1,1,0) Medicare Buffer View. "KRN",101,92,20) K IBCNSORT D EN1^IBCNBLL(3) "KRN",101,92,99) 62097,65030 "KRN",101,161,-1) 0^38 "KRN",101,161,0) IBCNB LIST APPOINTMENTS VIEW^Future Appts.^^A^^^^^^^^INSURANCE MANAGEMENT "KRN",101,161,1,0) ^101.06^1^1^3100715^^ "KRN",101,161,1,1,0) Appointments Buffer View. "KRN",101,161,20) K IBCNSORT D EN1^IBCNBLL(4) "KRN",101,161,99) 62097,65030 "KRN",101,163,-1) 0^8 "KRN",101,163,0) IBCNB LIST EPHARMACY VIEW^ePharm Buffer^^A^^^^^^^^INSURANCE MANAGEMENT "KRN",101,163,20) K IBCNSORT D EN1^IBCNBLL(5) "KRN",101,163,99) 62097,65030 "KRN",101,164,-1) 0^28 "KRN",101,164,0) IBJT ECME RESP INFO SCREEN^ECME Information^^A^^^^^^^^INTEGRATED BILLING "KRN",101,164,1,0) ^^3^3^3101022^ "KRN",101,164,1,1,0) This is the action protocol used in TPJI - Third Party Joint Inquiry - "KRN",101,164,1,2,0) for the display of ECME response information for e-Pharmacy claims and "KRN",101,164,1,3,0) prescriptions. "KRN",101,164,20) D EN^IBJTRX "KRN",101,164,99) 62097,65030 "KRN",101,165,-1) 0^39 "KRN",101,165,0) IBJT ECME RESP INFO MENU^ECME claim information menu^^M^^^^^^^^INTEGRATED BILLING "KRN",101,165,4) 26^4 "KRN",101,165,10,0) ^101.01PA^1^1 "KRN",101,165,10,1,0) 1121^EX^^ "KRN",101,165,10,1,"^") IBJ EXIT "KRN",101,165,15) I $G(IBFASTXT) S VALMBCK="Q" "KRN",101,165,20) K IBFASTXT "KRN",101,165,26) D SHOW^VALM "KRN",101,165,28) Select Action: "KRN",101,165,99) 62332,60648 "KRN",101,1097,-1) 0^11 "KRN",101,1097,0) IBJT CLAIM SCREEN MENU^Claim Information Menu^^M^^^^^^^^INTEGRATED BILLING "KRN",101,1097,4) 26^4 "KRN",101,1097,10,0) ^101.01PA^18^17 "KRN",101,1097,10,1,0) 1129^BC^11^ "KRN",101,1097,10,1,"^") IBJT BILL CHARGES SCREEN "KRN",101,1097,10,2,0) 1130^DX^12^ "KRN",101,1097,10,2,"^") IBJT BILL DX SCREEN "KRN",101,1097,10,3,0) 1131^PR^13^ "KRN",101,1097,10,3,"^") IBJT BILL PROCEDURES SCREEN "KRN",101,1097,10,4,0) 1139^CB^14^ "KRN",101,1097,10,4,"^") IBJT CHANGE BILL "KRN",101,1097,10,5,0) 1132^AR^21^ "KRN",101,1097,10,5,"^") IBJT AR ACCOUNT PROFILE SCREEN "KRN",101,1097,10,6,0) 1144^CM^22^ "KRN",101,1097,10,6,"^") IBJT AR COMMENT HISTORY SCREEN "KRN",101,1097,10,7,0) 1141^IR^23^ "KRN",101,1097,10,7,"^") IBJT CT/IR COMMUNICATIONS LIST SCREEN "KRN",101,1097,10,8,0) 1143^HS^24^ "KRN",101,1097,10,8,"^") IBJT HS HEALTH SUMMARY "KRN",101,1097,10,9,0) 1135^AL^25^ "KRN",101,1097,10,9,"^") IBJT ACTIVE LIST SCREEN SKIP "KRN",101,1097,10,10,0) 1126^VI^31^ "KRN",101,1097,10,10,"^") IBJT NS VIEW INS CO SCREEN "KRN",101,1097,10,11,0) 1127^VP^32^ "KRN",101,1097,10,11,"^") IBJT NS VIEW EXP POL SCREEN "KRN",101,1097,10,12,0) 1128^AB^33^ "KRN",101,1097,10,12,"^") IBJT NS VIEW AN BEN SCREEN "KRN",101,1097,10,13,0) 1140^EL^34^ "KRN",101,1097,10,13,"^") IBJT PT ELIGIBILITY SCREEN "KRN",101,1097,10,14,0) 1121^EX^26^ "KRN",101,1097,10,14,"^") IBJ EXIT "KRN",101,1097,10,15,0) 3132^ED^15^ "KRN",101,1097,10,15,"^") IBJT EDI STATUS SCREEN "KRN",101,1097,10,16,0) 45^EB^35^ "KRN",101,1097,10,16,"^") IBCNE JT VIEW EXP ELIG BEN SCREEN "KRN",101,1097,10,18,0) 164^RX^16^ "KRN",101,1097,10,18,"^") IBJT ECME RESP INFO SCREEN "KRN",101,1097,15) I $G(IBFASTXT)>3 S VALMBCK="Q" "KRN",101,1097,20) K IBFASTXT "KRN",101,1097,26) D BM^IBJU1(21,16),SHOW^VALM "KRN",101,1097,28) Select Action: "KRN",101,1097,99) 62332,60648 "KRN",101,1121,-1) 0^25 "KRN",101,1121,0) IBJ EXIT^Exit^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1121,20) D FASTEXIT^IBJU1 "KRN",101,1121,99) 62332,60648 "KRN",101,1126,-1) 0^21 "KRN",101,1126,0) IBJT NS VIEW INS CO SCREEN^Insurance Company^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1126,15) "KRN",101,1126,20) I '$$PRVSCR^IBJTU1("IBCNSC") D VI^IBJTNA(0) "KRN",101,1126,99) 62097,65031 "KRN",101,1127,-1) 0^22 "KRN",101,1127,0) IBJT NS VIEW EXP POL SCREEN^Policy^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1127,15) "KRN",101,1127,20) I '$$PRVSCR^IBJTU1("IBCNSVP") D VP^IBJTNB(0) "KRN",101,1127,99) 62097,65031 "KRN",101,1128,-1) 0^23 "KRN",101,1128,0) IBJT NS VIEW AN BEN SCREEN^Annual Benefits^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1128,15) "KRN",101,1128,20) I '$$PRVSCR^IBJTU1("IBCNSA") D AB^IBJTNB(0) "KRN",101,1128,99) 62097,65031 "KRN",101,1129,-1) 0^12 "KRN",101,1129,0) IBJT BILL CHARGES SCREEN^Bill Charges^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1129,15) "KRN",101,1129,20) I '$$PRVSCR^IBJTU1("IBJTBA") D EN^IBJTBA "KRN",101,1129,99) 62097,65031 "KRN",101,1130,-1) 0^13 "KRN",101,1130,0) IBJT BILL DX SCREEN^Bill Diagnosis^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1130,15) "KRN",101,1130,20) I '$$PRVSCR^IBJTU1("IBJTBB") D EN^IBJTBB "KRN",101,1130,99) 62097,65031 "KRN",101,1131,-1) 0^14 "KRN",101,1131,0) IBJT BILL PROCEDURES SCREEN^Bill Procedures^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1131,15) "KRN",101,1131,20) I '$$PRVSCR^IBJTU1("IBJTBC") D EN^IBJTBC "KRN",101,1131,99) 62097,65031 "KRN",101,1132,-1) 0^16 "KRN",101,1132,0) IBJT AR ACCOUNT PROFILE SCREEN^Account Profile^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1132,20) I '$$PRVSCR^IBJTU1("IBJTTA") D EN^IBJTTA "KRN",101,1132,99) 62097,65031 "KRN",101,1135,-1) 0^20 "KRN",101,1135,0) IBJT ACTIVE LIST SCREEN SKIP^Go to Active List^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1135,20) S:'$G(IBNOTPJI) IBFASTXT=4 Q:'$G(IBNOTPJI) D FULL^VALM1 W !!,*7,"This action is not available for the current path into TPJI" S VALMBCK="R" N DIR S DIR(0)="E" D ^DIR W ! "KRN",101,1135,99) 62097,65031 "KRN",101,1139,-1) 0^15 "KRN",101,1139,0) IBJT CHANGE BILL^Change Bill^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1139,20) D CB^IBJTA1 "KRN",101,1139,99) 62097,65031 "KRN",101,1140,-1) 0^24 "KRN",101,1140,0) IBJT PT ELIGIBILITY SCREEN^Patient Eligibility^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1140,20) I '$$PRVSCR^IBJTU1("IBJTEA") D EN^IBJTEA "KRN",101,1140,99) 62097,65031 "KRN",101,1141,-1) 0^17 "KRN",101,1141,0) IBJT CT/IR COMMUNICATIONS LIST SCREEN^Insurance Reviews^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1141,20) I '$$PRVSCR^IBJTU1("IBJTRA") D EN^IBJTRA "KRN",101,1141,99) 62097,65031 "KRN",101,1143,-1) 0^19 "KRN",101,1143,0) IBJT HS HEALTH SUMMARY^Health Summary^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1143,20) D HS^IBJTA1 "KRN",101,1143,99) 62097,65031 "KRN",101,1144,-1) 0^18 "KRN",101,1144,0) IBJT AR COMMENT HISTORY SCREEN^Comment History^^A^^^^^^^^INTEGRATED BILLING "KRN",101,1144,20) I '$$PRVSCR^IBJTU1("IBJTTC") D EN^IBJTTC "KRN",101,1144,99) 62097,65031 "KRN",101,2394,-1) 0^9 "KRN",101,2394,0) IBCNB LIST SCREEN MENU^List Menu^^M^^^^^^^^INTEGRATED BILLING "KRN",101,2394,4) 20^3 "KRN",101,2394,10,0) ^101.01PA^12^12 "KRN",101,2394,10,1,0) 2398^PE^11^ "KRN",101,2394,10,1,"^") IBCNB LIST PROCESS SCREEN "KRN",101,2394,10,2,0) 2397^RE^12^ "KRN",101,2394,10,2,"^") IBCNB LIST REJECT "KRN",101,2394,10,3,0) 2396^EE^13^ "KRN",101,2394,10,3,"^") IBCNB LIST ENTRY SCREEN "KRN",101,2394,10,4,0) 2412^AE^21^ "KRN",101,2394,10,4,"^") IBCNB LIST ADD "KRN",101,2394,10,5,0) 2395^ST^22^ "KRN",101,2394,10,5,"^") IBCNB LIST SORT "KRN",101,2394,10,6,0) 2408^EX^43^ "KRN",101,2394,10,6,"^") IBCNB FAST EXIT "KRN",101,2394,10,7,0) 3583^CC^23^ "KRN",101,2394,10,7,"^") IBCNB LIST CHECK NAMES "KRN",101,2394,10,8,0) 60^PB^31^ "KRN",101,2394,10,8,"^") IBCNB LIST POSITIVE VIEW "KRN",101,2394,10,9,0) 76^NB^32^ "KRN",101,2394,10,9,"^") IBCNB LIST NEGATIVE VIEW "KRN",101,2394,10,10,0) 92^MB^33^ "KRN",101,2394,10,10,"^") IBCNB LIST MEDICARE VIEW "KRN",101,2394,10,11,0) 161^FA^41^ "KRN",101,2394,10,11,"^") IBCNB LIST APPOINTMENTS VIEW "KRN",101,2394,10,12,0) 163^RX^42^ "KRN",101,2394,10,12,"^") IBCNB LIST EPHARMACY VIEW "KRN",101,2394,15) I $D(IBFASTXT) S VALMBCK="Q" "KRN",101,2394,20) K IBFASTXT "KRN",101,2394,24) I 1 X:$D(^ORD(101,+$P(^ORD(101,DA(1),10,DA,0),"^"),24)) ^(24) "KRN",101,2394,26) D SHOW^VALM "KRN",101,2394,28) Select Action: "KRN",101,2394,99) 62157,55766 "KRN",101,2395,-1) 0^33 "KRN",101,2395,0) IBCNB LIST SORT^Sort List^^A^^^^^^^^INTEGRATED BILLING "KRN",101,2395,20) D SELSORT^IBCNBLA "KRN",101,2395,99) 62097,65032 "KRN",101,2396,-1) 0^31 "KRN",101,2396,0) IBCNB LIST ENTRY SCREEN^Expand Entry^^A^^^^^^^^INTEGRATED BILLING "KRN",101,2396,20) D LNXTSCRN^IBCNBLA("IBCNB INSURANCE BUFFER ENTRY","IBCNBLLX",AVIEW) "KRN",101,2396,99) 62097,65032 "KRN",101,2397,-1) 0^30 "KRN",101,2397,0) IBCNB LIST REJECT^Reject Entry^^A^^^^^^^^INTEGRATED BILLING "KRN",101,2397,20) D LREJECT^IBCNBLA("IBCNBLLX") "KRN",101,2397,24) I $D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ)) "KRN",101,2397,99) 62097,65032 "KRN",101,2398,-1) 0^29 "KRN",101,2398,0) IBCNB LIST PROCESS SCREEN^Process Entry^^A^^^^^^^^INTEGRATED BILLING "KRN",101,2398,10,0) ^101.01PA "KRN",101,2398,15) "KRN",101,2398,20) D LNXTSCRN^IBCNBLA("IBCNB INSURANCE BUFFER PROCESS","IBCNBLLX",AVIEW) "KRN",101,2398,99) 62097,65032 "KRN",101,2408,-1) 0^10 "KRN",101,2408,0) IBCNB FAST EXIT^Exit^^A^^^^^^^^INTEGRATED BILLING "KRN",101,2408,20) D FASTEXIT^IBCNBLA "KRN",101,2408,99) 62097,65032 "KRN",101,2412,-1) 0^32 "KRN",101,2412,0) IBCNB LIST ADD^Add Entry^^A^^^^^^^^INTEGRATED BILLING "KRN",101,2412,20) D ADDBUF^IBCNBLA1 "KRN",101,2412,99) 62097,65032 "KRN",101,3132,-1) 0^26 "KRN",101,3132,0) IBJT EDI STATUS SCREEN^EDI Status^^A^^^^^^^^INTEGRATED BILLING "KRN",101,3132,1,0) ^101.06^2^2^3010516^^^^ "KRN",101,3132,1,1,0) This action is used to display latest status message, return message "KRN",101,3132,1,2,0) and transmit message for a selected bill. "KRN",101,3132,20) I '$$PRVSCR^IBJTU1("IBJTED") D EN^IBJTED "KRN",101,3132,99) 62097,65033 "KRN",101,3583,-1) 0^34 "KRN",101,3583,0) IBCNB LIST CHECK NAMES^Check Ins Co's^^A^^^^^^^^INTEGRATED BILLING "KRN",101,3583,1,0) ^101.06^3^3^3020620^^ "KRN",101,3583,1,1,0) This action protocol will allow the user to see what insurance company "KRN",101,3583,1,2,0) names in the buffer are bad and allow for correction with the Auto Match "KRN",101,3583,1,3,0) utility. "KRN",101,3583,20) D AMCHK^IBCNBLA "KRN",101,3583,99) 62097,65033 "KRN",101,4039,-1) 4^2 "KRN",101,4039,0) IBNCPDP VIEW EXP POL "KRN",101,4040,-1) 4^3 "KRN",101,4040,0) IBNCPDP QUIT "KRN",409.61,888,-1) 0^1 "KRN",409.61,888,0) IBNCPDP INS ELIG VER INQ^1^^160^7^19^1^1^Policy^IBNCPDP INS ELIG VER INQ MENU^Rx Eligibility Verification^1^^1 "KRN",409.61,888,1) ^VALM HIDDEN ACTIONS "KRN",409.61,888,"ARRAY") ^TMP("IBNSM",$J) "KRN",409.61,888,"COL",0) ^409.621^14^14 "KRN",409.61,888,"COL",1,0) NUMBER^1^4 "KRN",409.61,888,"COL",2,0) NAME^5^15^Insurance Co.^^1 "KRN",409.61,888,"COL",3,0) TYPEPOL^22^15^Type of Policy "KRN",409.61,888,"COL",4,0) GROUP^39^11^Group "KRN",409.61,888,"COL",5,0) HOLDER^52^8^Holder "KRN",409.61,888,"COL",6,0) EFFDT^61^9^Effect. "KRN",409.61,888,"COL",7,0) EXPIRE^72^9^Expires "KRN",409.61,888,"COL",8,0) TYPE^81^8^Type "KRN",409.61,888,"COL",9,0) VERIFIED BY^91^12^Verified By "KRN",409.61,888,"COL",10,0) VERIFIED ON^105^9^Date Ver. "KRN",409.61,888,"COL",11,0) PRECERT^116^5^Pre "KRN",409.61,888,"COL",12,0) UR^122^5^UR "KRN",409.61,888,"COL",13,0) COB^128^4^COB "KRN",409.61,888,"COL",14,0) POLICY^134^15^Subscriber ID "KRN",409.61,888,"COL","AIDENT",1,2) "KRN",409.61,888,"COL","B","COB",13) "KRN",409.61,888,"COL","B","EFFDT",6) "KRN",409.61,888,"COL","B","EXPIRE",7) "KRN",409.61,888,"COL","B","GROUP",4) "KRN",409.61,888,"COL","B","HOLDER",5) "KRN",409.61,888,"COL","B","NAME",2) "KRN",409.61,888,"COL","B","NUMBER",1) "KRN",409.61,888,"COL","B","POLICY",14) "KRN",409.61,888,"COL","B","PRECERT",11) "KRN",409.61,888,"COL","B","TYPE",8) "KRN",409.61,888,"COL","B","TYPEPOL",3) "KRN",409.61,888,"COL","B","UR",12) "KRN",409.61,888,"COL","B","VERIFIED BY",9) "KRN",409.61,888,"COL","B","VERIFIED ON",10) "KRN",409.61,888,"FNL") D EXIT^IBNCPIV "KRN",409.61,888,"HDR") D HDR^IBNCPIV "KRN",409.61,888,"HLP") D HELP^IBNCPIV "KRN",409.61,888,"INIT") D INIT^IBNCPIV "KRN",409.61,890,-1) 0^2 "KRN",409.61,890,0) IBJT ECME RESP INFO^1^^80^4^21^1^1^^IBJT ECME RESP INFO MENU^ECME Claim Information^^^ "KRN",409.61,890,1) ^VALM HIDDEN ACTIONS "KRN",409.61,890,"ARRAY") ^TMP("IBJTRX",$J) "KRN",409.61,890,"FNL") D EXIT^IBJTRX "KRN",409.61,890,"HDR") D HDR^IBJTRX "KRN",409.61,890,"HLP") D HELP^IBJTRX "KRN",409.61,890,"INIT") D INIT^IBJTRX "MBREQ") 1 "ORD",15,101) 101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA "ORD",15,101,0) PROTOCOL "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",200,-1) 1^1 "PKG",200,0) INTEGRATED BILLING^IB^INTEGRATED BILLING "PKG",200,20,0) ^9.402P^1^1 "PKG",200,20,1,0) 2^^IBAXDR "PKG",200,20,1,1) "PKG",200,20,"B",2,1) "PKG",200,22,0) ^9.49I^1^1 "PKG",200,22,1,0) 2.0^2940321^2990406^2447 "PKG",200,22,1,"PAH",1,0) 435^3110830 "PKG",200,22,1,"PAH",1,1,0) ^^1^1^3110830 "PKG",200,22,1,"PAH",1,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 33 "RTN","IBCNBLE") 0^18^B79037653 "RTN","IBCNBLE",1,0) IBCNBLE ;ALB/ARH - Ins Buffer: LM buffer entry screen ;1-Jun-97 "RTN","IBCNBLE",2,0) ;;2.0;INTEGRATED BILLING;**82,231,184,251,371,416,435**;21-MAR-94;Build 27 "RTN","IBCNBLE",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNBLE",4,0) ; "RTN","IBCNBLE",5,0) EN ; - main entry point for list manager display "RTN","IBCNBLE",6,0) N DFN "RTN","IBCNBLE",7,0) D EN^VALM("IBCNB INSURANCE BUFFER ENTRY") "RTN","IBCNBLE",8,0) Q "RTN","IBCNBLE",9,0) ; "RTN","IBCNBLE",10,0) HDR ; - header code for list manager display "RTN","IBCNBLE",11,0) N IBX,IB0,VADM,VA,VAERR S IBX="" "RTN","IBCNBLE",12,0) I +$G(DFN) D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4) "RTN","IBCNBLE",13,0) S VALMHDR(1)=IBX "RTN","IBCNBLE",14,0) S IB0=$G(^IBA(355.33,+$G(IBBUFDA),0)) "RTN","IBCNBLE",15,0) S IBX=$E($P($G(^VA(200,+$P(IB0,U,2),0)),U,1),1,27)_" ("_$E($$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)),1,11)_")" "RTN","IBCNBLE",16,0) S IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX,IBX=$J("",40-($L(IBX)\2))_IBX "RTN","IBCNBLE",17,0) S VALMHDR(2)=IBX "RTN","IBCNBLE",18,0) S IBX="" I +$P(IB0,U,10) S IBX="Buffer entry verified on "_$$DATE(+$P(IB0,U,10))_" by "_$E($P($G(^VA(200,+$P(IB0,U,11),0)),U,1),1,27),IBX=$J("",40-($L(IBX)\2))_IBX "RTN","IBCNBLE",19,0) S VALMHDR(3)=IBX "RTN","IBCNBLE",20,0) Q "RTN","IBCNBLE",21,0) ; "RTN","IBCNBLE",22,0) INIT ; - initialization of list manager screen, ifn of record to display required IBBUFDA "RTN","IBCNBLE",23,0) K ^TMP("IBCNBLE",$J) "RTN","IBCNBLE",24,0) I '$G(IBBUFDA) S VALMQUIT="" Q "RTN","IBCNBLE",25,0) S DFN=+$G(^IBA(355.33,IBBUFDA,60)) "RTN","IBCNBLE",26,0) D BLD "RTN","IBCNBLE",27,0) Q "RTN","IBCNBLE",28,0) ; "RTN","IBCNBLE",29,0) HELP ; - help text for list manager screen "RTN","IBCNBLE",30,0) D FULL^VALM1 "RTN","IBCNBLE",31,0) W !!,"This screen displays all data in a Buffer File entry." "RTN","IBCNBLE",32,0) W !!,"The actions allow editing of all data and verification of coverage." "RTN","IBCNBLE",33,0) W !!,"It is not necessary to use the Verify Entry action, this action is optional.",!,"If the Verify Entry action is not used, the policy will be automatically flagged",!,"as verified when it is Accepted and stored in the main Insurance files." "RTN","IBCNBLE",34,0) D PAUSE^VALM1 S VALMBCK="R" "RTN","IBCNBLE",35,0) Q "RTN","IBCNBLE",36,0) ; "RTN","IBCNBLE",37,0) EXIT ; - exit list manager screen "RTN","IBCNBLE",38,0) K ^TMP("IBCNBLE",$J) "RTN","IBCNBLE",39,0) D CLEAR^VALM1 "RTN","IBCNBLE",40,0) Q "RTN","IBCNBLE",41,0) ; "RTN","IBCNBLE",42,0) BLD ; display buffer entry "RTN","IBCNBLE",43,0) N DFN,CLIEN,CLDT,IB0,IB20,IB40,IB60,IB61,IB62,IBL,IBLINE,ADDR,IBI,IBY "RTN","IBCNBLE",44,0) S VALMCNT=0 "RTN","IBCNBLE",45,0) S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40)) "RTN","IBCNBLE",46,0) S IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61)),IB62=$G(^IBA(355.33,IBBUFDA,62)) "RTN","IBCNBLE",47,0) ; check if we are coming from appointments view "RTN","IBCNBLE",48,0) I $G(AVIEW) D "RTN","IBCNBLE",49,0) .D SET(" ") S IBY=$J("",26)_"Appointment Information" D SET(IBY,"B") S IBLINE="" "RTN","IBCNBLE",50,0) .S DFN=+IB60 "RTN","IBCNBLE",51,0) .S CLIEN="" F S CLIEN=$O(^TMP($J,"IBCNAPPTS",DFN,CLIEN)) Q:CLIEN="" D "RTN","IBCNBLE",52,0) ..S CLDT="" F S CLDT=$O(^TMP($J,"IBCNAPPTS",DFN,CLIEN,CLDT)) Q:CLDT="" D "RTN","IBCNBLE",53,0) ...S IBL="Clinic: ",IBY=$P($P(^TMP($J,"IBCNAPPTS",DFN,CLIEN,CLDT),U,2),";",2) "RTN","IBCNBLE",54,0) ...S IBLINE=$$SETL(IBLINE,IBY,IBL,10,30) "RTN","IBCNBLE",55,0) ...S IBL="Appt. D/T: ",IBY=$$FMTE^XLFDT(CLDT) "RTN","IBCNBLE",56,0) ...S IBLINE=$$SETL(IBLINE,IBY,IBL,50,22) "RTN","IBCNBLE",57,0) ...D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",58,0) ...Q "RTN","IBCNBLE",59,0) ..Q "RTN","IBCNBLE",60,0) .Q "RTN","IBCNBLE",61,0) ; "RTN","IBCNBLE",62,0) I +$P(IB0,U,17) D EN^IBCNBLE2 ; IB*2*435 - Display e-Pharmacy ELIG response data "RTN","IBCNBLE",63,0) ; "RTN","IBCNBLE",64,0) D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE="" "RTN","IBCNBLE",65,0) S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30) "RTN","IBCNBLE",66,0) S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) "RTN","IBCNBLE",67,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",68,0) S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20) "RTN","IBCNBLE",69,0) S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) "RTN","IBCNBLE",70,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",71,0) S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) "RTN","IBCNBLE",72,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",73,0) S IBL="Remote Query From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20) "RTN","IBCNBLE",74,0) D SET(IBLINE) S IBLINE="" D ADDR(21,1) "RTN","IBCNBLE",75,0) S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) "RTN","IBCNBLE",76,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",77,0) F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",78,0) ; "RTN","IBCNBLE",79,0) D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE="" "RTN","IBCNBLE",80,0) S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3) "RTN","IBCNBLE",81,0) S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) "RTN","IBCNBLE",82,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",83,0) S IBL="Group Name: ",IBY=$P(IB40,U,2) S IBLINE=$$SETL("",IBY,IBL,16,20) "RTN","IBCNBLE",84,0) S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) "RTN","IBCNBLE",85,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",86,0) S IBL="Group Number: ",IBY=$P(IB40,U,3) S IBLINE=$$SETL("",IBY,IBL,16,17) "RTN","IBCNBLE",87,0) S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) "RTN","IBCNBLE",88,0) ;;Daou/EEN - Adding BIN and PCN "RTN","IBCNBLE",89,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",90,0) S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10) "RTN","IBCNBLE",91,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",92,0) S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20) "RTN","IBCNBLE",93,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",94,0) S IBL="Type of Plan: ",IBY=$P($G(^IBE(355.1,+$P(IB40,U,9),0)),U,1) S IBLINE=$$SETL("",IBY,IBL,16,25) "RTN","IBCNBLE",95,0) S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) "RTN","IBCNBLE",96,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",97,0) S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3) "RTN","IBCNBLE",98,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",99,0) ; "RTN","IBCNBLE",100,0) D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE="" "RTN","IBCNBLE",101,0) S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7) "RTN","IBCNBLE",102,0) S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8) "RTN","IBCNBLE",103,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",104,0) S IBL="Insured's Name: ",IBY=$P(IB60,U,7) S IBLINE=$$SETL("",IBY,IBL,18,30) "RTN","IBCNBLE",105,0) S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13) "RTN","IBCNBLE",106,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",107,0) S IBL="Subscriber Id: ",IBY=$P(IB60,U,4) S IBLINE=$$SETL("",IBY,IBL,18,20) "RTN","IBCNBLE",108,0) S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) "RTN","IBCNBLE",109,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",110,0) S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16) "RTN","IBCNBLE",111,0) S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16) "RTN","IBCNBLE",112,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",113,0) I $P(IB60,U,6)'="01"!($P(IB60,U,8)'="") S IBL="Insured's DOB: ",IBY=$$DATE($P(IB60,U,8)) S IBLINE=$$SETL("",IBY,IBL,18,8) "RTN","IBCNBLE",114,0) S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16) "RTN","IBCNBLE",115,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",116,0) I $P(IB62,U)'="" S IBL="Patient Id: ",IBY=$P(IB62,U) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13) "RTN","IBCNBLE",117,0) I IBLINE'="" D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",118,0) ; "RTN","IBCNBLE",119,0) I '$P(IB61,U,1) D SET(" ") S IBL="Employer Sponsored Group Health Plan?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,40,3) D SET(IBLINE) S IBLINE="" G NXT "RTN","IBCNBLE",120,0) ; "RTN","IBCNBLE",121,0) D ADDR(61,6) "RTN","IBCNBLE",122,0) D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE="" "RTN","IBCNBLE",123,0) S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3) "RTN","IBCNBLE",124,0) S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15) "RTN","IBCNBLE",125,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",126,0) S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3) "RTN","IBCNBLE",127,0) S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8) "RTN","IBCNBLE",128,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",129,0) S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30) "RTN","IBCNBLE",130,0) S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15) "RTN","IBCNBLE",131,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",132,0) S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) "RTN","IBCNBLE",133,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",134,0) F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",135,0) ; "RTN","IBCNBLE",136,0) NXT ; "RTN","IBCNBLE",137,0) D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE="" "RTN","IBCNBLE",138,0) S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17) "RTN","IBCNBLE",139,0) S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) "RTN","IBCNBLE",140,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",141,0) S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40) "RTN","IBCNBLE",142,0) S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) "RTN","IBCNBLE",143,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",144,0) ; "RTN","IBCNBLE",145,0) ; esg - 6/25/02 SDD 5.1.2 - modifications to Expand Entry for IIV "RTN","IBCNBLE",146,0) ; move source down one line, eIIV trace # to the left column and add "RTN","IBCNBLE",147,0) ; eIIV processed date to the right column "RTN","IBCNBLE",148,0) ; "RTN","IBCNBLE",149,0) S IBLINE=$$TRACE(IBLINE,IBBUFDA) ; eIIV trace # "RTN","IBCNBLE",150,0) S IBL="eIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M")) "RTN","IBCNBLE",151,0) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17) "RTN","IBCNBLE",152,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",153,0) S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)) "RTN","IBCNBLE",154,0) S IBLINE=$$SETL("",IBY,IBL,18,17) "RTN","IBCNBLE",155,0) D SET(IBLINE) S IBLINE="" "RTN","IBCNBLE",156,0) ; "RTN","IBCNBLE",157,0) ; Call another routine for continuation of list build "RTN","IBCNBLE",158,0) D BLD^IBCNBLE1 "RTN","IBCNBLE",159,0) ; "RTN","IBCNBLE",160,0) BLDQ Q "RTN","IBCNBLE",161,0) ; "RTN","IBCNBLE",162,0) ; "RTN","IBCNBLE",163,0) SETL(LINE,DATA,LABEL,COL,LNG) ; "RTN","IBCNBLE",164,0) S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG) "RTN","IBCNBLE",165,0) Q LINE "RTN","IBCNBLE",166,0) ; "RTN","IBCNBLE",167,0) SET(LINE,SPEC) ; "RTN","IBCNBLE",168,0) S VALMCNT=VALMCNT+1 "RTN","IBCNBLE",169,0) S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE "RTN","IBCNBLE",170,0) I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM) "RTN","IBCNBLE",171,0) Q "RTN","IBCNBLE",172,0) ; "RTN","IBCNBLE",173,0) DATE(X) ; "RTN","IBCNBLE",174,0) N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) "RTN","IBCNBLE",175,0) Q Y "RTN","IBCNBLE",176,0) ; "RTN","IBCNBLE",177,0) YN(X) ; "RTN","IBCNBLE",178,0) N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"") "RTN","IBCNBLE",179,0) Q Y "RTN","IBCNBLE",180,0) ; "RTN","IBCNBLE",181,0) ADDR(NODE,FLD) ; format address for output "RTN","IBCNBLE",182,0) N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)="" "RTN","IBCNBLE",183,0) S IB0=$G(^IBA(355.33,IBBUFDA,NODE)) "RTN","IBCNBLE",184,0) S IBCS=$P(IB0,U,FLD+3),IBST=$P($G(^DIC(5,+$P(IB0,U,FLD+4),0)),U,2),IBZIP=$P(IB0,U,FLD+5) "RTN","IBCNBLE",185,0) S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"") "RTN","IBCNBLE",186,0) S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:" ")_IBZIP "RTN","IBCNBLE",187,0) S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST "RTN","IBCNBLE",188,0) ; "RTN","IBCNBLE",189,0) S IBJ=1 F IBY=$P(IB0,U,FLD),$P(IB0,U,(FLD+1)),$P(IB0,U,(FLD+2)),IBCS I IBY'="" S IBX=$G(ADDR(IBJ)),IBZ=", " D "RTN","IBCNBLE",190,0) . S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1 "RTN","IBCNBLE",191,0) . S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY "RTN","IBCNBLE",192,0) Q "RTN","IBCNBLE",193,0) ; "RTN","IBCNBLE",194,0) TRACE(IBLINE,IBBUFDA) ; Add the eIIV Trace Number to the display "RTN","IBCNBLE",195,0) NEW RESP,TRACENUM,IBL,IBY "RTN","IBCNBLE",196,0) I '$G(IBBUFDA) G TRACEX "RTN","IBCNBLE",197,0) S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) ; response ien "RTN","IBCNBLE",198,0) S TRACENUM="" "RTN","IBCNBLE",199,0) I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9) ; trace# field "RTN","IBCNBLE",200,0) S IBL="eIV Trace #: ",IBY=TRACENUM ; field label/data "RTN","IBCNBLE",201,0) S IBLINE=$$SETL("",IBY,IBL,18,17) ; add it "RTN","IBCNBLE",202,0) TRACEX ; "RTN","IBCNBLE",203,0) Q IBLINE "RTN","IBCNBLE",204,0) ; "RTN","IBCNBLE1") 0^15^B30221340 "RTN","IBCNBLE1",1,0) IBCNBLE1 ;DAOU/ESG - Ins Buffer, Expand Entry, con't ;25-JUN-2002 "RTN","IBCNBLE1",2,0) ;;2.0;INTEGRATED BILLING;**184,271,416,435**;21-MAR-94;Build 27 "RTN","IBCNBLE1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNBLE1",4,0) ; "RTN","IBCNBLE1",5,0) ; Can't be called from the top "RTN","IBCNBLE1",6,0) Q "RTN","IBCNBLE1",7,0) ; "RTN","IBCNBLE1",8,0) BLD ; Continuation of Expand Entry list build procedure "RTN","IBCNBLE1",9,0) ; --- Called by IBCNBLE "RTN","IBCNBLE1",10,0) ; "RTN","IBCNBLE1",11,0) NEW ERR,MSG,IBL,IBY,IBLINE,IBER,IBLN,EDITED,ORIGSYME,ORIGSYMI,EEUPDATE "RTN","IBCNBLE1",12,0) NEW ORIGSYMS "RTN","IBCNBLE1",13,0) ; "RTN","IBCNBLE1",14,0) ; save the external and internal IIV status values "RTN","IBCNBLE1",15,0) S ORIGSYMS=$$SYMBOL^IBCNBLL(IBBUFDA) "RTN","IBCNBLE1",16,0) S ORIGSYME=$$GET1^DIQ(355.33,IBBUFDA,.12,"E") "RTN","IBCNBLE1",17,0) S ORIGSYMI=$P(IB0,U,12) "RTN","IBCNBLE1",18,0) ; "RTN","IBCNBLE1",19,0) ; Determine if Expand Entry is allowed to update the IIV Status "RTN","IBCNBLE1",20,0) S EEUPDATE=1 ; default Expand Entry update flag to true "RTN","IBCNBLE1",21,0) I ORIGSYMI,'$P($G(^IBE(365.15,ORIGSYMI,0)),U,3) S EEUPDATE=0 "RTN","IBCNBLE1",22,0) ; "RTN","IBCNBLE1",23,0) ; Do not update the IIV status if manually verified "RTN","IBCNBLE1",24,0) I ORIGSYMS="*" S EEUPDATE=0 "RTN","IBCNBLE1",25,0) ; "RTN","IBCNBLE1",26,0) ; Don't let Expand Entry update the eIV status for ePharmacy buffer entries "RTN","IBCNBLE1",27,0) ; esg - 10/12/10 - IB*2*435 "RTN","IBCNBLE1",28,0) I +$P($G(^IBA(355.33,IBBUFDA,0)),U,17) S EEUPDATE=0 "RTN","IBCNBLE1",29,0) ; "RTN","IBCNBLE1",30,0) ; If the current IIV Status allows updates by Expand Entry, then "RTN","IBCNBLE1",31,0) ; invoke the function that trys to find a valid payer "RTN","IBCNBLE1",32,0) I EEUPDATE D "RTN","IBCNBLE1",33,0) . S ERR=$$INSERROR^IBCNEUT3("B",IBBUFDA,1,.MSG) "RTN","IBCNBLE1",34,0) . ; If no errors, then remove the IIV Status "RTN","IBCNBLE1",35,0) . I 'ERR S ERR=$$SIDERR(IBBUFDA,$P(ERR,U,2)) "RTN","IBCNBLE1",36,0) . I 'ERR D CLEAR^IBCNEUT4(IBBUFDA,.EDITED) "RTN","IBCNBLE1",37,0) . ; If errors found, then update with the new IIV Status "RTN","IBCNBLE1",38,0) . I ERR D BUFF^IBCNEUT2(IBBUFDA,$P(ERR,U,1)) S EDITED=1 "RTN","IBCNBLE1",39,0) . ; refresh the IB0 variable for the possible symbol change "RTN","IBCNBLE1",40,0) . S $P(IB0,U,12)=$P($G(^IBA(355.33,IBBUFDA,0)),U,12) "RTN","IBCNBLE1",41,0) . Q "RTN","IBCNBLE1",42,0) ; "RTN","IBCNBLE1",43,0) ; Possibly display information if the OVERRIDE FRESHNESS FLAG is on "RTN","IBCNBLE1",44,0) I $P(IB0,U,13) D "RTN","IBCNBLE1",45,0) . S IBL="User Requested Inquiry?: ",IBY="YES" "RTN","IBCNBLE1",46,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,18,3) "RTN","IBCNBLE1",47,0) . D SET^IBCNBLE(IBLINE) S IBLINE="" "RTN","IBCNBLE1",48,0) . Q "RTN","IBCNBLE1",49,0) ; "RTN","IBCNBLE1",50,0) ; Display the Current Status line "RTN","IBCNBLE1",51,0) S IBL="Current eIV Status: " "RTN","IBCNBLE1",52,0) S IBY=$$GET1^DIQ(355.33,IBBUFDA,.12,"E") "RTN","IBCNBLE1",53,0) I IBY="",$$SYMBOL^IBCNBLL(IBBUFDA)'="*" S IBY="No problems identified, Awaiting electronic processing" "RTN","IBCNBLE1",54,0) I $$SYMBOL^IBCNBLL(IBBUFDA)="*" S IBY="Manually verified, No eIV activity at this time" "RTN","IBCNBLE1",55,0) ; "RTN","IBCNBLE1",56,0) ; esg - 10/12/10 - check for epharmacy entries "RTN","IBCNBLE1",57,0) I +$P($G(^IBA(355.33,IBBUFDA,0)),U,17) S IBY="N/A for e-Pharmacy buffer entries" "RTN","IBCNBLE1",58,0) ; "RTN","IBCNBLE1",59,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,18,80) "RTN","IBCNBLE1",60,0) D SET^IBCNBLE(IBLINE) S IBLINE="" "RTN","IBCNBLE1",61,0) ; "RTN","IBCNBLE1",62,0) ; Display any text returned by the payer function "RTN","IBCNBLE1",63,0) F IBER=1:1:$G(MSG) D SET^IBCNBLE(" ") F IBLN=1:1:$P($G(MSG(IBER)),U,2) D SET^IBCNBLE(" "_$G(MSG(IBER,IBLN))) "RTN","IBCNBLE1",64,0) ; "RTN","IBCNBLE1",65,0) ; Display the current IIV Status generic description "RTN","IBCNBLE1",66,0) D SYMTXT($P(IB0,U,12),1) "RTN","IBCNBLE1",67,0) D SYMTXT($P(IB0,U,12),2) "RTN","IBCNBLE1",68,0) ; "RTN","IBCNBLE1",69,0) ; If the IIV Status ien changed from what it once was, then display the "RTN","IBCNBLE1",70,0) ; Prior Status line "RTN","IBCNBLE1",71,0) I ORIGSYMI'=$P(IB0,U,12) D "RTN","IBCNBLE1",72,0) . I $P(IB0,U,12) D SET^IBCNBLE(" ") "RTN","IBCNBLE1",73,0) . S IBL="Prior Status: " "RTN","IBCNBLE1",74,0) . S IBY=ORIGSYME "RTN","IBCNBLE1",75,0) . I IBY="",ORIGSYMS'="*" S IBY="No problems identified, Awaiting electronic processing" "RTN","IBCNBLE1",76,0) . I ORIGSYMS="*" S IBY="Manually verified, No eIV activity at this time" "RTN","IBCNBLE1",77,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,18,80) "RTN","IBCNBLE1",78,0) . D SET^IBCNBLE(IBLINE) S IBLINE="" "RTN","IBCNBLE1",79,0) . D SYMTXT(ORIGSYMI,1) "RTN","IBCNBLE1",80,0) . Q "RTN","IBCNBLE1",81,0) ; "RTN","IBCNBLE1",82,0) ; Display any existing EC errors "RTN","IBCNBLE1",83,0) D ECERR "RTN","IBCNBLE1",84,0) ;D SET^IBCNBLE(" ") "RTN","IBCNBLE1",85,0) ; "RTN","IBCNBLE1",86,0) ; If the IIV Status was modified then refresh the visual display "RTN","IBCNBLE1",87,0) I $G(EDITED) D UPDLN^IBCNBLL(IBBUFDA,"EDITED") "RTN","IBCNBLE1",88,0) BLDX ; "RTN","IBCNBLE1",89,0) Q "RTN","IBCNBLE1",90,0) ; "RTN","IBCNBLE1",91,0) SYMTXT(IEN,TYPE) ; Display the text from the IIV symbol file for this entry "RTN","IBCNBLE1",92,0) ; TYPE=1 - Display Description from IIV Status Table file "RTN","IBCNBLE1",93,0) ; TYPE=2 - Display Corrective Action from IIV Status Table file "RTN","IBCNBLE1",94,0) NEW IBJ "RTN","IBCNBLE1",95,0) I '$G(IEN) G SYMX "RTN","IBCNBLE1",96,0) I '$P($G(^IBE(365.15,IEN,TYPE,0)),U,4) G SYMX "RTN","IBCNBLE1",97,0) D SET^IBCNBLE(" ") "RTN","IBCNBLE1",98,0) S IBJ=0 "RTN","IBCNBLE1",99,0) F S IBJ=$O(^IBE(365.15,IEN,TYPE,IBJ)) Q:'IBJ D SET^IBCNBLE(" "_$G(^IBE(365.15,IEN,TYPE,IBJ,0))) "RTN","IBCNBLE1",100,0) SYMX ; "RTN","IBCNBLE1",101,0) Q "RTN","IBCNBLE1",102,0) ; "RTN","IBCNBLE1",103,0) ECERR ; Display the Eligibility Communicator Error data from the "RTN","IBCNBLE1",104,0) ; response file if it exists "RTN","IBCNBLE1",105,0) ; "RTN","IBCNBLE1",106,0) NEW RESP,RESPDATA,ERRTXT,IBY,IBLINE,ERRDATA,FUTDT,TQIEN,IBERR,IBCT "RTN","IBCNBLE1",107,0) S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) "RTN","IBCNBLE1",108,0) I 'RESP G ECERRX "RTN","IBCNBLE1",109,0) S RESPDATA=$G(^IBCN(365,RESP,1)) "RTN","IBCNBLE1",110,0) S ERRTXT=$P($G(^IBCN(365,RESP,4)),U,1) "RTN","IBCNBLE1",111,0) S TQIEN=+$P($G(^IBCN(365,RESP,0)),U,5) ; Trans Queue file ien "RTN","IBCNBLE1",112,0) S FUTDT=$P($G(^IBCN(365.1,TQIEN,0)),U,9) ; Future date to transmit "RTN","IBCNBLE1",113,0) I '$P(RESPDATA,U,14),'$P(RESPDATA,U,15),ERRTXT="",'FUTDT G ECERRX "RTN","IBCNBLE1",114,0) ; "RTN","IBCNBLE1",115,0) ; At this point, we know there's something to get displayed "RTN","IBCNBLE1",116,0) ; "RTN","IBCNBLE1",117,0) ; Display section header "RTN","IBCNBLE1",118,0) D SET^IBCNBLE(" ") "RTN","IBCNBLE1",119,0) S IBY=$J("",19)_"Eligibility Communicator Error Information" "RTN","IBCNBLE1",120,0) D SET^IBCNBLE(IBY,"B") S IBLINE="" "RTN","IBCNBLE1",121,0) ; "RTN","IBCNBLE1",122,0) ; Display Error Condition data - field# 1.14 "RTN","IBCNBLE1",123,0) I $P(RESPDATA,U,14) D "RTN","IBCNBLE1",124,0) . S ERRDATA=$G(^IBE(365.017,$P(RESPDATA,U,14),0)) "RTN","IBCNBLE1",125,0) . K IBERR "RTN","IBCNBLE1",126,0) . S IBERR(1)=$P(ERRDATA,U,2)_" (Error Condition '"_$P(ERRDATA,U,1)_"')" "RTN","IBCNBLE1",127,0) . D TXT^IBCNEUT7("IBERR") "RTN","IBCNBLE1",128,0) . F IBCT=1:1:$O(IBERR(""),-1) D SET^IBCNBLE(IBERR(IBCT)) "RTN","IBCNBLE1",129,0) . Q "RTN","IBCNBLE1",130,0) ; "RTN","IBCNBLE1",131,0) ; Display Error Action data - field# 1.15 "RTN","IBCNBLE1",132,0) I $P(RESPDATA,U,15) D "RTN","IBCNBLE1",133,0) . S ERRDATA=$G(^IBE(365.018,$P(RESPDATA,U,15),0)) "RTN","IBCNBLE1",134,0) . K IBERR "RTN","IBCNBLE1",135,0) . S IBERR(1)=$P(ERRDATA,U,2)_" (Error Action '"_$P(ERRDATA,U,1)_"')" "RTN","IBCNBLE1",136,0) . D TXT^IBCNEUT7("IBERR") "RTN","IBCNBLE1",137,0) . F IBCT=1:1:$O(IBERR(""),-1) D SET^IBCNBLE(IBERR(IBCT)) "RTN","IBCNBLE1",138,0) . Q "RTN","IBCNBLE1",139,0) ; "RTN","IBCNBLE1",140,0) ; Display Error Text data - field# 4.01 "RTN","IBCNBLE1",141,0) I ERRTXT'="" D SET^IBCNBLE(ERRTXT) "RTN","IBCNBLE1",142,0) ; "RTN","IBCNBLE1",143,0) ; Display Date of Future Transmission - field# .09 in file 365.1 "RTN","IBCNBLE1",144,0) I FUTDT D "RTN","IBCNBLE1",145,0) . S FUTDT=$$FMTE^XLFDT(FUTDT,"5Z") "RTN","IBCNBLE1",146,0) . D SET^IBCNBLE(" ") "RTN","IBCNBLE1",147,0) . S IBLINE=" Date of Future Transmission: "_FUTDT "RTN","IBCNBLE1",148,0) . D SET^IBCNBLE(IBLINE) S IBLINE="" "RTN","IBCNBLE1",149,0) . Q "RTN","IBCNBLE1",150,0) ECERRX ; "RTN","IBCNBLE1",151,0) Q "RTN","IBCNBLE1",152,0) ; "RTN","IBCNBLE1",153,0) SIDERR(BUF,PIEN) ; "RTN","IBCNBLE1",154,0) ; If Subscriber ID is required and SSN cannot be substituted "RTN","IBCNBLE1",155,0) ; and buffer does not have a sub id -> return error "RTN","IBCNBLE1",156,0) ; BUF = buffer IEN "RTN","IBCNBLE1",157,0) ; PIEN = payer IEN "RTN","IBCNBLE1",158,0) ; "RTN","IBCNBLE1",159,0) N ERR,SID,APPIEN,SIDSTR,SIDREQ,SIDSSN "RTN","IBCNBLE1",160,0) S ERR="" "RTN","IBCNBLE1",161,0) S SID=$P($G(^IBA(355.33,BUF,60)),U,4) "RTN","IBCNBLE1",162,0) I SID]"" G SIDX ; Subscriber id is populated, further checking is moot "RTN","IBCNBLE1",163,0) S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN) "RTN","IBCNBLE1",164,0) S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0)) "RTN","IBCNBLE1",165,0) S SIDREQ=$P(SIDSTR,U,8) I 'SIDREQ G SIDX ; if sub id is not req'd - ok "RTN","IBCNBLE1",166,0) S SIDSSN=$P(SIDSTR,U,9) "RTN","IBCNBLE1",167,0) I 'SIDSSN S ERR=18 ; if ssn cannot be used -> B15 status (IEN = 18) "RTN","IBCNBLE1",168,0) SIDX Q ERR "RTN","IBCNBLE1",169,0) ; "RTN","IBCNBLE2") 0^19^B76745962 "RTN","IBCNBLE2",1,0) IBCNBLE2 ;ALB/ESG - Expand ins buffer - e-Pharmacy entry ;14-Oct-2010 "RTN","IBCNBLE2",2,0) ;;2.0;INTEGRATED BILLING;**435**;21-MAR-94;Build 27 "RTN","IBCNBLE2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNBLE2",4,0) ; "RTN","IBCNBLE2",5,0) ; References to BPS RESPONSES file (#9002313.03) supported by IA 4813 "RTN","IBCNBLE2",6,0) ; Called by IBCNBLE when expanding an e-Pharmacy buffer entry "RTN","IBCNBLE2",7,0) ; Variable IB0 is the 0 node of file 355.33 "RTN","IBCNBLE2",8,0) ; "RTN","IBCNBLE2",9,0) EN ; Entry point "RTN","IBCNBLE2",10,0) N RESPIEN,RSPSUB,ZR,ZM,BPSR,BPSM,BPSMD,BPSMCOB,IBY,IBL,IBLINE,TEXT "RTN","IBCNBLE2",11,0) ; "RTN","IBCNBLE2",12,0) S RESPIEN=+$P(IB0,U,17) I 'RESPIEN G EX "RTN","IBCNBLE2",13,0) I '$D(^BPSR(RESPIEN,0)) G EX "RTN","IBCNBLE2",14,0) S ZR=RESPIEN_"," "RTN","IBCNBLE2",15,0) D GETS^DIQ(9002313.03,ZR,".01:999","IEN","BPSR") ; get all fields at top level except raw data "RTN","IBCNBLE2",16,0) ; "RTN","IBCNBLE2",17,0) S RSPSUB=+$O(^BPSR(RESPIEN,1000,0)),ZM=0 "RTN","IBCNBLE2",18,0) I RSPSUB D "RTN","IBCNBLE2",19,0) . S ZM=RSPSUB_","_RESPIEN_"," "RTN","IBCNBLE2",20,0) . D GETS^DIQ(9002313.0301,ZM,"112;503;511*;130.01*;549;550;987","IEN","BPSM") ; get Response Status Segment data "RTN","IBCNBLE2",21,0) . Q "RTN","IBCNBLE2",22,0) ; "RTN","IBCNBLE2",23,0) D SET^IBCNBLE(" ") "RTN","IBCNBLE2",24,0) S IBY=$J("",22)_"e-Pharmacy Eligibility Response Data" "RTN","IBCNBLE2",25,0) D SET^IBCNBLE(IBY,"B") "RTN","IBCNBLE2",26,0) ; "RTN","IBCNBLE2",27,0) S IBL="Transmission Status: " "RTN","IBCNBLE2",28,0) S IBY=$G(BPSR(9002313.03,ZR,501,"E")) "RTN","IBCNBLE2",29,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,24,55) "RTN","IBCNBLE2",30,0) D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",31,0) ; "RTN","IBCNBLE2",32,0) S IBL="Transaction Status: " "RTN","IBCNBLE2",33,0) S IBY=$G(BPSM(9002313.0301,ZM,112,"E")) "RTN","IBCNBLE2",34,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,24,55) "RTN","IBCNBLE2",35,0) D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",36,0) ; "RTN","IBCNBLE2",37,0) S IBL="Date of Service: " "RTN","IBCNBLE2",38,0) S IBY=$G(BPSR(9002313.03,ZR,401,"E")) "RTN","IBCNBLE2",39,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,24,55) "RTN","IBCNBLE2",40,0) D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",41,0) ; "RTN","IBCNBLE2",42,0) ; get 504 Message "RTN","IBCNBLE2",43,0) S TEXT=$G(BPSR(9002313.03,ZR,504,"E")) "RTN","IBCNBLE2",44,0) I TEXT'="" D "RTN","IBCNBLE2",45,0) . D SET^IBCNBLE(" ") "RTN","IBCNBLE2",46,0) . N IBZ,J,LEN,PCE,CHS,NEWCHS "RTN","IBCNBLE2",47,0) . S LEN=30 ; break up big words "RTN","IBCNBLE2",48,0) . F PCE=1:1 Q:PCE>$L(TEXT," ") S CHS=$P(TEXT," ",PCE) I $L(CHS)>LEN D "RTN","IBCNBLE2",49,0) .. S NEWCHS=$E(CHS,1,LEN)_" "_$E(CHS,LEN+1,999) "RTN","IBCNBLE2",50,0) .. S $P(TEXT," ",PCE)=NEWCHS "RTN","IBCNBLE2",51,0) .. Q "RTN","IBCNBLE2",52,0) . D FSTRNG^IBJU1(TEXT,71,.IBZ) "RTN","IBCNBLE2",53,0) . S J=0 F S J=$O(IBZ(J)) Q:'J D "RTN","IBCNBLE2",54,0) .. S IBLINE=$$SETL^IBCNBLE("",IBZ(J),"",2,999) "RTN","IBCNBLE2",55,0) .. D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",56,0) .. Q "RTN","IBCNBLE2",57,0) . Q "RTN","IBCNBLE2",58,0) ; "RTN","IBCNBLE2",59,0) ; display reject codes 511 if they exist "RTN","IBCNBLE2",60,0) I $D(BPSM(9002313.03511)) D "RTN","IBCNBLE2",61,0) . N ZJ "RTN","IBCNBLE2",62,0) . D SET^IBCNBLE(" ") "RTN","IBCNBLE2",63,0) . D SET^IBCNBLE(" Reject Codes:") "RTN","IBCNBLE2",64,0) . S ZJ="" F S ZJ=$O(BPSM(9002313.03511,ZJ)) Q:ZJ="" D SET^IBCNBLE(" "_$G(BPSM(9002313.03511,ZJ,.01,"E"))) "RTN","IBCNBLE2",65,0) . Q "RTN","IBCNBLE2",66,0) ; "RTN","IBCNBLE2",67,0) ; display additional messages if they exist "RTN","IBCNBLE2",68,0) I $D(BPSM(9002313.13001)) D "RTN","IBCNBLE2",69,0) . N ZA,TEXT "RTN","IBCNBLE2",70,0) . D SET^IBCNBLE(" ") "RTN","IBCNBLE2",71,0) . D SET^IBCNBLE(" Additional Message:") "RTN","IBCNBLE2",72,0) . S ZA="" F S ZA=$O(BPSM(9002313.13001,ZA)) Q:ZA="" S TEXT=$G(BPSM(9002313.13001,ZA,526,"E")) I TEXT'="" D "RTN","IBCNBLE2",73,0) .. N IBZ,J,LEN,PCE,CHS,NEWCHS "RTN","IBCNBLE2",74,0) .. S LEN=30 ; break up big words "RTN","IBCNBLE2",75,0) .. F PCE=1:1 Q:PCE>$L(TEXT," ") S CHS=$P(TEXT," ",PCE) I $L(CHS)>LEN D "RTN","IBCNBLE2",76,0) ... S NEWCHS=$E(CHS,1,LEN)_" "_$E(CHS,LEN+1,999) "RTN","IBCNBLE2",77,0) ... S $P(TEXT," ",PCE)=NEWCHS "RTN","IBCNBLE2",78,0) ... Q "RTN","IBCNBLE2",79,0) .. D FSTRNG^IBJU1(TEXT,71,.IBZ) "RTN","IBCNBLE2",80,0) .. S J=0 F S J=$O(IBZ(J)) Q:'J D "RTN","IBCNBLE2",81,0) ... S IBLINE=$$SETL^IBCNBLE("",IBZ(J),"",5,999) "RTN","IBCNBLE2",82,0) ... D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",83,0) ... Q "RTN","IBCNBLE2",84,0) .. Q "RTN","IBCNBLE2",85,0) . Q "RTN","IBCNBLE2",86,0) D SET^IBCNBLE(" ") "RTN","IBCNBLE2",87,0) ; "RTN","IBCNBLE2",88,0) ; display response insurance segment data and responses patient segment data "RTN","IBCNBLE2",89,0) S IBL="Group ID: " "RTN","IBCNBLE2",90,0) S IBY=$G(BPSR(9002313.03,ZR,301,"E")) "RTN","IBCNBLE2",91,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",92,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",93,0) ; "RTN","IBCNBLE2",94,0) S IBL="Plan ID: " "RTN","IBCNBLE2",95,0) S IBY=$G(BPSR(9002313.03,ZR,524,"E")) "RTN","IBCNBLE2",96,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",97,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",98,0) ; "RTN","IBCNBLE2",99,0) S IBL="Network Reimbursement ID: " "RTN","IBCNBLE2",100,0) S IBY=$G(BPSR(9002313.03,ZR,545,"E")) "RTN","IBCNBLE2",101,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",102,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",103,0) ; "RTN","IBCNBLE2",104,0) S IBL="Cardholder ID: " "RTN","IBCNBLE2",105,0) S IBY=$G(BPSR(9002313.03,ZR,302,"E")) "RTN","IBCNBLE2",106,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",107,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",108,0) ; "RTN","IBCNBLE2",109,0) S IBL="Payer-reported First Name: " "RTN","IBCNBLE2",110,0) S IBY=$G(BPSR(9002313.03,ZR,310,"E")) "RTN","IBCNBLE2",111,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",112,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",113,0) ; "RTN","IBCNBLE2",114,0) S IBL="Payer-reported Last Name: " "RTN","IBCNBLE2",115,0) S IBY=$G(BPSR(9002313.03,ZR,311,"E")) "RTN","IBCNBLE2",116,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",117,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",118,0) ; "RTN","IBCNBLE2",119,0) S IBL="Payer-reported DOB: " "RTN","IBCNBLE2",120,0) S IBY=$G(BPSR(9002313.03,ZR,304,"E")) "RTN","IBCNBLE2",121,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",122,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",123,0) ; "RTN","IBCNBLE2",124,0) S IBL="Authorization Number: " "RTN","IBCNBLE2",125,0) S IBY=$G(BPSM(9002313.0301,ZM,503,"E")) "RTN","IBCNBLE2",126,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",127,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",128,0) ; "RTN","IBCNBLE2",129,0) S IBL="Help Desk Phone: " "RTN","IBCNBLE2",130,0) S IBY=$G(BPSM(9002313.0301,ZM,550,"E")) "RTN","IBCNBLE2",131,0) I IBY'="" D "RTN","IBCNBLE2",132,0) . N HDPQ "RTN","IBCNBLE2",133,0) . S HDPQ=$G(BPSM(9002313.0301,ZM,549,"E")) Q:HDPQ="" ; help desk phone# qualifier "RTN","IBCNBLE2",134,0) . S HDPQ=$S(+HDPQ=1:"Switch",+HDPQ=2:"Intermediary",+HDPQ=3:"Processor/PBM",1:"Other") "RTN","IBCNBLE2",135,0) . S IBY=IBY_" ("_HDPQ_")" "RTN","IBCNBLE2",136,0) . Q "RTN","IBCNBLE2",137,0) S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,28,51) "RTN","IBCNBLE2",138,0) I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",139,0) ; "RTN","IBCNBLE2",140,0) S IBL="URL: " "RTN","IBCNBLE2",141,0) S IBY=$G(BPSM(9002313.0301,ZM,987,"E")) "RTN","IBCNBLE2",142,0) I IBY'="" D "RTN","IBCNBLE2",143,0) . N COL,N,M,Z,URL,J "RTN","IBCNBLE2",144,0) . S COL=28 ; column to start display "RTN","IBCNBLE2",145,0) . S N=79-COL ; max length of each line "RTN","IBCNBLE2",146,0) . S M=0 ; array subscript "RTN","IBCNBLE2",147,0) . F Z=1:N:400 S M=M+1,URL(M)=$E(IBY,Z,Z+N-1) I URL(M)="" K URL(M) Q "RTN","IBCNBLE2",148,0) . S IBLINE=$$SETL^IBCNBLE("",$G(URL(1)),IBL,COL,999) ; display line 1 w/label "RTN","IBCNBLE2",149,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",150,0) . S J=1 F S J=$O(URL(J)) Q:'J D "RTN","IBCNBLE2",151,0) .. S IBLINE=$$SETL^IBCNBLE("",URL(J),"",COL,999) ; display the rest "RTN","IBCNBLE2",152,0) .. D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",153,0) .. Q "RTN","IBCNBLE2",154,0) . Q "RTN","IBCNBLE2",155,0) ; "RTN","IBCNBLE2",156,0) ; Get the Response Insurance Additional Information Segment data "RTN","IBCNBLE2",157,0) ; Used only for Medicare Part D Eligibility transactions "RTN","IBCNBLE2",158,0) D GETS^DIQ(9002313.0301,ZM,"139;138;240;926;757;140;141","IEN","BPSMD") ; get data "RTN","IBCNBLE2",159,0) I $D(BPSMD(9002313.0301)) D "RTN","IBCNBLE2",160,0) . D SET^IBCNBLE(" ") "RTN","IBCNBLE2",161,0) . D SET^IBCNBLE(" MEDICARE PART D ELIGIBILITY INFORMATION") "RTN","IBCNBLE2",162,0) . ; "RTN","IBCNBLE2",163,0) . S IBL="Coverage Code: " "RTN","IBCNBLE2",164,0) . S IBY=$G(BPSMD(9002313.0301,ZM,139,"E")) "RTN","IBCNBLE2",165,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",166,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",167,0) . ; "RTN","IBCNBLE2",168,0) . S IBL="CMS LICS Level: " "RTN","IBCNBLE2",169,0) . S IBY=$G(BPSMD(9002313.0301,ZM,138,"E")) "RTN","IBCNBLE2",170,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",171,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",172,0) . ; "RTN","IBCNBLE2",173,0) . S IBL="Contract Number: " "RTN","IBCNBLE2",174,0) . S IBY=$G(BPSMD(9002313.0301,ZM,240,"E")) "RTN","IBCNBLE2",175,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",176,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",177,0) . ; "RTN","IBCNBLE2",178,0) . S IBL="Forumulary ID: " "RTN","IBCNBLE2",179,0) . S IBY=$G(BPSMD(9002313.0301,ZM,926,"E")) "RTN","IBCNBLE2",180,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",181,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",182,0) . ; "RTN","IBCNBLE2",183,0) . S IBL="Benefit ID: " "RTN","IBCNBLE2",184,0) . S IBY=$G(BPSMD(9002313.0301,ZM,757,"E")) "RTN","IBCNBLE2",185,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",186,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",187,0) . ; "RTN","IBCNBLE2",188,0) . S IBL="Next Effective Date: " "RTN","IBCNBLE2",189,0) . S IBY=$G(BPSMD(9002313.0301,ZM,140,"E")) "RTN","IBCNBLE2",190,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",191,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",192,0) . ; "RTN","IBCNBLE2",193,0) . S IBL="Next Termination Date: " "RTN","IBCNBLE2",194,0) . S IBY=$G(BPSMD(9002313.0301,ZM,141,"E")) "RTN","IBCNBLE2",195,0) . S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,25,54) "RTN","IBCNBLE2",196,0) . D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",197,0) . ; "RTN","IBCNBLE2",198,0) . Q "RTN","IBCNBLE2",199,0) ; "RTN","IBCNBLE2",200,0) ; Display Response COB/Other Payers segment "RTN","IBCNBLE2",201,0) ; Data stored in 9002313.035501 subfile "RTN","IBCNBLE2",202,0) D GETS^DIQ(9002313.0301,ZM,"355.01*","IEN","BPSMCOB") ; get data "RTN","IBCNBLE2",203,0) I $D(BPSMCOB(9002313.035501)) D "RTN","IBCNBLE2",204,0) . N ZC,ZCTOT,ZCN "RTN","IBCNBLE2",205,0) . S ZC="" F ZCTOT=0:1 S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" ; count how many entries exist "RTN","IBCNBLE2",206,0) . S ZC="",ZCN=0 F S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" D "RTN","IBCNBLE2",207,0) .. S ZCN=ZCN+1 "RTN","IBCNBLE2",208,0) .. D SET^IBCNBLE(" ") "RTN","IBCNBLE2",209,0) .. D SET^IBCNBLE(" COB/OTHER PAYER INFORMATION ("_ZCN_" of "_ZCTOT_")") "RTN","IBCNBLE2",210,0) .. ; "RTN","IBCNBLE2",211,0) .. S IBL="Coverage Type: " "RTN","IBCNBLE2",212,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,338,"E")) "RTN","IBCNBLE2",213,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",214,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",215,0) .. ; "RTN","IBCNBLE2",216,0) .. S IBL="Payer ID Qual: " "RTN","IBCNBLE2",217,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,339,"E")) "RTN","IBCNBLE2",218,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",219,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",220,0) .. ; "RTN","IBCNBLE2",221,0) .. S IBL="Payer ID: " "RTN","IBCNBLE2",222,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,340,"E")) "RTN","IBCNBLE2",223,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",224,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",225,0) .. ; "RTN","IBCNBLE2",226,0) .. S IBL="Processor Cntrl#: " "RTN","IBCNBLE2",227,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,991,"E")) "RTN","IBCNBLE2",228,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",229,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",230,0) .. ; "RTN","IBCNBLE2",231,0) .. S IBL="Cardholder ID: " "RTN","IBCNBLE2",232,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,356,"E")) "RTN","IBCNBLE2",233,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",234,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",235,0) .. ; "RTN","IBCNBLE2",236,0) .. S IBL="Group ID: " "RTN","IBCNBLE2",237,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,992,"E")) "RTN","IBCNBLE2",238,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",239,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",240,0) .. ; "RTN","IBCNBLE2",241,0) .. S IBL="Person Code: " "RTN","IBCNBLE2",242,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,142,"E")) "RTN","IBCNBLE2",243,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",244,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",245,0) .. ; "RTN","IBCNBLE2",246,0) .. S IBL="Help Desk Phone: " "RTN","IBCNBLE2",247,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,127,"E")) "RTN","IBCNBLE2",248,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",249,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",250,0) .. ; "RTN","IBCNBLE2",251,0) .. S IBL="Patient Rel Code: " "RTN","IBCNBLE2",252,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,143,"E")) "RTN","IBCNBLE2",253,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",254,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",255,0) .. ; "RTN","IBCNBLE2",256,0) .. S IBL="Benefit Effective: " "RTN","IBCNBLE2",257,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,144,"E")) "RTN","IBCNBLE2",258,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",259,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",260,0) .. ; "RTN","IBCNBLE2",261,0) .. S IBL="Benefit Term: " "RTN","IBCNBLE2",262,0) .. S IBY=$G(BPSMCOB(9002313.035501,ZC,145,"E")) "RTN","IBCNBLE2",263,0) .. S IBLINE=$$SETL^IBCNBLE("",IBY,IBL,22,57) "RTN","IBCNBLE2",264,0) .. I IBY'="" D SET^IBCNBLE(IBLINE) "RTN","IBCNBLE2",265,0) .. ; "RTN","IBCNBLE2",266,0) .. Q "RTN","IBCNBLE2",267,0) . Q "RTN","IBCNBLE2",268,0) ; "RTN","IBCNBLE2",269,0) EX ; "RTN","IBCNBLE2",270,0) Q "RTN","IBCNBLE2",271,0) ; "RTN","IBCNBLL") 0^14^B101908545 "RTN","IBCNBLL",1,0) IBCNBLL ;ALB/ARH - Ins Buffer: LM main screen, list buffer entries ;1 Jun 97 "RTN","IBCNBLL",2,0) ;;2.0;INTEGRATED BILLING;**82,149,153,183,184,271,345,416,438,435**;21-MAR-94;Build 27 "RTN","IBCNBLL",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNBLL",4,0) ; "RTN","IBCNBLL",5,0) ; DBIA# 642 for call to $$LST^DGMTU "RTN","IBCNBLL",6,0) ; DBIA# 4433 for call to $$SDAPI^SDAMA301 "RTN","IBCNBLL",7,0) ; "RTN","IBCNBLL",8,0) EN ; - main entry point for screen "RTN","IBCNBLL",9,0) N VIEW,AVIEW,DFLG "RTN","IBCNBLL",10,0) S VIEW=1,AVIEW=0 ; default to positive view "RTN","IBCNBLL",11,0) K ^TMP("IBCNERTQ",$J) ; clear temp. global for eIV real time inquiries "RTN","IBCNBLL",12,0) D EN^VALM("IBCNB INSURANCE BUFFER LIST") "RTN","IBCNBLL",13,0) Q "RTN","IBCNBLL",14,0) ; "RTN","IBCNBLL",15,0) EN1(V) ; entry point from view changing actions "RTN","IBCNBLL",16,0) S VIEW=V S AVIEW=$S(VIEW=4:1,1:0) "RTN","IBCNBLL",17,0) D INIT,HDR "RTN","IBCNBLL",18,0) S VALMBCK="R",VALMBG=1 "RTN","IBCNBLL",19,0) Q "RTN","IBCNBLL",20,0) ; "RTN","IBCNBLL",21,0) HDR ; header code for list manager display "RTN","IBCNBLL",22,0) S VALMHDR(1)="Sorted by: "_$P(IBCNSORT,U,2) "RTN","IBCNBLL",23,0) I $P(IBCNSORT,U,3)'="" S VALMHDR(1)=VALMHDR(1)_", """_$P(IBCNSORT,U,3)_""" first" "RTN","IBCNBLL",24,0) I VIEW=1 S VALM("TITLE")="Positive Insurance Buffer",VALMSG="*Verified +Active ?Await/Reply" "RTN","IBCNBLL",25,0) I VIEW=2 S VALM("TITLE")="Negative Insurance Buffer",VALMSG="*Verified -N/Active #Unclear !Unable/Send" "RTN","IBCNBLL",26,0) I VIEW=3 S VALM("TITLE")="Medicare(WNR) Insurance Buffer",VALMSG="*Verified +Act -N/Act ?Await/R #Unclr !Unable/Send" "RTN","IBCNBLL",27,0) I VIEW=4 S VALM("TITLE")="Future Appointments Buffer",VALMSG="!Unable/Send" "RTN","IBCNBLL",28,0) I VIEW=5 S VALM("TITLE")="e-Pharmacy Buffer",VALMSG="*Verified" ; IB*2*435 "RTN","IBCNBLL",29,0) Q "RTN","IBCNBLL",30,0) ; "RTN","IBCNBLL",31,0) INIT ; initialization for list manager list "RTN","IBCNBLL",32,0) K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),^TMP($J,"IBCNAPPTS") "RTN","IBCNBLL",33,0) S:$G(IBCNSORT)="" IBCNSORT=$S(VIEW=1:"10^Positive Response",1:"1^Patient Name") "RTN","IBCNBLL",34,0) D BLD "RTN","IBCNBLL",35,0) Q "RTN","IBCNBLL",36,0) ; "RTN","IBCNBLL",37,0) HELP ; list manager help "RTN","IBCNBLL",38,0) D FULL^VALM1 "RTN","IBCNBLL",39,0) S VALMBCK="R" "RTN","IBCNBLL",40,0) W @IOF "RTN","IBCNBLL",41,0) W !,"Flags displayed on screen if they apply to the Buffer entry:" "RTN","IBCNBLL",42,0) W !," i - Patient has other currently effective Insurance" "RTN","IBCNBLL",43,0) W !," I - Patient is currently admitted as an Inpatient" "RTN","IBCNBLL",44,0) W !," E - Patient has Expired" "RTN","IBCNBLL",45,0) W !," Y - Means Test Copay Patient" "RTN","IBCNBLL",46,0) W !," H - Patient has Bills On Hold" "RTN","IBCNBLL",47,0) W !," * - Buffer entry Verified by User" "RTN","IBCNBLL",48,0) D PAUSE^VALM1 I 'Y Q "RTN","IBCNBLL",49,0) W !,"Sources displayed on the screen if they apply to the Buffer entry:" "RTN","IBCNBLL",50,0) W !," I - Interview" "RTN","IBCNBLL",51,0) W !," P - Pre-registration" "RTN","IBCNBLL",52,0) W !," M - Medicare" "RTN","IBCNBLL",53,0) W !," D - Data Match" "RTN","IBCNBLL",54,0) W !," E - eIV" "RTN","IBCNBLL",55,0) W !," R - ICB" "RTN","IBCNBLL",56,0) W !," V - IVM" "RTN","IBCNBLL",57,0) W !," H - HMS" "RTN","IBCNBLL",58,0) W !," C - Contract Services" "RTN","IBCNBLL",59,0) W !," X - e-Pharmacy" ; IB*2*435 "RTN","IBCNBLL",60,0) D PAUSE^VALM1 I 'Y Q "RTN","IBCNBLL",61,0) ; "RTN","IBCNBLL",62,0) I VIEW'=5 D ; IB*2*435 "RTN","IBCNBLL",63,0) . W !,"eIV Electronic Insurance Verification Status" "RTN","IBCNBLL",64,0) . W !!,"The following eIV Status indicators may appear to the left of the patient name:",! "RTN","IBCNBLL",65,0) . Q "RTN","IBCNBLL",66,0) ; "RTN","IBCNBLL",67,0) I VIEW=1 D "RTN","IBCNBLL",68,0) .W !," + - eIV payer response indicates this is an active policy." "RTN","IBCNBLL",69,0) .W !," ? - Awaiting electronic reply from eIV Payer." "RTN","IBCNBLL",70,0) .W !," - Entry added through manual process." "RTN","IBCNBLL",71,0) .Q "RTN","IBCNBLL",72,0) I VIEW=2 D "RTN","IBCNBLL",73,0) .W !,"- - eIV payer response indicates this is NOT an active policy." "RTN","IBCNBLL",74,0) .W !,"# - Can not determine from eIV response if coverage is Active." "RTN","IBCNBLL",75,0) .W !," Review Response Report. Manual verification required." "RTN","IBCNBLL",76,0) .W !,"! - eIV was unable to send an inquiry for this entry." "RTN","IBCNBLL",77,0) .W !," Corrections required before eIV can send inquiry." "RTN","IBCNBLL",78,0) .Q "RTN","IBCNBLL",79,0) I VIEW=3 D "RTN","IBCNBLL",80,0) .W !," + - eIV payer response indicates this is an active policy." "RTN","IBCNBLL",81,0) .W !," ? - Awaiting electronic reply from eIV Payer." "RTN","IBCNBLL",82,0) .W !," # - Can not determine from eIV response if coverage is Active." "RTN","IBCNBLL",83,0) .W !," Review Response Report. Manual verification required." "RTN","IBCNBLL",84,0) .W !," ! - eIV was unable to send an inquiry for this entry." "RTN","IBCNBLL",85,0) .W !," Corrections required or payer not Active." "RTN","IBCNBLL",86,0) .W !," - - eIV payer response indicates this is NOT an active policy." "RTN","IBCNBLL",87,0) .W !," - Entry added through manual process." "RTN","IBCNBLL",88,0) .Q "RTN","IBCNBLL",89,0) I VIEW=4 D "RTN","IBCNBLL",90,0) .W !,"! - eIV was unable to send an inquiry for this entry." "RTN","IBCNBLL",91,0) .W !," Corrections required or payer not Active." "RTN","IBCNBLL",92,0) .Q "RTN","IBCNBLL",93,0) ; "RTN","IBCNBLL",94,0) I VIEW=5 D ; IB*2*435 "RTN","IBCNBLL",95,0) . W !,"e-Pharmacy buffer entries are not applicable for e-IV processing." "RTN","IBCNBLL",96,0) . Q "RTN","IBCNBLL",97,0) ; "RTN","IBCNBLL",98,0) D PAUSE^VALM1 I 'Y Q "RTN","IBCNBLL",99,0) W !,"When an entry is Processed it is either:" "RTN","IBCNBLL",100,0) W !," Accepted - the Buffer entry's data is stored in the main Insurance files." "RTN","IBCNBLL",101,0) W !," - the modified Insurance entry is flagged as Verified." "RTN","IBCNBLL",102,0) W ! "RTN","IBCNBLL",103,0) W !," Rejected - the Buffer entry's data is not stored in the main Insurance files." "RTN","IBCNBLL",104,0) W !! "RTN","IBCNBLL",105,0) W !,"Once an entry is processed (either accepted or rejected) most of the data in" "RTN","IBCNBLL",106,0) W !,"the Buffer File entry is deleted leaving only a stub entry for tracking" "RTN","IBCNBLL",107,0) W !,"and reporting purposes." "RTN","IBCNBLL",108,0) W !! "RTN","IBCNBLL",109,0) W !,"The IB INSURANCE SUPERVISOR key is required to either Accept or Reject an entry." "RTN","IBCNBLL",110,0) D PAUSE^VALM1 "RTN","IBCNBLL",111,0) Q "RTN","IBCNBLL",112,0) ; "RTN","IBCNBLL",113,0) EXIT ; exit list manager option and clean up "RTN","IBCNBLL",114,0) K ^TMP("IBCNBLL",$J),^TMP("IBCNBLLX",$J),^TMP("IBCNBLLY",$J),^TMP($J,"IBCNBLLS"),^TMP($J,"SDAMA301"),^TMP($J,"IBCNAPPTS") "RTN","IBCNBLL",115,0) K IBCNSORT,IBCNSCRN,DFN,IBINSDA,IBFASTXT,IBBUFDA "RTN","IBCNBLL",116,0) D CLEAR^VALM1 "RTN","IBCNBLL",117,0) Q "RTN","IBCNBLL",118,0) ; "RTN","IBCNBLL",119,0) BLD ; build screen display "RTN","IBCNBLL",120,0) N IBCNT,IBCNS1,IBCNS2,IBBUFDA,IBLINE "RTN","IBCNBLL",121,0) ; "RTN","IBCNBLL",122,0) D SORT S IBCNT=0,VALMCNT=0,IBBUFDA=0 "RTN","IBCNBLL",123,0) ; "RTN","IBCNBLL",124,0) S IBCNS1="" F S IBCNS1=$O(^TMP($J,"IBCNBLLS",IBCNS1)) Q:IBCNS1="" D "RTN","IBCNBLL",125,0) .S IBCNS2="" F S IBCNS2=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2)) Q:IBCNS2="" D "RTN","IBCNBLL",126,0) ..S IBBUFDA=0 F S IBBUFDA=$O(^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA)) Q:'IBBUFDA D "RTN","IBCNBLL",127,0) ...S DFLG=^TMP($J,"IBCNBLLS",IBCNS1,IBCNS2,IBBUFDA) "RTN","IBCNBLL",128,0) ...S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W "." "RTN","IBCNBLL",129,0) ...S IBLINE=$$BLDLN(IBBUFDA,IBCNT,DFLG) "RTN","IBCNBLL",130,0) ...D SET(IBLINE,IBCNT) "RTN","IBCNBLL",131,0) ; "RTN","IBCNBLL",132,0) I VALMCNT=0 D SET("",0),SET("There are no Buffer entries that have not been processed.",0) "RTN","IBCNBLL",133,0) Q "RTN","IBCNBLL",134,0) ; "RTN","IBCNBLL",135,0) BLDLN(IBBUFDA,IBCNT,DFLG) ; build line to display on List screen for one Buffer entry "RTN","IBCNBLL",136,0) N DFN,IB0,IB20,IB60,IBLINE,IBY,VAIN,VADM,VA,VAERR,X,Y,IBMTS S IBLINE="",IBBUFDA=+$G(IBBUFDA) "RTN","IBCNBLL",137,0) S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60)) "RTN","IBCNBLL",138,0) S DFN=+IB60 I +DFN D DEM^VADPT,INP^VADPT "RTN","IBCNBLL",139,0) ; "RTN","IBCNBLL",140,0) S IBY=$G(IBCNT),IBLINE=$$SETSTR^VALM1(IBY,"",1,4) "RTN","IBCNBLL",141,0) ; "RTN","IBCNBLL",142,0) ; ESG - 6/6/02 - SDD 5.1.8 "RTN","IBCNBLL",143,0) ; pull the symbol from the symbol function "RTN","IBCNBLL",144,0) ; "RTN","IBCNBLL",145,0) S IBY=$$SYMBOL(IBBUFDA) "RTN","IBCNBLL",146,0) S IBY=IBY_$P($G(^DPT(+DFN,0)),U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,5,20) "RTN","IBCNBLL",147,0) S IBLINE=$$SETSTR^VALM1(DFLG,IBLINE,25,1) "RTN","IBCNBLL",148,0) S IBY=$G(VA("BID")),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,27,4) "RTN","IBCNBLL",149,0) S IBY=$P(IB20,U,1),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,32,17) "RTN","IBCNBLL",150,0) S IBY=$P(IB60,U,4),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,50,13) "RTN","IBCNBLL",151,0) S IBY=$$GET1^DIQ(355.12,$P(IB0,U,3),.03),IBLINE=$$SETSTR^VALM1($$SRCCNV(IBY),IBLINE,64,1) "RTN","IBCNBLL",152,0) S IBY=$$DATE(+IB0),IBLINE=$$SETSTR^VALM1(IBY,IBLINE,66,8) "RTN","IBCNBLL",153,0) S IBY="" D S IBLINE=$$SETSTR^VALM1(IBY,IBLINE,76,5) "RTN","IBCNBLL",154,0) . S IBY=IBY_$S(+$$INSURED^IBCNS1(DFN,DT):"i",1:" ") "RTN","IBCNBLL",155,0) . S IBY=IBY_$S(+$G(VAIN(1)):"I",1:" ") "RTN","IBCNBLL",156,0) . S IBY=IBY_$S(+$G(VADM(6)):"E",1:" ") "RTN","IBCNBLL",157,0) . S IBMTS=$P($$LST^DGMTU(DFN),U,4) "RTN","IBCNBLL",158,0) . S IBY=IBY_$S(IBMTS="C":"Y",IBMTS="G":"Y",1:" ") "RTN","IBCNBLL",159,0) . S IBY=IBY_$S(+$$HOLD(DFN):"H",1:" ") "RTN","IBCNBLL",160,0) Q IBLINE "RTN","IBCNBLL",161,0) ; "RTN","IBCNBLL",162,0) SET(LINE,CNT) ; set up list manager screen display array "RTN","IBCNBLL",163,0) S VALMCNT=VALMCNT+1 "RTN","IBCNBLL",164,0) S ^TMP("IBCNBLL",$J,VALMCNT,0)=LINE Q:'CNT "RTN","IBCNBLL",165,0) S ^TMP("IBCNBLL",$J,"IDX",VALMCNT,+CNT)="" "RTN","IBCNBLL",166,0) S ^TMP("IBCNBLLX",$J,CNT)=VALMCNT_U_IBBUFDA "RTN","IBCNBLL",167,0) S ^TMP("IBCNBLLY",$J,IBBUFDA)=VALMCNT_U_+CNT "RTN","IBCNBLL",168,0) Q "RTN","IBCNBLL",169,0) ; "RTN","IBCNBLL",170,0) SORT ; set up sort for list screen "RTN","IBCNBLL",171,0) ; 1^Patient Name, 2^Ins Name, 3^Source Of Info, 4^Date Entered, 5^Inpatient (Y/N), 6^Means Test (Y/N), 7^On Hold, 8^Verified, 9^eIV Status, 10^Positive Response "RTN","IBCNBLL",172,0) N APPTNUM,IB0,IB20,IB60,IBCNDT,IBBUFDA,IBCNDFN,IBCNPAT,IBCSORT1,IBCSORT2,IBSDA,DFN,VAIN,VA,VAERR,IBX,IBCNT,INAME,SYM,MWNRFLG,MWNRIEN,X,Y "RTN","IBCNBLL",173,0) S IBCNT=0 "RTN","IBCNBLL",174,0) ; "RTN","IBCNBLL",175,0) K ^TMP($J,"IBCNBLLS") I '$G(IBCNSORT) S IBCNSORT="1^Patient Name" "RTN","IBCNBLL",176,0) ; get payer ien for Medicare WNR "RTN","IBCNBLL",177,0) S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25) "RTN","IBCNBLL",178,0) ; "RTN","IBCNBLL",179,0) S IBCNDT=0 F S IBCNDT=$O(^IBA(355.33,"AEST","E",IBCNDT)) Q:'IBCNDT D "RTN","IBCNBLL",180,0) .S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",IBCNDT,IBBUFDA)) Q:'IBBUFDA D "RTN","IBCNBLL",181,0) ..S IBCNT=IBCNT+1 I '$D(ZTQUEUED),'(IBCNT#15) W "." "RTN","IBCNBLL",182,0) ..S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB60=$G(^IBA(355.33,IBBUFDA,60)) "RTN","IBCNBLL",183,0) ..S IBCNDFN=+IB60,IBCNPAT="" I +IBCNDFN S IBCNPAT=$P($G(^DPT(IBCNDFN,0)),U,1) "RTN","IBCNBLL",184,0) ..S INAME=$P(IB20,U) "RTN","IBCNBLL",185,0) ..; "RTN","IBCNBLL",186,0) ..I +IBCNSORT=1 S IBCSORT1=IBCNPAT "RTN","IBCNBLL",187,0) ..I +IBCNSORT=2 S IBCSORT1=INAME "RTN","IBCNBLL",188,0) ..I +IBCNSORT=3 S IBCSORT1=$P(IB0,U,3) "RTN","IBCNBLL",189,0) ..I +IBCNSORT=4 S IBCSORT1=$P(+IB0,".",1) "RTN","IBCNBLL",190,0) ..I +IBCNSORT=5 I +IBCNDFN S DFN=+IBCNDFN D INP^VADPT S IBCSORT1=$S($G(VAIN(1)):1,1:2) "RTN","IBCNBLL",191,0) ..I +IBCNSORT=6 I +IBCNDFN S IBX=$P($$LST^DGMTU(IBCNDFN),U,4) S IBCSORT1=$S(IBX="C":1,IBX="G":1,1:2) "RTN","IBCNBLL",192,0) ..I +IBCNSORT=7 I +IBCNDFN S IBX=$$HOLD(IBCNDFN) S IBCSORT1=$S(+IBX:1,1:2) "RTN","IBCNBLL",193,0) ..I +IBCNSORT=8 S IBCSORT1=$S(+$P(IB0,U,10):1,1:2) "RTN","IBCNBLL",194,0) ..; Sort by symbol and then within the symbol, sort by date entered "RTN","IBCNBLL",195,0) ..; Build a numerical subscript with format ##.FM date "RTN","IBCNBLL",196,0) ..S SYM=$$SYMBOL(IBBUFDA) "RTN","IBCNBLL",197,0) ..I +IBCNSORT=9 S IBCSORT1=$G(IBCNSORT(1,SYM))_"."_$P(+IB0,".",1),IBCSORT1=+IBCSORT1 "RTN","IBCNBLL",198,0) ..; "RTN","IBCNBLL",199,0) ..I +IBCNSORT=10 S IBCSORT1=$S(SYM="+":0,1:1),IBCSORT2=IBCNPAT "RTN","IBCNBLL",200,0) ..; "RTN","IBCNBLL",201,0) ..S IBCSORT1=$S($G(IBCSORT1)="":"~UNKNOWN",1:IBCSORT1),IBCSORT2=$S(IBCNPAT="":"~UNKNOWN",1:IBCNPAT) "RTN","IBCNBLL",202,0) ..; get future appointments "RTN","IBCNBLL",203,0) ..S IBSDA(1)=DT,IBSDA(3)="R;I;NT",IBSDA(4)=IBCNDFN,IBSDA("FLDS")="1;2" "RTN","IBCNBLL",204,0) ..S DFLG="",APPTNUM=$$SDAPI^SDAMA301(.IBSDA) I APPTNUM>0,SYM="!" S DFLG="d" ; duplicate flag "RTN","IBCNBLL",205,0) ..S MWNRFLG=0 I MWNRIEN'="",$P($$INSERROR^IBCNEUT3("B",IBBUFDA),U,2)=MWNRIEN S MWNRFLG=1 "RTN","IBCNBLL",206,0) ..I VIEW=1 Q:MWNRFLG=1 Q:SYM'="*"&(SYM'="+")&(SYM'="?")&(SYM'=" ") "RTN","IBCNBLL",207,0) ..I VIEW=2 Q:MWNRFLG=1 Q:SYM'="*"&(SYM'="-")&(SYM'="#")&(SYM'="!") "RTN","IBCNBLL",208,0) ..I VIEW=3 Q:MWNRFLG=0 "RTN","IBCNBLL",209,0) ..I VIEW=4 Q:SYM'="!" Q:APPTNUM<1 M ^TMP($J,"IBCNAPPTS")=^TMP($J,"SDAMA301") "RTN","IBCNBLL",210,0) ..I VIEW=5 Q:'$P(IB0,U,17) ; IB*2*435 e-Pharmacy view only "RTN","IBCNBLL",211,0) ..I VIEW'=5 Q:$P(IB0,U,17) ; IB*2*435 "RTN","IBCNBLL",212,0) ..S ^TMP($J,"IBCNBLLS",IBCSORT1,IBCSORT2,IBBUFDA)=DFLG "RTN","IBCNBLL",213,0) ..K VAIN,IBCSORT1,IBCSORT2 "RTN","IBCNBLL",214,0) ..Q "RTN","IBCNBLL",215,0) .Q "RTN","IBCNBLL",216,0) I IBCNT,'$D(ZTQUEUED) W "|" "RTN","IBCNBLL",217,0) Q "RTN","IBCNBLL",218,0) ; "RTN","IBCNBLL",219,0) DATE(X) ; "RTN","IBCNBLL",220,0) Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) "RTN","IBCNBLL",221,0) HOLD(DFN) ; returns true if patient has bills On Hold "RTN","IBCNBLL",222,0) Q $D(^IB("AH",+$G(DFN))) "RTN","IBCNBLL",223,0) ; "RTN","IBCNBLL",224,0) SYMBOL(IBBUFDA) ; Returns the symbol for this buffer entry "RTN","IBCNBLL",225,0) NEW IB0,SYM "RTN","IBCNBLL",226,0) S IB0=$G(^IBA(355.33,IBBUFDA,0)),SYM="" "RTN","IBCNBLL",227,0) I +$P(IB0,U,12) S SYM=$C($P($G(^IBE(365.15,+$P(IB0,U,12),0)),U,2)) "RTN","IBCNBLL",228,0) ; If the entry has been manually verified, override the symbol displayed "RTN","IBCNBLL",229,0) I $P(IB0,U,10)'="",'+$P(IB0,U,12) S SYM="*" "RTN","IBCNBLL",230,0) I SYM="" S SYM=" " "RTN","IBCNBLL",231,0) Q SYM "RTN","IBCNBLL",232,0) ; "RTN","IBCNBLL",233,0) ; "RTN","IBCNBLL",234,0) UPDLN(IBBUFDA,ACTION) ; *** called by any action that modifies a buffer entry, so list screen can be updated if screen not recompiled "RTN","IBCNBLL",235,0) ; modifies a single line in the display array for a buffer entry that has been modified in some way "RTN","IBCNBLL",236,0) ; ACTION = REJECTED, ACCEPTED, EDITED "RTN","IBCNBLL",237,0) N IBARRN,IBOLD,IBNEW,IBO,IBN S IBO="0123456789",IBN="----------" "RTN","IBCNBLL",238,0) ; "RTN","IBCNBLL",239,0) S IBARRN=$G(^TMP("IBCNBLLY",$J,+$G(IBBUFDA))) Q:'IBARRN "RTN","IBCNBLL",240,0) S IBOLD=$G(^TMP("IBCNBLL",$J,+IBARRN,0)) Q:IBOLD="" "RTN","IBCNBLL",241,0) ; "RTN","IBCNBLL",242,0) ; if action is REJECTED or ACCEPTED then the patient name is replaced by the Action in the display array "RTN","IBCNBLL",243,0) ; and the buffer entry is removed from the list of entries that can be selected "RTN","IBCNBLL",244,0) I (ACTION="REJECTED")!(ACTION="ACCEPTED") D "RTN","IBCNBLL",245,0) . S IBNEW=$TR($E(IBOLD,1,5),IBO,IBN)_ACTION_$J("",7)_$E(IBOLD,21,999) "RTN","IBCNBLL",246,0) . S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW "RTN","IBCNBLL",247,0) ; "RTN","IBCNBLL",248,0) ; if the action is EDITED then the line for the buffer entry is recomplied and the updated line is set into "RTN","IBCNBLL",249,0) ; the display array "RTN","IBCNBLL",250,0) I ACTION="EDITED" D "RTN","IBCNBLL",251,0) . S IBNEW=$$BLDLN(IBBUFDA,+$P(IBARRN,U,2),$E(IBOLD,25)) "RTN","IBCNBLL",252,0) . S ^TMP("IBCNBLL",$J,+IBARRN,0)=IBNEW "RTN","IBCNBLL",253,0) Q "RTN","IBCNBLL",254,0) ; "RTN","IBCNBLL",255,0) SRCCNV(SRC) ; convert Source of Info acronym from field 355.12/.03 into 1 char code "RTN","IBCNBLL",256,0) N CODSTR,I,SRCSTR,CODE "RTN","IBCNBLL",257,0) S SRCSTR="INTVW^DMTCH^IVM^PreRg^eIV^HMS^MCR^ICB^CS^eRxEL" "RTN","IBCNBLL",258,0) S CODSTR="I^D^V^P^E^H^M^R^C^X" "RTN","IBCNBLL",259,0) S CODE="" "RTN","IBCNBLL",260,0) I $G(SRC)'="" F I=1:1:10 S:SRC=$P(SRCSTR,U,I) CODE=$P(CODSTR,U,I) Q:CODE'="" "RTN","IBCNBLL",261,0) Q CODE "RTN","IBCNEDE1") 0^17^B40267278 "RTN","IBCNEDE1",1,0) IBCNEDE1 ;DAOU/DAC - eIV INSURANCE BUFFER EXTRACT ;04-JUN-2002 "RTN","IBCNEDE1",2,0) ;;2.0;INTEGRATED BILLING;**184,271,416,438,435**;21-MAR-94;Build 27 "RTN","IBCNEDE1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNEDE1",4,0) ; "RTN","IBCNEDE1",5,0) ;**Program Description** "RTN","IBCNEDE1",6,0) ; This routine loops through the insurance buffer and "RTN","IBCNEDE1",7,0) ; creates eIV transaction queue entries when approriate. "RTN","IBCNEDE1",8,0) ; Periodically check for stop request for background task "RTN","IBCNEDE1",9,0) ; "RTN","IBCNEDE1",10,0) Q ; no direct calls allowed "RTN","IBCNEDE1",11,0) ; "RTN","IBCNEDE1",12,0) EN ; Loop through designated cross-references for updates "RTN","IBCNEDE1",13,0) ; Insurance Buffer Extract "RTN","IBCNEDE1",14,0) ; "RTN","IBCNEDE1",15,0) N TODAYSDT,FRESHDAY,LOOPDT,IEN,OVRFRESH,FRESHDT "RTN","IBCNEDE1",16,0) N DFN,PDOD,SRVICEDT,VERIFDDT,PAYERSTR,PAYERID,SYMBOL,PAYRNAME "RTN","IBCNEDE1",17,0) N PIEN,PNIEN,TQIEN,TRIEN,TRSRVCDT,TQCRTDT,TRANSNO,DISYS "RTN","IBCNEDE1",18,0) N ORIGINSR,ORGRPSTR,ORGRPNUM,ORGRPNAM,ORGSUBCR "RTN","IBCNEDE1",19,0) N MAXCNT,CNT,ISYMBOLM,DATA1,DATA2,ORIG,SETSTR,ISYMBOL,IBCNETOT "RTN","IBCNEDE1",20,0) N SIDDATA,SID,SIDACT,BSID,FDA,PASSBUF,SIDCNT,SIDARRAY "RTN","IBCNEDE1",21,0) N TQDT,TQIENS,TQOK,STATIEN,PATID,MCAREFLG,INSNAME "RTN","IBCNEDE1",22,0) ; "RTN","IBCNEDE1",23,0) S SETSTR=$$SETTINGS^IBCNEDE7(1) ; Returns buffer extract settings "RTN","IBCNEDE1",24,0) I 'SETSTR Q ; Quit if extract is not active "RTN","IBCNEDE1",25,0) S MAXCNT=$P(SETSTR,U,4) ; Max # TQ entries that may be created "RTN","IBCNEDE1",26,0) S:MAXCNT="" MAXCNT=9999999999 "RTN","IBCNEDE1",27,0) ; "RTN","IBCNEDE1",28,0) S FRESHDAY=$P($G(^IBE(350.9,1,51)),U,1) ; System freshness days "RTN","IBCNEDE1",29,0) ; "RTN","IBCNEDE1",30,0) S CNT=0 ; Initialize count of TQ entries created "RTN","IBCNEDE1",31,0) S IBCNETOT=0 ; Initialize count for periodic TaskMan check "RTN","IBCNEDE1",32,0) ; "RTN","IBCNEDE1",33,0) S LOOPDT="" ; Date used to loop throught the IB global "RTN","IBCNEDE1",34,0) F S LOOPDT=$O(^IBA(355.33,"AEST","E",LOOPDT)) Q:LOOPDT=""!(CNT=MAXCNT) D Q:$G(ZTSTOP) "RTN","IBCNEDE1",35,0) . S IEN="" "RTN","IBCNEDE1",36,0) . F S IEN=$O(^IBA(355.33,"AEST","E",LOOPDT,IEN)) Q:IEN=""!(CNT=MAXCNT) D Q:$G(ZTSTOP) "RTN","IBCNEDE1",37,0) .. ; Update count for periodic check "RTN","IBCNEDE1",38,0) .. S IBCNETOT=IBCNETOT+1 "RTN","IBCNEDE1",39,0) .. ; Check for request to stop background job, periodically "RTN","IBCNEDE1",40,0) .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q "RTN","IBCNEDE1",41,0) .. ; "RTN","IBCNEDE1",42,0) .. ; Get symbol, if symbol'=" " OR "!" then quit "RTN","IBCNEDE1",43,0) .. S ISYMBOL=$$SYMBOL^IBCNBLL(IEN) ; Insurance buffer symbol "RTN","IBCNEDE1",44,0) .. I (ISYMBOL'=" ")&(ISYMBOL'="!") Q "RTN","IBCNEDE1",45,0) .. ; "RTN","IBCNEDE1",46,0) .. ; Don't extract ePharmacy buffer entries - IB*2*435 "RTN","IBCNEDE1",47,0) .. I +$P($G(^IBA(355.33,IEN,0)),U,17) Q "RTN","IBCNEDE1",48,0) .. ; "RTN","IBCNEDE1",49,0) .. ; Get the eIV STATUS IEN and quit for response related errors "RTN","IBCNEDE1",50,0) .. S STATIEN=+$P($G(^IBA(355.33,IEN,0)),U,12) "RTN","IBCNEDE1",51,0) .. I ",11,12,15,"[(","_STATIEN_",") Q ; Prevent update for response errors "RTN","IBCNEDE1",52,0) .. ; "RTN","IBCNEDE1",53,0) .. S OVRFRESH=$P($G(^IBA(355.33,IEN,0)),U,13) ; Freshness OvrRd flag "RTN","IBCNEDE1",54,0) .. S DFN=$P($G(^IBA(355.33,IEN,60)),U,1) ; Patient DFN "RTN","IBCNEDE1",55,0) .. Q:DFN="" "RTN","IBCNEDE1",56,0) .. I $P($G(^DPT(DFN,0)),U,21) Q ; Exclude if test patient "RTN","IBCNEDE1",57,0) .. ; "RTN","IBCNEDE1",58,0) .. S PDOD=$P($G(^DPT(DFN,.35)),U,1)\1 ; Patient's date of death "RTN","IBCNEDE1",59,0) .. S SRVICEDT=DT I PDOD S SRVICEDT=PDOD ; Service Date "RTN","IBCNEDE1",60,0) .. S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-FRESHDAY) "RTN","IBCNEDE1",61,0) .. S PAYERSTR=$$INSERROR^IBCNEUT3("B",IEN) ; Payer String "RTN","IBCNEDE1",62,0) .. S PAYERID=$P(PAYERSTR,U,3),PIEN=$P(PAYERSTR,U,2) ; Payer ID "RTN","IBCNEDE1",63,0) .. S SYMBOL=+PAYERSTR ; Payer Symbol "RTN","IBCNEDE1",64,0) .. I '$$PYRACTV^IBCNEDE7(PIEN) Q ; Payer is not nationally active "RTN","IBCNEDE1",65,0) .. ; "RTN","IBCNEDE1",66,0) .. ; If payer symbol is returned set symbol in Ins. Buffer and quit "RTN","IBCNEDE1",67,0) .. I SYMBOL D BUFF^IBCNEUT2(IEN,SYMBOL) Q "RTN","IBCNEDE1",68,0) .. ; "RTN","IBCNEDE1",69,0) .. D CLEAR^IBCNEUT4(IEN) ; remove any existing symbol "RTN","IBCNEDE1",70,0) .. ; "RTN","IBCNEDE1",71,0) .. ; If no payer ID or no payer IEN is returned quit "RTN","IBCNEDE1",72,0) .. I (PAYERID="")!('PIEN) Q "RTN","IBCNEDE1",73,0) .. ; "RTN","IBCNEDE1",74,0) .. ; Update service date and freshness date based on payer's allowed "RTN","IBCNEDE1",75,0) .. ; date range "RTN","IBCNEDE1",76,0) .. D UPDDTS^IBCNEDE6(PIEN,.SRVICEDT,.FRESHDT) "RTN","IBCNEDE1",77,0) .. ; "RTN","IBCNEDE1",78,0) .. ; Update service dates for inquiries to be transmitted "RTN","IBCNEDE1",79,0) .. D TQUPDSV^IBCNEUT5(DFN,PIEN,SRVICEDT) "RTN","IBCNEDE1",80,0) .. ; "RTN","IBCNEDE1",81,0) .. ; allow only one MEDICARE transmission per patient "RTN","IBCNEDE1",82,0) .. S INSNAME=$P($G(^IBA(355.33,IEN,20)),U) "RTN","IBCNEDE1",83,0) .. I INSNAME["MEDICARE",$G(MCAREFLG(DFN)) Q "RTN","IBCNEDE1",84,0) .. ; "RTN","IBCNEDE1",85,0) .. ; make sure that entries have pat. relationship set to "self" "RTN","IBCNEDE1",86,0) .. D SETREL(IEN) "RTN","IBCNEDE1",87,0) .. ; make sure that service type codes are set "RTN","IBCNEDE1",88,0) .. I '+$G(^IBA(355.33,IEN,80)) D SETSTC^IBCNERTQ(IEN) "RTN","IBCNEDE1",89,0) .. ; "RTN","IBCNEDE1",90,0) .. ; If freshness override flag is set, file to TQ and quit "RTN","IBCNEDE1",91,0) .. I OVRFRESH=1 D Q "RTN","IBCNEDE1",92,0) ... NEW DIE,X,Y,DISYS "RTN","IBCNEDE1",93,0) ... S FDA(355.33,IEN_",",.13)="" D FILE^DIE("","FDA") K FDA "RTN","IBCNEDE1",94,0) ... S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ "RTN","IBCNEDE1",95,0) .. ; Check the existing TQ entries to confirm that this buffer IEN is "RTN","IBCNEDE1",96,0) .. ; not included "RTN","IBCNEDE1",97,0) .. S (TQDT,TQIENS)="",TQOK=1 "RTN","IBCNEDE1",98,0) .. F S TQDT=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT)) Q:'TQDT!'TQOK D "RTN","IBCNEDE1",99,0) ... F S TQIENS=$O(^IBCN(365.1,"AD",DFN,PIEN,TQDT,TQIENS)) Q:'TQIENS!'TQOK D "RTN","IBCNEDE1",100,0) .... I $P($G(^IBCN(365.1,TQIENS,0)),U,5)=IEN S TQOK=0 Q "RTN","IBCNEDE1",101,0) .. I TQOK S:INSNAME["MEDICARE" MCAREFLG(DFN)=1 D TQ "RTN","IBCNEDE1",102,0) Q "RTN","IBCNEDE1",103,0) TQ ; Determine how many entries to create in the TQ file and set entries "RTN","IBCNEDE1",104,0) ; "RTN","IBCNEDE1",105,0) S BSID=$P($G(^IBA(355.33,IEN,60)),U,4) ; Subscriber ID from buffer "RTN","IBCNEDE1",106,0) S PATID=$P($G(^IBA(355.33,IEN,62)),U,1) ; Patient ID from buffer IB*2*416 "RTN","IBCNEDE1",107,0) K SIDARRAY "RTN","IBCNEDE1",108,0) S SIDDATA=$$SIDCHK^IBCNEDE5(PIEN,DFN,BSID,.SIDARRAY,FRESHDT) ;determine rules to follow "RTN","IBCNEDE1",109,0) S SIDACT=$P(SIDDATA,U,1) "RTN","IBCNEDE1",110,0) S SIDCNT=$P(SIDDATA,U,2) ;Pull cnt of SIDs - shd be 1 "RTN","IBCNEDE1",111,0) ; "RTN","IBCNEDE1",112,0) I SIDACT=3 D BUFF^IBCNEUT2(IEN,18) Q ; update buffer w/ bang & quit "RTN","IBCNEDE1",113,0) I CNT+SIDCNT>MAXCNT Q "RTN","IBCNEDE1",114,0) S SID="" "RTN","IBCNEDE1",115,0) F S SID=$O(SIDARRAY(SID)) Q:SID="" D:$P(SID,"_")'="" SET(IEN,OVRFRESH,1,$P(SID,"_")) ; set TQ w/ 'Pass Buffer' flag "RTN","IBCNEDE1",116,0) I SIDACT=4 D SET(IEN,OVRFRESH,1,"") ; set TQ w/ 'Pass Buffer' flag w/ blank subscriber ID "RTN","IBCNEDE1",117,0) Q "RTN","IBCNEDE1",118,0) ; "RTN","IBCNEDE1",119,0) RET ; Record Retrieval - Insurance Buffer "RTN","IBCNEDE1",120,0) ; "RTN","IBCNEDE1",121,0) S ORIGINSR=$P($G(^IBA(355.33,IEN,20)),U,1) ;Original ins. co. "RTN","IBCNEDE1",122,0) S ORGRPSTR=$G(^IBA(355.33,IEN,40)) ; Original group string "RTN","IBCNEDE1",123,0) S ORGRPNUM=$P(ORGRPSTR,U,3) ;Original group number "RTN","IBCNEDE1",124,0) S ORGRPNAM=$P(ORGRPSTR,U,2) ;Original group name "RTN","IBCNEDE1",125,0) S ORGSUBCR=$P($G(^IBA(355.33,IEN,60)),U,4) ; Original subscriber "RTN","IBCNEDE1",126,0) ; "RTN","IBCNEDE1",127,0) Q "RTN","IBCNEDE1",128,0) ; "RTN","IBCNEDE1",129,0) SET(BUFFIEN,OVRFRESH,PASSBUF,SID1) ; Set data and check if set already "RTN","IBCNEDE1",130,0) D RET "RTN","IBCNEDE1",131,0) ; "RTN","IBCNEDE1",132,0) ; The hard coded '1' in the 3rd piece of DATA1 sets the Transmission "RTN","IBCNEDE1",133,0) ; status of file 365.1 to "Ready to Transmit" "RTN","IBCNEDE1",134,0) S DATA1=DFN_U_PIEN_U_1_U_$G(BUFFIEN)_U_SID1_U_FRESHDT_U_PASSBUF ; SETTQ parameter 1 "RTN","IBCNEDE1",135,0) S $P(DATA1,U,8)=PATID ; IB*2*416 "RTN","IBCNEDE1",136,0) ; "RTN","IBCNEDE1",137,0) ;The hardcoded '1' in the 1st piece of DATA2 is the value to tell "RTN","IBCNEDE1",138,0) ; the file 365.1 that it is the buffer extract. "RTN","IBCNEDE1",139,0) S DATA2=1_U_"V"_U_SRVICEDT_U_"" ; SETTQ parameter 2 "RTN","IBCNEDE1",140,0) ; "RTN","IBCNEDE1",141,0) S ORIG=ORIGINSR_U_ORGRPNUM_U_ORGRPNAM_U_ORGSUBCR ; SETTQ parameter 3 "RTN","IBCNEDE1",142,0) S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,ORIG,$G(OVRFRESH)) ; File TQ entry "RTN","IBCNEDE1",143,0) I TQIEN'="" S CNT=CNT+1 ; If filed increment count "RTN","IBCNEDE1",144,0) ; "RTN","IBCNEDE1",145,0) Q "RTN","IBCNEDE1",146,0) ; "RTN","IBCNEDE1",147,0) SETREL(IEN) ; set pat. relationship to "self" "RTN","IBCNEDE1",148,0) N DA,DIE,DR,X,Y "RTN","IBCNEDE1",149,0) I $P($G(^IBA(355.33,IEN,60)),U,14)="" S DIE="^IBA(355.33,",DA=IEN,DR="60.14///SELF" D ^DIE "RTN","IBCNEDE1",150,0) Q "RTN","IBCNEUT2") 0^16^B3063599 "RTN","IBCNEUT2",1,0) IBCNEUT2 ;DAOU/DAC - eIV MISC. UTILITIES ;06-JUN-2002 "RTN","IBCNEUT2",2,0) ;;2.0;INTEGRATED BILLING;**184,416,435**;21-MAR-94;Build 27 "RTN","IBCNEUT2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNEUT2",4,0) ; "RTN","IBCNEUT2",5,0) ; Can't be called from the top "RTN","IBCNEUT2",6,0) Q "RTN","IBCNEUT2",7,0) ; "RTN","IBCNEUT2",8,0) SAVETQ(IEN,TDT) ; Update service date in TQ record "RTN","IBCNEUT2",9,0) ; "RTN","IBCNEUT2",10,0) N DIE,DA,DR,D,D0,DI,DIC,DQ,X "RTN","IBCNEUT2",11,0) S DIE="^IBCN(365.1,",DA=IEN,DR=".12////"_TDT "RTN","IBCNEUT2",12,0) D ^DIE "RTN","IBCNEUT2",13,0) Q "RTN","IBCNEUT2",14,0) ; "RTN","IBCNEUT2",15,0) ; "RTN","IBCNEUT2",16,0) SST(IEN,STAT) ; Set the Transmission Queue Status "RTN","IBCNEUT2",17,0) ; Input parameters "RTN","IBCNEUT2",18,0) ; IEN = Internal entry number for the record "RTN","IBCNEUT2",19,0) ; STAT= Status IEN "RTN","IBCNEUT2",20,0) ; "RTN","IBCNEUT2",21,0) NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X "RTN","IBCNEUT2",22,0) ; "RTN","IBCNEUT2",23,0) I IEN="" Q "RTN","IBCNEUT2",24,0) ; "RTN","IBCNEUT2",25,0) S DIE="^IBCN(365.1,",DA=IEN,DR=".04////^S X=STAT;.15////^S X=$$NOW^XLFDT()" "RTN","IBCNEUT2",26,0) D ^DIE "RTN","IBCNEUT2",27,0) Q "RTN","IBCNEUT2",28,0) ; "RTN","IBCNEUT2",29,0) RSP(IEN,STAT) ; Set the Response File Status "RTN","IBCNEUT2",30,0) ; Input parameters "RTN","IBCNEUT2",31,0) ; IEN = Internal entry number for the record "RTN","IBCNEUT2",32,0) ; STAT= Status IEN "RTN","IBCNEUT2",33,0) ; "RTN","IBCNEUT2",34,0) NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X "RTN","IBCNEUT2",35,0) S DIE="^IBCN(365,",DA=IEN,DR=".06////^S X=STAT" "RTN","IBCNEUT2",36,0) D ^DIE "RTN","IBCNEUT2",37,0) Q "RTN","IBCNEUT2",38,0) ; "RTN","IBCNEUT2",39,0) BUFF(BUFF,BNG) ; Set error symbol into Buffer File "RTN","IBCNEUT2",40,0) ; Input Parameter "RTN","IBCNEUT2",41,0) ; BUFF = Buffer internal entry number "RTN","IBCNEUT2",42,0) ; BNG = Buffer Symbol IEN "RTN","IBCNEUT2",43,0) I 'BUFF!'BNG Q "RTN","IBCNEUT2",44,0) I +$P($G(^IBA(355.33,BUFF,0)),U,17) Q ; .12 field not for ePharmacy IB*2*435 "RTN","IBCNEUT2",45,0) NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,DISYS "RTN","IBCNEUT2",46,0) S DIE="^IBA(355.33,",DA=BUFF,DR=".12////^S X=BNG" "RTN","IBCNEUT2",47,0) D ^DIE "RTN","IBCNEUT2",48,0) Q "RTN","IBCNEUT2",49,0) ; "RTN","IBCNEUT2",50,0) PAYR ; Set up the '~NO PAYER' payer. This procedure is called by both "RTN","IBCNEUT2",51,0) ; the post-install routine and by the nightly batch extract routine. "RTN","IBCNEUT2",52,0) S DLAYGO=365.12,DIC(0)="L",DIC("P")=DLAYGO,DIC="^IBE(365.12," "RTN","IBCNEUT2",53,0) S X="~NO PAYER" D ^DIC "RTN","IBCNEUT2",54,0) S DA=+Y "RTN","IBCNEUT2",55,0) S DR=".02////^S X=""00000""",DIE=DIC D ^DIE "RTN","IBCNEUT2",56,0) ; "RTN","IBCNEUT2",57,0) K DA,DIC,DLAYGO,X,Y,D1,DILN,DISYS,IDUZ,DIE,DR,D0,D,DI,DIERR,DQ "RTN","IBCNEUT2",58,0) Q "RTN","IBCNEUT2",59,0) ; "RTN","IBCNRE4") 0^3^B31384444 "RTN","IBCNRE4",1,0) IBCNRE4 ;DAOU/DMK - Edit PLAN APPLICATION Sub-file ;23-DEC-2003 "RTN","IBCNRE4",2,0) ;;2.0;INTEGRATED BILLING;**251,435**;21-MAR-94;Build 27 "RTN","IBCNRE4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNRE4",4,0) ; "RTN","IBCNRE4",5,0) ; Specific to E-PHARM APPLICATION Entry "RTN","IBCNRE4",6,0) ; Edit LOCAL ACTIVE? Field "RTN","IBCNRE4",7,0) ; "RTN","IBCNRE4",8,0) ; 366.033 PLAN APPLICATION "RTN","IBCNRE4",9,0) ; .01 APPLICATION "RTN","IBCNRE4",10,0) ; .03 LOCAL ACTIVE? "RTN","IBCNRE4",11,0) ; "RTN","IBCNRE4",12,0) 1000 ; Control processing "RTN","IBCNRE4",13,0) N ANAME,APIEN,FIELDNO,FILENO,FILENO1,QUIT "RTN","IBCNRE4",14,0) N DISYS "RTN","IBCNRE4",15,0) ; "RTN","IBCNRE4",16,0) D INIT1 "RTN","IBCNRE4",17,0) D HEADING "RTN","IBCNRE4",18,0) F D 2000 Q:QUIT "RTN","IBCNRE4",19,0) Q "RTN","IBCNRE4",20,0) ; "RTN","IBCNRE4",21,0) 2000 ; Control processing "RTN","IBCNRE4",22,0) N CONTINUE,IEN,IENS,IENS1,KEY "RTN","IBCNRE4",23,0) ; "RTN","IBCNRE4",24,0) S QUIT=0 "RTN","IBCNRE4",25,0) ; "RTN","IBCNRE4",26,0) ; Control file entry selection and subfile entry validation "RTN","IBCNRE4",27,0) D IEN "RTN","IBCNRE4",28,0) I IEN=-1 S QUIT=1 Q "RTN","IBCNRE4",29,0) I APIEN=-1 Q "RTN","IBCNRE4",30,0) ; "RTN","IBCNRE4",31,0) ; Control file entry printing "RTN","IBCNRE4",32,0) D PRINT1 "RTN","IBCNRE4",33,0) ; "RTN","IBCNRE4",34,0) ; Control pause "RTN","IBCNRE4",35,0) D CONTINUE "RTN","IBCNRE4",36,0) ; "RTN","IBCNRE4",37,0) ; Control subfile entry printing "RTN","IBCNRE4",38,0) D PRINT2 "RTN","IBCNRE4",39,0) ; "RTN","IBCNRE4",40,0) ; Control subfile entry editing "RTN","IBCNRE4",41,0) D EDIT "RTN","IBCNRE4",42,0) Q "RTN","IBCNRE4",43,0) ; "RTN","IBCNRE4",44,0) CONTINUE ; Pause until user ready to continue "RTN","IBCNRE4",45,0) N CONTINUE "RTN","IBCNRE4",46,0) R !,"Press Enter / Return to continue: ",CONTINUE:$S($D(DTIME):DTIME,1:300) "RTN","IBCNRE4",47,0) W ! "RTN","IBCNRE4",48,0) Q "RTN","IBCNRE4",49,0) ; "RTN","IBCNRE4",50,0) EDIT ; Edit subfile entry data "RTN","IBCNRE4",51,0) ; 366.033 PLAN APPLICATION Subfile "RTN","IBCNRE4",52,0) ; "RTN","IBCNRE4",53,0) N DA,DIDEL,DIC,DIE,DLAYGO,DR,DTOUT,X,Y "RTN","IBCNRE4",54,0) N %,A,D,D0,DDER,DI,DISYS,DQ,OLD "RTN","IBCNRE4",55,0) ; "RTN","IBCNRE4",56,0) S DA=APIEN,DA(1)=IEN "RTN","IBCNRE4",57,0) S DIE=$$ROOT^DILFD(FILENO1,","_IEN_",") "RTN","IBCNRE4",58,0) ; "RTN","IBCNRE4",59,0) ; .03 LOCAL ACTIVE "RTN","IBCNRE4",60,0) S DR=".03R"_"~"_KEY_" - Local Active?" "RTN","IBCNRE4",61,0) ; "RTN","IBCNRE4",62,0) ; Quit if value unchanged "RTN","IBCNRE4",63,0) ; OLD = old value "RTN","IBCNRE4",64,0) ; X = new value "RTN","IBCNRE4",65,0) S OLD=$$GET1^DIQ(FILENO1,IENS1,.03,"I") "RTN","IBCNRE4",66,0) S DR=DR_";"_"S:OLD=X Y=""""" "RTN","IBCNRE4",67,0) ; "RTN","IBCNRE4",68,0) ; .04 USER EDITED LOCAL "RTN","IBCNRE4",69,0) S DR=DR_";"_".04////"_DUZ "RTN","IBCNRE4",70,0) ; "RTN","IBCNRE4",71,0) ; .05 DATE/TIME LOCAL EDITED "RTN","IBCNRE4",72,0) S DR=DR_";"_".05////"_$$NOW^XLFDT() "RTN","IBCNRE4",73,0) ; "RTN","IBCNRE4",74,0) D ^DIE "RTN","IBCNRE4",75,0) ; "RTN","IBCNRE4",76,0) W ! "RTN","IBCNRE4",77,0) Q "RTN","IBCNRE4",78,0) ; "RTN","IBCNRE4",79,0) HEADING ; Print heading "RTN","IBCNRE4",80,0) W @IOF "RTN","IBCNRE4",81,0) W "PLAN File Inquiry and Edit (E-PHARM)",! "RTN","IBCNRE4",82,0) Q "RTN","IBCNRE4",83,0) ; "RTN","IBCNRE4",84,0) IEN ; Select file entry "RTN","IBCNRE4",85,0) N I "RTN","IBCNRE4",86,0) ; "RTN","IBCNRE4",87,0) S IEN=$$SELECT1^IBCNRFM1(FILENO,"Select Plan ID: ") "RTN","IBCNRE4",88,0) I IEN=-1 Q "RTN","IBCNRE4",89,0) S IENS=IEN_"," "RTN","IBCNRE4",90,0) ; "RTN","IBCNRE4",91,0) ; E-PHARM APPLICATION Defined? "RTN","IBCNRE4",92,0) S APIEN=$$LOOKUP2^IBCNRFM1(FILENO,IEN,FIELDNO,ANAME) "RTN","IBCNRE4",93,0) I APIEN=-1 W " E-PHARM APPLICATION not defined" Q "RTN","IBCNRE4",94,0) S IENS1=APIEN_","_IEN_"," "RTN","IBCNRE4",95,0) Q "RTN","IBCNRE4",96,0) ; "RTN","IBCNRE4",97,0) INIT1 ; Initialize variables "RTN","IBCNRE4",98,0) S ANAME="E-PHARM" "RTN","IBCNRE4",99,0) S FIELDNO=3 "RTN","IBCNRE4",100,0) S FILENO=366.03 "RTN","IBCNRE4",101,0) S FILENO1=FILENO_FIELDNO "RTN","IBCNRE4",102,0) I '$D(IOF) D HOME^%ZIS "RTN","IBCNRE4",103,0) Q "RTN","IBCNRE4",104,0) ; "RTN","IBCNRE4",105,0) PRINT1 ; Print file entry data "RTN","IBCNRE4",106,0) ; 366.03 PLAN File "RTN","IBCNRE4",107,0) ; "RTN","IBCNRE4",108,0) N A "RTN","IBCNRE4",109,0) ; "RTN","IBCNRE4",110,0) W !! "RTN","IBCNRE4",111,0) ; "RTN","IBCNRE4",112,0) D GETS^DIQ(FILENO,IENS,"*","","A") "RTN","IBCNRE4",113,0) ; "RTN","IBCNRE4",114,0) ; .01 ID "RTN","IBCNRE4",115,0) S KEY=A(FILENO,IENS,.01) "RTN","IBCNRE4",116,0) W $J("Plan ID: ",40),$G(A(FILENO,IENS,.01)),! "RTN","IBCNRE4",117,0) ; "RTN","IBCNRE4",118,0) ; .07 DATE/TIME CREATED "RTN","IBCNRE4",119,0) W $J("Date/Time Created: ",40),$G(A(FILENO,IENS,.07)),! "RTN","IBCNRE4",120,0) ; "RTN","IBCNRE4",121,0) ; .02 NAME "RTN","IBCNRE4",122,0) W $J("Plan Name: ",40),$G(A(FILENO,IENS,.02)),! "RTN","IBCNRE4",123,0) ; "RTN","IBCNRE4",124,0) ; .04 NAME - SHORT "RTN","IBCNRE4",125,0) W $J("Plan Name - Short: ",40),$G(A(FILENO,IENS,.04)),! "RTN","IBCNRE4",126,0) ; "RTN","IBCNRE4",127,0) ; .03 PAYER NAME "RTN","IBCNRE4",128,0) W $J("Payer Name: ",40),$G(A(FILENO,IENS,.03)),! "RTN","IBCNRE4",129,0) ; "RTN","IBCNRE4",130,0) ; .05 TYPE "RTN","IBCNRE4",131,0) W $J("Type: ",40),$G(A(FILENO,IENS,.05)),! "RTN","IBCNRE4",132,0) ; "RTN","IBCNRE4",133,0) ; .06 REGION "RTN","IBCNRE4",134,0) W $J("Region: ",40),$G(A(FILENO,IENS,.06)),! "RTN","IBCNRE4",135,0) ; "RTN","IBCNRE4",136,0) ; 10.01 PHARMACY BENEFITS MANAGER NAME "RTN","IBCNRE4",137,0) W $J("Pharmacy Benefits Manager (PBM) Name: ",40),$G(A(FILENO,IENS,10.01)),! "RTN","IBCNRE4",138,0) ; "RTN","IBCNRE4",139,0) ; 10.02 BANKING IDENTIFICATION NUMBER "RTN","IBCNRE4",140,0) W $J("Banking Identification Number (BIN): ",40),$G(A(FILENO,IENS,10.02)),! "RTN","IBCNRE4",141,0) ; "RTN","IBCNRE4",142,0) ; 10.03 PROCESSOR CONTROL NUMBER (PCN) "RTN","IBCNRE4",143,0) W $J("Processor Control Number (PCN): ",40),$G(A(FILENO,IENS,10.03)),! "RTN","IBCNRE4",144,0) ; "RTN","IBCNRE4",145,0) ; 10.04 NCPDP PROCESSOR NAME "RTN","IBCNRE4",146,0) W $J("NCPDP Processor Name: ",40),$G(A(FILENO,IENS,10.04)),! "RTN","IBCNRE4",147,0) ; "RTN","IBCNRE4",148,0) ; 10.05 ENABLED? "RTN","IBCNRE4",149,0) W $J("Enabled?: ",40),$G(A(FILENO,IENS,10.05)),! "RTN","IBCNRE4",150,0) ; "RTN","IBCNRE4",151,0) ; 10.06 SOFTWARE VENDOR ID "RTN","IBCNRE4",152,0) W $J("Software Vendor ID: ",40),$G(A(FILENO,IENS,10.06)),! "RTN","IBCNRE4",153,0) ; "RTN","IBCNRE4",154,0) ; 10.07 BILLING PAYER SHEET NAME "RTN","IBCNRE4",155,0) W $J("Billing Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.07)),! "RTN","IBCNRE4",156,0) ; "RTN","IBCNRE4",157,0) ; 10.08 REVERSAL PAYER SHEET NAME "RTN","IBCNRE4",158,0) W $J("Reversal Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.08)),! "RTN","IBCNRE4",159,0) ; "RTN","IBCNRE4",160,0) ; 10.09 REBILL PAYER SHEET NAME "RTN","IBCNRE4",161,0) W $J("Rebill Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.09)),! "RTN","IBCNRE4",162,0) ; "RTN","IBCNRE4",163,0) ; 10.15 ELIGIBILITY PAYER SHEET NAME "RTN","IBCNRE4",164,0) W $J("Eligibility Verification Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.15)),! "RTN","IBCNRE4",165,0) ; "RTN","IBCNRE4",166,0) ; 10.1 MAXIMUM NCPDP TRANSACTIONS "RTN","IBCNRE4",167,0) W $J("Maximum NCPDP Transactions: ",40),$G(A(FILENO,IENS,10.1)),! "RTN","IBCNRE4",168,0) ; "RTN","IBCNRE4",169,0) ; 10.11 TEST BILLING PAYER SHEET NAME "RTN","IBCNRE4",170,0) W $J("Test Billing Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.11)),! "RTN","IBCNRE4",171,0) ; "RTN","IBCNRE4",172,0) ; 10.12 TEST REVERSAL PAYER SHEET NAME "RTN","IBCNRE4",173,0) W $J("Test Reversal Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.12)),! "RTN","IBCNRE4",174,0) ; "RTN","IBCNRE4",175,0) ; 10.13 TEST REBILL PAYER SHEET NAME "RTN","IBCNRE4",176,0) W $J("Test Rebill Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.13)),! "RTN","IBCNRE4",177,0) ; "RTN","IBCNRE4",178,0) ; 10.14 TEST ELIGIBILITY PAYER SHEET NAME "RTN","IBCNRE4",179,0) W $J("Test Eligibility Verification Payer Sheet Name: ",40),$G(A(FILENO,IENS,10.14)),! "RTN","IBCNRE4",180,0) Q "RTN","IBCNRE4",181,0) ; "RTN","IBCNRE4",182,0) PRINT2 ; Print subfile entry data "RTN","IBCNRE4",183,0) ; 366.033 PLAN APPLICATION Subfile "RTN","IBCNRE4",184,0) ; "RTN","IBCNRE4",185,0) N A "RTN","IBCNRE4",186,0) ; "RTN","IBCNRE4",187,0) W ! "RTN","IBCNRE4",188,0) ; "RTN","IBCNRE4",189,0) D GETS^DIQ(FILENO1,IENS1,"*","","A") "RTN","IBCNRE4",190,0) ; "RTN","IBCNRE4",191,0) ; .01 APPLICATION "RTN","IBCNRE4",192,0) W $J("Application: ",40),$G(A(FILENO1,IENS1,.01)),! "RTN","IBCNRE4",193,0) ; "RTN","IBCNRE4",194,0) ; .13 DATE/TIME CREATED "RTN","IBCNRE4",195,0) W $J("Date/Time Created: ",40),$G(A(FILENO1,IENS1,.13)),! "RTN","IBCNRE4",196,0) ; "RTN","IBCNRE4",197,0) ; .11 DEACTIVATED "RTN","IBCNRE4",198,0) W $J("Deactivated? ",40),$G(A(FILENO1,IENS1,.11)),! "RTN","IBCNRE4",199,0) ; "RTN","IBCNRE4",200,0) ; .12 DATE/TIME DEACTIVATED "RTN","IBCNRE4",201,0) W $J("Date/Time Deactivated: ",40),$G(A(FILENO1,IENS1,.12)),! "RTN","IBCNRE4",202,0) ; "RTN","IBCNRE4",203,0) ; .02 NATIONAL ACTIVE "RTN","IBCNRE4",204,0) W $J("National Active? ",40),$G(A(FILENO1,IENS1,.02)),! "RTN","IBCNRE4",205,0) ; "RTN","IBCNRE4",206,0) ; .06 DATE/TIME NATIONAL EDITED "RTN","IBCNRE4",207,0) W $J("Date/Time National Edited: ",40),$G(A(FILENO1,IENS1,.06)),! "RTN","IBCNRE4",208,0) ; "RTN","IBCNRE4",209,0) ; .03 LOCAL ACTIVE "RTN","IBCNRE4",210,0) W $J("Local Active? ",40),$G(A(FILENO1,IENS1,.03)),! "RTN","IBCNRE4",211,0) ; "RTN","IBCNRE4",212,0) ; .05 DATE/TIME LOCAL EDITED "RTN","IBCNRE4",213,0) W $J("Date/Time Local Edited: ",40),$G(A(FILENO1,IENS1,.05)),! "RTN","IBCNRE4",214,0) ; "RTN","IBCNRE4",215,0) ; .04 USER EDITED LOCAL "RTN","IBCNRE4",216,0) W $J("User Edited Local: ",40),$G(A(FILENO1,IENS1,.04)),! "RTN","IBCNRE4",217,0) Q "RTN","IBCNRHLT") 0^11^B14102069 "RTN","IBCNRHLT",1,0) IBCNRHLT ;DAOU/DMK - Receive HL7 e-Pharmacy MFN Message ;23-OCT-2003 "RTN","IBCNRHLT",2,0) ;;2.0;INTEGRATED BILLING;**251,435**;21-MAR-94;Build 27 "RTN","IBCNRHLT",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNRHLT",4,0) ; "RTN","IBCNRHLT",5,0) ; Description "RTN","IBCNRHLT",6,0) ; "RTN","IBCNRHLT",7,0) ; Receive HL7 e-Pharmacy MFN Message "RTN","IBCNRHLT",8,0) ; Table Update "RTN","IBCNRHLT",9,0) ; "RTN","IBCNRHLT",10,0) ; Control processing of segments "RTN","IBCNRHLT",11,0) ; "RTN","IBCNRHLT",12,0) ; Required segments listed in order "RTN","IBCNRHLT",13,0) ; MSH (Message Header Segment) (processed by IBCNEHLT) "RTN","IBCNRHLT",14,0) ; MFI (Master File Identifier Segment) (processed by IBCNEHLT) "RTN","IBCNRHLT",15,0) ; MFE (Master File Entry Segment) "RTN","IBCNRHLT",16,0) ; "RTN","IBCNRHLT",17,0) ; Optional segments listed by file "RTN","IBCNRHLT",18,0) ; ZP0 (365.12 PAYER File Update Segment) "RTN","IBCNRHLT",19,0) ; "RTN","IBCNRHLT",20,0) ; ZPT (366.01 NCPDP PROCESSOR File Update Segment) "RTN","IBCNRHLT",21,0) ; ZCM (366.012 NCPDP PROCESSOR CONTACT MEANS Subfile Update Segment) "RTN","IBCNRHLT",22,0) ; "RTN","IBCNRHLT",23,0) ; ZPB (366.02 PHARMACY BENEFITS MANAGER (PBM) File Update Segment) "RTN","IBCNRHLT",24,0) ; ZCM (366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile "RTN","IBCNRHLT",25,0) ; Update Segment) "RTN","IBCNRHLT",26,0) ; "RTN","IBCNRHLT",27,0) ; ZPL (366.03 PLAN File Update Segment) "RTN","IBCNRHLT",28,0) ; ZCM (366.032 PLAN CONTACT MEANS Subfile Update Segment) "RTN","IBCNRHLT",29,0) ; "RTN","IBCNRHLT",30,0) ; ZRX (366.03 PLAN File (Pharmacy) Update Segment) "RTN","IBCNRHLT",31,0) ; ZCM (366.0312 PLAN RX CONTACT MEANS Subfile Update Segment) "RTN","IBCNRHLT",32,0) ; "RTN","IBCNRHLT",33,0) ; Called by IBCNEHLT if all of the following are true "RTN","IBCNRHLT",34,0) ; * File # (MFI Segment) = 365.12, 366.01, 366.02, or 366.03 "RTN","IBCNRHLT",35,0) ; * Primary Key Value (MFE Segment) does not contain "IIV" "RTN","IBCNRHLT",36,0) ; * Segment ID (every segment) = MFE, ZCM, ZP0, ZPB, ZPL, ZPT, or ZRX "RTN","IBCNRHLT",37,0) ; "RTN","IBCNRHLT",38,0) ; Entry point "RTN","IBCNRHLT",39,0) ; "RTN","IBCNRHLT",40,0) 1000 ; Control processing "RTN","IBCNRHLT",41,0) I $D(ERROR) Q "RTN","IBCNRHLT",42,0) D @SEG "RTN","IBCNRHLT",43,0) ; "RTN","IBCNRHLT",44,0) ; Initialize MFK Message (Application Acknowledgement) variables "RTN","IBCNRHLT",45,0) I $D(ERROR) D Q "RTN","IBCNRHLT",46,0) . S DATAMFK("ERROR")=ERROR "RTN","IBCNRHLT",47,0) . S DATAMFK("IEN")=IEN "RTN","IBCNRHLT",48,0) ; "RTN","IBCNRHLT",49,0) ; Quit if more segments "RTN","IBCNRHLT",50,0) I $O(^TMP($J,"IBCNEHLI",HCT))]"" Q "RTN","IBCNRHLT",51,0) ; "RTN","IBCNRHLT",52,0) ; Update File? "RTN","IBCNRHLT",53,0) I $D(DATA) D "RTN","IBCNRHLT",54,0) . S FIELDNO="" F S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D "RTN","IBCNRHLT",55,0) .. ; "RTN","IBCNRHLT",56,0) .. ; Convert "" to "@" to delete field value if necessary "RTN","IBCNRHLT",57,0) .. I IEN'=-1,DATA(FIELDNO)="" S DATA(FIELDNO)="@" "RTN","IBCNRHLT",58,0) .. ; "RTN","IBCNRHLT",59,0) .. ; Convert HL7 special characters if necessary "RTN","IBCNRHLT",60,0) .. I DATA(FIELDNO)[$E(HLECH,3) S DATA(FIELDNO)=$$TRAN1^IBCNRHLU(DATA(FIELDNO)) "RTN","IBCNRHLT",61,0) . D FILE "RTN","IBCNRHLT",62,0) ; "RTN","IBCNRHLT",63,0) ; Update APPLICATION Subfile? "RTN","IBCNRHLT",64,0) I $D(DATAAP) D "RTN","IBCNRHLT",65,0) . S FIELDNO="" F S FIELDNO=$O(DATAAP(FIELDNO)) Q:FIELDNO="" D "RTN","IBCNRHLT",66,0) .. ; "RTN","IBCNRHLT",67,0) .. ; Convert "" to "@" to delete field value if necessary "RTN","IBCNRHLT",68,0) .. I APIEN'=-1,DATAAP(FIELDNO)="" S DATAAP(FIELDNO)="@" "RTN","IBCNRHLT",69,0) .. ; "RTN","IBCNRHLT",70,0) .. ; Convert HL7 special characters if necessary "RTN","IBCNRHLT",71,0) .. I DATAAP(FIELDNO)[$E(HLECH,3) S DATAAP(FIELDNO)=$$TRAN1^IBCNRHLU(DATAAP(FIELDNO)) "RTN","IBCNRHLT",72,0) . S FIELDNO=$S(FILENO=365.12:1,1:3) "RTN","IBCNRHLT",73,0) . D FILEAP "RTN","IBCNRHLT",74,0) ; "RTN","IBCNRHLT",75,0) ; Update CONTACT MEANS Subfile? "RTN","IBCNRHLT",76,0) I $D(DATACM) D "RTN","IBCNRHLT",77,0) . S FIELDNO="" F S FIELDNO=$O(DATACM(FIELDNO)) Q:FIELDNO="" D "RTN","IBCNRHLT",78,0) .. ; "RTN","IBCNRHLT",79,0) .. ; Convert "" to "@" to delete field value if necessary "RTN","IBCNRHLT",80,0) .. I CMIEN'=-1,DATACM(FIELDNO)="" S DATACM(FIELDNO)="@" "RTN","IBCNRHLT",81,0) .. ; "RTN","IBCNRHLT",82,0) .. ; Convert HL7 special characters if necessary "RTN","IBCNRHLT",83,0) .. I DATACM(FIELDNO)[$E(HLECH,3) S DATACM(FIELDNO)=$$TRAN1^IBCNRHLU(DATACM(FIELDNO)) "RTN","IBCNRHLT",84,0) . S FIELDNO=$S(FILE["Pharmacy"&FILENO=366.03:12,1:2) "RTN","IBCNRHLT",85,0) . I IBCNACT="MDL" D DELETECM Q "RTN","IBCNRHLT",86,0) . D FILECM "RTN","IBCNRHLT",87,0) Q "RTN","IBCNRHLT",88,0) ; "RTN","IBCNRHLT",89,0) ADD ; Add File entry "RTN","IBCNRHLT",90,0) ; 365.12 PAYER File "RTN","IBCNRHLT",91,0) ; 366.01 NCPDP PROCESSOR File "RTN","IBCNRHLT",92,0) ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File "RTN","IBCNRHLT",93,0) ; 366.03 PLAN File "RTN","IBCNRHLT",94,0) ; "RTN","IBCNRHLT",95,0) S IEN=$$ADD1^IBCNRFM1(FILENO,DATA(.01)) "RTN","IBCNRHLT",96,0) Q "RTN","IBCNRHLT",97,0) ; "RTN","IBCNRHLT",98,0) ADDAP ; Add APPLICATION Subfile entry "RTN","IBCNRHLT",99,0) ; 365.121 PAYER APPLICATION Subfile "RTN","IBCNRHLT",100,0) ; 366.013 NCPDP PROCESSOR APPLICATION File "RTN","IBCNRHLT",101,0) ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile "RTN","IBCNRHLT",102,0) ; 366.033 PLAN APPLICATION Subfile "RTN","IBCNRHLT",103,0) ; "RTN","IBCNRHLT",104,0) S APIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,AIEN) "RTN","IBCNRHLT",105,0) Q "RTN","IBCNRHLT",106,0) ; "RTN","IBCNRHLT",107,0) ADDCM ; Add CONTACT MEANS Subfile entry "RTN","IBCNRHLT",108,0) ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile "RTN","IBCNRHLT",109,0) ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile "RTN","IBCNRHLT",110,0) ; 366.032 PLAN CONTACT MEANS Subfile "RTN","IBCNRHLT",111,0) ; 366.0312 PLAN RX CONTACT MEANS Subfile "RTN","IBCNRHLT",112,0) ; "RTN","IBCNRHLT",113,0) S CMIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01)) "RTN","IBCNRHLT",114,0) Q "RTN","IBCNRHLT",115,0) ; "RTN","IBCNRHLT",116,0) DELETECM ; Delete CONTACT MEANS Subfile entry "RTN","IBCNRHLT",117,0) ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile "RTN","IBCNRHLT",118,0) ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile "RTN","IBCNRHLT",119,0) ; 366.032 PLAN CONTACT MEANS Subfile "RTN","IBCNRHLT",120,0) ; 366.0312 PLAN RX CONTACT MEANS Subfile "RTN","IBCNRHLT",121,0) ; "RTN","IBCNRHLT",122,0) D DELETE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN) "RTN","IBCNRHLT",123,0) Q "RTN","IBCNRHLT",124,0) ; "RTN","IBCNRHLT",125,0) FILE ; File data "RTN","IBCNRHLT",126,0) ; 365.12 PAYER File "RTN","IBCNRHLT",127,0) ; 366.01 NCPDP PROCESSOR File "RTN","IBCNRHLT",128,0) ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File "RTN","IBCNRHLT",129,0) ; 366.03 PLAN File "RTN","IBCNRHLT",130,0) ; "RTN","IBCNRHLT",131,0) ; Add? "RTN","IBCNRHLT",132,0) I IEN=-1 D ADD "RTN","IBCNRHLT",133,0) ; "RTN","IBCNRHLT",134,0) ; Update "RTN","IBCNRHLT",135,0) D FILE1^IBCNRFM1(FILENO,IEN,.DATA) "RTN","IBCNRHLT",136,0) Q "RTN","IBCNRHLT",137,0) ; "RTN","IBCNRHLT",138,0) FILEAP ; File APPLICATION Subfile data "RTN","IBCNRHLT",139,0) ; 365.121 PAYER APPLICATION Subfile "RTN","IBCNRHLT",140,0) ; 366.013 NCPDP PROCESSOR APPLICATION Subfile "RTN","IBCNRHLT",141,0) ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile "RTN","IBCNRHLT",142,0) ; 366.033 PLAN APPLICATION Subfile "RTN","IBCNRHLT",143,0) ; "RTN","IBCNRHLT",144,0) ; Add? "RTN","IBCNRHLT",145,0) I APIEN=-1 D ADDAP "RTN","IBCNRHLT",146,0) ; "RTN","IBCNRHLT",147,0) ; Update "RTN","IBCNRHLT",148,0) D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,APIEN,.DATAAP) "RTN","IBCNRHLT",149,0) Q "RTN","IBCNRHLT",150,0) ; "RTN","IBCNRHLT",151,0) FILECM ; File CONTACT MEANS Subfile data "RTN","IBCNRHLT",152,0) ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile "RTN","IBCNRHLT",153,0) ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile "RTN","IBCNRHLT",154,0) ; 366.032 PLAN CONTACT MEANS Subfile "RTN","IBCNRHLT",155,0) ; 366.0312 PLAN RX CONTACT MEANS Subfile "RTN","IBCNRHLT",156,0) ; "RTN","IBCNRHLT",157,0) ; Add? "RTN","IBCNRHLT",158,0) I CMIEN=-1 D ADDCM "RTN","IBCNRHLT",159,0) ; "RTN","IBCNRHLT",160,0) ; Update "RTN","IBCNRHLT",161,0) D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN,.DATACM) "RTN","IBCNRHLT",162,0) Q "RTN","IBCNRHLT",163,0) ; "RTN","IBCNRHLT",164,0) MFE ; Process MFE Segment "RTN","IBCNRHLT",165,0) D ^IBCNRMFE "RTN","IBCNRHLT",166,0) Q "RTN","IBCNRHLT",167,0) ; "RTN","IBCNRHLT",168,0) ZP0 ; Process ZP0 Segment "RTN","IBCNRHLT",169,0) D ^IBCNRZP0 "RTN","IBCNRHLT",170,0) Q "RTN","IBCNRHLT",171,0) ; "RTN","IBCNRHLT",172,0) ZCM ; Process ZCM Segment "RTN","IBCNRHLT",173,0) D ^IBCNRZCM "RTN","IBCNRHLT",174,0) Q "RTN","IBCNRHLT",175,0) ; "RTN","IBCNRHLT",176,0) ZPB ; Process ZPB Segment "RTN","IBCNRHLT",177,0) D ^IBCNRZPB "RTN","IBCNRHLT",178,0) Q "RTN","IBCNRHLT",179,0) ; "RTN","IBCNRHLT",180,0) ZPL ; Process ZPL Segment "RTN","IBCNRHLT",181,0) D ^IBCNRZPL "RTN","IBCNRHLT",182,0) Q "RTN","IBCNRHLT",183,0) ; "RTN","IBCNRHLT",184,0) ZPT ; Process ZPT Segment "RTN","IBCNRHLT",185,0) D ^IBCNRZPT "RTN","IBCNRHLT",186,0) Q "RTN","IBCNRHLT",187,0) ; "RTN","IBCNRHLT",188,0) ZRX ; Process ZRX Segment "RTN","IBCNRHLT",189,0) D ^IBCNRZRX "RTN","IBCNRHLT",190,0) Q "RTN","IBCNRPSM") 0^4^B12153957 "RTN","IBCNRPSM",1,0) IBCNRPSM ;DAOU/CMW - Match Test Payer Sheet to a Pharmacy Plan ;10-DEC-2003 "RTN","IBCNRPSM",2,0) ;;2.0;INTEGRATED BILLING;**251,435**;21-MAR-94;Build 27 "RTN","IBCNRPSM",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNRPSM",4,0) ; "RTN","IBCNRPSM",5,0) EN(IBCNSP) ; Main entry point for IBCNR PAYERSHEET MATCH (LIST TEMPLATE) "RTN","IBCNRPSM",6,0) D EN^VALM("IBCNR PAYERSHEET MATCH") "RTN","IBCNRPSM",7,0) Q "RTN","IBCNRPSM",8,0) ; "RTN","IBCNRPSM",9,0) HDR ; Header code "RTN","IBCNRPSM",10,0) N IBCNS0,IBCNSID,IBCNSNM,IBCNS10,IBCNSPBM,IBCNSBIN,IBCNSPCN,IBCNS3 "RTN","IBCNRPSM",11,0) N IBCNSNST,IBCNSLST,IBCNSHDR,X "RTN","IBCNRPSM",12,0) S IBCNS0=$G(^IBCNR(366.03,+IBCNSP,0)) "RTN","IBCNRPSM",13,0) S IBCNSID=$P(IBCNS0,"^",1) ;id "RTN","IBCNRPSM",14,0) S IBCNSNM=$P(IBCNS0,"^",2) ;name "RTN","IBCNRPSM",15,0) S IBCNS10=$G(^IBCNR(366.03,+IBCNSP,10)) "RTN","IBCNRPSM",16,0) S IBCNSPBM=$P(IBCNS10,"^",1) ;pbm "RTN","IBCNRPSM",17,0) I IBCNSPBM S IBCNSPBM=$P($G(^IBCNR(366.02,+IBCNSPBM,0)),"^",1) ; pbm name "RTN","IBCNRPSM",18,0) S IBCNSBIN=$P(IBCNS10,"^",2) ;bin "RTN","IBCNRPSM",19,0) S IBCNSPCN=$P(IBCNS10,"^",3) ;pcn "RTN","IBCNRPSM",20,0) S IBCNS3=$G(^IBCNR(366.03,+IBCNSP,3,1,0)) ; appl "RTN","IBCNRPSM",21,0) S IBCNSNST=$S($P(IBCNS3,"^",2)=0:"Inactive",1:"Active") "RTN","IBCNRPSM",22,0) S IBCNSLST=$S($P(IBCNS3,"^",3)=0:"Inactive",1:"Active") "RTN","IBCNRPSM",23,0) ; Header Line 1 "RTN","IBCNRPSM",24,0) S IBCNSHDR="PLAN: " "RTN","IBCNRPSM",25,0) S X=IBCNSID_" - "_IBCNSNM "RTN","IBCNRPSM",26,0) S VALMHDR(1)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80) "RTN","IBCNRPSM",27,0) ; Header Line 2 "RTN","IBCNRPSM",28,0) S IBCNSHDR="PBM: "_IBCNSPBM "RTN","IBCNRPSM",29,0) S X=" BIN: "_IBCNSBIN_" PCN: "_IBCNSPCN "RTN","IBCNRPSM",30,0) S VALMHDR(2)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80) "RTN","IBCNRPSM",31,0) ; Header Line 3 "RTN","IBCNRPSM",32,0) S IBCNSHDR="STATUS: " "RTN","IBCNRPSM",33,0) S X="National "_IBCNSNST_"/Local "_IBCNSLST "RTN","IBCNRPSM",34,0) S VALMHDR(3)=$$SETSTR^VALM1(X,IBCNSHDR,$L(IBCNSHDR)+1,80) "RTN","IBCNRPSM",35,0) Q "RTN","IBCNRPSM",36,0) ; "RTN","IBCNRPSM",37,0) INIT ; Init variables and list array "RTN","IBCNRPSM",38,0) N TCODE,IBCNS10,I,TPS,X,NUMBER,PSN "RTN","IBCNRPSM",39,0) K ^TMP("IBCNR",$J),TCODE "RTN","IBCNRPSM",40,0) S VALMCNT=0,VALMBG=1 "RTN","IBCNRPSM",41,0) S TCODE(1)="BILLING (B1)" "RTN","IBCNRPSM",42,0) S TCODE(2)="REVERSAL (B2)" "RTN","IBCNRPSM",43,0) S TCODE(3)="REBILL (B3)" "RTN","IBCNRPSM",44,0) S TCODE(4)="ELIGIBILITY (E1)" "RTN","IBCNRPSM",45,0) S IBCNS10=$G(^IBCNR(366.03,IBCNSP,10)) "RTN","IBCNRPSM",46,0) F I=1:1:4 S TPS=$P(IBCNS10,"^",10+I) D "RTN","IBCNRPSM",47,0) . ; Set up Index Number "RTN","IBCNRPSM",48,0) . S VALMCNT=I "RTN","IBCNRPSM",49,0) . S X=$$SETFLD^VALM1(VALMCNT,"","NUMBER") "RTN","IBCNRPSM",50,0) . ; Set up Transaction code "RTN","IBCNRPSM",51,0) . S X=$$SETFLD^VALM1(TCODE(I),X,"TCODE") "RTN","IBCNRPSM",52,0) . ; Set up the payer sheet name "RTN","IBCNRPSM",53,0) . I $G(TPS) S PSN=$G(^BPSF(9002313.92,TPS,0)) "RTN","IBCNRPSM",54,0) . I '$G(TPS) S PSN="NOT FOUND" "RTN","IBCNRPSM",55,0) . S X=$$SETFLD^VALM1(PSN,X,"PSHEET") "RTN","IBCNRPSM",56,0) . ; Set up temporary array "RTN","IBCNRPSM",57,0) . S ^TMP("IBCNR",$J,VALMCNT,0)=X "RTN","IBCNRPSM",58,0) . S ^TMP("IBCNR",$J,"IDX",VALMCNT,VALMCNT)=IBCNSP "RTN","IBCNRPSM",59,0) Q "RTN","IBCNRPSM",60,0) ; "RTN","IBCNRPSM",61,0) HELP ; Help code "RTN","IBCNRPSM",62,0) I $D(X),X'["??" D "RTN","IBCNRPSM",63,0) . W !,"Possible actions are the following:" "RTN","IBCNRPSM",64,0) . S X="?" D DISP^XQORM1,PAUSE^VALM1 "RTN","IBCNRPSM",65,0) Q "RTN","IBCNRPSM",66,0) ; "RTN","IBCNRPSM",67,0) EXIT ; Exit code "RTN","IBCNRPSM",68,0) K ^TMP("IBCNR",$J),VALMY "RTN","IBCNRPSM",69,0) D CLEAN^VALM10 "RTN","IBCNRPSM",70,0) Q "RTN","IBCNRPSM",71,0) ; "RTN","IBCNRPSM",72,0) EXPND ; Expand code "RTN","IBCNRPSM",73,0) Q "RTN","IBCNRPSM",74,0) ; "RTN","IBCNRPSM",75,0) SEL ; Add Payer Sheet to Plan "RTN","IBCNRPSM",76,0) ; Get the transaction code "RTN","IBCNRPSM",77,0) N IBX,IBSEL,IBDR "RTN","IBCNRPSM",78,0) D S1 "RTN","IBCNRPSM",79,0) I 'IBX Q "RTN","IBCNRPSM",80,0) ; Get the Payer Sheet Name "RTN","IBCNRPSM",81,0) N DIC,Y,X,DTOUT,DUOUT "RTN","IBCNRPSM",82,0) N DA,DIE,DR "RTN","IBCNRPSM",83,0) S DIC="^BPSF(9002313.92,",DIC(0)="AEMZ",DIC("S")="I $P(^(1),U,6)=2" "RTN","IBCNRPSM",84,0) S DIC("B")=$$GET1^DIQ(366.03,IBSEL,IBDR) "RTN","IBCNRPSM",85,0) D ^DIC "RTN","IBCNRPSM",86,0) I +Y<1 W !!,"No Payer Sheet Selected!" D PAUSE^VALM1 Q "RTN","IBCNRPSM",87,0) ; Do the insert "RTN","IBCNRPSM",88,0) S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"////^S X="_+Y "RTN","IBCNRPSM",89,0) D ^DIE "RTN","IBCNRPSM",90,0) ; Rebuild ListMan screen data "RTN","IBCNRPSM",91,0) D INIT "RTN","IBCNRPSM",92,0) Q "RTN","IBCNRPSM",93,0) ; "RTN","IBCNRPSM",94,0) DEL ; Delete Payer Sheet from Plan "RTN","IBCNRPSM",95,0) ; Get the transaction code "RTN","IBCNRPSM",96,0) N IBX,IBSEL,IBDR "RTN","IBCNRPSM",97,0) D S1 "RTN","IBCNRPSM",98,0) I 'IBX Q "RTN","IBCNRPSM",99,0) ; Do the deletion "RTN","IBCNRPSM",100,0) N DA,DIE,DR "RTN","IBCNRPSM",101,0) S DA=IBSEL,DIE="^IBCNR(366.03,",DR=IBDR_"///@" "RTN","IBCNRPSM",102,0) D ^DIE "RTN","IBCNRPSM",103,0) ; Rebuild ListMan screen data "RTN","IBCNRPSM",104,0) D INIT "RTN","IBCNRPSM",105,0) Q "RTN","IBCNRPSM",106,0) ; "RTN","IBCNRPSM",107,0) S1 ; Prompt for transaction code "RTN","IBCNRPSM",108,0) N VALMY "RTN","IBCNRPSM",109,0) D FULL^VALM1,EN^VALM2($G(XQORNOD(0)),"S") "RTN","IBCNRPSM",110,0) ; Store transaction code in IBX "RTN","IBCNRPSM",111,0) S IBX=$O(VALMY(0)) "RTN","IBCNRPSM",112,0) ; Set variable to refresh the screen when returning from the action "RTN","IBCNRPSM",113,0) S VALMBCK="R" "RTN","IBCNRPSM",114,0) ; Display error if not transaction code was picked and exit "RTN","IBCNRPSM",115,0) I 'IBX W !!,"No Transaction Code Selected!" D PAUSE^VALM1 Q "RTN","IBCNRPSM",116,0) ; Build variables needed for insert or deletion "RTN","IBCNRPSM",117,0) S IBSEL=+$G(^TMP("IBCNR",$J,"IDX",IBX,IBX)) "RTN","IBCNRPSM",118,0) S IBDR=$S(IBX=1:10.11,IBX=2:10.12,IBX=3:10.13,1:10.14) "RTN","IBCNRPSM",119,0) Q "RTN","IBCNRU1") 0^6^B36756107 "RTN","IBCNRU1",1,0) IBCNRU1 ;BHAM ISC/CMW - IB Utilities ;15-OCT-04 "RTN","IBCNRU1",2,0) ;;2.0;INTEGRATED BILLING;**251,276,435**;21-MAR-94;Build 27 "RTN","IBCNRU1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNRU1",4,0) ; "RTN","IBCNRU1",5,0) Q "RTN","IBCNRU1",6,0) ; "RTN","IBCNRU1",7,0) ;return array definition "RTN","IBCNRU1",8,0) ;(1) - "A"ctive or "I"nactive flag. "RTN","IBCNRU1",9,0) ;(2) - BIN #. "RTN","IBCNRU1",10,0) ;(3) - PCN #. "RTN","IBCNRU1",11,0) ;(4) - Vender Cert ID. "RTN","IBCNRU1",12,0) ;(5) - Payer Sheets. (B1,B2,B3,E1) (comma separated string). "RTN","IBCNRU1",13,0) ;(6) - Status codes (comma separated string). "RTN","IBCNRU1",14,0) ; "RTN","IBCNRU1",15,0) STCHK(PIEN,IBARAY,ELIG) ;Review status flags for all files related to this pharmacy plan "RTN","IBCNRU1",16,0) ; "RTN","IBCNRU1",17,0) ; PIEN - plan ien to file# 366.03 "RTN","IBCNRU1",18,0) ; IBARAY - output array pass by reference "RTN","IBCNRU1",19,0) ; ELIG - eligibility request flag "RTN","IBCNRU1",20,0) ; 1=eligibility request "RTN","IBCNRU1",21,0) ; 0=claim request (default) "RTN","IBCNRU1",22,0) ; "RTN","IBCNRU1",23,0) NEW I,IBBIN,IBPCN,IBPBM,IBPRO,IBSTA,IBPAY "RTN","IBCNRU1",24,0) NEW IBAPP,IBCODE,IBCERT "RTN","IBCNRU1",25,0) NEW PLN0,PLN10,AIEN,APDAT,APIEN "RTN","IBCNRU1",26,0) NEW NA1,NA2,NA3,NA4,LA1,LA2,LA3,LA4,DA1,DA2,DA3,DA4 "RTN","IBCNRU1",27,0) ; "RTN","IBCNRU1",28,0) K IBARAY "RTN","IBCNRU1",29,0) S ELIG=$G(ELIG,0) "RTN","IBCNRU1",30,0) ; "RTN","IBCNRU1",31,0) I '$G(PIEN) S IBSTA="" D IBC(299) G EXT "RTN","IBCNRU1",32,0) I '$D(^IBCNR(366.03,PIEN)) S IBSTA="" D IBC(299) G EXT "RTN","IBCNRU1",33,0) ; "RTN","IBCNRU1",34,0) S IBAPP="E-PHARM",IBSTA=1,IBCODE="" "RTN","IBCNRU1",35,0) S PLN0=$G(^IBCNR(366.03,PIEN,0)) D "RTN","IBCNRU1",36,0) . ; "RTN","IBCNRU1",37,0) . ; get PAYER "RTN","IBCNRU1",38,0) . S IBPAY=$P(PLN0,U,3) D "RTN","IBCNRU1",39,0) .. I 'IBPAY Q "RTN","IBCNRU1",40,0) .. ;check payer active "RTN","IBCNRU1",41,0) .. S AIEN=$O(^IBE(365.13,"B",IBAPP,"")) I AIEN="" Q "RTN","IBCNRU1",42,0) .. S APIEN=$O(^IBE(365.12,IBPAY,1,"B",AIEN,"")) I APIEN="" Q "RTN","IBCNRU1",43,0) .. S APDAT=$G(^IBE(365.12,IBPAY,1,APIEN,0)) "RTN","IBCNRU1",44,0) .. S NA1=$P(APDAT,U,2) I NA1=0 S IBSTA="" D IBC(101) "RTN","IBCNRU1",45,0) .. S LA1=$P(APDAT,U,3) I LA1=0 S IBSTA="" D IBC(102) "RTN","IBCNRU1",46,0) .. S DA1=$P(APDAT,U,11) I DA1=1 S IBSTA="" D IBC(103) "RTN","IBCNRU1",47,0) .. Q "RTN","IBCNRU1",48,0) . ; "RTN","IBCNRU1",49,0) . ; check Plan active "RTN","IBCNRU1",50,0) . S AIEN=$O(^IBCNR(366.13,"B",IBAPP,"")) I AIEN="" Q "RTN","IBCNRU1",51,0) . S APIEN=$O(^IBCNR(366.03,PIEN,3,"B",AIEN,"")) I APIEN="" Q "RTN","IBCNRU1",52,0) . S APDAT=$G(^IBCNR(366.03,PIEN,3,APIEN,0)) "RTN","IBCNRU1",53,0) . S NA2=$P(APDAT,U,2) I NA2=0 S IBSTA="" D IBC(201) "RTN","IBCNRU1",54,0) . S LA2=$P(APDAT,U,3) I LA2=0 S IBSTA="" D IBC(202) "RTN","IBCNRU1",55,0) . S DA2=$P(APDAT,U,11) I DA2=1 S IBSTA="" D IBC(203) "RTN","IBCNRU1",56,0) . ; "RTN","IBCNRU1",57,0) . ; check pharmacy data "RTN","IBCNRU1",58,0) . I '$D(^IBCNR(366.03,PIEN,10)) S IBSTA="" D IBC(599) "RTN","IBCNRU1",59,0) . ; "RTN","IBCNRU1",60,0) . S PLN10=$G(^IBCNR(366.03,PIEN,10)) D "RTN","IBCNRU1",61,0) .. ; "RTN","IBCNRU1",62,0) .. ; get BIN "RTN","IBCNRU1",63,0) .. S IBBIN=$P(PLN10,U,2) "RTN","IBCNRU1",64,0) .. S IBARAY(2)=IBBIN "RTN","IBCNRU1",65,0) .. ; "RTN","IBCNRU1",66,0) .. ; get PCN "RTN","IBCNRU1",67,0) .. S IBPCN=$P(PLN10,U,3) "RTN","IBCNRU1",68,0) .. S IBARAY(3)=IBPCN "RTN","IBCNRU1",69,0) .. ; "RTN","IBCNRU1",70,0) .. ; get PBM "RTN","IBCNRU1",71,0) .. S IBPBM=$P(PLN10,U,1) D "RTN","IBCNRU1",72,0) ... I 'IBPBM Q "RTN","IBCNRU1",73,0) ... ;check PBM active "RTN","IBCNRU1",74,0) ... S AIEN=$O(^IBCNR(366.12,"B",IBAPP,"")) I AIEN="" Q "RTN","IBCNRU1",75,0) ... S APIEN=$O(^IBCNR(366.02,IBPBM,3,"B",AIEN,"")) I APIEN="" Q "RTN","IBCNRU1",76,0) ... S APDAT=$G(^IBCNR(366.02,IBPBM,3,APIEN,0)) "RTN","IBCNRU1",77,0) ... S NA3=$P(APDAT,U,2) I NA3=0 D IBC(301) S IBSTA="" "RTN","IBCNRU1",78,0) ... S LA3=$P(APDAT,U,3) I LA3=0 D IBC(302) S IBSTA="" "RTN","IBCNRU1",79,0) ... S DA3=$P(APDAT,U,11) I DA3=1 D IBC(303) S IBSTA="" "RTN","IBCNRU1",80,0) ... Q "RTN","IBCNRU1",81,0) .. ; "RTN","IBCNRU1",82,0) .. ; get Processor "RTN","IBCNRU1",83,0) .. S IBPRO=$P(PLN10,U,4) D "RTN","IBCNRU1",84,0) ... I 'IBPRO Q "RTN","IBCNRU1",85,0) ... ;check Processor active flags here "RTN","IBCNRU1",86,0) ... S AIEN=$O(^IBCNR(366.11,"B",IBAPP,"")) I AIEN="" Q "RTN","IBCNRU1",87,0) ... S APIEN=$O(^IBCNR(366.01,IBPRO,3,"B",AIEN,"")) I APIEN="" Q "RTN","IBCNRU1",88,0) ... S APDAT=$G(^IBCNR(366.01,IBPRO,3,APIEN,0)) "RTN","IBCNRU1",89,0) ... S NA4=$P(APDAT,U,2) I NA4=0 D IBC(401) S IBSTA="" "RTN","IBCNRU1",90,0) ... S LA4=$P(APDAT,U,3) I LA4=0 D IBC(402) S IBSTA="" "RTN","IBCNRU1",91,0) ... S DA4=$P(APDAT,U,11) I DA4=1 D IBC(403) S IBSTA="" "RTN","IBCNRU1",92,0) ... Q "RTN","IBCNRU1",93,0) .. ; "RTN","IBCNRU1",94,0) .. ; get Vender Cert "RTN","IBCNRU1",95,0) .. S IBCERT=$P(PLN10,U,6) "RTN","IBCNRU1",96,0) .. S IBARAY(4)=IBCERT "RTN","IBCNRU1",97,0) .. ; "RTN","IBCNRU1",98,0) .. ; Check payer sheets "RTN","IBCNRU1",99,0) .. N BPS,PST,PSP "RTN","IBCNRU1",100,0) .. N B1,B2,B3,E1 "RTN","IBCNRU1",101,0) .. S PST="" "RTN","IBCNRU1",102,0) .. ; "RTN","IBCNRU1",103,0) .. ; check for test/production sheets "RTN","IBCNRU1",104,0) .. ; get the test payer sheet first. If nil, then get the regular payer sheet "RTN","IBCNRU1",105,0) .. S (B1,B2,B3,E1)="" "RTN","IBCNRU1",106,0) .. S B1=$P(PLN10,U,11),B2=$P(PLN10,U,12),B3=$P(PLN10,U,13),E1=$P(PLN10,U,14) "RTN","IBCNRU1",107,0) .. I 'B1 S B1=$P(PLN10,U,7) ; billing "RTN","IBCNRU1",108,0) .. I 'B2 S B2=$P(PLN10,U,8) ; reversal "RTN","IBCNRU1",109,0) .. I 'B3 S B3=$P(PLN10,U,9) ; rebill (not currently validated) "RTN","IBCNRU1",110,0) .. I 'E1 S E1=$P(PLN10,U,15) ; eligibility "RTN","IBCNRU1",111,0) .. S PST=B1_","_B2_","_B3_","_E1 "RTN","IBCNRU1",112,0) .. S IBARAY(5)=PST ; save the payer sheet iens "RTN","IBCNRU1",113,0) .. ; "RTN","IBCNRU1",114,0) .. ; perform payer sheet validation for claim request "RTN","IBCNRU1",115,0) .. I 'ELIG D "RTN","IBCNRU1",116,0) ... I 'B1,'B2 S IBSTA="" D IBC(699) Q "RTN","IBCNRU1",117,0) ... I B1 D PSD(B1) I PSP=0 S IBSTA="" D IBC(601) "RTN","IBCNRU1",118,0) ... I B2 D PSD(B2) I PSP=0 S IBSTA="" D IBC(602) "RTN","IBCNRU1",119,0) ... I 'B1 S IBSTA="" D IBC(603) "RTN","IBCNRU1",120,0) ... I 'B2 S IBSTA="" D IBC(604) "RTN","IBCNRU1",121,0) ... Q "RTN","IBCNRU1",122,0) .. ; "RTN","IBCNRU1",123,0) .. ; perform payer sheet validation for eligibility request "RTN","IBCNRU1",124,0) .. I ELIG D "RTN","IBCNRU1",125,0) ... I E1 D PSD(E1) I PSP=0 S IBSTA="" D IBC(605) "RTN","IBCNRU1",126,0) ... I 'E1 S IBSTA="" D IBC(606) "RTN","IBCNRU1",127,0) ... Q "RTN","IBCNRU1",128,0) .. Q "RTN","IBCNRU1",129,0) . ; "RTN","IBCNRU1",130,0) . ;check HIPAA NCPDP flag "RTN","IBCNRU1",131,0) . I '$P($G(^IBE(350.9,1,11)),U,1) S IBSTA="" D IBC(999) "RTN","IBCNRU1",132,0) . Q "RTN","IBCNRU1",133,0) ; "RTN","IBCNRU1",134,0) EXT ; "RTN","IBCNRU1",135,0) S IBARAY(1)=$S(IBSTA="":"I",1:"A") "RTN","IBCNRU1",136,0) I IBCODE="" S IBCODE=200 ; all is well "RTN","IBCNRU1",137,0) S IBARAY(6)=IBCODE "RTN","IBCNRU1",138,0) Q "RTN","IBCNRU1",139,0) ; "RTN","IBCNRU1",140,0) PSD(PS) ; check for disabled payersheet "RTN","IBCNRU1",141,0) S PSP=1 "RTN","IBCNRU1",142,0) S BPS=$G(^BPSF(9002313.92,PS,1)) I $P(BPS,U,6)=0 S PSP=0 "RTN","IBCNRU1",143,0) Q "RTN","IBCNRU1",144,0) ; "RTN","IBCNRU1",145,0) IBC(CD) ;set IBCODE "RTN","IBCNRU1",146,0) I '$G(IBCODE) S IBCODE=CD Q "RTN","IBCNRU1",147,0) S IBCODE=IBCODE_","_CD "RTN","IBCNRU1",148,0) Q "RTN","IBCNRU1",149,0) ; "RTN","IBCNRU1",150,0) STATAR(AR) ; "RTN","IBCNRU1",151,0) ; setup status code definition array "RTN","IBCNRU1",152,0) K AR "RTN","IBCNRU1",153,0) ; payer "RTN","IBCNRU1",154,0) S AR(101)="Payer not active, national." "RTN","IBCNRU1",155,0) S AR(102)="Payer not active, local." "RTN","IBCNRU1",156,0) S AR(103)="Payer Deactivated." "RTN","IBCNRU1",157,0) ; plan "RTN","IBCNRU1",158,0) S AR(200)="Plan Active" "RTN","IBCNRU1",159,0) S AR(201)="Plan not active, national." "RTN","IBCNRU1",160,0) S AR(202)="Plan not active, local." "RTN","IBCNRU1",161,0) S AR(203)="Plan Deactivated." "RTN","IBCNRU1",162,0) S AR(299)="Plan not found." "RTN","IBCNRU1",163,0) ; pbm "RTN","IBCNRU1",164,0) S AR(301)="PBM not active, national." "RTN","IBCNRU1",165,0) S AR(302)="PBM not active, local." "RTN","IBCNRU1",166,0) S AR(303)="PBM Deactivated." "RTN","IBCNRU1",167,0) ; processor "RTN","IBCNRU1",168,0) S AR(401)="Processor not active, national." "RTN","IBCNRU1",169,0) S AR(402)="Processor not active, local." "RTN","IBCNRU1",170,0) S AR(403)="Processor Deactivated." "RTN","IBCNRU1",171,0) ; pharmacy plan "RTN","IBCNRU1",172,0) S AR(599)="Pharmacy Plan not found." "RTN","IBCNRU1",173,0) ; payer sheets "RTN","IBCNRU1",174,0) S AR(601)="Billing PayerSheet Disabled." "RTN","IBCNRU1",175,0) S AR(602)="Reversal PayerSheet Disabled." "RTN","IBCNRU1",176,0) S AR(603)="Billing PayerSheet Not Found." "RTN","IBCNRU1",177,0) S AR(604)="Reversal PayerSheet Not Found." "RTN","IBCNRU1",178,0) S AR(605)="Eligibility PayerSheet Disabled." "RTN","IBCNRU1",179,0) S AR(606)="Eligibility PayerSheet Not Found." "RTN","IBCNRU1",180,0) S AR(699)="No Payer Sheets found." "RTN","IBCNRU1",181,0) ; "RTN","IBCNRU1",182,0) S AR(999)="HIPAA NCPDP Inactive." "RTN","IBCNRU1",183,0) ; "RTN","IBCNRU1",184,0) Q "RTN","IBCNRZRX") 0^2^B13620171 "RTN","IBCNRZRX",1,0) IBCNRZRX ;DAOU/DMK - Receive HL7 e-Pharmacy ZRX Segment ;23-OCT-2003 "RTN","IBCNRZRX",2,0) ;;2.0;INTEGRATED BILLING;**251,435**;21-MAR-94;Build 27 "RTN","IBCNRZRX",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNRZRX",4,0) ; "RTN","IBCNRZRX",5,0) ; Description "RTN","IBCNRZRX",6,0) ; "RTN","IBCNRZRX",7,0) ; Receive HL7 e-Pharmacy ZRX Segment "RTN","IBCNRZRX",8,0) ; 366.03 PLAN File Update (Pharmacy) "RTN","IBCNRZRX",9,0) ; "RTN","IBCNRZRX",10,0) ; Called by IBCNRHLT "RTN","IBCNRZRX",11,0) ; "RTN","IBCNRZRX",12,0) ; Entry point "RTN","IBCNRZRX",13,0) ; "RTN","IBCNRZRX",14,0) 1000 ; Control ZRX Segment processing "RTN","IBCNRZRX",15,0) D INIT "RTN","IBCNRZRX",16,0) I $D(ERROR) Q "RTN","IBCNRZRX",17,0) Q "RTN","IBCNRZRX",18,0) ; "RTN","IBCNRZRX",19,0) INIT ; Initialize ZRX Segment variables "RTN","IBCNRZRX",20,0) ; 366.03 PLAN File "RTN","IBCNRZRX",21,0) ; "RTN","IBCNRZRX",22,0) N NAME "RTN","IBCNRZRX",23,0) ; "RTN","IBCNRZRX",24,0) ; Error? "RTN","IBCNRZRX",25,0) ; V505 = Plan ID Missing "RTN","IBCNRZRX",26,0) I $TR($G(IBSEG(3))," ","") S ERROR="V505" Q "RTN","IBCNRZRX",27,0) ; "RTN","IBCNRZRX",28,0) ; 10.01 = PHARMACY BENEFITS MANAGER NAME (pointer - 366.02) "RTN","IBCNRZRX",29,0) S DATA(10.01)=$G(IBSEG(4)) "RTN","IBCNRZRX",30,0) I DATA(10.01)]"" S DATA(10.01)=$$LOOKUP1^IBCNRFM1(366.02,DATA(10.01)) "RTN","IBCNRZRX",31,0) ; "RTN","IBCNRZRX",32,0) ; Error? "RTN","IBCNRZRX",33,0) ; V510 = Pharmacy Benefits Manager (PBM) Undefined "RTN","IBCNRZRX",34,0) I DATA(10.01)=-1 S ERROR="V510" Q "RTN","IBCNRZRX",35,0) ; "RTN","IBCNRZRX",36,0) ; 10.02 = BANKING IDENTIFICATION NUMBER "RTN","IBCNRZRX",37,0) S DATA(10.02)=$G(IBSEG(5)) "RTN","IBCNRZRX",38,0) ; "RTN","IBCNRZRX",39,0) ; Error? "RTN","IBCNRZRX",40,0) ; V515 = Plan BIN Missing "RTN","IBCNRZRX",41,0) I $TR(DATA(10.02)," ","")="" S ERROR="V515" Q "RTN","IBCNRZRX",42,0) ; "RTN","IBCNRZRX",43,0) ; 10.03 = PROCESSOR CONTROL NUMBER (PCN) "RTN","IBCNRZRX",44,0) S DATA(10.03)=$G(IBSEG(6)) "RTN","IBCNRZRX",45,0) ; "RTN","IBCNRZRX",46,0) ; 10.04 = NCPDP PROCESSOR NAME (pointer - 366.01) "RTN","IBCNRZRX",47,0) S DATA(10.04)=$G(IBSEG(7)) "RTN","IBCNRZRX",48,0) I DATA(10.04)]"" S DATA(10.04)=$$LOOKUP1^IBCNRFM1(366.01,DATA(10.04)) "RTN","IBCNRZRX",49,0) ; "RTN","IBCNRZRX",50,0) ; Error? "RTN","IBCNRZRX",51,0) ; V520 = NCPDP Processor Name Undefined "RTN","IBCNRZRX",52,0) I DATA(10.04)=-1 S ERROR="V520" Q "RTN","IBCNRZRX",53,0) ; "RTN","IBCNRZRX",54,0) ; 10.05 = ENABLED? "RTN","IBCNRZRX",55,0) S DATA(10.05)=$S($G(IBSEG(8))="Y":1,1:0) "RTN","IBCNRZRX",56,0) ; "RTN","IBCNRZRX",57,0) ; Error? "RTN","IBCNRZRX",58,0) ; V525 = Plan Enabled? Missing "RTN","IBCNRZRX",59,0) I $TR(DATA(10.05)," ","")="" S ERROR="V525" Q "RTN","IBCNRZRX",60,0) ; "RTN","IBCNRZRX",61,0) ; 10.06 = SOFTWARE VENDOR ID "RTN","IBCNRZRX",62,0) S DATA(10.06)=$G(IBSEG(9)) "RTN","IBCNRZRX",63,0) ; "RTN","IBCNRZRX",64,0) ; 10.07 = BILLING PAYER SHEET NAME (pointer - 9002313.92) "RTN","IBCNRZRX",65,0) S DATA(10.07)=$G(IBSEG(10)) "RTN","IBCNRZRX",66,0) I DATA(10.07)]"" S DATA(10.07)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.07)) "RTN","IBCNRZRX",67,0) ; "RTN","IBCNRZRX",68,0) ; Error? "RTN","IBCNRZRX",69,0) ; V530 = Billing Payer Sheet Name Undefined "RTN","IBCNRZRX",70,0) I DATA(10.07)=-1 S ERROR="V530" Q "RTN","IBCNRZRX",71,0) ; "RTN","IBCNRZRX",72,0) ; 10.08 = REVERSAL PAYER SHEET NAME (pointer - 9002313.92) "RTN","IBCNRZRX",73,0) S DATA(10.08)=$G(IBSEG(11)) "RTN","IBCNRZRX",74,0) I DATA(10.08)]"" S DATA(10.08)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.08)) "RTN","IBCNRZRX",75,0) ; "RTN","IBCNRZRX",76,0) ; Error? "RTN","IBCNRZRX",77,0) ; V535 = Reversal Payer Sheet Name Undefined "RTN","IBCNRZRX",78,0) I DATA(10.08)=-1 S ERROR="V535" Q "RTN","IBCNRZRX",79,0) ; "RTN","IBCNRZRX",80,0) ; 10.09 = REBILL PAYER SHEET NAME (pointer - 9002313.92) "RTN","IBCNRZRX",81,0) S DATA(10.09)=$G(IBSEG(12)) "RTN","IBCNRZRX",82,0) I DATA(10.09)]"" S DATA(10.09)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.09)) "RTN","IBCNRZRX",83,0) ; "RTN","IBCNRZRX",84,0) ; Error? "RTN","IBCNRZRX",85,0) ; V540 = Rebill Payer Sheet Name Undefined "RTN","IBCNRZRX",86,0) I DATA(10.09)=-1 S ERROR="V540" Q "RTN","IBCNRZRX",87,0) ; "RTN","IBCNRZRX",88,0) ; 10.1 = MAXIMUM NCPDP TRANSACTIONS "RTN","IBCNRZRX",89,0) S DATA(10.1)=$G(IBSEG(13)) "RTN","IBCNRZRX",90,0) ; "RTN","IBCNRZRX",91,0) ; 10.15 = ELIGIBILITY VERIFICATION PAYER SHEET NAME (pointer - 9002313.92) "RTN","IBCNRZRX",92,0) S DATA(10.15)=$G(IBSEG(16)) "RTN","IBCNRZRX",93,0) I DATA(10.15)]"" S DATA(10.15)=$$LOOKUP1^IBCNRFM1(9002313.92,DATA(10.15)) "RTN","IBCNRZRX",94,0) ; "RTN","IBCNRZRX",95,0) ; Error? "RTN","IBCNRZRX",96,0) ; V545 = Eligibility Verification Payer Sheet Name Undefined "RTN","IBCNRZRX",97,0) I DATA(10.15)=-1 S ERROR="V545" Q "RTN","IBCNRZRX",98,0) ; "RTN","IBCNRZRX",99,0) ; Initialize RX primary contact name variables "RTN","IBCNRZRX",100,0) S NAME=$G(IBSEG(14)) "RTN","IBCNRZRX",101,0) D NAME "RTN","IBCNRZRX",102,0) ; "RTN","IBCNRZRX",103,0) ; 11.01 = RX PRIMARY CONTACT NAME "RTN","IBCNRZRX",104,0) S DATA(11.01)=NAME("NAME") "RTN","IBCNRZRX",105,0) ; "RTN","IBCNRZRX",106,0) ; 11.02 = RX PRIMARY CONTACT PREFIX "RTN","IBCNRZRX",107,0) S DATA(11.02)=NAME("PREFIX") "RTN","IBCNRZRX",108,0) ; "RTN","IBCNRZRX",109,0) ; 11.03 = RX PRIMARY CONTACT DEGREE "RTN","IBCNRZRX",110,0) S DATA(11.03)=NAME("DEGREE") "RTN","IBCNRZRX",111,0) ; "RTN","IBCNRZRX",112,0) ; Initialize RX alternate contact name variables "RTN","IBCNRZRX",113,0) S NAME=$G(IBSEG(15)) "RTN","IBCNRZRX",114,0) D NAME "RTN","IBCNRZRX",115,0) ; "RTN","IBCNRZRX",116,0) ; 11.04 = RX ALTERNATE CONTACT NAME "RTN","IBCNRZRX",117,0) S DATA(11.04)=NAME("NAME") "RTN","IBCNRZRX",118,0) ; "RTN","IBCNRZRX",119,0) ; 11.05 = RX ALETRNATE CONTACT PREFIX "RTN","IBCNRZRX",120,0) S DATA(11.05)=NAME("PREFIX") "RTN","IBCNRZRX",121,0) ; "RTN","IBCNRZRX",122,0) ; 11.06 = RX ALTERNATE CONTACT DEGREE "RTN","IBCNRZRX",123,0) S DATA(11.06)=NAME("DEGREE") "RTN","IBCNRZRX",124,0) Q "RTN","IBCNRZRX",125,0) ; "RTN","IBCNRZRX",126,0) NAME ; Initialize name variables from NAME string "RTN","IBCNRZRX",127,0) S NAME("SURNAME")=$P($P(NAME,$E(HLECH,1),1),$E(HLECH,4),1) "RTN","IBCNRZRX",128,0) S NAME("SURNAME PREFIX")=$P($P(NAME,$E(HLECH,1),1),$E(HLECH,4),2) "RTN","IBCNRZRX",129,0) S NAME("FAMILY")=$S(NAME("SURNAME PREFIX")]"":NAME("SURNAME PREFIX")_" ",1:"")_NAME("SURNAME") "RTN","IBCNRZRX",130,0) S NAME("GIVEN")=$P(NAME,$E(HLECH,1),2) "RTN","IBCNRZRX",131,0) S NAME("MIDDLE")=$P(NAME,$E(HLECH,1),3) "RTN","IBCNRZRX",132,0) S NAME("SUFFIX")=$P(NAME,$E(HLECH,1),4) "RTN","IBCNRZRX",133,0) S NAME("NAME")="" "RTN","IBCNRZRX",134,0) I NAME("FAMILY")]"" S NAME("NAME")=NAME("FAMILY")_","_NAME("GIVEN")_$S(NAME("MIDDLE")]"":" "_$E(NAME("MIDDLE"),1),1:"")_$S(NAME("SUFFIX")]"":" "_NAME("SUFFIX"),1:"") "RTN","IBCNRZRX",135,0) S NAME("PREFIX")=$P(NAME,$E(HLECH,1),5) "RTN","IBCNRZRX",136,0) S NAME("DEGREE")=$P(NAME,$E(HLECH,1),6) "RTN","IBCNRZRX",137,0) Q "RTN","IBCNSM") 0^9^B22946232 "RTN","IBCNSM",1,0) IBCNSM ;ALB/AAS - INSURANCE MANAGEMENT, LIST MANAGER INIT ROUTINE ;21-OCT-92 "RTN","IBCNSM",2,0) ;;2.0;INTEGRATED BILLING;**28,46,56,52,82,103,199,276,435**;21-MAR-94;Build 27 "RTN","IBCNSM",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBCNSM",4,0) ; "RTN","IBCNSM",5,0) ;also used for IA #4694 "RTN","IBCNSM",6,0) ; "RTN","IBCNSM",7,0) % ; -- main entry point "RTN","IBCNSM",8,0) EN ; "RTN","IBCNSM",9,0) D DT^DICRW "RTN","IBCNSM",10,0) K XQORS,VALMEVL "RTN","IBCNSM",11,0) D EN^VALM("IBCNS INSURANCE MANAGEMENT") "RTN","IBCNSM",12,0) ENQ K DFN "RTN","IBCNSM",13,0) Q "RTN","IBCNSM",14,0) ; "RTN","IBCNSM",15,0) ; "RTN","IBCNSM",16,0) INIT ; -- set up inital variables "RTN","IBCNSM",17,0) S U="^",VALMCNT=0,VALMBG=1 "RTN","IBCNSM",18,0) K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J) "RTN","IBCNSM",19,0) ;K I,X,SDBEG,SDEND,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ "RTN","IBCNSM",20,0) S DIR(0)="350.9,4.02",DIR("A")="Select Patient Name or Insurance Co." "RTN","IBCNSM",21,0) D ^DIR K DIR I $D(DIRUT) S VALMQUIT="" G INITQ "RTN","IBCNSM",22,0) S IBY=Y "RTN","IBCNSM",23,0) I IBY["DPT(" S IBTYP="P",DFN=+IBY D BLD "RTN","IBCNSM",24,0) I IBY["DIC(" S IBTYP="I",IBCNS=+IBY D EN^VALM("IBCNS INSURANCE COMPANY") S VALMQUIT="" "RTN","IBCNSM",25,0) ; "RTN","IBCNSM",26,0) INITQ Q "RTN","IBCNSM",27,0) ; "RTN","IBCNSM",28,0) ; "RTN","IBCNSM",29,0) PAT ; -- select patient you are working with "RTN","IBCNSM",30,0) N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups "RTN","IBCNSM",31,0) S DIC(0)="AEQMN",DIC="^DPT(" D ^DIC I +Y<1 S VALMQUIT="" Q "RTN","IBCNSM",32,0) S DFN=+Y "RTN","IBCNSM",33,0) Q "RTN","IBCNSM",34,0) ; "RTN","IBCNSM",35,0) ; "RTN","IBCNSM",36,0) BLD ; -- build list of bills "RTN","IBCNSM",37,0) K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J) "RTN","IBCNSM",38,0) N I,J,K,IBHOLD,IBGRP,IBINS,IBCNT,IBCDFND,IBCDFND1,IBCPOLD,IBPL "RTN","IBCNSM",39,0) S (IBN,IBCNT,VALMCNT)=0,IBFILE=2 "RTN","IBCNSM",40,0) ; "RTN","IBCNSM",41,0) ; -- find all ins. co data "RTN","IBCNSM",42,0) K IBINS S IBINS=0 "RTN","IBCNSM",43,0) D POL^IBCNSU41(DFN) "RTN","IBCNSM",44,0) I '$G(IBNCPIVD) D ALL^IBCNS1(DFN,"IBINS") ; all insurances "RTN","IBCNSM",45,0) I $G(IBNCPIVD) D ALL^IBCNS1(DFN,"IBINS",1,IBNCPIVD) ; IB*2*435 - Rx policies active as of this date "RTN","IBCNSM",46,0) ; "RTN","IBCNSM",47,0) I $G(IBINS(0)) S K=0 F S K=$O(IBINS(K)) Q:'K D "RTN","IBCNSM",48,0) .; -- add to list "RTN","IBCNSM",49,0) .W "." "RTN","IBCNSM",50,0) .S IBCDFND=$G(IBINS(K,0)) "RTN","IBCNSM",51,0) .S IBCDFND1=$G(IBINS(K,1)) "RTN","IBCNSM",52,0) .S IBPL=+$P(IBCDFND,U,18) "RTN","IBCNSM",53,0) .S IBCPOLD=$G(^IBA(355.3,IBPL,0)) "RTN","IBCNSM",54,0) .; "RTN","IBCNSM",55,0) .; IB*2*435 - esg - 9/27/10 - active Rx policies only if this variable is set "RTN","IBCNSM",56,0) .I $G(IBNCPIVD),'$$PLCOV^IBCNSU3(IBPL,IBNCPIVD,3) Q "RTN","IBCNSM",57,0) .; "RTN","IBCNSM",58,0) .S IBCNT=IBCNT+1 "RTN","IBCNSM",59,0) .S X="" "RTN","IBCNSM",60,0) .S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER") "RTN","IBCNSM",61,0) .I $D(^DIC(36,+IBCDFND,0)) S X=$$SETFLD^VALM1($P(^(0),"^"),X,"NAME") "RTN","IBCNSM",62,0) .S X=$$SETFLD^VALM1($E($P(IBCDFND,"^",2),1,14),X,"POLICY") "RTN","IBCNSM",63,0) .S IBHOLD=$P(IBCDFND,"^",6),X=$$SETFLD^VALM1($S(IBHOLD="v":"SELF",IBHOLD="s":"SPOUSE",IBHOLD="o":"OTHER",1:"UNKNOWN"),X,"HOLDER") "RTN","IBCNSM",64,0) .S X=$$SETFLD^VALM1($E($$GRP^IBCNS($P(IBCDFND,"^",18)),1,10),X,"GROUP") "RTN","IBCNSM",65,0) .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",8)),X,"EFFDT") "RTN","IBCNSM",66,0) .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND,"^",4)),X,"EXPIRE") "RTN","IBCNSM",67,0) .S X=$$SETFLD^VALM1($E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),U),1,8),X,"TYPE") "RTN","IBCNSM",68,0) .S X=$$SETFLD^VALM1($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+$P(IBCDFND,"^",18),0)),"^",9),0)),"^"),X,"TYPEPOL") "RTN","IBCNSM",69,0) .S X=$$SETFLD^VALM1($E($P($G(^VA(200,+$P(IBCDFND1,"^",4),0)),U),1,15),X,"VERIFIED BY") "RTN","IBCNSM",70,0) .S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBCDFND1,"^",3)),X,"VERIFIED ON") "RTN","IBCNSM",71,0) .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",6)),X,"PRECERT") "RTN","IBCNSM",72,0) .S X=$$SETFLD^VALM1($$YN($P(IBCPOLD,"^",5)),X,"UR") "RTN","IBCNSM",73,0) .S X=$$SETFLD^VALM1($$YN($P(IBCDFND,"^",20)),X,"COB") "RTN","IBCNSM",74,0) .K IBHOLD,IBGRP "RTN","IBCNSM",75,0) .D SET(X) "RTN","IBCNSM",76,0) .Q "RTN","IBCNSM",77,0) ; "RTN","IBCNSM",78,0) I '$D(^TMP("IBNSM",$J)) D "RTN","IBCNSM",79,0) .S VALMCNT=2,IBCNT=2,^TMP("IBNSM",$J,1,0)=" " "RTN","IBCNSM",80,0) .S ^TMP("IBNSM",$J,2,0)=" No Insurance Policies on file for this patient." "RTN","IBCNSM",81,0) .I $G(IBNCPIVD) S ^TMP("IBNSM",$J,2,0)=" No Active Rx Policies found as of Effective Date "_$$FMTE^XLFDT(IBNCPIVD,"2Z")_"." "RTN","IBCNSM",82,0) .Q "RTN","IBCNSM",83,0) ; "RTN","IBCNSM",84,0) S X=$G(^IBA(354,DFN,60)) I X D "RTN","IBCNSM",85,0) .S IBCNT=IBCNT+1 "RTN","IBCNSM",86,0) .S ^TMP("IBNSM",$J,IBCNT,0)=" Verification of No Coverage "_$$FMTE^XLFDT(X) "RTN","IBCNSM",87,0) .Q "RTN","IBCNSM",88,0) ; "RTN","IBCNSM",89,0) BLDQ ; "RTN","IBCNSM",90,0) Q "RTN","IBCNSM",91,0) ; "RTN","IBCNSM",92,0) SET(X) ; -- set arrays "RTN","IBCNSM",93,0) S VALMCNT=VALMCNT+1,^TMP("IBNSM",$J,VALMCNT,0)=X "RTN","IBCNSM",94,0) S ^TMP("IBNSM",$J,"IDX",VALMCNT,IBCNT)="" "RTN","IBCNSM",95,0) S ^TMP("IBNSMDX",$J,IBCNT)=VALMCNT_"^"_IBFILE_"^"_DFN_"^"_K_"^"_IBCDFND "RTN","IBCNSM",96,0) Q "RTN","IBCNSM",97,0) ; "RTN","IBCNSM",98,0) HDR ; -- screen header for initial screen "RTN","IBCNSM",99,0) D PID^VADPT "RTN","IBCNSM",100,0) S VALMHDR(1)="Insurance Management for Patient: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID") "RTN","IBCNSM",101,0) S VALMHDR(2)=" " "RTN","IBCNSM",102,0) I +$$BUFFER^IBCNBU1(DFN) S VALMHDR(2)="*** Patient has Insurance Buffer Records" "RTN","IBCNSM",103,0) Q "RTN","IBCNSM",104,0) ; "RTN","IBCNSM",105,0) FNL ; -- exit and clean up "RTN","IBCNSM",106,0) K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J) "RTN","IBCNSM",107,0) K IBFASTXT "RTN","IBCNSM",108,0) D CLEAN^VALM10 "RTN","IBCNSM",109,0) Q "RTN","IBCNSM",110,0) ; "RTN","IBCNSM",111,0) YN(X,Y) ; -- convert 1 or 0 to yes/no/unknown "RTN","IBCNSM",112,0) Q $S($G(X)="":$S($G(Y):"",1:"UNK"),X=0:"NO",X=1:"YES",1:"") "RTN","IBCNSM",113,0) ; "RTN","IBCNSM",114,0) CP ; -- change patient "RTN","IBCNSM",115,0) N VALMQUIT "RTN","IBCNSM",116,0) D FULL^VALM1 "RTN","IBCNSM",117,0) S IBDFN=DFN D PAT "RTN","IBCNSM",118,0) I $D(VALMQUIT) S DFN=IBDFN "RTN","IBCNSM",119,0) D HDR,BLD "RTN","IBCNSM",120,0) S VALMBCK="R" "RTN","IBCNSM",121,0) CPQ K IBDFN "RTN","IBCNSM",122,0) Q "RTN","IBCNSM",123,0) ; "RTN","IBCNSM",124,0) PCI S VALMBCK="R" Q "RTN","IBCNSM",125,0) ; "RTN","IBCNSM",126,0) FASTEXIT ;just sets a flag signaling system should be exited "RTN","IBCNSM",127,0) S VALMBCK="Q" "RTN","IBCNSM",128,0) D FULL^VALM1 "RTN","IBCNSM",129,0) K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR "RTN","IBCNSM",130,0) I $D(DIRUT)!(Y) S IBFASTXT=1 "RTN","IBCNSM",131,0) K DIR "RTN","IBCNSM",132,0) Q "RTN","IBJTRX") 0^25^B61346654 "RTN","IBJTRX",1,0) IBJTRX ;ALB/ESG - TPJI ePharmacy ECME claim information ;22-Oct-2010 "RTN","IBJTRX",2,0) ;;2.0;INTEGRATED BILLING;**435**;21-MAR-94;Build 27 "RTN","IBJTRX",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBJTRX",4,0) ; "RTN","IBJTRX",5,0) ; Reference to $$CLAIM^BPSBUTL supported by IA# 4719 "RTN","IBJTRX",6,0) ; Reference to BPS RESPONSES file# 9002313.03 supported by IA# 4813 "RTN","IBJTRX",7,0) ; Reference to $$NPI^XUSNPI supported by IA# 4532 "RTN","IBJTRX",8,0) ; "RTN","IBJTRX",9,0) Q "RTN","IBJTRX",10,0) ; "RTN","IBJTRX",11,0) EN ; -- main entry point for IBJT ECME RESP INFO "RTN","IBJTRX",12,0) N IBZ,IBRXDATA,IBRXIEN,IBRXFILL,IBCOBN,IBBPS,X,Y "RTN","IBJTRX",13,0) D FULL^VALM1 "RTN","IBJTRX",14,0) I '$G(IBIFN) W !!,"No Claim Defined!" D PAUSE^VALM1 G EX "RTN","IBJTRX",15,0) I '$$ISRX^IBCEF1(IBIFN) W !!,"Not available. This is not a Pharmacy Claim." D PAUSE^VALM1 G EX "RTN","IBJTRX",16,0) I $$ECME^IBTRE(IBIFN)="" W !!,"Not available. This is a Pharmacy Claim, but not an ECME Claim." D PAUSE^VALM1 G EX "RTN","IBJTRX",17,0) ; "RTN","IBJTRX",18,0) S IBZ=+$O(^IBA(362.4,"C",IBIFN,0)) "RTN","IBJTRX",19,0) I 'IBZ W !!,"Rx data not found for this claim." D PAUSE^VALM1 G EX "RTN","IBJTRX",20,0) S IBRXDATA=$G(^IBA(362.4,IBZ,0)) "RTN","IBJTRX",21,0) S IBRXIEN=+$P(IBRXDATA,U,5) ; RX ien ptr file 52 "RTN","IBJTRX",22,0) I 'IBRXIEN W !!,"Rx IEN cannot be determined." D PAUSE^VALM1 G EX "RTN","IBJTRX",23,0) S IBRXFILL=+$P(IBRXDATA,U,10) ; rx fill# "RTN","IBJTRX",24,0) S IBCOBN=+$$COBN^IBCEF(IBIFN) ; current payer sequence # "RTN","IBJTRX",25,0) S IBBPS=$$CLAIM^BPSBUTL(IBRXIEN,IBRXFILL,IBCOBN) "RTN","IBJTRX",26,0) ; "RTN","IBJTRX",27,0) D EN^VALM("IBJT ECME RESP INFO") "RTN","IBJTRX",28,0) EX ; "RTN","IBJTRX",29,0) S VALMBCK="R" "RTN","IBJTRX",30,0) Q "RTN","IBJTRX",31,0) ; "RTN","IBJTRX",32,0) HDR ; -- header code "RTN","IBJTRX",33,0) D HDR^IBJTU1(+IBIFN,+DFN,1) "RTN","IBJTRX",34,0) Q "RTN","IBJTRX",35,0) ; "RTN","IBJTRX",36,0) INIT ; -- init variables and list array "RTN","IBJTRX",37,0) N IBM1,ECME,ECMEAP,RXORG,DOCIEN,PHARMNPI,DOCNPI,RESPIEN,ZR,RSPSUB,ZM,BPSM,BPSMCOB,IBLINE,ZC,ZCTOT,ZCN "RTN","IBJTRX",38,0) K ^TMP("IBJTRX",$J) "RTN","IBJTRX",39,0) S VALMCNT=0 "RTN","IBJTRX",40,0) S IBM1=$G(^DGCR(399,IBIFN,"M1")) "RTN","IBJTRX",41,0) S ECME=$P($P(IBM1,U,8),";",1) ; ECME# "RTN","IBJTRX",42,0) S ECMEAP=$P(IBM1,U,9) ; ECME approval number "RTN","IBJTRX",43,0) S RXORG=$$RXSITE^IBCEF73A(IBIFN) ; pharmacy file 4 ien "RTN","IBJTRX",44,0) S DOCIEN=$$RXAPI1^IBNCPUT1(IBRXIEN,4,"I") ; ien of doctor who wrote the Rx (52,4) "RTN","IBJTRX",45,0) S (PHARMNPI,DOCNPI)="" "RTN","IBJTRX",46,0) I RXORG S PHARMNPI=$P($$NPI^XUSNPI("Organization_ID",RXORG),U,1) ; pharmacy NPI "RTN","IBJTRX",47,0) I DOCIEN S DOCNPI=$P($$NPI^XUSNPI("Individual_ID",DOCIEN),U,1) ; doctor NPI "RTN","IBJTRX",48,0) I PHARMNPI'>0 S PHARMNPI="No NPI on file" "RTN","IBJTRX",49,0) I DOCNPI'>0 S DOCNPI="No NPI on file" "RTN","IBJTRX",50,0) ; "RTN","IBJTRX",51,0) S RESPIEN=+$P(IBBPS,U,3) ; BPS response file ien "RTN","IBJTRX",52,0) I RESPIEN D "RTN","IBJTRX",53,0) . S ZR=RESPIEN_"," "RTN","IBJTRX",54,0) . S RSPSUB=+$O(^BPSR(RESPIEN,1000,0)) "RTN","IBJTRX",55,0) . I RSPSUB D "RTN","IBJTRX",56,0) .. S ZM=RSPSUB_","_RESPIEN_"," "RTN","IBJTRX",57,0) .. D GETS^DIQ(9002313.0301,ZM,"129;133:137;505;506;507;509;517:520;571;572","IEN","BPSM") ; get selected $ amount fields "RTN","IBJTRX",58,0) .. D GETS^DIQ(9002313.0301,ZM,"355.01*","IEN","BPSMCOB") ; get cob/other payer data fields "RTN","IBJTRX",59,0) .. Q "RTN","IBJTRX",60,0) . Q "RTN","IBJTRX",61,0) ; "RTN","IBJTRX",62,0) S IBLINE=$$SETL("",ECME,"ECME No",25,11,1) "RTN","IBJTRX",63,0) S IBLINE=$$SETL(IBLINE,PHARMNPI,"Pharmacy NPI",14,15,40) "RTN","IBJTRX",64,0) D SET(IBLINE) "RTN","IBJTRX",65,0) ; "RTN","IBJTRX",66,0) S IBLINE=$$SETL("",ECMEAP,"ECME Ap No",25,11,1) "RTN","IBJTRX",67,0) S IBLINE=$$SETL(IBLINE,DOCNPI,"Provider NPI",14,15,40) "RTN","IBJTRX",68,0) D SET(IBLINE) "RTN","IBJTRX",69,0) ; "RTN","IBJTRX",70,0) D SET(" ") "RTN","IBJTRX",71,0) S IBLINE=$$SETL("",$P(IBRXDATA,U,1)_" / "_IBRXFILL,"Rx No",31,11,1) "RTN","IBJTRX",72,0) S IBLINE=$$SETL(IBLINE,$$FMTE^XLFDT($P(IBRXDATA,U,3),"2Z"),"Fill Date",8,15,40) "RTN","IBJTRX",73,0) D SET(IBLINE) "RTN","IBJTRX",74,0) ; "RTN","IBJTRX",75,0) S IBLINE=$$SETL("",$$RXAPI1^IBNCPUT1(IBRXIEN,6,"E"),"Drug Name",36,11,1) "RTN","IBJTRX",76,0) S IBLINE=$$SETL(IBLINE,$P(IBRXDATA,U,8),"NDC #",24,15,40) "RTN","IBJTRX",77,0) D SET(IBLINE) "RTN","IBJTRX",78,0) ; "RTN","IBJTRX",79,0) S IBLINE=$$SETL("",$$AMT(+$P($G(^DGCR(399,IBIFN,"U1")),U,1)),"Billed Amt",36,11,1) "RTN","IBJTRX",80,0) S IBLINE=$$SETL(IBLINE,$S(IBCOBN=2:"Secondary",IBCOBN=3:"Tertiary",1:"Primary"),"COB",15,15,40) "RTN","IBJTRX",81,0) D SET(IBLINE) "RTN","IBJTRX",82,0) ; "RTN","IBJTRX",83,0) D SET(" ") "RTN","IBJTRX",84,0) ; "RTN","IBJTRX",85,0) ; if response data is not available, get out here "RTN","IBJTRX",86,0) ; "RTN","IBJTRX",87,0) I 'RESPIEN D G INITX "RTN","IBJTRX",88,0) . D SET(" ECME Response Information is not on file.") "RTN","IBJTRX",89,0) . D SET(" No further information available for display.") "RTN","IBJTRX",90,0) . Q "RTN","IBJTRX",91,0) ; "RTN","IBJTRX",92,0) S IBLINE=$$SETL("",,"Payment Information",,20,1) "RTN","IBJTRX",93,0) D SET(IBLINE,"3;2;19") "RTN","IBJTRX",94,0) ; "RTN","IBJTRX",95,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,506,"E"))),"Ingredient Cost Paid",15,26,1) D SET(IBLINE) "RTN","IBJTRX",96,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,507,"E"))),"Dispensing Fee Paid",15,26,1) D SET(IBLINE) "RTN","IBJTRX",97,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,505,"E")),,1),"Patient Resp (Ins)",15,26,1) D SET(IBLINE) "RTN","IBJTRX",98,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,509,"E"))),"Expected Payment Amount",15,26,1) D SET(IBLINE) "RTN","IBJTRX",99,0) ; "RTN","IBJTRX",100,0) D SET(" ") "RTN","IBJTRX",101,0) S IBLINE=$$SETL("",,"Patient Responsibility Amounts",,31,1) "RTN","IBJTRX",102,0) D SET(IBLINE,"3;2;30") "RTN","IBJTRX",103,0) ; "RTN","IBJTRX",104,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,517,"E"))),"Deductible",10,13,1) "RTN","IBJTRX",105,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,572,"E"))),"Coinsurance",10,13,27) "RTN","IBJTRX",106,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,518,"E"))),"Amount of Copay",9,18,52) "RTN","IBJTRX",107,0) D SET(IBLINE) "RTN","IBJTRX",108,0) ; "RTN","IBJTRX",109,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,137,"E"))),"Coverage Gap",10,13,1) "RTN","IBJTRX",110,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,571,"E"))),"Processor Fee",10,13,27) "RTN","IBJTRX",111,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,520,"E"))),"Exceed Benefit Max",9,18,52) "RTN","IBJTRX",112,0) D SET(IBLINE) "RTN","IBJTRX",113,0) ; "RTN","IBJTRX",114,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,129,"E"))),"Health Plan-funded Assistance Amount",15,39,1) "RTN","IBJTRX",115,0) D SET(IBLINE) "RTN","IBJTRX",116,0) ; "RTN","IBJTRX",117,0) D SET(" ") "RTN","IBJTRX",118,0) S IBLINE=$$SETL("",,"Product Selection Amounts",,26,1) "RTN","IBJTRX",119,0) D SET(IBLINE,"3;2;25") "RTN","IBJTRX",120,0) ; "RTN","IBJTRX",121,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,519,"E"))),"Prod Sel Amt",12,21,1) "RTN","IBJTRX",122,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,135,"E"))),"Prod Sel /Non-Pref Formulary",9,33,37) "RTN","IBJTRX",123,0) D SET(IBLINE) "RTN","IBJTRX",124,0) ; "RTN","IBJTRX",125,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,134,"E"))),"Prod Sel/Brand Drug",12,21,1) "RTN","IBJTRX",126,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,136,"E"))),"Prod Sel/Brand Non-Pref Formulary",9,33,37) "RTN","IBJTRX",127,0) D SET(IBLINE) "RTN","IBJTRX",128,0) ; "RTN","IBJTRX",129,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,133,"E"))),"Provider Network Adj",12,21,1) "RTN","IBJTRX",130,0) D SET(IBLINE) "RTN","IBJTRX",131,0) ; "RTN","IBJTRX",132,0) ; Display COB/Other Payer data "RTN","IBJTRX",133,0) I '$D(BPSMCOB(9002313.035501)) D G INITX "RTN","IBJTRX",134,0) . D SET(" ") "RTN","IBJTRX",135,0) . D SET(" No COB/Other Payer Data on file in the ECME Response.") "RTN","IBJTRX",136,0) . Q "RTN","IBJTRX",137,0) ; "RTN","IBJTRX",138,0) S ZC="" F ZCTOT=0:1 S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" ; count how many entries exist "RTN","IBJTRX",139,0) S ZC="",ZCN=0 F S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" D "RTN","IBJTRX",140,0) . S ZCN=ZCN+1 "RTN","IBJTRX",141,0) . D SET(" ") "RTN","IBJTRX",142,0) . S IBLINE="COB/Other Payer ("_ZCN_" of "_ZCTOT_") (from other payer response message)" "RTN","IBJTRX",143,0) . D SET(" "_IBLINE,"3;2;"_$L(IBLINE)) "RTN","IBJTRX",144,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,356,"E")),"Other Payer Cardholder ID",40,27,1) "RTN","IBJTRX",145,0) . D SET(IBLINE) "RTN","IBJTRX",146,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,144,"E")),"Other Payer Effective Date",10,27,1) "RTN","IBJTRX",147,0) . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,145,"E")),"Other Payer Termination Date",10,32,38) "RTN","IBJTRX",148,0) . D SET(IBLINE) "RTN","IBJTRX",149,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,142,"E")),"Other Payer Person Code",6,27,1) "RTN","IBJTRX",150,0) . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,143,"E")),"Other Payer Pt Relationship Code",9,32,38) "RTN","IBJTRX",151,0) . D SET(IBLINE) "RTN","IBJTRX",152,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,340,"E")),"Other Payer ID (BIN)",24,27,1) "RTN","IBJTRX",153,0) . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,991,"E")),"Other Payer PCN",9,32,38) "RTN","IBJTRX",154,0) . D SET(IBLINE) "RTN","IBJTRX",155,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,992,"E")),"Other Payer Group ID",40,27,1) "RTN","IBJTRX",156,0) . D SET(IBLINE) "RTN","IBJTRX",157,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,127,"E")),"Other Payer Help Desk",40,27,1) "RTN","IBJTRX",158,0) . D SET(IBLINE) "RTN","IBJTRX",159,0) . Q "RTN","IBJTRX",160,0) ; "RTN","IBJTRX",161,0) INITX ; "RTN","IBJTRX",162,0) D SET(" "),SET(" ") "RTN","IBJTRX",163,0) Q "RTN","IBJTRX",164,0) ; "RTN","IBJTRX",165,0) HELP ; -- help code "RTN","IBJTRX",166,0) S X="?" D DISP^XQORM1 W !! "RTN","IBJTRX",167,0) Q "RTN","IBJTRX",168,0) ; "RTN","IBJTRX",169,0) EXIT ; -- exit code "RTN","IBJTRX",170,0) K ^TMP("IBJTRX",$J) "RTN","IBJTRX",171,0) I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10() "RTN","IBJTRX",172,0) Q "RTN","IBJTRX",173,0) ; "RTN","IBJTRX",174,0) SETL(TEXT,DATA,LABEL,LEND,LENL,COL) ; build line of text "RTN","IBJTRX",175,0) ; TEXT - existing line of text data "RTN","IBJTRX",176,0) ; DATA - field data "RTN","IBJTRX",177,0) ; LABEL - field label "RTN","IBJTRX",178,0) ; LEND - max length of data "RTN","IBJTRX",179,0) ; LENL - length of label (label will be right justified so the colons line up) "RTN","IBJTRX",180,0) ; COL - starting column for insert "RTN","IBJTRX",181,0) ; "RTN","IBJTRX",182,0) N D1,STR S D1="",COL=$G(COL,1) "RTN","IBJTRX",183,0) I $G(LABEL)'="" S D1=$J(LABEL,+$G(LENL)) "RTN","IBJTRX",184,0) I $D(DATA) S D1=D1_": "_$$FO^IBCNEUT1(DATA,+$G(LEND)) "RTN","IBJTRX",185,0) S STR=$$SETSTR^VALM1(D1,$G(TEXT),COL,$L(D1)) "RTN","IBJTRX",186,0) ; "RTN","IBJTRX",187,0) Q $E(STR,1,80) "RTN","IBJTRX",188,0) ; "RTN","IBJTRX",189,0) SET(TEXT,VID) ; set data in variable TEXT into ListMan display "RTN","IBJTRX",190,0) ; VID is video attribute data of line if any "RTN","IBJTRX",191,0) ; Format: type;start column;width "RTN","IBJTRX",192,0) ; type=1 (reverse video) "RTN","IBJTRX",193,0) ; type=2 (bold) "RTN","IBJTRX",194,0) ; type=3 (underline) "RTN","IBJTRX",195,0) ; "RTN","IBJTRX",196,0) S VALMCNT=VALMCNT+1 "RTN","IBJTRX",197,0) S ^TMP("IBJTRX",$J,VALMCNT,0)=$G(TEXT) ; set text line into display array "RTN","IBJTRX",198,0) I $G(VID)="" G SETX "RTN","IBJTRX",199,0) ; "RTN","IBJTRX",200,0) ; video attributes "RTN","IBJTRX",201,0) N ON,OFF "RTN","IBJTRX",202,0) S ON=$S(+VID=1:IORVON,+VID=2:IOINHI,1:IOUON) "RTN","IBJTRX",203,0) S OFF=$S(+VID=1:IORVOFF,+VID=2:IOINORM,1:IOUOFF) "RTN","IBJTRX",204,0) D CNTRL^VALM10(VALMCNT,+$P(VID,";",2),+$P(VID,";",3),ON,OFF) "RTN","IBJTRX",205,0) ; "RTN","IBJTRX",206,0) SETX ; "RTN","IBJTRX",207,0) Q "RTN","IBJTRX",208,0) ; "RTN","IBJTRX",209,0) AMT(VAL,L,P) ; convert dollar amount to external display "RTN","IBJTRX",210,0) ; VAL can be a number or the Fileman external version of the number "RTN","IBJTRX",211,0) ; L is the $J field length (default 8) "RTN","IBJTRX",212,0) ; P is a flag indicating the number should be enclosed within parentheses "RTN","IBJTRX",213,0) ; strip $ and spaces "RTN","IBJTRX",214,0) S VAL=+$TR($G(VAL),"$ ") "RTN","IBJTRX",215,0) I '$G(L) S L=8 "RTN","IBJTRX",216,0) I $G(P) Q $J($FN(-VAL,"P",2),L+1) "RTN","IBJTRX",217,0) Q $J(VAL,L,2) "RTN","IBJTRX",218,0) ; "RTN","IBJTU2") 0^24^B10638422 "RTN","IBJTU2",1,0) IBJTU2 ;ALB/ARH - TPI UTILITIES ;6/6/03 1:05pm "RTN","IBJTU2",2,0) ;;2.0;INTEGRATED BILLING;**39,106,199,211,276,435**;21-MAR-94;Build 27 "RTN","IBJTU2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBJTU2",4,0) ; "RTN","IBJTU2",5,0) PAT() ; select patient, only allows patient's that have bills - returns DFN^NAME if patient selected, 0 otherwise "RTN","IBJTU2",6,0) N X,Y,DFN,DTOUT,DUOUT,DA "RTN","IBJTU2",7,0) N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups "RTN","IBJTU2",8,0) S DFN=0,DIC(0)="AEQM",DIC="^DPT(",DIC("S")="I $D(^DGCR(399,""C"",Y))" D ^DIC K DIC I Y'<1 S DFN=Y "RTN","IBJTU2",9,0) Q DFN "RTN","IBJTU2",10,0) ; "RTN","IBJTU2",11,0) BILL() ; select bill, returns bill IFN^BILL NUMBER or 0 if none selected "RTN","IBJTU2",12,0) N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups "RTN","IBJTU2",13,0) N X,Y,DTOUT,DUOUT,DA,IBY S IBY=0,DIC="^DGCR(399,",DIC(0)="AEMQ" D ^DIC K DIC I Y'<1 S IBY=Y "RTN","IBJTU2",14,0) Q IBY "RTN","IBJTU2",15,0) ; "RTN","IBJTU2",16,0) PB() ; select either a patient name (must have a bill) or bill number "RTN","IBJTU2",17,0) ; if patient chosen: returns "1^"_DFN, if bill chosen: returns "2^"_IBIFN, 0 otherwise "RTN","IBJTU2",18,0) N IBX,IBY,DIC,DTOUT,DUOUT,DA,X,Y,DPTNOFZY,IBSTR "RTN","IBJTU2",19,0) S IBY=0 "RTN","IBJTU2",20,0) ; "RTN","IBJTU2",21,0) PB1 R !!,"Enter BILL NUMBER or PATIENT NAME: ",IBX:DTIME I IBX["^"!(IBX="") G PBQ "RTN","IBJTU2",22,0) ; "RTN","IBJTU2",23,0) I $E(IBX)="?" D G PB1 "RTN","IBJTU2",24,0) . W ! "RTN","IBJTU2",25,0) . W !," Enter one of following: Patient Name, Bill Number," "RTN","IBJTU2",26,0) . W !," ECME Number or Prescription Number." "RTN","IBJTU2",27,0) . W !," You may also use prefixes: 'E.' for ECME# or 'R.' for Prescription." "RTN","IBJTU2",28,0) . W ! "RTN","IBJTU2",29,0) ; "RTN","IBJTU2",30,0) ; search for patient name "RTN","IBJTU2",31,0) I IBX?1A4N!(IBX?2A.AP)!(IBX?2.A1",".AP)!(IBX?1A1P.AP) D I IBY G PBQ "RTN","IBJTU2",32,0) . S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups "RTN","IBJTU2",33,0) . S DIC="^DPT(",DIC(0)="EQM",DIC("S")="I $D(^DGCR(399,""C"",Y))",X=IBX D ^DIC K DIC I Y'<1 S IBY="1^"_+Y "RTN","IBJTU2",34,0) ; "RTN","IBJTU2",35,0) ; search for bill number "RTN","IBJTU2",36,0) I (IBX?1A1.12AN)!(IBX?3N1"-"1A1.7AN)!(IBX?1"`"1.15N)!(IBX=" ") D I IBY G PBQ "RTN","IBJTU2",37,0) . S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups "RTN","IBJTU2",38,0) . S IBSTR=IBX "RTN","IBJTU2",39,0) . I $L(IBSTR,"-")=2,$P(IBSTR,"-")?3N S IBSTR=$P(IBX,"-",2,255) "RTN","IBJTU2",40,0) . S DIC="^DGCR(399,",DIC(0)="EQ",X=IBSTR D ^DIC K DIC I Y'<1 S IBY="2^"_+Y "RTN","IBJTU2",41,0) ; "RTN","IBJTU2",42,0) ; search for ECME number REC^IBRFN() "RTN","IBJTU2",43,0) S IBSTR=IBX "RTN","IBJTU2",44,0) I IBSTR?1.12N S IBSTR="E."_IBSTR "RTN","IBJTU2",45,0) I IBSTR?1"E."1.12N S Y=$$REC^IBRFN(IBSTR) I Y>0 S IBY="2^"_+Y G PBQ "RTN","IBJTU2",46,0) ; "RTN","IBJTU2",47,0) ; search for RX number REC^IBRFN() "RTN","IBJTU2",48,0) S IBSTR=IBX "RTN","IBJTU2",49,0) I IBSTR?1N1.10AN S IBSTR="R."_IBSTR "RTN","IBJTU2",50,0) I IBSTR?1"R."1N1.10AN S Y=$$REC^IBRFN(IBSTR) I Y>0 S IBY="2^"_+Y G PBQ "RTN","IBJTU2",51,0) ; "RTN","IBJTU2",52,0) W "??" "RTN","IBJTU2",53,0) G PB1 "RTN","IBJTU2",54,0) PBQ Q IBY "RTN","IBJTU2",55,0) ; "RTN","IBJTU2",56,0) RCANC(IBIFN,ARR,WDTH) ; if bill cancelled returns ARR = IBIFN ^ PTR TO 200 ^ INITIALS OF WHO CANCELLED IN IB "RTN","IBJTU2",57,0) ; ARR(X) = REASON CANCELLED with line width passed in "RTN","IBJTU2",58,0) N X,DIWL,DIWR,DIWF,IBDS,IBCNT,IBI,IBD K ARR "RTN","IBJTU2",59,0) S ARR=0,IBIFN=+$G(IBIFN),IBDS=$G(^DGCR(399,IBIFN,"S")) "RTN","IBJTU2",60,0) S X=$P(IBDS,U,18) G:'X RCANCQ "RTN","IBJTU2",61,0) S ARR=IBIFN_U_X_U_$P($G(^VA(200,+X,0)),U,2) "RTN","IBJTU2",62,0) S X=$P(IBDS,U,19) G:X="" RCANCQ "RTN","IBJTU2",63,0) S DIWL=1,DIWR=$G(WDTH),DIWF="" D ^DIWP "RTN","IBJTU2",64,0) S (IBCNT,IBI)=0,DIWL=1 F S IBI=$O(^UTILITY($J,"W",DIWL,IBI)) Q:'IBI D "RTN","IBJTU2",65,0) . S IBD=$G(^UTILITY($J,"W",DIWL,IBI,0)) I IBD'="" S IBCNT=IBCNT+1,ARR(IBCNT)=IBD "RTN","IBJTU2",66,0) K ^UTILITY($J,"W") "RTN","IBJTU2",67,0) RCANCQ Q "RTN","IBJTU2",68,0) ; "RTN","IBJTU2",69,0) DR(DB,DE) ; get a date range from the user, DB is default begin date (FM), DE is default end date "RTN","IBJTU2",70,0) ; returns "begin dt ^ end dt" in FM format, or "" if two valid dates are not entered "RTN","IBJTU2",71,0) N IBY,IBX,%DT,X,Y S (IBX,IBY)="" I $G(DB)?7N S %DT("B")=$$FMTE^XLFDT(DB,2) "RTN","IBJTU2",72,0) S %DT="AEX",%DT("A")="Start Date: " D ^%DT K %DT G:Y<0 DRQ S IBX=Y "RTN","IBJTU2",73,0) S %DT(0)=IBX,%DT("B")=$$FMTE^XLFDT($S(IBX>$G(DE):IBX,1:DE),2) "RTN","IBJTU2",74,0) S %DT="AEX",%DT("A")="End Date: " D ^%DT K %DT G:Y<0 DRQ S IBY=IBX_U_Y "RTN","IBJTU2",75,0) DRQ Q IBY "RTN","IBNCPBB") 0^1^B95588054 "RTN","IBNCPBB",1,0) IBNCPBB ;DALOI/AAT - ECME BACKBILLING ;24-JUN-2003 "RTN","IBNCPBB",2,0) ;;2.0;INTEGRATED BILLING;**276,347,384,435**;21-MAR-94;Build 27 "RTN","IBNCPBB",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPBB",4,0) ; "RTN","IBNCPBB",5,0) ; Reference to file #9002313.29 supported by IA# 4222 "RTN","IBNCPBB",6,0) ; Reference to DIC^PSODI supported by IA# 4858 "RTN","IBNCPBB",7,0) ; "RTN","IBNCPBB",8,0) Q "RTN","IBNCPBB",9,0) EN ;[IB GENERATE ECME RX BILLS] entry "RTN","IBNCPBB",10,0) N IBMOD1,IBMOD3,IBPAT,IBRX,IBBDT,IBEDT,IBSEL,IBREF,IBPAUSE "RTN","IBNCPBB",11,0) S IBREF=$NA(^TMP($J,"IBNCPBB")) "RTN","IBNCPBB",12,0) S IBPAUSE=1 "RTN","IBNCPBB",13,0) K @IBREF D "RTN","IBNCPBB",14,0) . N IBEXIT "RTN","IBNCPBB",15,0) . S IBEXIT=0 "RTN","IBNCPBB",16,0) . D MODE I IBEXIT Q "RTN","IBNCPBB",17,0) . I IBMOD1="P" D SELECT I IBEXIT Q "RTN","IBNCPBB",18,0) . I IBMOD1="R" D SELECT2 I IBEXIT Q "RTN","IBNCPBB",19,0) . D CONFIRM I IBEXIT Q "RTN","IBNCPBB",20,0) . D PROCESS^IBNCPBB1 I IBEXIT Q "RTN","IBNCPBB",21,0) I IBPAUSE W ! D PAUSE() "RTN","IBNCPBB",22,0) K @IBREF "RTN","IBNCPBB",23,0) Q "RTN","IBNCPBB",24,0) ; "RTN","IBNCPBB",25,0) CT(IBTRN) ;CT ENTRY "RTN","IBNCPBB",26,0) N IBDELAY,IBZ,IBRX,IBRXN,IBFIL,IBEXIT,IBPAT,IBRDT,IBFDT,IBRES,IBBIL,IBBN,IBQ,IBSCRES,IBERR "RTN","IBNCPBB",27,0) S IBQ=0 "RTN","IBNCPBB",28,0) D FULL^VALM1 "RTN","IBNCPBB",29,0) W !!,"This option sends electronic Pharmacy Claims to the Payer" "RTN","IBNCPBB",30,0) S VALMBCK="R" "RTN","IBNCPBB",31,0) S IBZ=$G(^IBT(356,IBTRN,0)) Q:IBZ="" "RTN","IBNCPBB",32,0) S IBRX=$P(IBZ,U,8),IBFIL=$P(IBZ,U,10) "RTN","IBNCPBB",33,0) I 'IBRX D Q "RTN","IBNCPBB",34,0) . W !!,"This is not a Pharmacy Claims Tracking record",*7,! "RTN","IBNCPBB",35,0) . D PAUSE("Cannot submit to ECME") "RTN","IBNCPBB",36,0) ; "RTN","IBNCPBB",37,0) ;Release date: "RTN","IBNCPBB",38,0) I IBFIL=0 S IBRDT=$$FILE^IBRXUTL(IBRX,31) "RTN","IBNCPBB",39,0) E S IBRDT=$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,17) "RTN","IBNCPBB",40,0) I 'IBRDT D Q "RTN","IBNCPBB",41,0) . W !!,"The Prescription is not released.",! "RTN","IBNCPBB",42,0) . D PAUSE("Cannot submit to ECME") "RTN","IBNCPBB",43,0) ; -- Drug DEA ROI check. "RTN","IBNCPBB",44,0) S IBPAT=$P(IBZ,U,2) "RTN","IBNCPBB",45,0) S IBDRUG=$$FILE^IBRXUTL(IBRX,6) "RTN","IBNCPBB",46,0) ; Fill/Refill Date: "RTN","IBNCPBB",47,0) S IBFDT=$S('IBFIL:$$FILE^IBRXUTL(IBRX,22),1:$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,.01)) "RTN","IBNCPBB",48,0) I $$INSUR^IBBAPI(IBPAT,IBFDT,"P",.IBANY,1) S IBINS=+$G(IBANY("IBBAPI","INSUR",1,1)) S IBQ=$$ROICHK^IBNCPDR4(IBPAT,IBDRUG,IBINS,IBFDT) D:IBQ=1 ROICLN^IBNCPDR4(IBTRN) I 'IBQ D PAUSE() Q ;Requires ROI "RTN","IBNCPBB",49,0) ; "RTN","IBNCPBB",50,0) I $$SC($P(IBZ,U,19)) D Q:IBQ "RTN","IBNCPBB",51,0) . N DIR,DIE,DA,DR,Y "RTN","IBNCPBB",52,0) . W !!,"The Rx is marked 'non-billable' in CT: ",$P($G(^IBE(356.8,+$P(IBZ,U,19),0)),U) "RTN","IBNCPBB",53,0) . W !,"If you continue, the NON-BILLABLE REASON will be deleted.",! "RTN","IBNCPBB",54,0) . S DIR(0)="Y",DIR("A")="Are you sure you want to bill this episode" "RTN","IBNCPBB",55,0) . S DIR("B")="NO" "RTN","IBNCPBB",56,0) . S DIR("?")="If you want to bill this Rx, enter 'Yes' - otherwise, enter 'No'" "RTN","IBNCPBB",57,0) . W ! D ^DIR K DIR "RTN","IBNCPBB",58,0) . I 'Y S IBQ=1 Q "RTN","IBNCPBB",59,0) . S DIE="^IBT(356,",DA=IBTRN,DR=".19///@" D ^DIE ;clean NB reason "RTN","IBNCPBB",60,0) . S IBSCRES(IBRX,IBFIL)=1 ; sc resolved flag "RTN","IBNCPBB",61,0) ; "RTN","IBNCPBB",62,0) S IBZ=$G(^IBT(356,IBTRN,0)) ; refresh "RTN","IBNCPBB",63,0) I $P(IBZ,U,19) D Q "RTN","IBNCPBB",64,0) . W !!,"The Prescription is marked 'non-billable' in Claims Tracking",*7 "RTN","IBNCPBB",65,0) . W !,"Reason non-billable: ",$P($G(^IBE(356.8,+$P(IBZ,U,19),0),"Unknown"),U),! "RTN","IBNCPBB",66,0) . D PAUSE("Cannot submit to ECME") "RTN","IBNCPBB",67,0) ; Is the patient billable at the released date? "RTN","IBNCPBB",68,0) S IBRES=$$ECMEBIL^IBNCPDPU(IBPAT,IBFDT) "RTN","IBNCPBB",69,0) I 'IBRES D Q "RTN","IBNCPBB",70,0) . W !!,"The patient is not ECME Billable at the ",$S(IBFIL:"re",1:""),"fill date." "RTN","IBNCPBB",71,0) . W !,"Reason: ",$P(IBRES,U,2,255),! "RTN","IBNCPBB",72,0) . D PAUSE("Cannot submit to ECME") "RTN","IBNCPBB",73,0) ; "RTN","IBNCPBB",74,0) S IBRXN=$$FILE^IBRXUTL(IBRX,.01) "RTN","IBNCPBB",75,0) S IBBIL=$$BILL(IBRXN,IBRDT) "RTN","IBNCPBB",76,0) I IBBIL,'$P($G(^DGCR(399,IBBIL,"S")),U,16) D Q "RTN","IBNCPBB",77,0) . W !!,"Rx# ",IBRXN," was previously billed." "RTN","IBNCPBB",78,0) . W !,"Please manually cancel the bill# ",$P($G(^DGCR(399,IBBIL,0)),U)," before submitting claim to ECME.",! "RTN","IBNCPBB",79,0) . D PAUSE("Cannot submit to ECME") "RTN","IBNCPBB",80,0) I IBBIL W !,"The bill# ",$P($G(^DGCR(399,IBBIL,0)),U)," has been cancelled.",! "RTN","IBNCPBB",81,0) ; "RTN","IBNCPBB",82,0) S IBDELAY=$$DLYRC() ; get delay reason code with optional parameter, IB*2.0*435 "RTN","IBNCPBB",83,0) ; "RTN","IBNCPBB",84,0) D CONFRX(IBRXN) Q:$G(IBEXIT) "RTN","IBNCPBB",85,0) ; "RTN","IBNCPBB",86,0) W !!,"Submitting Rx# ",IBRXN W:IBFIL ", Refill# ",IBFIL W " ..." "RTN","IBNCPBB",87,0) S IBRES=$$SUBMIT^IBNCPDPU(IBRX,IBFIL,IBDELAY) W !," ",$S(+IBRES=0:"S",1:"Not s")_"ent through ECME." "RTN","IBNCPBB",88,0) I +IBRES'=0 W !," *** ECME returned status: ",$$STAT(IBRES),! "RTN","IBNCPBB",89,0) I +IBRES=0 W !!,"The Rx have been submitted to ECME for electronic billing",! "RTN","IBNCPBB",90,0) D PAUSE() "RTN","IBNCPBB",91,0) Q "RTN","IBNCPBB",92,0) ; "RTN","IBNCPBB",93,0) MODE ; "RTN","IBNCPBB",94,0) ; IBMOD1: "P"-Single Patient, "R"-Single Rx "RTN","IBNCPBB",95,0) ; IBMOD3 (if IBMOD1="P"): "U"-Unbilled, "A"-All Rx "RTN","IBNCPBB",96,0) ; IBPAT (if IBMOD1="P"): Patient's DFN "RTN","IBNCPBB",97,0) ; IBBDT,IBEDT (if IBMOD1="P"): From/To dates inclusive "RTN","IBNCPBB",98,0) N DIR,DIC,DIRUT,DUOUT,Y,PSOFILE "RTN","IBNCPBB",99,0) S (IBMOD1,IBMOD3)="" "RTN","IBNCPBB",100,0) S DIR(0)="S^P:SINGLE (P)ATIENT;R:SINGLE (R)X" "RTN","IBNCPBB",101,0) S DIR("A")="SINGLE (P)ATIENT, SINGLE (R)X" "RTN","IBNCPBB",102,0) S DIR("B")="P" "RTN","IBNCPBB",103,0) D ^DIR K DIR I $D(DIRUT) S IBEXIT=1,IBPAUSE=0 Q "RTN","IBNCPBB",104,0) S IBMOD1=Y "RTN","IBNCPBB",105,0) ; Enter Rx "RTN","IBNCPBB",106,0) I IBMOD1="R" W ! S PSOFILE=52,DIC="^PSRX(",DIC(0)="AEQMN" D DIC^PSODI(PSOFILE,.DIC) S:$D(DUOUT) IBEXIT=1 S IBRX=$S(Y>0:+Y,1:0) S:'IBRX IBEXIT=1,IBPAUSE=0 "RTN","IBNCPBB",107,0) K PSODIY "RTN","IBNCPBB",108,0) I IBMOD1="R" Q "RTN","IBNCPBB",109,0) ; "RTN","IBNCPBB",110,0) I IBMOD1'="P" W !,"???" S IBEXIT=1 Q ; Invalid mode "RTN","IBNCPBB",111,0) ;Enter Patient "RTN","IBNCPBB",112,0) S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC S:$D(DUOUT) IBEXIT=1 S IBPAT=$S(Y>0:+Y,1:0) S:'IBPAT IBEXIT=1,IBPAUSE=0 "RTN","IBNCPBB",113,0) Q:IBEXIT "RTN","IBNCPBB",114,0) I '$$ECMEBIL^IBNCPDPU(IBPAT,DT) W *7,!!,"Warning! The patient is currently not ECME billable!" "RTN","IBNCPBB",115,0) ; "RTN","IBNCPBB",116,0) D DATE I IBEXIT S IBPAUSE=0 Q "RTN","IBNCPBB",117,0) ; "RTN","IBNCPBB",118,0) S DIR(0)="S^U:UNBILLED;A:ALL RX" "RTN","IBNCPBB",119,0) S DIR("A")="(U)NBILLED, (A)LL RX" "RTN","IBNCPBB",120,0) S DIR("B")="U" "RTN","IBNCPBB",121,0) D ^DIR K DIR I $D(DIRUT) S IBEXIT=1,IBPAUSE=0 Q "RTN","IBNCPBB",122,0) S IBMOD3=Y "RTN","IBNCPBB",123,0) Q "RTN","IBNCPBB",124,0) ; "RTN","IBNCPBB",125,0) ;begin/end date "RTN","IBNCPBB",126,0) DATE ; "RTN","IBNCPBB",127,0) N Y,%DT "RTN","IBNCPBB",128,0) S (IBBDT,IBEDT)=DT "RTN","IBNCPBB",129,0) W ! "RTN","IBNCPBB",130,0) S %DT="AEX" "RTN","IBNCPBB",131,0) S %DT("A")="START WITH DATE: ",%DT("B")="TODAY" "RTN","IBNCPBB",132,0) D ^%DT K %DT "RTN","IBNCPBB",133,0) I Y'>0 S IBEXIT=1 Q "RTN","IBNCPBB",134,0) S IBBDT=+Y "RTN","IBNCPBB",135,0) S %DT="AEX" "RTN","IBNCPBB",136,0) S %DT("A")="GO TO DATE: ",%DT("B")="TODAY" ;$$DAT2^IBOUTL(IBBDT) "RTN","IBNCPBB",137,0) D ^%DT K %DT "RTN","IBNCPBB",138,0) I Y'>0 S IBEXIT=1 Q "RTN","IBNCPBB",139,0) S IBEDT=+Y "RTN","IBNCPBB",140,0) Q "RTN","IBNCPBB",141,0) ; "RTN","IBNCPBB",142,0) SELECT ;Select from patient's list "RTN","IBNCPBB",143,0) ; (IBPAT,IBBDT,IBEDT,IBMOD3) "RTN","IBNCPBB",144,0) N IBD,IBRX,IBZ,IBDATA,IBCNT,Y,PDFN,LIST,LIST2,NODE,RXNUMEXT,LIST,IBDATE,CNT1,CNT2,RFNUM "RTN","IBNCPBB",145,0) S CNT1=0,CNT2=0,IBCNT=0 "RTN","IBNCPBB",146,0) S LIST="IBRXSELARR" "RTN","IBNCPBB",147,0) S NODE=2 "RTN","IBNCPBB",148,0) D RX^PSO52API(IBPAT,LIST,,,NODE,,) "RTN","IBNCPBB",149,0) S RXNUMEXT=0 F S RXNUMEXT=$O(^TMP($J,LIST,"B",RXNUMEXT)) Q:'RXNUMEXT D "RTN","IBNCPBB",150,0) . S IBRX=0 F S IBRX=$O(^TMP($J,LIST,"B",RXNUMEXT,IBRX)) Q:'IBRX D "RTN","IBNCPBB",151,0) .. S IBDATE=$P(^TMP($J,LIST,IBPAT,IBRX,31),"^",1) "RTN","IBNCPBB",152,0) .. I (IBDATE>IBBDT)&(IBDATE0 D:$$SUBFILE^IBRXUTL(IBRX,RFNUM,52,17) "RTN","IBNCPBB",162,0) .... S IBDATA=$$RXDATA(IBRX,RFNUM) "RTN","IBNCPBB",163,0) .... I $P(IBDATA,U,6),IBMOD3'="A" Q ; unbilled only "RTN","IBNCPBB",164,0) .... S IBCNT=IBCNT+1,@IBREF@(IBCNT)=IBDATA "RTN","IBNCPBB",165,0) ... K ^TMP($J,LIST2) "RTN","IBNCPBB",166,0) K ^TMP($J,LIST) "RTN","IBNCPBB",167,0) D MKCHOICE "RTN","IBNCPBB",168,0) Q "RTN","IBNCPBB",169,0) SELECT2 ;Select from Rx list "RTN","IBNCPBB",170,0) ; (IBRX) "RTN","IBNCPBB",171,0) N IBCNT,Y,PDFN,RIFN,LST "RTN","IBNCPBB",172,0) S RIFN=0 "RTN","IBNCPBB",173,0) W ! S IBPAUSE=1 "RTN","IBNCPBB",174,0) S PDFN=$$FILE^IBRXUTL(IBRX,2) "RTN","IBNCPBB",175,0) S LST="SEL2LST" "RTN","IBNCPBB",176,0) I $$RXZERO^IBRXUTL(PDFN,IBRX)="" W !,"The Rx does not exist. Please try again." S IBEXIT=1 Q "RTN","IBNCPBB",177,0) I $$FILE^IBRXUTL(IBRX,31)="" W !,"The Rx has not been released. Please try again." S IBEXIT=1 Q "RTN","IBNCPBB",178,0) S IBCNT=1,@IBREF@(IBCNT)=$$RXDATA(IBRX,0) "RTN","IBNCPBB",179,0) D RX^PSO52API(PDFN,LST,IBRX,,"R",,) "RTN","IBNCPBB",180,0) S RIFN=0 F S RIFN=$O(^TMP($J,LST,PDFN,IBRX,"RF",RIFN)) Q:RIFN'>0 D:$$SUBFILE^IBRXUTL(IBRX,RIFN,52,17) "RTN","IBNCPBB",181,0) .S IBCNT=IBCNT+1,@IBREF@(IBCNT)=$$RXDATA(IBRX,RIFN) "RTN","IBNCPBB",182,0) K ^TMP($J,LST) "RTN","IBNCPBB",183,0) D MKCHOICE "RTN","IBNCPBB",184,0) Q "RTN","IBNCPBB",185,0) ; "RTN","IBNCPBB",186,0) MKCHOICE ; "RTN","IBNCPBB",187,0) N Y "RTN","IBNCPBB",188,0) W ! "RTN","IBNCPBB",189,0) S Y=0 F S Y=$O(@IBREF@(Y)) Q:'Y D DISP(Y) "RTN","IBNCPBB",190,0) ; "RTN","IBNCPBB",191,0) I $O(@IBREF@(0))="" S IBEXIT=1 W !!," No Rxs meet the entered criteria. Please try again." Q "RTN","IBNCPBB",192,0) I $O(@IBREF@(""),-1)=1 S IBSEL(1)="" Q ; one item only "RTN","IBNCPBB",193,0) F W !!,"Enter Line Item(s) to submit to ECME or (A)LL :" R IBSEL:DTIME S:'$T IBEXIT=1 Q:IBEXIT Q:IBSEL'["?" D "RTN","IBNCPBB",194,0) . W !?10,"Enter number(s) or item range(s) separated by comma." "RTN","IBNCPBB",195,0) . W !?10,"Example: 1,3,7-11" "RTN","IBNCPBB",196,0) Q:IBEXIT "RTN","IBNCPBB",197,0) I IBSEL'="",$TR(IBSEL,"al","AL")=$E("ALL",1,$L(IBSEL)),$L(IBSEL)<3 W $E("ALL",$L(IBSEL)+1,3) S IBSEL="ALL" "RTN","IBNCPBB",198,0) I IBSEL="" S IBEXIT=1 W " Nothing selected" Q "RTN","IBNCPBB",199,0) I IBSEL="^" S IBEXIT=1 W " Cancelled" Q "RTN","IBNCPBB",200,0) ;Collect the required into the IBSEL(i) local array "RTN","IBNCPBB",201,0) D PARSE(.IBSEL) "RTN","IBNCPBB",202,0) I $O(IBSEL(0))="" S IBEXIT=1 W !!,"No item(s) match the selection." Q "RTN","IBNCPBB",203,0) Q "RTN","IBNCPBB",204,0) ; "RTN","IBNCPBB",205,0) CONFIRM ; "RTN","IBNCPBB",206,0) N DIR,Y "RTN","IBNCPBB",207,0) W ! "RTN","IBNCPBB",208,0) S DIR(0)="Y",DIR("B")="NO",DIR("A")="Submit the selected RX(s) to ECME for electronic billing" "RTN","IBNCPBB",209,0) D ^DIR I Y'=1 S IBEXIT=1 "RTN","IBNCPBB",210,0) Q "RTN","IBNCPBB",211,0) ; "RTN","IBNCPBB",212,0) CONFRX(IBRX) ; "RTN","IBNCPBB",213,0) N DIR,Y "RTN","IBNCPBB",214,0) W ! "RTN","IBNCPBB",215,0) S DIR(0)="Y",DIR("B")="NO",DIR("A")="Submit the Rx# "_IBRX_" to ECME for electronic billing" "RTN","IBNCPBB",216,0) D ^DIR I Y'=1 S IBEXIT=1 "RTN","IBNCPBB",217,0) Q "RTN","IBNCPBB",218,0) ; "RTN","IBNCPBB",219,0) STAT(X) ; "RTN","IBNCPBB",220,0) I +X<6 Q $P(X,"^",2) "RTN","IBNCPBB",221,0) Q "Unknown Status" "RTN","IBNCPBB",222,0) ; "RTN","IBNCPBB",223,0) BILL(IBRXN,IBDT) ;Bill IEN (if any) or null "RTN","IBNCPBB",224,0) N RES,X,IBZ "RTN","IBNCPBB",225,0) S IBDT=$P(IBDT,".") "RTN","IBNCPBB",226,0) S RES="" "RTN","IBNCPBB",227,0) S X="" F S X=$O(^IBA(362.4,"B",IBRXN,X),-1) Q:X="" D:X Q:RES "RTN","IBNCPBB",228,0) . S IBZ=$G(^IBA(362.4,X,0)) "RTN","IBNCPBB",229,0) . I $P($P(IBZ,U,3),".")=IBDT,$P(IBZ,U,2) S RES=+$P(IBZ,U,2) "RTN","IBNCPBB",230,0) Q RES "RTN","IBNCPBB",231,0) ; "RTN","IBNCPBB",232,0) ; "RTN","IBNCPBB",233,0) RXDATA(IBRX,IBFIL) ; "RTN","IBNCPBB",234,0) ;RxIEN^Rx#^Fill#^RelDate^DrugIEN^BillIEN "RTN","IBNCPBB",235,0) N IBRXN,IBDT,IBDRUG,IBBIL,DATRET "RTN","IBNCPBB",236,0) S IBRXN=$$FILE^IBRXUTL(IBRX,.01) "RTN","IBNCPBB",237,0) I IBFIL=0 S IBDT=$$FILE^IBRXUTL(IBRX,22) "RTN","IBNCPBB",238,0) E S IBDT=$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,.01) "RTN","IBNCPBB",239,0) S IBDT=$P(IBDT,".") "RTN","IBNCPBB",240,0) S IBDRUG=$$FILE^IBRXUTL(IBRX,6) "RTN","IBNCPBB",241,0) S IBBIL=$$BILL(IBRXN,IBDT) "RTN","IBNCPBB",242,0) S DATRET=IBRX_"^"_IBRXN_"^"_IBFIL_"^"_IBDT_"^"_IBDRUG_"^"_IBBIL "RTN","IBNCPBB",243,0) Q DATRET "RTN","IBNCPBB",244,0) ; "RTN","IBNCPBB",245,0) DISP(IBITEM) ; "RTN","IBNCPBB",246,0) N IBD,IBBILN,IBDRUG,IBBIL "RTN","IBNCPBB",247,0) S IBD=$G(@IBREF@(IBITEM)) Q:IBD="" "RTN","IBNCPBB",248,0) W !,IBITEM," ",?4,$P(IBD,U,2)," ",?15,$P(IBD,U,3)," ",?20,$$DAT2^IBOUTL($P(IBD,U,4))," " "RTN","IBNCPBB",249,0) W ?32,$E($$DRUG^IBRXUTL1(+$P(IBD,U,5)),1,30) "RTN","IBNCPBB",250,0) S IBBIL=$P(IBD,U,6) "RTN","IBNCPBB",251,0) I IBBIL W ?64,$P($G(^DGCR(399,+IBBIL,0)),U) I $P($G(^DGCR(399,IBBIL,"S")),U,16) W "(canc)" "RTN","IBNCPBB",252,0) Q "RTN","IBNCPBB",253,0) ; "RTN","IBNCPBB",254,0) PARSE(X) ; "RTN","IBNCPBB",255,0) N I,J,N "RTN","IBNCPBB",256,0) S X=$TR(X," ") "RTN","IBNCPBB",257,0) S X=$TR(X,";",",") "RTN","IBNCPBB",258,0) I $TR(IBSEL,"al","AL")="ALL" D Q "RTN","IBNCPBB",259,0) . F I=1:1 Q:'$D(@IBREF@(I)) S IBSEL(I)="" "RTN","IBNCPBB",260,0) F I=1:1:$L(X,",") S N=$P(X,",",I) D:N'="" "RTN","IBNCPBB",261,0) . I N'["-" D:N Q "RTN","IBNCPBB",262,0) . . I $D(@IBREF@(N)) S X(N)="" "RTN","IBNCPBB",263,0) . ; Processing range "RTN","IBNCPBB",264,0) . N N1,N2 "RTN","IBNCPBB",265,0) . S N1=+$P(N,"-",1),N2=+$P(N,"-",2) "RTN","IBNCPBB",266,0) . F J=N1:$S(N20,DFLT<15 S DIR("B")=DFLT "RTN","IBNCPBB",291,0) S DIR(0)="PO^9002313.29:EMZ" D ^DIR K DIR ; IA# TBD "RTN","IBNCPBB",292,0) S IBDELAY=$S($D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT):"^",1:Y) "RTN","IBNCPBB",293,0) S IBDELAY=+$P((IBDELAY),"^",1) "RTN","IBNCPBB",294,0) Q IBDELAY "RTN","IBNCPBB",295,0) ; "RTN","IBNCPBB",296,0) ;IBNCPBB "RTN","IBNCPDP") 0^5^B5486206 "RTN","IBNCPDP",1,0) IBNCPDP ;OAK/ELZ - APIS FOR NCPCP/ECME ;1/9/08 17:27 "RTN","IBNCPDP",2,0) ;;2.0;INTEGRATED BILLING;**223,276,363,383,384,411,435**;21-MAR-94;Build 27 "RTN","IBNCPDP",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDP",4,0) ; "RTN","IBNCPDP",5,0) ; "RTN","IBNCPDP",6,0) RX(DFN,IBD) ; pharmacy package call, passing in IBD by ref "RTN","IBNCPDP",7,0) ; this is called by PSO for all prescriptions issued, return is "RTN","IBNCPDP",8,0) ; a response to bill ECME or not with array for billing data elements "RTN","IBNCPDP",9,0) ; third piece of return is an Eligibility indicator for the prescription "RTN","IBNCPDP",10,0) ; "RTN","IBNCPDP",11,0) ; IBD("IEN") = Prescription IEN "RTN","IBNCPDP",12,0) ; ("FILL NUMBER") = Fill number (0 is initial) "RTN","IBNCPDP",13,0) ; ("FILL DATE") = Fill or refill date "RTN","IBNCPDP",14,0) ; ("RELEASE DATE")= Date of the Rx release in FileMan format "RTN","IBNCPDP",15,0) ; ("NDC") = NDC number for drug "RTN","IBNCPDP",16,0) ; ("DEA") = DEA special handling info "RTN","IBNCPDP",17,0) ; ("COST") = cost of medication being dispensed "RTN","IBNCPDP",18,0) ; ("AO") = Agent Orange (0,1 OR Null) "RTN","IBNCPDP",19,0) ; ("EC") = Environmental Contaminant (0,1 OR Null) "RTN","IBNCPDP",20,0) ; ("HNC") = Head/neck cancer (0,1 OR Null) "RTN","IBNCPDP",21,0) ; ("IR") = Ionizing radiation (0,1 OR Null) "RTN","IBNCPDP",22,0) ; ("MST") = Military sexual trauma (0,1 OR Null) "RTN","IBNCPDP",23,0) ; ("SC") = Service connected (0,1 OR Null) "RTN","IBNCPDP",24,0) ; ("CV") = Combat Veteran (0,1 OR Null) "RTN","IBNCPDP",25,0) ; ("QTY") = Quantity of med dispensed "RTN","IBNCPDP",26,0) ; ("EPHARM") = #9002313.56 ien (E-PHARMACY division) "RTN","IBNCPDP",27,0) ; "RTN","IBNCPDP",28,0) ; "RTN","IBNCPDP",29,0) ; IBD("INS",n,1) = insurance array to bill in n order "RTN","IBNCPDP",30,0) ; file 355.3 ien (group)^bin^pcn^payer sheet^group id^ "RTN","IBNCPDP",31,0) ; cardholder id^patient relationship code^ "RTN","IBNCPDP",32,0) ; cardholder first name^cardholder last name^ "RTN","IBNCPDP",33,0) ; home plan state ^Payer Sheet B2 ^Payer Sheet B3 "RTN","IBNCPDP",34,0) ; Software/Vendor Cert ID ^ Ins Name^Payer Sheet E1 "RTN","IBNCPDP",35,0) ; "RTN","IBNCPDP",36,0) ; ("INS",n,2) = dispensing fee^basis of cost determination^ "RTN","IBNCPDP",37,0) ; awp or tort rate or cost^gross amount due^ "RTN","IBNCPDP",38,0) ; administrative fee "RTN","IBNCPDP",39,0) ; "RTN","IBNCPDP",40,0) ; for basis of cost determination the following is used: "RTN","IBNCPDP",41,0) ; "07" would be sent for Usual & Customary "RTN","IBNCPDP",42,0) ; "01" would be sent for AWP "RTN","IBNCPDP",43,0) ; "05" would be sent for Cost calculations "RTN","IBNCPDP",44,0) ; "RTN","IBNCPDP",45,0) ; ("INS",n,3) = group name^ins co ph 3^plan ID^ "RTN","IBNCPDP",46,0) ; insurance type (V=vet, T=tricare)^ "RTN","IBNCPDP",47,0) ; insurance company (#36) ien^COB field (.2) in 2.312 subfile^ "RTN","IBNCPDP",48,0) ; 2.312 subfile ien (pt. insurance policy ien)^ "RTN","IBNCPDP",49,0) ; maximum NCPDP transactions (366.03,10.1) "RTN","IBNCPDP",50,0) ; "RTN","IBNCPDP",51,0) N IBRES,IBNB "RTN","IBNCPDP",52,0) S IBRES=$$RX^IBNCPDP1(DFN,.IBD) "RTN","IBNCPDP",53,0) ;remove "Not ECME billable: " from the reason text "RTN","IBNCPDP",54,0) S IBNB="Not ECME billable: " "RTN","IBNCPDP",55,0) I IBRES[IBNB S IBRES=$P(IBRES,U)_U_$P($P(IBRES,U,2),IBNB,2)_U_$P(IBRES,U,3) "RTN","IBNCPDP",56,0) Q IBRES "RTN","IBNCPDP",57,0) ; "RTN","IBNCPDP",58,0) ; "RTN","IBNCPDP",59,0) STORESP(DFN,IBD) ; this is an API for pharmacy/ecme to use to relay "RTN","IBNCPDP",60,0) ; results of billing using the ecme software. If electronic billing is "RTN","IBNCPDP",61,0) ; successful, then bills will be established. If not, then we will "RTN","IBNCPDP",62,0) ; flag the entry in ct for paper or not billable. "RTN","IBNCPDP",63,0) ; "RTN","IBNCPDP",64,0) ; IBD("STATUS") = Bill status (PAID, REJECTED,REVERSED "RTN","IBNCPDP",65,0) ; CLOSED,RELEASED,or SUBMITTED) "RTN","IBNCPDP",66,0) ; ("FILL DATE") = Fill Date "RTN","IBNCPDP",67,0) ; ("PRESCRIPTION") = Prescription IEN from drug file (#52) "RTN","IBNCPDP",68,0) ; ("FILL NUMBER") = Fill or refill number "RTN","IBNCPDP",69,0) ; ("BILLED") = Amount billed "RTN","IBNCPDP",70,0) ; ("PAID") = Amount paid "RTN","IBNCPDP",71,0) ; ("BCID") = Reference number to the claim for payment "RTN","IBNCPDP",72,0) ; BCID stands for Bill Claim ID "RTN","IBNCPDP",73,0) ; ("PLAN") = IEN of the the entry in the GROUP INSURANCE "RTN","IBNCPDP",74,0) ; PLAN file(#355.3)(captured from the "RTN","IBNCPDP",75,0) ; $$RX^IBNCPDP call) "RTN","IBNCPDP",76,0) ; ("COPAY") = Patient's copay from ECME response "RTN","IBNCPDP",77,0) ; ("RX NO") = RX number from file 52 "RTN","IBNCPDP",78,0) ; ("DRUG") = IEN of file #50 DRUG "RTN","IBNCPDP",79,0) ; ("DAYS SUPPLY") = Days Supply "RTN","IBNCPDP",80,0) ; ("QTY") = Quantity Dispensed (should be from the Rx fill or refill 52/52.1) "RTN","IBNCPDP",81,0) ; ("NDC") = NDC "RTN","IBNCPDP",82,0) ; ("CLOSE REASON") = Optional, Pointer to the IB file #356.8 "RTN","IBNCPDP",83,0) ; "CLAIMS TRACKING NON-BILLABLE REASONS" "RTN","IBNCPDP",84,0) ; ("CLOSE COMMENT")= Optional, if the close reason is defined "RTN","IBNCPDP",85,0) ; then the Close Comment parameter may be "RTN","IBNCPDP",86,0) ; sent to IB "RTN","IBNCPDP",87,0) ; ("DROP TO PAPER")= Optional, this parameter may be set to 1(TRUE) "RTN","IBNCPDP",88,0) ; for certain Close Claim Reasons, indicating "RTN","IBNCPDP",89,0) ; that that the closed episode still may be "RTN","IBNCPDP",90,0) ; "dropped to paper" - passed to the Autobiller "RTN","IBNCPDP",91,0) ; ("RELEASE COPAY")= Optional, if the claim is being closed, setting "RTN","IBNCPDP",92,0) ; this parameter to 1 (TRUE) indicates that the "RTN","IBNCPDP",93,0) ; patients copay should be released off hold "RTN","IBNCPDP",94,0) ; ("DIVISION") = Pointer to the MC DIVISION file (#40.8) "RTN","IBNCPDP",95,0) ; ("AUTH #") = ECME approval/authorization number "RTN","IBNCPDP",96,0) ; ("CLAIMID") = Reference Number to ECME "RTN","IBNCPDP",97,0) ; ("EPHARM") = Optional, #9002313.56 ien (E-PHARMACY division) "RTN","IBNCPDP",98,0) ; ("RTYPE") = Optional, rate type specified by user during "RTN","IBNCPDP",99,0) ; manual ePharmacy processing "RTN","IBNCPDP",100,0) ; ("PRIMARY BILL") = Optional, if this is to be a secondary bill, "RTN","IBNCPDP",101,0) ; this is the primary bill the secondary relates "RTN","IBNCPDP",102,0) ; ("PRIOR PAYMENT")= Optional, on secondary bills this is the offset "RTN","IBNCPDP",103,0) ; to be applied from the primary payment. "RTN","IBNCPDP",104,0) ; ("RXCOB") = Optional, COB indicator (secondary = 2) "RTN","IBNCPDP",105,0) ; "RTN","IBNCPDP",106,0) ; "RTN","IBNCPDP",107,0) ; Return is the bill number for success or 1 if not billable. "RTN","IBNCPDP",108,0) ; "0^reason" indicates not success "RTN","IBNCPDP",109,0) ; "RTN","IBNCPDP",110,0) ; "RTN","IBNCPDP",111,0) Q $$ECME^IBNCPDP2(DFN,.IBD) "RTN","IBNCPDP",112,0) ; "RTN","IBNCPDP",113,0) ; "RTN","IBNCPDP",114,0) UPAWP(IBNDC,IBAWP,IBADT) ; used to update AWPs. This is an API that "RTN","IBNCPDP",115,0) ; pharmacy will call. "RTN","IBNCPDP",116,0) ; "RTN","IBNCPDP",117,0) ; IBNDC = NDC number to update with the price. "RTN","IBNCPDP",118,0) ; IBAWP = average wholesale price of the NDC "RTN","IBNCPDP",119,0) ; IBADT = effective date of change (optional, default it today) "RTN","IBNCPDP",120,0) ; "RTN","IBNCPDP",121,0) ; return will be a positive number indicating success. "RTN","IBNCPDP",122,0) ; if it is unsuccessful, then "0^reason" will be returned. "RTN","IBNCPDP",123,0) ; "RTN","IBNCPDP",124,0) Q $$UPAWP^IBNCPDP3(IBNDC,IBAWP,$G(IBADT,DT)) "RTN","IBNCPDP",125,0) ; "RTN","IBNCPDP",126,0) ; "RTN","IBNCPDP",127,0) DEA(IBDEA,IBRMARK) ; used to check the DEA special handling. "RTN","IBNCPDP",128,0) ; pass in IBDEA (dea code to check out) "RTN","IBNCPDP",129,0) ; optional pass in IBRMARK by reference (reason not billable) "RTN","IBNCPDP",130,0) ; return: 1 or 0^why not billable "RTN","IBNCPDP",131,0) ; "RTN","IBNCPDP",132,0) ; -- check for compound, NOT BILLABLE "RTN","IBNCPDP",133,0) N IBRES "RTN","IBNCPDP",134,0) I $G(IBDEA)="" S IBRES="0^Null DEA Special Handling field" G DEAQ "RTN","IBNCPDP",135,0) I IBDEA["M"!(IBDEA["0") S IBRMARK="DRUG NOT BILLABLE",IBRES="0^COMPOUND DRUG" G DEAQ "RTN","IBNCPDP",136,0) ; -- check drug (not investigational, supply, over the counter, or nutritional supplement drug "RTN","IBNCPDP",137,0) ; "E" means always ecme billable "RTN","IBNCPDP",138,0) I (IBDEA["I"!(IBDEA["S")!(IBDEA["9"))!(IBDEA["N"),IBDEA'["E" S IBRMARK="DRUG NOT BILLABLE",IBRES="0^"_IBRMARK "RTN","IBNCPDP",139,0) DEAQ Q $G(IBRES,1) "RTN","IBNCPDP1") 0^7^B138462172 "RTN","IBNCPDP1",1,0) IBNCPDP1 ;OAK/ELZ - PROCESSING FOR NEW RX REQUESTS ;5/22/08 15:24 "RTN","IBNCPDP1",2,0) ;;2.0;INTEGRATED BILLING;**223,276,339,363,383,405,384,411,434,437,435**;21-MAR-94;Build 27 "RTN","IBNCPDP1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDP1",4,0) ; "RTN","IBNCPDP1",5,0) ; Reference to CL^SDCO21 supported by IA# 406 "RTN","IBNCPDP1",6,0) ; Reference to IN5^VADPT supported by IA# 10061 "RTN","IBNCPDP1",7,0) ; "RTN","IBNCPDP1",8,0) RX(DFN,IBD) ; pharmacy package call, passing in IBD by ref "RTN","IBNCPDP1",9,0) ; this is called by PSO for all prescriptions issued, return is "RTN","IBNCPDP1",10,0) ; a response to bill ECME or not with array for billing data elements "RTN","IBNCPDP1",11,0) ; "RTN","IBNCPDP1",12,0) ;warning: back-billing flag: "RTN","IBNCPDP1",13,0) ;if passed IBSCRES(IBRXN,IBFIL)=1 "RTN","IBNCPDP1",14,0) ; - then the SC Determination is just done by the IB clerk (billable) "RTN","IBNCPDP1",15,0) ; - set by routine IBNCPBB "RTN","IBNCPDP1",16,0) ; "RTN","IBNCPDP1",17,0) ; IBD("PLAN") - is specified only if RX API is called for billing determination for 2ndary claim. "RTN","IBNCPDP1",18,0) ; "RTN","IBNCPDP1",19,0) ;clean up the list of non-answered SC/Env.indicators questions and INS "RTN","IBNCPDP1",20,0) K IBD("SC/EI NO ANSW"),IBD("INS") "RTN","IBNCPDP1",21,0) ; "RTN","IBNCPDP1",22,0) N IBTRKR,IBARR,IBADT,IBRXN,IBFIL,IBTRKRN,IBRMARK,IBANY,IBX,IBT,IBINS,IBSAVE "RTN","IBNCPDP1",23,0) N IBFEE,IBBI,IBIT,IBPRICE,IBRS,IBRT,IBTRN,IBCHG,IBRES,IBNEEDS,IBELIG,IBDEA,IBPTYP "RTN","IBNCPDP1",24,0) ; "RTN","IBNCPDP1",25,0) ; eligibility verification request flag - esg 9/9/10 IB*2*435 "RTN","IBNCPDP1",26,0) S IBELIG=($G(IBD("RX ACTION"))="ELIG") "RTN","IBNCPDP1",27,0) ; "RTN","IBNCPDP1",28,0) I '$G(DFN) S IBRES="0^No DFN" G RXQ "RTN","IBNCPDP1",29,0) ; "RTN","IBNCPDP1",30,0) S IBRES="0^Error" "RTN","IBNCPDP1",31,0) S IBADT=+$G(IBD("FILL DATE"),DT) "RTN","IBNCPDP1",32,0) ; "RTN","IBNCPDP1",33,0) ; -- look up insurance for patient "RTN","IBNCPDP1",34,0) D ALL^IBCNS1(DFN,"IBINS",1,IBADT,1) "RTN","IBNCPDP1",35,0) ; "RTN","IBNCPDP1",36,0) ; -- determine rate type "RTN","IBNCPDP1",37,0) S IBRT=$$RT^IBNCPDPU(DFN,IBADT,.IBINS,.IBPTYP) "RTN","IBNCPDP1",38,0) ; "RTN","IBNCPDP1",39,0) ; If the rate type was selected by the user for manual primary or secondary claims processing, then update IBRT "RTN","IBNCPDP1",40,0) I $G(IBD("RTYPE")),$G(IBD("PLAN")) D "RTN","IBNCPDP1",41,0) . S $P(IBRT,U,1)=+IBD("RTYPE") ; overwrite the rate type ien [1] "RTN","IBNCPDP1",42,0) . S $P(IBRT,U,2)=$$COSTTYP^IBNCPUT3(+IBD("RTYPE"),IBADT) ; overwrite the basis of cost determination [2] "RTN","IBNCPDP1",43,0) . I $P(IBRT,U,3)="" S $P(IBRT,U,3)=IBPTYP ; overwrite eligibility if null [3] "RTN","IBNCPDP1",44,0) . Q "RTN","IBNCPDP1",45,0) ; "RTN","IBNCPDP1",46,0) ; -- Process an eligibility verification request "RTN","IBNCPDP1",47,0) I IBELIG D G RXQ "RTN","IBNCPDP1",48,0) . S IBRES=1 "RTN","IBNCPDP1",49,0) . D SETINSUR(IBADT,IBRT,IBELIG,.IBINS,.IBD,.IBRES) "RTN","IBNCPDP1",50,0) . Q "RTN","IBNCPDP1",51,0) ; "RTN","IBNCPDP1",52,0) ; additional data integrity checks "RTN","IBNCPDP1",53,0) S IBRXN=+$G(IBD("IEN")) I 'IBRXN S IBRES="0^No Rx IEN" G RXQ "RTN","IBNCPDP1",54,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBRES="0^No fill number" G RXQ "RTN","IBNCPDP1",55,0) S IBD("QTY")=+$G(IBD("QTY")) I 'IBD("QTY") S IBRES="0^No Quantity" G RXQ "RTN","IBNCPDP1",56,0) ; "RTN","IBNCPDP1",57,0) ; -- Gather claims tracking information if it exists "RTN","IBNCPDP1",58,0) S IBTRKR=$G(^IBE(350.9,1,6)) "RTN","IBNCPDP1",59,0) ; date can't be before parameters "RTN","IBNCPDP1",60,0) S $P(IBTRKR,U)=$S('$P(IBTRKR,U,4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT) "RTN","IBNCPDP1",61,0) ; already in claims tracking "RTN","IBNCPDP1",62,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) "RTN","IBNCPDP1",63,0) ; "RTN","IBNCPDP1",64,0) ; -- Check for TRICARE Inpatient - esg 8/5/10 IB*2*434 "RTN","IBNCPDP1",65,0) I $P(IBRT,U,3)="T",$$INP(DFN,IBRXN,IBFIL) D G RXQ "RTN","IBNCPDP1",66,0) . S IBRMARK="TRICARE INPATIENT/DISCHARGE" ; reason not billable "RTN","IBNCPDP1",67,0) . D CT ; update/add claims tracking entry "RTN","IBNCPDP1",68,0) . S IBRES=0_U_IBRMARK ; not ECME billable "RTN","IBNCPDP1",69,0) . Q "RTN","IBNCPDP1",70,0) ; "RTN","IBNCPDP1",71,0) ;for secondary billing - skip claim tracking functionality "RTN","IBNCPDP1",72,0) G:$G(IBD("RXCOB"))>1 GETINS "RTN","IBNCPDP1",73,0) ; "RTN","IBNCPDP1",74,0) ; -- claims tracking info "RTN","IBNCPDP1",75,0) I IBTRKRN,$$PAPERBIL^IBNCPNB(IBTRKRN) S IBRES="0^Existing IB Bill in CT",IBD("NO ECME INSURANCE")=1 G RXQ "RTN","IBNCPDP1",76,0) ; already billed as Tricare "RTN","IBNCPDP1",77,0) I $D(^IBA(351.5,"B",IBRXN_";"_IBFIL)) S IBRES="0^Already billed under prior Tricare process",IBD("NO ECME INSURANCE")=1 G RXQ "RTN","IBNCPDP1",78,0) ; "RTN","IBNCPDP1",79,0) ; -- no pharmacy coverage, update ct if applicable, quit "RTN","IBNCPDP1",80,0) I '$$PTCOV^IBCNSU3(DFN,IBADT,"PHARMACY",.IBANY) S IBRMARK=$S($G(IBANY):"SERVICE NOT COVERED",1:"NOT INSURED") D:$P(IBTRKR,U,4)=2 CT S IBRES="0^"_IBRMARK,IBD("NO ECME INSURANCE")=1 G RXQ "RTN","IBNCPDP1",81,0) ; "RTN","IBNCPDP1",82,0) ; -- check for DEA SPECIAL HDLG "RTN","IBNCPDP1",83,0) S IBDEA=$$DEA^IBNCPDP($G(IBD("DEA")),.IBRMARK) I 'IBDEA S IBRES=IBDEA D CT G RXQ "RTN","IBNCPDP1",84,0) ; "RTN","IBNCPDP1",85,0) ;retrieve indicators from file #52 and overwrite the indicators in IBD array "RTN","IBNCPDP1",86,0) D GETINDIC^IBNCPUT2(+IBD("IEN"),.IBD) "RTN","IBNCPDP1",87,0) ; -- process patient exemptions if any (if not already resolved) "RTN","IBNCPDP1",88,0) I $G(IBD("SC/EI OVR"))'=1 D CL^SDCO21(DFN,IBADT,"",.IBARR) "RTN","IBNCPDP1",89,0) ; check out exemptions "RTN","IBNCPDP1",90,0) S IBNEEDS=0 ;flag will be set to 1 if at least one of the questions wasn't answered "RTN","IBNCPDP1",91,0) I $G(IBD("SC/EI OVR"))'=1 I $D(IBARR)>9 F IBX=2:1 S IBT=$P($T(EXEMPT+IBX),";;",2) Q:IBT="" D:$D(IBARR(+IBT)) "RTN","IBNCPDP1",92,0) . I $G(IBD($P(IBT,U,2)))=0 Q "RTN","IBNCPDP1",93,0) . I $G(IBD($P(IBT,U,2))) S IBRMARK=$P(IBT,U,3) Q "RTN","IBNCPDP1",94,0) . I '$G(IBSCRES(IBRXN,IBFIL)) S IBNEEDS=1 D "RTN","IBNCPDP1",95,0) . . S IBD("SC/EI NO ANSW")=$S($G(IBD("SC/EI NO ANSW"))="":$P(IBT,U,2),1:$G(IBD("SC/EI NO ANSW"))_","_$P(IBT,U,2)) "RTN","IBNCPDP1",96,0) I '$D(IBRMARK),IBNEEDS=1 S IBRMARK="NEEDS SC DETERMINATION" "RTN","IBNCPDP1",97,0) I $D(IBRMARK) D CT S IBRES="0^"_IBRMARK G RXQ "RTN","IBNCPDP1",98,0) ; Clean-up the NEEDS SC DETERMINATION record if resolved "RTN","IBNCPDP1",99,0) ; And check if it is non-billable in CT "RTN","IBNCPDP1",100,0) I IBTRKRN D "RTN","IBNCPDP1",101,0) . N IBNBR,IBNBRT "RTN","IBNCPDP1",102,0) . S IBNBR=$P($G(^IBT(356,+IBTRKRN,0)),U,19) Q:'IBNBR "RTN","IBNCPDP1",103,0) . S IBNBRT=$P($G(^IBE(356.8,IBNBR,0)),U) Q:IBNBRT="" "RTN","IBNCPDP1",104,0) . ; if refill was deleted (not RX) and now the refill is re-entered "RTN","IBNCPDP1",105,0) . ;use $$RXSTATUS^IBNCPRR instead of $G(^PSRX(IBRXN,"STA")) "RTN","IBNCPDP1",106,0) . I IBNBRT="PRESCRIPTION DELETED",$$RXSTATUS^IBNCPRR(DFN,IBRXN)'=13 D Q "RTN","IBNCPDP1",107,0) . . N DIE,DA,DR "RTN","IBNCPDP1",108,0) . . ; clean up REASON NOT BILLABLE and ADDITIONAL COMMENT "RTN","IBNCPDP1",109,0) . . S DIE="^IBT(356,",DA=+IBTRKRN,DR=".19////@;1.08////@" D ^DIE "RTN","IBNCPDP1",110,0) . ; Clean up NBR if released "RTN","IBNCPDP1",111,0) . I IBNBRT="PRESCRIPTION NOT RELEASED" D:$G(IBD("RELEASE DATE")) Q "RTN","IBNCPDP1",112,0) . . N DIE,DA,DR "RTN","IBNCPDP1",113,0) . . S DIE="^IBT(356,",DA=+IBTRKRN,DR=".19////@" D ^DIE "RTN","IBNCPDP1",114,0) . ; Clean up 'Needs SC determ' "RTN","IBNCPDP1",115,0) . I IBNBRT="NEEDS SC DETERMINATION" D Q "RTN","IBNCPDP1",116,0) . . N DIE,DA,DR "RTN","IBNCPDP1",117,0) . . S DIE="^IBT(356,",DA=+IBTRKRN,DR=".19////@" D ^DIE "RTN","IBNCPDP1",118,0) . S IBRMARK=IBNBRT "RTN","IBNCPDP1",119,0) I $D(IBRMARK) S IBRES="0^Non-Billable in CT: "_IBRMARK G RXQ "RTN","IBNCPDP1",120,0) ; "RTN","IBNCPDP1",121,0) GETINS ; -- setup insurance data for patient "RTN","IBNCPDP1",122,0) ; "RTN","IBNCPDP1",123,0) D SETINSUR(IBADT,IBRT,IBELIG,.IBINS,.IBD,.IBRES) ; build IBD("INS") insurance array "RTN","IBNCPDP1",124,0) I $G(IBD("NO ECME INSURANCE")) G RXQ "RTN","IBNCPDP1",125,0) ; "RTN","IBNCPDP1",126,0) ;for secondary billing - skip ROI functionality "RTN","IBNCPDP1",127,0) G:$G(IBD("RXCOB"))>1 RATEPRIC "RTN","IBNCPDP1",128,0) ; "RTN","IBNCPDP1",129,0) ; -- check drug for sensitive dx special handling code and ROI on file "RTN","IBNCPDP1",130,0) I IBD("DEA")["U",$D(IBD("INS",1,3)) D G:$D(IBRMARK) RXQ "RTN","IBNCPDP1",131,0) . I '$$ROI^IBNCPDR4(DFN,$G(IBD("DRUG")),+$P($G(IBD("INS",1,3)),U,5),$G(IBD("FILL DATE"))) D Q "RTN","IBNCPDP1",132,0) .. S IBRMARK="REFUSES TO SIGN RELEASE (ROI)" "RTN","IBNCPDP1",133,0) .. D CT "RTN","IBNCPDP1",134,0) .. S IBRES="0^NOT BILLABLE, NO ROI - NO ACTIVE ROI ON FILE" "RTN","IBNCPDP1",135,0) . D ROICLN^IBNCPDR4(IBTRKRN,IBRXN,IBFIL) K:$G(IBRMARK)="REFUSES TO SIGN RELEASE (ROI)" IBRMARK "RTN","IBNCPDP1",136,0) ; "RTN","IBNCPDP1",137,0) RATEPRIC ; "RTN","IBNCPDP1",138,0) ; determine rates/prices to use "RTN","IBNCPDP1",139,0) I 'IBRT D CT S IBRES="0^Cannot determine Rate type" G RXQ "RTN","IBNCPDP1",140,0) S IBBI=$$EVNTITM^IBCRU3(+IBRT,3,"PRESCRIPTION FILL",IBADT,.IBRS) "RTN","IBNCPDP1",141,0) I 'IBBI,$P(IBBI,";")'="VA COST" D CT S IBRES="0^Cannot find Billable Item" G RXQ "RTN","IBNCPDP1",142,0) ;1;BEDSECTION;1^ "RTN","IBNCPDP1",143,0) ;IBRS(1,18,5)= "RTN","IBNCPDP1",144,0) S IBRS=+$O(IBRS($P(IBBI,";"),0)) "RTN","IBNCPDP1",145,0) S IBIT=$$ITPTR^IBCRU2($P(IBBI,";"),$S($P(IBRT,U,2)="A":$$NDC^IBNCPNB($G(IBD("NDC"))),1:"PRESCRIPTION")) "RTN","IBNCPDP1",146,0) I 'IBIT,$P(IBRT,U,2)'="C" D CT S IBRES="0^Cannot find Item Pointer" G RXQ "RTN","IBNCPDP1",147,0) ;8 "RTN","IBNCPDP1",148,0) S IBPRICE=+$$BICOST^IBCRCI(+IBRT,3,IBADT,"PRESCRIPTION FILL",+IBIT,,,$S($P(IBRT,U,2)="A":IBD("QTY"),1:1)) "RTN","IBNCPDP1",149,0) ;36^2991001 "RTN","IBNCPDP1",150,0) ; "RTN","IBNCPDP1",151,0) ; get fees if any, ignore return, don't care about price, just need fees "RTN","IBNCPDP1",152,0) S IBCHG=$$RATECHG^IBCRCC(+IBRS,$S($P(IBRT,U,2)'="C":1,1:IBD("QTY")*IBD("COST")),IBADT,.IBFEE) "RTN","IBNCPDP1",153,0) I $P(IBRT,U,2)="C" S IBPRICE=+IBCHG "RTN","IBNCPDP1",154,0) ; "RTN","IBNCPDP1",155,0) I 'IBPRICE D CT S IBRES="0^Cannot find price for Item" G RXQ "RTN","IBNCPDP1",156,0) ; "RTN","IBNCPDP1",157,0) S IBPRICE=(+$G(IBFEE))_U_$S($P(IBRT,U,2)="A":"01",$P(IBRT,U,2)="C":"05",1:"07")_U_$S($P(IBRT,U,2)="C":IBD("QTY")*IBD("COST")+$G(IBFEE),$P(IBRT,U,2)="A":IBPRICE-$G(IBFEE)-$P($G(IBFEE),U,2),1:IBPRICE)_U_IBPRICE_U_(+$P($G(IBFEE),U,2)) "RTN","IBNCPDP1",158,0) S IBX=0 F S IBX=$O(IBD("INS",IBX)) Q:IBX<1 S IBD("INS",IBX,2)=IBPRICE "RTN","IBNCPDP1",159,0) ; "RTN","IBNCPDP1",160,0) ;Check for non-covered drugs "RTN","IBNCPDP1",161,0) S IBRES=$$CHCK^IBNCDNC(.IBD) I IBRES]"" S IBRMARK=$P(IBRES,U,2) D CT G RXQ "RTN","IBNCPDP1",162,0) ; "RTN","IBNCPDP1",163,0) S IBRES=$S($D(IBRMARK):"0^"_IBRMARK,1:1) "RTN","IBNCPDP1",164,0) I IBRES,'$G(IBD("RELEASE DATE")) S IBRMARK="PRESCRIPTION NOT RELEASED" "RTN","IBNCPDP1",165,0) ; "RTN","IBNCPDP1",166,0) D CT "RTN","IBNCPDP1",167,0) ; "RTN","IBNCPDP1",168,0) RXQ ; final processing "RTN","IBNCPDP1",169,0) ; set the 3rd piece of IBRES (default Vet) "RTN","IBNCPDP1",170,0) S $P(IBRES,U,3)=$S($L($P($G(IBRT),U,3)):$P(IBRT,U,3),1:"V") "RTN","IBNCPDP1",171,0) ; "RTN","IBNCPDP1",172,0) ; possibly add entries to files 366.14 and 366.15 (not for eligibility verification requests) "RTN","IBNCPDP1",173,0) I 'IBELIG D "RTN","IBNCPDP1",174,0) . I IBRES D START^IBNCPDP6(IBRXN_";"_IBFIL,$P(IBRES,U,3),+IBRT) "RTN","IBNCPDP1",175,0) . D LOG^IBNCPDP2("BILLABLE STATUS CHECK",IBRES) "RTN","IBNCPDP1",176,0) . Q "RTN","IBNCPDP1",177,0) ; "RTN","IBNCPDP1",178,0) Q IBRES "RTN","IBNCPDP1",179,0) ; "RTN","IBNCPDP1",180,0) ; "RTN","IBNCPDP1",181,0) CT ; files in claims tracking "RTN","IBNCPDP1",182,0) Q:$G(IBD("RXCOB"))>1 ;Claim Tracking is updated only for the primary payer (payer sequence =1) "RTN","IBNCPDP1",183,0) ;If null then the payer sequence = Primary is assumed "RTN","IBNCPDP1",184,0) I IBTRKR D CT^IBNCPDPU(DFN,IBRXN,IBFIL,IBADT,$G(IBRMARK)) "RTN","IBNCPDP1",185,0) Q "RTN","IBNCPDP1",186,0) ; "RTN","IBNCPDP1",187,0) SETINSUR(IBADT,IBRT,IBELIG,IBINS,IBD,IBRES) ; build insurance data array "RTN","IBNCPDP1",188,0) ; Input variables: "RTN","IBNCPDP1",189,0) ; IBADT - fill date/identify insurance as of this date "RTN","IBNCPDP1",190,0) ; IBRT - rate type variable - [1] rate type ien, [2] type (A/C/T), [3] eligibility (V/T) "RTN","IBNCPDP1",191,0) ; IBELIG - eligibility request flag (1/0) "RTN","IBNCPDP1",192,0) ; IBINS - insurance array as returned by ALL^IBCNS1 "RTN","IBNCPDP1",193,0) ; IBD - input/output - array entries passed in and certain array entries returned "RTN","IBNCPDP1",194,0) ; Output variable: "RTN","IBNCPDP1",195,0) ; IBRES - only returned if insurance errors "RTN","IBNCPDP1",196,0) ; "RTN","IBNCPDP1",197,0) ; Note: if more than one insurance with the same COB then the latest insurance occurrence overrides the first one(s) "RTN","IBNCPDP1",198,0) ; Example: "RTN","IBNCPDP1",199,0) ; IBINS("S",1,1)="" "RTN","IBNCPDP1",200,0) ; IBINS("S",1,3)="" <<--- this will be primary "RTN","IBNCPDP1",201,0) ; "RTN","IBNCPDP1",202,0) K IBD("INS"),IBD("NO ECME INSURANCE") "RTN","IBNCPDP1",203,0) ; "RTN","IBNCPDP1",204,0) N IBCNT,IBERMSG,IBRXPOL,IBT,IBX "RTN","IBNCPDP1",205,0) ; IBERMSG - error message array "RTN","IBNCPDP1",206,0) ; IBRXPOL - array of Rx policies found "RTN","IBNCPDP1",207,0) ; "RTN","IBNCPDP1",208,0) S IBX=0 F S IBX=$O(IBINS("S",IBX)) Q:'IBX D "RTN","IBNCPDP1",209,0) . S IBT=0 F S IBT=$O(IBINS("S",IBX,IBT)) Q:'IBT D "RTN","IBNCPDP1",210,0) .. N IBDAT,IBPL,IBINSN,IBPIEN,IBY,IBZ,IBCHNM "RTN","IBNCPDP1",211,0) .. S IBZ=$G(IBINS(IBT,0)) Q:IBZ="" "RTN","IBNCPDP1",212,0) .. S IBPL=$P(IBZ,U,18) ; plan "RTN","IBNCPDP1",213,0) .. Q:'IBPL "RTN","IBNCPDP1",214,0) .. Q:'$$PLCOV^IBCNSU3(IBPL,IBADT,3) ; not a pharmacy plan "RTN","IBNCPDP1",215,0) .. ; "RTN","IBNCPDP1",216,0) .. I $G(IBD("PLAN")) Q:IBPL'=$G(IBD("PLAN")) ;skip other plans if we call RX API for a specific plan (IBD("PLAN")) "RTN","IBNCPDP1",217,0) .. ; "RTN","IBNCPDP1",218,0) .. I '$G(IBD("PLAN")) I '$D(IBD("INS")),$P(IBRT,U,3)="V",($P($G(^IBE(355.1,+$P($G(^IBA(355.3,+IBPL,0)),U,9),0)),U)["TRICARE"!($P($G(^(0)),U)="CHAMPVA")) K IBINS Q ;Tricare/ChampVa coverage for a Vet "RTN","IBNCPDP1",219,0) .. ; "RTN","IBNCPDP1",220,0) .. ; at this point we have found an Rx policy. We'll count these up later by IBX. "RTN","IBNCPDP1",221,0) .. S IBRXPOL(IBX,IBT)="" "RTN","IBNCPDP1",222,0) .. ; "RTN","IBNCPDP1",223,0) .. S IBINSN=$P($G(^DIC(36,+$G(^IBA(355.3,+IBPL,0)),0)),U) ; ins name "RTN","IBNCPDP1",224,0) .. S IBPIEN=+$G(^IBA(355.3,+IBPL,6)) "RTN","IBNCPDP1",225,0) .. I 'IBPIEN S IBERMSG(IBX)="Plan not linked to the Payer" Q ; Not linked "RTN","IBNCPDP1",226,0) .. K IBY D STCHK^IBCNRU1(IBPIEN,.IBY,IBELIG) "RTN","IBNCPDP1",227,0) .. I $E($G(IBY(1)))'="A" S IBERMSG(IBX)=$$ERMSG^IBNCPNB($G(IBY(6))) Q ; not active "RTN","IBNCPDP1",228,0) .. ; "RTN","IBNCPDP1",229,0) .. ; at this point we have a valid policy for this IBX "RTN","IBNCPDP1",230,0) .. S IBERMSG(IBX)="" ; no error message "RTN","IBNCPDP1",231,0) .. S IBDAT=IBPL ; Plan IEN "RTN","IBNCPDP1",232,0) .. S IBCHNM=$$NAME^IBCEFG1($P(IBZ,U,17)) ; standardize subscriber/cardholder name "RTN","IBNCPDP1",233,0) .. S $P(IBDAT,U,2)=$G(IBY(2)) ; BIN "RTN","IBNCPDP1",234,0) .. S $P(IBDAT,U,3)=$G(IBY(3)) ; PCN "RTN","IBNCPDP1",235,0) .. S $P(IBDAT,U,4)=$P($G(^BPSF(9002313.92,+$P($G(IBY(5)),",",1),0)),U) ; Payer Sheet B1 name "RTN","IBNCPDP1",236,0) .. S $P(IBDAT,U,5)=$P($G(IBINS(IBT,355.3)),U,4) ; Group ID "RTN","IBNCPDP1",237,0) .. S $P(IBDAT,U,6)=$P(IBZ,U,2) ; Cardholder ID "RTN","IBNCPDP1",238,0) .. S $P(IBDAT,U,7)=$P(IBZ,U,16) ; Patient Relationship Code "RTN","IBNCPDP1",239,0) .. S $P(IBDAT,U,8)=$P(IBCHNM,U,2) ; Cardholder First Name "RTN","IBNCPDP1",240,0) .. S $P(IBDAT,U,9)=$P(IBCHNM,U,1) ; Cardholder Last Name "RTN","IBNCPDP1",241,0) .. S $P(IBDAT,U,10)=$P($G(^DIC(36,+IBZ,.11)),U,5) ; State "RTN","IBNCPDP1",242,0) .. S $P(IBDAT,U,11)=$P($G(^BPSF(9002313.92,+$P($G(IBY(5)),",",2),0)),U) ; Payer Sheet B2 name "RTN","IBNCPDP1",243,0) .. S $P(IBDAT,U,12)=$P($G(^BPSF(9002313.92,+$P($G(IBY(5)),",",3),0)),U) ; Payer Sheet B3 name "RTN","IBNCPDP1",244,0) .. S $P(IBDAT,U,13)=$G(IBY(4)) ; Software/Vendor Cert ID "RTN","IBNCPDP1",245,0) .. S $P(IBDAT,U,14)=IBINSN ; Ins Name "RTN","IBNCPDP1",246,0) .. S $P(IBDAT,U,15)=$P($G(^BPSF(9002313.92,+$P($G(IBY(5)),",",4),0)),U) ; Payer Sheet E1 name "RTN","IBNCPDP1",247,0) .. S $P(IBDAT,U,16)=+$P($G(IBY(5)),",",1) ; Payer Sheet B1 ien "RTN","IBNCPDP1",248,0) .. S $P(IBDAT,U,17)=+$P($G(IBY(5)),",",2) ; Payer Sheet B2 ien "RTN","IBNCPDP1",249,0) .. S $P(IBDAT,U,18)=+$P($G(IBY(5)),",",3) ; Payer Sheet B3 ien "RTN","IBNCPDP1",250,0) .. S $P(IBDAT,U,19)=+$P($G(IBY(5)),",",4) ; Payer Sheet E1 ien "RTN","IBNCPDP1",251,0) .. S IBD("INS",IBX,1)=IBDAT "RTN","IBNCPDP1",252,0) .. ; "RTN","IBNCPDP1",253,0) .. S IBDAT=$P($G(IBINS(IBT,355.3)),U,3) ;group name "RTN","IBNCPDP1",254,0) .. S $P(IBDAT,U,2)=$$PHONE^IBNCPDP6(+IBZ) ;ins co ph 3 "RTN","IBNCPDP1",255,0) .. S $P(IBDAT,U,3)=$$GET1^DIQ(366.03,IBPIEN_",",.01) ;plan ID "RTN","IBNCPDP1",256,0) .. S $P(IBDAT,U,4)=$S($P($G(^IBE(355.1,+$P($G(IBINS(IBT,355.3)),U,9),0)),U)="TRICARE":"T",1:"V") ; plan type "RTN","IBNCPDP1",257,0) .. S $P(IBDAT,U,5)=+$G(^IBA(355.3,+IBPL,0)) ; insurance co ien "RTN","IBNCPDP1",258,0) .. S $P(IBDAT,U,6)=$P(IBZ,U,20) ;(#.2) COB field of the (#.3121) insurance Type multiple of the Patient file (#2) "RTN","IBNCPDP1",259,0) .. S $P(IBDAT,U,7)=IBT ; 2.312 subfile ien "RTN","IBNCPDP1",260,0) .. S $P(IBDAT,U,8)=$$GET1^DIQ(366.03,IBPIEN_",",10.1) ; maximum ncpdp transactions "RTN","IBNCPDP1",261,0) .. S IBD("INS",IBX,3)=IBDAT "RTN","IBNCPDP1",262,0) .. Q "RTN","IBNCPDP1",263,0) . Q "RTN","IBNCPDP1",264,0) ; "RTN","IBNCPDP1",265,0) ; Count the number of pharmacy insurance policies by IBX found up above "RTN","IBNCPDP1",266,0) S IBX=0 F IBCNT=0:1 S IBX=$O(IBRXPOL(IBX)) Q:'IBX "RTN","IBNCPDP1",267,0) ; "RTN","IBNCPDP1",268,0) ; Determine the value of the IBX variable here. This is basically the COB sequence# to be used. "RTN","IBNCPDP1",269,0) ; If there is only 1 pharmacy policy or no pharmacy policies, then set IBX in this manner "RTN","IBNCPDP1",270,0) I IBCNT'>1 D "RTN","IBNCPDP1",271,0) . I $D(IBD("INS")) S IBX=+$O(IBD("INS",0)) ; use the only one in this array "RTN","IBNCPDP1",272,0) . I '$D(IBD("INS")) S IBX=+$O(IBERMSG(0)) ; the only one here (or 0) "RTN","IBNCPDP1",273,0) . Q "RTN","IBNCPDP1",274,0) ; "RTN","IBNCPDP1",275,0) ; If there are multiple pharmacy policies on file, then the COB field in the pt. policy must be used correctly "RTN","IBNCPDP1",276,0) ; and primary insurance must be at #1 "RTN","IBNCPDP1",277,0) I IBCNT>1 S IBX=1 "RTN","IBNCPDP1",278,0) ; "RTN","IBNCPDP1",279,0) ; In all cases, if this variable is set, then use it "RTN","IBNCPDP1",280,0) I $G(IBD("RXCOB"))>1 S IBX=$G(IBD("RXCOB")) "RTN","IBNCPDP1",281,0) ; "RTN","IBNCPDP1",282,0) ; Check insurance at IBX "RTN","IBNCPDP1",283,0) I '$D(IBD("INS",IBX)),$G(IBERMSG(IBX))'="" S IBRES="0^Not ECME billable: "_IBERMSG(IBX),IBD("NO ECME INSURANCE")=1 G SETINX "RTN","IBNCPDP1",284,0) I '$D(IBD("INS",IBX)) S IBRES="0^No Insurance ECME billable",IBD("NO ECME INSURANCE")=1 "RTN","IBNCPDP1",285,0) SETINX ; "RTN","IBNCPDP1",286,0) Q "RTN","IBNCPDP1",287,0) ; "RTN","IBNCPDP1",288,0) INP(DFN,IBRXN,IBFIL) ; Is this an inpatient, NON-BILLABLE Rx as of the Issue Date? esg 8/5/10 - IB*2*434 "RTN","IBNCPDP1",289,0) N INP,VAHOW,VAROOT,IBRXINP,VAIP,IBRXISUE,IBMW "RTN","IBNCPDP1",290,0) S INP=0 "RTN","IBNCPDP1",291,0) ; "RTN","IBNCPDP1",292,0) S VAROOT="IBRXINP" "RTN","IBNCPDP1",293,0) S IBRXISUE=$$FILE^IBRXUTL(IBRXN,1)\1 ; Rx Issue Date (Field# 1) "RTN","IBNCPDP1",294,0) I 'IBRXISUE S IBRXISUE=DT "RTN","IBNCPDP1",295,0) S VAIP("D")=IBRXISUE ; if pt was an inpatient at any time during this day "RTN","IBNCPDP1",296,0) D IN5^VADPT ; DBIA 10061 - inpatient episode API "RTN","IBNCPDP1",297,0) I '$G(IBRXINP(1)) G INPX ; not an inpatient on this day "RTN","IBNCPDP1",298,0) ; "RTN","IBNCPDP1",299,0) ; check Rx issue date = discharge date. This is billable so get out (esg 9/13/10) "RTN","IBNCPDP1",300,0) I IBRXISUE=(+$G(IBRXINP(17,1))\1) G INPX "RTN","IBNCPDP1",301,0) ; "RTN","IBNCPDP1",302,0) ; if Rx/fill is MAIL, then this is billable so get out (esg 9/13/10) "RTN","IBNCPDP1",303,0) I IBFIL S IBMW=$$SUBFILE^IBRXUTL(IBRXN,IBFIL,52,2) ; 52.1,2 MAIL/WINDOW field "RTN","IBNCPDP1",304,0) I 'IBFIL S IBMW=$$FILE^IBRXUTL(IBRXN,11) ; 52,11 MAIL/WINDOW field "RTN","IBNCPDP1",305,0) I IBMW="M" G INPX "RTN","IBNCPDP1",306,0) ; "RTN","IBNCPDP1",307,0) ; inpatient and non-billable "RTN","IBNCPDP1",308,0) S INP=1 "RTN","IBNCPDP1",309,0) INPX ; "RTN","IBNCPDP1",310,0) Q INP "RTN","IBNCPDP1",311,0) ; "RTN","IBNCPDP1",312,0) EXEMPT ; exemption reasons "RTN","IBNCPDP1",313,0) ; variable from SD call ^ variable from PSO ^ reason not billable "RTN","IBNCPDP1",314,0) ;;1^AO^AGENT ORANGE "RTN","IBNCPDP1",315,0) ;;2^IR^IONIZING RADIATION "RTN","IBNCPDP1",316,0) ;;3^SC^SC TREATMENT "RTN","IBNCPDP1",317,0) ;;4^SWA^SOUTHWEST ASIA "RTN","IBNCPDP1",318,0) ;;5^MST^MILITARY SEXUAL TRAUMA "RTN","IBNCPDP1",319,0) ;;6^HNC^HEAD/NECK CANCER "RTN","IBNCPDP1",320,0) ;;7^CV^COMBAT VETERAN "RTN","IBNCPDP1",321,0) ;;8^SHAD^PROJECT 112/SHAD "RTN","IBNCPDP1",322,0) ;; "RTN","IBNCPDP1",323,0) ; "RTN","IBNCPDP2") 0^8^B72289199 "RTN","IBNCPDP2",1,0) IBNCPDP2 ;OAK/ELZ - PROCESSING FOR ECME RESP ;11/15/07 09:43 "RTN","IBNCPDP2",2,0) ;;2.0;INTEGRATED BILLING;**223,276,342,347,363,383,405,384,411,435**;21-MAR-94;Build 27 "RTN","IBNCPDP2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDP2",4,0) ; "RTN","IBNCPDP2",5,0) ; Reference to DEC^PRCASER1 supported by IA# 593 "RTN","IBNCPDP2",6,0) ; Reference to REL^PRCASVC supported by IA# 385 "RTN","IBNCPDP2",7,0) ; Reference to STATUS^PRCASVC1 supported by IA# 387 "RTN","IBNCPDP2",8,0) ; Reference to ^PRCASVC6 supported by IA# 384 "RTN","IBNCPDP2",9,0) ; Reference to $$RXSITE^PSOBPSUT supported by IA# 4701 "RTN","IBNCPDP2",10,0) ; Reference to $$GETPHARM^BPSUTIL supported by IA# 4146 "RTN","IBNCPDP2",11,0) ; "RTN","IBNCPDP2",12,0) ECME(DFN,IBD) ; function called by STORESP^IBNCPDP "RTN","IBNCPDP2",13,0) ; input - DFN - patient IEN for the prescription "RTN","IBNCPDP2",14,0) ; IBD array passed in by reference "RTN","IBNCPDP2",15,0) ; The IBD array is passed to various subroutines depending "RTN","IBNCPDP2",16,0) ; on the ePharmacy event as evaluated by IBD("STATUS") "RTN","IBNCPDP2",17,0) I $G(IBD("EPHARM"))="" S IBD("EPHARM")=$$EPHARM(+$G(IBD("PRESCRIPTION")),+$G(IBD("FILL NUMBER"))) "RTN","IBNCPDP2",18,0) I IBD("STATUS")="PAID",$G(IBD("RXCOB"))=2 Q $$BILLSEC^IBNCPDP5(DFN,.IBD) "RTN","IBNCPDP2",19,0) I IBD("STATUS")="PAID" Q $$BILL(DFN,.IBD) "RTN","IBNCPDP2",20,0) I IBD("STATUS")="REVERSED" Q $$REVERSE^IBNCPDP3(DFN,.IBD) "RTN","IBNCPDP2",21,0) I IBD("STATUS")="CLOSED" Q $$CLOSE^IBNCPDP4(DFN,.IBD) "RTN","IBNCPDP2",22,0) I IBD("STATUS")="RELEASED" Q $$RELEASE^IBNCPDP4(DFN,.IBD) "RTN","IBNCPDP2",23,0) I IBD("STATUS")="SUBMITTED" Q $$SUBMIT^IBNCPDP4(DFN,.IBD) "RTN","IBNCPDP2",24,0) I IBD("STATUS")="REOPEN" Q $$REOPEN^IBNCPDP4(DFN,.IBD) "RTN","IBNCPDP2",25,0) I IBD("STATUS")="ELIG" Q $$ELIG^IBNCPDP3(DFN,.IBD) "RTN","IBNCPDP2",26,0) D LOG("UNKNOWN") "RTN","IBNCPDP2",27,0) Q "0^Cannot determine ECME event status" "RTN","IBNCPDP2",28,0) ; "RTN","IBNCPDP2",29,0) MATCH(BCID,IBS) ; right bill, right COB payer "RTN","IBNCPDP2",30,0) N IBX,IBPS,IBFOUND,ECMELEN,BCID1 "RTN","IBNCPDP2",31,0) S IBPS=$S(IBS=1:"P",IBS=2:"S",IBS=3:"T",1:"P") "RTN","IBNCPDP2",32,0) S IBFOUND=0 "RTN","IBNCPDP2",33,0) ; "RTN","IBNCPDP2",34,0) ; need to check for ECME# lengths of both 7 digits and 12 digits to be sure "RTN","IBNCPDP2",35,0) F ECMELEN=12,7 D Q:IBFOUND "RTN","IBNCPDP2",36,0) . I $L(+BCID)>ECMELEN Q ; quit if too large "RTN","IBNCPDP2",37,0) . S BCID1=BCID "RTN","IBNCPDP2",38,0) . S $P(BCID1,";",1)=$$RJ^XLFSTR(+BCID,ECMELEN,0) "RTN","IBNCPDP2",39,0) . S IBX=0 ; quit when we have found a non-cancelled claim with a payer sequence match "RTN","IBNCPDP2",40,0) . F S IBX=$O(^DGCR(399,"AG",BCID1,IBX)) Q:'IBX!IBFOUND I '$P($G(^DGCR(399,IBX,"S")),U,16),(IBPS=$P($G(^DGCR(399,IBX,0)),U,21)) S IBFOUND=IBX Q "RTN","IBNCPDP2",41,0) . Q "RTN","IBNCPDP2",42,0) ; "RTN","IBNCPDP2",43,0) Q IBFOUND "RTN","IBNCPDP2",44,0) ; "RTN","IBNCPDP2",45,0) BILL(DFN,IBD) ; create bills "RTN","IBNCPDP2",46,0) N IBDIV,IBAMT,IBY,IBSERV,IBFAC,IBSITE,IBDRX,IB,IBCDFN,IBINS,IBIDS,IBIFN,IBDFN,PRCASV,IBTRIC,IBLGL,IBLDT2 "RTN","IBNCPDP2",47,0) N PRCAERR,IBADT,IBRXN,IBFIL,IBTRKRN,DIE,DA,DR,IBRES,IBLOCK,IBLDT,IBNOW,IBDUZ,RCDUZ,IBPREV,IBQUERY,IBPAID,IBACT,%,DGRVRCAL "RTN","IBNCPDP2",48,0) ; "RTN","IBNCPDP2",49,0) S IBDUZ=.5 ;POSTMASTER "RTN","IBNCPDP2",50,0) ;I $G(IBD("FILLED BY")),$D(^VA(200,+IBD("FILLED BY"))) S IBDUZ=+IBD("FILLED BY") "RTN","IBNCPDP2",51,0) S RCDUZ=IBDUZ "RTN","IBNCPDP2",52,0) ; "RTN","IBNCPDP2",53,0) S IBY=1,IBLOCK=0 "RTN","IBNCPDP2",54,0) I 'DFN S IBY="0^Missing DFN" G BILLQ "RTN","IBNCPDP2",55,0) S IBAMT=+$G(IBD("BILLED")) ;FI portion of charge "RTN","IBNCPDP2",56,0) I 'IBAMT S IBY="-1^Zero amount billed" G BILLQ "RTN","IBNCPDP2",57,0) S IBADT=+$G(IBD("FILL DATE"),DT) "RTN","IBNCPDP2",58,0) S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBY="0^Missing Rx IEN" G BILLQ "RTN","IBNCPDP2",59,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBY="0^No fill number" G BILLQ "RTN","IBNCPDP2",60,0) S IBDIV=+$G(IBD("DIVISION")) "RTN","IBNCPDP2",61,0) I '$L($G(IBD("CLAIMID"))) S IBY="-1^Missing ECME Number" G BILLQ "RTN","IBNCPDP2",62,0) S IBD("BCID")=$$BCID^IBNCPDP4(IBD("CLAIMID"),IBADT) "RTN","IBNCPDP2",63,0) L +^DGCR(399,"AG",IBD("BCID")):15 E S IBY="0^Cannot lock ECME number." G BILLQ "RTN","IBNCPDP2",64,0) ; "RTN","IBNCPDP2",65,0) S IBTRIC=$$TRICARE^IBNCPDP6(IBRXN_";"_IBFIL) "RTN","IBNCPDP2",66,0) ; do patient copay first (only applicable if Tricare) "RTN","IBNCPDP2",67,0) I $G(IBD("COPAY")),IBTRIC D BILL^IBNCPDP6(IBRXN_";"_IBFIL,IBD("COPAY"),$G(IBD("RTYPE"))) "RTN","IBNCPDP2",68,0) I IBTRIC,'$G(IBD("PAID")) S IBY="1^Nothing paid in Tricare claim." G BILLQ "RTN","IBNCPDP2",69,0) ; "RTN","IBNCPDP2",70,0) S IBLOCK=1,IBLDT2="" "RTN","IBNCPDP2",71,0) S IBLDT=$$FMADD^XLFDT(DT,1) F S IBLGL=$O(^XTMP("IBNCPLDT"_IBLDT),-1),IBLDT=$E(IBLGL,9,15) Q:IBLDT<$$FMADD^XLFDT(DT,-3)!(IBLGL'["IBNCPLDT") I $D(^XTMP(IBLGL,IBD("BCID"))) S IBLDT2=^(IBD("BCID")) Q ;Last time called "RTN","IBNCPDP2",72,0) D NOW^%DTC S IBNOW=% "RTN","IBNCPDP2",73,0) ; 2 calls in 45 sec "RTN","IBNCPDP2",74,0) I IBLDT2,$$FMDIFF^XLFDT(IBNOW,IBLDT2,2)<45 S IBY="0^Duplicate billing call" G BILLQ "RTN","IBNCPDP2",75,0) ; "RTN","IBNCPDP2",76,0) I $$MATCH(IBD("BCID"),IBD("RXCOB")) D ;cancel the previous bill "RTN","IBNCPDP2",77,0) . N IBARR M IBARR=IBD I $$REVERSE^IBNCPDP3(DFN,.IBARR) "RTN","IBNCPDP2",78,0) ; "RTN","IBNCPDP2",79,0) ; derive minimal variables "RTN","IBNCPDP2",80,0) I '$$CHECK^IBECEAU(0) S IBY="-1^IB SITE" G BILLQ "RTN","IBNCPDP2",81,0) S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4) "RTN","IBNCPDP2",82,0) I '$$SERV^IBARX1(IBSERV) S IBY="-1^IB SERVICE" G BILLQ "RTN","IBNCPDP2",83,0) I 'IBDIV S IBDIV=$P($$MCDIV^IBNCPEB(IBRXN,IBFIL),U,2) "RTN","IBNCPDP2",84,0) I 'IBDIV S IBDIV=+$P($G(^SC(+$$FILE^IBRXUTL(IBRXN,5),0)),"^",15) "RTN","IBNCPDP2",85,0) I 'IBDIV S IBDIV=+$P($G(^IBE(350.9,1,1)),U,25) ;dflt "RTN","IBNCPDP2",86,0) I IBDIV S IBD("DIVISION")=IBDIV "RTN","IBNCPDP2",87,0) ; - establish a stub claim/receivable "RTN","IBNCPDP2",88,0) D SET^IBR I IBY<0 G BILLQ "RTN","IBNCPDP2",89,0) ; "RTN","IBNCPDP2",90,0) ; set up the following variables for claim establishment: "RTN","IBNCPDP2",91,0) ; .01 BILL # "RTN","IBNCPDP2",92,0) ; .17 ORIG CLAIM "RTN","IBNCPDP2",93,0) ; .2 AUTO? "RTN","IBNCPDP2",94,0) ; .02 DFN "RTN","IBNCPDP2",95,0) ; .06 TIMEFRAME "RTN","IBNCPDP2",96,0) ; .07 RATE TYPE "RTN","IBNCPDP2",97,0) ; .18 SC AT TIME? "RTN","IBNCPDP2",98,0) ; .04 LOCATION "RTN","IBNCPDP2",99,0) ; .22 DIVISION "RTN","IBNCPDP2",100,0) ; .05 BILL CLASSIF (3) "RTN","IBNCPDP2",101,0) ; .03 EVT DATE (FILL DATE) "RTN","IBNCPDP2",102,0) ; 151 BILL FROM "RTN","IBNCPDP2",103,0) ; 152 BILL TO "RTN","IBNCPDP2",104,0) ; 155 SENSITIVE DX "RTN","IBNCPDP2",105,0) ; 157 ROI OBTAINED "RTN","IBNCPDP2",106,0) ; 101 PRIMARY INS CARRIER "RTN","IBNCPDP2",107,0) K IB "RTN","IBNCPDP2",108,0) S (IB(.02),IBDFN)=DFN "RTN","IBNCPDP2",109,0) S IB(.07)=$$RT^IBNCPDP6(IBRXN_";"_IBFIL) ; previously determined rate type "RTN","IBNCPDP2",110,0) I 'IB(.07) S IB(.07)=+$$RT^IBNCPDPU(DFN) ; cannot find previously, try to recompute "RTN","IBNCPDP2",111,0) I 'IB(.07) S IBY="-1^IB RATE TYPE" G BILLQ "RTN","IBNCPDP2",112,0) ; "RTN","IBNCPDP2",113,0) S IBIFN=PRCASV("ARREC") "RTN","IBNCPDP2",114,0) S IB(.01)=$P(PRCASV("ARBIL"),"-",2) "RTN","IBNCPDP2",115,0) S IB(.17)="" "RTN","IBNCPDP2",116,0) S IB(.2)=0 "RTN","IBNCPDP2",117,0) S IB(.06)=1 "RTN","IBNCPDP2",118,0) S IB(.18)=$$SC^IBCU3(DFN) "RTN","IBNCPDP2",119,0) S IB(.04)=$S(+$P($G(^DG(40.8,+IBDIV,0)),U,3):7,1:1) "RTN","IBNCPDP2",120,0) S:IBDIV IB(.22)=+IBDIV "RTN","IBNCPDP2",121,0) S IB(.05)=3 "RTN","IBNCPDP2",122,0) S (IB(.03),IB(151),IB(152))=IBADT "RTN","IBNCPDP2",123,0) S IBINS=$P($G(^IBA(355.3,+$G(IBD("PLAN")),0)),"^") I IBINS S IB(101)=IBINS "RTN","IBNCPDP2",124,0) ; "RTN","IBNCPDP2",125,0) ; set 362.4 node to rx#^p50^days sup^fill date^qty^ndc "RTN","IBNCPDP2",126,0) S IB(362.4,IBRXN,IBFIL)=IBD("RX NO")_"^"_IBD("DRUG")_"^"_IBD("DAYS SUPPLY")_"^"_IBD("FILL DATE")_"^"_IBD("QTY")_"^"_IBD("NDC") "RTN","IBNCPDP2",127,0) ; "RTN","IBNCPDP2",128,0) ; drug DEA ROI check. "RTN","IBNCPDP2",129,0) N IBDEA "RTN","IBNCPDP2",130,0) D ZERO^IBRXUTL(IBD("DRUG")) S IBDEA=^TMP($J,"IBDRUG",IBD("DRUG"),3) "RTN","IBNCPDP2",131,0) I IBDEA["U" S IB(155)=1,IB(157)=1 ; set sensitive dx and ROI obtained "RTN","IBNCPDP2",132,0) K ^TMP($J,"IBDRUG") "RTN","IBNCPDP2",133,0) ; "RTN","IBNCPDP2",134,0) ; call the autobiller module to create the claim with a default "RTN","IBNCPDP2",135,0) ; diagnosis and procedure for prescriptions "RTN","IBNCPDP2",136,0) D EN^IBCD3(.IBQUERY) "RTN","IBNCPDP2",137,0) D CLOSE^IBSDU(.IBQUERY) "RTN","IBNCPDP2",138,0) ; "RTN","IBNCPDP2",139,0) S:'$D(^XTMP("IBNCPLDT"_DT)) ^XTMP("IBNCPLDT"_DT,0)=$$FMADD^XLFDT(DT,2)_U_DT S ^XTMP("IBNCPLDT"_DT,IBD("BCID"))=IBNOW "RTN","IBNCPDP2",140,0) S DIE="^DGCR(399,",DA=IBIFN "RTN","IBNCPDP2",141,0) ; update the ECME fields "RTN","IBNCPDP2",142,0) S DR="460////^S X=IBD(""BCID"")" S:$L($G(IBD("AUTH #"))) DR=DR_";461////^S X=IBD(""AUTH #"")" "RTN","IBNCPDP2",143,0) D ^DIE K DA,DR,DIE "RTN","IBNCPDP2",144,0) D SETCT ; Set Claims Tracking record "RTN","IBNCPDP2",145,0) ; "RTN","IBNCPDP2",146,0) ; IEN to 2.3121 "RTN","IBNCPDP2",147,0) S IBCDFN=$$PLANN^IBNCPDPU(DFN,IBD("PLAN"),IBADT) "RTN","IBNCPDP2",148,0) I 'IBCDFN S IBY="-1^Plan not found in Patient's Profile." G BILLQ "RTN","IBNCPDP2",149,0) ; "RTN","IBNCPDP2",150,0) ; add the payer (fiscal intermediary) to the claim "RTN","IBNCPDP2",151,0) S IBINS=+IBCDFN,IBCDFN=$P(IBCDFN,"^",2) "RTN","IBNCPDP2",152,0) S DIE="^DGCR(399,",DA=IBIFN,DR="112////"_IBCDFN "RTN","IBNCPDP2",153,0) D ^DIE K DA,DR,DIE,DGRVRCAL "RTN","IBNCPDP2",154,0) ; "RTN","IBNCPDP2",155,0) ; need to make sure we have computed charges. "RTN","IBNCPDP2",156,0) Q:'$$CHARGES(IBIFN,IBINS,+IB(.07),$G(IBD("PAID")),IBDIV,IBTRIC,.IBY) "RTN","IBNCPDP2",157,0) ; "RTN","IBNCPDP2",158,0) ; update the authorize/print fields "RTN","IBNCPDP2",159,0) S DIE="^DGCR(399,",DA=IBIFN "RTN","IBNCPDP2",160,0) S DR="9////1;12////"_DT D ^DIE "RTN","IBNCPDP2",161,0) ; "RTN","IBNCPDP2",162,0) ; pass the claim to AR "RTN","IBNCPDP2",163,0) D GVAR^IBCBB,ARRAY^IBCBB1 S PRCASV("APR")=IBDUZ D ^PRCASVC6 "RTN","IBNCPDP2",164,0) I 'PRCASV("OKAY") S IBY="-1^Cannot establish receivable in AR." G BILLQ "RTN","IBNCPDP2",165,0) D REL^PRCASVC "RTN","IBNCPDP2",166,0) ; "RTN","IBNCPDP2",167,0) ; update the AR status to Active "RTN","IBNCPDP2",168,0) ; D AUDITX^PRCAUDT(PRCASV("ARREC")) "RTN","IBNCPDP2",169,0) S PRCASV("STATUS")=16 "RTN","IBNCPDP2",170,0) D STATUS^PRCASVC1 "RTN","IBNCPDP2",171,0) ; "RTN","IBNCPDP2",172,0) ; decrease adjust bill "RTN","IBNCPDP2",173,0) ; Auto decrease from service Bill#,Tran amt,person,reason,Tran date "RTN","IBNCPDP2",174,0) S IBAMT=$G(^DGCR(399,IBIFN,"U1")) "RTN","IBNCPDP2",175,0) S IBPAID=$G(IBD("PAID")) "RTN","IBNCPDP2",176,0) I IBAMT-IBPAID>.01,'IBTRIC D "RTN","IBNCPDP2",177,0) . D DEC^PRCASER1(PRCASV("ARREC"),IBAMT-IBPAID,IBDUZ,"Adjust based on ECME amount paid.",IBADT) "RTN","IBNCPDP2",178,0) . I 'IBPAID S PRCASV("STATUS")=22 D STATUS^PRCASVC1 ; collected/closed "RTN","IBNCPDP2",179,0) ; "RTN","IBNCPDP2",180,0) D ; set the user in 399 "RTN","IBNCPDP2",181,0) . N IBI,IBT F IBI=2,5,11,13,15 S IBT(399,IBIFN_",",IBI)=IBDUZ "RTN","IBNCPDP2",182,0) . D FILE^DIE("","IBT") "RTN","IBNCPDP2",183,0) ; "RTN","IBNCPDP2",184,0) BILLQ S IBRES=$S(IBY<0:"0^"_$S($L($P(IBY,"^",2)):$P(IBY,"^",2),1:$P(IBY,"^",3)),$G(IBIFN):+IBIFN,1:IBY) "RTN","IBNCPDP2",185,0) I $G(IBIFN) S IBD("BILL")=IBIFN "RTN","IBNCPDP2",186,0) D LOG("BILL",IBRES) "RTN","IBNCPDP2",187,0) I IBY<0 D BULL^IBNCPEB($G(DFN),.IBD,IBRES,$G(IBIFN)) "RTN","IBNCPDP2",188,0) I IBLOCK L -^DGCR(399,"AG",IBD("BCID")) "RTN","IBNCPDP2",189,0) Q IBRES "RTN","IBNCPDP2",190,0) ; "RTN","IBNCPDP2",191,0) SETCT ; update claims tracking saying bill has been billed "RTN","IBNCPDP2",192,0) N X,Y,D0,DA,DI,DICR,DIE,DIG,DIH,DIU,DIV,DIW,DQ,DR "RTN","IBNCPDP2",193,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) "RTN","IBNCPDP2",194,0) I IBTRKRN S DIE="^IBT(356,",DA=IBTRKRN,DR=".11////^S X=IBIFN;.17///@" D ^DIE "RTN","IBNCPDP2",195,0) I IBTRKRN,(+$G(IBD("FILL DATE"))'=$P(^IBT(356,IBTRKRN,0),U,6)) S DIE="^IBT(356,",DA=IBTRKRN,DR=".06////"_IBD("FILL DATE") D ^DIE ; Check Fill Date "RTN","IBNCPDP2",196,0) I IBTRKRN,IBIFN D CTB^IBCDC(IBTRKRN,IBIFN) "RTN","IBNCPDP2",197,0) Q "RTN","IBNCPDP2",198,0) ; "RTN","IBNCPDP2",199,0) LOG(PROC,RESULT) ;Store the data "RTN","IBNCPDP2",200,0) ;Log values passed into IB by outside applications "RTN","IBNCPDP2",201,0) ; "RTN","IBNCPDP2",202,0) ;implicit input variables/arrays : "RTN","IBNCPDP2",203,0) ; IBD array with values sent to IB (see calling subroutines) "RTN","IBNCPDP2",204,0) ; DFN - patient's IEN (file #2) "RTN","IBNCPDP2",205,0) ; DUZ - user's IEN(file #200) "RTN","IBNCPDP2",206,0) ;explicit parameters: "RTN","IBNCPDP2",207,0) ; PROC - type of event as string, i.e. BILL, REJECT and so on "RTN","IBNCPDP2",208,0) ; RESULT - result of the event processing, format: return_code^message "RTN","IBNCPDP2",209,0) ; "RTN","IBNCPDP2",210,0) D LOG^IBNCPLOG(.IBD,DFN,PROC,RESULT,$J,$$NOW^XLFDT(),+DUZ) "RTN","IBNCPDP2",211,0) Q "RTN","IBNCPDP2",212,0) ; "RTN","IBNCPDP2",213,0) EPHARM(IBRX,IBREFILL) ; "RTN","IBNCPDP2",214,0) ;returns ien of #9002313.56 BPS PHARMACIES associated "RTN","IBNCPDP2",215,0) ;with the prescription specified by: "RTN","IBNCPDP2",216,0) ; IBRX - IEN in file #52 "RTN","IBNCPDP2",217,0) ; IBREFILL - zero(0) for the original prescription or the refill "RTN","IBNCPDP2",218,0) ; number for a refill (IEN of REFILL multiple #52.1) "RTN","IBNCPDP2",219,0) I +$G(IBRX)=0 Q "" "RTN","IBNCPDP2",220,0) I $G(IBREFILL)="" Q "" "RTN","IBNCPDP2",221,0) N IBDIV59 "RTN","IBNCPDP2",222,0) S IBDIV59=+$$RXSITE^PSOBPSUT(+IBRX,+IBREFILL) "RTN","IBNCPDP2",223,0) I IBDIV59>0 Q $$GETPHARM^BPSUTIL(IBDIV59) "RTN","IBNCPDP2",224,0) Q "" "RTN","IBNCPDP2",225,0) ; "RTN","IBNCPDP2",226,0) CHARGES(IBIFN,IBINS,IBRT,IBAMT,IBDIV,IBTRIC,IBY) ; "RTN","IBNCPDP2",227,0) ; will add charges onto bill based on rate type "RTN","IBNCPDP2",228,0) ; "RTN","IBNCPDP2",229,0) ; Input: IBIFN = Bill (399) ien "RTN","IBNCPDP2",230,0) ; IBINS = Insurance Co (36) ien "RTN","IBNCPDP2",231,0) ; IBRT = Rate Type (399.3) ien "RTN","IBNCPDP2",232,0) ; Output: 1 = Ok all done "RTN","IBNCPDP2",233,0) ; 0 = not ok, bill doesn't have charges "RTN","IBNCPDP2",234,0) ; "RTN","IBNCPDP2",235,0) N IBCSZ,IBRVCD,IBBS,IBUNITS,IBCPT,IBAA,IBTYPE,IBITEM,X "RTN","IBNCPDP2",236,0) ; "RTN","IBNCPDP2",237,0) I 'IBTRIC D BILL^IBCRBC(IBIFN) Q 1 "RTN","IBNCPDP2",238,0) ; "RTN","IBNCPDP2",239,0) ; - manually add charge to the claim (based on cost for Tricare) "RTN","IBNCPDP2",240,0) S IBRVCD=$P($G(^DIC(36,IBINS,0)),"^",15) ; rx refill rev code "RTN","IBNCPDP2",241,0) S IBCSZ=$G(^IBE(363.1,+$O(^IBE(363.1,"B","RX COST",0)),0)) ; using cost CS "RTN","IBNCPDP2",242,0) I IBRVCD="" S IBRVCD=$P(IBCSZ,U,5) ; CS def rev code "RTN","IBNCPDP2",243,0) I IBRVCD="" S X=250 ; gen'l rx rev code "RTN","IBNCPDP2",244,0) ; "RTN","IBNCPDP2",245,0) S IBBS=$P(IBCSZ,U,6) ; CS def bedsection "RTN","IBNCPDP2",246,0) S IBUNITS=1 ; one unit "RTN","IBNCPDP2",247,0) S IBCPT=$P($G(^IBE(350.9,1,1)),"^",30) ; def rx refill cpt "RTN","IBNCPDP2",248,0) S IBAA=0 ; not auto calc charges "RTN","IBNCPDP2",249,0) S IBTYPE=3 ; rx type "RTN","IBNCPDP2",250,0) S IBITEM="" ; charge item link "RTN","IBNCPDP2",251,0) ; "RTN","IBNCPDP2",252,0) S X=$$ADDRC^IBCRBF(IBIFN,IBRVCD,IBBS,IBAMT,IBUNITS,IBCPT,IBDIV,IBAA,IBTYPE,IBITEM) "RTN","IBNCPDP2",253,0) I X<0 S IBY="-1^^Unable to add Revenue Code charge to claim." Q 0 "RTN","IBNCPDP2",254,0) Q 1 "RTN","IBNCPDP2",255,0) ; "RTN","IBNCPDP3") 0^13^B84836012 "RTN","IBNCPDP3",1,0) IBNCPDP3 ;OAK/ELZ - STORES NDC/AWP UPDATES ;11/14/07 13:18 "RTN","IBNCPDP3",2,0) ;;2.0;INTEGRATED BILLING;**223,276,342,363,383,384,411,435**;21-MAR-94;Build 27 "RTN","IBNCPDP3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDP3",4,0) ; "RTN","IBNCPDP3",5,0) ; Reference to ^PRCASER1 supported by IA# 593 "RTN","IBNCPDP3",6,0) ; Reference to BPS RESPONSES file (#9002313.03) supported by IA# 4813 "RTN","IBNCPDP3",7,0) ; "RTN","IBNCPDP3",8,0) ; "RTN","IBNCPDP3",9,0) UPAWP(IBNDC,IBAWP,IBADT) ; updates AWP prices for NDCs "RTN","IBNCPDP3",10,0) ; "RTN","IBNCPDP3",11,0) N IBITEM,IBCS "RTN","IBNCPDP3",12,0) ; "RTN","IBNCPDP3",13,0) ; "RTN","IBNCPDP3",14,0) S IBCS=$P($G(^IBE(350.9,1,9)),"^",12) "RTN","IBNCPDP3",15,0) I 'IBCS Q "0^Unable to find Charge Set" "RTN","IBNCPDP3",16,0) ; "RTN","IBNCPDP3",17,0) S IBNDC=$$NDC^IBNCPNB(IBNDC) "RTN","IBNCPDP3",18,0) ; "RTN","IBNCPDP3",19,0) S IBITEM=+$$ADDBI^IBCREF("NDC",IBNDC) I IBITEM Q "0^Unable to add item" "RTN","IBNCPDP3",20,0) ; "RTN","IBNCPDP3",21,0) I '$$ADDCI^IBCREF(IBCS,IBITEM,IBADT,IBAWP) Q "0^Unable to add charge" "RTN","IBNCPDP3",22,0) ; "RTN","IBNCPDP3",23,0) Q 1 "RTN","IBNCPDP3",24,0) ; "RTN","IBNCPDP3",25,0) ; "RTN","IBNCPDP3",26,0) ; "RTN","IBNCPDP3",27,0) ; "RTN","IBNCPDP3",28,0) REVERSE(DFN,IBD,IBAUTO) ;process reversed claims "RTN","IBNCPDP3",29,0) N IBIFN,I,IB,IBIL,IBCHG,IBCRES,IBY,X,Y,DA,DIE,DR,IBADT,IBLOCK,IBLDT "RTN","IBNCPDP3",30,0) N IBNOW,IBDUZ,IBCR,IBRELC,IBCC,IBPAP,IBRXN,IBFIL,IBRTS,IBARES,IBUSR "RTN","IBNCPDP3",31,0) N IBLGL,IBLDT "RTN","IBNCPDP3",32,0) S IBDUZ=.5 "RTN","IBNCPDP3",33,0) S IBLOCK=0 "RTN","IBNCPDP3",34,0) ; find bill number "RTN","IBNCPDP3",35,0) I 'DFN S IBY="0^No patient" G REVQ "RTN","IBNCPDP3",36,0) I '$L($G(IBD("CLAIMID"))) S IBY="0^Missing ECME Number" G REVQ "RTN","IBNCPDP3",37,0) S IBADT=+$G(IBD("FILL DATE")) I 'IBADT S IBY="0^Missing Fill Date" G REVQ "RTN","IBNCPDP3",38,0) S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBY="0^No Rx IEN" G REVQ "RTN","IBNCPDP3",39,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBY="0^No fill number" G REVQ "RTN","IBNCPDP3",40,0) I $E($G(IBD("RESPONSE")),1)="R" D G REVQ:+'$G(IBRTS) "RTN","IBNCPDP3",41,0) . S IBY="0^REVERSAL rejected by payer" "RTN","IBNCPDP3",42,0) . S IBRTS=$$RTS(IBD("REVERSAL REASON")) "RTN","IBNCPDP3",43,0) ; "RTN","IBNCPDP3",44,0) D CANC^IBNCPDP6(IBRXN_";"_IBFIL) ; cancel 1st party charge for Tricare "RTN","IBNCPDP3",45,0) ; "RTN","IBNCPDP3",46,0) S IBD("BCID")=$$BCID^IBNCPDP4(IBD("CLAIMID"),IBADT) "RTN","IBNCPDP3",47,0) L +^DGCR(399,"AG",IBD("BCID")):15 E S IBY="0^Cannot lock ECME number" G REVQ "RTN","IBNCPDP3",48,0) S IBLOCK=1 "RTN","IBNCPDP3",49,0) S IBUSR=$S(+$G(IBD("USER"))=0:DUZ,1:IBD("USER")) "RTN","IBNCPDP3",50,0) S IBLDT=$$FMADD^XLFDT(DT,1) F S IBLGL=$O(^XTMP("IBNCPLDT"_IBLDT),-1),IBLDT=$E(IBLGL,9,15) Q:IBLDT<$$FMADD^XLFDT(DT,-3)!(IBLGL'["IBNCPLDT") I $D(^XTMP(IBLGL,IBD("BCID"))) S ^(IBD("BCID"))="" Q "RTN","IBNCPDP3",51,0) S IBIFN=$$MATCH^IBNCPDP2(IBD("BCID"),$G(IBD("RXCOB"))) "RTN","IBNCPDP3",52,0) I $D(IBD("CLOSE REASON")),'$D(IBD("DROP TO PAPER")) S IBD("DROP TO PAPER")="" "RTN","IBNCPDP3",53,0) S IBCR=+$G(IBD("CLOSE REASON")) "RTN","IBNCPDP3",54,0) S IBPAP=$G(IBD("DROP TO PAPER")) "RTN","IBNCPDP3",55,0) S IBRELC=$G(IBD("RELEASE COPAY")) "RTN","IBNCPDP3",56,0) S IBCC=$G(IBD("CLOSE COMMENT")) "RTN","IBNCPDP3",57,0) D NONBR^IBNCPNB(DFN,IBRXN,IBFIL,IBADT,IBCR,IBPAP,IBRELC,IBCC,IBUSR) "RTN","IBNCPDP3",58,0) I 'IBIFN S IBY="0^"_$S(IBPAP:"Dropped to paper",IBCR>1:"Set non-billable reason in CT",1:"Cannot find the bill to reverse") G REVQ "RTN","IBNCPDP3",59,0) ; "RTN","IBNCPDP3",60,0) F I=0,"S" S IB(I)=$G(^DGCR(399,IBIFN,I)) "RTN","IBNCPDP3",61,0) I IB(0)="" S IBY="0^No data in bill" G REVQ "RTN","IBNCPDP3",62,0) I +$P(IB("S"),U,16),$P(IB("S"),U,17)]"" S IBY="0^Bill already cancelled" G REVQ "RTN","IBNCPDP3",63,0) ; "RTN","IBNCPDP3",64,0) S:'$D(IBCRES) IBCRES="ECME PRESCRIPTION REVERSED" "RTN","IBNCPDP3",65,0) S DA=IBIFN,DR="16////1;19////"_IBCRES,DIE="^DGCR(399," "RTN","IBNCPDP3",66,0) D ^DIE K DA,DIE,DR "RTN","IBNCPDP3",67,0) ; "RTN","IBNCPDP3",68,0) ; - decrease out the receivable in AR "RTN","IBNCPDP3",69,0) S IB("U1")=$G(^DGCR(399,IBIFN,"U1")) "RTN","IBNCPDP3",70,0) S IBIL=$P($G(^PRCA(430,IBIFN,0)),"^") "RTN","IBNCPDP3",71,0) S IBCHG=$S(IB("U1")']"":0,$P(IB("U1"),"^",1)]"":$P(IB("U1"),"^",1),1:0) "RTN","IBNCPDP3",72,0) ; "RTN","IBNCPDP3",73,0) S X="21^"_IBCHG_"^"_IBIL_"^"_IBDUZ_"^"_DT_"^"_IBCRES "RTN","IBNCPDP3",74,0) D ^PRCASER1 "RTN","IBNCPDP3",75,0) S IBARES=Y "RTN","IBNCPDP3",76,0) I IBARES<0 S IBY=IBARES D BULL "RTN","IBNCPDP3",77,0) ; "RTN","IBNCPDP3",78,0) S IBY=$S(IBARES<0:"0^"_$P(IBARES,"^",2),1:1) "RTN","IBNCPDP3",79,0) ; "RTN","IBNCPDP3",80,0) I IBDUZ'=DUZ D ; set the real user "RTN","IBNCPDP3",81,0) . N IBI,IBT S IBI=18,IBT(399,IBIFN_",",IBI)=IBDUZ D FILE^DIE("","IBT") "RTN","IBNCPDP3",82,0) ; "RTN","IBNCPDP3",83,0) REVQ ; perform end of job tasks "RTN","IBNCPDP3",84,0) D LOG^IBNCPDP2($S($G(IBAUTO)=1:"AUTO REVERSE",$G(IBAUTO)=2:"BILL CANCELLED",1:"REVERSE"),IBY) "RTN","IBNCPDP3",85,0) I IBLOCK L -^DGCR(399,"AG",IBD("BCID")) "RTN","IBNCPDP3",86,0) I IBY=1,$G(IBIFN) S IBY=+IBIFN "RTN","IBNCPDP3",87,0) Q IBY "RTN","IBNCPDP3",88,0) ; "RTN","IBNCPDP3",89,0) RTS(IBRR) ; Return to Stock processing on Released Rx "RTN","IBNCPDP3",90,0) ; input - IBRR = reversal reason "RTN","IBNCPDP3",91,0) ; IBCRSN = passed in by reference "RTN","IBNCPDP3",92,0) ; output - 0 = reversal not due to a Rx RETURN TO STOCK or Rx DELETE "RTN","IBNCPDP3",93,0) ; 1 = reversal due to a Rx RETURN TO STOCK or Rx DELETE "RTN","IBNCPDP3",94,0) ; IBCRSN = charge removal reason "RTN","IBNCPDP3",95,0) N IBTRKRN,IBLOCK2,IBCMT,DA,DIE,DR "RTN","IBNCPDP3",96,0) ; "RTN","IBNCPDP3",97,0) I IBRR'="RX RETURNED TO STOCK"&(IBRR'="RX DELETED") Q 0 "RTN","IBNCPDP3",98,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) "RTN","IBNCPDP3",99,0) I 'IBTRKRN Q 0 ; CT record does not exist "RTN","IBNCPDP3",100,0) I '$P($G(^IBT(356,IBTRKRN,0)),U,11) Q 0 ; BILL does not exist "RTN","IBNCPDP3",101,0) S IBCRES=$$GETRSN(DFN,IBRXN,IBFIL) ; recorded in file 399 entry "RTN","IBNCPDP3",102,0) L +^IBT(356,IBTRKRN):5 S IBLOCK2=$T "RTN","IBNCPDP3",103,0) S DIE="^IBT(356,",DA=IBTRKRN,IBCMT="Rx RTS - May Need Refund" "RTN","IBNCPDP3",104,0) S DR="1.08////"_IBCMT "RTN","IBNCPDP3",105,0) D ^DIE "RTN","IBNCPDP3",106,0) I IBLOCK2 L -^IBT(356,IBTRKRN) "RTN","IBNCPDP3",107,0) Q 1 "RTN","IBNCPDP3",108,0) ; "RTN","IBNCPDP3",109,0) BULL ; Generate a bulletin if there is an error in cancelling the claim. "RTN","IBNCPDP3",110,0) N IBC,IBT,IBPT,IBGRP,XMDUZ,XMTEXT,XMSUB,XMY "RTN","IBNCPDP3",111,0) ; "RTN","IBNCPDP3",112,0) S IBPT=$$PT^IBEFUNC(DFN) "RTN","IBNCPDP3",113,0) S XMSUB=$E($P(IBPT,"^"),1,14)_" "_$P(IBPT,"^",3)_" - ERROR ENCOUNTERED" "RTN","IBNCPDP3",114,0) S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT(" "RTN","IBNCPDP3",115,0) S XMY(IBDUZ)="" "RTN","IBNCPDP3",116,0) S XMY("G.IBCNR EPHARM")="" "RTN","IBNCPDP3",117,0) ; "RTN","IBNCPDP3",118,0) S IBT(1)="An error occurred while cancelling the Pharmacy claim from ECME" "RTN","IBNCPDP3",119,0) S IBT(2)="fiscal intermediary for the following patient:" "RTN","IBNCPDP3",120,0) S IBT(3)=" " S IBC=3 "RTN","IBNCPDP3",121,0) D PAT^IBAERR1 ; Accepts IBDUZ "RTN","IBNCPDP3",122,0) S IBC=IBC+1,IBT(IBC)=" Bill #: "_IBIL "RTN","IBNCPDP3",123,0) S IBC=IBC+1,IBT(IBC)=" " "RTN","IBNCPDP3",124,0) S IBC=IBC+1,IBT(IBC)="The following error was encountered:" "RTN","IBNCPDP3",125,0) S IBC=IBC+1,IBT(IBC)=" " "RTN","IBNCPDP3",126,0) D ERR^IBAERR1 "RTN","IBNCPDP3",127,0) S IBC=IBC+1,IBT(IBC)=" " "RTN","IBNCPDP3",128,0) S IBC=IBC+1,IBT(IBC)="Please review the circumstances surrounding this error and decrease" "RTN","IBNCPDP3",129,0) S IBC=IBC+1,IBT(IBC)="out this receivable in Accounts Receivable if necessary." "RTN","IBNCPDP3",130,0) D ^XMD "RTN","IBNCPDP3",131,0) Q "RTN","IBNCPDP3",132,0) ; "RTN","IBNCPDP3",133,0) GETRSN(DFN,IBRXN,IBFIL) ; "RTN","IBNCPDP3",134,0) ; retrieve charge removal reason from file 354.71 "RTN","IBNCPDP3",135,0) ; input - DFN,IBRXN=Rx ien,IBFIL=fill number "RTN","IBNCPDP3",136,0) ; output - charge removal reason "RTN","IBNCPDP3",137,0) N IBDT,IBDA,IBXRSN,IBRXFIL,IB0 "RTN","IBNCPDP3",138,0) S (IBDT,IBDA)=0,IBXRSN="" "RTN","IBNCPDP3",139,0) S IBRXFIL=$S('IBFIL:IBRXN,1:IBRXN_";"_IBFIL) "RTN","IBNCPDP3",140,0) F S IBDT=$O(^IBAM(354.71,"AD",DFN,IBDT)) Q:'IBDT Q:IBXRSN]"" D "RTN","IBNCPDP3",141,0) . F S IBDA=$O(^IBAM(354.71,"AD",DFN,IBDT,IBDA)) Q:'IBDA Q:IBXRSN]"" D "RTN","IBNCPDP3",142,0) . . S IB0=^IBAM(354.71,IBDA,0) "RTN","IBNCPDP3",143,0) . . Q:$P(IB0,"^",6)'[IBRXFIL "RTN","IBNCPDP3",144,0) . . S IBXRSN=$$GET1^DIQ(354.71,IBDA_",",.19) "RTN","IBNCPDP3",145,0) S:IBXRSN']"" IBXRSN="CHARGE REMOVAL REASON NOT FOUND" "RTN","IBNCPDP3",146,0) Q "Reversal Rej, no pymt due<>"_IBXRSN "RTN","IBNCPDP3",147,0) ; "RTN","IBNCPDP3",148,0) ELIG(DFN,IBD) ; process an Eligibility response "RTN","IBNCPDP3",149,0) N IBRES,ERACT,IDUZ,IBFDA,BPRIEN,IBUSR,IBCDFN,IBPL,IBERR,EPHSRC,INSIEN,BUDA,PTDA,PLDA,ICDA,BUFF,BPSR,ZR,BPRSUB,BPRGRP,IBNCPDPELIG "RTN","IBNCPDP3",150,0) S IBRES="" "RTN","IBNCPDP3",151,0) I '$G(DFN) S IBRES="0^No patient - ELIG response" G ELIGX "RTN","IBNCPDP3",152,0) S BPRIEN=+$G(IBD("RESPIEN")) ; response file ien "RTN","IBNCPDP3",153,0) S IBUSR=+$G(IBD("USER")) ; DUZ of user "RTN","IBNCPDP3",154,0) S IBCDFN=+$G(IBD("POLICY")) ; pt. ins. policy subfile 2.312 ien "RTN","IBNCPDP3",155,0) S IBPL=+$G(IBD("PLAN")) ; plan 355.3 ien "RTN","IBNCPDP3",156,0) ; "RTN","IBNCPDP3",157,0) ; data integrity checks "RTN","IBNCPDP3",158,0) I 'BPRIEN S IBRES="0^No BPS RESPONSES file ien" G ELIGX "RTN","IBNCPDP3",159,0) I '$D(^BPSR(BPRIEN,0)) S IBRES="0^No BPS RESPONSES file data exists for this ien" G ELIGX "RTN","IBNCPDP3",160,0) S ZR=BPRIEN_"," "RTN","IBNCPDP3",161,0) D GETS^DIQ(9002313.03,ZR,"103;301;302","IEN","BPSR") "RTN","IBNCPDP3",162,0) I $G(BPSR(9002313.03,ZR,103,"E"))'="E1" S IBRES="0^BPS Response is not an E1 Transaction Code" G ELIGX "RTN","IBNCPDP3",163,0) I 'IBCDFN S IBRES="0^No pt. policy ien" G ELIGX "RTN","IBNCPDP3",164,0) I '$D(^DPT(DFN,.312,IBCDFN,0)) S IBRES="0^Pt. insurance policy data not found" G ELIGX "RTN","IBNCPDP3",165,0) I +$P($G(^DPT(DFN,.312,IBCDFN,0)),U,18)'=IBPL S IBRES="0^Mismatch on plan ien" G ELIGX "RTN","IBNCPDP3",166,0) ; "RTN","IBNCPDP3",167,0) ; build a buffer entry based primarily on the ins. policy in the pt. file "RTN","IBNCPDP3",168,0) K IBERR "RTN","IBNCPDP3",169,0) S IDUZ=IBUSR "RTN","IBNCPDP3",170,0) S IBNCPDPELIG=1 ; special variable indicating to eIV where the buffer entry is coming from "RTN","IBNCPDP3",171,0) D PT^IBCNEBF(DFN,IBCDFN,"","",1,.IBERR) ; build and add buffer entry "RTN","IBNCPDP3",172,0) I $G(IBERR)'="" S IBRES="0^"_IBERR G ELIGX "RTN","IBNCPDP3",173,0) I '$G(IBFDA) S IBRES="0^No Buffer entry was created" G ELIGX "RTN","IBNCPDP3",174,0) I '$D(^IBA(355.33,IBFDA,0)) S IBRES="0^Buffer entry doesn't exist" G ELIGX "RTN","IBNCPDP3",175,0) S EPHSRC=+$O(^IBE(355.12,"C","E-PHARMACY",0)) ; source of information "RTN","IBNCPDP3",176,0) I 'EPHSRC S IBRES="0^Cannot find e-Pharmacy Source of Information in dictionary" G ELIGX "RTN","IBNCPDP3",177,0) S INSIEN=+$P($G(^DPT(DFN,.312,IBCDFN,0)),U,1) "RTN","IBNCPDP3",178,0) I 'INSIEN S IBRES="0^Insurance Company pointer not there" G ELIGX "RTN","IBNCPDP3",179,0) ; "RTN","IBNCPDP3",180,0) ; complete the buffer entry "RTN","IBNCPDP3",181,0) S BUDA=+IBFDA_"," ; IENS for the buffer entry "RTN","IBNCPDP3",182,0) S PTDA=IBCDFN_","_DFN_"," ; IENS for the pt. ins. policy subfile entry 2.312 "RTN","IBNCPDP3",183,0) S PLDA=IBPL_"," ; IENS for the plan entry 355.3 "RTN","IBNCPDP3",184,0) S ICDA=INSIEN_"," ; IENS for the insurance company entry 36 "RTN","IBNCPDP3",185,0) ; "RTN","IBNCPDP3",186,0) S BUFF(355.33,BUDA,60.1)=$$GET1^DIQ(2.312,PTDA,4.01,"I") "RTN","IBNCPDP3",187,0) S BUFF(355.33,BUDA,60.11)=$$GET1^DIQ(2.312,PTDA,4.02,"I") "RTN","IBNCPDP3",188,0) ; "RTN","IBNCPDP3",189,0) S BUFF(355.33,BUDA,40.01)=$$GET1^DIQ(355.3,PLDA,.02,"I") "RTN","IBNCPDP3",190,0) S BUFF(355.33,BUDA,40.04)=$$GET1^DIQ(355.3,PLDA,.05,"I") "RTN","IBNCPDP3",191,0) S BUFF(355.33,BUDA,40.05)=$$GET1^DIQ(355.3,PLDA,.06,"I") "RTN","IBNCPDP3",192,0) S BUFF(355.33,BUDA,40.06)=$$GET1^DIQ(355.3,PLDA,.12,"I") "RTN","IBNCPDP3",193,0) S BUFF(355.33,BUDA,40.07)=$$GET1^DIQ(355.3,PLDA,.07,"I") "RTN","IBNCPDP3",194,0) S BUFF(355.33,BUDA,40.08)=$$GET1^DIQ(355.3,PLDA,.08,"I") "RTN","IBNCPDP3",195,0) S BUFF(355.33,BUDA,40.09)=$$GET1^DIQ(355.3,PLDA,.09,"I") "RTN","IBNCPDP3",196,0) S BUFF(355.33,BUDA,40.1)=$$GET1^DIQ(355.3,PLDA,6.02,"I") "RTN","IBNCPDP3",197,0) S BUFF(355.33,BUDA,40.11)=$$GET1^DIQ(355.3,PLDA,6.03,"I") "RTN","IBNCPDP3",198,0) ; "RTN","IBNCPDP3",199,0) S BUFF(355.33,BUDA,20.02)=$$GET1^DIQ(36,ICDA,.131,"I") "RTN","IBNCPDP3",200,0) S BUFF(355.33,BUDA,20.05)=$$GET1^DIQ(36,ICDA,1,"I") "RTN","IBNCPDP3",201,0) S BUFF(355.33,BUDA,21.01)=$$GET1^DIQ(36,ICDA,.111,"I") "RTN","IBNCPDP3",202,0) S BUFF(355.33,BUDA,21.02)=$$GET1^DIQ(36,ICDA,.112,"I") "RTN","IBNCPDP3",203,0) S BUFF(355.33,BUDA,21.03)=$$GET1^DIQ(36,ICDA,.113,"I") "RTN","IBNCPDP3",204,0) S BUFF(355.33,BUDA,21.04)=$$GET1^DIQ(36,ICDA,.114,"I") "RTN","IBNCPDP3",205,0) S BUFF(355.33,BUDA,21.05)=$$GET1^DIQ(36,ICDA,.115,"I") "RTN","IBNCPDP3",206,0) S BUFF(355.33,BUDA,21.06)=$$GET1^DIQ(36,ICDA,.116,"I") "RTN","IBNCPDP3",207,0) ; "RTN","IBNCPDP3",208,0) ; update buffer entry with some additional information "RTN","IBNCPDP3",209,0) S BUFF(355.33,BUDA,.03)=EPHSRC ; source of info "RTN","IBNCPDP3",210,0) S BUFF(355.33,BUDA,.12)="" ; make sure eIV related fields are blank "RTN","IBNCPDP3",211,0) S BUFF(355.33,BUDA,.13)="" "RTN","IBNCPDP3",212,0) S BUFF(355.33,BUDA,.14)="" "RTN","IBNCPDP3",213,0) S BUFF(355.33,BUDA,.15)="" "RTN","IBNCPDP3",214,0) S BUFF(355.33,BUDA,.17)=BPRIEN ; BPS response file ien "RTN","IBNCPDP3",215,0) ; "RTN","IBNCPDP3",216,0) ; update buffer entry with data pulled from BPS response file "RTN","IBNCPDP3",217,0) ; only 2 fields are applicable here: group# and cardholder ID "RTN","IBNCPDP3",218,0) ; "RTN","IBNCPDP3",219,0) S BPRSUB=$G(BPSR(9002313.03,ZR,302,"E")) ; subscriber/cardholder ID "RTN","IBNCPDP3",220,0) I BPRSUB'="" S BUFF(355.33,BUDA,60.04)=BPRSUB ; update buffer if field exists "RTN","IBNCPDP3",221,0) ; "RTN","IBNCPDP3",222,0) S BPRGRP=$G(BPSR(9002313.03,ZR,301,"E")) ; group number "RTN","IBNCPDP3",223,0) I BPRGRP'="" S BUFF(355.33,BUDA,40.03)=BPRGRP ; update buffer if field exists "RTN","IBNCPDP3",224,0) ; "RTN","IBNCPDP3",225,0) D FILE^DIE(,"BUFF") "RTN","IBNCPDP3",226,0) ; "RTN","IBNCPDP3",227,0) S IBRES=1 ; all good "RTN","IBNCPDP3",228,0) ; "RTN","IBNCPDP3",229,0) ELIGX ; "RTN","IBNCPDP3",230,0) Q IBRES "RTN","IBNCPDP3",231,0) ; "RTN","IBNCPDP3",232,0) ;IBNCPDP3 "RTN","IBNCPDP4") 0^27^B55438909 "RTN","IBNCPDP4",1,0) IBNCPDP4 ;DALOI/AAT - HANDLE ECME EVENTS ;20-JUN-2003 "RTN","IBNCPDP4",2,0) ;;2.0;INTEGRATED BILLING;**276,342,405,384,411,435**;21-MAR-94;Build 27 "RTN","IBNCPDP4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDP4",4,0) ; "RTN","IBNCPDP4",5,0) ;NCPDP PHASE III "RTN","IBNCPDP4",6,0) Q "RTN","IBNCPDP4",7,0) ; "RTN","IBNCPDP4",8,0) CLOSE(DFN,IBD) ; Close Claim Event "RTN","IBNCPDP4",9,0) N IBADT,IBTRKR,IBTRKRN,IBRXN,IBFIL,IBEABD,IBRES,IBLOCK,IBDUZ "RTN","IBNCPDP4",10,0) N IBRXTYP,IBCR,DA,DIE,DR,IBUSR "RTN","IBNCPDP4",11,0) S IBDUZ=.5 "RTN","IBNCPDP4",12,0) S IBRES=1,IBLOCK=0 "RTN","IBNCPDP4",13,0) ; "RTN","IBNCPDP4",14,0) I 'DFN S IBRES="0^No patient" G CLOSEQ "RTN","IBNCPDP4",15,0) S IBADT=+$G(IBD("FILL DATE")) I 'IBADT S IBRES="0^No fill date" G CLOSEQ "RTN","IBNCPDP4",16,0) S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBRES="0^No Rx IEN" G CLOSEQ "RTN","IBNCPDP4",17,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBRES="0^No fill number" G CLOSEQ "RTN","IBNCPDP4",18,0) S IBCR=+$G(IBD("CLOSE REASON")) I 'IBCR S IBRES="0^No close reason" G CLOSEQ "RTN","IBNCPDP4",19,0) I '$L($G(IBD("CLAIMID"))) S IBRES="0^Missing ECME Number" G CLOSEQ "RTN","IBNCPDP4",20,0) S IBD("BCID")=$$BCID(IBD("CLAIMID"),IBADT) "RTN","IBNCPDP4",21,0) S IBUSR=$S(+$G(IBD("USER"))=0:DUZ,1:IBD("USER")) "RTN","IBNCPDP4",22,0) L +^DGCR(399,"AG",IBD("BCID")):5 S IBLOCK=$T "RTN","IBNCPDP4",23,0) ; "RTN","IBNCPDP4",24,0) ; closing secondary claims should not affect CT - esg 7/8/10 "RTN","IBNCPDP4",25,0) I $G(IBD("RXCOB"))>1 D S IBRES=1 G CLOSEQ "RTN","IBNCPDP4",26,0) . N IBACT "RTN","IBNCPDP4",27,0) . ; "RTN","IBNCPDP4",28,0) . ; release copay charges off hold if OPECC said to do so "RTN","IBNCPDP4",29,0) . I '$G(IBD("RELEASE COPAY")) Q "RTN","IBNCPDP4",30,0) . S IBACT=+$$RELCOPAY^IBNCPNB(DFN,IBRXN,IBFIL,1,IBADT,0) ; release copay charges off hold "RTN","IBNCPDP4",31,0) . I IBACT=-1 D RELBUL^IBNCPEB(DFN,IBRXN,IBFIL,IBADT,IBACT,IBCR,$G(IBD("CLOSE COMMENT")),0,1) ; send msg if error "RTN","IBNCPDP4",32,0) . Q "RTN","IBNCPDP4",33,0) ; "RTN","IBNCPDP4",34,0) ; -- claims tracking info "RTN","IBNCPDP4",35,0) S IBTRKR=$G(^IBE(350.9,1,6)) "RTN","IBNCPDP4",36,0) ; date can't be before parameters "RTN","IBNCPDP4",37,0) S $P(IBTRKR,"^")=$S('$P(IBTRKR,"^",4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT) "RTN","IBNCPDP4",38,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) "RTN","IBNCPDP4",39,0) ; "RTN","IBNCPDP4",40,0) I 'IBTRKRN S IBRES="0^CT record not found" G CLOSEQ "RTN","IBNCPDP4",41,0) ; "RTN","IBNCPDP4",42,0) D NONBR^IBNCPNB(DFN,IBRXN,IBFIL,IBADT,IBCR,$G(IBD("DROP TO PAPER")),$G(IBD("RELEASE COPAY")),$G(IBD("CLOSE COMMENT")),IBUSR) "RTN","IBNCPDP4",43,0) ; "RTN","IBNCPDP4",44,0) S DIE="^IBT(356,",DA=IBTRKRN "RTN","IBNCPDP4",45,0) ; add ECME #,ECME flag, remove total charges "RTN","IBNCPDP4",46,0) S DR="1.1///"_IBD("CLAIMID")_";1.11///2;.29////@" "RTN","IBNCPDP4",47,0) D ^DIE "RTN","IBNCPDP4",48,0) ; "RTN","IBNCPDP4",49,0) S IBRES=1 ; OK "RTN","IBNCPDP4",50,0) CLOSEQ ; "RTN","IBNCPDP4",51,0) D LOG^IBNCPDP2("CLOSE",IBRES) "RTN","IBNCPDP4",52,0) I IBLOCK L -^DGCR(399,"AG",IBD("BCID")) "RTN","IBNCPDP4",53,0) Q IBRES "RTN","IBNCPDP4",54,0) ; "RTN","IBNCPDP4",55,0) ; "RTN","IBNCPDP4",56,0) RELEASE(DFN,IBD) ; "RTN","IBNCPDP4",57,0) N IBRES,IBADT,IBRXN,IBFIL,IBRDT,IBLOCK,IBLOCK2,IBTRKR,IBTRKRN "RTN","IBNCPDP4",58,0) N IBEABD,IBNBR,DA,DIE,DR,IBUSR "RTN","IBNCPDP4",59,0) S IBLOCK=0 "RTN","IBNCPDP4",60,0) I 'DFN S IBRES="0^No patient" G RELQ "RTN","IBNCPDP4",61,0) S IBADT=+$G(IBD("FILL DATE")) I 'IBADT S IBRES="0^No fill date" G RELQ "RTN","IBNCPDP4",62,0) S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBRES="0^No Rx IEN" G RELQ "RTN","IBNCPDP4",63,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBRES="0^No fill number" G RELQ "RTN","IBNCPDP4",64,0) S IBRDT=+$G(IBD("RELEASE DATE"),-1) I 'IBRDT S IBRES="0^No release date" G RELQ "RTN","IBNCPDP4",65,0) I '$L($G(IBD("CLAIMID"))) S IBRES="0^Missing ECME Number" G RELQ "RTN","IBNCPDP4",66,0) S IBD("BCID")=$$BCID(IBD("CLAIMID"),IBADT) "RTN","IBNCPDP4",67,0) S IBUSR=$S(+$G(IBD("USER"))=0:DUZ,1:IBD("USER")) "RTN","IBNCPDP4",68,0) L +^DGCR(399,"AG",IBD("BCID")):5 S IBLOCK=$T "RTN","IBNCPDP4",69,0) ; -- claims tracking info "RTN","IBNCPDP4",70,0) S IBTRKR=$G(^IBE(350.9,1,6)) "RTN","IBNCPDP4",71,0) ; date can't be before parameters "RTN","IBNCPDP4",72,0) S $P(IBTRKR,"^")=$S('$P(IBTRKR,"^",4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT) "RTN","IBNCPDP4",73,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) "RTN","IBNCPDP4",74,0) I 'IBTRKRN S IBRES="0^No CT record found." G RELQ "RTN","IBNCPDP4",75,0) ; "RTN","IBNCPDP4",76,0) ; Remove NBR from CT and set T+60 (if not billed yet) "RTN","IBNCPDP4",77,0) ; Set ECME flags in CT "RTN","IBNCPDP4",78,0) ; "RTN","IBNCPDP4",79,0) L +^IBT(356,IBTRKRN):5 S IBLOCK2=$T "RTN","IBNCPDP4",80,0) S DIE="^IBT(356,",DA=IBTRKRN,DR="" "RTN","IBNCPDP4",81,0) S IBNBR=+$P($G(^IBT(356,IBTRKRN,0)),U,19) "RTN","IBNCPDP4",82,0) ; Clean up "Rx not released" "RTN","IBNCPDP4",83,0) I IBNBR,$P($G(^IBE(356.8,IBNBR,0)),U)="PRESCRIPTION NOT RELEASED" S DR=DR_".19////@;",IBNBR="" "RTN","IBNCPDP4",84,0) ; "RTN","IBNCPDP4",85,0) ; Set EABD if no bill and no NBR "RTN","IBNCPDP4",86,0) I '$P($G(^IBT(356,IBTRKRN,0)),U,11),'IBNBR D "RTN","IBNCPDP4",87,0) . S IBEABD=$$EABD^IBTUTL($O(^IBE(356.6,"AC",4,0)),IBADT) "RTN","IBNCPDP4",88,0) . S:'IBEABD IBEABD=DT "RTN","IBNCPDP4",89,0) . S IBEABD=$$FMADD^XLFDT(IBEABD,60) "RTN","IBNCPDP4",90,0) . S DR=DR_".17////^S X=IBEABD;" "RTN","IBNCPDP4",91,0) ; "RTN","IBNCPDP4",92,0) ; Set ECME Flags "RTN","IBNCPDP4",93,0) S DR=DR_"1.1////"_IBD("CLAIMID")_";" "RTN","IBNCPDP4",94,0) ; Reject status will not be set here "RTN","IBNCPDP4",95,0) ; "RTN","IBNCPDP4",96,0) ; Check that the Fill Date is current "RTN","IBNCPDP4",97,0) I IBADT'=$P(^IBT(356,IBTRKRN,0),U,6) S DR=DR_".06////"_IBADT_";" "RTN","IBNCPDP4",98,0) ; "RTN","IBNCPDP4",99,0) D ^DIE "RTN","IBNCPDP4",100,0) S IBFDA(356,IBTRKRN_",",1.03)=DT ; date last edited "RTN","IBNCPDP4",101,0) S IBFDA(356,IBTRKRN_",",1.04)=IBUSR ; last edited by "RTN","IBNCPDP4",102,0) D FILE^DIE("","IBFDA"),MSG^DIALOG() "RTN","IBNCPDP4",103,0) I IBLOCK2 L -^IBT(356,IBTRKRN) "RTN","IBNCPDP4",104,0) ; "RTN","IBNCPDP4",105,0) S IBRES=1 "RTN","IBNCPDP4",106,0) RELQ ; "RTN","IBNCPDP4",107,0) D LOG^IBNCPDP2("RELEASE",IBRES) "RTN","IBNCPDP4",108,0) I IBLOCK L -^DGCR(399,"AG",IBD("BCID")) "RTN","IBNCPDP4",109,0) Q IBRES "RTN","IBNCPDP4",110,0) ; "RTN","IBNCPDP4",111,0) SUBMIT(DFN,IBD) ; "RTN","IBNCPDP4",112,0) N IBRES,IBLOCK,IBADT,IBRXN,IBFIL,IBRDT,IBNBR,IBFLAG,IBTRKR,IBTRKRN "RTN","IBNCPDP4",113,0) N IBRESP,DA,DIE,DR,IBUSR "RTN","IBNCPDP4",114,0) S IBLOCK=0 "RTN","IBNCPDP4",115,0) I 'DFN S IBRES="0^No patient" G SUBQ "RTN","IBNCPDP4",116,0) S IBADT=+$G(IBD("FILL DATE")) I 'IBADT S IBRES="0^No fill date" G SUBQ "RTN","IBNCPDP4",117,0) S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBRES="0^No Rx IEN" G SUBQ "RTN","IBNCPDP4",118,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBRES="0^No fill number" G SUBQ "RTN","IBNCPDP4",119,0) S IBRESP=$G(IBD("RESPONSE")) I IBRESP="" S IBRES="0^No response from the payer" G SUBQ "RTN","IBNCPDP4",120,0) S IBRDT=+$G(IBD("RELEASE DATE"),-1) "RTN","IBNCPDP4",121,0) I '$L($G(IBD("CLAIMID"))) S IBRES="0^Missing ECME Number" G SUBQ "RTN","IBNCPDP4",122,0) S IBD("BCID")=$$BCID(IBD("CLAIMID"),IBADT) "RTN","IBNCPDP4",123,0) S IBUSR=$S(+$G(IBD("USER"))=0:DUZ,1:IBD("USER")) "RTN","IBNCPDP4",124,0) L +^DGCR(399,"AG",IBD("BCID")):5 S IBLOCK=$T "RTN","IBNCPDP4",125,0) ; "RTN","IBNCPDP4",126,0) ; -- claims tracking info "RTN","IBNCPDP4",127,0) S IBTRKR=$G(^IBE(350.9,1,6)) "RTN","IBNCPDP4",128,0) ; date can't be before parameters "RTN","IBNCPDP4",129,0) S $P(IBTRKR,"^")=$S('$P(IBTRKR,"^",4):0,+IBTRKR&(IBADT<+IBTRKR):0,1:IBADT) "RTN","IBNCPDP4",130,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) "RTN","IBNCPDP4",131,0) ; "RTN","IBNCPDP4",132,0) ; If the Rx is not released - set NBR in CT "RTN","IBNCPDP4",133,0) I 'IBRDT,'$P($G(^IBT(356,IBTRKRN,0)),U,19) D NONBR^IBNCPNB(DFN,IBRXN,IBFIL,IBADT,"PRESCRIPTION NOT RELEASED","","","",IBUSR) "RTN","IBNCPDP4",134,0) ; "RTN","IBNCPDP4",135,0) ; If the Rx is released - clean up NBR in CT "RTN","IBNCPDP4",136,0) I IBRDT,$P($G(^IBE(356.8,+$P($G(^IBT(356,IBTRKRN,0)),U,19),0)),U)="PRESCRIPTION NOT RELEASED" D NONBR^IBNCPNB(DFN,IBRXN,IBFIL,IBADT,"","","","",IBUSR) "RTN","IBNCPDP4",137,0) ; Set ECME fields in CT "RTN","IBNCPDP4",138,0) S DIE="^IBT(356,",DA=IBTRKRN "RTN","IBNCPDP4",139,0) S IBFLAG=$S(IBRESP["REJECT":1,1:0) "RTN","IBNCPDP4",140,0) S DR="1.1///"_IBD("CLAIMID")_";1.11///"_IBFLAG "RTN","IBNCPDP4",141,0) D ^DIE "RTN","IBNCPDP4",142,0) S IBRES=1 "RTN","IBNCPDP4",143,0) SUBQ ; "RTN","IBNCPDP4",144,0) D LOG^IBNCPDP2("SUBMIT",IBRES) "RTN","IBNCPDP4",145,0) I IBLOCK L -^DGCR(399,"AG",IBD("BCID")) "RTN","IBNCPDP4",146,0) Q IBRES "RTN","IBNCPDP4",147,0) ; "RTN","IBNCPDP4",148,0) ; "RTN","IBNCPDP4",149,0) REOPEN(DFN,IBD) ; "RTN","IBNCPDP4",150,0) N IBRES,IBADT,IBRXN,IBFIL,IBRDT,IBLOCK,IBLOCK2,IBTRKRN "RTN","IBNCPDP4",151,0) N IBEABD,IBNBR,DA,DIE,DR,IBUSR,IBEABD "RTN","IBNCPDP4",152,0) S (IBLOCK,IBLOCK2)=0 "RTN","IBNCPDP4",153,0) I 'DFN S IBRES="0^No patient" G REOPQ "RTN","IBNCPDP4",154,0) S IBADT=+$G(IBD("FILL DATE")) I 'IBADT S IBRES="0^No fill date" G REOPQ "RTN","IBNCPDP4",155,0) S IBRXN=+$G(IBD("PRESCRIPTION")) I 'IBRXN S IBRES="0^No Rx IEN" G REOPQ "RTN","IBNCPDP4",156,0) S IBFIL=+$G(IBD("FILL NUMBER"),-1) I IBFIL<0 S IBRES="0^No fill number" G REOPQ "RTN","IBNCPDP4",157,0) I '$L($G(IBD("CLAIMID"))) S IBRES="0^Missing ECME Number" G REOPQ "RTN","IBNCPDP4",158,0) S IBRDT=$$RXRLDT^PSOBPSUT(IBRXN,IBFIL) ; release date (if null is returned then Rx is not released) "RTN","IBNCPDP4",159,0) S IBD("BCID")=$$BCID(IBD("CLAIMID"),IBADT) "RTN","IBNCPDP4",160,0) S IBUSR=$S(+$G(IBD("USER"))=0:DUZ,1:IBD("USER")) "RTN","IBNCPDP4",161,0) L +^DGCR(399,"AG",IBD("BCID")):5 S IBLOCK=$T "RTN","IBNCPDP4",162,0) ; "RTN","IBNCPDP4",163,0) ; re-opening secondary claims should not affect CT - esg 7/9/10 "RTN","IBNCPDP4",164,0) I $G(IBD("RXCOB"))>1 S IBRES=1 G REOPQ "RTN","IBNCPDP4",165,0) ; "RTN","IBNCPDP4",166,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",IBRXN,IBFIL,0)) ;get the claim entry associated with the Rx fill (or refill) "RTN","IBNCPDP4",167,0) L +^IBT(356,IBTRKRN):5 S IBLOCK2=$T "RTN","IBNCPDP4",168,0) S DIE="^IBT(356,",DA=IBTRKRN "RTN","IBNCPDP4",169,0) ; "RTN","IBNCPDP4",170,0) I IBRDT D ; if Rx released assign earliest autobill date "RTN","IBNCPDP4",171,0) . S IBEABD=$$EABD^IBTUTL($O(^IBE(356.6,"AC",4,0)),IBADT) "RTN","IBNCPDP4",172,0) . S:'IBEABD IBEABD=DT "RTN","IBNCPDP4",173,0) . S IBEABD=$$FMADD^XLFDT(IBEABD,60) "RTN","IBNCPDP4",174,0) ; "RTN","IBNCPDP4",175,0) N IBFDA "RTN","IBNCPDP4",176,0) S IBFDA(356,IBTRKRN_",",.19)=$S('IBRDT:$O(^IBE(356.8,"B","PRESCRIPTION NOT RELEASED","")),1:"@") ;non-billable reason "RTN","IBNCPDP4",177,0) D FILE^DIE("","IBFDA"),MSG^DIALOG() "RTN","IBNCPDP4",178,0) K IBFDA "RTN","IBNCPDP4",179,0) S IBFDA(356,IBTRKRN_",",.17)=$S('IBRDT:"@",1:IBEABD) ; earliest autobill date "RTN","IBNCPDP4",180,0) S IBFDA(356,IBTRKRN_",",1.08)="@" ;additional comments "RTN","IBNCPDP4",181,0) S IBFDA(356,IBTRKRN_",",1.11)=0 ; reject flag - reset to "no" "RTN","IBNCPDP4",182,0) S IBFDA(356,IBTRKRN_",",1.03)=DT ; date last edited "RTN","IBNCPDP4",183,0) S IBFDA(356,IBTRKRN_",",1.04)=IBUSR ; last edited by "RTN","IBNCPDP4",184,0) D FILE^DIE("","IBFDA"),MSG^DIALOG() "RTN","IBNCPDP4",185,0) ; "RTN","IBNCPDP4",186,0) S IBRES=1 "RTN","IBNCPDP4",187,0) REOPQ ; "RTN","IBNCPDP4",188,0) D LOG^IBNCPDP2("REOPEN",IBRES) "RTN","IBNCPDP4",189,0) I IBLOCK L -^DGCR(399,"AG",IBD("BCID")) "RTN","IBNCPDP4",190,0) I IBLOCK2 L -^IBT(356,IBTRKRN) "RTN","IBNCPDP4",191,0) Q IBRES "RTN","IBNCPDP4",192,0) ; "RTN","IBNCPDP4",193,0) BCID(BCID,IBADT) ; build BCID "RTN","IBNCPDP4",194,0) Q BCID_";"_IBADT "RTN","IBNCPDPC") 0^30^B4153613 "RTN","IBNCPDPC",1,0) IBNCPDPC ;DALOI/SS - CLAIMS TRACKING EDITOR for ECME ;3/6/08 16:17 "RTN","IBNCPDPC",2,0) ;;2.0;INTEGRATED BILLING;**276,339,363,384,435**;21-MAR-94;Build 27 "RTN","IBNCPDPC",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDPC",4,0) ; "RTN","IBNCPDPC",5,0) CT(IBRXIEN,IBRXFIL) ; look up CT entry and call CT listman "RTN","IBNCPDPC",6,0) ; entry point for DBIA# 4693 "RTN","IBNCPDPC",7,0) ; Input: IBRXIEN - internal Rx ien "RTN","IBNCPDPC",8,0) ; IBRXFIL - fill# "RTN","IBNCPDPC",9,0) ; "RTN","IBNCPDPC",10,0) N IBTRN,DFN "RTN","IBNCPDPC",11,0) S IBTRN=+$O(^IBT(356,"ARXFL",+$G(IBRXIEN),+$G(IBRXFIL),0)) "RTN","IBNCPDPC",12,0) I 'IBTRN D Q "RTN","IBNCPDPC",13,0) . W !,"There is no Claims Tracking record for this prescription/fill." "RTN","IBNCPDPC",14,0) . D PAUSE^VALM1 "RTN","IBNCPDPC",15,0) . Q "RTN","IBNCPDPC",16,0) ; "RTN","IBNCPDPC",17,0) S DFN=+$P($G(^IBT(356,IBTRN,0)),U,2) "RTN","IBNCPDPC",18,0) D EN^VALM("IBNCPDP LSTMN CT") "RTN","IBNCPDPC",19,0) Q "RTN","IBNCPDPC",20,0) ; "RTN","IBNCPDPC",21,0) EN ; -- main entry point for IBT EXPAND/EDIT TRACKING "RTN","IBNCPDPC",22,0) D EN^IBTRED "RTN","IBNCPDPC",23,0) Q "RTN","IBNCPDPC",24,0) ; "RTN","IBNCPDPC",25,0) INIT ; -- init variables and list array "RTN","IBNCPDPC",26,0) D INIT^IBTRED "RTN","IBNCPDPC",27,0) Q "RTN","IBNCPDPC",28,0) ; "RTN","IBNCPDPC",29,0) HELP ; -- help code "RTN","IBNCPDPC",30,0) D HELP^IBTRED "RTN","IBNCPDPC",31,0) Q "RTN","IBNCPDPC",32,0) ; "RTN","IBNCPDPC",33,0) EXIT ; -- exit code "RTN","IBNCPDPC",34,0) D EXIT^IBTRED "RTN","IBNCPDPC",35,0) Q "RTN","IBNCPDPC",36,0) ; "RTN","IBNCPDPC",37,0) BLANK(LINE) ; -- Build blank line "RTN","IBNCPDPC",38,0) D BLANK^IBTRED(.LINE) "RTN","IBNCPDPC",39,0) Q "RTN","IBNCPDPC",40,0) ; "RTN","IBNCPDPC",41,0) ETYP(IBTRN) ; -- Expand type of epidose and date "RTN","IBNCPDPC",42,0) Q $$ETYP^IBTRED(IBTRN) "RTN","IBNCPDPC",43,0) ; "RTN","IBNCPDPC",44,0) ENCL(IBOE) ; -- output format of classifications "RTN","IBNCPDPC",45,0) Q $$ENCL^IBTRED(IBOE) "RTN","IBNCPDPC",46,0) ; "RTN","IBNCPDPC",47,0) PSOCPVW(IBDFN,IBRX,PSOTMP) ; return RX info "RTN","IBNCPDPC",48,0) ; IBDFN - patient's DFN "RTN","IBNCPDPC",49,0) ; IBRX - ien in #52 "RTN","IBNCPDPC",50,0) ; output in .PSOTMP array "RTN","IBNCPDPC",51,0) ; "RTN","IBNCPDPC",52,0) Q:($G(IBDFN)=0)!($G(IBRX)=0) "RTN","IBNCPDPC",53,0) K ^TMP($J,"IBNCPDP-RXINFO") "RTN","IBNCPDPC",54,0) D RX^PSO52API(IBDFN,"IBNCPDP-RXINFO",IBRX,"",0) "RTN","IBNCPDPC",55,0) S PSOTMP(52,+$P(IBTRND,"^",8),.01,"E")=$G(^TMP($J,"IBNCPDP-RXINFO",IBDFN,IBRX,.01)) "RTN","IBNCPDPC",56,0) S PSOTMP(52,+$P(IBTRND,"^",8),7,"E")=$G(^TMP($J,"IBNCPDP-RXINFO",IBDFN,IBRX,7)) "RTN","IBNCPDPC",57,0) S PSOTMP(52,+$P(IBTRND,"^",8),8,"E")=$G(^TMP($J,"IBNCPDP-RXINFO",IBDFN,IBRX,8)) "RTN","IBNCPDPC",58,0) S PSOTMP(52,+$P(IBTRND,"^",8),6,"E")=$P($G(^TMP($J,"IBNCPDP-RXINFO",IBDFN,IBRX,6)),U,2) "RTN","IBNCPDPC",59,0) K ^TMP($J,"IBNCPDP-RXINFO") "RTN","IBNCPDPC",60,0) Q "RTN","IBNCPDPC",61,0) ; "RTN","IBNCPDPE") 0^23^B17708957 "RTN","IBNCPDPE",1,0) IBNCPDPE ;DALOI/AAT - NCPDP BILLING EVENTS REPORT ;3/6/08 16:18 "RTN","IBNCPDPE",2,0) ;;2.0;INTEGRATED BILLING;**276,342,347,363,384,435**;21-MAR-94;Build 27 "RTN","IBNCPDPE",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDPE",4,0) ; "RTN","IBNCPDPE",5,0) ; Reference to $$MULTPHRM^BPSUTIL supported by IA# 4146 "RTN","IBNCPDPE",6,0) ; Reference to DIC^PSODI supported by IA# 4858 "RTN","IBNCPDPE",7,0) ; "RTN","IBNCPDPE",8,0) DATE ; "RTN","IBNCPDPE",9,0) S (IBBDT,IBEDT)=DT "RTN","IBNCPDPE",10,0) S %DT="AEX" "RTN","IBNCPDPE",11,0) S %DT("A")="START WITH DATE: ",%DT("B")="TODAY" "RTN","IBNCPDPE",12,0) D ^%DT K %DT "RTN","IBNCPDPE",13,0) I Y<0 S IBQ=1 Q "RTN","IBNCPDPE",14,0) S IBBDT=+Y "RTN","IBNCPDPE",15,0) S %DT="AEX" "RTN","IBNCPDPE",16,0) S %DT("A")="GO TO DATE: ",%DT("B")="TODAY" "RTN","IBNCPDPE",17,0) D ^%DT K %DT "RTN","IBNCPDPE",18,0) I Y<0 S IBQ=1 Q "RTN","IBNCPDPE",19,0) S IBEDT=+Y "RTN","IBNCPDPE",20,0) Q "RTN","IBNCPDPE",21,0) ; "RTN","IBNCPDPE",22,0) MODE ; "RTN","IBNCPDPE",23,0) N DIR,DIC,DIRUT,DUOUT,PSOFILE "RTN","IBNCPDPE",24,0) S (IBM1,IBM2,IBM3)="A" "RTN","IBNCPDPE",25,0) S DIR(0)="S^P:SINGLE PATIENT;R:SINGLE RX;E:SINGLE ECME #;A:ALL ACTIVITY" "RTN","IBNCPDPE",26,0) S DIR("A")="SINGLE (P)ATIENT, SINGLE (R)X, SINGLE (E)CME #, (A)LL ACTIVITY" "RTN","IBNCPDPE",27,0) S DIR("B")="ALL" "RTN","IBNCPDPE",28,0) D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q "RTN","IBNCPDPE",29,0) S IBM1=Y "RTN","IBNCPDPE",30,0) I IBM1="P" S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC Q:$D(DUOUT) S IBPAT=$S(Y>0:+Y,1:0) I 'IBPAT W " ALL" S IBM1="A" "RTN","IBNCPDPE",31,0) I IBM1="R" S PSOFILE=52,DIC="^PSRX(",DIC(0)="AEQMN" D DIC^PSODI(PSOFILE,.DIC) Q:$D(DUOUT) S IBRX=$S(Y>0:+Y,1:0) I 'IBRX W " ALL" S IBM1="A" "RTN","IBNCPDPE",32,0) K PSODIY "RTN","IBNCPDPE",33,0) I IBM1="E" S DIR(0)="FO^1:12^I X'?1.12N W !!,""Cannot contain alpha characters"" K X",DIR("A")="Enter ECME #" D ^DIR Q:$D(DUOUT) S IBECME=$S(+Y>0:Y,1:0) I 'IBECME W " ALL" S IBM1="A" "RTN","IBNCPDPE",34,0) S IBM2="B" "RTN","IBNCPDPE",35,0) ; if "All" "RTN","IBNCPDPE",36,0) I IBM1="A" D Q:$G(IBQ) "RTN","IBNCPDPE",37,0) .S DIR(0)="S^E:ECME BILLABLE;N:NON ECME BILLABLE;B:BOTH" "RTN","IBNCPDPE",38,0) .S DIR("A")="(E)CME BILLABLE;(N)ON ECME BILLABLE;(B)OTH" "RTN","IBNCPDPE",39,0) .S DIR("B")="BOTH" "RTN","IBNCPDPE",40,0) .D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q "RTN","IBNCPDPE",41,0) .S IBM2=Y "RTN","IBNCPDPE",42,0) ; "RTN","IBNCPDPE",43,0) ;Mail/Window/CMOP? "RTN","IBNCPDPE",44,0) S DIR(0)="S^M:MAIL;W:WINDOW;C:CMOP;A:ALL" "RTN","IBNCPDPE",45,0) S DIR("A")="(M)AIL, (W)INDOW, (C)CMOP, (A)LL" "RTN","IBNCPDPE",46,0) S DIR("B")="ALL" "RTN","IBNCPDPE",47,0) D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q "RTN","IBNCPDPE",48,0) S IBM3=Y "RTN","IBNCPDPE",49,0) ; "RTN","IBNCPDPE",50,0) S DIR(0)="S^S:SUMMARY REPORT;D:DETAILED REPORT" "RTN","IBNCPDPE",51,0) S DIR("A")="(S)UMMARY REPORT, (D)ETAILED REPORT" "RTN","IBNCPDPE",52,0) S DIR("B")="SUMMARY REPORT" "RTN","IBNCPDPE",53,0) D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q "RTN","IBNCPDPE",54,0) S IBDTL=($E(Y)="D") "RTN","IBNCPDPE",55,0) Q "RTN","IBNCPDPE",56,0) ; "RTN","IBNCPDPE",57,0) TESTDATA() ; "RTN","IBNCPDPE",58,0) N Y "RTN","IBNCPDPE",59,0) S Y=$$HAVEDATA() "RTN","IBNCPDPE",60,0) I 'Y W !!,"No data found in the specified period.",! "RTN","IBNCPDPE",61,0) Q Y "RTN","IBNCPDPE",62,0) ; "RTN","IBNCPDPE",63,0) HAVEDATA() ; "RTN","IBNCPDPE",64,0) N Z "RTN","IBNCPDPE",65,0) I $D(^IBCNR(366.14,"B",IBBDT)) Q 1 "RTN","IBNCPDPE",66,0) S Z=+$O(^IBCNR(366.14,"B",IBBDT)) "RTN","IBNCPDPE",67,0) I Z=0 Q 0 "RTN","IBNCPDPE",68,0) I Z>IBEDT Q 0 "RTN","IBNCPDPE",69,0) Q 1 "RTN","IBNCPDPE",70,0) ; "RTN","IBNCPDPE",71,0) DEVICE ; "RTN","IBNCPDPE",72,0) N DIR,DIRUT,POP,ZTRTN,ZTIO,ZTSAVE,ZTDESC,%ZIS,ZTSK "RTN","IBNCPDPE",73,0) S %ZIS="QM" "RTN","IBNCPDPE",74,0) W ! D ^%ZIS "RTN","IBNCPDPE",75,0) I POP S IBQ=1 Q "RTN","IBNCPDPE",76,0) S IBSCR=$S($E($G(IOST),1,2)="C-":1,1:0) "RTN","IBNCPDPE",77,0) ; "RTN","IBNCPDPE",78,0) I $D(IO("Q")) D S IBQ=1 "RTN","IBNCPDPE",79,0) . S ZTRTN="START^IBNCPEV" "RTN","IBNCPDPE",80,0) . S ZTIO=ION "RTN","IBNCPDPE",81,0) . S ZTSAVE("IB*")="" "RTN","IBNCPDPE",82,0) . S ZTDESC="IB ECME BILLING EVENTS REPORT" "RTN","IBNCPDPE",83,0) . D ^%ZTLOAD "RTN","IBNCPDPE",84,0) . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") "RTN","IBNCPDPE",85,0) . D HOME^%ZIS "RTN","IBNCPDPE",86,0) U IO "RTN","IBNCPDPE",87,0) Q "RTN","IBNCPDPE",88,0) ;------ added for the User screen -------- "RTN","IBNCPDPE",89,0) ;User Screen Entry point (to call from ECME User Screen) "RTN","IBNCPDPE",90,0) ;IBMODE: "RTN","IBNCPDPE",91,0) ; P-patient "RTN","IBNCPDPE",92,0) ; R-Rx "RTN","IBNCPDPE",93,0) ;IBVAL - patient DFN or RX ien (#52) "RTN","IBNCPDPE",94,0) ; "RTN","IBNCPDPE",95,0) USRSCREN(IBMODE,IBVAL) ; "RTN","IBNCPDPE",96,0) N IBPAT,IBRX,IBBDT,IBEDT,Y,IBM1,IBM2,IBM3,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS "RTN","IBNCPDPE",97,0) S (IBPAT,IBRX,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS)=0 "RTN","IBNCPDPE",98,0) S IBM1=IBMODE "RTN","IBNCPDPE",99,0) I IBM1="P" S IBPAT=+IBVAL "RTN","IBNCPDPE",100,0) I IBM1="R" S IBRX=+IBVAL "RTN","IBNCPDPE",101,0) ;date "RTN","IBNCPDPE",102,0) F D DATE Q:IBQ Q:$$TESTDATA "RTN","IBNCPDPE",103,0) Q:IBQ "RTN","IBNCPDPE",104,0) N IBMLTDV S IBMLTDV=$$MULTPHRM^BPSUTIL() "RTN","IBNCPDPE",105,0) I +IBMLTDV=1 S IBDIVS=+$$MULTIDIV^IBNCPEV1(.IBDIVS) S:IBDIVS=0 IBDIVS(0)="0^ALL" I IBDIVS=-1 S IBQ=1 Q "RTN","IBNCPDPE",106,0) I +IBMLTDV=0 S IBDIVS=0,IBDIVS(0)="0^"_$P(IBMLTDV,U,2) "RTN","IBNCPDPE",107,0) D MODE2 Q:IBQ "RTN","IBNCPDPE",108,0) D DEVICE Q:IBQ "RTN","IBNCPDPE",109,0) D START^IBNCPEV "RTN","IBNCPDPE",110,0) D ^%ZISC "RTN","IBNCPDPE",111,0) I IBQ W !,"Cancelled" "RTN","IBNCPDPE",112,0) Q "RTN","IBNCPDPE",113,0) ; "RTN","IBNCPDPE",114,0) MODE2 ; "RTN","IBNCPDPE",115,0) N DIR,DIC,DIRUT,DUOUT "RTN","IBNCPDPE",116,0) S (IBM1,IBM2,IBM3)="A" "RTN","IBNCPDPE",117,0) S IBM2="B" "RTN","IBNCPDPE",118,0) ; "RTN","IBNCPDPE",119,0) ;Mail/Window/CMOP? "RTN","IBNCPDPE",120,0) S DIR(0)="S^M:MAIL;W:WINDOW;C:CMOP;A:ALL" "RTN","IBNCPDPE",121,0) S DIR("A")="(M)AIL, (W)INDOW, (C)CMOP, (A)LL" "RTN","IBNCPDPE",122,0) S DIR("B")="ALL" "RTN","IBNCPDPE",123,0) D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q "RTN","IBNCPDPE",124,0) S IBM3=Y "RTN","IBNCPDPE",125,0) ; "RTN","IBNCPDPE",126,0) S DIR(0)="S^S:SUMMARY REPORT;D:DETAILED REPORT" "RTN","IBNCPDPE",127,0) S DIR("A")="(S)UMMARY REPORT, (D)ETAILED REPORT" "RTN","IBNCPDPE",128,0) S DIR("B")="SUMMARY REPORT" "RTN","IBNCPDPE",129,0) D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q "RTN","IBNCPDPE",130,0) S IBDTL=($E(Y)="D") "RTN","IBNCPDPE",131,0) Q "RTN","IBNCPDPE",132,0) ;IBNCPDPE "RTN","IBNCPDPI") 0^26^B13081373 "RTN","IBNCPDPI",1,0) IBNCPDPI ;DALOI/SS - ECME SCREEN INSURANCE VIEW AND UTILITIES ;3/6/08 16:21 "RTN","IBNCPDPI",2,0) ;;2.0;INTEGRATED BILLING;**276,383,384,411,435**;21-MAR-94;Build 27 "RTN","IBNCPDPI",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDPI",4,0) ; "RTN","IBNCPDPI",5,0) ; "RTN","IBNCPDPI",6,0) EN1(DFN) ; "RTN","IBNCPDPI",7,0) I $G(DFN)'>0 Q "RTN","IBNCPDPI",8,0) N J,POP,START,X,VA,ALMBG,DIC,DT,C,CTRLCOL,DILN "RTN","IBNCPDPI",9,0) ; "RTN","IBNCPDPI",10,0) ;if the user does have IB keys to edit insurances "RTN","IBNCPDPI",11,0) I $D(^XUSEC("IB INSURANCE SUPERVISOR",DUZ))!($D(^XUSEC("IB INSURANCE COMPANY ADD",DUZ))) D Q "RTN","IBNCPDPI",12,0) . N D1,DA,DDER,DDH,DIE,DR,I "RTN","IBNCPDPI",13,0) . N IBCH,IBCNS,IBCNSEH,IBCNT,IBCPOL,IBDT,IBDUZ,IBFILE,IBLCNT,IBN,IBNEW,IBPPOL "RTN","IBNCPDPI",14,0) . N IBTYP,IBYE,IBCDFN,IBCDFND1,IBCGN "RTN","IBNCPDPI",15,0) . D EN^VALM("IBNCPDP INSURANCE MANAGEMENT") "RTN","IBNCPDPI",16,0) ;if the user doesn't have insurance IB keys "RTN","IBNCPDPI",17,0) D "RTN","IBNCPDPI",18,0) . N D0,IBCAB,IBCDFN,IBCDFND1,IBCNS,IBCNT,IBCPOL,IBDT,IBEXP1 "RTN","IBNCPDPI",19,0) . N IBEXP2,IBFILE,IBLCNT,IBN,IBPPOL "RTN","IBNCPDPI",20,0) . D EN1^IBNCPDPV(DFN) "RTN","IBNCPDPI",21,0) Q "RTN","IBNCPDPI",22,0) ; "RTN","IBNCPDPI",23,0) INIT ; -- set up initial variables "RTN","IBNCPDPI",24,0) ;DFN should be defined "RTN","IBNCPDPI",25,0) I '$D(DFN) Q "RTN","IBNCPDPI",26,0) S U="^",VALMCNT=0,VALMBG=1 "RTN","IBNCPDPI",27,0) K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J) "RTN","IBNCPDPI",28,0) S IBTYP="P" "RTN","IBNCPDPI",29,0) D BLD^IBCNSM "RTN","IBNCPDPI",30,0) Q "RTN","IBNCPDPI",31,0) ; "RTN","IBNCPDPI",32,0) HDR ; -- screen header for initial screen "RTN","IBNCPDPI",33,0) D HDR^IBCNSM "RTN","IBNCPDPI",34,0) Q "RTN","IBNCPDPI",35,0) ; "RTN","IBNCPDPI",36,0) HELP ; -- help code "RTN","IBNCPDPI",37,0) Q "RTN","IBNCPDPI",38,0) ; "RTN","IBNCPDPI",39,0) EXIT ; -- exit code "RTN","IBNCPDPI",40,0) Q "RTN","IBNCPDPI",41,0) ; "RTN","IBNCPDPI",42,0) EXPND ; -- expand code "RTN","IBNCPDPI",43,0) Q "RTN","IBNCPDPI",44,0) ; "RTN","IBNCPDPI",45,0) SELINSUR(PRMTMSG,DFLTVAL) ; "RTN","IBNCPDPI",46,0) ;API for ECME (DBIA #4721) "RTN","IBNCPDPI",47,0) ;Insurance Company lookup API "RTN","IBNCPDPI",48,0) ;input: "RTN","IBNCPDPI",49,0) ; PRMTMSG - prompt message "RTN","IBNCPDPI",50,0) ; DFLTVAL - INSURANCE NAME as a default value for the prompt (optional) "RTN","IBNCPDPI",51,0) ;output: "RTN","IBNCPDPI",52,0) ; IEN^INSURANCE_NAME "RTN","IBNCPDPI",53,0) ; 0^ means ALL selected "RTN","IBNCPDPI",54,0) ; -1^ nothing was selected, timeout expired or uparrow entered "RTN","IBNCPDPI",55,0) ; where: IEN is record number in file #36. "RTN","IBNCPDPI",56,0) ; "RTN","IBNCPDPI",57,0) N Y,DUOUT,DTOUT,IBQUIT,DIROUT "RTN","IBNCPDPI",58,0) S IBQUIT=0 "RTN","IBNCPDPI",59,0) N DIC "RTN","IBNCPDPI",60,0) S DIC="^DIC(36," "RTN","IBNCPDPI",61,0) S DIC(0)="AEMNQ" "RTN","IBNCPDPI",62,0) S:$L($G(DFLTVAL))>0 DIC("B")=DFLTVAL "RTN","IBNCPDPI",63,0) S DIC("A")=PRMTMSG_": " "RTN","IBNCPDPI",64,0) D ^DIC "RTN","IBNCPDPI",65,0) I (Y=-1)!$D(DUOUT)!$D(DTOUT) S IBQUIT=1 "RTN","IBNCPDPI",66,0) I IBQUIT=1 Q "-1^" "RTN","IBNCPDPI",67,0) Q Y "RTN","IBNCPDPI",68,0) ; "RTN","IBNCPDPI",69,0) RNB(IBRX,IBFL) ; Return the Claims Tracking Reason Not Billable for a Prescription "RTN","IBNCPDPI",70,0) ; API for ECME (DBIA #4729) "RTN","IBNCPDPI",71,0) ; Input: IBRX - prescription ien (required) "RTN","IBNCPDPI",72,0) ; IBFL - fill# (required) "RTN","IBNCPDPI",73,0) ; Output: function value "RTN","IBNCPDPI",74,0) ; [1] RNB ien (ptr to file# 356.8) "RTN","IBNCPDPI",75,0) ; [2] RNB description "RTN","IBNCPDPI",76,0) ; [3] RNB ECME flag "RTN","IBNCPDPI",77,0) ; [4] RNB ECME paper flag "RTN","IBNCPDPI",78,0) ; [5] RNB code "RTN","IBNCPDPI",79,0) ; [6] RNB active/inactive flag "RTN","IBNCPDPI",80,0) ; or 0 if no CT entry or if CT entry is billable "RTN","IBNCPDPI",81,0) ; "RTN","IBNCPDPI",82,0) N RNB,IBTRKRN "RTN","IBNCPDPI",83,0) S RNB=0 "RTN","IBNCPDPI",84,0) S IBTRKRN=+$O(^IBT(356,"ARXFL",+$G(IBRX),+$G(IBFL),0)) I 'IBTRKRN G RNBX "RTN","IBNCPDPI",85,0) S RNB=+$P($G(^IBT(356,IBTRKRN,0)),U,19) I 'RNB G RNBX "RTN","IBNCPDPI",86,0) S RNB=RNB_U_$G(^IBE(356.8,RNB,0)) "RTN","IBNCPDPI",87,0) RNBX ; "RTN","IBNCPDPI",88,0) Q RNB "RTN","IBNCPDPI",89,0) ; "RTN","IBNCPDPI",90,0) BILLINFO(IBRX,IBREF,IBPSEQ) ; "RTN","IBNCPDPI",91,0) ;API for ECME (DBIA #4729) "RTN","IBNCPDPI",92,0) ;Determine Bill# and Account Receivable information about the bill "RTN","IBNCPDPI",93,0) ;input: "RTN","IBNCPDPI",94,0) ; IBRX - pointer to file #52 (internal prescription number) "RTN","IBNCPDPI",95,0) ; IBREF - re-fill number "RTN","IBNCPDPI",96,0) ; IBPSEQ - payer sequence "RTN","IBNCPDPI",97,0) ;output: "RTN","IBNCPDPI",98,0) ;Returns a string of information about the bill requested: "RTN","IBNCPDPI",99,0) ; piece #1: Bill number (field(#.01) of file (#399)) "RTN","IBNCPDPI",100,0) ; piece #2: Original Amount of bill "RTN","IBNCPDPI",101,0) ; piece #3: Current Status (pointer to file #430.3) "RTN","IBNCPDPI",102,0) ; piece #4: Current Balance "RTN","IBNCPDPI",103,0) ; piece #5: Total Collected "RTN","IBNCPDPI",104,0) ; piece #6: % Collected Returns null if no data or bill found. "RTN","IBNCPDPI",105,0) ; "RTN","IBNCPDPI",106,0) N IBIEN,IBBNUM,RCRET,IBRETV,IBARR,IBZ "RTN","IBNCPDPI",107,0) I +$G(IBPSEQ)=0 S IBPSEQ=1 "RTN","IBNCPDPI",108,0) S RCRET="",IBRETV="",IBIEN="" "RTN","IBNCPDPI",109,0) I IBPSEQ=1 S IBBNUM=$$BILL^IBNCPDPU(IBRX,IBREF) ;get from the CT record "RTN","IBNCPDPI",110,0) ;find secondary bill, return null if none "RTN","IBNCPDPI",111,0) I IBPSEQ=2 S IBZ=$$RXBILL^IBNCPUT3(IBRX,IBREF,"S",,.IBARR) D Q:+IBIEN=0 "^" S IBBNUM=$P($G(IBARR(IBIEN)),U) "RTN","IBNCPDPI",112,0) . S IBIEN=$P(IBZ,U,2) Q:+IBIEN>0 "RTN","IBNCPDPI",113,0) . ;if there is no active bill then get the latest bill with whatever status "RTN","IBNCPDPI",114,0) . S IBIEN=$O(IBARR(999999999),-1) "RTN","IBNCPDPI",115,0) I IBBNUM]"" D "RTN","IBNCPDPI",116,0) .I IBIEN="" S IBIEN=$O(^DGCR(399,"B",IBBNUM,"")) Q:IBIEN="" "RTN","IBNCPDPI",117,0) .S RCRET=$$BILL^RCJIBFN2(IBIEN) "RTN","IBNCPDPI",118,0) S IBRETV=IBBNUM_U_RCRET "RTN","IBNCPDPI",119,0) Q IBRETV "RTN","IBNCPDPI",120,0) ; "RTN","IBNCPDPI",121,0) ; "RTN","IBNCPDPI",122,0) TPJI(DFN) ; entry point for TPJI option of the ECME User Screen "RTN","IBNCPDPI",123,0) I DFN>0 D EN^IBJTLA "RTN","IBNCPDPI",124,0) Q "RTN","IBNCPDPI",125,0) ; "RTN","IBNCPDPI",126,0) INSNM(IBINSIEN) ; api to return insurance company name "RTN","IBNCPDPI",127,0) Q $P($G(^DIC(36,+$G(IBINSIEN),0)),"^") "RTN","IBNCPDPI",128,0) ; "RTN","IBNCPDPI",129,0) ACPHONE() ; API to return the default Pay-to provider phone# "RTN","IBNCPDPI",130,0) Q $$PRVPHONE^IBJPS3() "RTN","IBNCPDPI",131,0) ; "RTN","IBNCPDPI",132,0) INSPL(IBPL) ; api to return the insurance company IEN from the plan "RTN","IBNCPDPI",133,0) ; passed in. "RTN","IBNCPDPI",134,0) Q $P($G(^IBA(355.3,+$G(IBPL),0)),"^") "RTN","IBNCPDPI",135,0) ; "RTN","IBNCPDPI",136,0) MXTRNS(IBPLID) ; api to return MAXIMUM NCPDP TRANSACTIONS for a plan "RTN","IBNCPDPI",137,0) ; Input: IBPLID = ID from the PLAN file. "RTN","IBNCPDPI",138,0) ; Returns: Numeric value from field 10.1 of Plan file "RTN","IBNCPDPI",139,0) ; Default's to 1 if undefined. "RTN","IBNCPDPI",140,0) Q:IBPLID="" 1 "RTN","IBNCPDPI",141,0) Q:$O(^IBCNR(366.03,"B",$G(IBPLID),0))']"" 1 "RTN","IBNCPDPI",142,0) Q $P($G(^IBCNR(366.03,$O(^IBCNR(366.03,"B",$G(IBPLID),0)),10)),"^",10) "RTN","IBNCPDPI",143,0) ; "RTN","IBNCPDPI",144,0) EPHON() ; API to return if ePharmacy is on within IB "RTN","IBNCPDPI",145,0) ; 1 FOR Active "RTN","IBNCPDPI",146,0) ; 0 FOR Not Active "RTN","IBNCPDPI",147,0) ; "RTN","IBNCPDPI",148,0) Q +$G(^IBE(350.9,1,11)) "RTN","IBNCPDPI",149,0) ; "RTN","IBNCPDPU") 0^20^B95492067 "RTN","IBNCPDPU",1,0) IBNCPDPU ;OAK/ELZ - UTILITIES FOR NCPCP ;5/22/08 15:24 "RTN","IBNCPDPU",2,0) ;;2.0;INTEGRATED BILLING;**223,276,347,383,405,384,437,435**;21-MAR-94;Build 27 "RTN","IBNCPDPU",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPDPU",4,0) ; "RTN","IBNCPDPU",5,0) ;Reference to ECMEACT^PSOBPSU1 supported by IA# 4702 "RTN","IBNCPDPU",6,0) ;Reference to $$EN^BPSNCPDP supported by IA# 4415 "RTN","IBNCPDPU",7,0) ;Reference to $$NABP^BPSBUTL supported by IA# 4719 "RTN","IBNCPDPU",8,0) ; "RTN","IBNCPDPU",9,0) ; "RTN","IBNCPDPU",10,0) CT(DFN,IBRXN,IBFIL,IBADT,IBRMARK) ; files in claims tracking "RTN","IBNCPDPU",11,0) ; Input: "RTN","IBNCPDPU",12,0) ; DFN - Patient IEN "RTN","IBNCPDPU",13,0) ; IBRXN - Rx IEN "RTN","IBNCPDPU",14,0) ; IBFIL - Fill# "RTN","IBNCPDPU",15,0) ; IBADT - Fill Date "RTN","IBNCPDPU",16,0) ; IBRMARK - Non-billable Reason (.01 from 356.8) "RTN","IBNCPDPU",17,0) ; "RTN","IBNCPDPU",18,0) N DIE,DR,DA,IBRXTYP,IBEABD "RTN","IBNCPDPU",19,0) ; Check that the Fill Date is current "RTN","IBNCPDPU",20,0) I IBTRKRN,$G(IBADT),($G(IBADT)'=$P(^IBT(356,IBTRKRN,0),U,6)) D "RTN","IBNCPDPU",21,0) . S DIE="^IBT(356,",DA=IBTRKRN,DR=".06////"_IBADT D ^DIE "RTN","IBNCPDPU",22,0) I IBTRKRN D:$D(IBRMARK) Q "RTN","IBNCPDPU",23,0) . S DIE="^IBT(356,",DA=IBTRKRN,DR=".19///"_IBRMARK "RTN","IBNCPDPU",24,0) . D ^DIE "RTN","IBNCPDPU",25,0) ; event type pointer for rx billing "RTN","IBNCPDPU",26,0) S IBRXTYP=$O(^IBE(356.6,"AC",4,0)) "RTN","IBNCPDPU",27,0) ; earliest auto-billing date "RTN","IBNCPDPU",28,0) S IBEABD=$$EABD^IBTUTL(IBRXTYP,$$FMADD^XLFDT(IBADT,60)) "RTN","IBNCPDPU",29,0) ; space out earliest auto bill date "RTN","IBNCPDPU",30,0) ; "RTN","IBNCPDPU",31,0) ; ROI check "RTN","IBNCPDPU",32,0) N IBSCROI,IBDRUG,IBDEA,IBRXDATA "RTN","IBNCPDPU",33,0) S IBRXDATA=$$RXZERO^IBRXUTL(DFN,IBRXN) "RTN","IBNCPDPU",34,0) S IBDRUG=$P(IBRXDATA,"^",6) "RTN","IBNCPDPU",35,0) D ZERO^IBRXUTL(IBDRUG) "RTN","IBNCPDPU",36,0) S IBDEA=$G(^TMP($J,"IBDRUG",+IBDRUG,3)) "RTN","IBNCPDPU",37,0) K ^TMP($J,"IBDRUG") "RTN","IBNCPDPU",38,0) I $G(IBDEA)["U" D "RTN","IBNCPDPU",39,0) . N IBINS,IBFLG,IBINSP "RTN","IBNCPDPU",40,0) . D ALL^IBCNS1(DFN,"IBINS",1,IBADT,1) "RTN","IBNCPDPU",41,0) . S IBINSP=$O(IBINS("S",1,99),-1) Q:IBINSP="" "RTN","IBNCPDPU",42,0) . S IBFLG=$$ROI^IBNCPDR4(DFN,$G(IBDRUG),+$G(IBINS(IBINSP,"0")),$G(IBADT)) "RTN","IBNCPDPU",43,0) . I 'IBFLG,$G(IBRMARK)="" S IBRMARK="REFUSES TO SIGN RELEASE (ROI)" "RTN","IBNCPDPU",44,0) . I 'IBFLG S IBSCROI=3 "RTN","IBNCPDPU",45,0) . I IBFLG S IBSCROI=2 "RTN","IBNCPDPU",46,0) ; "RTN","IBNCPDPU",47,0) D REFILL^IBTUTL1(DFN,IBRXTYP,IBADT,IBRXN,IBFIL,$G(IBRMARK),IBEABD,$G(IBSCROI)) "RTN","IBNCPDPU",48,0) Q "RTN","IBNCPDPU",49,0) ; "RTN","IBNCPDPU",50,0) ;NDC relocated to IBNCPNB "RTN","IBNCPDPU",51,0) ; "RTN","IBNCPDPU",52,0) FILL(X,LEN) ; Zero-fill, right justified. "RTN","IBNCPDPU",53,0) N Y "RTN","IBNCPDPU",54,0) S:'$G(LEN) LEN=1 "RTN","IBNCPDPU",55,0) S Y=$E($G(X),1,LEN) "RTN","IBNCPDPU",56,0) F Q:$L(Y)>(LEN-1) S Y="0"_Y "RTN","IBNCPDPU",57,0) Q Y "RTN","IBNCPDPU",58,0) ; "RTN","IBNCPDPU",59,0) PLANN(DFN,IBX,IBADT) ; returns the ien in the insurance multiple for the given plan "RTN","IBNCPDPU",60,0) ; /patient privided. "RTN","IBNCPDPU",61,0) ; ien in multiple^insurance co ien "RTN","IBNCPDPU",62,0) N IBPOL,IBY,IBR "RTN","IBNCPDPU",63,0) S IBR="" "RTN","IBNCPDPU",64,0) D ALL^IBCNS1(DFN,"IBPOL",3,IBADT) "RTN","IBNCPDPU",65,0) S IBY=0 F S IBY=$O(IBPOL(IBY)) Q:IBY<1!(IBR) I $P(IBPOL(IBY,0),"^",18)=IBX S IBR=$P(IBPOL(IBY,0),"^")_"^"_IBY "RTN","IBNCPDPU",66,0) Q IBR "RTN","IBNCPDPU",67,0) ; "RTN","IBNCPDPU",68,0) PLANEPS(IBPL) ; returns the ePharmacy payer sheets for a group plan "RTN","IBNCPDPU",69,0) ; IBPL = IEN to GROUP INSURANCE PLAN file #355.3 "RTN","IBNCPDPU",70,0) ; Returns: Payer Sheets. (B1,B2,B3,E1) (comma separated string) "RTN","IBNCPDPU",71,0) ; Successful: 1^B1,B2,B3,E1 "RTN","IBNCPDPU",72,0) ; Unsuccessful: 0 "RTN","IBNCPDPU",73,0) N PIEN,IBR,PLN10,B1,B2,B3,E1 "RTN","IBNCPDPU",74,0) S IBR=0 "RTN","IBNCPDPU",75,0) ; Get ePharmacy plan IEN "RTN","IBNCPDPU",76,0) S PIEN=+$P($G(^IBA(355.3,$G(IBPL),6)),U,1) "RTN","IBNCPDPU",77,0) I 'PIEN Q IBR "RTN","IBNCPDPU",78,0) S PLN10=$G(^IBCNR(366.03,PIEN,10)) "RTN","IBNCPDPU",79,0) ; check for test/production sheets "RTN","IBNCPDPU",80,0) ; get the test payer sheet first. If nil, then get the regular payer sheet "RTN","IBNCPDPU",81,0) S (B1,B2,B3,E1)="" "RTN","IBNCPDPU",82,0) S B1=$P(PLN10,U,11),B2=$P(PLN10,U,12),B3=$P(PLN10,U,13),E1=$P(PLN10,U,14) "RTN","IBNCPDPU",83,0) I 'B1 S B1=$P(PLN10,U,7) ; billing "RTN","IBNCPDPU",84,0) I 'B2 S B2=$P(PLN10,U,8) ; reversal "RTN","IBNCPDPU",85,0) I 'B3 S B3=$P(PLN10,U,9) ; rebill (not currently validated) "RTN","IBNCPDPU",86,0) I 'E1 S E1=$P(PLN10,U,15) ; eligibility "RTN","IBNCPDPU",87,0) S IBR="1^"_B1_","_B2_","_B3_","_E1 "RTN","IBNCPDPU",88,0) Q IBR "RTN","IBNCPDPU",89,0) ; "RTN","IBNCPDPU",90,0) RT(DFN,IBDT,IBINS,IBPTYP) ; returns rate type to use for bill "RTN","IBNCPDPU",91,0) ; Input: "RTN","IBNCPDPU",92,0) ; DFN - patient ien "RTN","IBNCPDPU",93,0) ; IBDT - date of service "RTN","IBNCPDPU",94,0) ; IBINS - insurance array (pass by reference) "RTN","IBNCPDPU",95,0) ; "RTN","IBNCPDPU",96,0) ; Output: "RTN","IBNCPDPU",97,0) ; 3 piece string in the following format "RTN","IBNCPDPU",98,0) ; [1] rate type ien "RTN","IBNCPDPU",99,0) ; [2] Rate Type (Tort or Awp or Cost) "RTN","IBNCPDPU",100,0) ; [3] Eligibility Basis (V=VETERAN, T=TRICARE) "RTN","IBNCPDPU",101,0) ; "RTN","IBNCPDPU",102,0) ; IBPTYP - patient type - optional output parameter (pass by reference) "RTN","IBNCPDPU",103,0) ; - this is only used by the PRO option (see IBNCPDP1) "RTN","IBNCPDPU",104,0) ; - (V=VETERAN, T=TRICARE) "RTN","IBNCPDPU",105,0) ; - NOT the same thing as [3] of this function "RTN","IBNCPDPU",106,0) ; "RTN","IBNCPDPU",107,0) N VAEL,VAERR,IBPT,IBRT,IBX,IBE,IBI,IBRET,IBRS "RTN","IBNCPDPU",108,0) S IBPTYP="" "RTN","IBNCPDPU",109,0) D ELIG^VADPT "RTN","IBNCPDPU",110,0) ; "RTN","IBNCPDPU",111,0) ; if primary elig is vet type, use reimbursable "RTN","IBNCPDPU",112,0) S IBPT=$P($G(^DIC(8,+VAEL(1),0)),"^",5) ; = N:NON-VETERAN;Y:VETERAN "RTN","IBNCPDPU",113,0) I IBPT="Y" D Q IBRT_U_$S($G(IBRET)="VA COST":"C^V",1:"T^V") ; IB*2*437 modifications "RTN","IBNCPDPU",114,0) . S IBRT=$O(^DGCR(399.3,"B","REIMBURSABLE INS.",0)) "RTN","IBNCPDPU",115,0) . S IBRT=$S(IBRT:IBRT,1:8) "RTN","IBNCPDPU",116,0) . I $G(IBDT) S IBRET=$P($$EVNTITM^IBCRU3(IBRT,3,"PRESCRIPTION FILL",IBDT,.IBRS),";",1) "RTN","IBNCPDPU",117,0) ; "RTN","IBNCPDPU",118,0) ; if patient is only Tricare elig and only Tricare ins bill for Tricare "RTN","IBNCPDPU",119,0) ; ia #'s 427 & 2516 "RTN","IBNCPDPU",120,0) ; - determine eligibilities "RTN","IBNCPDPU",121,0) S IBE=$P($G(^DIC(8.1,+$P($G(^DIC(8,+VAEL(1),0)),"^",9),0)),"^"),IBE($S(IBE="TRICARE"!(IBE="SHARING AGREEMENT"):"T",IBE="CHAMPVA":"C",1:"O"))="" "RTN","IBNCPDPU",122,0) S IBX=0 F S IBX=$O(VAEL(1,IBX)) Q:'IBX S IBE=$P($G(^DIC(8.1,+$P($G(^DIC(8,+VAEL(1,IBX),0)),"^",9),0)),"^") S IBE($S(IBE="TRICARE"!(IBE="SHARING AGREEMENT"):"T",IBE="CHAMPVA":"C",1:"O"))="" "RTN","IBNCPDPU",123,0) ; "RTN","IBNCPDPU",124,0) ; set patient type parameter "RTN","IBNCPDPU",125,0) I $G(VAEL(4)) S IBPTYP="V" ; veteran without any pt. eligibilities defined "RTN","IBNCPDPU",126,0) I $D(IBE("T")) S IBPTYP="T" ; TRICARE "RTN","IBNCPDPU",127,0) ; "RTN","IBNCPDPU",128,0) ; - determine insurance policies "RTN","IBNCPDPU",129,0) S IBX=0 F S IBX=$O(IBINS(IBX)) Q:'IBX S IBI=$P($G(^IBE(355.1,+$P($G(IBINS(IBX,355.3)),"^",9),0)),"^") S IBI($S(IBI="TRICARE":"T",IBI="CHAMPVA":"C",1:"O"))="" "RTN","IBNCPDPU",130,0) ; - tricare? "RTN","IBNCPDPU",131,0) I $D(IBE("T")),'$D(IBE("O")),'$D(IBE("C")),$D(IBI("T")),'$D(IBI("O")),'$D(IBI("C")) S IBRT=$O(^DGCR(399.3,"B","TRICARE",0)) Q:IBRT IBRT_"^C^T" "RTN","IBNCPDPU",132,0) ; "RTN","IBNCPDPU",133,0) Q $S($D(IBRT):IBRT,1:"0^unable to determine rate type") "RTN","IBNCPDPU",134,0) ; "RTN","IBNCPDPU",135,0) ; "RTN","IBNCPDPU",136,0) BS() ; returns the mccr utility to use "RTN","IBNCPDPU",137,0) N IBX "RTN","IBNCPDPU",138,0) S IBX=0 F S IBX=$O(^DGCR(399.1,"B","PRESCRIPTION",IBX)) Q:IBX<1 I $P($G(^DGCR(399.1,+$G(IBX),0)),U,5) Q "RTN","IBNCPDPU",139,0) Q IBX "RTN","IBNCPDPU",140,0) ; "RTN","IBNCPDPU",141,0) RXBIL(IBINP,IBERR) ; Matching NCPDP payments "RTN","IBNCPDPU",142,0) ; Find IB Bill by the 7 or 12 digit ECME number and the Rx fill date "RTN","IBNCPDPU",143,0) ; This function is called by AR routine $$BILL^RCDPESR1 (DBIA 4435). "RTN","IBNCPDPU",144,0) ;Input: "RTN","IBNCPDPU",145,0) ; IBINP("ECME") - the 7 or 12 digit ECME number (Reference Number) "RTN","IBNCPDPU",146,0) ; IBINP("FILLDT") - the Rx fill date, YYYYMMDD or FileMan format "RTN","IBNCPDPU",147,0) ; IBINP("PNM") (optional) - the patient's last name "RTN","IBNCPDPU",148,0) ;Returns: "RTN","IBNCPDPU",149,0) ; IBERR (by ref) - the error code, or null string if found "RTN","IBNCPDPU",150,0) ; $$RXBIL - IB Bill IEN, or 0 if not matched "RTN","IBNCPDPU",151,0) N IBKEY,IBECME,BILLDA,IBFOUND,IBMATCH,IBDAT,IBPNAME,ECMELEN,ECMENUM "RTN","IBNCPDPU",152,0) S IBERR="" "RTN","IBNCPDPU",153,0) S IBECME=$G(IBINP("ECME")) "RTN","IBNCPDPU",154,0) I IBECME'?1.12N S IBERR="Invalid ECME number" Q 0 "RTN","IBNCPDPU",155,0) S IBDAT=$G(IBINP("FILLDT")) ; Rx fill date "RTN","IBNCPDPU",156,0) I IBDAT?8N S IBDAT=($E(IBDAT,1,4)-1700)_$E(IBDAT,5,8) ; conv date to FM format "RTN","IBNCPDPU",157,0) I IBDAT'?7N Q $$RXBILND(IBECME) ; date is not correct or null "RTN","IBNCPDPU",158,0) S IBPNAME=$G(IBINP("PNM")) ; patient's name (optional) "RTN","IBNCPDPU",159,0) ; "RTN","IBNCPDPU",160,0) ; Attempt ECME# look up with either 7 digit or 12 digit number (IB*2*435) "RTN","IBNCPDPU",161,0) S IBFOUND=0,IBMATCH=0 "RTN","IBNCPDPU",162,0) F ECMELEN=12,7 D Q:IBFOUND "RTN","IBNCPDPU",163,0) . I $L(+IBECME)>ECMELEN Q ; Quit if too large "RTN","IBNCPDPU",164,0) . S ECMENUM=$$RJ^XLFSTR(+IBECME,ECMELEN,0) ; build ECME# "RTN","IBNCPDPU",165,0) . S IBKEY=ECMENUM_";"_IBDAT ; The ECME Number (BC ID) for the "AG" xref "RTN","IBNCPDPU",166,0) . S BILLDA="" "RTN","IBNCPDPU",167,0) . ; Search Backward "RTN","IBNCPDPU",168,0) . F S BILLDA=$O(^DGCR(399,"AG",IBKEY,BILLDA),-1) Q:BILLDA="" D Q:IBFOUND "RTN","IBNCPDPU",169,0) .. I 'BILLDA Q ; IEN must be numeric "RTN","IBNCPDPU",170,0) .. I '$D(^DGCR(399,BILLDA,0)) Q ; Corrupted index "RTN","IBNCPDPU",171,0) .. S IBMATCH=1 "RTN","IBNCPDPU",172,0) .. I IBPNAME'="" I '$$TXMATCH($P(IBPNAME,","),$P($G(^DPT(+$P(^DGCR(399,BILLDA,0),U,2),0)),","),8) Q ; Patient name doesn't match "RTN","IBNCPDPU",173,0) .. S IBFOUND=1 "RTN","IBNCPDPU",174,0) .. Q "RTN","IBNCPDPU",175,0) . Q "RTN","IBNCPDPU",176,0) ; "RTN","IBNCPDPU",177,0) I 'BILLDA S IBERR=$S(IBMATCH:"Patient's name does not match",1:"Matching bill not found") ; not matched "RTN","IBNCPDPU",178,0) Q +BILLDA "RTN","IBNCPDPU",179,0) ; "RTN","IBNCPDPU",180,0) RXBILND(IBECME) ;Match the bill with no date "RTN","IBNCPDPU",181,0) N IBKEY,IBBC,BILLDA,IBY,IBCUT,ECMELEN,ECMENUM "RTN","IBNCPDPU",182,0) S IBCUT=$$FMADD^XLFDT(DT,-180) ; only 180 days in the past for cut-off date "RTN","IBNCPDPU",183,0) ; "RTN","IBNCPDPU",184,0) ; Search ECME# 7/12 digits forward looking for PRNT/TX claims (IB*2*435) "RTN","IBNCPDPU",185,0) S BILLDA=0 "RTN","IBNCPDPU",186,0) F ECMELEN=12,7 D Q:BILLDA "RTN","IBNCPDPU",187,0) . I $L(+IBECME)>ECMELEN Q ; Quit if too large "RTN","IBNCPDPU",188,0) . S ECMENUM=$$RJ^XLFSTR(+IBECME,ECMELEN,0) ; build ECME# "RTN","IBNCPDPU",189,0) . S IBKEY=ECMENUM_";" "RTN","IBNCPDPU",190,0) . S IBBC=IBKEY_IBCUT "RTN","IBNCPDPU",191,0) . F S IBBC=$O(^DGCR(399,"AG",IBBC)) Q:IBBC'[IBKEY D Q:BILLDA "RTN","IBNCPDPU",192,0) .. S IBY="" F S IBY=$O(^DGCR(399,"AG",IBBC,IBY)) Q:'IBY D Q:BILLDA "RTN","IBNCPDPU",193,0) ... I $P($G(^DGCR(399,+IBY,0)),U,13)'=4 Q ; not PRNT/TX "RTN","IBNCPDPU",194,0) ... S BILLDA=+IBY "RTN","IBNCPDPU",195,0) ... Q "RTN","IBNCPDPU",196,0) .. Q "RTN","IBNCPDPU",197,0) . Q "RTN","IBNCPDPU",198,0) I BILLDA Q BILLDA "RTN","IBNCPDPU",199,0) ; "RTN","IBNCPDPU",200,0) ; Search ECME# 7/12 digits backwards looking for ANY claims within cut-off date (IB*2*435) "RTN","IBNCPDPU",201,0) S BILLDA=0 "RTN","IBNCPDPU",202,0) F ECMELEN=12,7 D Q:BILLDA "RTN","IBNCPDPU",203,0) . I $L(+IBECME)>ECMELEN Q ; Quit if too large "RTN","IBNCPDPU",204,0) . S ECMENUM=$$RJ^XLFSTR(+IBECME,ECMELEN,0) ; build ECME# "RTN","IBNCPDPU",205,0) . S IBKEY=ECMENUM_";" "RTN","IBNCPDPU",206,0) . S IBBC=IBKEY_"8000000" "RTN","IBNCPDPU",207,0) . F S IBBC=$O(^DGCR(399,"AG",IBBC),-1) Q:IBBC'[IBKEY Q:$P(IBBC,";",2)/\|@#$%&*-=!`~ " "RTN","IBNCPDPU",220,0) S IBTR2="abcdefghijklmnopqrstuvwxyz" "RTN","IBNCPDPU",221,0) S IBT1=$E($TR(IBTXT1,IBTR1,IBTR2),1,IBMAX) "RTN","IBNCPDPU",222,0) S IBT2=$E($TR(IBTXT2,IBTR1,IBTR2),1,IBMAX) "RTN","IBNCPDPU",223,0) Q IBT1=IBT2 "RTN","IBNCPDPU",224,0) ; "RTN","IBNCPDPU",225,0) ECMEBIL(DFN,IBADT) ; Is the pat ECME Billable (pharmacy coverage only) "RTN","IBNCPDPU",226,0) ; DFN - ptr to the patient "RTN","IBNCPDPU",227,0) ; IBADT - the date "RTN","IBNCPDPU",228,0) N IBANY,IBERMSG,IBX,IBINS,IBT,IBZ,IBRES,IBCAT,IBCOV,IBPCOV "RTN","IBNCPDPU",229,0) S IBRES=0 ; Not ECME Billable by default "RTN","IBNCPDPU",230,0) S (IBCOV,IBPCOV)=0 "RTN","IBNCPDPU",231,0) ; -- look up ins with Rx "RTN","IBNCPDPU",232,0) D ALL^IBCNS1(DFN,"IBINS",1,IBADT,1) "RTN","IBNCPDPU",233,0) S IBERMSG="" ; Error message "RTN","IBNCPDPU",234,0) S IBCAT=$O(^IBE(355.31,"B","PHARMACY",0)) "RTN","IBNCPDPU",235,0) S IBX=0 F S IBX=$O(IBINS("S",IBX)) Q:'IBX D Q:IBRES "RTN","IBNCPDPU",236,0) . S IBT=0 F S IBT=$O(IBINS("S",IBX,IBT)) Q:'IBT D Q:IBRES "RTN","IBNCPDPU",237,0) . . N IBZ,IBPIEN,IBY,IBPL "RTN","IBNCPDPU",238,0) . . S IBZ=$G(IBINS(IBT,0)) "RTN","IBNCPDPU",239,0) . . S IBPL=+$P(IBZ,U,18) Q:'IBPL "RTN","IBNCPDPU",240,0) . . S IBCOV=1 ; covered "RTN","IBNCPDPU",241,0) . . I '$$PLCOV^IBCNSU3(IBPL,IBADT,IBCAT) Q "RTN","IBNCPDPU",242,0) . . S IBPCOV=1 "RTN","IBNCPDPU",243,0) . . S IBPIEN=+$G(^IBA(355.3,IBPL,6)) "RTN","IBNCPDPU",244,0) . . I 'IBPIEN S IBERMSG="Plan not linked to the Payer" Q ; Not linked "RTN","IBNCPDPU",245,0) . . D STCHK^IBCNRU1(IBPIEN,.IBY) "RTN","IBNCPDPU",246,0) . . I $E($G(IBY(1)))'="A" S:IBERMSG="" IBERMSG=$$ERMSG^IBNCPNB($P($G(IBY(6)),",")) Q "RTN","IBNCPDPU",247,0) . . S IBRES=1 "RTN","IBNCPDPU",248,0) I 'IBCOV Q "0^Not Insured" "RTN","IBNCPDPU",249,0) I 'IBPCOV Q "0^No Pharmacy Coverage" "RTN","IBNCPDPU",250,0) I 'IBRES,IBERMSG'="" Q "0^"_IBERMSG "RTN","IBNCPDPU",251,0) I 'IBRES Q "0^No Insurance ECME billable" "RTN","IBNCPDPU",252,0) ; "RTN","IBNCPDPU",253,0) Q IBRES "RTN","IBNCPDPU",254,0) ; "RTN","IBNCPDPU",255,0) SUBMIT(IBRX,IBFIL,IBDELAY) ; Submit the Rx claim through ECME "RTN","IBNCPDPU",256,0) ; IBDELAY - Delay Reason Code, passed as the 18th parameter - IB*2.0*435 "RTN","IBNCPDPU",257,0) ; IBRX - RX ien in file #52 "RTN","IBNCPDPU",258,0) ; IBFIL - Fill No (0 for orig fill) "RTN","IBNCPDPU",259,0) N IBDT,IBNDC,IBX "RTN","IBNCPDPU",260,0) I '$G(IBRX)!('$D(IBFIL)) Q "0^Invalid parameters." "RTN","IBNCPDPU",261,0) S IBDT=$S('IBFIL:$$FILE^IBRXUTL(IBRX,22),1:$$SUBFILE^IBRXUTL(IBRX,IBFIL,52,.01)) "RTN","IBNCPDPU",262,0) S IBX=$$EN^BPSNCPDP(+IBRX,+IBFIL,IBDT,"BB",,,,,,,,,,,,,,+$G(IBDELAY)) "RTN","IBNCPDPU",263,0) I +IBX=0 D ECMEACT^PSOBPSU1(+IBRX,+IBFIL,"Claim submitted to 3rd party payer: IB BACK BILLING") "RTN","IBNCPDPU",264,0) Q IBX "RTN","IBNCPDPU",265,0) ; "RTN","IBNCPDPU",266,0) REASON(IBX,EXACT) ; Close Claim Reasons "RTN","IBNCPDPU",267,0) Q $P($G(^IBE(356.8,+IBX,0)),U) ; non-billable reason "RTN","IBNCPDPU",268,0) ; "RTN","IBNCPDPU",269,0) NABP(IBIFN) ;NABP Number "RTN","IBNCPDPU",270,0) N IBY,IBTRKN,IBRX,IBFIL,IBZ,IBNABP "RTN","IBNCPDPU",271,0) S IBY=+$O(^IBT(356.399,"C",IBIFN,0)) I 'IBY Q "" "RTN","IBNCPDPU",272,0) S IBTRKN=$P($G(^IBT(356.399,IBY,0)),U) I 'IBTRKN Q "" "RTN","IBNCPDPU",273,0) S IBZ=$G(^IBT(356,IBTRKN,0)) I IBZ="" Q "" "RTN","IBNCPDPU",274,0) S IBRX=$P(IBZ,U,8) "RTN","IBNCPDPU",275,0) S IBFIL=$P(IBZ,U,10) "RTN","IBNCPDPU",276,0) S IBNABP=$$NABP^BPSBUTL(IBRX,IBFIL) "RTN","IBNCPDPU",277,0) Q $S(IBNABP=0:"",1:IBNABP) "RTN","IBNCPDPU",278,0) ; "RTN","IBNCPDPU",279,0) ; Get the K-bill# from CT "RTN","IBNCPDPU",280,0) BILL(IBRX,IBFIL) ; "RTN","IBNCPDPU",281,0) N IBTRKN,IBIFN "RTN","IBNCPDPU",282,0) S IBTRKN=+$O(^IBT(356,"ARXFL",+$G(IBRX),+$G(IBFIL),"")) "RTN","IBNCPDPU",283,0) S IBIFN=+$P($G(^IBT(356,IBTRKN,0)),U,11) "RTN","IBNCPDPU",284,0) Q $P($G(^DGCR(399,IBIFN,0)),U) "RTN","IBNCPDPU",285,0) ; "RTN","IBNCPDPU",286,0) REJECT(IBECME,IBDATE) ; Is the e-claim rejected? "RTN","IBNCPDPU",287,0) N IBTRKRN,IBY,ECMELEN "RTN","IBNCPDPU",288,0) I IBECME'?1.12N Q 0 "RTN","IBNCPDPU",289,0) S IBTRKRN=0 "RTN","IBNCPDPU",290,0) F ECMELEN=12,7 D Q:IBTRKRN "RTN","IBNCPDPU",291,0) . I $L(+IBECME)>ECMELEN Q "RTN","IBNCPDPU",292,0) . S IBECME=$$RJ^XLFSTR(+IBECME,ECMELEN,0) ; build ECME# with leading zeros "RTN","IBNCPDPU",293,0) . S IBTRKRN=+$O(^IBT(356,"AE",IBECME,0)) "RTN","IBNCPDPU",294,0) . Q "RTN","IBNCPDPU",295,0) I 'IBTRKRN Q 0 "RTN","IBNCPDPU",296,0) S IBY=$G(^IBT(356,IBTRKRN,1)) "RTN","IBNCPDPU",297,0) I $P(IBY,U,11)>0 Q 1 ; Rejected or closed "RTN","IBNCPDPU",298,0) Q 0 "RTN","IBNCPDPU",299,0) ; "RTN","IBNCPDPU",300,0) ; "RTN","IBNCPDPU",301,0) ;IBNCPDPU "RTN","IBNCPEV") 0^21^B84626765 "RTN","IBNCPEV",1,0) IBNCPEV ;DALOI/SS - NCPDP BILLING EVENTS REPORT ;5/22/08 14:27 "RTN","IBNCPEV",2,0) ;;2.0;INTEGRATED BILLING;**342,363,383,384,411,435**;21-MAR-94;Build 27 "RTN","IBNCPEV",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPEV",4,0) RPT ; "RTN","IBNCPEV",5,0) N IBBDT,IBDIVS,IBDTL,IBEDT,IBM1,IBM2,IBM3,IBPAGE,IBPAT,IBQ,IBRX,IBSCR,Y "RTN","IBNCPEV",6,0) N IBECME "RTN","IBNCPEV",7,0) D SETVARS^IBNCPEV1 "RTN","IBNCPEV",8,0) Q:IBQ "RTN","IBNCPEV",9,0) D START "RTN","IBNCPEV",10,0) D ^%ZISC "RTN","IBNCPEV",11,0) I IBQ W !,"Cancelled" "RTN","IBNCPEV",12,0) Q "RTN","IBNCPEV",13,0) ; "RTN","IBNCPEV",14,0) START ; "RTN","IBNCPEV",15,0) N IBFN,IBFROM,IBI,IBN,IBNB,IBNDX,IBNUM,IBRX1,IBSC,IBTO,IB1ST,REF,X,Z,Z1 "RTN","IBNCPEV",16,0) ;Constants "RTN","IBNCPEV",17,0) S IBSC="STATUS CHECK",IBNB="Not ECME billable: ",IBNDX="IBNCPDP-" "RTN","IBNCPEV",18,0) ;get the first date "RTN","IBNCPEV",19,0) S IBFROM=$O(^IBCNR(366.14,"B",IBBDT-1)) Q:+IBFROM=0 "RTN","IBNCPEV",20,0) ;get the last date "RTN","IBNCPEV",21,0) S IBTO=$O(^IBCNR(366.14,"B",IBEDT+1),-1) Q:+IBTO=0 "RTN","IBNCPEV",22,0) ; "RTN","IBNCPEV",23,0) S REF=$NA(^TMP($J,"IBNCPDPE")) "RTN","IBNCPEV",24,0) ; "RTN","IBNCPEV",25,0) K @REF "RTN","IBNCPEV",26,0) ; "RTN","IBNCPEV",27,0) I +$G(IBECME) S IBRX=$$GETRX^IBNCPEV1(IBECME,IBFROM,IBTO,.IBECME) I 'IBRX W !!,"No data found for the specified date range and ECME #" Q ; no match with ECME # "RTN","IBNCPEV",28,0) ;collect "RTN","IBNCPEV",29,0) N IBDFN,IBDTIEN,IBEVNT,IBP4,IBRXIEN,IBZ0,IBZ1,IBZ2 "RTN","IBNCPEV",30,0) S IBI=IBFROM-1 "RTN","IBNCPEV",31,0) F S IBI=$O(^IBCNR(366.14,"B",IBI)) Q:+IBI=0 Q:IBI>IBTO D "RTN","IBNCPEV",32,0) . S IBDTIEN=$O(^IBCNR(366.14,"B",IBI,0)) "RTN","IBNCPEV",33,0) . S IBN=0 F S IBN=$O(^IBCNR(366.14,IBDTIEN,1,IBN)) Q:+IBN=0 D "RTN","IBNCPEV",34,0) . . S IBZ0=$G(^IBCNR(366.14,IBDTIEN,1,IBN,0)) "RTN","IBNCPEV",35,0) . . ;if not "ALL" was selected IBDIVS>0 AND the division in #366.14 record is among those selected by the user "RTN","IBNCPEV",36,0) . . I IBDIVS>0,$$CHECKDIV^IBNCPEV1(+$P(IBZ0,U,9),.IBDIVS)=0 Q "RTN","IBNCPEV",37,0) . . S IBDFN=+$P(IBZ0,U,3) "RTN","IBNCPEV",38,0) . . Q:IBDFN=0 "RTN","IBNCPEV",39,0) . . S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBDTIEN_",",.01) "RTN","IBNCPEV",40,0) . . S IBZ2=$G(^IBCNR(366.14,IBDTIEN,1,IBN,2)) "RTN","IBNCPEV",41,0) . . S IBRXIEN=$P(IBZ2,U,12) "RTN","IBNCPEV",42,0) . . I IBRXIEN="" S IBRXIEN=$P(IBZ2,U,1) "RTN","IBNCPEV",43,0) . . I IBPAT,IBDFN'=IBPAT Q "RTN","IBNCPEV",44,0) . . I IBM2="E",IBEVNT[IBSC,'$P(IBZ0,U,7) Q "RTN","IBNCPEV",45,0) . . I IBM2="N",IBEVNT'[IBSC Q "RTN","IBNCPEV",46,0) . . I IBM2="N",IBEVNT[IBSC,$P(IBZ0,U,7) Q "RTN","IBNCPEV",47,0) . . ;if "No Rx IEN" case then create a unique artificial IBRXIEN to be able "RTN","IBNCPEV",48,0) . . ;to create ^TMP entry and display available information in the report "RTN","IBNCPEV",49,0) . . I +$G(IBRXIEN)=0 S IBRXIEN=+(IBDTIEN_"."_IBN) G SETTMP "RTN","IBNCPEV",50,0) . . I IBRX,IBRXIEN'=IBRX Q "RTN","IBNCPEV",51,0) . . I $$RXNUM(IBRXIEN)="" Q "RTN","IBNCPEV",52,0) . . I IBM3'="A",IBM3'=$$RXWMC^IBNCPRR(+IBRXIEN) Q "RTN","IBNCPEV",53,0) SETTMP . . S @REF@(+IBRXIEN,+$P(IBZ2,U,3),IBDTIEN,IBN)="" "RTN","IBNCPEV",54,0) ; "RTN","IBNCPEV",55,0) I '$D(@REF) W !!,"No data found for the specified input criteria" Q "RTN","IBNCPEV",56,0) ;print "RTN","IBNCPEV",57,0) S IBNUM=0 "RTN","IBNCPEV",58,0) U IO D HDR "RTN","IBNCPEV",59,0) S IBRX1="" F S IBRX1=$O(@REF@(IBRX1)) Q:IBRX1="" D Q:IBQ "RTN","IBNCPEV",60,0) .S IBFN="" F S IBFN=$O(@REF@(IBRX1,IBFN)) Q:IBFN="" D Q:IBQ "RTN","IBNCPEV",61,0) ..S IB1ST=1 "RTN","IBNCPEV",62,0) ..S IBI="" F S IBI=$O(@REF@(IBRX1,IBFN,IBI)) Q:IBI="" D Q:IBQ "RTN","IBNCPEV",63,0) ...S IBN="" F S IBN=$O(@REF@(IBRX1,IBFN,IBI,IBN)) Q:IBN="" D Q:IBQ "RTN","IBNCPEV",64,0) ....N IBZ,IBD1,IBD2,IBD3,IBD4,IBD7,IBINS,IBY "RTN","IBNCPEV",65,0) ....;load main "RTN","IBNCPEV",66,0) ....S IBZ=$G(^IBCNR(366.14,IBI,1,IBN,0)) "RTN","IBNCPEV",67,0) ....;load IBD array "RTN","IBNCPEV",68,0) ....S IBD1=$G(^IBCNR(366.14,IBI,1,IBN,1)) "RTN","IBNCPEV",69,0) ....S IBD2=$G(^IBCNR(366.14,IBI,1,IBN,2)) "RTN","IBNCPEV",70,0) ....S IBD3=$G(^IBCNR(366.14,IBI,1,IBN,3)) "RTN","IBNCPEV",71,0) ....S IBD4=$G(^IBCNR(366.14,IBI,1,IBN,4)) "RTN","IBNCPEV",72,0) ....S IBD7=$G(^IBCNR(366.14,IBI,1,IBN,7)) "RTN","IBNCPEV",73,0) ....S IBY=0 "RTN","IBNCPEV",74,0) ....;load insurance multiple "RTN","IBNCPEV",75,0) ....F S IBY=$O(^IBCNR(366.14,IBI,1,IBN,5,IBY)) Q:+IBY=0 D "RTN","IBNCPEV",76,0) .....S IBINS(IBY,0)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,0)) "RTN","IBNCPEV",77,0) .....S IBINS(IBY,1)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,1)) "RTN","IBNCPEV",78,0) .....S IBINS(IBY,2)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,2)) "RTN","IBNCPEV",79,0) .....S IBINS(IBY,3)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,3)) "RTN","IBNCPEV",80,0) ....; "RTN","IBNCPEV",81,0) ....I IB1ST D Q:IBQ "RTN","IBNCPEV",82,0) .....S IBNUM=IBNUM+1 I IBNUM>1 D ULINE("-") Q:IBQ "RTN","IBNCPEV",83,0) .....D CHKP Q:IBQ "RTN","IBNCPEV",84,0) .....W !,IBNUM," ",?4,$$RXNUM(IBRX1)," ",?12,IBFN," ",?16,$$DAT(+$P(IBD2,U,6)) ;RX# Fill# Fill_date "RTN","IBNCPEV",85,0) .....W " ",?28,$E($$PAT(+$P(IBZ,U,3)),1,21)," ",?50,$E($$DRUG(+$P(IBZ,U,3),IBRX1),1,30) "RTN","IBNCPEV",86,0) .....S IB1ST=0 "RTN","IBNCPEV",87,0) ....N IND S IND=6 "RTN","IBNCPEV",88,0) ....D CHKP Q:IBQ "RTN","IBNCPEV",89,0) ....S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBI_",",.01) "RTN","IBNCPEV",90,0) ....W !,?IND,$$EVNT(IBEVNT)," ",?16,$$TIM($P(IBZ,U,5)),?31," Status:",$E($$STAT(IBEVNT,$P(IBZ,U,7)_U_$P(IBZ,U,8),$P(IBD3,U,7),$P(IBD3,U,1)),1,40) "RTN","IBNCPEV",91,0) ....Q:'IBDTL ; no details "RTN","IBNCPEV",92,0) ....I IBEVNT="BILL" D DBILL Q "RTN","IBNCPEV",93,0) ....I IBEVNT="REJECT" D DREJ Q "RTN","IBNCPEV",94,0) ....I IBEVNT["REVERSE" D DREV Q "RTN","IBNCPEV",95,0) ....I IBEVNT["SUBMIT" D DSUB Q "RTN","IBNCPEV",96,0) ....I IBEVNT["CLOSE" D DCLO Q "RTN","IBNCPEV",97,0) ....I IBEVNT["REOPEN" D REOPEN^IBNCPEV1 Q "RTN","IBNCPEV",98,0) ....I IBEVNT["RELEASE" D DREL Q "RTN","IBNCPEV",99,0) ....I IBEVNT[IBSC D DSTAT^IBNCPEV1(.IBD2,.IBD3,.IBD4,.IBINS,.IBD7) Q "RTN","IBNCPEV",100,0) ....I IBEVNT["BILL CANCELLED" D BCANC Q "RTN","IBNCPEV",101,0) I IBSCR,'IBQ W !,"End of report, press RETURN to continue." R X:DTIME "RTN","IBNCPEV",102,0) K @REF "RTN","IBNCPEV",103,0) Q "RTN","IBNCPEV",104,0) ; "RTN","IBNCPEV",105,0) STAT(X,RES,CR,IBIFN) ;provides STATUS information "RTN","IBNCPEV",106,0) N IBNL,IBSC "RTN","IBNCPEV",107,0) S IBNL="Plan not linked to the Payer",IBSC="STATUS CHECK" "RTN","IBNCPEV",108,0) I X[IBSC,RES[IBNB S RES="0^"_$P(RES,IBNB,2) "RTN","IBNCPEV",109,0) I X[IBSC,RES[IBNL S RES="0^Plan not linked" ; shorten too long line "RTN","IBNCPEV",110,0) I X[IBSC,'RES,RES["Non-Billable in CT" Q $P(RES,U,2) "RTN","IBNCPEV",111,0) I X[IBSC Q $S(RES:"",1:"non-")_"ECME Billable"_$S(RES:"",$P(RES,U,2)="":"",$P(RES,U,2)="NEEDS SC DETERMINATION":" NEEDS "_$$GETNOANS^IBNCPEV1(IBD4)_" DETERMINATION",1:", "_$P(RES,U,2)) "RTN","IBNCPEV",112,0) I X="BILL",'RES,IBIFN Q "Bill "_$$BILL(IBIFN)_" created with ERRORs" "RTN","IBNCPEV",113,0) I X="BILL",'RES Q "Error: "_$P(RES,U,2) "RTN","IBNCPEV",114,0) I X="BILL",'IBIFN Q $P(RES,U,2) "RTN","IBNCPEV",115,0) I X="BILL" Q "Bill# "_$$BILL(+IBIFN)_" created" "RTN","IBNCPEV",116,0) I X["REVERSE",$G(CR)=7,RES=1 Q "set N/B Reason: Rx deleted, no Bill to cancel." "RTN","IBNCPEV",117,0) I X["REVERSE" Q $S(RES=1:"success",RES>1:"Bill# "_$$BILL(+RES)_" cancelled",'RES:"ECME Claim reversed, no Bill to cancel",1:$P(RES,U,2)) "RTN","IBNCPEV",118,0) I 'RES Q $P(RES,U,2) "RTN","IBNCPEV",119,0) Q "OK" "RTN","IBNCPEV",120,0) ; "RTN","IBNCPEV",121,0) ;BILL section "RTN","IBNCPEV",122,0) ;input params IBD*, IBZ, IBINS* "RTN","IBNCPEV",123,0) DBILL ; "RTN","IBNCPEV",124,0) I '$P(IBZ,U,7),$L($P(IBZ,U,8)),$P(IBD3,U,1) D CHKP Q:IBQ W !?10,"ERROR DESCRIPTION: ",$P(IBZ,U,8) "RTN","IBNCPEV",125,0) D CHKP Q:IBQ "RTN","IBNCPEV",126,0) D SUBHDR "RTN","IBNCPEV",127,0) I $P(IBD2,U,4) D CHKP Q:IBQ W !?10,"DRUG:",$$DRUGAPI^IBNCPEV1(+$P(IBD2,U,4),.01) "RTN","IBNCPEV",128,0) D CHKP Q:IBQ "RTN","IBNCPEV",129,0) W !,?10,"NDC:",$S($P(IBD2,U,5):$P(IBD2,U,5),1:"No"),", BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No"),", DAYS SUPPLY:",$S($P(IBD2,U,9):$P(IBD2,U,9),1:"No") "RTN","IBNCPEV",130,0) W !,?10,"BILLED:",$J($P(IBD3,U,2),0,2),", " "RTN","IBNCPEV",131,0) W "PAID:",$J($P(IBD3,U,5),0,2) "RTN","IBNCPEV",132,0) W:$P(IBD3,U,11) ", 3RD PARTY REPORTED COPAY:",$J($P(IBD3,U,11),0,2) "RTN","IBNCPEV",133,0) D CHKP Q:IBQ "RTN","IBNCPEV",134,0) W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U) "RTN","IBNCPEV",135,0) D CHKP Q:IBQ "RTN","IBNCPEV",136,0) D DISPUSR "RTN","IBNCPEV",137,0) Q "RTN","IBNCPEV",138,0) ; "RTN","IBNCPEV",139,0) ;reject section "RTN","IBNCPEV",140,0) DREJ ; "RTN","IBNCPEV",141,0) D CHKP Q:IBQ "RTN","IBNCPEV",142,0) D SUBHDR "RTN","IBNCPEV",143,0) I +$P(IBD3,U,3) D CHKP Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U) "RTN","IBNCPEV",144,0) D CLRS Q:IBQ "RTN","IBNCPEV",145,0) D CHKP Q:IBQ "RTN","IBNCPEV",146,0) D DISPUSR "RTN","IBNCPEV",147,0) Q "RTN","IBNCPEV",148,0) ;close "RTN","IBNCPEV",149,0) DCLO ; "RTN","IBNCPEV",150,0) D DREJ "RTN","IBNCPEV",151,0) Q "RTN","IBNCPEV",152,0) ;submit "RTN","IBNCPEV",153,0) DSUB ; "RTN","IBNCPEV",154,0) D CHKP Q:IBQ "RTN","IBNCPEV",155,0) D SUBHDR "RTN","IBNCPEV",156,0) I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6) "RTN","IBNCPEV",157,0) I $L($P(IBD3,U,3)) D CHKP Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U) "RTN","IBNCPEV",158,0) D CHKP Q:IBQ "RTN","IBNCPEV",159,0) D DISPUSR "RTN","IBNCPEV",160,0) Q "RTN","IBNCPEV",161,0) ;release "RTN","IBNCPEV",162,0) DREL ; "RTN","IBNCPEV",163,0) D DREJ "RTN","IBNCPEV",164,0) Q "RTN","IBNCPEV",165,0) ;reverse "RTN","IBNCPEV",166,0) DREV ; "RTN","IBNCPEV",167,0) D CHKP Q:IBQ "RTN","IBNCPEV",168,0) D SUBHDR "RTN","IBNCPEV",169,0) I $L($P(IBD1,U,6)),$E($P(IBD1,U,6),1)'="A"&($E($P(IBD1,U,6),1)'="R") S $P(IBD1,U,6)="" ; only display accepted and rejected on REVERSALS "RTN","IBNCPEV",170,0) I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6) "RTN","IBNCPEV",171,0) I $L($P(IBD3,U,3)) D CHKP Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U) "RTN","IBNCPEV",172,0) D CLRS Q:IBQ "RTN","IBNCPEV",173,0) D CHKP Q:IBQ "RTN","IBNCPEV",174,0) D DISPUSR "RTN","IBNCPEV",175,0) W !?10,"REVERSAL REASON:",$P(IBD1,U,7) "RTN","IBNCPEV",176,0) Q "RTN","IBNCPEV",177,0) ; "RTN","IBNCPEV",178,0) BCANC ; bill cancellation generated by auto-reversal (duplicate bill) "RTN","IBNCPEV",179,0) D CHKP Q:IBQ "RTN","IBNCPEV",180,0) W !?10,"SYSTEM FOUND DUPLICATE BILL WHILE PROCESSING CLAIM" "RTN","IBNCPEV",181,0) D CHKP Q:IBQ "RTN","IBNCPEV",182,0) D DISPUSR "RTN","IBNCPEV",183,0) Q "RTN","IBNCPEV",184,0) ; "RTN","IBNCPEV",185,0) CLRS ; "RTN","IBNCPEV",186,0) N TX,PP,RC "RTN","IBNCPEV",187,0) S TX="CLOSE REASON" "RTN","IBNCPEV",188,0) S PP="DROP TO PAPER" "RTN","IBNCPEV",189,0) S RC="RELEASE COPAY" "RTN","IBNCPEV",190,0) I $P(IBD3,U,7)'="" D CHKP Q:IBQ W !?10,TX,":",$$REASON^IBNCPDPU($P(IBD3,U,7)) W:$P(IBD3,U,8) ", ",PP W:$P(IBD3,U,9) ", ",RC "RTN","IBNCPEV",191,0) S TX="CLOSE COMMENT" "RTN","IBNCPEV",192,0) I $L($P(IBD3,U,6))>2 D CHKP Q:IBQ W !?10,"COMMENT:",$P(IBD3,U,6) "RTN","IBNCPEV",193,0) Q "RTN","IBNCPEV",194,0) ; "RTN","IBNCPEV",195,0) HDR ;header "RTN","IBNCPEV",196,0) W @IOF S IBPAGE=IBPAGE+1 W ?72,"PAGE ",IBPAGE "RTN","IBNCPEV",197,0) W !,$$DISPTITL^IBNCPEV1(IBBDT,IBEDT,IBDTL,.IBDIVS) "RTN","IBNCPEV",198,0) W:IBDIVS'=0 !,$$DISPLDIV^IBNCPEV1(.IBDIVS) "RTN","IBNCPEV",199,0) W !?15 "RTN","IBNCPEV",200,0) I IBM1="R" W "SINGLE PRESCRIPTION - ",$$RXNUM(IBRX)," " "RTN","IBNCPEV",201,0) I IBM1="P" W "SINGLE PATIENT - ",$P($G(^DPT(IBPAT,0)),U)," " "RTN","IBNCPEV",202,0) I IBM1="E" W "SINGLE ECME # - ",IBECME "RTN","IBNCPEV",203,0) I IBM2="E" W "ECME BILLABLE RX " "RTN","IBNCPEV",204,0) I IBM2="N" W "NON ECME BILLABLE RX " "RTN","IBNCPEV",205,0) I IBM3'="A",IBM1'="R" W $S(IBM3="M":"MAIL",IBM3="C":"CMOP",1:"WINDOW")_" PRESCRIPTIONS ONLY" "RTN","IBNCPEV",206,0) W !,?4," RX# FILL DATE PATIENT NAME",?55,"DRUG" "RTN","IBNCPEV",207,0) N I W ! F I=1:1:80 W "=" "RTN","IBNCPEV",208,0) Q "RTN","IBNCPEV",209,0) ; "RTN","IBNCPEV",210,0) ULINE(X) ;line "RTN","IBNCPEV",211,0) D CHKP Q:IBQ "RTN","IBNCPEV",212,0) N I W ! F I=1:1:80 W $G(X,"-") "RTN","IBNCPEV",213,0) Q "RTN","IBNCPEV",214,0) CHKP ;Check for EOP "RTN","IBNCPEV",215,0) N Y "RTN","IBNCPEV",216,0) I $Y>(IOSL-4) D:IBSCR PAUSE Q:IBQ D HDR "RTN","IBNCPEV",217,0) Q "RTN","IBNCPEV",218,0) DAT(X,Y) Q $$DAT1^IBOUTL(X,.Y) "RTN","IBNCPEV",219,0) TIM(X) N IBT ;time "RTN","IBNCPEV",220,0) S IBT=$$DAT1^IBOUTL(X,1) I $L(IBT," ")<3 Q IBT "RTN","IBNCPEV",221,0) I $P(IBT," ",3)="pm" S IBT=$P(IBT," ",1,2)_"p" Q IBT "RTN","IBNCPEV",222,0) I $P(IBT," ",3)="am" S IBT=$P(IBT," ",1,2)_"a" Q IBT "RTN","IBNCPEV",223,0) Q IBT "RTN","IBNCPEV",224,0) ; "RTN","IBNCPEV",225,0) USR(X) ; "RTN","IBNCPEV",226,0) I $D(^VA(200,+X,0)) Q $P(^(0),U) "RTN","IBNCPEV",227,0) Q X "RTN","IBNCPEV",228,0) ; "RTN","IBNCPEV",229,0) PAT(DFN) ; "RTN","IBNCPEV",230,0) Q $P($G(^DPT(DFN,0),"?"),"^") "RTN","IBNCPEV",231,0) BILL(BN) ; "RTN","IBNCPEV",232,0) Q $P($G(^DGCR(399,BN,0),"?"),"^") "RTN","IBNCPEV",233,0) ARBILL(BN) ; "RTN","IBNCPEV",234,0) Q $P($G(^PRCA(430,BN,0),"?"),"^") "RTN","IBNCPEV",235,0) ; "RTN","IBNCPEV",236,0) ;Returns DRUG name (#50,.01) "RTN","IBNCPEV",237,0) ;IBDFN = IEN in PATIENT file #2 "RTN","IBNCPEV",238,0) ;IBRX = IEN in PRESCRIPTION file #52 "RTN","IBNCPEV",239,0) DRUG(IBDFN,IBRX) ; "RTN","IBNCPEV",240,0) I +$G(IBDFN)=0 Q "" "RTN","IBNCPEV",241,0) N X1 "RTN","IBNCPEV",242,0) K ^TMP($J,"IBNCPDP52") "RTN","IBNCPEV",243,0) D RX^PSO52API(IBDFN,"IBNCPDP52",IBRX,"",0) "RTN","IBNCPEV",244,0) S X1=+$G(^TMP($J,"IBNCPDP52",IBDFN,IBRX,6)) "RTN","IBNCPEV",245,0) K ^TMP($J,"IBNCPDP52") "RTN","IBNCPEV",246,0) I X1=0 Q "" "RTN","IBNCPEV",247,0) Q $$DRUGNAM^IBNCPEV1(X1) "RTN","IBNCPEV",248,0) ; "RTN","IBNCPEV",249,0) EVNT(X) ;Translate codes "RTN","IBNCPEV",250,0) I X="BILL" Q "BILLING" "RTN","IBNCPEV",251,0) I X="REVERSE" Q "REVERSAL" "RTN","IBNCPEV",252,0) I X="AUTO REVERSE" Q "REVERSAL(A)" "RTN","IBNCPEV",253,0) I X["RELEASE" Q "RELEASE" "RTN","IBNCPEV",254,0) I X["SUBMIT" Q "SUBMIT" "RTN","IBNCPEV",255,0) I X["CLOSE" Q "CLOSE" "RTN","IBNCPEV",256,0) I X[IBSC Q "FINISH" ;IBSC = "STATUS CHECK" "RTN","IBNCPEV",257,0) Q X "RTN","IBNCPEV",258,0) ; "RTN","IBNCPEV",259,0) BOCD(X) ;Basis of Cost Determination "RTN","IBNCPEV",260,0) I +X=7 Q "USUAL & CUSTOMARY" "RTN","IBNCPEV",261,0) I +X=1 Q "AWP" "RTN","IBNCPEV",262,0) I +X=5 Q "COST CALCULATIONS" "RTN","IBNCPEV",263,0) Q X "RTN","IBNCPEV",264,0) ; "RTN","IBNCPEV",265,0) PAUSE ; "RTN","IBNCPEV",266,0) N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" IBQ=1 "RTN","IBNCPEV",267,0) U IO "RTN","IBNCPEV",268,0) Q "RTN","IBNCPEV",269,0) ; "RTN","IBNCPEV",270,0) SUBHDR ; display ECME#, Fill Date, and Release Date (if it exists) "RTN","IBNCPEV",271,0) ; used by many event displays "RTN","IBNCPEV",272,0) W !?10,"ECME#:",$P(IBD1,U,3),", FILL DATE:",$$DAT($P(IBD2,U,6)) "RTN","IBNCPEV",273,0) I $P(IBD2,U,7) W ", RELEASE DATE:",$$TIM($P(IBD2,U,7)) "RTN","IBNCPEV",274,0) Q "RTN","IBNCPEV",275,0) ; "RTN","IBNCPEV",276,0) DISPUSR ; "RTN","IBNCPEV",277,0) W !?10,"USER:",$$USR(+$P(IBD3,U,10)) "RTN","IBNCPEV",278,0) Q "RTN","IBNCPEV",279,0) ; "RTN","IBNCPEV",280,0) ;Returns RX number (external value: #52,.01) "RTN","IBNCPEV",281,0) ;IBRX = IEN in PRESCRIPTION file #52 "RTN","IBNCPEV",282,0) RXNUM(IBRX) ; "RTN","IBNCPEV",283,0) Q $$RXAPI1^IBNCPUT1(IBRX,.01,"E") "RTN","IBNCPEV",284,0) ; "RTN","IBNCPEV1") 0^32^B49201751 "RTN","IBNCPEV1",1,0) IBNCPEV1 ;DALOI/SS - NCPDP BILLING EVENTS REPORT ;21-MAR-2006 "RTN","IBNCPEV1",2,0) ;;2.0;INTEGRATED BILLING;**342,339,363,411,435**;21-MAR-94;Build 27 "RTN","IBNCPEV1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPEV1",4,0) ; "RTN","IBNCPEV1",5,0) ;IA# 10155 is used to read ^DD(file,field,0) node "RTN","IBNCPEV1",6,0) Q "RTN","IBNCPEV1",7,0) ; "RTN","IBNCPEV1",8,0) SETVARS ; "RTN","IBNCPEV1",9,0) ;newed in IBNCPEV "RTN","IBNCPEV1",10,0) S (IBECME,IBPAT,IBRX,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS)=0 "RTN","IBNCPEV1",11,0) ;date "RTN","IBNCPEV1",12,0) F D DATE^IBNCPDPE Q:IBQ Q:$$TESTDATA^IBNCPDPE "RTN","IBNCPEV1",13,0) Q:IBQ "RTN","IBNCPEV1",14,0) N IBMLTDV S IBMLTDV=$$MULTPHRM^BPSUTIL() "RTN","IBNCPEV1",15,0) I +IBMLTDV=1 S IBDIVS=+$$MULTIDIV(.IBDIVS) S:IBDIVS=0 IBDIVS(0)="0^ALL" I IBDIVS=-1 S IBQ=1 Q "RTN","IBNCPEV1",16,0) I +IBMLTDV=0 S IBDIVS=0,IBDIVS(0)="0^"_$P(IBMLTDV,U,2) "RTN","IBNCPEV1",17,0) D MODE^IBNCPDPE Q:IBQ "RTN","IBNCPEV1",18,0) D DEVICE^IBNCPDPE Q:IBQ "RTN","IBNCPEV1",19,0) Q "RTN","IBNCPEV1",20,0) ; "RTN","IBNCPEV1",21,0) ;/** "RTN","IBNCPEV1",22,0) GETRX(IBECMENO,IBST,IBEND,IBECME) ; get ien of file 52 from #366.14 "RTN","IBNCPEV1",23,0) ; input - "RTN","IBNCPEV1",24,0) ; IBECMENO = ECME # input from the user (with or without leading zeros) "RTN","IBNCPEV1",25,0) ; IBST = start date (FM format) "RTN","IBNCPEV1",26,0) ; IBEND = end date (FM format) "RTN","IBNCPEV1",27,0) ; output - function value: returns internal entry number of file #52 for the earliest date within the date range "RTN","IBNCPEV1",28,0) ; IBECME - output variable pass by reference. Returns the external version of the ECME# with leading zeros "RTN","IBNCPEV1",29,0) ; "RTN","IBNCPEV1",30,0) ; This subroutine is called when the user enters an ECME# as part of the search criteria "RTN","IBNCPEV1",31,0) ; "RTN","IBNCPEV1",32,0) N IBDATE,IBNO,IBIEN,IBFOUND,IBRXIEN,ECMELEN,IBRXIEN "RTN","IBNCPEV1",33,0) S (IBFOUND,IBRXIEN)=0 "RTN","IBNCPEV1",34,0) F ECMELEN=12,7 D Q:IBFOUND "RTN","IBNCPEV1",35,0) . I $L(+IBECMENO)>ECMELEN Q "RTN","IBNCPEV1",36,0) . S IBECMENO=$$RJ^XLFSTR(+IBECMENO,ECMELEN,0) ; build ECME# with leading zeros to proper length "RTN","IBNCPEV1",37,0) . S IBDATE=+$O(^IBCNR(366.14,"E",IBECMENO,IBST-1)) Q:'IBDATE "RTN","IBNCPEV1",38,0) . I IBDATE>IBEND Q "RTN","IBNCPEV1",39,0) . S IBNO=+$O(^IBCNR(366.14,"E",IBECMENO,IBDATE,0)) Q:'IBNO "RTN","IBNCPEV1",40,0) . S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0)) Q:'IBIEN "RTN","IBNCPEV1",41,0) . S IBRXIEN=+$P($G(^IBCNR(366.14,IBIEN,1,IBNO,2)),U,1) "RTN","IBNCPEV1",42,0) . I IBRXIEN S IBFOUND=1,IBECME=IBECMENO Q "RTN","IBNCPEV1",43,0) . Q "RTN","IBNCPEV1",44,0) Q IBRXIEN "RTN","IBNCPEV1",45,0) ; "RTN","IBNCPEV1",46,0) ;/** "RTN","IBNCPEV1",47,0) ;finish "RTN","IBNCPEV1",48,0) ;input: "RTN","IBNCPEV1",49,0) ;IBD2 - node ^IBCNR(366.14,D0,1,D1,2) "RTN","IBNCPEV1",50,0) ;IBD3 - node ^IBCNR(366.14,D0,1,D1,3) "RTN","IBNCPEV1",51,0) ;IBD4 - node ^IBCNR(366.14,D0,1,D1,4) "RTN","IBNCPEV1",52,0) ;IBINS - multiple of ^IBCNR(366.14,D0,1,D1,5) "RTN","IBNCPEV1",53,0) ;IBD7 - node ^IBCNR(366.14,D0,1,D1,7) "RTN","IBNCPEV1",54,0) DSTAT(IBD2,IBD3,IBD4,IBINS,IBD7) ; "RTN","IBNCPEV1",55,0) N IBX,IBT,IBSC,IB1ST,IBNXT,IBEXMPV "RTN","IBNCPEV1",56,0) S IB1ST=1 "RTN","IBNCPEV1",57,0) D CHKP^IBNCPEV Q:IBQ "RTN","IBNCPEV1",58,0) W !?10,"ELIGIBILITY: " "RTN","IBNCPEV1",59,0) F IBX=2:1 S IBT=$P($T(EXEMPT+IBX^IBNCPDP1),";",3),IBSC=$P(IBT,U,2) Q:IBSC="" S IBEXMPV=$$EXMPFLDS(IBSC,IBD4) D:IBEXMPV]"" Q:IBQ!(IBEXMPV=3) "RTN","IBNCPEV1",60,0) . I IBEXMPV=3 W "overridden by the user" Q "RTN","IBNCPEV1",61,0) . I 'IB1ST W "," I $X>70 D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1 "RTN","IBNCPEV1",62,0) . W " ",IBSC,":",$S(IBEXMPV=1:"Yes",IBEXMPV=0:"No",IBEXMPV=2:"No Answer",1:"?") S IB1ST=0 "RTN","IBNCPEV1",63,0) Q:IBQ "RTN","IBNCPEV1",64,0) I $P(IBD2,U,4) D CHKP^IBNCPEV Q:IBQ W !?10,"DRUG:",$$DRUGNAM(+$P(IBD2,U,4)) "RTN","IBNCPEV1",65,0) D CHKP^IBNCPEV Q:IBQ W !?10 "RTN","IBNCPEV1",66,0) W "NDC:",$S($P(IBD2,U,5):$P(IBD2,U,5),1:"No"),", BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No"),", COST:",$S($P(IBD3,U,4):$P(IBD3,U,4),1:"No") "RTN","IBNCPEV1",67,0) I $P(IBD2,U,10)]"" W ", DEA:",$P(IBD2,U,10) "RTN","IBNCPEV1",68,0) S IBX=0,IBNXT=0 F S IBX=$O(IBINS(IBX)) Q:'IBX D Q:IBQ S IBNXT=1 "RTN","IBNCPEV1",69,0) .N Y S Y=$P(IBINS(IBX,0),U,2,8) W:'Y "@@@@" Q:'Y "RTN","IBNCPEV1",70,0) .I IBNXT D CHKP^IBNCPEV Q:IBQ W !?10,"-----------" "RTN","IBNCPEV1",71,0) .D CHKP^IBNCPEV Q:IBQ W !?10 "RTN","IBNCPEV1",72,0) .W "PLAN:",$P($G(^IBA(355.3,+Y,0)),U,3)," " "RTN","IBNCPEV1",73,0) .W "INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+Y,0)),0)),U) "RTN","IBNCPEV1",74,0) .I +IBD7>0 W " COB: ",$S(+IBD7=2:"S",1:"P") "RTN","IBNCPEV1",75,0) .D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1 "RTN","IBNCPEV1",76,0) .I $P(Y,U,2)]"" W "BIN:",$P(Y,U,2) S IB1ST=0 "RTN","IBNCPEV1",77,0) .I $P(Y,U,3)]"" W:'IB1ST ", " W "PCN:",$P(Y,U,3) S IB1ST=0 "RTN","IBNCPEV1",78,0) .I $P(Y,U,4)]"" W:'IB1ST ", " W "PAYER SHEET B1:",$P(Y,U,4) S IB1ST=0 "RTN","IBNCPEV1",79,0) .D CHKP^IBNCPEV Q:IBQ W !?10 S IB1ST=1 "RTN","IBNCPEV1",80,0) .S Y=IBINS(IBX,1) "RTN","IBNCPEV1",81,0) .I $P(Y,U,4)]"" W "PAYER SHEET B2:",$P(Y,U,4) S IB1ST=0 "RTN","IBNCPEV1",82,0) .I $P(Y,U,5)]"" W:'IB1ST ", " W "PAYER SHEET B3:",$P(Y,U,5) "RTN","IBNCPEV1",83,0) .S Y=IBINS(IBX,2) "RTN","IBNCPEV1",84,0) .D CHKP^IBNCPEV Q:IBQ "RTN","IBNCPEV1",85,0) .W !?10,"DISPENSING FEE:",$S($L($P(Y,U,1)):$J($P(Y,U,1),0,2),1:"N/A") "RTN","IBNCPEV1",86,0) .W ", BASIS OF COST DETERM:",$S($L($P(Y,U,2)):$$BOCD^IBNCPEV($P(Y,U,2)),1:"N/A") "RTN","IBNCPEV1",87,0) .D CHKP^IBNCPEV Q:IBQ "RTN","IBNCPEV1",88,0) .W !?10,"COST:",$S($L($P(Y,U,3)):$J($P(Y,U,3),0,2),1:"N/A") "RTN","IBNCPEV1",89,0) .W ", GROSS AMT DUE:",$S($L($P(Y,U,4)):$J($P(Y,U,4),0,2),1:"N/A") "RTN","IBNCPEV1",90,0) .W ", ADMIN FEE:",$S($L($P(Y,U,5)):$J($P(Y,U,5),0,2),1:"N/A") "RTN","IBNCPEV1",91,0) Q:IBQ "RTN","IBNCPEV1",92,0) ; "RTN","IBNCPEV1",93,0) D CHKP^IBNCPEV Q:IBQ "RTN","IBNCPEV1",94,0) W !?10,"USER:",$$USR^IBNCPEV(+$P(IBD3,U,10)) "RTN","IBNCPEV1",95,0) Q "RTN","IBNCPEV1",96,0) ; "RTN","IBNCPEV1",97,0) ;get Exemption status by name "RTN","IBNCPEV1",98,0) ;IBEXMP - exemption (like "AO","EC", etc) "RTN","IBNCPEV1",99,0) ;IBNODE - node ^IBCNR(366.14,D0,1,D1,4) "RTN","IBNCPEV1",100,0) EXMPFLDS(IBEXMP,IBNODE) ; "RTN","IBNCPEV1",101,0) Q:IBEXMP="AO" $P(IBNODE,U,1) "RTN","IBNCPEV1",102,0) Q:IBEXMP="CV" $P(IBNODE,U,2) "RTN","IBNCPEV1",103,0) Q:IBEXMP="SWA" $P(IBNODE,U,3) "RTN","IBNCPEV1",104,0) Q:IBEXMP="IR" $P(IBNODE,U,4) "RTN","IBNCPEV1",105,0) Q:IBEXMP="MST" $P(IBNODE,U,5) "RTN","IBNCPEV1",106,0) Q:IBEXMP="HNC" $P(IBNODE,U,6) "RTN","IBNCPEV1",107,0) Q:IBEXMP="SC" $P(IBNODE,U,7) "RTN","IBNCPEV1",108,0) Q:IBEXMP="SHAD" $P(IBNODE,U,8) "RTN","IBNCPEV1",109,0) Q "" "RTN","IBNCPEV1",110,0) ;returns DFN from file #366.14 by prescription ien of file #50 "RTN","IBNCPEV1",111,0) GETDFN(IBRX) ; "RTN","IBNCPEV1",112,0) N IB1,IB2 "RTN","IBNCPEV1",113,0) S IB1=+$O(^IBCNR(366.14,"I",IBRX,0)) "RTN","IBNCPEV1",114,0) I IB1=0 Q 0 "RTN","IBNCPEV1",115,0) S IB2=+$O(^IBCNR(366.14,"I",IBRX,IB1,0)) "RTN","IBNCPEV1",116,0) I IB2=0 Q 0 "RTN","IBNCPEV1",117,0) Q +$P($G(^IBCNR(366.14,IB1,1,IB2,0)),U,3) "RTN","IBNCPEV1",118,0) ; "RTN","IBNCPEV1",119,0) ;return DRUG name (#50,.01) "RTN","IBNCPEV1",120,0) ;IBX1 - ien in file #50 "RTN","IBNCPEV1",121,0) DRUGNAM(IBX1) ; "RTN","IBNCPEV1",122,0) ;Q $P($G(^PSDRUG(IBX1,0)),U) "RTN","IBNCPEV1",123,0) N X "RTN","IBNCPEV1",124,0) K ^TMP($J,"IBNCPDP50") "RTN","IBNCPEV1",125,0) D DATA^PSS50(IBX1,"","","","","IBNCPDP50") "RTN","IBNCPEV1",126,0) S X=$G(^TMP($J,"IBNCPDP50",IBX1,.01)) "RTN","IBNCPEV1",127,0) K ^TMP($J,"IBNCPDP50") "RTN","IBNCPEV1",128,0) Q X "RTN","IBNCPEV1",129,0) ; "RTN","IBNCPEV1",130,0) DRUGAPI(DRUGIEN,FLDNUM) ; "RTN","IBNCPEV1",131,0) ;return a DRUG's field value "RTN","IBNCPEV1",132,0) ;input: "RTN","IBNCPEV1",133,0) ; DRUGIEN - ien #50 "RTN","IBNCPEV1",134,0) ; FLDNUM - field number (like .01) "RTN","IBNCPEV1",135,0) ;output: "RTN","IBNCPEV1",136,0) ; returned value that contains the external value of the specified field "RTN","IBNCPEV1",137,0) N IBARR,DIQ,DIC "RTN","IBNCPEV1",138,0) S DIQ="IBARR",DIQ(0)="E",DIC=50 "RTN","IBNCPEV1",139,0) D EN^PSSDI(50,"IB",DIC,.FLDNUM,.DRUGIEN,.DIQ) "RTN","IBNCPEV1",140,0) Q $G(IBARR(50,DRUGIEN,FLDNUM,"E")) "RTN","IBNCPEV1",141,0) ; "RTN","IBNCPEV1",142,0) ;reopen "RTN","IBNCPEV1",143,0) REOPEN ; "RTN","IBNCPEV1",144,0) D CHKP^IBNCPEV Q:IBQ "RTN","IBNCPEV1",145,0) D SUBHDR^IBNCPEV "RTN","IBNCPEV1",146,0) I +$P(IBD3,U,3) D CHKP^IBNCPEV Q:IBQ W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,+$G(^IBA(355.3,+$P(IBD3,U,3),0)),0)),U) "RTN","IBNCPEV1",147,0) I $L($P(IBD3,U,6))>2 D CHKP^IBNCPEV Q:IBQ W !?10,"REOPEN COMMENTS:",$P(IBD3,U,6) "RTN","IBNCPEV1",148,0) D CHKP^IBNCPEV Q:IBQ "RTN","IBNCPEV1",149,0) D DISPUSR^IBNCPEV "RTN","IBNCPEV1",150,0) Q "RTN","IBNCPEV1",151,0) ; "RTN","IBNCPEV1",152,0) ;Prompts user to select multiple divisions (BPS PHARMACIES) "RTN","IBNCPEV1",153,0) ; in order to filter the report by division(s) or for ALL divisions "RTN","IBNCPEV1",154,0) ; "RTN","IBNCPEV1",155,0) ;returns composite value: "RTN","IBNCPEV1",156,0) ;1st piece "RTN","IBNCPEV1",157,0) ; 1 - divisions were selected "RTN","IBNCPEV1",158,0) ; 0 - divisions were NOT selected "RTN","IBNCPEV1",159,0) ; -1 if up arrow entered or timeout "RTN","IBNCPEV1",160,0) ;2nd piece "RTN","IBNCPEV1",161,0) ; A-all or D - division(s) in the BPS PHARMACIES file #9002313.56) "RTN","IBNCPEV1",162,0) ; "RTN","IBNCPEV1",163,0) ;and by reference: "RTN","IBNCPEV1",164,0) ;IBPSPHAR (only if the user selects "D") - a local array with iens and names "RTN","IBNCPEV1",165,0) ; of BPS PHARMACIES (file #9002313.56) selected by the user "RTN","IBNCPEV1",166,0) ; IBPSPHAR(ien of file #9002313.56) = ien of file #9002313.56 ^ name of the BPS PHARMACY "RTN","IBNCPEV1",167,0) ; "RTN","IBNCPEV1",168,0) MULTIDIV(IBPSPHAR) ; "RTN","IBNCPEV1",169,0) N IBDIVCNT,IBANSW,IBRETV "RTN","IBNCPEV1",170,0) S IBRETV=$$SELPHARM^BPSUTIL(.IBPSPHAR) "RTN","IBNCPEV1",171,0) I IBRETV="^" Q -1 ;exit "RTN","IBNCPEV1",172,0) I IBRETV="A" Q "0^A" "RTN","IBNCPEV1",173,0) Q "1^D" "RTN","IBNCPEV1",174,0) ; "RTN","IBNCPEV1",175,0) ;check if ePharmacy division in IB36614 in among those selected by the user "RTN","IBNCPEV1",176,0) ;IBDIVS - a local array (by reference) with divisions selected by the user "RTN","IBNCPEV1",177,0) ;returns 0 - not among selected divisions, 1 - among them "RTN","IBNCPEV1",178,0) CHECKDIV(IB36614,IBDIVS) ; "RTN","IBNCPEV1",179,0) I $D(IBDIVS(IB36614)) Q 1 "RTN","IBNCPEV1",180,0) Q 0 "RTN","IBNCPEV1",181,0) ; "RTN","IBNCPEV1",182,0) ;Compile the string for divisions "RTN","IBNCPEV1",183,0) ;input: "RTN","IBNCPEV1",184,0) ;IBDVS - division local array by reference "RTN","IBNCPEV1",185,0) ;output: "RTN","IBNCPEV1",186,0) ; return value with the resulting string "RTN","IBNCPEV1",187,0) DISPLDIV(IBDVS) ; "RTN","IBNCPEV1",188,0) I ('$D(IBDVS))!($G(IBDVS)="") Q "" ;invalid parameters "RTN","IBNCPEV1",189,0) I IBDVS=0 Q "" ;if "all" or single division "RTN","IBNCPEV1",190,0) N IBZ,IBCNT,IBDIVSTR "RTN","IBNCPEV1",191,0) S IBDIVSTR="" "RTN","IBNCPEV1",192,0) S IBZ=0,IBCNT=0 "RTN","IBNCPEV1",193,0) F S IBZ=$O(IBDVS(IBZ)) Q:+IBZ=0 D "RTN","IBNCPEV1",194,0) . I IBCNT>0 S IBDIVSTR=IBDIVSTR_", " "RTN","IBNCPEV1",195,0) . S IBCNT=IBCNT+1 "RTN","IBNCPEV1",196,0) . S IBDIVSTR=IBDIVSTR_$P(IBDVS(IBZ),U,2) "RTN","IBNCPEV1",197,0) I $L(IBDIVSTR)'<80 S IBDIVSTR=$E(IBDIVSTR,1,75)_"..." "RTN","IBNCPEV1",198,0) Q $$CENTERIT(IBDIVSTR,80) "RTN","IBNCPEV1",199,0) ; "RTN","IBNCPEV1",200,0) ;Compile the string for title "RTN","IBNCPEV1",201,0) ;input: "RTN","IBNCPEV1",202,0) ;IBBDT - begin date "RTN","IBNCPEV1",203,0) ;IBEDT - end date "RTN","IBNCPEV1",204,0) ;IBDTL - summary/detail mode "RTN","IBNCPEV1",205,0) ;IBDIVS - division local array by reference "RTN","IBNCPEV1",206,0) ;output: "RTN","IBNCPEV1",207,0) ; return value with the resulting string "RTN","IBNCPEV1",208,0) DISPTITL(IBBDT,IBEDT,IBDTL,IBDIVS) ; "RTN","IBNCPEV1",209,0) I ('$D(IBDIVS))!($G(IBDIVS)="")!($G(IBBDT)="")!($G(IBEDT)="")!($G(IBDTL)="") Q "" ;invalid parameters "RTN","IBNCPEV1",210,0) N IBTITL "RTN","IBNCPEV1",211,0) S IBTITL="BILLING ECME EVENTS ON "_$$DAT^IBNCPEV(IBBDT) "RTN","IBNCPEV1",212,0) I IBBDT'=IBEDT S IBTITL=IBTITL_" TO "_$$DAT^IBNCPEV(IBEDT) "RTN","IBNCPEV1",213,0) S IBTITL=IBTITL_" ("_$S(IBDTL:"DETAILED",1:"SUMMARY")_") for " "RTN","IBNCPEV1",214,0) I IBDIVS'=0 S IBTITL=IBTITL_"SELECTED DIVISIONS:" "RTN","IBNCPEV1",215,0) I IBDIVS=0 S IBTITL=IBTITL_$P(IBDIVS(0),U,2)_" DIVISION" I $P(IBDIVS(0),U,2)="ALL" S IBTITL=IBTITL_"S" "RTN","IBNCPEV1",216,0) Q $$CENTERIT(IBTITL,80) "RTN","IBNCPEV1",217,0) ; "RTN","IBNCPEV1",218,0) ;Center the string (add left pads to center the string) "RTN","IBNCPEV1",219,0) ;input: "RTN","IBNCPEV1",220,0) ;IBSTR - input string "RTN","IBNCPEV1",221,0) ;IBMAXLEN - max len "RTN","IBNCPEV1",222,0) ;output: "RTN","IBNCPEV1",223,0) ; return value with the resulting string "RTN","IBNCPEV1",224,0) CENTERIT(IBSTR,IBMAXLEN) ; "RTN","IBNCPEV1",225,0) I ($G(IBSTR)="")!(+$G(IBMAXLEN)=0) Q "" "RTN","IBNCPEV1",226,0) N IBLEFT,IBSP "RTN","IBNCPEV1",227,0) S IBSTR=$E(IBSTR,1,IBMAXLEN) "RTN","IBNCPEV1",228,0) S IBLEFT=((IBMAXLEN-$L(IBSTR))/2)\1 "RTN","IBNCPEV1",229,0) S IBSP="" "RTN","IBNCPEV1",230,0) S $P(IBSP," ",IBLEFT+1)="" "RTN","IBNCPEV1",231,0) Q IBSP_IBSTR "RTN","IBNCPEV1",232,0) ;Get list of indicators that were not answered "RTN","IBNCPEV1",233,0) GETNOANS(IBD4) ; "RTN","IBNCPEV1",234,0) N IBX,IBT,IBSC,IBEXMPV,IBQ,IBRET "RTN","IBNCPEV1",235,0) S IBQ=0,IBRET="" "RTN","IBNCPEV1",236,0) F IBX=2:1 S IBT=$P($T(EXEMPT+IBX^IBNCPDP1),";",3),IBSC=$P(IBT,U,2) Q:IBSC="" S IBEXMPV=$$EXMPFLDS^IBNCPEV1(IBSC,IBD4) D:IBEXMPV]"" "RTN","IBNCPEV1",237,0) . I IBEXMPV=2 S IBRET=IBRET_","_IBSC "RTN","IBNCPEV1",238,0) Q $S(IBRET="":"SC",1:$E(IBRET,2,99)) "RTN","IBNCPEV1",239,0) ;IBNCPEV1 "RTN","IBNCPIV") 0^10^B54267861 "RTN","IBNCPIV",1,0) IBNCPIV ;ALB/ESG - Manual Rx Eligibility Verification ;23-SEP-2010 "RTN","IBNCPIV",2,0) ;;2.0;INTEGRATED BILLING;**435**;21-MAR-94;Build 27 "RTN","IBNCPIV",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPIV",4,0) ; "RTN","IBNCPIV",5,0) ; Reference to EN^BPSNCPD9 supported by IA# 5576 "RTN","IBNCPIV",6,0) ; Reference to PID^VADPT6 supported by IA# 10062 "RTN","IBNCPIV",7,0) ; Reference to DT^DICRW supported by IA# 10005 "RTN","IBNCPIV",8,0) ; "RTN","IBNCPIV",9,0) Q "RTN","IBNCPIV",10,0) ; "RTN","IBNCPIV",11,0) EN ; -- main entry point for IBNCPDP INS ELIG VER INQ "RTN","IBNCPIV",12,0) N IBNCPIVD,DFN "RTN","IBNCPIV",13,0) D DT^DICRW "RTN","IBNCPIV",14,0) S IBNCPIVD=DT ; first time in compile Active Rx ins as of today "RTN","IBNCPIV",15,0) D EN^VALM("IBNCPDP INS ELIG VER INQ") "RTN","IBNCPIV",16,0) Q "RTN","IBNCPIV",17,0) ; "RTN","IBNCPIV",18,0) HDR ; -- header code "RTN","IBNCPIV",19,0) N VA,NAME "RTN","IBNCPIV",20,0) D PID^VADPT6 "RTN","IBNCPIV",21,0) S NAME=$P($G(^DPT($G(DFN),0)),U,1) "RTN","IBNCPIV",22,0) S VALMHDR(1)="Perform Rx Eligibility Insurance Inquiry" "RTN","IBNCPIV",23,0) S VALMHDR(2)=" Patient: "_$E(NAME,1,20)_" ("_$E(NAME)_$G(VA("BID"))_")" "RTN","IBNCPIV",24,0) S VALMHDR(3)=" Showing: All Insurance Policies on File" "RTN","IBNCPIV",25,0) I $G(IBNCPIVD) S VALMHDR(3)=" Showing: Active Rx Policies as of Effective Date "_$$FMTE^XLFDT(IBNCPIVD,"2Z") "RTN","IBNCPIV",26,0) S VALMHDR(4)=" " "RTN","IBNCPIV",27,0) I +$$BUFFER^IBCNBU1($G(DFN)) S VALMHDR(4)=" Buffer: *** Patient has Insurance Buffer Records ***" "RTN","IBNCPIV",28,0) Q "RTN","IBNCPIV",29,0) ; "RTN","IBNCPIV",30,0) INIT ; Build the list of valid insurance policies "RTN","IBNCPIV",31,0) D INIT^IBCNSM4 "RTN","IBNCPIV",32,0) Q "RTN","IBNCPIV",33,0) ; "RTN","IBNCPIV",34,0) HELP ; -- help code "RTN","IBNCPIV",35,0) S X="?" D DISP^XQORM1 W !! "RTN","IBNCPIV",36,0) Q "RTN","IBNCPIV",37,0) ; "RTN","IBNCPIV",38,0) EXIT ; -- exit code "RTN","IBNCPIV",39,0) K ^TMP("IBNSM",$J),^TMP("IBNSMDX",$J) "RTN","IBNCPIV",40,0) D CLEAN^VALM10 "RTN","IBNCPIV",41,0) Q "RTN","IBNCPIV",42,0) ; "RTN","IBNCPIV",43,0) SEND ; send the ELIG inquiry "RTN","IBNCPIV",44,0) N VALMY,IBDATA,IBRES,IBX,IBY,IBPPOL,INSIEN,INSNM,GENERR,IBPL,IBCDFN,EPHPLAN,IBSTL,LIST,G,IBSTA,TXT,DEFDT "RTN","IBNCPIV",45,0) N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,LOCKFLG,IBREL,IBPER "RTN","IBNCPIV",46,0) D FULL^VALM1 "RTN","IBNCPIV",47,0) D EN^VALM2($G(XQORNOD(0)),"S") ; user selection - 1 entry from the list "RTN","IBNCPIV",48,0) I '$D(VALMY) G SENDX "RTN","IBNCPIV",49,0) S IBX=$O(VALMY(0)) I 'IBX G SENDX "RTN","IBNCPIV",50,0) S IBPPOL=$G(^TMP("IBNSMDX",$J,+$O(^TMP("IBNSM",$J,"IDX",IBX,0)))) "RTN","IBNCPIV",51,0) I IBPPOL="" W !!,$T(+0)_" - System error - policy data not found!" D PAUSE^VALM1 G SENDX "RTN","IBNCPIV",52,0) S INSIEN=+$P(IBPPOL,U,5) ; file 36 ien "RTN","IBNCPIV",53,0) S INSNM=$P($G(^DIC(36,INSIEN,0)),U,1) ; ins company name "RTN","IBNCPIV",54,0) S GENERR="Unable to submit Eligibility Verification Inquiry to "_INSNM_"." "RTN","IBNCPIV",55,0) S IBPL=+$P(IBPPOL,U,22) ; plan file 355.3 ien "RTN","IBNCPIV",56,0) I 'IBPL W !!,GENERR,!,"This policy has no plan." D PAUSE^VALM1 G SENDX "RTN","IBNCPIV",57,0) S IBDATA("PLAN")=IBPL ; plan file 355.3 ien "RTN","IBNCPIV",58,0) S IBCDFN=+$P(IBPPOL,U,4) ; subfile 2.312 ien "RTN","IBNCPIV",59,0) ; "RTN","IBNCPIV",60,0) ; lock check "RTN","IBNCPIV",61,0) L +^IBDPTL(DFN,IBCDFN):$G(DILOCKTM,3) "RTN","IBNCPIV",62,0) E W !!,GENERR,!,"Another user is currently processing the same patient and policy!" D PAUSE^VALM1 G SENDX "RTN","IBNCPIV",63,0) S LOCKFLG=1 "RTN","IBNCPIV",64,0) ; "RTN","IBNCPIV",65,0) S EPHPLAN=+$P($G(^IBA(355.3,IBPL,6)),U,1) ; epharmacy plan ien "RTN","IBNCPIV",66,0) I 'EPHPLAN W !!,GENERR,!,"This policy's plan is not linked with an ePharmacy plan." D PAUSE^VALM1 G SENDX "RTN","IBNCPIV",67,0) ; "RTN","IBNCPIV",68,0) ; scan for any other errors and display them all "RTN","IBNCPIV",69,0) K IBY D STCHK^IBCNRU1(EPHPLAN,.IBY,1) "RTN","IBNCPIV",70,0) I $E($G(IBY(1)))'="A" D G SENDX "RTN","IBNCPIV",71,0) . S IBSTL=$G(IBY(6)) ; list of error msg code#'s "RTN","IBNCPIV",72,0) . K LIST "RTN","IBNCPIV",73,0) . D STATAR^IBCNRU1(.LIST) ; build the list of error messages "RTN","IBNCPIV",74,0) . W !!,GENERR "RTN","IBNCPIV",75,0) . F G=1:1:$L(IBSTL,",") S IBSTA=+$P(IBSTL,",",G),TXT=$G(LIST(IBSTA)) I TXT'="" W !,TXT "RTN","IBNCPIV",76,0) . D PAUSE^VALM1 "RTN","IBNCPIV",77,0) . Q "RTN","IBNCPIV",78,0) ; "RTN","IBNCPIV",79,0) ; Ask for Effective Date for the ELIG transmission "RTN","IBNCPIV",80,0) S DEFDT=$G(IBNCPIVD) "RTN","IBNCPIV",81,0) I 'DEFDT S DEFDT=DT ; default date "RTN","IBNCPIV",82,0) S DIR(0)="D" "RTN","IBNCPIV",83,0) S DIR("A")="Effective Date" "RTN","IBNCPIV",84,0) S DIR("?")="Enter the Date for which to perform the Eligibility Verification check." "RTN","IBNCPIV",85,0) S DIR("B")=$$FMTE^XLFDT(DEFDT,"2Z") "RTN","IBNCPIV",86,0) W ! D ^DIR K DIR "RTN","IBNCPIV",87,0) I $D(DTOUT)!$D(DUOUT)!('Y) G SENDX "RTN","IBNCPIV",88,0) ; "RTN","IBNCPIV",89,0) ; check for pharmacy coverage as of this date "RTN","IBNCPIV",90,0) I '$$PLCOV^IBCNSU3(IBPL,Y,3) W !!,GENERR,!,"This policy has no Active Pharmacy Coverage on this date." D PAUSE^VALM1 G SENDX "RTN","IBNCPIV",91,0) S IBDATA("FILL DATE")=Y "RTN","IBNCPIV",92,0) ; "RTN","IBNCPIV",93,0) ; Ask for Relationship Code "RTN","IBNCPIV",94,0) S IBREL=+$P($G(^DPT(DFN,.312,IBCDFN,0)),U,16) ; pt. relationship to insured (2.312,16) "RTN","IBNCPIV",95,0) I IBREL'<4 S IBREL=4 "RTN","IBNCPIV",96,0) S DIC=9002313.19 "RTN","IBNCPIV",97,0) S DIC(0)="AEQZ" "RTN","IBNCPIV",98,0) S DIC("A")="Relationship Code: " "RTN","IBNCPIV",99,0) S DIC("B")=IBREL "RTN","IBNCPIV",100,0) W ! D ^DIC K DIC "RTN","IBNCPIV",101,0) I $D(DTOUT)!$D(DUOUT)!(Y'>0) G SENDX "RTN","IBNCPIV",102,0) S IBDATA("REL CODE")=$P(Y,U,2) "RTN","IBNCPIV",103,0) ; "RTN","IBNCPIV",104,0) ; Ask for Person Code "RTN","IBNCPIV",105,0) S IBPER=IBDATA("REL CODE") "RTN","IBNCPIV",106,0) S IBPER=$S(IBPER:0_IBPER,1:"01") ; base the default value on the selected relationship code "RTN","IBNCPIV",107,0) S DIR(0)="FO^1:3" "RTN","IBNCPIV",108,0) S DIR("A")="Person Code" "RTN","IBNCPIV",109,0) S DIR("?",1)="Enter the Specific Person Code Assigned to the Patient by the Payer." "RTN","IBNCPIV",110,0) S DIR("?",2)="This is a code assigned to a specific person within a family." "RTN","IBNCPIV",111,0) S DIR("?",3)=" " "RTN","IBNCPIV",112,0) S DIR("?",4)="Enrollment Standard Examples" "RTN","IBNCPIV",113,0) S DIR("?",5)="----------------------------" "RTN","IBNCPIV",114,0) S DIR("?",6)="001=Cardholder" "RTN","IBNCPIV",115,0) S DIR("?",7)="002=Spouse" "RTN","IBNCPIV",116,0) S DIR("?")="003-999=Dependents and Others (including second spouses, etc.)" "RTN","IBNCPIV",117,0) S DIR("B")=IBPER "RTN","IBNCPIV",118,0) W ! D ^DIR K DIR "RTN","IBNCPIV",119,0) I $D(DTOUT)!$D(DUOUT) G SENDX "RTN","IBNCPIV",120,0) S IBDATA("PERSON CODE")=Y "RTN","IBNCPIV",121,0) ; "RTN","IBNCPIV",122,0) ; call BPS to send the elig transaction "RTN","IBNCPIV",123,0) S IBRES=$$EN^BPSNCPD9(DFN,.IBDATA) "RTN","IBNCPIV",124,0) ; "RTN","IBNCPIV",125,0) ; success! "RTN","IBNCPIV",126,0) I +IBRES W !!,"Eligibility Verification Inquiry sent to "_INSNM_".",!,$P(IBRES,U,2) D PAUSE^VALM1 G SENDX "RTN","IBNCPIV",127,0) ; "RTN","IBNCPIV",128,0) ; error "RTN","IBNCPIV",129,0) W !!,"Failure to submit Eligibility Verification Inquiry to "_INSNM_"." "RTN","IBNCPIV",130,0) W !,$P(IBRES,U,2) "RTN","IBNCPIV",131,0) D PAUSE^VALM1 "RTN","IBNCPIV",132,0) ; "RTN","IBNCPIV",133,0) SENDX ; "RTN","IBNCPIV",134,0) I $G(LOCKFLG) L -^IBDPTL(DFN,IBCDFN) ; unlock "RTN","IBNCPIV",135,0) S VALMBCK="R" "RTN","IBNCPIV",136,0) Q "RTN","IBNCPIV",137,0) ; "RTN","IBNCPIV",138,0) CP ; Change Patient "RTN","IBNCPIV",139,0) N VALMQUIT,IBDFN "RTN","IBNCPIV",140,0) D FULL^VALM1 "RTN","IBNCPIV",141,0) S IBDFN=$G(DFN) "RTN","IBNCPIV",142,0) W ! D PAT^IBCNSM "RTN","IBNCPIV",143,0) I $D(VALMQUIT) S DFN=IBDFN "RTN","IBNCPIV",144,0) I IBDFN=$G(DFN) G CPX ; no changes "RTN","IBNCPIV",145,0) K VALMHDR "RTN","IBNCPIV",146,0) D INIT "RTN","IBNCPIV",147,0) CPX ; "RTN","IBNCPIV",148,0) S VALMBCK="R" "RTN","IBNCPIV",149,0) Q "RTN","IBNCPIV",150,0) ; "RTN","IBNCPIV",151,0) CHGD ; change the date for the screen display "RTN","IBNCPIV",152,0) N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,ORIG,DEFDT "RTN","IBNCPIV",153,0) S (ORIG,DEFDT)=$G(IBNCPIVD) ; save the original value coming in "RTN","IBNCPIV",154,0) I 'DEFDT S DEFDT=DT ; always have a default date "RTN","IBNCPIV",155,0) D FULL^VALM1 "RTN","IBNCPIV",156,0) S DIR(0)="D" "RTN","IBNCPIV",157,0) S DIR("A")="Enter the Effective Date" "RTN","IBNCPIV",158,0) S DIR("B")=$$FMTE^XLFDT(DEFDT,"2Z") "RTN","IBNCPIV",159,0) S DIR("?",1)="Please enter the effective date to be used in order to look-up active" "RTN","IBNCPIV",160,0) S DIR("?",2)="pharmacy insurance policies as of this effective date. The effective" "RTN","IBNCPIV",161,0) S DIR("?",3)="date used for the current screen display is found in the header of" "RTN","IBNCPIV",162,0) S DIR("?")="this screen unless ALL insurance policies are displayed." "RTN","IBNCPIV",163,0) W ! D ^DIR K DIR "RTN","IBNCPIV",164,0) I Y S IBNCPIVD=Y "RTN","IBNCPIV",165,0) I ORIG=$G(IBNCPIVD) G CHGDX ; no changes to date "RTN","IBNCPIV",166,0) K VALMHDR "RTN","IBNCPIV",167,0) D INIT "RTN","IBNCPIV",168,0) CHGDX ; "RTN","IBNCPIV",169,0) S VALMBCK="R" "RTN","IBNCPIV",170,0) Q "RTN","IBNCPIV",171,0) ; "RTN","IBNCPIV",172,0) TOGGLE ; toggle the display between all ins policies and Rx only policies "RTN","IBNCPIV",173,0) ; "RTN","IBNCPIV",174,0) N CASE,TEXT,PROMPT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT "RTN","IBNCPIV",175,0) D FULL^VALM1 "RTN","IBNCPIV",176,0) ; "RTN","IBNCPIV",177,0) I $G(IBNCPIVD) D "RTN","IBNCPIV",178,0) . S CASE=1 "RTN","IBNCPIV",179,0) . S TEXT="The screen is now showing Active Rx Insurance as of "_$$FMTE^XLFDT(IBNCPIVD,"2Z")_"." "RTN","IBNCPIV",180,0) . S PROMPT="Do you want to display ALL insurance on file" "RTN","IBNCPIV",181,0) . Q "RTN","IBNCPIV",182,0) ; "RTN","IBNCPIV",183,0) I '$G(IBNCPIVD) D "RTN","IBNCPIV",184,0) . S CASE=2 "RTN","IBNCPIV",185,0) . S TEXT="The screen is now showing ALL insurance on file." "RTN","IBNCPIV",186,0) . S PROMPT="Do you want to display only Active Rx Insurance" "RTN","IBNCPIV",187,0) . Q "RTN","IBNCPIV",188,0) ; "RTN","IBNCPIV",189,0) S DIR(0)="Y" "RTN","IBNCPIV",190,0) S DIR("A")=PROMPT "RTN","IBNCPIV",191,0) S DIR("A",1)=TEXT "RTN","IBNCPIV",192,0) S DIR("B")="YES" "RTN","IBNCPIV",193,0) W ! D ^DIR K DIR "RTN","IBNCPIV",194,0) I 'Y G TOGGX ; user said NO, no changes so get out "RTN","IBNCPIV",195,0) ; "RTN","IBNCPIV",196,0) I CASE=1 K IBNCPIVD,VALMHDR D INIT G TOGGX ; change to ALL insurance/rebuild list "RTN","IBNCPIV",197,0) ; "RTN","IBNCPIV",198,0) D CHGD ; change to Active Rx only ins/get effective date & rebuild list "RTN","IBNCPIV",199,0) ; "RTN","IBNCPIV",200,0) TOGGX ; "RTN","IBNCPIV",201,0) S VALMBCK="R" "RTN","IBNCPIV",202,0) Q "RTN","IBNCPIV",203,0) ; "RTN","IBNCPLOG") 0^31^B64598922 "RTN","IBNCPLOG",1,0) IBNCPLOG ;BHAM ISC/SS - IB ECME EVNT REPORT ;3/5/08 14:02 "RTN","IBNCPLOG",2,0) ;;2.0;INTEGRATED BILLING;**342,339,363,383,411,435**;21-MAR-94;Build 27 "RTN","IBNCPLOG",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPLOG",4,0) ; "RTN","IBNCPLOG",5,0) ;store data related to the IB calls made by ECME package in the file #366.14 "RTN","IBNCPLOG",6,0) ;input: "RTN","IBNCPLOG",7,0) ;.IBIBD - (by reference) IBD array with parameter sent to IB by ECME "RTN","IBNCPLOG",8,0) ;DFN patient's ien "RTN","IBNCPLOG",9,0) ;IBPROC - type of event. i.e. content of CALL such as BILL, REJECT and so on "RTN","IBNCPLOG",10,0) ;IBRESULT - (optional) result of the event processing, format: return_code^message "RTN","IBNCPLOG",11,0) ;IBJOB - (optional) job, default = $J "RTN","IBNCPLOG",12,0) ;IBDTTM - (optional) datetime, default = "NOW" "RTN","IBNCPLOG",13,0) ;IBUSR - (optional) user ID, default = DUZ "RTN","IBNCPLOG",14,0) ;output: "RTN","IBNCPLOG",15,0) ;none "RTN","IBNCPLOG",16,0) LOG(IBIBD,DFN,IBPROC,IBRESULT,IBJOB,IBDTTM,IBUSR) ;Store the data "RTN","IBNCPLOG",17,0) N NDX,Z,REF,IBDATE,IBDTIEN,IBEVNIEN,IBIBDTYP,IBRETV "RTN","IBNCPLOG",18,0) S IBRESULT=$G(IBRESULT) "RTN","IBNCPLOG",19,0) ; "RTN","IBNCPLOG",20,0) I '$G(IBJOB) S IBJOB=$J "RTN","IBNCPLOG",21,0) I '$G(IBDTTM) S IBDTTM=$$NOW^XLFDT() "RTN","IBNCPLOG",22,0) I '$G(IBUSR) S IBUSR=+DUZ "RTN","IBNCPLOG",23,0) ; "RTN","IBNCPLOG",24,0) S IBDATE=DT "RTN","IBNCPLOG",25,0) S IBDTIEN=+$O(^IBCNR(366.14,"B",IBDATE,0)) "RTN","IBNCPLOG",26,0) L +^IBCNR(366.14):30 E Q "RTN","IBNCPLOG",27,0) I IBDTIEN=0 S IBDTIEN=+$$ADDDATE(IBDATE) "RTN","IBNCPLOG",28,0) ;create an event "RTN","IBNCPLOG",29,0) S IBEVNIEN=$$NEWEVENT(IBDTIEN,IBPROC) "RTN","IBNCPLOG",30,0) L -^IBCNR(366.14) "RTN","IBNCPLOG",31,0) I IBEVNIEN=0 W !,"New event creation Error : LOG^IBNCPLOG",! Q "RTN","IBNCPLOG",32,0) ; "RTN","IBNCPLOG",33,0) I +$$FILLFLDS^IBNCPUT1(366.141,".03",IBEVNIEN_","_IBDTIEN,DFN) ;DFN "RTN","IBNCPLOG",34,0) I +$$FILLFLDS^IBNCPUT1(366.141,".04",IBEVNIEN_","_IBDTIEN,IBJOB) ;JOB "RTN","IBNCPLOG",35,0) I +$$FILLFLDS^IBNCPUT1(366.141,".05",IBEVNIEN_","_IBDTIEN,IBDTTM) ;DATETIME "RTN","IBNCPLOG",36,0) I +$$FILLFLDS^IBNCPUT1(366.141,".06",IBEVNIEN_","_IBDTIEN,DUZ) ;USER "RTN","IBNCPLOG",37,0) I IBRESULT'="" D "RTN","IBNCPLOG",38,0) . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".07",IBEVNIEN_","_IBDTIEN,+IBRESULT) ;RESULT "RTN","IBNCPLOG",39,0) . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".08",IBEVNIEN_","_IBDTIEN,$P(IBRESULT,U,2)) ;RESULT MESSAGE "RTN","IBNCPLOG",40,0) ;store IBIBD array "RTN","IBNCPLOG",41,0) S IBIBDTYP="" "RTN","IBNCPLOG",42,0) F S IBIBDTYP=$O(IBIBD(IBIBDTYP)) Q:IBIBDTYP="" D "RTN","IBNCPLOG",43,0) . D IBD(IBDTIEN,IBEVNIEN,IBIBDTYP,$G(IBIBD(IBIBDTYP)),.IBIBD) "RTN","IBNCPLOG",44,0) ;store "INS" node of IBIBD array "RTN","IBNCPLOG",45,0) I $D(IBIBD("INS")) I $$INS(.IBIBD,IBDTIEN,IBEVNIEN) "RTN","IBNCPLOG",46,0) Q "RTN","IBNCPLOG",47,0) ; "RTN","IBNCPLOG",48,0) ;store IBD array data "RTN","IBNCPLOG",49,0) ;IBDTIEN - ien on top [DATE] level "RTN","IBNCPLOG",50,0) ;IBRECNO - ien in [EVENTS] multiple "RTN","IBNCPLOG",51,0) ;IBIBDTYP - type subscript in IBD array (BILL, PAID, RESPONSE, etc) "RTN","IBNCPLOG",52,0) ;IBVAL - value to store "RTN","IBNCPLOG",53,0) ;IBIBD - array with data passed by reference (for efficiency) "RTN","IBNCPLOG",54,0) IBD(IBDTIEN,IBRECNO,IBIBDTYP,IBVAL,IBIBD) ; "RTN","IBNCPLOG",55,0) N IBFLDNO "RTN","IBNCPLOG",56,0) ;W !," - ",IBRECNO," ",IBIBDTYP," = ",IBVAL "RTN","IBNCPLOG",57,0) ;free text like "WEBMD: PAID" "RTN","IBNCPLOG",58,0) I IBIBDTYP="AUTH #" S IBFLDNO=".11",IBVAL=$E(IBVAL,1,30) G EDITIBD "RTN","IBNCPLOG",59,0) ;free text like "0504597;3051229" "RTN","IBNCPLOG",60,0) I IBIBDTYP="BCID" S IBFLDNO=".12" G EDITIBD "RTN","IBNCPLOG",61,0) ;7 or 12 digit ECME number - identifier (stored as a text - might have leading zeroes) "RTN","IBNCPLOG",62,0) I IBIBDTYP="CLAIMID" S IBFLDNO=".13" G EDITIBD "RTN","IBNCPLOG",63,0) ;pointer to file #2 "RTN","IBNCPLOG",64,0) I IBIBDTYP="DFN" S IBFLDNO=".14" G EDITIBD "RTN","IBNCPLOG",65,0) ;pointer to file #40.8 "RTN","IBNCPLOG",66,0) I IBIBDTYP="DIVISION" S IBFLDNO=".15" G EDITIBD "RTN","IBNCPLOG",67,0) ;free text "RTN","IBNCPLOG",68,0) I IBIBDTYP="RESPONSE" S IBFLDNO=".16",IBVAL=$E(IBVAL,1,20) G EDITIBD "RTN","IBNCPLOG",69,0) ;free text "RTN","IBNCPLOG",70,0) I IBIBDTYP="REVERSAL REASON" S IBFLDNO=".17",IBVAL=$E(IBVAL,1,40) G EDITIBD "RTN","IBNCPLOG",71,0) ;1 digit number "RTN","IBNCPLOG",72,0) I IBIBDTYP="RTS-DEL" S IBFLDNO=".18" G EDITIBD "RTN","IBNCPLOG",73,0) ;free text "RTN","IBNCPLOG",74,0) I IBIBDTYP="STATUS" S IBFLDNO=".19",IBVAL=$E(IBVAL,1,20) G EDITIBD "RTN","IBNCPLOG",75,0) ;Prescription number as a text, might have alpha characters (external value, this is not IEN) "RTN","IBNCPLOG",76,0) I IBIBDTYP="RX NO" S IBFLDNO=".202",IBVAL=$E(IBVAL,1,20) G EDITIBD "RTN","IBNCPLOG",77,0) ;0 - original, 1,2,3,... - refill number "RTN","IBNCPLOG",78,0) I IBIBDTYP="FILL NUMBER" S IBFLDNO=".203" G EDITIBD "RTN","IBNCPLOG",79,0) ;internal identifier number for a DRUG "RTN","IBNCPLOG",80,0) I IBIBDTYP="DRUG" S IBFLDNO=".204" G EDITIBD "RTN","IBNCPLOG",81,0) I IBIBDTYP="NDC" S IBFLDNO=".205" G EDITIBD "RTN","IBNCPLOG",82,0) I IBIBDTYP="FILL DATE" S IBFLDNO=".206" G EDITIBD "RTN","IBNCPLOG",83,0) I IBIBDTYP="RELEASE DATE" S IBFLDNO=".207" G EDITIBD "RTN","IBNCPLOG",84,0) I IBIBDTYP="QTY" S IBFLDNO=".208" G EDITIBD "RTN","IBNCPLOG",85,0) I IBIBDTYP="DAYS SUPPLY" S IBFLDNO=".209" G EDITIBD "RTN","IBNCPLOG",86,0) I IBIBDTYP="DEA" S IBFLDNO=".21" G EDITIBD "RTN","IBNCPLOG",87,0) I IBIBDTYP="FILLED BY" S IBFLDNO=".211" G EDITIBD "RTN","IBNCPLOG",88,0) I IBIBDTYP="COPAY" S IBFLDNO=".311" G EDITIBD "RTN","IBNCPLOG",89,0) ; for environmental indicators: "RTN","IBNCPLOG",90,0) ; if IBIBD("SC/EI OVR")=1 - the user overrides any answers (3) "RTN","IBNCPLOG",91,0) ; if $G(IBIBD("SC/EI NO ANSW")) contains the IBIBDTYP - this question was not answered (2) "RTN","IBNCPLOG",92,0) ; otherwise - use whatever in the IBVAL (0 - NO, 1 -YES) "RTN","IBNCPLOG",93,0) I IBIBDTYP="AO" S IBFLDNO=".401",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",94,0) I IBIBDTYP="CV" S IBFLDNO=".402",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",95,0) I IBIBDTYP="SWA" S IBFLDNO=".403",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",96,0) I IBIBDTYP="IR" S IBFLDNO=".404",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",97,0) I IBIBDTYP="MST" S IBFLDNO=".405",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",98,0) I IBIBDTYP="HNC" S IBFLDNO=".406",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",99,0) I IBIBDTYP="SC" S IBFLDNO=".407",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",100,0) I IBIBDTYP="SHAD" S IBFLDNO=".408",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD "RTN","IBNCPLOG",101,0) I IBIBDTYP="BILL" S IBFLDNO=".301" G EDITIBD "RTN","IBNCPLOG",102,0) I IBIBDTYP="BILLED" S IBFLDNO=".302" G EDITIBD "RTN","IBNCPLOG",103,0) I IBIBDTYP="PLAN" S IBFLDNO=".303" G EDITIBD "RTN","IBNCPLOG",104,0) I IBIBDTYP="COST" S IBFLDNO=".304" G EDITIBD "RTN","IBNCPLOG",105,0) I IBIBDTYP="PAID" S IBFLDNO=".305" G EDITIBD "RTN","IBNCPLOG",106,0) I IBIBDTYP="CLOSE COMMENT" S IBFLDNO=".306" G EDITIBD "RTN","IBNCPLOG",107,0) I IBIBDTYP="REOPEN COMMENT" S IBFLDNO=".306" G EDITIBD "RTN","IBNCPLOG",108,0) I IBIBDTYP="CLOSE REASON" S IBFLDNO=".307" G EDITIBD "RTN","IBNCPLOG",109,0) I IBIBDTYP="DROP TO PAPER" S IBFLDNO=".308" G EDITIBD "RTN","IBNCPLOG",110,0) I IBIBDTYP="RELEASE COPAY" S IBFLDNO=".309" G EDITIBD "RTN","IBNCPLOG",111,0) I IBIBDTYP="USER" S IBFLDNO=".31" G EDITIBD "RTN","IBNCPLOG",112,0) I IBIBDTYP="PRESCRIPTION" S IBFLDNO=".201" G EDITIBD "RTN","IBNCPLOG",113,0) I IBIBDTYP="IEN" S IBFLDNO=".212" G EDITIBD "RTN","IBNCPLOG",114,0) I IBIBDTYP="EPHARM" S IBFLDNO=".09" G EDITIBD "RTN","IBNCPLOG",115,0) I IBIBDTYP="RXCOB" S IBFLDNO="7.01" G EDITIBD "RTN","IBNCPLOG",116,0) I IBIBDTYP="PRIMARY BILL" S IBFLDNO="7.02" G EDITIBD "RTN","IBNCPLOG",117,0) I IBIBDTYP="PRIOR PAYMENT" S IBFLDNO="7.03" G EDITIBD "RTN","IBNCPLOG",118,0) I IBIBDTYP="RTYPE" S IBFLDNO="7.04" G EDITIBD "RTN","IBNCPLOG",119,0) Q 0 "RTN","IBNCPLOG",120,0) EDITIBD ; "RTN","IBNCPLOG",121,0) Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL) "RTN","IBNCPLOG",122,0) ;------ "RTN","IBNCPLOG",123,0) ;to store IBD("INS") array data "RTN","IBNCPLOG",124,0) ;input: "RTN","IBNCPLOG",125,0) ;IBDARR - IBD array by reference "RTN","IBNCPLOG",126,0) ;IBDTIEN - ien on top [DATE] level "RTN","IBNCPLOG",127,0) ;IBRECNO - ien in [EVENTS] multiple "RTN","IBNCPLOG",128,0) ;output: "RTN","IBNCPLOG",129,0) ; record number if success "RTN","IBNCPLOG",130,0) ; 0 if failure "RTN","IBNCPLOG",131,0) INS(IBDARR,IBDTIEN,IBRECNO) ; "RTN","IBNCPLOG",132,0) N IBSET1,IBSET2,IBSET3,IBFLDNO,IBINSNO,RECNO,IBVAL "RTN","IBNCPLOG",133,0) S IBINSNO=0 "RTN","IBNCPLOG",134,0) ; Only create entry for first insurance found. BNT 07/07/2010 "RTN","IBNCPLOG",135,0) F S IBINSNO=$O(IBDARR("INS",IBINSNO)) Q:+IBINSNO=0 D Q:$D(RECNO) "RTN","IBNCPLOG",136,0) . S IBSET1=$G(IBDARR("INS",IBINSNO,1)) "RTN","IBNCPLOG",137,0) . S IBSET2=$G(IBDARR("INS",IBINSNO,2)) "RTN","IBNCPLOG",138,0) . S IBSET3=$G(IBDARR("INS",IBINSNO,3)) "RTN","IBNCPLOG",139,0) . S RECNO=$$ADDINS(IBDTIEN,IBRECNO) "RTN","IBNCPLOG",140,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.02,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,1)) "RTN","IBNCPLOG",141,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.03,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,2)) "RTN","IBNCPLOG",142,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.04,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,3)) "RTN","IBNCPLOG",143,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.05,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,4)) "RTN","IBNCPLOG",144,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.06,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,5)) "RTN","IBNCPLOG",145,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.07,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,6)) "RTN","IBNCPLOG",146,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.08,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,7)) "RTN","IBNCPLOG",147,0) . ; "RTN","IBNCPLOG",148,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.101,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,8)) "RTN","IBNCPLOG",149,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.102,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,9)) "RTN","IBNCPLOG",150,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.103,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,10)) "RTN","IBNCPLOG",151,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.104,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,11)) "RTN","IBNCPLOG",152,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.105,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,12)) "RTN","IBNCPLOG",153,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.106,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,13)) "RTN","IBNCPLOG",154,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.107,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,14)) "RTN","IBNCPLOG",155,0) . ; "RTN","IBNCPLOG",156,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.201,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,1)) "RTN","IBNCPLOG",157,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.202,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,2)) "RTN","IBNCPLOG",158,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.203,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,3)) "RTN","IBNCPLOG",159,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.204,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,4)) "RTN","IBNCPLOG",160,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.205,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,5)) "RTN","IBNCPLOG",161,0) . ; "RTN","IBNCPLOG",162,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.301,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,1)) "RTN","IBNCPLOG",163,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.302,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,2)) "RTN","IBNCPLOG",164,0) . I +$$FILLFLDS^IBNCPUT1(366.1412,.303,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,3)) "RTN","IBNCPLOG",165,0) Q RECNO "RTN","IBNCPLOG",166,0) ;create top level entry in #366.14 "RTN","IBNCPLOG",167,0) ;input: "RTN","IBNCPLOG",168,0) ; IBDATE - date in FileMan format "RTN","IBNCPLOG",169,0) ;output "RTN","IBNCPLOG",170,0) ; returns ien created "RTN","IBNCPLOG",171,0) ADDDATE(IBDATE) ; "RTN","IBNCPLOG",172,0) N IBIEN "RTN","IBNCPLOG",173,0) S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0)) "RTN","IBNCPLOG",174,0) I IBIEN>0 Q IBIEN "RTN","IBNCPLOG",175,0) I $$INSITEM^IBNCPUT1(366.14,"",IBDATE,"") "RTN","IBNCPLOG",176,0) Q +$O(^IBCNR(366.14,"B",IBDATE,0)) "RTN","IBNCPLOG",177,0) ; "RTN","IBNCPLOG",178,0) ;create EVENT entry in #366.14 "RTN","IBNCPLOG",179,0) ;input: "RTN","IBNCPLOG",180,0) ;IBIEN - ien on top [DATE] level "RTN","IBNCPLOG",181,0) ;EVNTTYPE event type (value for .01) "RTN","IBNCPLOG",182,0) ;returns ien for the event "RTN","IBNCPLOG",183,0) ;or 0 if failed "RTN","IBNCPLOG",184,0) NEWEVENT(IBIEN,EVNTTYPE) ; "RTN","IBNCPLOG",185,0) N EVNTRECN "RTN","IBNCPLOG",186,0) S EVNTRECN=$$INSITEM^IBNCPUT1(366.141,IBIEN,$$EXT2INT^IBNCPUT1(EVNTTYPE),"","") "RTN","IBNCPLOG",187,0) I EVNTRECN>0 Q EVNTRECN "RTN","IBNCPLOG",188,0) Q 0 "RTN","IBNCPLOG",189,0) ; "RTN","IBNCPLOG",190,0) ;add insurance node "RTN","IBNCPLOG",191,0) ;IBDTIEN - ien on top [DATE] level "RTN","IBNCPLOG",192,0) ;IBEVIEN - ien in [EVENTS] multiple "RTN","IBNCPLOG",193,0) ;returns : "RTN","IBNCPLOG",194,0) ; new ien in INSURANCE multiple "RTN","IBNCPLOG",195,0) ADDINS(IBDTIEN,IBEVIEN) ; "RTN","IBNCPLOG",196,0) N IBX,IBX2 "RTN","IBNCPLOG",197,0) F IBX=1:1:99999 I '$D(^IBCNR(366.14,IBDTIEN,1,IBEVIEN,5,IBX)) D Q "RTN","IBNCPLOG",198,0) . S IBX2=$$INSITEM^IBNCPUT1(366.1412,IBEVIEN_","_IBDTIEN,IBX,IBX) "RTN","IBNCPLOG",199,0) Q +$O(^IBCNR(366.14,IBDTIEN,1,IBEVIEN,5,"B",IBX,0)) "RTN","IBNCPLOG",200,0) ; "RTN","IBNCPUT3") 0^34^B15136080 "RTN","IBNCPUT3",1,0) IBNCPUT3 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08 "RTN","IBNCPUT3",2,0) ;;2.0;INTEGRATED BILLING;**411,435**;21-MAR-94;Build 27 "RTN","IBNCPUT3",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBNCPUT3",4,0) ; "RTN","IBNCPUT3",5,0) Q "RTN","IBNCPUT3",6,0) ; "RTN","IBNCPUT3",7,0) ;used by ECME "RTN","IBNCPUT3",8,0) ;ICR #5355 "RTN","IBNCPUT3",9,0) ;determine if there is a bill with a given bill # "RTN","IBNCPUT3",10,0) ;input: "RTN","IBNCPUT3",11,0) ; IBBIL - bill # entered by the user "RTN","IBNCPUT3",12,0) ;returns: "RTN","IBNCPUT3",13,0) ; file #399 ien if found "RTN","IBNCPUT3",14,0) ; zero if not found "RTN","IBNCPUT3",15,0) ISBILL(IBBIL) ; "RTN","IBNCPUT3",16,0) N IB399 "RTN","IBNCPUT3",17,0) S IB399=+$O(^DGCR(399,"B",IBBIL,0)) "RTN","IBNCPUT3",18,0) I IB399>0 Q IB399 ;bill # was entered "RTN","IBNCPUT3",19,0) Q 0 ;nothing was found "RTN","IBNCPUT3",20,0) ; "RTN","IBNCPUT3",21,0) ;get bill details from file #399 "RTN","IBNCPUT3",22,0) ;Used by ECME - ICR #5355 "RTN","IBNCPUT3",23,0) ;input: "RTN","IBNCPUT3",24,0) ; IB399 - bill ien of (#399) "RTN","IBNCPUT3",25,0) ; IBINFO - output array, by reference "RTN","IBNCPUT3",26,0) ;Returns two piece value: "RTN","IBNCPUT3",27,0) ; Piece#1 : "RTN","IBNCPUT3",28,0) ; -1 if an error "RTN","IBNCPUT3",29,0) ; the payer sequence (P-primary, S-secondary,...) "RTN","IBNCPUT3",30,0) ; Piece#2 : "RTN","IBNCPUT3",31,0) ; error message if piece#1 = -1 "RTN","IBNCPUT3",32,0) ; otherwise - patient's DFN "RTN","IBNCPUT3",33,0) ; "RTN","IBNCPUT3",34,0) ;Output array, passed in by reference. "RTN","IBNCPUT3",35,0) ;Format of data returned in the array: "RTN","IBNCPUT3",36,0) ; IBINFO("INS IEN") - insurance ien, ien of the file (#36) "RTN","IBNCPUT3",37,0) ; IBINFO("INS NAME") - insurance name as a text "RTN","IBNCPUT3",38,0) ; IBINFO("BILL #") - bill number, field (#.01) of the file (#399) "RTN","IBNCPUT3",39,0) ; IBINFO("AR STATUS") - Account Receivable status for the bill "RTN","IBNCPUT3",40,0) ; IBINFO("DOS") - date of service (FM format) "RTN","IBNCPUT3",41,0) ; IBINFO("PLAN") - plan ien of (#355.3) "RTN","IBNCPUT3",42,0) ; IBINFO("FILL NUMBER") - refill number "RTN","IBNCPUT3",43,0) ; IBINFO("PRESCRIPTION") - prescription ien of file (#52) ; "RTN","IBNCPUT3",44,0) BILINF(IB399,IBINFO) ; "RTN","IBNCPUT3",45,0) Q:IB399=0 "" "RTN","IBNCPUT3",46,0) N IBDFN,IBZZ,IBRXN,IBFIL,IB3624,IBPSEQ "RTN","IBNCPUT3",47,0) ; "RTN","IBNCPUT3",48,0) S IBDFN=$P($G(^DGCR(399,IB399,0)),U,2) "RTN","IBNCPUT3",49,0) S IBPSEQ=$P($G(^DGCR(399,IB399,0)),U,21) "RTN","IBNCPUT3",50,0) I IBPSEQ="" Q "-1^Cannot determine payer sequence" "RTN","IBNCPUT3",51,0) S IBINFO("INS IEN")=$P($G(^DGCR(399,IB399,"MP")),U) "RTN","IBNCPUT3",52,0) S IBINFO("INS NAME")=$P($G(^DIC(36,+IBINFO("INS IEN"),0)),U) "RTN","IBNCPUT3",53,0) S IBINFO("BILL #")=$P($G(^DGCR(399,IB399,0)),U,1) "RTN","IBNCPUT3",54,0) S IBINFO("IB STATUS")=$P($G(^DGCR(399,IB399,0)),U,13) "RTN","IBNCPUT3",55,0) S IBINFO("AR STATUS")=$P($$ARSTATA^IBJTU4(IB399),U,2) "RTN","IBNCPUT3",56,0) S IBINFO("DOS")=$P($G(^DGCR(399,IB399,0)),U,3) "RTN","IBNCPUT3",57,0) S IBINFO("PLAN")=$$GETPLAN(IB399) "RTN","IBNCPUT3",58,0) ; "RTN","IBNCPUT3",59,0) S IB3624=0 "RTN","IBNCPUT3",60,0) S IB3624=$O(^IBA(362.4,"C",IB399,0)) "RTN","IBNCPUT3",61,0) I IB3624>0 D "RTN","IBNCPUT3",62,0) . S IBZZ=^IBA(362.4,IB3624,0) "RTN","IBNCPUT3",63,0) . I IBZZ>0 S IBINFO("PRESCRIPTION")=+$P(IBZZ,U,5),IBINFO("FILL NUMBER")=+$P(IBZZ,U,10),IBINFO("DOS")=+$P(IBZZ,U,3) "RTN","IBNCPUT3",64,0) I $G(IBINFO("PRESCRIPTION"))="" Q "-1^no RX ien" "RTN","IBNCPUT3",65,0) I $G(IBINFO("FILL NUMBER"))="" Q "-1^no Refill No" "RTN","IBNCPUT3",66,0) ; "RTN","IBNCPUT3",67,0) Q IBPSEQ_U_IBDFN "RTN","IBNCPUT3",68,0) ; "RTN","IBNCPUT3",69,0) GETPLAN(IB399) ; "RTN","IBNCPUT3",70,0) N IBPLN,IBNODE "RTN","IBNCPUT3",71,0) S IBPLN=0 "RTN","IBNCPUT3",72,0) S IBNODE=$P($G(^DGCR(399,IB399,0)),"^",21),IBNODE=$S(IBNODE="P":1,IBNODE="S":2,IBNODE="T":3,1:"") "RTN","IBNCPUT3",73,0) S IBPLN=$P($G(^DGCR(399,IB399,"I"_IBNODE)),U,18) "RTN","IBNCPUT3",74,0) Q IBPLN "RTN","IBNCPUT3",75,0) ; "RTN","IBNCPUT3",76,0) ;Find bill(s) for the specific RX/refill "RTN","IBNCPUT3",77,0) ;Used by ECME - ICR #5355 "RTN","IBNCPUT3",78,0) ;IBRXIEN RX ien (#52) "RTN","IBNCPUT3",79,0) ;IBRXREF refill # "RTN","IBNCPUT3",80,0) ;IBRXCOB - (optional) Payer Sequence ("P"- primary,"S" - secondary,"T" -tertiary "RTN","IBNCPUT3",81,0) ;IBDOS-(optional)Date of Service "RTN","IBNCPUT3",82,0) ;IBARR - by reference to return the list of bills for the RX# "RTN","IBNCPUT3",83,0) ;Return: "RTN","IBNCPUT3",84,0) ; return 2 pieces "RTN","IBNCPUT3",85,0) ; piece 1 - the number of ANY (cancelled, active, etc) bills found for the RX/refill "RTN","IBNCPUT3",86,0) ; piece 2 - the latest active bill's ien "RTN","IBNCPUT3",87,0) ;Return all bills in the array IBARR as "RTN","IBNCPUT3",88,0) ; IBARR(IEN of the file #399 )= Bill#^status^date^insurance name^payer sequence^RX ien^Refill No "RTN","IBNCPUT3",89,0) ; "RTN","IBNCPUT3",90,0) RXBILL(IBRXIEN,IBRXREF,IBRXCOB,IBDOS,IBARR) ; "RTN","IBNCPUT3",91,0) N IB3624,IB3624V,IB399,IBRET,IBCNT,IBRXNUM,IB399ACT "RTN","IBNCPUT3",92,0) S IBCNT=0 "RTN","IBNCPUT3",93,0) S IB3624=0 "RTN","IBNCPUT3",94,0) S IB399ACT=0 "RTN","IBNCPUT3",95,0) S IBRXNUM=$$RXAPI1^IBNCPUT1(IBRXIEN,.01,"E") ;external format "RTN","IBNCPUT3",96,0) Q:IBRXNUM="" 0 "RTN","IBNCPUT3",97,0) F S IB3624=$O(^IBA(362.4,"B",IBRXNUM,IB3624)) Q:+IB3624=0 D "RTN","IBNCPUT3",98,0) . S IB3624V=$G(^IBA(362.4,IB3624,0)) "RTN","IBNCPUT3",99,0) . I $P(IB3624V,U,10)'=IBRXREF Q "RTN","IBNCPUT3",100,0) . I $G(IBDOS) I $P(IB3624V,U,3)'=IBDOS Q "RTN","IBNCPUT3",101,0) . S IB399=+$P(IB3624V,U,2) "RTN","IBNCPUT3",102,0) . I IB399=0 Q "RTN","IBNCPUT3",103,0) . N IBINFARR "RTN","IBNCPUT3",104,0) . S IBRET=$$BILINF(IB399,.IBINFARR) "RTN","IBNCPUT3",105,0) . I +IBRET=-1 Q "RTN","IBNCPUT3",106,0) . I $G(IBRXCOB)'="",$P(IBRET,U)'=IBRXCOB Q "RTN","IBNCPUT3",107,0) . S IBARR(IB399)=$G(IBINFARR("BILL #"))_U_$G(IBINFARR("AR STATUS"))_U_$G(IBINFARR("DOS"))_U_$G(IBINFARR("INS NAME"))_U_($P(IBRET,U))_U_$G(IBINFARR("PRESCRIPTION"))_U_$G(IBINFARR("FILL NUMBER"))_U_$G(IBINFARR("IB STATUS")) "RTN","IBNCPUT3",108,0) . I $G(IBINFARR("AR STATUS"))="A" S IB399ACT=IB399 "RTN","IBNCPUT3",109,0) . S IBCNT=IBCNT+1 "RTN","IBNCPUT3",110,0) Q IBCNT_U_IB399ACT "RTN","IBNCPUT3",111,0) ; "RTN","IBNCPUT3",112,0) COSTTYP(IBRATYP,IBDT) ; calculate the basis of cost determination for manual claims processing "RTN","IBNCPUT3",113,0) ; IBRATYP - rate type (ien of file #399.3) "RTN","IBNCPUT3",114,0) ; IBDT - date of service "RTN","IBNCPUT3",115,0) ; This is to update only piece [2] of the IBRT rate type string "RTN","IBNCPUT3",116,0) ; "RTN","IBNCPUT3",117,0) N IBRET "RTN","IBNCPUT3",118,0) S IBRET=$P($$EVNTITM^IBCRU3(IBRATYP,3,"PRESCRIPTION FILL",IBDT),";",1) "RTN","IBNCPUT3",119,0) Q $S(IBRET="VA COST":"C",1:"T") "RTN","IBNCPUT3",120,0) ; "RTN","IBNCPUT3",121,0) ;IBNCPUT3 "RTN","IBOSCDC") 0^22^B46120180 "RTN","IBOSCDC",1,0) IBOSCDC ;ALB/BNT - SERVICE CONNECTED DETERMINATION CHANGE REPORT ;10/04/07 "RTN","IBOSCDC",2,0) ;;2.0;INTEGRATED BILLING;**384,435**;21-MAR-94;Build 27 "RTN","IBOSCDC",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBOSCDC",4,0) ; "RTN","IBOSCDC",5,0) SCR ; -- Main Entry for report. "RTN","IBOSCDC",6,0) N IBCTY,IBPTY,IBSD,IBDFN,Y,DUOUT,DTOUT,DIC "RTN","IBOSCDC",7,0) S IBDFN=0 "RTN","IBOSCDC",8,0) S IBCTY=$$CTYPE() Q:IBCTY=U I IBCTY="S" S IBCTY="Y" "RTN","IBOSCDC",9,0) S IBSD=$$ATIME() Q:IBSD=U "RTN","IBOSCDC",10,0) PTP S IBPTY=$$PTYPE() Q:IBPTY=U "RTN","IBOSCDC",11,0) I IBPTY="P" D "RTN","IBOSCDC",12,0) . S DIC="^DPT(",DIC(0)="AEMNQ",DIC("A")="Select Patient: " D ^DIC "RTN","IBOSCDC",13,0) . I (Y=-1)!$D(DUOUT)!$D(DTOUT) G PTP "RTN","IBOSCDC",14,0) . S IBDFN=$P(Y,U) "RTN","IBOSCDC",15,0) D DEV("RUN^IBOSCDC"," SERVICE CONNECTED STATUS CHANGES",IBDFN) "RTN","IBOSCDC",16,0) Q "RTN","IBOSCDC",17,0) ; "RTN","IBOSCDC",18,0) ;Process Report "RTN","IBOSCDC",19,0) RUN ; "RTN","IBOSCDC",20,0) S REF=$NA(^TMP($J,"IBSCDC")) "RTN","IBOSCDC",21,0) K @REF "RTN","IBOSCDC",22,0) U IO "RTN","IBOSCDC",23,0) D REPORT "RTN","IBOSCDC",24,0) D ^%ZISC "RTN","IBOSCDC",25,0) S:$D(ZTQUEUED) ZTREQ="@" K @REF,REF "RTN","IBOSCDC",26,0) I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR "RTN","IBOSCDC",27,0) Q "RTN","IBOSCDC",28,0) ; "RTN","IBOSCDC",29,0) REPORT ; "RTN","IBOSCDC",30,0) N IBSCDFN,IBRXNUM,IBRXFIL,PTNM,PTLN1,PTLN2,IBQUIT,IBOSCNT,IBFRST,IBOSCDC,IBRXD,IBP "RTN","IBOSCDC",31,0) S (IBP,IBSCDFN,IBQUIT,IBOSCNT)=0,IBFRST=1 "RTN","IBOSCDC",32,0) S IBN=IBN_" for period "_$$FMTE^XLFDT(IBSD,"2P")_" - "_$$FMTE^XLFDT(DT,"2P") "RTN","IBOSCDC",33,0) ; Write the Header "RTN","IBOSCDC",34,0) D HDR(IBN) "RTN","IBOSCDC",35,0) ; Get Data for specific patient "RTN","IBOSCDC",36,0) I IBPTY="P" D Q:IBQUIT "RTN","IBOSCDC",37,0) . I '$$PTSRCH(IBDFN,IBSD,IBCTY,.IBOSCDC) W !,"No matching SC changes for patient "_$$PATINF^IBOSCDC1(IBDFN,30) S IBQUIT=1 Q "RTN","IBOSCDC",38,0) . D COLLECT^IBOSCDC1(IBDFN,IBSD) "RTN","IBOSCDC",39,0) . I '$D(@REF@(IBDFN)) W !,"No matching Prescriptions found for patient "_$$PATINF^IBOSCDC1(IBDFN,30) S IBQUIT=1 Q "RTN","IBOSCDC",40,0) ; Get Data for all patients "RTN","IBOSCDC",41,0) I IBPTY="A" D Q:IBQUIT "RTN","IBOSCDC",42,0) . D GETALLPT(IBCTY,IBSD,.IBOSCDC) "RTN","IBOSCDC",43,0) . I '$D(IBOSCDC) W !,"No patients with SC changes found" S IBQUIT=1 Q "RTN","IBOSCDC",44,0) ; Check all patients for Pharmacy data "RTN","IBOSCDC",45,0) F S IBSCDFN=$O(IBOSCDC(IBSCDFN)) Q:IBSCDFN="" D Q:IBQUIT "RTN","IBOSCDC",46,0) . D COLLECT^IBOSCDC1(IBSCDFN,IBSD) "RTN","IBOSCDC",47,0) . I '$D(@REF@(IBSCDFN)) Q "RTN","IBOSCDC",48,0) . ;Get Patient Name and last 4 SSN "RTN","IBOSCDC",49,0) . S PTNM=$$PATINF^IBOSCDC1(IBSCDFN,23) "RTN","IBOSCDC",50,0) . ;Get first line of Patient data "RTN","IBOSCDC",51,0) . S PTLN1=$$GETENRL($P($G(IBOSCDC(IBSCDFN)),U,1)) "RTN","IBOSCDC",52,0) . ; Get second line of patient data "RTN","IBOSCDC",53,0) . S PTLN2=$$GETENRL($P($G(IBOSCDC(IBSCDFN)),U,2)) "RTN","IBOSCDC",54,0) . I 'IBFRST W !! "RTN","IBOSCDC",55,0) . ;Write the first Patient line "RTN","IBOSCDC",56,0) . D WPTLINE(PTNM,$P(PTLN1,U),$P(PTLN1,U,2),$P(PTLN1,U,3),$P(PTLN1,U,4),$P(PTLN1,U,5)) Q:IBQUIT "RTN","IBOSCDC",57,0) . ;Write the second Patient line "RTN","IBOSCDC",58,0) . D WPTLINE("",$P(PTLN2,U),$P(PTLN2,U,2),$P(PTLN2,U,3),$P(PTLN2,U,4),$P(PTLN2,U,5)) "RTN","IBOSCDC",59,0) . S (IBFRST)=0 "RTN","IBOSCDC",60,0) . F S IBOSCNT=$O(@REF@(IBSCDFN,IBOSCNT)) Q:IBOSCNT="" D "RTN","IBOSCDC",61,0) . . S IBRXD=@REF@(IBSCDFN,IBOSCNT) "RTN","IBOSCDC",62,0) . . ;Write the RX data "RTN","IBOSCDC",63,0) . . D WRXLINE($P(IBRXD,U),$P(IBRXD,U,2),$P(IBRXD,U,3),$P(IBRXD,U,4),$P(IBRXD,U,5),$P(IBRXD,U,6),$P(IBRXD,U,7)) "RTN","IBOSCDC",64,0) . . ;Increment counter "RTN","IBOSCDC",65,0) . . S IBFRST=1 "RTN","IBOSCDC",66,0) I 'IBFRST W "No data available for report" "RTN","IBOSCDC",67,0) Q "RTN","IBOSCDC",68,0) ; "RTN","IBOSCDC",69,0) ;Get Service Connected Change type value "RTN","IBOSCDC",70,0) ;Returns: "RTN","IBOSCDC",71,0) ;(S = SC - NSC, N = NCS - SC, B = Both) "RTN","IBOSCDC",72,0) CTYPE() ; "RTN","IBOSCDC",73,0) N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT "RTN","IBOSCDC",74,0) S DIR(0)="S^S:SC to NSC;N:NSC to SC;B:Both" "RTN","IBOSCDC",75,0) S DIR("A")="Select Change Type or (B)oth",DIR("B")="B" "RTN","IBOSCDC",76,0) D ^DIR "RTN","IBOSCDC",77,0) Q Y "RTN","IBOSCDC",78,0) ; "RTN","IBOSCDC",79,0) ;Get Activity Timeframe (Start date) for search "RTN","IBOSCDC",80,0) ;Returns: "RTN","IBOSCDC",81,0) ;Start date in FileMan format "RTN","IBOSCDC",82,0) ATIME() ; "RTN","IBOSCDC",83,0) N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT "RTN","IBOSCDC",84,0) W ! "RTN","IBOSCDC",85,0) S DIR(0)="N^1:999" "RTN","IBOSCDC",86,0) S DIR("A")=" Select Activity Timeframe Days",DIR("B")=30 "RTN","IBOSCDC",87,0) D ^DIR "RTN","IBOSCDC",88,0) Q $$FMADD^XLFDT(DT\1,-$G(Y)) "RTN","IBOSCDC",89,0) ; "RTN","IBOSCDC",90,0) ;Get Patient Type value "RTN","IBOSCDC",91,0) ;Returns (P = Patient, A = All) "RTN","IBOSCDC",92,0) PTYPE() ; "RTN","IBOSCDC",93,0) N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT "RTN","IBOSCDC",94,0) S DIR(0)="S^P:ONE PATIENT;A:ALL" "RTN","IBOSCDC",95,0) S DIR("A")="Display One (P)atient or (A)ll",DIR("B")="A" "RTN","IBOSCDC",96,0) D ^DIR "RTN","IBOSCDC",97,0) Q Y "RTN","IBOSCDC",98,0) ; "RTN","IBOSCDC",99,0) ;Get All patients with SC Change "RTN","IBOSCDC",100,0) ;Input: "RTN","IBOSCDC",101,0) ;IBSCDIR = Service Connected change direction "RTN","IBOSCDC",102,0) ; (Y = SC to NSC, N = NSC to SC, B = Both) "RTN","IBOSCDC",103,0) ;IBSD = Start search date "RTN","IBOSCDC",104,0) ;IBSCARR = Return array passed by ref "RTN","IBOSCDC",105,0) ;Returns: "RTN","IBOSCDC",106,0) ;^TMP(IBSCARR,$J,0)=Number of records found "RTN","IBOSCDC",107,0) ;The first record found is in the 1 node "RTN","IBOSCDC",108,0) ;^TMP(IBSCARR,$J,IBDFN,1)=File 27.11 IEN "RTN","IBOSCDC",109,0) ;The last record found is in the 2 node "RTN","IBOSCDC",110,0) ;^TMP(IBSCARR,$J,IBDFN,2)=File 27.11 IEN "RTN","IBOSCDC",111,0) GETALLPT(IBSCDIR,IBSD,IBSCARR) ; "RTN","IBOSCDC",112,0) N IBDFN,IBCNT,IBDGEN "RTN","IBOSCDC",113,0) ; Default start date -30 days "RTN","IBOSCDC",114,0) I IBSD="" S IBSD=$$FMADD^XLFDT(DT\1,-30) "RTN","IBOSCDC",115,0) S (IBDFN,IBCNT)=0 "RTN","IBOSCDC",116,0) F S IBDFN=$O(^DGEN(27.11,"C",IBDFN)) Q:IBDFN="" D "RTN","IBOSCDC",117,0) . Q:'$D(^DPT(IBDFN,0)) "RTN","IBOSCDC",118,0) . I $$PTSRCH(IBDFN,IBSD,IBSCDIR,.IBDGEN) D "RTN","IBOSCDC",119,0) . . S IBCNT=IBCNT+1,IBSCARR(0)=IBCNT "RTN","IBOSCDC",120,0) . . S IBSCARR(IBDFN)=IBDGEN(IBDFN) "RTN","IBOSCDC",121,0) Q "RTN","IBOSCDC",122,0) ; "RTN","IBOSCDC",123,0) ;This function searches for an SC change in Patient Enrollment for a patient "RTN","IBOSCDC",124,0) ;during a specified date range. "RTN","IBOSCDC",125,0) ;Input: "RTN","IBOSCDC",126,0) ;IBDFN = Patient DFN "RTN","IBOSCDC",127,0) ;IBSD = Start date to begin search "RTN","IBOSCDC",128,0) ;IBSCDIR = Service Connected change direction "RTN","IBOSCDC",129,0) ; (Y = SC to NSC, N = NSC to SC, B = Both) "RTN","IBOSCDC",130,0) ;IBSCARR = Return array passed by ref "RTN","IBOSCDC",131,0) ;Returns: "RTN","IBOSCDC",132,0) ;IBSCARR(DFN)=DGEN1^DGEN2 "RTN","IBOSCDC",133,0) ;WHERE: "RTN","IBOSCDC",134,0) ; DGEN1 = The IEN of first record "RTN","IBOSCDC",135,0) ; DGEN2 = The IEN of second record where a SC change occurred. "RTN","IBOSCDC",136,0) PTSRCH(IBDFN,IBSD,IBSCDIR,IBSCARR) ; "RTN","IBOSCDC",137,0) Q:IBDFN="" 0 "RTN","IBOSCDC",138,0) N DGENIEN,IBSC,IBSCHNG,SCDIR,EFDT,IBDGEN1 "RTN","IBOSCDC",139,0) S (DGENIEN,IBSCHNG)=0,(IBDGEN1,IBSC)="" "RTN","IBOSCDC",140,0) F S DGENIEN=$O(^DGEN(27.11,"C",IBDFN,DGENIEN)) Q:DGENIEN="" D "RTN","IBOSCDC",141,0) . I $D(^DGEN(27.11,DGENIEN,"E")) D "RTN","IBOSCDC",142,0) . . ; Get SERVICE CONNECTED field "RTN","IBOSCDC",143,0) . . S IBSC=$P(^DGEN(27.11,DGENIEN,"E"),U,2) Q:IBSC="" "RTN","IBOSCDC",144,0) . . ; Get EFFECTIVE DATE field "RTN","IBOSCDC",145,0) . . S EFDT=$P(^DGEN(27.11,DGENIEN,0),U,8) Q:EFDT="" "RTN","IBOSCDC",146,0) . . ; Is EFFECTIVE DATE prior to search date? If yes, quit. "RTN","IBOSCDC",147,0) . . I EFDT(IOSL-4) D HDR(IBN) Q:IBQUIT "RTN","IBOSCDC",195,0) W !,PT,?24,EFDT,?35,SC,?46,ELIGCODE,?65,SCPERCNT,?69,ENRLPRIO "RTN","IBOSCDC",196,0) Q "RTN","IBOSCDC",197,0) ; "RTN","IBOSCDC",198,0) ;Write Prescription Line "RTN","IBOSCDC",199,0) WRXLINE(RX,FILL,DOS,BILL,ECME,COPAYINS,AMNT) ; "RTN","IBOSCDC",200,0) I $Y>(IOSL-4) D HDR(IBN) Q:IBQUIT "RTN","IBOSCDC",201,0) W !,?2,RX,?10,FILL,?16,$$FMTE^XLFDT(DOS,"2D"),?25,BILL,?39,ECME,?52,COPAYINS,?71,AMNT "RTN","IBOSCDC",202,0) Q "RTN","IBOSCDC",203,0) ; "RTN","IBOSCDC",204,0) ;Device Selection "RTN","IBOSCDC",205,0) ;Input: IBR = Routine "RTN","IBOSCDC",206,0) ; IBN = Task name (only used if tasked) "RTN","IBOSCDC",207,0) ; IBDFN = Patient DFN for single patient, if exists. "RTN","IBOSCDC",208,0) DEV(IBR,IBN,IBDFN) ; "RTN","IBOSCDC",209,0) N %ZIS,ZTSK,ZTSAVE,POP,ZTRTN,ZTDESC "RTN","IBOSCDC",210,0) S %ZIS="MQ" D ^%ZIS Q:POP "RTN","IBOSCDC",211,0) I $D(IO("Q")) D Q "RTN","IBOSCDC",212,0) . S ZTRTN=IBR,ZTDESC=IBN,ZTSAVE("IB*")="",ZTSAVE("IBPT(")="" "RTN","IBOSCDC",213,0) . D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"QUEUED TASK #",ZTSK "RTN","IBOSCDC",214,0) U IO "RTN","IBOSCDC",215,0) D @IBR "RTN","IBOSCDC",216,0) Q "RTN","IBOSCDC1") 0^33^B17703191 "RTN","IBOSCDC1",1,0) IBOSCDC1 ;ALB/BNT - SERVICE CONNECTED DETERMINATION CHANGE REPORT UTILITIES ;10/04/07 "RTN","IBOSCDC1",2,0) ;;2.0;INTEGRATED BILLING;**384,435**;21-MAR-94;Build 27 "RTN","IBOSCDC1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBOSCDC1",4,0) ; "RTN","IBOSCDC1",5,0) ;Patient info for header "RTN","IBOSCDC1",6,0) ;Input: "RTN","IBOSCDC1",7,0) ;IBDFN = Patient DFN "RTN","IBOSCDC1",8,0) ;IBLEN = Length of overall characters for output "RTN","IBOSCDC1",9,0) ;Returns: "RTN","IBOSCDC1",10,0) ;Left Justified patient name with Last 4 SSN "RTN","IBOSCDC1",11,0) PATINF(IBDFN,IBLEN) ; "RTN","IBOSCDC1",12,0) N X "RTN","IBOSCDC1",13,0) S X=$$PATNAME(IBDFN,IBLEN-7)_" "_$$SSN4^IBNCPRR1(IBDFN) "RTN","IBOSCDC1",14,0) Q $$LJ(X,IBLEN) ;name "RTN","IBOSCDC1",15,0) ; "RTN","IBOSCDC1",16,0) ;Get patient's name "RTN","IBOSCDC1",17,0) ;Input: "RTN","IBOSCDC1",18,0) ;IBDFN = Patient DFN "RTN","IBOSCDC1",19,0) ;IBLEN = Length of characters to return "RTN","IBOSCDC1",20,0) ;Returns: "RTN","IBOSCDC1",21,0) ;patient's name "RTN","IBOSCDC1",22,0) PATNAME(IBDFN,IBLEN) ; "RTN","IBOSCDC1",23,0) Q $E($P($G(^DPT(IBDFN,0)),U),1,IBLEN) "RTN","IBOSCDC1",24,0) ; "RTN","IBOSCDC1",25,0) ;left justified, blank padded "RTN","IBOSCDC1",26,0) ;adds spaces on right or truncates to make return string IBLEN characters long "RTN","IBOSCDC1",27,0) ;IBST- original string "RTN","IBOSCDC1",28,0) ;IBLEN - desired length "RTN","IBOSCDC1",29,0) LJ(IBST,IBLEN) ; "RTN","IBOSCDC1",30,0) N IBL "RTN","IBOSCDC1",31,0) S IBL=IBLEN-$L(IBST) "RTN","IBOSCDC1",32,0) Q $E(IBST_$J("",$S(IBL<0:0,1:IBL)),1,IBLEN) "RTN","IBOSCDC1",33,0) ; "RTN","IBOSCDC1",34,0) ;Get Third Party bill from file 362.4, if one exists "RTN","IBOSCDC1",35,0) ;IBRXN = RX number "RTN","IBOSCDC1",36,0) ;IBDT = RX Fill Date "RTN","IBOSCDC1",37,0) ;Returns the Bill Number "RTN","IBOSCDC1",38,0) BILL(IBRXN,IBDT) ;Bill IEN (if any) or null "RTN","IBOSCDC1",39,0) N RES,X,IBZ "RTN","IBOSCDC1",40,0) S IBDT=$P(IBDT,".") "RTN","IBOSCDC1",41,0) S RES="" "RTN","IBOSCDC1",42,0) S X="" F S X=$O(^IBA(362.4,"B",IBRXN,X),-1) Q:X="" D:X Q:RES "RTN","IBOSCDC1",43,0) . S IBZ=$G(^IBA(362.4,X,0)) "RTN","IBOSCDC1",44,0) . I $P($P(IBZ,U,3),".")=IBDT,$P(IBZ,U,2) S RES=+$P(IBZ,U,2) "RTN","IBOSCDC1",45,0) Q RES "RTN","IBOSCDC1",46,0) ; "RTN","IBOSCDC1",47,0) ;Check if the status on the first party bill in 350 is CANCELLED? "RTN","IBOSCDC1",48,0) ;IBILL = IEN from file 350 "RTN","IBOSCDC1",49,0) ;Returns 1=yes, 0=no "RTN","IBOSCDC1",50,0) BILLCNCL(IBILL) ; "RTN","IBOSCDC1",51,0) N IBBILSTS "RTN","IBOSCDC1",52,0) Q:(IBILL="")!(IBILL=0) 1 "RTN","IBOSCDC1",53,0) Q $S($$BILLSTS(IBILL)["CANCEL":1,1:0) "RTN","IBOSCDC1",54,0) ; "RTN","IBOSCDC1",55,0) ;Returns the PRINT NAME of the STATUS associated with a bill "RTN","IBOSCDC1",56,0) ;IBILL = IEN from file 350 "RTN","IBOSCDC1",57,0) ;Returns the PRINT NAME field from file 350.21 "RTN","IBOSCDC1",58,0) BILLSTS(IBILL) ; "RTN","IBOSCDC1",59,0) N IBBILSTS "RTN","IBOSCDC1",60,0) Q:(IBILL="")!(IBILL=0) "" "RTN","IBOSCDC1",61,0) S IBBILSTS=+$P($G(^IB(IBILL,0)),U,5) "RTN","IBOSCDC1",62,0) Q $P($G(^IBE(350.21,IBBILSTS,0)),U,2) "RTN","IBOSCDC1",63,0) ; "RTN","IBOSCDC1",64,0) ;Get the TOTAL CHARGE for the bill "RTN","IBOSCDC1",65,0) ;IBILL = IEN from file 350 "RTN","IBOSCDC1",66,0) ;Returns the TOTAL CHARGE "RTN","IBOSCDC1",67,0) BILLAMNT(IBILL) ; "RTN","IBOSCDC1",68,0) N X,X2,X3 "RTN","IBOSCDC1",69,0) Q:(IBILL="")!(IBILL=0) "" "RTN","IBOSCDC1",70,0) S X=$P($G(^IB(IBILL,0)),U,7),X2="2$",X3=0 D COMMA^%DTC "RTN","IBOSCDC1",71,0) Q X "RTN","IBOSCDC1",72,0) ; "RTN","IBOSCDC1",73,0) ;Collect the RX related data using Pharmacy API for the report and store in ^TMP($J,"IBRXARR" "RTN","IBOSCDC1",74,0) ;DFN = Patient IEN "RTN","IBOSCDC1",75,0) ;IBBDT = Beginning search date, used to determine if Rx was filled within this date "RTN","IBOSCDC1",76,0) COLLECT(DFN,IBBDT) ; Collect data for patient "RTN","IBOSCDC1",77,0) N LIST,IBRX,IBFIL,CNT "RTN","IBOSCDC1",78,0) S LIST="IBRXARR",(IBRX,CNT,IBFIL)=0 "RTN","IBOSCDC1",79,0) K ^TMP($J,LIST) "RTN","IBOSCDC1",80,0) D RX^PSO52API(DFN,LIST,,,"2,I,R",,) "RTN","IBOSCDC1",81,0) F S IBRX=$O(^TMP($J,LIST,DFN,IBRX)) Q:'IBRX D "RTN","IBOSCDC1",82,0) . Q:'+$P(^TMP($J,LIST,DFN,IBRX,31),U) "RTN","IBOSCDC1",83,0) . D GETDATA(0,IBRX,DFN,LIST) "RTN","IBOSCDC1",84,0) . I ^TMP($J,LIST,DFN,IBRX,"RF",0)<0 Q "RTN","IBOSCDC1",85,0) . F S IBFIL=$O(^TMP($J,LIST,DFN,IBRX,"RF",IBFIL)) Q:IBFIL="" D "RTN","IBOSCDC1",86,0) . . Q:IBFIL=0 "RTN","IBOSCDC1",87,0) . . D GETDATA(IBFIL,IBRX,DFN,LIST) "RTN","IBOSCDC1",88,0) . Q "RTN","IBOSCDC1",89,0) Q "RTN","IBOSCDC1",90,0) ; "RTN","IBOSCDC1",91,0) ;Gets specific data for first and third party bills and store in TMP file "RTN","IBOSCDC1",92,0) ;IBFIL = RX Fill # "RTN","IBOSCDC1",93,0) ;IBRX = IEN to Prescription file - RX ID Placeholder in the TMP file "RTN","IBOSCDC1",94,0) ;DFN = Patient IEN "RTN","IBOSCDC1",95,0) ;LIST = placeholder for data in ^TMP file "RTN","IBOSCDC1",96,0) GETDATA(IBFIL,IBRX,DFN,LIST) ; "RTN","IBOSCDC1",97,0) N IBBA,IBBILL,IBRXN,IBFILDT,IBRXINS,IBBILLN,IBECN "RTN","IBOSCDC1",98,0) I IBFIL=0 D "RTN","IBOSCDC1",99,0) . S IBFILDT=+$P(^TMP($J,LIST,DFN,IBRX,22),U) "RTN","IBOSCDC1",100,0) . S IBBA=+$P($G(^TMP($J,LIST,DFN,IBRX,106)),U) "RTN","IBOSCDC1",101,0) E S IBFILDT=+$P(^TMP($J,LIST,DFN,IBRX,"RF",IBFIL,.01),U) D "RTN","IBOSCDC1",102,0) . S IBBA=+$P($G(^TMP($J,LIST,DFN,IBRX,"IB",IBFIL,9)),U) "RTN","IBOSCDC1",103,0) Q:IBFILDT0 ERRQ "RTN","IBRFN",11,0) S X2=$P(Y,U,2) F N=1:1 S X=$P(X2,";",N) Q:X="" S X1=$P($G(^IBE(350.8,+$O(^IBE(350.8,"AC",X,0)),0)),U,2) D "RTN","IBRFN",12,0) .I N=1 S IBRERR=X1 "RTN","IBRFN",13,0) .I $P(Y,U,3)]""!($P(X2,";",2,99)]"") S IBRERR(N)=X1 "RTN","IBRFN",14,0) I $P(Y,U,3)]"" S N=N+1,IBRERR(N)=$P(Y,U,3) "RTN","IBRFN",15,0) ERRQ Q IBRERR "RTN","IBRFN",16,0) ; "RTN","IBRFN",17,0) MESS(Y) ; -input y=error code - from file 350.8 (piece 3) "RTN","IBRFN",18,0) ; output error message "RTN","IBRFN",19,0) Q $P($G(^IBE(350.8,+$O(^IBE(350.8,"AC",Y,0)),0)),U,2) "RTN","IBRFN",20,0) ; "RTN","IBRFN",21,0) SVDT(BN,VDT) ;returns service dates for a specific bill "RTN","IBRFN",22,0) ; Input: BN bill number (external form) "RTN","IBRFN",23,0) ; VDT name of array to hold outpatient visit dates, pass by value (if needed) "RTN","IBRFN",24,0) ; Output: X function value, string, = 0 if bill not found "RTN","IBRFN",25,0) ; = 1 (Inpt) or 2 (Outpt)^event date^stmt from date^stmt to date^LOS (I)^Number of visit dates (O) "RTN","IBRFN",26,0) ; all are internal form, any piece may be null if not defined for the bill "RTN","IBRFN",27,0) ; array containing outpatient visit dates as subscripts/no data, if VDT passed by value "RTN","IBRFN",28,0) N X,Y,IFN S X=0,BN=$G(BN) "RTN","IBRFN",29,0) I BN'="" S IFN=+$O(^DGCR(399,"B",BN,0)),Y=$G(^DGCR(399,IFN,0)) I Y'="" D "RTN","IBRFN",30,0) . S X=$S(+$P(Y,U,5)<1:"",+$P(Y,U,5)<3:1,+$P(Y,U,5)<5:2,1:"")_U_$P(Y,U,3),Y=$G(^DGCR(399,IFN,"U")) "RTN","IBRFN",31,0) . S X=X_U_$P(Y,U,1)_U_$P(Y,U,2)_U_$P(Y,U,15)_U_$P($G(^DGCR(399,IFN,"OP",0)),U,4) "RTN","IBRFN",32,0) . S Y=0 F S Y=$O(^DGCR(399,IFN,"OP",Y)) Q:'Y S VDT(Y)="" "RTN","IBRFN",33,0) Q X "RTN","IBRFN",34,0) ; "RTN","IBRFN",35,0) ; "RTN","IBRFN",36,0) REC(IBSTR,IBTYPE,IBDISP) ; Find the AR for an Authorization or Rx number "RTN","IBRFN",37,0) ; Input: IBSTR - FI Authorization Number or Rx Number "RTN","IBRFN",38,0) ; Output: IBAR >0 => ptr to claim/AR in files 399/430 "RTN","IBRFN",39,0) ; -1 => No receivable found "RTN","IBRFN",40,0) ; IBTYPE (by ref) - how the IBSTR was recognized: 1-Auth,2-ECME,3-Rx#,0-Unknown "RTN","IBRFN",41,0) ; IBDISP (by ref) - external display of number (for example to include the leading zeros on the ECME#) "RTN","IBRFN",42,0) ; "RTN","IBRFN",43,0) N IBAR,IBARR,IBRX,IBKEY,IBKEYS,IBREF,IBPREF "RTN","IBRFN",44,0) S IBTYPE=0 "RTN","IBRFN",45,0) S IBAR=-1 "RTN","IBRFN",46,0) I $G(IBSTR)="" G RECQ "RTN","IBRFN",47,0) ; "RTN","IBRFN",48,0) ; extended syntax to indicate the type: "RTN","IBRFN",49,0) ; T.000000 for TRICARE, E.7000000 for ECME, R.50000000 for Rx "RTN","IBRFN",50,0) I $L($P(IBSTR,"."))=1,$P(IBSTR,".",2)'="" D "RTN","IBRFN",51,0) . S IBPREF=$TR($P(IBSTR,"."),"ter","TER") "RTN","IBRFN",52,0) . S IBSTR=$P(IBSTR,".",2,255) "RTN","IBRFN",53,0) . I $E(IBPREF)="T" S IBTYPE=1 ; TRICARE Auth# "RTN","IBRFN",54,0) . I $E(IBPREF)="E" S IBTYPE=2 ; ECME # "RTN","IBRFN",55,0) . I $E(IBPREF)="R" S IBTYPE=3 ; Rx # "RTN","IBRFN",56,0) ; "RTN","IBRFN",57,0) ; look for TRICARE number "RTN","IBRFN",58,0) I (IBTYPE=0)!(IBTYPE=1) S IBAR=$$AREC(IBSTR) I IBAR>0 S IBTYPE=1 G RECQ "RTN","IBRFN",59,0) ; "RTN","IBRFN",60,0) ; - look for ecme number "RTN","IBRFN",61,0) I (IBTYPE=0)!(IBTYPE=2) S IBAR=$$EREC(IBSTR) I IBAR>0 S IBTYPE=2 G RECQ "RTN","IBRFN",62,0) ; "RTN","IBRFN",63,0) I IBTYPE,IBTYPE'=3 G RECQ "RTN","IBRFN",64,0) ; "RTN","IBRFN",65,0) ; - treat as an rx number "RTN","IBRFN",66,0) S IBAR=$$RXREC(IBSTR) I IBAR>0 S IBTYPE=3 "RTN","IBRFN",67,0) ; "RTN","IBRFN",68,0) RECQ Q IBAR "RTN","IBRFN",69,0) ; "RTN","IBRFN",70,0) RXREC(IBRXN) ; Search the Rx "RTN","IBRFN",71,0) N IBR,IBX,IBARR,IBY,IBBIL,IBTRKN,IBFIL,IBRX "RTN","IBRFN",72,0) I $L(IBRXN)<5,'$D(^IBA(362.4,"B",IBRXN)) Q -1 "RTN","IBRFN",73,0) ; Scan 362.4 "RTN","IBRFN",74,0) ; 1) check the exact match: "RTN","IBRFN",75,0) S IBX=0 F S IBX=$O(^IBA(362.4,"B",IBRXN,IBX)) Q:'IBX D "RTN","IBRFN",76,0) . S IBBIL=$P($G(^IBA(362.4,IBX,0)),U,2) Q:'IBBIL "RTN","IBRFN",77,0) . I $P($G(^DGCR(399,IBBIL,0)),U,13)=7 Q ; ignore cancld "RTN","IBRFN",78,0) . S IBARR(IBBIL)="" "RTN","IBRFN",79,0) ; 2) check Rx with postfixes like "A","B" etc "RTN","IBRFN",80,0) S IBR=IBRXN_" " F S IBR=$O(^IBA(362.4,"B",IBR)) Q:$E(IBR,1,$L(IBRXN))'=IBRXN D "RTN","IBRFN",81,0) . I $E(IBR,$L(IBRXN)+1)'?1A Q ; only letters in postfx "RTN","IBRFN",82,0) . S IBX=0 F S IBX=$O(^IBA(362.4,"B",IBR,IBX)) Q:'IBX D "RTN","IBRFN",83,0) . . S IBBIL=$P($G(^IBA(362.4,IBX,0)),U,2) Q:'IBBIL "RTN","IBRFN",84,0) . . I $P($G(^DGCR(399,IBBIL,0)),U,13)=7 Q ; ignore cancld "RTN","IBRFN",85,0) . . S IBARR(IBBIL)="" "RTN","IBRFN",86,0) ; 3) Now scan CT (356): "RTN","IBRFN",87,0) S DIC=52,DIC(0)="BO",X=IBSTR D DIC^PSODI(52,.DIC,X) S IBRX=+Y K DIC,X,Y "RTN","IBRFN",88,0) I IBRX S IBFIL="" F S IBFIL=$O(^IBT(356,"ARXFL",IBRX,IBFIL)) Q:IBFIL="" D "RTN","IBRFN",89,0) . S IBTRKN="" F S IBTRKN=$O(^IBT(356,"ARXFL",IBRX,IBFIL,IBTRKN)) Q:IBTRKN="" D "RTN","IBRFN",90,0) .. S IBBIL=$P($G(^IBT(356,IBTRKN,0)),U,11) Q:'IBBIL "RTN","IBRFN",91,0) .. I $P($G(^DGCR(399,IBBIL,0)),U,13)=7 Q ; ignore cancld "RTN","IBRFN",92,0) .. S IBARR(IBBIL)="" "RTN","IBRFN",93,0) ; "RTN","IBRFN",94,0) S IBY=$O(IBARR("")) I IBY'>0 Q -1 ;not found "RTN","IBRFN",95,0) I '$O(IBARR(IBY)) D DTL(+IBY,"Rx#",IBRXN) Q +IBY ;one only "RTN","IBRFN",96,0) W !!,"More than one claim for Rx# ",IBSTR," exists." "RTN","IBRFN",97,0) S IBY=$$SEL(.IBARR) "RTN","IBRFN",98,0) D DTL(IBY,"Rx#",IBRXN) "RTN","IBRFN",99,0) Q IBY "RTN","IBRFN",100,0) ; "RTN","IBRFN",101,0) AREC(AUTH) ; Find the Receivable for a TRICARE FI Authorization Number "RTN","IBRFN",102,0) ; Input: AUTH - Fiscal Intermediary Authorization Number "RTN","IBRFN",103,0) ; Output: IBIFN >0 => ptr to claim/AR in files 399/430 "RTN","IBRFN",104,0) ; -1 => No receivable found "RTN","IBRFN",105,0) N IBIFN "RTN","IBRFN",106,0) S IBIFN=-1 "RTN","IBRFN",107,0) I $G(AUTH)="" G ARECQ "RTN","IBRFN",108,0) S IBIFN=$P($G(^IBA(351.5,+$O(^IBA(351.5,"AUTH",AUTH,0)),0)),U,9) "RTN","IBRFN",109,0) S:'IBIFN IBIFN=-1 "RTN","IBRFN",110,0) ARECQ ; "RTN","IBRFN",111,0) D DTL(IBIFN,"TRICARE#",AUTH) "RTN","IBRFN",112,0) Q IBIFN "RTN","IBRFN",113,0) ; "RTN","IBRFN",114,0) ; "RTN","IBRFN",115,0) EREC(AUTH) ; Find the Receivable for an ECME FI Number "RTN","IBRFN",116,0) ; Input: AUTH - Fiscal Intermediary ECME Number "RTN","IBRFN",117,0) ; Output: IBIFN >0 => ptr to claim/AR in files 399/430 "RTN","IBRFN",118,0) ; -1 => No receivable found "RTN","IBRFN",119,0) ; "RTN","IBRFN",120,0) ; the ECME# may be either 7 digits or 12 digits in length "RTN","IBRFN",121,0) ; users are not forced to enter the leading zeros, but the "AG" xref stores the ECME# "RTN","IBRFN",122,0) ; with the leading zeros. esg - 11/30/10 - IB*2*435 "RTN","IBRFN",123,0) ; "RTN","IBRFN",124,0) N IBIFN,IBC,IBX,IBA,IBE,IBES,ECMELEN,ECMENUM,ZLEN "RTN","IBRFN",125,0) S IBIFN=-1,IBC=0 "RTN","IBRFN",126,0) I $G(AUTH)="" G ERECQ "RTN","IBRFN",127,0) ; "RTN","IBRFN",128,0) F ECMELEN=12,7 D "RTN","IBRFN",129,0) . I $L(+AUTH)>ECMELEN Q ; if the passed in number is already too large just quit "RTN","IBRFN",130,0) . S ECMENUM=$$RJ^XLFSTR(+AUTH,ECMELEN,0) ; build the actual ECME# with leading zeros if necessary "RTN","IBRFN",131,0) . S (IBE,IBES)=ECMENUM_";" ; getting ready to hit the "AG" xref "RTN","IBRFN",132,0) . F S IBE=$O(^DGCR(399,"AG",IBE)) Q:IBE'[IBES D "RTN","IBRFN",133,0) .. S IBX=0 F S IBX=$O(^DGCR(399,"AG",IBE,IBX)) Q:'IBX D "RTN","IBRFN",134,0) ... I $P($G(^DGCR(399,IBX,0)),U,13)=7 Q ; exclude cancelled claims "RTN","IBRFN",135,0) ... S IBA(IBX)="",IBC=IBC+1 "RTN","IBRFN",136,0) ... S ZLEN=ECMELEN ; save the correct ECME# length for later display "RTN","IBRFN",137,0) ... Q "RTN","IBRFN",138,0) .. Q "RTN","IBRFN",139,0) . Q "RTN","IBRFN",140,0) ; "RTN","IBRFN",141,0) I $G(ZLEN) S (AUTH,IBDISP)=$$RJ^XLFSTR(+AUTH,ZLEN,0) ; reset AUTH for display "RTN","IBRFN",142,0) ; "RTN","IBRFN",143,0) I IBC'>1 S IBIFN=$O(IBA(0)) G ERECQ ; only one or none found "RTN","IBRFN",144,0) ; "RTN","IBRFN",145,0) W !!,"More than one claim for ECME# ",AUTH," exists." "RTN","IBRFN",146,0) S IBIFN=$$SEL(.IBA) "RTN","IBRFN",147,0) ERECQ ; "RTN","IBRFN",148,0) S:'IBIFN IBIFN=-1 "RTN","IBRFN",149,0) D DTL(IBIFN,"ECME#",AUTH) ;details "RTN","IBRFN",150,0) Q IBIFN "RTN","IBRFN",151,0) ; "RTN","IBRFN",152,0) DTL(IBIFN,TYPE,AUTH) ;Details "RTN","IBRFN",153,0) Q:IBIFN'>0 Q:AUTH="" "RTN","IBRFN",154,0) N IBZ,IBBIL,IBPAT,IBPATN,IBRX,IB3624,IBDRUG,IBQTY,IBDAT,DIR,IBFIL "RTN","IBRFN",155,0) S IBZ=$G(^DGCR(399,IBIFN,0)) "RTN","IBRFN",156,0) S IBBIL=$P(IBZ,U),IBPAT=$P(IBZ,U,2),IBDAT=$P(IBZ,U,3) "RTN","IBRFN",157,0) S IBPATN=$P($G(^DPT(+IBPAT,0)),U) "RTN","IBRFN",158,0) S IB3624=$G(^IBA(362.4,+$O(^IBA(362.4,"C",IBIFN,"")),0)) "RTN","IBRFN",159,0) D ZERO^IBRXUTL(+$P(IB3624,U,4)) "RTN","IBRFN",160,0) S IBDRUG=$G(^TMP($J,"IBDRUG",+$P(IB3624,U,4),.01)) "RTN","IBRFN",161,0) K ^TMP($J,"IBDRUG") "RTN","IBRFN",162,0) S IBRX=$$FILE^IBRXUTL(+$P(IB3624,U,5),.01) "RTN","IBRFN",163,0) S IBQTY=+$P(IB3624,U,7) "RTN","IBRFN",164,0) S IBFIL=+$P(IB3624,U,10) "RTN","IBRFN",165,0) W !!,"Found IB Bill ",IBBIL," matching to "_TYPE_" '",AUTH,"':" "RTN","IBRFN",166,0) W !,"Rx#",IBRX,"-",IBFIL," ",$$DAT3^IBOUTL(IBDAT),", ",IBPATN,", ",IBDRUG I IBQTY W " (",IBQTY,")" "RTN","IBRFN",167,0) Q "RTN","IBRFN",168,0) ; "RTN","IBRFN",169,0) AUD(IBIFN) ; Does the Accounts Receivable need to be audited? "RTN","IBRFN",170,0) ; Input: IBIFN - ptr to claim/AR in files 399/430 "RTN","IBRFN",171,0) ; Output: 0 => Claim does not have to be audited "RTN","IBRFN",172,0) ; (claim was set up automatically) "RTN","IBRFN",173,0) ; 1 => Claim must be audited "RTN","IBRFN",174,0) ; (claim was established manually) "RTN","IBRFN",175,0) ; "RTN","IBRFN",176,0) AUDQ Q $O(^IBA(351.5,"ACL",+$G(IBIFN),0))'>0 "RTN","IBRFN",177,0) ; "RTN","IBRFN",178,0) ; "RTN","IBRFN",179,0) TYP(IBIFN) ; Determine the bill type for an Accounts Receivable. "RTN","IBRFN",180,0) ; Input: IBIFN - ptr to claim/AR in files 399/430 "RTN","IBRFN",181,0) ; Output: I => Inpatient bill "RTN","IBRFN",182,0) ; O => Outpatient bill "RTN","IBRFN",183,0) ; PH => Pharmacy bill "RTN","IBRFN",184,0) ; PR => Prosthetics bill "RTN","IBRFN",185,0) ; "RTN","IBRFN",186,0) ; or -1 if the bill type can't be determined. "RTN","IBRFN",187,0) ; "RTN","IBRFN",188,0) N IBATYP,IBATYPN,IBBG,IBN,IBND,IBTYP,IBX "RTN","IBRFN",189,0) S IBTYP=-1 "RTN","IBRFN",190,0) I '$G(IBIFN) G TYPQ "RTN","IBRFN",191,0) ; "RTN","IBRFN",192,0) ; - see if AR originated from file #399 "RTN","IBRFN",193,0) S IBX=$G(^DGCR(399,IBIFN,0)) "RTN","IBRFN",194,0) I IBX]"" D G TYPQ "RTN","IBRFN",195,0) .S IBTYP=$$BTYP^IBCOIVM1(IBIFN,IBX) "RTN","IBRFN",196,0) .S IBTYP=$S(IBTYP="":-1,IBTYP="P":"PR",IBTYP="R":"PH",1:IBTYP) "RTN","IBRFN",197,0) ; "RTN","IBRFN",198,0) ; - get the bill number "RTN","IBRFN",199,0) S IBX=$P($G(^PRCA(430,IBIFN,0)),U) "RTN","IBRFN",200,0) I IBX="" G TYPQ "RTN","IBRFN",201,0) ; "RTN","IBRFN",202,0) ; - AR must have originated from file #350 "RTN","IBRFN",203,0) S IBN=$O(^IB("ABIL",IBX,0)) "RTN","IBRFN",204,0) I 'IBN G TYPQ "RTN","IBRFN",205,0) S IBND=$G(^IB(IBN,0)) "RTN","IBRFN",206,0) I 'IBND G TYPQ "RTN","IBRFN",207,0) S IBATYP=$G(^IBE(350.1,+$P(IBND,U,3),0)),IBBG=$P(IBATYP,U,11) "RTN","IBRFN",208,0) ; "RTN","IBRFN",209,0) ; - handle TRICARE charges first "RTN","IBRFN",210,0) I IBBG=7 D G TYPQ "RTN","IBRFN",211,0) .S IBATYPN=$P(IBATYP,U) "RTN","IBRFN",212,0) .S IBTYP=$S(IBATYPN["INPT":"I",IBATYPN["OPT":"O",1:"PH") "RTN","IBRFN",213,0) ; "RTN","IBRFN",214,0) S IBTYP=$S(IBBG=4:"O",IBBG=5:"PH",IBBG=8:"O",1:"I") "RTN","IBRFN",215,0) TYPQ Q IBTYP "RTN","IBRFN",216,0) ; "RTN","IBRFN",217,0) RELBILL(IBIFN) ; given a Third Party Bill, find all related Third Party bills, "RTN","IBRFN",218,0) ; then find all First Party bills related to any of the Third Party bills "RTN","IBRFN",219,0) ; Input: IBIFN = internal file number of a Third Party bill "RTN","IBRFN",220,0) ; Output: Third Party Bills (#399) "RTN","IBRFN",221,0) ; ^TMP("IBRBT", $J, selected bill ifn) = PATIENT HAS ANY RX COVERAGE ON FROM DATE OF BILL? "RTN","IBRFN",222,0) ; ^TMP("IBRBT", $J, selected bill ifn, matching bill ifn) = "RTN","IBRFN",223,0) ; BILL FROM ^ BILL TO ^ CANCELLED? ^ AR BILL NUMBER ^ "RTN","IBRFN",224,0) ; PAYER SEQUENCE ^ PAYER IS MEDICARE SUPPLEMENTAL (0/1) ^ PAYER NAME "RTN","IBRFN",225,0) ; Output: First Party Bills (#350) "RTN","IBRFN",226,0) ; ^TMP("IBRBF", $J , selected bill ifn ) = "" "RTN","IBRFN",227,0) ; ^TMP("IBRBF", $J , selected bill ifn , charge ifn) = "RTN","IBRFN",228,0) ; BILL FROM ^ BILL TO ^ CANCELLED? ^ AR BILL NUMBER ^ "RTN","IBRFN",229,0) ; TOTAL CHARGE ^ ACTION TYPE (SHORT) ^ # DAYS ON HOLD "RTN","IBRFN",230,0) ; "RTN","IBRFN",231,0) N IBIFN1 I '$D(^DGCR(399,+$G(IBIFN),0)) Q "RTN","IBRFN",232,0) D TPTP^IBEFUR(IBIFN) "RTN","IBRFN",233,0) S IBIFN1=0 F S IBIFN1=$O(^TMP("IBRBT",$J,IBIFN,IBIFN1)) Q:'IBIFN1 D TPFP^IBEFUR(IBIFN1) "RTN","IBRFN",234,0) Q "RTN","IBRFN",235,0) ; "RTN","IBRFN",236,0) SEL(IBARR) ; Select an rx bill "RTN","IBRFN",237,0) ; Input: IBARR - Array of IBIFN "RTN","IBRFN",238,0) ; Output: IBNUM - One of the bill iens, or -1 "RTN","IBRFN",239,0) ; "RTN","IBRFN",240,0) N DIR,IBIFN,IBRXN,IBDT,IBZ,IBY,IBC,IBBIL,IBLNK,DFN,IBPT,I,IBINS,IBCOB,IBFIL "RTN","IBRFN",241,0) ; "RTN","IBRFN",242,0) S IBIFN=$O(IBARR("")) "RTN","IBRFN",243,0) I 'IBIFN Q -1 "RTN","IBRFN",244,0) I '$O(IBARR(IBIFN)) Q IBIFN ; no choice "RTN","IBRFN",245,0) ; "RTN","IBRFN",246,0) W !!?4,"Select one of the following:",! "RTN","IBRFN",247,0) W !?8,"BILL",?17,"RX",?31,"DATE",?42,"INSURANCE",?60,"COB",?65,"PATIENT" "RTN","IBRFN",248,0) W !?4 F I=1:1:75 W "-" "RTN","IBRFN",249,0) ; "RTN","IBRFN",250,0) S (IBIFN,IBC)=0 "RTN","IBRFN",251,0) F S IBIFN=$O(IBARR(IBIFN)) Q:'IBIFN D "RTN","IBRFN",252,0) . S IBZ=$G(^DGCR(399,IBIFN,0)) Q:IBZ="" "RTN","IBRFN",253,0) . S DFN=+$P(IBZ,U,2),IBPT=$P($G(^DPT(DFN,0)),U) "RTN","IBRFN",254,0) . S IBBIL=$P(IBZ,U) "RTN","IBRFN",255,0) . S IBDT=$P(IBZ,U,3) "RTN","IBRFN",256,0) . S IBY=$G(^IBA(362.4,+$O(^IBA(362.4,"C",IBIFN,0)),0)) "RTN","IBRFN",257,0) . S IBRXN=$P(IBY,U,1) ; rx# "RTN","IBRFN",258,0) . S IBFIL=+$P(IBY,U,10) ; fill# "RTN","IBRFN",259,0) . S IBC=IBC+1 "RTN","IBRFN",260,0) . S IBLNK(IBC)=IBIFN "RTN","IBRFN",261,0) . S IBCOB=$P(IBZ,U,21) "RTN","IBRFN",262,0) . S IBINS=$P($G(^DIC(36,+$P($G(^DGCR(399,IBIFN,"MP")),U),0)),U) "RTN","IBRFN",263,0) . W !?4,IBC,?8,IBBIL," ",?17,IBRXN,"-",IBFIL," ",?31,$$DAT1^IBOUTL(IBDT)," ",?42,$E(IBINS,1,18),?61,IBCOB,?65,$E(IBPT,1,14) "RTN","IBRFN",264,0) ; "RTN","IBRFN",265,0) ; "RTN","IBRFN",266,0) F R !!?4,"Select one of the bills by number: ",IBY:DTIME Q:'$T Q:"^"[IBY Q:$D(IBLNK(+IBY)) W:(IBY'="")&(IBY'["?") " ??" D "RTN","IBRFN",267,0) . W !!?8,"Enter numeric value from 1 to ",IBC "RTN","IBRFN",268,0) ; "RTN","IBRFN",269,0) S IBIFN=$G(IBLNK(+IBY),-1) "RTN","IBRFN",270,0) Q IBIFN "RTN","IBY435PO") 0^^B6818265 "RTN","IBY435PO",1,0) IBY435PO ;ALB/ESG - Post Install for IB patch 435 ;4-Oct-2010 "RTN","IBY435PO",2,0) ;;2.0;INTEGRATED BILLING;**435**;21-MAR-94;Build 27 "RTN","IBY435PO",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","IBY435PO",4,0) ; "RTN","IBY435PO",5,0) ; ePharmacy Phase 5 - patch 435 post install "RTN","IBY435PO",6,0) ; "RTN","IBY435PO",7,0) EN ; entry point "RTN","IBY435PO",8,0) N XPDIDTOT "RTN","IBY435PO",9,0) S XPDIDTOT=2 "RTN","IBY435PO",10,0) D SOI(1) ; 1. add a new Source of Information for insurance "RTN","IBY435PO",11,0) D EPI(2) ; 2. change a menu synonym "RTN","IBY435PO",12,0) ; "RTN","IBY435PO",13,0) EX ; exit point "RTN","IBY435PO",14,0) Q "RTN","IBY435PO",15,0) ; "RTN","IBY435PO",16,0) SOI(IBXPD) ; add a new Source of Information for insurance "RTN","IBY435PO",17,0) N DA,DIC,DO,X,Y "RTN","IBY435PO",18,0) D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT) "RTN","IBY435PO",19,0) D MES^XPDUTL("-------------") "RTN","IBY435PO",20,0) D MES^XPDUTL("Add a new Source of Information for Insurance ... ") "RTN","IBY435PO",21,0) ; "RTN","IBY435PO",22,0) F X=10 D "RTN","IBY435PO",23,0) . I $D(^IBE(355.12,"B",X)) D MES^XPDUTL("Already there...no action") Q "RTN","IBY435PO",24,0) . S DIC="^IBE(355.12,",DIC(0)="F" "RTN","IBY435PO",25,0) . S DIC("DR")=".02///E-PHARMACY;.03///eRxEL" "RTN","IBY435PO",26,0) . D FILE^DICN "RTN","IBY435PO",27,0) . I Y=-1 D MES^XPDUTL("ERROR when adding a new Ins. Source of Information. Log a Remedy ticket!") Q "RTN","IBY435PO",28,0) . D MES^XPDUTL("Entry added successfully") "RTN","IBY435PO",29,0) . Q "RTN","IBY435PO",30,0) ; "RTN","IBY435PO",31,0) SOIX ; "RTN","IBY435PO",32,0) D MES^XPDUTL(" Done.") "RTN","IBY435PO",33,0) D UPDATE^XPDID(IBXPD) "RTN","IBY435PO",34,0) Q "RTN","IBY435PO",35,0) ; "RTN","IBY435PO",36,0) EPI(IBXPD) ; change a menu synonym "RTN","IBY435PO",37,0) N DIE,DA,DR,X,Y,MENUIEN,ITEMIEN "RTN","IBY435PO",38,0) D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT) "RTN","IBY435PO",39,0) D MES^XPDUTL("-------------") "RTN","IBY435PO",40,0) D MES^XPDUTL("Modify an ePharmacy menu synonym ... ") "RTN","IBY435PO",41,0) S MENUIEN=$O(^DIC(19,"B","IBCNR E-PHARMACY MENU",0)) I 'MENUIEN D MES^XPDUTL("Parent menu not found.") G EPIX "RTN","IBY435PO",42,0) S ITEMIEN=$O(^DIC(19,"B","IBCNR ELIGIBILITY INQUIRY",0)) I 'ITEMIEN D MES^XPDUTL("ePharm Menu item not found.") G EPIX "RTN","IBY435PO",43,0) S DA=+$O(^DIC(19,MENUIEN,10,"B",ITEMIEN,0)) I 'DA D MES^XPDUTL("ePharm Menu item not found on Parent Menu.") G EPIX "RTN","IBY435PO",44,0) S DIE="^DIC(19,"_MENUIEN_",10," "RTN","IBY435PO",45,0) S DA(1)=MENUIEN "RTN","IBY435PO",46,0) S DR="2////EPI" "RTN","IBY435PO",47,0) D ^DIE "RTN","IBY435PO",48,0) D MES^XPDUTL("ePharmacy Menu synonym has been updated.") "RTN","IBY435PO",49,0) ; "RTN","IBY435PO",50,0) EPIX ; "RTN","IBY435PO",51,0) D MES^XPDUTL(" Done.") "RTN","IBY435PO",52,0) D UPDATE^XPDID(IBXPD) "RTN","IBY435PO",53,0) Q "RTN","IBY435PO",54,0) ; "UP",366.14,366.141,-1) 366.14^1 "UP",366.14,366.141,0) 366.141 "VER") 8.0^22.0 "^DD",355.33,355.33,.17,0) BPS RESPONSE^P9002313.03'^BPSR(^0;17^Q "^DD",355.33,355.33,.17,1,0) ^.1 "^DD",355.33,355.33,.17,1,1,0) 355.33^E "^DD",355.33,355.33,.17,1,1,1) S ^IBA(355.33,"E",$E(X,1,30),DA)="" "^DD",355.33,355.33,.17,1,1,2) K ^IBA(355.33,"E",$E(X,1,30),DA) "^DD",355.33,355.33,.17,1,1,"DT") 3101115 "^DD",355.33,355.33,.17,3) Enter the BPS RESPONSES entry linked with this buffer entry. "^DD",355.33,355.33,.17,21,0) ^^7^7^3101115^ "^DD",355.33,355.33,.17,21,1,0) This is the payer's response to an Eligibility Inquiry. When an "^DD",355.33,355.33,.17,21,2,0) ePharmacy Eligibility Inquiry transaction is sent to the payer, "^DD",355.33,355.33,.17,21,3,0) the payer responds with an NCPDP Eligibility Response "^DD",355.33,355.33,.17,21,4,0) transaction through the ECME engine. This response is stored by "^DD",355.33,355.33,.17,21,5,0) default in the BPS RESPONSES file. When this happens an "^DD",355.33,355.33,.17,21,6,0) insurance buffer entry is also created. This field links the "^DD",355.33,355.33,.17,21,7,0) buffer entry with the BPS Response entry. "^DD",355.33,355.33,.17,23,0) ^^4^4^3101115^ "^DD",355.33,355.33,.17,23,1,0) This field will be automatically populated by the system when "^DD",355.33,355.33,.17,23,2,0) receiving Eligibility responses through the ECME engine. "^DD",355.33,355.33,.17,23,3,0) It is only valid for buffer entries that have a Source of "^DD",355.33,355.33,.17,23,4,0) Information of e-Pharmacy. "^DD",355.33,355.33,.17,"DT") 3101115 "^DD",356,356,1.1,0) ECME NUMBER^FX^^1;10^K:'($L(X)=7)&'($L(X)=12) X "^DD",356,356,1.1,1,0) ^.1 "^DD",356,356,1.1,1,1,0) 356^AE "^DD",356,356,1.1,1,1,1) S ^IBT(356,"AE",$E(X,1,30),DA)="" "^DD",356,356,1.1,1,1,2) K ^IBT(356,"AE",$E(X,1,30),DA) "^DD",356,356,1.1,1,1,"%D",0) ^^2^2^3050328^ "^DD",356,356,1.1,1,1,"%D",1,0) The cross-reference is important to identify CT billable episodes related "^DD",356,356,1.1,1,1,"%D",2,0) to the ECME number. It will be used for EDI matching purposes. "^DD",356,356,1.1,1,1,"DT") 3050328 "^DD",356,356,1.1,3) Answer must be 7 or 12 characters. "^DD",356,356,1.1,10) ECME PACKAGE "^DD",356,356,1.1,21,0) ^.001^2^2^3101011^^^^ "^DD",356,356,1.1,21,1,0) This is the ECME NUMBER associated with the e-Pharmacy Claim. This field "^DD",356,356,1.1,21,2,0) may only be set for e-pharmacy prescriptions and refills. "^DD",356,356,1.1,23,0) ^^9^9^3101020^ "^DD",356,356,1.1,23,1,0) ECME NUMBER is used to link the CT record to the ECME claim. After the "^DD",356,356,1.1,23,2,0) ECME package successfully submitted e-Pharmacy claim it calls IB and "^DD",356,356,1.1,23,3,0) it creates the CT record accociated with the claim, whether it is rejected "^DD",356,356,1.1,23,4,0) by the Payer or approved. This field is especially important for the "^DD",356,356,1.1,23,5,0) rejected e-Pharmacy claims, because IB does not create bills for rejects. "^DD",356,356,1.1,23,6,0) The field ECME NUMBER in CT is the only means AR can recognize EOBs sent "^DD",356,356,1.1,23,7,0) for rejected claims. "^DD",356,356,1.1,23,8,0) "^DD",356,356,1.1,23,9,0) The length of the ECME # for vD.0 has increased to 12 characters, from 7 in v5.1. "^DD",356,356,1.1,"DT") 3101020 "^DD",366.03,366.03,10.14,0) TEST ELIGIBILITY SHEET NAME^P9002313.92'^BPSF(9002313.92,^10;14^Q "^DD",366.03,366.03,10.14,3) Enter the Test Eligibility Verification Payer Sheet Name for the plan. "^DD",366.03,366.03,10.14,21,0) ^^6^6^3101022^ "^DD",366.03,366.03,10.14,21,1,0) This is the Plan's Test Eligibility Verification Payer Sheet Name, which "^DD",366.03,366.03,10.14,21,2,0) gives the specifications for a Eligibility Verification request sent for "^DD",366.03,366.03,10.14,21,3,0) this plan. This payer sheet is manually entered by the user to override "^DD",366.03,366.03,10.14,21,4,0) the normal Eligibility Payer sheet in the ELIGIBILITY PAYER SHEET "^DD",366.03,366.03,10.14,21,5,0) NAME (#10.15) field and is used when the site needs to use a payer sheet "^DD",366.03,366.03,10.14,21,6,0) other than the 'standard' one. "^DD",366.03,366.03,10.14,"DT") 3101022 "^DD",366.03,366.03,10.15,0) ELIGIBILITY PAYER SHEET NAME^P9002313.92'^BPSF(9002313.92,^10;15^Q "^DD",366.03,366.03,10.15,3) Enter the Eligibility Verification Payer Sheet Name for this plan. "^DD",366.03,366.03,10.15,21,0) ^^3^3^3101021^ "^DD",366.03,366.03,10.15,21,1,0) This is the Plan's Eligibility Verification Payer Sheet Name, which gives "^DD",366.03,366.03,10.15,21,2,0) the specifications for a Eligibility Verification request sent for this "^DD",366.03,366.03,10.15,21,3,0) plan. "^DD",366.03,366.03,10.15,"DT") 3101021 "^DD",366.14,366.141,.12,0) BCID^F^^1;2^K:$L(X)>30!($L(X)<1) X "^DD",366.14,366.141,.12,3) Answer must be 1-30 characters in length. "^DD",366.14,366.141,.12,21,0) ^^2^2^3101201^ "^DD",366.14,366.141,.12,21,1,0) This field contains the Prescription/Service Reference Number "^DD",366.14,366.141,.12,21,2,0) (also known as the ECME#) and the Fill Date separated by a semi-colon. "^DD",366.14,366.141,.12,23,0) ^^4^4^3101201^ "^DD",366.14,366.141,.12,23,1,0) Prescription/Service Reference Number (ECME#);Fill Date "^DD",366.14,366.141,.12,23,2,0) Where: "^DD",366.14,366.141,.12,23,3,0) Prescription/Service Ref Number (ECME#) is 7 or 12 digits. "^DD",366.14,366.141,.12,23,4,0) Fill Date is in FileMan format. "^DD",366.14,366.141,.12,"DT") 3101201 "^DD",366.14,366.141,.13,0) CLAIMID^FX^^1;3^K:$L(X)'=7&($L(X)'=12) X "^DD",366.14,366.141,.13,1,0) ^.1 "^DD",366.14,366.141,.13,1,1,0) 366.14^E^MUMPS "^DD",366.14,366.141,.13,1,1,1) S ^IBCNR(366.14,"E",$E(X,1,30),$G(^IBCNR(366.14,DA(1),0)),DA)="" "^DD",366.14,366.141,.13,1,1,2) K ^IBCNR(366.14,"E",$E(X,1,30),$G(^IBCNR(366.14,DA(1),0)),DA) "^DD",366.14,366.141,.13,1,1,"DT") 3060308 "^DD",366.14,366.141,.13,3) Answer must be 7 or 12 characters in length. "^DD",366.14,366.141,.13,21,0) ^.001^1^1^3101026^^ "^DD",366.14,366.141,.13,21,1,0) This is a 7 or 12 digit ECME number with leading zero(s). "^DD",366.14,366.141,.13,"DT") 3101026 **INSTALL NAME** PRCA*4.5*271 "BLD",8107,0) PRCA*4.5*271^ACCOUNTS RECEIVABLE^0^3110830^y "BLD",8107,1,0) ^^1^1^3101029^ "BLD",8107,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "BLD",8107,4,0) ^9.64PA^344^1 "BLD",8107,4,344,0) 344 "BLD",8107,4,344,2,0) ^9.641^344.01^1 "BLD",8107,4,344,2,344.01,0) TRANSACTION (sub-file) "BLD",8107,4,344,2,344.01,1,0) ^9.6411^.09^1 "BLD",8107,4,344,2,344.01,1,.09,0) PATIENT NAME OR BILL NUMBER "BLD",8107,4,344,222) y^y^p^^^^n^^n "BLD",8107,4,344,224) "BLD",8107,4,"APDD",344,344.01) "BLD",8107,4,"APDD",344,344.01,.09) "BLD",8107,4,"B",344,344) "BLD",8107,6.3) 29 "BLD",8107,"ABPKG") n "BLD",8107,"KRN",0) ^9.67PA^779.2^20 "BLD",8107,"KRN",.4,0) .4 "BLD",8107,"KRN",.401,0) .401 "BLD",8107,"KRN",.402,0) .402 "BLD",8107,"KRN",.403,0) .403 "BLD",8107,"KRN",.5,0) .5 "BLD",8107,"KRN",.84,0) .84 "BLD",8107,"KRN",3.6,0) 3.6 "BLD",8107,"KRN",3.8,0) 3.8 "BLD",8107,"KRN",9.2,0) 9.2 "BLD",8107,"KRN",9.8,0) 9.8 "BLD",8107,"KRN",9.8,"NM",0) ^9.68A^6^6 "BLD",8107,"KRN",9.8,"NM",1,0) RCDPBTLM^^0^B47109458 "BLD",8107,"KRN",9.8,"NM",2,0) RCDPESR6^^0^B43409269 "BLD",8107,"KRN",9.8,"NM",3,0) RCDPESR1^^0^B50545484 "BLD",8107,"KRN",9.8,"NM",4,0) RCDPURED^^0^B37216500 "BLD",8107,"KRN",9.8,"NM",5,0) RCDPESR2^^0^B85277265 "BLD",8107,"KRN",9.8,"NM",6,0) RCDPESR4^^0^B77733360 "BLD",8107,"KRN",9.8,"NM","B","RCDPBTLM",1) "BLD",8107,"KRN",9.8,"NM","B","RCDPESR1",3) "BLD",8107,"KRN",9.8,"NM","B","RCDPESR2",5) "BLD",8107,"KRN",9.8,"NM","B","RCDPESR4",6) "BLD",8107,"KRN",9.8,"NM","B","RCDPESR6",2) "BLD",8107,"KRN",9.8,"NM","B","RCDPURED",4) "BLD",8107,"KRN",19,0) 19 "BLD",8107,"KRN",19.1,0) 19.1 "BLD",8107,"KRN",101,0) 101 "BLD",8107,"KRN",409.61,0) 409.61 "BLD",8107,"KRN",771,0) 771 "BLD",8107,"KRN",779.2,0) 779.2 "BLD",8107,"KRN",870,0) 870 "BLD",8107,"KRN",8989.51,0) 8989.51 "BLD",8107,"KRN",8989.52,0) 8989.52 "BLD",8107,"KRN",8994,0) 8994 "BLD",8107,"KRN","B",.4,.4) "BLD",8107,"KRN","B",.401,.401) "BLD",8107,"KRN","B",.402,.402) "BLD",8107,"KRN","B",.403,.403) "BLD",8107,"KRN","B",.5,.5) "BLD",8107,"KRN","B",.84,.84) "BLD",8107,"KRN","B",3.6,3.6) "BLD",8107,"KRN","B",3.8,3.8) "BLD",8107,"KRN","B",9.2,9.2) "BLD",8107,"KRN","B",9.8,9.8) "BLD",8107,"KRN","B",19,19) "BLD",8107,"KRN","B",19.1,19.1) "BLD",8107,"KRN","B",101,101) "BLD",8107,"KRN","B",409.61,409.61) "BLD",8107,"KRN","B",771,771) "BLD",8107,"KRN","B",779.2,779.2) "BLD",8107,"KRN","B",870,870) "BLD",8107,"KRN","B",8989.51,8989.51) "BLD",8107,"KRN","B",8989.52,8989.52) "BLD",8107,"KRN","B",8994,8994) "BLD",8107,"QUES",0) ^9.62^^ "BLD",8107,"REQB",0) ^9.611^5^3 "BLD",8107,"REQB",2,0) PRCA*4.5*247^2 "BLD",8107,"REQB",4,0) PRCA*4.5*268^2 "BLD",8107,"REQB",5,0) PRCA*4.5*269^2 "BLD",8107,"REQB","B","PRCA*4.5*247",2) "BLD",8107,"REQB","B","PRCA*4.5*268",4) "BLD",8107,"REQB","B","PRCA*4.5*269",5) "FIA",344) AR BATCH PAYMENT "FIA",344,0) ^RCY(344, "FIA",344,0,0) 344I "FIA",344,0,1) y^y^p^^^^n^^n "FIA",344,0,10) "FIA",344,0,11) "FIA",344,0,"RLRO") "FIA",344,0,"VR") 4.5^PRCA "FIA",344,344) 1 "FIA",344,344.01) 1 "FIA",344,344.01,.09) "MBREQ") 1 "PKG",142,-1) 1^1 "PKG",142,0) ACCOUNTS RECEIVABLE^PRCA^BILL COLLECTIONS "PKG",142,20,0) ^9.402P^1^1 "PKG",142,20,1,0) 2^^PRCAMRG "PKG",142,20,1,1) "PKG",142,20,"B",2,1) "PKG",142,22,0) ^9.49I^1^1 "PKG",142,22,1,0) 4.5^^2950320 "PKG",142,22,1,"PAH",1,0) 271^3110830 "PKG",142,22,1,"PAH",1,1,0) ^^1^1^3110830 "PKG",142,22,1,"PAH",1,1,1,0) ePharmacy Phase 5 - NCPDP D.0 "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 6 "RTN","RCDPBTLM") 0^1^B47109458 "RTN","RCDPBTLM",1,0) RCDPBTLM ;WISC/RFJ - bill transactions List Manager top routine ;1 Jun 99 "RTN","RCDPBTLM",2,0) ;;4.5;Accounts Receivable;**114,148,153,168,169,198,247,271**;Mar 20, 1995;Build 29 "RTN","RCDPBTLM",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","RCDPBTLM",4,0) ; "RTN","RCDPBTLM",5,0) ; Reference to $$REC^IBRFN supported by DBIA 2031 "RTN","RCDPBTLM",6,0) ; "RTN","RCDPBTLM",7,0) ; called from menu option (19) "RTN","RCDPBTLM",8,0) ; "RTN","RCDPBTLM",9,0) N RCBILLDA,RCDPFXIT "RTN","RCDPBTLM",10,0) ; "RTN","RCDPBTLM",11,0) F D Q:'RCBILLDA "RTN","RCDPBTLM",12,0) . W !! S RCBILLDA=$$SELBILL "RTN","RCDPBTLM",13,0) . I RCBILLDA<1 S RCBILLDA=0 Q "RTN","RCDPBTLM",14,0) . D EN^VALM("RCDP TRANSACTIONS LIST") "RTN","RCDPBTLM",15,0) . ; fast exit "RTN","RCDPBTLM",16,0) . I $G(RCDPFXIT) S RCBILLDA=0 "RTN","RCDPBTLM",17,0) Q "RTN","RCDPBTLM",18,0) ; "RTN","RCDPBTLM",19,0) ; "RTN","RCDPBTLM",20,0) INIT ; initialization for list manager list "RTN","RCDPBTLM",21,0) ; requires rcbillda "RTN","RCDPBTLM",22,0) N ADMIN,DATE,RCLINE,RCLIST,RCTOTAL,RCTRAN,RCTRANDA "RTN","RCDPBTLM",23,0) K ^TMP("RCDPBTLM",$J),^TMP("VALM VIDEO",$J) "RTN","RCDPBTLM",24,0) ; "RTN","RCDPBTLM",25,0) ; fast exit "RTN","RCDPBTLM",26,0) I $G(RCDPFXIT) S VALMQUIT=1 Q "RTN","RCDPBTLM",27,0) ; "RTN","RCDPBTLM",28,0) ; set the List Manager line number "RTN","RCDPBTLM",29,0) S RCLINE=0 "RTN","RCDPBTLM",30,0) ; set the List Manager transaction number "RTN","RCDPBTLM",31,0) S RCTRAN=0 "RTN","RCDPBTLM",32,0) ; "RTN","RCDPBTLM",33,0) ; get transactions and balance for bill "RTN","RCDPBTLM",34,0) S RCTOTAL=$$GETTRANS(RCBILLDA) "RTN","RCDPBTLM",35,0) ; "RTN","RCDPBTLM",36,0) S DATE="" F S DATE=$O(RCLIST(DATE)) Q:'DATE D "RTN","RCDPBTLM",37,0) . S RCTRANDA="" F S RCTRANDA=$O(RCLIST(DATE,RCTRANDA)) Q:RCTRANDA="" D "RTN","RCDPBTLM",38,0) . . S RCLINE=RCLINE+1 "RTN","RCDPBTLM",39,0) . . ; "RTN","RCDPBTLM",40,0) . . ; create an index array for transaction lookup in list "RTN","RCDPBTLM",41,0) . . I RCTRANDA D "RTN","RCDPBTLM",42,0) . . . S RCTRAN=RCTRAN+1 "RTN","RCDPBTLM",43,0) . . . S ^TMP("RCDPBTLM",$J,"IDX",RCTRAN,RCTRAN)=RCTRANDA "RTN","RCDPBTLM",44,0) . . . D SET^RCDPAPLI(RCTRAN,RCLINE,1,80,0,IORVON,IORVOFF) "RTN","RCDPBTLM",45,0) . . ; "RTN","RCDPBTLM",46,0) . . D SET^RCDPAPLI($S(RCTRANDA:RCTRANDA,1:" "),RCLINE,4,80) "RTN","RCDPBTLM",47,0) . . D SET^RCDPAPLI($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,13,21) "RTN","RCDPBTLM",48,0) . . D SET^RCDPAPLI($TR($P(RCLIST(DATE,RCTRANDA),"^"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,25,50) "RTN","RCDPBTLM",49,0) . . D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),"^",2),9,2),RCLINE,53,62) "RTN","RCDPBTLM",50,0) . . D SET^RCDPAPLI($J($P(RCLIST(DATE,RCTRANDA),"^",3),9,2),RCLINE,62,71) "RTN","RCDPBTLM",51,0) . . ; add marshal fee and court cost to create admin dollars "RTN","RCDPBTLM",52,0) . . S ADMIN=$P(RCLIST(DATE,RCTRANDA),"^",4)+$P(RCLIST(DATE,RCTRANDA),"^",5)+$P(RCLIST(DATE,RCTRANDA),"^",6) "RTN","RCDPBTLM",53,0) . . D SET^RCDPAPLI($J(ADMIN,9,2),RCLINE,71,80) "RTN","RCDPBTLM",54,0) ; "RTN","RCDPBTLM",55,0) ; show totals "RTN","RCDPBTLM",56,0) S RCLINE=RCLINE+1 "RTN","RCDPBTLM",57,0) D SET^RCDPAPLI(" --------- -------- --------",RCLINE,1,80) "RTN","RCDPBTLM",58,0) S RCLINE=RCLINE+1 "RTN","RCDPBTLM",59,0) D SET^RCDPAPLI(" TOTAL BALANCE FOR BILL",RCLINE,1,80) "RTN","RCDPBTLM",60,0) D SET^RCDPAPLI($J($P(RCTOTAL,"^",1),9,2),RCLINE,53,62) "RTN","RCDPBTLM",61,0) D SET^RCDPAPLI($J($P(RCTOTAL,"^",2),9,2),RCLINE,62,71) "RTN","RCDPBTLM",62,0) D SET^RCDPAPLI($J($P(RCTOTAL,"^",3)+$P(RCTOTAL,"^",4)+$P(RCTOTAL,"^",5),9,2),RCLINE,71,80) "RTN","RCDPBTLM",63,0) ; "RTN","RCDPBTLM",64,0) ; compare totals to what is stored in the file "RTN","RCDPBTLM",65,0) N RCDATA7,RCFOUT "RTN","RCDPBTLM",66,0) S RCDATA7=$G(^PRCA(430,RCBILLDA,7)) "RTN","RCDPBTLM",67,0) ; for a write-off bill, the balance should equal all zeros, for "RTN","RCDPBTLM",68,0) ; these bills, node 7 is the write-off amount, so for the out of "RTN","RCDPBTLM",69,0) ; balance check to work, node 7 needs to be adjusted to all zeros "RTN","RCDPBTLM",70,0) I $P(^PRCA(430,RCBILLDA,0),"^",8)=23 S RCDATA7="0^0^0^0^0" "RTN","RCDPBTLM",71,0) I +$P(RCDATA7,"^",1)'=+$P(RCTOTAL,"^",1) S RCFOUT=1 "RTN","RCDPBTLM",72,0) I +$P(RCDATA7,"^",2)'=+$P(RCTOTAL,"^",2) S RCFOUT=1 "RTN","RCDPBTLM",73,0) I ($P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5))'=+$P(RCTOTAL,"^",3) S RCFOUT=1 "RTN","RCDPBTLM",74,0) I $G(RCFOUT) D "RTN","RCDPBTLM",75,0) . S RCLINE=RCLINE+1 "RTN","RCDPBTLM",76,0) . D SET^RCDPAPLI(" ",RCLINE,1,80) "RTN","RCDPBTLM",77,0) . S RCLINE=RCLINE+1 "RTN","RCDPBTLM",78,0) . D SET^RCDPAPLI(" STORED BALANCE FOR BILL (** INCORRECT **)",RCLINE,1,80) "RTN","RCDPBTLM",79,0) . D SET^RCDPAPLI($J($P(RCDATA7,"^",1),9,2),RCLINE,53,62) "RTN","RCDPBTLM",80,0) . D SET^RCDPAPLI($J($P(RCDATA7,"^",2),9,2),RCLINE,62,71) "RTN","RCDPBTLM",81,0) . D SET^RCDPAPLI($J($P(RCDATA7,"^",3)+$P(RCDATA7,"^",4)+$P(RCDATA7,"^",5),9,2),RCLINE,71,80) "RTN","RCDPBTLM",82,0) ; "RTN","RCDPBTLM",83,0) ; set valmcnt to number of lines in the list "RTN","RCDPBTLM",84,0) S VALMCNT=RCLINE "RTN","RCDPBTLM",85,0) D HDR "RTN","RCDPBTLM",86,0) Q "RTN","RCDPBTLM",87,0) ; "RTN","RCDPBTLM",88,0) ; "RTN","RCDPBTLM",89,0) HDR ; header code for list manager display "RTN","RCDPBTLM",90,0) ; requires rcbillda "RTN","RCDPBTLM",91,0) N %,DATA,RCDEBTDA,RCDPDATA "RTN","RCDPBTLM",92,0) ; "RTN","RCDPBTLM",93,0) D DIQ430^RCDPBPLM(RCBILLDA,".01;8;") "RTN","RCDPBTLM",94,0) ; "RTN","RCDPBTLM",95,0) S RCDEBTDA=$P(^PRCA(430,RCBILLDA,0),"^",9) "RTN","RCDPBTLM",96,0) S DATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA) "RTN","RCDPBTLM",97,0) ; "RTN","RCDPBTLM",98,0) S %="",$P(%," ",80)="" "RTN","RCDPBTLM",99,0) S VALMHDR(1)=$E("Bill #: "_$G(RCDPDATA(430,RCBILLDA,.01,"E"))_%,1,25)_"Account: "_$P(DATA,"^")_$P(DATA,"^",2) "RTN","RCDPBTLM",100,0) S VALMHDR(2)=$E("Status: "_$G(RCDPDATA(430,RCBILLDA,8,"E"))_%,1,25)_$E(" Addr: "_$P(DATA,"^",4)_", "_$P(DATA,"^",7)_", "_$P(DATA,"^",8)_" "_$P(DATA,"^",9)_%,1,55) "RTN","RCDPBTLM",101,0) Q "RTN","RCDPBTLM",102,0) S VALMHDR(3)=" "_IORVON_$E("Bill Balance: "_$J($P(RCTOTAL,"^")+$P(RCTOTAL,"^",2)+$P(RCTOTAL,"^",3)+$P(RCTOTAL,"^",4)+$P(RCTOTAL,"^",5),0,2)_%,1,23)_IORVOFF_" Phone: "_$P(DATA,"^",10) "RTN","RCDPBTLM",103,0) Q "RTN","RCDPBTLM",104,0) ; "RTN","RCDPBTLM",105,0) ; "RTN","RCDPBTLM",106,0) EXIT ; exit list manager option and clean up "RTN","RCDPBTLM",107,0) K ^TMP("RCDPBTLM",$J),^TMP("RCDPBTLMX",$J) "RTN","RCDPBTLM",108,0) Q "RTN","RCDPBTLM",109,0) ; "RTN","RCDPBTLM",110,0) ; "RTN","RCDPBTLM",111,0) SELBILL() ; select a bill "RTN","RCDPBTLM",112,0) ; returns -1 for timeout or ^, 0 for no selection, or ien of bill "RTN","RCDPBTLM",113,0) N %,%Y,C,DIC,DTOUT,DUOUT,RCBEFLUP,X,Y "RTN","RCDPBTLM",114,0) N DPTNOFZY,DPTNOFZK S (DPTNOFZY,DPTNOFZK)=1 "RTN","RCDPBTLM",115,0) N RCY,DIR,DIRUT "RTN","RCDPBTLM",116,0) ; allow user to get the record using bill# or ECME# "RTN","RCDPBTLM",117,0) S DIR("A")="Select (B)ILL or (E)CME#: " "RTN","RCDPBTLM",118,0) S DIR(0)="SA^B:BILL NUMBER;E:ECME#" "RTN","RCDPBTLM",119,0) S DIR("B")="B" "RTN","RCDPBTLM",120,0) D ^DIR K DIR I $D(DIRUT) Q 0 "RTN","RCDPBTLM",121,0) S RCY=Y "RTN","RCDPBTLM",122,0) I RCY="E" Q $$SELECME "RTN","RCDPBTLM",123,0) S DIC="^PRCA(430,",DIC(0)="QEAM",DIC("A")="Select BILL: " "RTN","RCDPBTLM",124,0) S DIC("W")="D DICW^RCBEUBI1" "RTN","RCDPBTLM",125,0) ; special lookup on input "RTN","RCDPBTLM",126,0) S RCBEFLUP=1 "RTN","RCDPBTLM",127,0) D ^DIC "RTN","RCDPBTLM",128,0) I Y<0,'$G(DUOUT),'$G(DTOUT) S Y=0 "RTN","RCDPBTLM",129,0) Q +Y "RTN","RCDPBTLM",130,0) ; "RTN","RCDPBTLM",131,0) ; "RTN","RCDPBTLM",132,0) GETTRANS(BILLDA) ; original amount goes first for bill "RTN","RCDPBTLM",133,0) ; returns list of transactions in "RTN","RCDPBTLM",134,0) ; rclist(date,tranda)=trantype ^ principle ^ interest ^ admin "RTN","RCDPBTLM",135,0) ; returns principle balance ^ interest balance ^ admin balance "RTN","RCDPBTLM",136,0) ; ^ marshall fee balance ^ court cost balance "RTN","RCDPBTLM",137,0) N %,ADMBAL,AMTDISP,CCBAL,DATA1,DATE,INTBAL,MFBAL,PRINBAL,RCDPDATA,TRANDA,VALUE "RTN","RCDPBTLM",138,0) ; "RTN","RCDPBTLM",139,0) D DIQ430^RCDPBPLM(BILLDA,"3;60;") "RTN","RCDPBTLM",140,0) ; "RTN","RCDPBTLM",141,0) K RCLIST "RTN","RCDPBTLM",142,0) S (ADMBAL,CCBAL,INTBAL,MFBAL,PRINBAL)=0 "RTN","RCDPBTLM",143,0) S PRINBAL=RCDPDATA(430,BILLDA,3,"I") "RTN","RCDPBTLM",144,0) ; loop transaction and add to list "RTN","RCDPBTLM",145,0) S TRANDA=0 F S TRANDA=$O(^PRCA(433,"C",BILLDA,TRANDA)) Q:'TRANDA D "RTN","RCDPBTLM",146,0) . S DATA1=$G(^PRCA(433,TRANDA,1)) "RTN","RCDPBTLM",147,0) . S DATE=$P(DATA1,"^",9) I 'DATE Q "RTN","RCDPBTLM",148,0) . S VALUE=$$TRANVALU(TRANDA) I VALUE="" Q "RTN","RCDPBTLM",149,0) . S RCLIST($P(DATE,"."),TRANDA)=$P($G(^PRCA(430.3,+$P(DATA1,"^",2),0)),"^")_VALUE "RTN","RCDPBTLM",150,0) . ; "RTN","RCDPBTLM",151,0) . ; calculate bill's balance "RTN","RCDPBTLM",152,0) . S PRINBAL=PRINBAL+$P(VALUE,"^",2) "RTN","RCDPBTLM",153,0) . S INTBAL=INTBAL+$P(VALUE,"^",3) "RTN","RCDPBTLM",154,0) . S ADMBAL=ADMBAL+$P(VALUE,"^",4) "RTN","RCDPBTLM",155,0) . S MFBAL=MFBAL+$P(VALUE,"^",5) "RTN","RCDPBTLM",156,0) . S CCBAL=CCBAL+$P(VALUE,"^",6) "RTN","RCDPBTLM",157,0) ; "RTN","RCDPBTLM",158,0) S DATE=$G(RCDPDATA(430,BILLDA,60,"I")) "RTN","RCDPBTLM",159,0) ; check to make sure activation date is not greater than first transaction "RTN","RCDPBTLM",160,0) S %=$O(RCLIST(0)) I DATE>% S DATE=% "RTN","RCDPBTLM",161,0) S RCLIST(+$P(DATE,"."),0)="original amount^"_RCDPDATA(430,BILLDA,3,"I") "RTN","RCDPBTLM",162,0) ; "RTN","RCDPBTLM",163,0) Q PRINBAL_"^"_INTBAL_"^"_ADMBAL_"^"_MFBAL_"^"_CCBAL "RTN","RCDPBTLM",164,0) ; "RTN","RCDPBTLM",165,0) ; "RTN","RCDPBTLM",166,0) TRANVALU(TRANDA) ; return the transaction value as displayed (with + or - sign) "RTN","RCDPBTLM",167,0) N TYPE,VALUE "RTN","RCDPBTLM",168,0) S VALUE=$$TRANBAL^RCRJRCOT(TRANDA) "RTN","RCDPBTLM",169,0) ; no dollars on transaction "RTN","RCDPBTLM",170,0) I '$P(VALUE,"^"),'$P(VALUE,"^",2),'$P(VALUE,"^",3),'$P(VALUE,"^",4),'$P(VALUE,"^",5) Q "" "RTN","RCDPBTLM",171,0) ; check type for payments, etc, make values (-) to subtract "RTN","RCDPBTLM",172,0) S TYPE=$P($G(^PRCA(433,TRANDA,1)),"^",2) "RTN","RCDPBTLM",173,0) I TYPE=2!(TYPE=8)!(TYPE=9)!(TYPE=10)!(TYPE=11)!(TYPE=14)!(TYPE=29)!(TYPE=34)!(TYPE=35)!(TYPE=41) D "RTN","RCDPBTLM",174,0) . S $P(VALUE,"^",1)=-$P(VALUE,"^",1) "RTN","RCDPBTLM",175,0) . S $P(VALUE,"^",2)=-$P(VALUE,"^",2) "RTN","RCDPBTLM",176,0) . S $P(VALUE,"^",3)=-$P(VALUE,"^",3) "RTN","RCDPBTLM",177,0) . S $P(VALUE,"^",4)=-$P(VALUE,"^",4) "RTN","RCDPBTLM",178,0) . S $P(VALUE,"^",5)=-$P(VALUE,"^",5) "RTN","RCDPBTLM",179,0) ; "RTN","RCDPBTLM",180,0) ; the following transaction types should not change the bills balance "RTN","RCDPBTLM",181,0) ; return the amount displayed in the description and 0 for value "RTN","RCDPBTLM",182,0) ; refer to RC 3, refer to DOJ 4, reestablish 5, returned 6 and 32 "RTN","RCDPBTLM",183,0) ; repayment plan 25, amended 33, suspended 47, unsuspended 46 "RTN","RCDPBTLM",184,0) K AMTDISP "RTN","RCDPBTLM",185,0) I TYPE=3!(TYPE=4)!(TYPE=5)!(TYPE=6)!(TYPE=25)!(TYPE=32)!(TYPE=33)!(TYPE=46)!(TYPE=47) D "RTN","RCDPBTLM",186,0) . S AMTDISP=" ($"_$J($P(VALUE,"^")+$P(VALUE,"^",2)+$P(VALUE,"^",3)+$P(VALUE,"^",4)+$P(VALUE,"^",5),0,2)_")" "RTN","RCDPBTLM",187,0) . S VALUE="" "RTN","RCDPBTLM",188,0) Q $G(AMTDISP)_"^"_VALUE "RTN","RCDPBTLM",189,0) ; "RTN","RCDPBTLM",190,0) SELECME() ; "RTN","RCDPBTLM",191,0) ; function takes the user input of the ECME # to return a valid ien of file 430 "RTN","RCDPBTLM",192,0) ; if an invalid ECME is evaluated then the process keeps asking the user for ECME # "RTN","RCDPBTLM",193,0) ; until a valid ECME# is entered or until the user enters a "^" or null value "RTN","RCDPBTLM",194,0) ; output - returns the IEN of the record entry in the ACCOUNT RECEIVABLE file (#430) or "??" "RTN","RCDPBTLM",195,0) N RCECME,RCBILL,DIR,DIRUT,Y "RTN","RCDPBTLM",196,0) S DIR(0)="FO^1:12^I X'?1.12N W !!,""Cannot contain alpha characters"" K X" "RTN","RCDPBTLM",197,0) S DIR("A")="Select ECME#" "RTN","RCDPBTLM",198,0) RET D ^DIR I $D(DIRUT) Q 0 "RTN","RCDPBTLM",199,0) S RCECME=$S(+Y>0:Y,1:0) "RTN","RCDPBTLM",200,0) S RCBILL=$$REC^IBRFN(RCECME) ; IA 2031 "RTN","RCDPBTLM",201,0) I RCBILL<0 W !!,"??" G RET "RTN","RCDPBTLM",202,0) E W !!,$P($G(^PRCA(430,+RCBILL,0)),"^")," " "RTN","RCDPBTLM",203,0) Q RCBILL "RTN","RCDPBTLM",204,0) ;RCDPBTLM "RTN","RCDPESR1") 0^3^B50545484 "RTN","RCDPESR1",1,0) RCDPESR1 ;ALB/TMP - Server interface to AR from Austin ;06/03/02 "RTN","RCDPESR1",2,0) ;;4.5;Accounts Receivable;**173,214,208,202,271**;Mar 20, 1995;Build 29 "RTN","RCDPESR1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","RCDPESR1",4,0) ; "RTN","RCDPESR1",5,0) ; Reference to $$RXBIL^IBNCPDPU supported by DBIA 4435 "RTN","RCDPESR1",6,0) ; "RTN","RCDPESR1",7,0) Q "RTN","RCDPESR1",8,0) ; "RTN","RCDPESR1",9,0) PERROR(RCERR,RCEMG,RCXMZ) ; Process Errors - Send bulletin to mail group "RTN","RCDPESR1",10,0) ; RCERR = Error text array "RTN","RCDPESR1",11,0) ; RCEMG = name of the mail group to which these errors should be sent "RTN","RCDPESR1",12,0) ; RCXMZ = internal entry # of the mailman msg "RTN","RCDPESR1",13,0) ; RCTYPE = msg type, if known "RTN","RCDPESR1",14,0) N CT,XMDUZ,XMSUBJ,XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR,Z "RTN","RCDPESR1",15,0) ; "RTN","RCDPESR1",16,0) S CT=0 "RTN","RCDPESR1",17,0) ; "RTN","RCDPESR1",18,0) I $G(RCEMG)="" S CT=CT+1,RCXM(CT)=$P($T(ERROR+2),";;",2),XMTO(.5)="" "RTN","RCDPESR1",19,0) ; "RTN","RCDPESR1",20,0) I $D(RCEMG) D "RTN","RCDPESR1",21,0) . S:RCEMG="" RCEMG="RCDPE PAYMENTS EXCEPTIONS" "RTN","RCDPESR1",22,0) . S:$E(RCEMG,1,2)'="G." RCEMG="G."_RCEMG "RTN","RCDPESR1",23,0) . S XMTO("I:"_RCEMG)="" "RTN","RCDPESR1",24,0) ; "RTN","RCDPESR1",25,0) S Z=$O(XMTO("")) I Z=.5,'$O(XMTO(.5)) S XMTO("I:G.RCDPE PAYMENTS EXCEPTIONS")="" "RTN","RCDPESR1",26,0) D EMFORM(CT,.RCERR,.RCXM,RCXMZ) "RTN","RCDPESR1",27,0) ; "RTN","RCDPESR1",28,0) S XMDUZ="" "RTN","RCDPESR1",29,0) S XMSUBJ="EDI LBOX SERVER OPTION ERROR",XMBODY="RCXM" "RTN","RCDPESR1",30,0) D "RTN","RCDPESR1",31,0) . N DUZ S DUZ=.5,DUZ(0)="@" "RTN","RCDPESR1",32,0) . D SENDMSG^XMXAPI(.5,XMSUBJ,XMBODY,.XMTO,,.XMZ) "RTN","RCDPESR1",33,0) K ^TMP("RCRAW",$J) "RTN","RCDPESR1",34,0) Q "RTN","RCDPESR1",35,0) ; "RTN","RCDPESR1",36,0) EMFORM(CT,RCERR,RCXM,RCXMZ) ; Format error msgs "RTN","RCDPESR1",37,0) ; INPUT: "RTN","RCDPESR1",38,0) ; CT = # of lines previously populated in error msg "RTN","RCDPESR1",39,0) ; RCERR = array of errors "RTN","RCDPESR1",40,0) ; RCXMZ = internal entry # of mailman msg "RTN","RCDPESR1",41,0) ; "RTN","RCDPESR1",42,0) ; OUTPUT: "RTN","RCDPESR1",43,0) ; RCXM = array containing the complete error msg text "RTN","RCDPESR1",44,0) ; "RTN","RCDPESR1",45,0) N TTYPE,TDATE,TTIME,Z "RTN","RCDPESR1",46,0) ; "RTN","RCDPESR1",47,0) S TDATE=$G(^TMP("RCERR",$J,"DATE")),TTIME=$P(TDATE,".",2)_"000000",TDATE=$$FMTE^XLFDT($P(TDATE,"."),"2D") "RTN","RCDPESR1",48,0) S TTYPE=$G(^TMP("RCMSG",$J)) "RTN","RCDPESR1",49,0) ; "RTN","RCDPESR1",50,0) S CT=CT+1 "RTN","RCDPESR1",51,0) S RCXM(CT)="** AN EXCEPTION HAS BEEN DETECTED FOR AN EDI LOCKBOX RETURN MESSAGE **",CT=CT+1,RCXM(CT)=" " "RTN","RCDPESR1",52,0) S CT=CT+1 "RTN","RCDPESR1",53,0) S RCXM(CT)=" Return Message Code: "_$S(TTYPE="":$S($G(^TMP("RCERR",$J,"TYPE"))'="":^("TYPE"),1:"Cannot be determined"),1:TTYPE) "RTN","RCDPESR1",54,0) ; "RTN","RCDPESR1",55,0) S CT=CT+2 "RTN","RCDPESR1",56,0) S RCXM(CT-1)=" ",RCXM(CT)=$J("",13)_"Return Message Date: "_TDATE_" Message Time: "_$E(TTIME,1,2)_":"_$E(TTIME,3,4)_":"_$E(TTIME,5,6),CT=CT+1 "RTN","RCDPESR1",57,0) ; "RTN","RCDPESR1",58,0) S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=$J("",15)_"Mailman Message #: "_$G(RCXMZ) "RTN","RCDPESR1",59,0) ; "RTN","RCDPESR1",60,0) I $G(RCERR)'="",RCERR?1A.E S CT=CT+2,RCXM(CT-1)=" ",RCXM(CT)=RCERR "RTN","RCDPESR1",61,0) I $G(^TMP("RCERR",$J,"TEXT"))'="" S CT=CT+2,RCXM(CT)=^("TEXT"),RCXM(CT-1)=" " "RTN","RCDPESR1",62,0) ; "RTN","RCDPESR1",63,0) S Z="" F S Z=$O(RCERR(Z)) Q:Z="" S:$G(^TMP("RCERR",$J,"TEXT"))="" CT=CT+1,RCXM(CT)=" " I $G(RCERR(Z))'="",RCERR(Z)'=" " S CT=CT+1,RCXM(CT)=RCERR(Z) "RTN","RCDPESR1",64,0) S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S CT=CT+1,RCXM(CT)=^(Z) "RTN","RCDPESR1",65,0) ; "RTN","RCDPESR1",66,0) Q "RTN","RCDPESR1",67,0) ; "RTN","RCDPESR1",68,0) EXTERR(RCERR,RCE) ; Put error into error array "RTN","RCDPESR1",69,0) ; Returns: (must be passed by reference) "RTN","RCDPESR1",70,0) ; RCERR = specific error encountered, returned as 4 "RTN","RCDPESR1",71,0) ; RCE = error text from the word processing field update error global "RTN","RCDPESR1",72,0) N RCZ,Q "RTN","RCDPESR1",73,0) S RCE="",RCERR=4 ; error reported as 'record was partially stored' "RTN","RCDPESR1",74,0) S RCZ=0 F S RCZ=$O(RCE("DIERR",RCZ)) Q:'RCZ S Q=$G(RCE("DIERR",RCZ,"TEXT",1)) I $L(Q),$L(Q)+$L(RCE)<99 S RCE=RCE_Q_";;" "RTN","RCDPESR1",75,0) Q "RTN","RCDPESR1",76,0) ; "RTN","RCDPESR1",77,0) ERRUPD(RCGBL,RCD,RCTYPE,RCERR) ; Set up global array to hold msg data "RTN","RCDPESR1",78,0) ; RCGBL = name of the global or array where msg data is found "RTN","RCDPESR1",79,0) ; RCD = array containing mail header data for the msg "RTN","RCDPESR1",80,0) ; RCTYPE = type of msg (835ERA/835XFR/etc) "RTN","RCDPESR1",81,0) ; RCERR = error array - text or reference to error tables below "RTN","RCDPESR1",82,0) ; "RTN","RCDPESR1",83,0) ; Returns ^TMP("RCERR",$J,"MSG" array with formatted error text "RTN","RCDPESR1",84,0) ; "RTN","RCDPESR1",85,0) N Z,Z0,Z1,Z2,CT,RCE "RTN","RCDPESR1",86,0) ; "RTN","RCDPESR1",87,0) Q:$G(RCERR)<0 "RTN","RCDPESR1",88,0) K ^TMP("RCERR",$J) "RTN","RCDPESR1",89,0) S CT=0 "RTN","RCDPESR1",90,0) ; "RTN","RCDPESR1",91,0) S ^TMP("RCERR",$J,"DATE")=$G(RCD("DATE")) "RTN","RCDPESR1",92,0) S ^TMP("RCERR",$J,"TYPE")=$G(RCTYPE) "RTN","RCDPESR1",93,0) S ^TMP("RCERR",$J,"SUBJ")=$G(RCD("SUBJ")) "RTN","RCDPESR1",94,0) ; "RTN","RCDPESR1",95,0) I $G(RCERR)>0,RCERR<20 D "RTN","RCDPESR1",96,0) . S Z="ERROR2+"_RCERR "RTN","RCDPESR1",97,0) . S RCE=$P($T(@Z),";;",2) "RTN","RCDPESR1",98,0) . I RCE'="" S ^TMP("RCERR",$J,"TEXT")=RCE "RTN","RCDPESR1",99,0) ; "RTN","RCDPESR1",100,0) S Z="" F S Z=$O(RCERR(Z)) Q:Z="" S Z0="" F S Z0=$O(RCERR(Z,Z0)) Q:Z0="" S RCE=$G(RCERR(Z,Z0)) D "RTN","RCDPESR1",101,0) . I $L(RCE) S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$S(RCE:$P($T(ERROR+RCE),";;",2),1:RCE) "RTN","RCDPESR1",102,0) . S RCTYPE=$P($G(@RCGBL@(0)),U) "RTN","RCDPESR1",103,0) . S:$G(^TMP("RCERR",$J,"TYPE"))="" ^("TYPE")=RCTYPE "RTN","RCDPESR1",104,0) . S Z1="" "RTN","RCDPESR1",105,0) . F S Z1=$O(@RCGBL@(1,"D",Z1)) Q:Z1="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(@RCGBL@(1,"D",Z1)) "RTN","RCDPESR1",106,0) ; "RTN","RCDPESR1",107,0) I $D(@RCGBL@(2,"D")) D "RTN","RCDPESR1",108,0) . S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:" "RTN","RCDPESR1",109,0) . I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0) "RTN","RCDPESR1",110,0) . S Z2="" F S Z2=$O(@RCGBL@(2,"D",Z2)) Q:Z2="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(@RCGBL@(2,"D",Z2)) "RTN","RCDPESR1",111,0) E D "RTN","RCDPESR1",112,0) . Q:'$D(^TMP("RCRAW",$J)) "RTN","RCDPESR1",113,0) . S CT=CT+2,^TMP("RCERR",$J,"MSG",CT-1)=" ",^TMP("RCERR",$J,"MSG",CT)="**** RAW MESSAGE DATA ****:" "RTN","RCDPESR1",114,0) . I $G(^TMP("RCMSGH",$J,0))'="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=^TMP("RCMSGH",$J,0) "RTN","RCDPESR1",115,0) . S Z2="" F S Z2=$O(^TMP("RCRAW",$J,Z2)) Q:Z2="" S CT=CT+1,^TMP("RCERR",$J,"MSG",CT)=$G(^TMP("RCRAW",$J,Z2)) "RTN","RCDPESR1",116,0) ; "RTN","RCDPESR1",117,0) Q "RTN","RCDPESR1",118,0) ; "RTN","RCDPESR1",119,0) DKILL(RCXMZ) ; Delete server mail msg from postmaster mailbox "RTN","RCDPESR1",120,0) ; RCXMZ = ien of mailman msg "RTN","RCDPESR1",121,0) ; "RTN","RCDPESR1",122,0) D ZAPSERV^XMXAPI("S.RCDPE EDI LOCKBOX SERVER",RCXMZ) "RTN","RCDPESR1",123,0) Q "RTN","RCDPESR1",124,0) ; "RTN","RCDPESR1",125,0) TEMPDEL(DA) ; Delete msg from temporary msg file "RTN","RCDPESR1",126,0) ; DA = ien of the entry in file 344.5 "RTN","RCDPESR1",127,0) ; "RTN","RCDPESR1",128,0) N DIK,Y,X "RTN","RCDPESR1",129,0) S DIK="^RCY(344.5," D ^DIK "RTN","RCDPESR1",130,0) L -^RCY(344.5,DA,0) "RTN","RCDPESR1",131,0) Q "RTN","RCDPESR1",132,0) ; "RTN","RCDPESR1",133,0) RESTMSG(RCD,RCARRAY,XMZ) ; Read rest of msg, store in array "RTN","RCDPESR1",134,0) ; RCD = last line # already in the msg "RTN","RCDPESR1",135,0) ; RCARRAY = name of the array to store the data in "RTN","RCDPESR1",136,0) ; XMZ = ien of the mailman msg "RTN","RCDPESR1",137,0) ; "RTN","RCDPESR1",138,0) F X XMREC Q:XMER<0 S RCD=RCD+1,@RCARRAY@(RCD)=XMRG "RTN","RCDPESR1",139,0) Q "RTN","RCDPESR1",140,0) ; "RTN","RCDPESR1",141,0) TAXERR(RCTYPE,RCINS,RCTID,RCCHG) ; Send a bulletin for a bad tax id "RTN","RCDPESR1",142,0) ; RCTYPE = "ERA" for an ERA record, "EFT" for an EFT record "RTN","RCDPESR1",143,0) ; RCINS = name and id to identify the ins co "RTN","RCDPESR1",144,0) ; RCTID = tax id sent in error "RTN","RCDPESR1",145,0) ; RCCHG = code describing how correction was made "RTN","RCDPESR1",146,0) ; 'E'=EPHRA, 'C'=Changed by looking at claim #'s "RTN","RCDPESR1",147,0) ; "RTN","RCDPESR1",148,0) N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCDXM,XMZ,XMERR,RCCT,RCDXM,RCCT "RTN","RCDPESR1",149,0) S RCCT=0 "RTN","RCDPESR1",150,0) S RCCT=RCCT+1,RCDXM(RCCT)="An "_RCTYPE_" was received at your site "_$$FMTE^XLFDT($$NOW^XLFDT(),2)_" with an invalid tax id.",RCCT=RCCT+1,RCDXM(RCCT)=" From: "_RCINS "RTN","RCDPESR1",151,0) S RCCT=RCCT+1,RCDXM(RCCT)=" The tax id sent was: "_RCTID_" and it was corrected by: " "RTN","RCDPESR1",152,0) S RCCT=RCCT+1,RCDXM(RCCT)=" "_$S(RCCHG="E":"EPHRA",1:"Extracting it based on bill numbers in the ERA") "RTN","RCDPESR1",153,0) S RCCT=RCCT+2,RCDXM(RCCT-1)=" ",RCDXM(RCCT)="If your site continues to receive these bulletins for this payer,",RCCT=RCCT+1,RCDXM(RCCT)="contact the payer and request they correct their tax id for your site" "RTN","RCDPESR1",154,0) ; "RTN","RCDPESR1",155,0) S XMTO("I:G.RCDPE PAYMENTS")="",XMBODY="RCDXM" "RTN","RCDPESR1",156,0) D "RTN","RCDPESR1",157,0) . N DUZ S DUZ=.5,DUZ(0)="@" "RTN","RCDPESR1",158,0) . D SENDMSG^XMXAPI(.5,"EDI LBOX ERRONEOUS TAX ID ON "_RCTYPE,XMBODY,.XMTO,,.XMZ) "RTN","RCDPESR1",159,0) Q "RTN","RCDPESR1",160,0) ; "RTN","RCDPESR1",161,0) BILL(X,RCDT,RCIB) ; Returns ien of bill in X or -1 if not valid "RTN","RCDPESR1",162,0) ; RCDT = the Statement from date (used for Rx bills) "RTN","RCDPESR1",163,0) ; and, if passed by reference, RCIB = 1 if an insurance bill "RTN","RCDPESR1",164,0) N DIC,Y "RTN","RCDPESR1",165,0) S RCIB=0 "RTN","RCDPESR1",166,0) S X=$TR(X," "),X=$TR(X,"O","0") ; Remove spaces, change ohs to zeroes "RTN","RCDPESR1",167,0) I X'["-",$E(X,1,3)?3N,+$E(X,1,3),$L(X)>7,$L(X)<12 S X=$E(X,1,3)_"-"_$E(X,4,$L(X)) "RTN","RCDPESR1",168,0) S DIC="^PRCA(430,",DIC(0)="MZ" D ^DIC "RTN","RCDPESR1",169,0) I Y<0,X?1.12N D ; Rx lookup esg 9/7/10 *271 - ECME# up to 12 digits "RTN","RCDPESR1",170,0) . N ARRAY "RTN","RCDPESR1",171,0) . S ARRAY("ECME")=X,ARRAY("FILLDT")=$G(RCDT) "RTN","RCDPESR1",172,0) . S Y=$$RXBIL^IBNCPDPU(.ARRAY) ; DBIA 4435 "RTN","RCDPESR1",173,0) . I Y>0 S Y(0)=$G(^PRCA(430,+Y,0)) "RTN","RCDPESR1",174,0) I Y>0 S RCIB=($P($G(^RCD(340,+$P(Y(0),U,9),0)),U)["DIC(36,") "RTN","RCDPESR1",175,0) Q +Y "RTN","RCDPESR1",176,0) ; "RTN","RCDPESR1",177,0) FMDT(X) ; Format date (X) in YYYYMMDD to Fileman format "RTN","RCDPESR1",178,0) I $L(X)=8 D "RTN","RCDPESR1",179,0) . S X=$E(X,1,4)-1700_$E(X,5,8) "RTN","RCDPESR1",180,0) Q X "RTN","RCDPESR1",181,0) ; "RTN","RCDPESR1",182,0) ERROR ; Top level error msgs for msgs "RTN","RCDPESR1",183,0) ;;Invalid mailgroup designated for EDI Lockbox errors "RTN","RCDPESR1",184,0) ;;Message header error "RTN","RCDPESR1",185,0) ; "RTN","RCDPESR1",186,0) ERROR2 ; Error condition msgs for msgs "RTN","RCDPESR1",187,0) ;;Message code is invalid for EDI Lockbox. "RTN","RCDPESR1",188,0) ;;This message has no ending $ or 99 record. "RTN","RCDPESR1",189,0) ;;Message file problem - no message stored. "RTN","RCDPESR1",190,0) ;;Message file problem - message partially stored. "RTN","RCDPESR1",191,0) ;;No valid claims for the site found on the ERA. "RTN","RCDPESR1",192,0) ; "RTN","RCDPESR2") 0^5^B85277265 "RTN","RCDPESR2",1,0) RCDPESR2 ;ALB/TMK/DWA - Server auto-upd - EDI Lockbox ; 06/03/02 "RTN","RCDPESR2",2,0) ;;4.5;Accounts Receivable;**173,216,208,230,252,264,269,271**;Mar 20, 1995;Build 29 "RTN","RCDPESR2",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","RCDPESR2",4,0) ; IA 4042 (IBCEOB) "RTN","RCDPESR2",5,0) ; "RTN","RCDPESR2",6,0) TASKERA(RCTDA) ; Task to upd ERA "RTN","RCDPESR2",7,0) ; RCTDA = ien 344.5 "RTN","RCDPESR2",8,0) N ZTDTH,ZTUCI,ZTSAVE,ZTIO,ZTDESC,ZTRTN,ZTSK,DIE,DR,DA "RTN","RCDPESR2",9,0) S (ZTSAVE("DT"),ZTSAVE("U"),ZTSAVE("DUZ"))="",ZTSAVE("ZTREQ")="@",ZTRTN="NEWERA^RCDPESR2("_RCTDA_",0)",ZTDTH=$H,ZTIO="" "RTN","RCDPESR2",10,0) D ^%ZTLOAD "RTN","RCDPESR2",11,0) Q "RTN","RCDPESR2",12,0) ; "RTN","RCDPESR2",13,0) NEWERA(RCTDA,RCREFILE) ;Tasked "RTN","RCDPESR2",14,0) ; Add new EOB's to IB & ERA tot rec to AR "RTN","RCDPESR2",15,0) ; RCTDA = ien 344.5 "RTN","RCDPESR2",16,0) ; RCREFILE = 1: re-filing rec via exc proc "RTN","RCDPESR2",17,0) N RCDUPERR,RCPAYER,RCRTOT,RCE,RCEC,RCERR,RCR1,RCADJ,DIE,DR,DA,Z,Q "RTN","RCDPESR2",18,0) S ZTREQ="@" "RTN","RCDPESR2",19,0) K ^TMP($J,"RCDPERA") "RTN","RCDPESR2",20,0) L +^RCY(344.5,RCTDA):5 "RTN","RCDPESR2",21,0) I $D(ZTQUEUED) S DIE="^RCY(344.5,",DA=RCTDA,DR=".05////"_ZTSK_";.04////1" D ^DIE "RTN","RCDPESR2",22,0) I $P($G(^RCY(344.5,RCTDA,0)),U,5),'$G(RCREFILE) S DIE="^RCY(344.5,",DA=RCTDA,DR=".1////4;.08///1" D ^DIE "RTN","RCDPESR2",23,0) S RCR1=$P($G(^RCY(344.5,RCTDA,0)),U,7),RCPAYER=$P($G(^RCY(344.5,RCTDA,3)),U) "RTN","RCDPESR2",24,0) S RCRTOT=$S(RCR1:RCR1,1:$$ERATOT^RCDPESR6(RCTDA,.RCERR)) ; ERA rec "RTN","RCDPESR2",25,0) S RCDUPERR=$S($G(RCERR)="DUP"!($G(RCERR(1))=-2):$G(RCERR(1)),1:0) K RCERR(1) "RTN","RCDPESR2",26,0) I RCRTOT,'RCR1 S DIE="^RCY(344.5,",DR=".07////"_RCRTOT,DA=RCTDA D ^DIE "RTN","RCDPESR2",27,0) D:RCDUPERR'=-2 UPDEOB(RCTDA,5,$S('$G(RCREFILE):RCDUPERR,1:-1)) ; Add EOB det to IB "RTN","RCDPESR2",28,0) I RCRTOT D UPDCON^RCDPESR6(RCRTOT),UPDADJ^RCDPESR6(RCRTOT),UPD3444^RCDPESR6(.RCRTOT) ; Bills added 344.41 "RTN","RCDPESR2",29,0) I RCRTOT,RCTDA S DIE="^RCY(344.5,",DR=".08////0;.1///@",DA=RCTDA D ^DIE "RTN","RCDPESR2",30,0) I 'RCRTOT D G QNEW "RTN","RCDPESR2",31,0) .I RCDUPERR Q:'RCTDA D S RCTDA="" Q "RTN","RCDPESR2",32,0) ..I RCDUPERR=-2 D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - DUPLICATE ERA NOT FILED "_$E(RCPAYER,1,20),.RCERR,0) "RTN","RCDPESR2",33,0) ..D TEMPDEL^RCDPESR1(RCTDA) "RTN","RCDPESR2",34,0) .S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" An error occurred while storing ERA data.",RCE(2)="No totals data was stored for this ERA record"_$S('$G(RCREFILE):" and an",1:" on this re-file attempt.") "RTN","RCDPESR2",35,0) .S RCE(3)=$S('$G(RCREFILE):"ERA transmission exception was created.",1:"") "RTN","RCDPESR2",36,0) .D WP^DIE(344.5,RCTDA_",",5,"A","RCE") "RTN","RCDPESR2",37,0) .S DIE="^RCY(344.5,",DA=RCTDA,DR=".07///@;.08////1;.1////1" D ^DIE "RTN","RCDPESR2",38,0) .K RCERR "RTN","RCDPESR2",39,0) .S RCERR(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" The ERA data could not be stored. The AR receipt",RCERR(2)=" for this data must be created/processed manually for the bills included" "RTN","RCDPESR2",40,0) .S RCERR(3)=" in this ERA."_$S('$G(RCREFILE):"",1:" This error occurred during a refile attempt."),RCERR(4)=" " "RTN","RCDPESR2",41,0) .D BULLERA^RCDPESR0("DF",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - TOTALS FILE EXCEPTION "_$E(RCPAYER,1,20),.RCERR,0) "RTN","RCDPESR2",42,0) .K RCERR "RTN","RCDPESR2",43,0) I $$ADJ^RCDPEU(RCRTOT,.RCADJ) D ;Bulletin adjs "RTN","RCDPESR2",44,0) .S RCEC=$$ADJERR^RCDPESR3(.RCERR) "RTN","RCDPESR2",45,0) .I RCADJ'=2 S RCEC=RCEC+1,RCERR(RCEC)=" THERE ARE ERA LEVEL ADJUSTMENT(S)",RCEC=RCEC+1,RCERR(RCEC)=" " "RTN","RCDPESR2",46,0) .I RCADJ'=1 S RCEC=RCEC+1,RCERR(RCEC)=" THE FOLLOWING BILL(S) HAVE RETRACTIONS:" D "RTN","RCDPESR2",47,0) ..S (Q,Z)=0 S Z=0 F S Z=$O(RCADJ(RCRTOT,Z)) Q:'Z S:'Q RCEC=RCEC+1,RCERR(RCEC)=" " S Q=Q+1,RCERR(RCEC)=RCERR(RCEC)_" "_RCADJ(RCRTOT,Z) S:Q=4 Q=0 "RTN","RCDPESR2",48,0) ..S RCEC=RCEC+1,RCERR(RCEC)=" " "RTN","RCDPESR2",49,0) .D BULLERA^RCDPESR0("D",RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U,11),"EDI LBOX - ERA HAS ADJ/TAKEBACKS "_$E(RCPAYER,1,20),.RCERR,0) "RTN","RCDPESR2",50,0) ; "RTN","RCDPESR2",51,0) QNEW I RCTDA,'$P($G(^RCY(344.5,RCTDA,0)),U,8) D TEMPDEL^RCDPESR1(RCTDA) S RCTDA="" "RTN","RCDPESR2",52,0) I RCTDA,$P($G(^RCY(344.5,RCTDA,0)),U)'="" S DIE="^RCY(344.5,",DR=".04////0;.05///@"_$S('$G(RCR1)&$G(RCRTOT):";.07////"_RCRTOT,1:""),DA=RCTDA D ^DIE "RTN","RCDPESR2",53,0) K ^TMP($J,"RCDPERA") "RTN","RCDPESR2",54,0) I RCTDA L -^RCY(344.5,RCTDA) "RTN","RCDPESR2",55,0) Q "RTN","RCDPESR2",56,0) ; "RTN","RCDPESR2",57,0) UPDEOB(RCTDA,RCFILE,DUP) ;Upd 361.1 from ERA msg in 344.5 or .4 "RTN","RCDPESR2",58,0) ;RCTDA = ien ERA msg in 344.5 or ;subfile in 344.4 "RTN","RCDPESR2",59,0) ;RCFILE = 4 file 344.4, 5 if 344.5 "RTN","RCDPESR2",60,0) ;DUP = msg # if dup msg, but not same # or -1 if same msg # "RTN","RCDPESR2",61,0) ;Returned for each bill in ERA: "RTN","RCDPESR2",62,0) ;^TMP($J,"RCDPEOB",n)=Bill ien^AR bill#^SrvDt "RTN","RCDPESR2",63,0) ;^TMP($J,"RCDPEOB",n,"EOB")=EOB ien^amt pd^ins co ptr^rev flg^EEOB pn^amtbld^^^^BPNPI^RNPI^ETQual^LN^FN "RTN","RCDPESR2",64,0) ;^TMP($J,"RCDPEOB","ADJ",x)=adj rec ('02') "RTN","RCDPESR2",65,0) ;Also: "RTN","RCDPESR2",66,0) ;^TMP($J,"RCDPEOB","HDR")=hdr rec from txmn "RTN","RCDPESR2",67,0) ;^TMP($J,"RCDPEOB","CONTACT")=ERA contact rec ('01') "RTN","RCDPESR2",68,0) ; "RTN","RCDPESR2",69,0) N RCGBL,RC,RC0,RCCT,RCCT1,RCEOB,RCBILL,RCDPBNPI,RCMNUM,RCIFN,RCIB,RCERR,RCSTAR,RCET,RCX,RCXMG,Z,Q,DA,DR,DIE,RCPAYER,RCFILED,RCEOBD,RCNOUPD,REFORM,RCSD,RCERR1,C5 "RTN","RCDPESR2",70,0) K ^TMP($J,"RCDP-EOB"),^TMP("RCDPERR-EOB",$J) "RTN","RCDPESR2",71,0) ; "RTN","RCDPESR2",72,0) S RCPAYER="",RCFILED=1,RCNOUPD=0 "RTN","RCDPESR2",73,0) I RCFILE=5 D "RTN","RCDPESR2",74,0) .S RCGBL=$NA(^RCY(344.5,RCTDA,2)) "RTN","RCDPESR2",75,0) .S RCMNUM=+$G(^RCY(344.5,RCTDA,0)),RCXMG=$P($G(^(0)),U,11) "RTN","RCDPESR2",76,0) .I $G(DUP) S RCNOUPD=$S(DUP>0:+DUP,1:RCXMG) "RTN","RCDPESR2",77,0) .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.5,RCTDA,2,1,0)) "RTN","RCDPESR2",78,0) .I $P(^TMP($J,"RCDPEOB","HDR"),U)["XFR",'$P($G(^RCY(344.5,RCTDA,0)),U,14) D "RTN","RCDPESR2",79,0) ..D SENDACK^RCDPESR5(RCTDA,1) "RTN","RCDPESR2",80,0) ..S DR=".14////1",DIE="^RCY(344.5,",DA=RCTDA D ^DIE "RTN","RCDPESR2",81,0) ; "RTN","RCDPESR2",82,0) I RCFILE=4 D "RTN","RCDPESR2",83,0) .S RCGBL=$NA(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1)) "RTN","RCDPESR2",84,0) .S RCMNUM=$P($G(^RCY(344.4,+RCTDA,0)),U,12),RCXMG=$P($G(^(0)),U,12) "RTN","RCDPESR2",85,0) .S ^TMP($J,"RCDPEOB","HDR")=$G(^RCY(344.4,+RCTDA,1,+$P(RCTDA,";",2),1,1,0)) "RTN","RCDPESR2",86,0) ; "RTN","RCDPESR2",87,0) S RCPAYER=$P($G(^TMP($J,"RCDPEOB","HDR")),U,6) "RTN","RCDPESR2",88,0) S RCDPBNPI=$P($G(^TMP($J,"RCDPEOB","HDR")),U,18) "RTN","RCDPESR2",89,0) ; "RTN","RCDPESR2",90,0) ;srv dates "RTN","RCDPESR2",91,0) S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD "RTN","RCDPESR2",92,0) N CP5 S CP5="",RC=1,C5=0 ;retrofit 264 into 269 "RTN","RCDPESR2",93,0) F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D "RTN","RCDPESR2",94,0) .I RC0<5 Q "RTN","RCDPESR2",95,0) .I +RC0=5 S C5=RC,CP5=$P(RC0,U,2) Q ;retrofit 264 into 269 "RTN","RCDPESR2",96,0) .I +RC0=40,CP5?1.12N,C5,'$D(@RCSD@(C5)) S @RCSD@(C5)=$P(RC0,U,19) ;serv date for possible ECME# matching "RTN","RCDPESR2",97,0) ; "RTN","RCDPESR2",98,0) S RC=1,(RCCT,RCCT1,RCX,REFORM)=0,RCBILL="" "RTN","RCDPESR2",99,0) S RCERR1=$NA(^TMP("RCERR1",$J)) K @RCERR1 "RTN","RCDPESR2",100,0) F S RC=$O(@RCGBL@(RC)) Q:'RC S RC0=$G(^(RC,0)) D "RTN","RCDPESR2",101,0) .I RCFILE=5,+RC0=1 D Q "RTN","RCDPESR2",102,0) ..S ^TMP($J,"RCDPEOB","CONTACT")=RC0 "RTN","RCDPESR2",103,0) .; "RTN","RCDPESR2",104,0) .I RCFILE=5,+RC0=2 D Q "RTN","RCDPESR2",105,0) ..S RCX=RCX+1,^TMP($J,"RCDPEOB","ADJ",RCX)=RC0 "RTN","RCDPESR2",106,0) .I RCFILE=5,+RC0=3 D Q ; Adding logic for line type 03,Patch 269,DWA "RTN","RCDPESR2",107,0) ..S $P(^TMP($J,"RCDPEOB","ADJ",RCX),U,5)=$P(RC0,U,2) "RTN","RCDPESR2",108,0) .; "RTN","RCDPESR2",109,0) .I +RC0=5 S RCCT=RCCT+1,RCCT1=0 D "RTN","RCDPESR2",110,0) ..S REFORM=0 "RTN","RCDPESR2",111,0) ..S Z=$$BILL^RCDPESR1($P(RC0,U,2),$G(@RCSD@(RC)),.RCIB) ; look up claim ien by claim# or by ECME# "RTN","RCDPESR2",112,0) ..I Z S RCBILL=$P($G(^PRCA(430,Z,0)),U) I RCBILL'="",RCBILL'=$P(RC0,U,2) S REFORM=1,$P(RC0,U,2)=RCBILL "RTN","RCDPESR2",113,0) ..S RCBILL=$P(RC0,U,2) "RTN","RCDPESR2",114,0) ..S Z=$S(Z>0:$S($G(RCIB):Z,1:-1),1:-1) "RTN","RCDPESR2",115,0) ..S ^TMP($J,"RCDP-EOB",RCCT,0)=Z_U_RCBILL_U_$G(@RCSD@(RC)) "RTN","RCDPESR2",116,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,5)=$P(RC0,U,3)_","_$P(RC0,U,4)_" "_$P(RC0,U,5) ;Save pt nm "RTN","RCDPESR2",117,0) ..I Z>0 S Q=+$P($G(^PRCA(430,Z,0)),U,9) I $P($G(^RCD(340,Q,0)),U)["DIC(36," S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,3)=+^RCD(340,Q,0) ;Save ins co "RTN","RCDPESR2",118,0) .; "RTN","RCDPESR2",119,0) .I +RC0>5,REFORM S $P(RC0,U,2)=RCBILL ; "RTN","RCDPESR2",120,0) .I +RC0=10 D ;Save amt pd/billed, rev flg "RTN","RCDPESR2",121,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2)=$S(+$P(RC0,U,11):$J($P(RC0,U,11)/100,"",2),1:0),$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,6)=$J($P(RC0,U,11),"",2) "RTN","RCDPESR2",122,0) ..I $P(RC0,U,6)="Y"!($P(RC0,U,7)=22) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,4)=1 "RTN","RCDPESR2",123,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,16,19) "RTN","RCDPESR2",124,0) .I +RC0=11 D ; Save Rendering Provider information from new style message "RTN","RCDPESR2",125,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,10,14)=RCDPBNPI_U_$P(RC0,U,3,6) "RTN","RCDPESR2",126,0) ..; End save of Rendering Provider "RTN","RCDPESR2",127,0) .I RCBILL=$P(RC0,U,2) S RCCT1=RCCT1+1,^TMP($J,"RCDP-EOB",RCCT,RCCT1,0)=RC0 "RTN","RCDPESR2",128,0) ; "RTN","RCDPESR2",129,0) S RCSTAR=$TR($J("",15)," ","*"),RCET=RCSTAR_"ERROR/WARNING EEOB DETAIL SEQ #" "RTN","RCDPESR2",130,0) S RCCT=0 F S RCCT=$O(^TMP($J,"RCDP-EOB",RCCT)) Q:'RCCT S RCIFN=+$G(^(RCCT,0)),RCBILL=$P($G(^(0)),U,2),^TMP($J,"RCDPEOB",RCCT)=$G(^TMP($J,"RCDP-EOB",RCCT,0)) D "RTN","RCDPESR2",131,0) .S RCEOB=-1,RCEOBD="" "RTN","RCDPESR2",132,0) .I $S(RCIFN>0:$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCIFN,0)),U,8),0),U,3)'=102,RCIFN'>0&($G(DUP)'>0):1,1:0) D "RTN","RCDPESR2",133,0) ..S @RCERR1@(RCCT)=" ",@RCERR1@(RCCT,1)=RCET_RCCT_RCSTAR "RTN","RCDPESR2",134,0) ..S @RCERR1@(RCCT,2)="Bill "_RCBILL_" is"_$S(RCIFN>0:" not in an ACTIVE status in your A/R",1:"n't valid/wasn't found so its detail wasn't stored in IB") "RTN","RCDPESR2",135,0) ..S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) "RTN","RCDPESR2",136,0) ..S @RCERR1@(RCCT,3)=" The reported amount paid on this bill was: "_$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U,2) "RTN","RCDPESR2",137,0) ..I RCIFN'>0 D "RTN","RCDPESR2",138,0) ...S @RCERR1@(RCCT,4)=" If the bill is not for your site, it must be transferred to the" "RTN","RCDPESR2",139,0) ...S @RCERR1@(RCCT,5)=" correct site and manually adjusted in your AR." "RTN","RCDPESR2",140,0) ...S @RCERR1@(RCCT,6)=" You can perform this transfer using EDI Lockbox ERA/EEOB exception process." "RTN","RCDPESR2",141,0) ...S @RCERR1@(RCCT,7)=" " "RTN","RCDPESR2",142,0) ..D DISP1^RCDPESR5(RCCT,1) "RTN","RCDPESR2",143,0) ..S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) "RTN","RCDPESR2",144,0) ..S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) "RTN","RCDPESR2",145,0) ..I RCFILE=5 D ;Store err if trans-in failed "RTN","RCDPESR2",146,0) ...N RCE,RC,DIE,X,Y,DA,DR "RTN","RCDPESR2",147,0) ...S RCE(1)=$$FMTE^XLFDT($$NOW^XLFDT(),2)_" "_$G(@RCERR1@(RCCT,"*")) "RTN","RCDPESR2",148,0) ...S RCE(2)=" ",RCFILED=0 "RTN","RCDPESR2",149,0) ...D WP^DIE(344.5,RCTDA_",",5,"A","RCE") "RTN","RCDPESR2",150,0) .I RCIFN>0 D "RTN","RCDPESR2",151,0) ..N RCDUPEOB,RCALLDUP "RTN","RCDPESR2",152,0) ..;Chk rec exists "RTN","RCDPESR2",153,0) ..S RCDUPEOB=0 "RTN","RCDPESR2",154,0) ..S RCEOB=$$DUP^RCDPESR3(RCMNUM,RCIFN,$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,2),$P($G(^TMP($J,"RCDPEOB",RCCT,"EOB")),U,6)) ;Same msg for update? "RTN","RCDPESR2",155,0) ..I RCEOB,$P(RCEOB,U,2) S RCEOB=0 ;If chksum exists, let below check it "RTN","RCDPESR2",156,0) ..S ^TMP($J,"RCDP-EOB",RCCT,.5,0)="835ERA" ;Needed - checksum "RTN","RCDPESR2",157,0) ..S RCALLDUP=$$DUP^IBCEOB("^TMP("_$J_",""RCDP-EOB"","_RCCT_")",RCIFN) "RTN","RCDPESR2",158,0) ..I $S(RCALLDUP:1,RCEOB:$G(DUP)'>0,1:0) D "RTN","RCDPESR2",159,0) ...S RCDUPEOB=1 "RTN","RCDPESR2",160,0) ...D DUPREC^RCDPESR6(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,.RCDUPEOB) "RTN","RCDPESR2",161,0) ...S:RCALLDUP RCEOBD=RCALLDUP "RTN","RCDPESR2",162,0) ..;Add stub to 361.1 "RTN","RCDPESR2",163,0) ..I 'RCDUPEOB S RCEOB=+$$ADD3611^IBCEOB(RCMNUM,"","",RCIFN,1,"^TMP("_$J_",""RCDP-EOB"","_RCCT_")") ;IA 4042 "RTN","RCDPESR2",164,0) ..K ^TMP($J,"RCDP-EOB",RCCT,.5,0) "RTN","RCDPESR2",165,0) ..I RCEOB<0 D:$G(DUP)'>0 Q "RTN","RCDPESR2",166,0) ...S @RCERR1@(RCCT)=" ",^(RCCT,1)=RCET_RCCT_RCSTAR,RCFILED=0 "RTN","RCDPESR2",167,0) ...S @RCERR1@(RCCT,2)="Error - EEOB detail not added to IB for bill "_RCBILL,$P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)="" "RTN","RCDPESR2",168,0) ...S:RCFILE=5 @RCERR1@(RCCT,"*")=@RCERR1@(RCCT,2) "RTN","RCDPESR2",169,0) ...D DISP1^RCDPESR5(RCCT,1) "RTN","RCDPESR2",170,0) ...S Q=0 F S Q=$O(^TMP($J,"RCDP-EOB",RCCT,Q)) Q:'Q S ^TMP($J,"RCDPEOB",RCCT,Q)=$G(^TMP($J,"RCDP-EOB",RCCT,Q,0)) "RTN","RCDPESR2",171,0) ...S ^TMP($J,"RCDPEOB",RCCT)=^TMP($J,"RCDP-EOB",RCCT,0) M ^TMP($J,"RCDPEOB",RCCT,"ERR")=@RCERR1@(RCCT) "RTN","RCDPESR2",172,0) ..;Upd 361.1, needs ^TMP($J,"RCDPEOB","HDR" and $J,"RCDP-EOB" "RTN","RCDPESR2",173,0) ..I RCDUPEOB'<0 S RCNOUPD=0 D UPD3611^IBCEOB(RCEOB,RCCT,1) "RTN","RCDPESR2",174,0) ..;errors in ^TMP("RCDPERR-EOB",$J "RTN","RCDPESR2",175,0) ..I $O(^TMP("RCDPERR-EOB",$J,0)) D ERRUPD^IBCEOB(RCEOB,"RCDPERR-EOB") "RTN","RCDPESR2",176,0) ..S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=$S('$G(RCEOBD):RCEOB,1:RCEOBD) "RTN","RCDPESR2",177,0) .K ^TMP("RCDPERR-EOB",$J) "RTN","RCDPESR2",178,0) ; "RTN","RCDPESR2",179,0) I RCNOUPD D DUPERA^RCDPESR3($G(DUP),RCNOUPD) "RTN","RCDPESR2",180,0) I $O(@RCERR1@("")) D BULLS^RCDPESR3(RCFILE,RCTDA,$S(RCNOUPD:RCNOUPD,1:$G(DUP)),$G(RCXMG)) "RTN","RCDPESR2",181,0) K ^TMP("RCDPERR-EOB",$J),^TMP($J,"RCDP-EOB"),@RCERR1,@RCSD "RTN","RCDPESR2",182,0) D CLEAN^DILF "RTN","RCDPESR2",183,0) Q "RTN","RCDPESR4") 0^6^B77733360 "RTN","RCDPESR4",1,0) RCDPESR4 ;ALB/TMK/PJH - Server interface 835ERA processing ; 06/03/02 "RTN","RCDPESR4",2,0) ;;4.5;Accounts Receivable;**173,216,208,230,269,271**;Mar 20, 1995;Build 29 "RTN","RCDPESR4",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","RCDPESR4",4,0) ; "RTN","RCDPESR4",5,0) ERAEOBIN(RCTXN,RCD,RCGBL,RCEFLG) ; Store/process 835ERA or 835XFR "RTN","RCDPESR4",6,0) ; transaction coming into the site "RTN","RCDPESR4",7,0) ; RCTXN = data on the hdr record of the msg text "RTN","RCDPESR4",8,0) ; RCD = array with formatted hdr data "RTN","RCDPESR4",9,0) ; RCGBL = name of the array or global where the msg is stored "RTN","RCDPESR4",10,0) ; RCEFLG = error flag returned if passed by REF "RTN","RCDPESR4",11,0) ; "RTN","RCDPESR4",12,0) N RCLAST,RCBILL,RCTDA,RCMSG,RCERR "RTN","RCDPESR4",13,0) S (RCTDA,RCEFLG)=0 "RTN","RCDPESR4",14,0) ; "RTN","RCDPESR4",15,0) ; "RTN","RCDPESR4",16,0) F L +^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13)):30 Q:$T "RTN","RCDPESR4",17,0) S RCMSG=$$EXTERA(RCTXN,.RCLAST,.RCBILL) ; Extract from mail msg "RTN","RCDPESR4",18,0) ; "RTN","RCDPESR4",19,0) ; If full msg received (99^$ record exists), file it "RTN","RCDPESR4",20,0) I 'RCLAST,'$G(RCERR) D ;No $ as last character of msg "RTN","RCDPESR4",21,0) . S RCERR=2 "RTN","RCDPESR4",22,0) ; "RTN","RCDPESR4",23,0) I RCLAST S RCTDA=+$$ADD(RCGBL,RCD("MSG#"),RCMSG,.RCBILL,.RCERR,.RCD) "RTN","RCDPESR4",24,0) ; "RTN","RCDPESR4",25,0) I $G(RCERR)>0 D "RTN","RCDPESR4",26,0) . D ERRUPD^RCDPESR1(RCGBL,.RCD,$P(RCTXN,U),.RCERR) "RTN","RCDPESR4",27,0) . I RCTDA D ; Store exception msgs in file 344.5 "RTN","RCDPESR4",28,0) .. N A,C,Z "RTN","RCDPESR4",29,0) .. S C=1,A(1)="Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),2) "RTN","RCDPESR4",30,0) .. I $G(^TMP("RCERR",$J,"TEXT"))'="" S C=C+1,A(C)=^TMP("RCERR",$J,"TEXT"),C=C+1,A(C)=" " "RTN","RCDPESR4",31,0) .. S Z=0 F S Z=$O(^TMP("RCERR",$J,"MSG",Z)) Q:'Z S C=C+1,A(C)=^(Z) "RTN","RCDPESR4",32,0) .. I $O(A(0)) D WP^DIE(344.5,RCTDA_",",5,"A","A") "RTN","RCDPESR4",33,0) . S RCEFLG=1 "RTN","RCDPESR4",34,0) ; "RTN","RCDPESR4",35,0) L -^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13)) "RTN","RCDPESR4",36,0) I $P(RCTXN,U)'["XFR",$P(RCTXN,U,12)'="" D TAXERR^RCDPESR1("ERA",$P(RCTXN,U,6)_" Payer ID: "_$P(RCTXN,U,7),$P(RCTXN,U,11),$P(RCTXN,U,12)) ; Send bad tax id bulletin "RTN","RCDPESR4",37,0) ; "RTN","RCDPESR4",38,0) Q "RTN","RCDPESR4",39,0) ; "RTN","RCDPESR4",40,0) EXTERA(RCTXN,RCLAST,RCBILL) ;Extract 835ERA or 835XFR transaction "RTN","RCDPESR4",41,0) ;INPUT: "RTN","RCDPESR4",42,0) ; RCTXN = data on 835ERA/835XFR hdr record "RTN","RCDPESR4",43,0) ; RCLAST = passed by REF and returned=1 if entire record exists "RTN","RCDPESR4",44,0) ; "RTN","RCDPESR4",45,0) ;OUTPUT: "RTN","RCDPESR4",46,0) ; ^TMP("RCMSG",$J,1,"D",line #)=formatted hdr data "RTN","RCDPESR4",47,0) ; ^TMP("RCMSG",$J,2,"D",line #)=raw msg data "RTN","RCDPESR4",48,0) ; if passed by ref, RCLAST = 1 if '99' record found "RTN","RCDPESR4",49,0) ; if passed by ref, RCBILL(AR bill number) is returned "RTN","RCDPESR4",50,0) ; with a 'list' of bills included in the ERA. If an "RTN","RCDPESR4",51,0) ; entry = 1, 3rd party bill was found in file 430. "RTN","RCDPESR4",52,0) ; If the entry = 2, the 3rd party bill found was not active "RTN","RCDPESR4",53,0) ; Function returns existing ien in file 344.5 for multi part ERAs "RTN","RCDPESR4",54,0) ; "RTN","RCDPESR4",55,0) N CT,CT1,LINE,HCT,RCH,RCMSG,RCREFORM,RCINS,RCSTAT,B,RCSD,C5 "RTN","RCDPESR4",56,0) S (HCT,RCH)=0 "RTN","RCDPESR4",57,0) ; "RTN","RCDPESR4",58,0) ; "RTN","RCDPESR4",59,0) ; Check if sequence control # already exists or if a new record needed "RTN","RCDPESR4",60,0) S RCMSG=+$O(^RCY(344.5,"AMSEQ",+$P(RCTXN,U,13),0)) "RTN","RCDPESR4",61,0) S CT=0 "RTN","RCDPESR4",62,0) I 'RCMSG D ; Build display data for the first sequence only "RTN","RCDPESR4",63,0) . S HCT=HCT+1 S LINE(HCT)="Payer Name: "_$P(RCTXN,U,6) "RTN","RCDPESR4",64,0) . S HCT=HCT+1 S LINE(HCT)="Payer ID: "_$P(RCTXN,U,7) "RTN","RCDPESR4",65,0) . S HCT=HCT+1,LINE(HCT)="Trace #: "_$P(RCTXN,U,8) "RTN","RCDPESR4",66,0) . S HCT=HCT+1,LINE(HCT)="Date Paid: "_$$FDT^RCDPESR9($P(RCTXN,U,9))_" Total Amt Paid: "_$J($P(RCTXN,U,10)/100,0,2) "RTN","RCDPESR4",67,0) . I $P(RCTXN,U)["XFR",$P(RCTXN,U,19)'="" S HCT=HCT+1,LINE(HCT)="Contact Info: "_$P(RCTXN,U,19) "RTN","RCDPESR4",68,0) . M ^TMP("RCMSG",$J,1,"D")=LINE "RTN","RCDPESR4",69,0) . S CT=CT+1,^TMP("RCMSG",$J,2,"D",CT)=RCTXN "RTN","RCDPESR4",70,0) ; "RTN","RCDPESR4",71,0) S CT1=CT "RTN","RCDPESR4",72,0) S ^TMP("RCMSG",$J,0)=RCTXN "RTN","RCDPESR4",73,0) ; "RTN","RCDPESR4",74,0) S RCSD=$NA(^TMP($J,"RCSRVDT")) K @RCSD ;service dates "RTN","RCDPESR4",75,0) S C5=0 "RTN","RCDPESR4",76,0) S RCLAST=0 "RTN","RCDPESR4",77,0) F X XMREC Q:XMER<0 D Q:RCLAST "RTN","RCDPESR4",78,0) . Q:XMRG="" "RTN","RCDPESR4",79,0) . I +XMRG=99,$P(XMRG,U,2)="$" S RCLAST=1 Q "RTN","RCDPESR4",80,0) . S CT=CT+1 "RTN","RCDPESR4",81,0) . I +XMRG=5,$P(XMRG,U,2)'="" S C5=CT "RTN","RCDPESR4",82,0) . I +XMRG=40,$P(XMRG,U,2)?1.12N,C5,$P(XMRG,U,19),'$D(@RCSD@(C5)) S ^(C5)=+$P(XMRG,U,19) ; save the service date for possible ECME# look up "RTN","RCDPESR4",83,0) . S ^TMP("RCMSG",$J,2,"D",CT)=XMRG "RTN","RCDPESR4",84,0) ; "RTN","RCDPESR4",85,0) ; reformat bill# if needed "RTN","RCDPESR4",86,0) S RCREFORM="" "RTN","RCDPESR4",87,0) S CT=CT1 "RTN","RCDPESR4",88,0) F S CT=$O(^TMP("RCMSG",$J,2,"D",CT)) Q:'CT S XMRG=$G(^(CT)) D "RTN","RCDPESR4",89,0) . Q:XMRG="" "RTN","RCDPESR4",90,0) . I +XMRG=5,$P(XMRG,U,2)'="" D "RTN","RCDPESR4",91,0) .. S RCREFORM="",RCSTAT=1 "RTN","RCDPESR4",92,0) .. ; Check if bill is in AR & is a 3rd party bill "RTN","RCDPESR4",93,0) .. S RCBILL=$$BILL^RCDPESR1($P(XMRG,U,2),$G(@RCSD@(CT)),.RCINS) ; look up claim ien by claim# or ECME# "RTN","RCDPESR4",94,0) .. I '$G(RCINS)!(RCBILL<0) S (RCBILL,RCSTAT)=0 "RTN","RCDPESR4",95,0) .. I RCBILL S B=$P($G(^PRCA(430,RCBILL,0)),U) I B'=$P(XMRG,U,2) S $P(XMRG,U,2)=B,RCREFORM=B "RTN","RCDPESR4",96,0) .. I RCBILL,$P(^PRCA(430.3,+$P($G(^PRCA(430,+RCBILL,0)),U,8),0),U,3)'=102 S RCSTAT=2 "RTN","RCDPESR4",97,0) .. S RCBILL($P(XMRG,U,2))=RCSTAT "RTN","RCDPESR4",98,0) . I RCREFORM'="",+XMRG>5 S $P(XMRG,U,2)=RCREFORM,^TMP("RCMSG",$J,2,"D",CT)=XMRG "RTN","RCDPESR4",99,0) ; "RTN","RCDPESR4",100,0) K @RCSD "RTN","RCDPESR4",101,0) Q RCMSG "RTN","RCDPESR4",102,0) ; "RTN","RCDPESR4",103,0) ADD(RCGBL,RCDMSG,RCMSG,RCBILL,RCERR,RCD) ; Add msg(s) in @RCGBL to "RTN","RCDPESR4",104,0) ; file 344.5 "RTN","RCDPESR4",105,0) ; RCGBL = name of the global used to store the msg data "RTN","RCDPESR4",106,0) ; RCDMSG = Mailman msg number the ERA arrived in. "RTN","RCDPESR4",107,0) ; RCMSG = ien of the existing entry in file 344.5 for multipart ERAs "RTN","RCDPESR4",108,0) ; RCBILL(AR bill number) = list of bills included, pass by REF "RTN","RCDPESR4",109,0) ; RCD = array with formatted hdr data "RTN","RCDPESR4",110,0) ; "RTN","RCDPESR4",111,0) ; Errors returned in RCERR and RCERR(n) "RTN","RCDPESR4",112,0) ; Function returns entry # of msg added or "" if none added "RTN","RCDPESR4",113,0) ; "RTN","RCDPESR4",114,0) ; "RTN","RCDPESR4",115,0) N RCHDR,RCTYP,RCIEN "RTN","RCDPESR4",116,0) S RCHDR=$G(^TMP("RCMSGH",$J,0)) "RTN","RCDPESR4",117,0) S RCTYP=$P(RCHDR,U) "RTN","RCDPESR4",118,0) S RCIEN=$S($G(RCMSG):RCMSG,1:$$ADDTXN(RCHDR,RCDMSG)) ;File msg hdr "RTN","RCDPESR4",119,0) I RCIEN'>0 S RCERR=3 ;msg hdr can't be filed "RTN","RCDPESR4",120,0) I '$G(RCERR) D LOADDET(RCIEN,RCGBL,RCHDR,.RCBILL,.RCD,.RCERR) "RTN","RCDPESR4",121,0) I '$G(RCERR),'$O(RCERR(0)),RCTYP["835ERA",'$P($G(^RCY(344.5,RCIEN,0)),U,8) D TASKERA^RCDPESR2(RCIEN) ;Task to upd VistA for complete 835ERA only "RTN","RCDPESR4",122,0) ; "RTN","RCDPESR4",123,0) Q $S($G(RCIEN)>0&'$G(RCERR):RCIEN,1:"") "RTN","RCDPESR4",124,0) ; "RTN","RCDPESR4",125,0) ADDTXN(RCDATA,RCDMSG) ; Add a trxn for msg in RCDATA to file 344.5 "RTN","RCDPESR4",126,0) ; RCDATA = data on the msg hdr record "RTN","RCDPESR4",127,0) ; RCDMSG = Mailman msg number the ERA arrived in "RTN","RCDPESR4",128,0) ;Function returns ien of the new entry in file 344.5 or "" if an error "RTN","RCDPESR4",129,0) ; "RTN","RCDPESR4",130,0) N A,RCY,DLAYGO,DIC,DD,DO,DA,X,Y,Z "RTN","RCDPESR4",131,0) ; "RTN","RCDPESR4",132,0) ; "RTN","RCDPESR4",133,0) S (X,A)=RCDMSG ;Use msg ID as basis for the .01 field "RTN","RCDPESR4",134,0) F Z=1:1 Q:'$D(^RCY(344.5,"B",A)) S A=X_"."_Z "RTN","RCDPESR4",135,0) S X=A "RTN","RCDPESR4",136,0) S DIC(0)="L",DIC="^RCY(344.5,",DLAYGO=344.5 "RTN","RCDPESR4",137,0) S DIC("DR")=".02////"_$E($P(RCDATA,U),1,6)_";.03///^S X=""NOW"";.04////0;.06////"_$S($P(RCDATA,U)'["XFR":1,1:0)_$S($P(RCDATA,U,13)'="":";.09////"_+$P(RCDATA,U,13)_";.08////1",1:"")_";.1////2;.11////"_RCDMSG "RTN","RCDPESR4",138,0) I $P(RCDATA,U,6)'="" S DIC("DR")=DIC("DR")_";3.01////"_$P(RCDATA,U,6) "RTN","RCDPESR4",139,0) D FILE^DICN K DO,DD,DLAYGO,DA,DIC "RTN","RCDPESR4",140,0) S RCY=+Y "RTN","RCDPESR4",141,0) ; "RTN","RCDPESR4",142,0) ; "RTN","RCDPESR4",143,0) Q $S(RCY>0:+RCY,1:"") "RTN","RCDPESR4",144,0) ; "RTN","RCDPESR4",145,0) LOADDET(RCTDA,RCGBL,RCHDR,RCBILL,RCD,RCERR) ; Load the rest of the text "RTN","RCDPESR4",146,0) ; into the msg "RTN","RCDPESR4",147,0) ; RCTDA = ien in file 344.5 "RTN","RCDPESR4",148,0) ; RCGBL = name of the array holding the detail msg text to be loaded "RTN","RCDPESR4",149,0) ; RCHDR = data on ERA hdr record "RTN","RCDPESR4",150,0) ; RCBILL(AR bill number) = list of bills included, pass by REF "RTN","RCDPESR4",151,0) ; RCD = array with formatted hdr data "RTN","RCDPESR4",152,0) ; "RTN","RCDPESR4",153,0) ; OUTPUT: RCERR if any errors found, pass by REF "RTN","RCDPESR4",154,0) ; "RTN","RCDPESR4",155,0) ; "RTN","RCDPESR4",156,0) N RCE,RCDATA,RCMSG,RCFROM,Z,Z0 "RTN","RCDPESR4",157,0) K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J) "RTN","RCDPESR4",158,0) M ^TMP("RCTEXT",$J)=@RCGBL@(1,"D") "RTN","RCDPESR4",159,0) M ^TMP("RCRAW",$J)=@RCGBL@(2,"D") "RTN","RCDPESR4",160,0) ; "RTN","RCDPESR4",161,0) S RCDATA=$G(^RCY(344.5,RCTDA,0)),RCMSG=$G(RCD("MSG#")),RCFROM=$G(RCD("FROM")) "RTN","RCDPESR4",162,0) ; "RTN","RCDPESR4",163,0) ; For multi-part ERA, don't update if sequence already filed "RTN","RCDPESR4",164,0) ; Add seq # if not already there "RTN","RCDPESR4",165,0) I $P(RCHDR,U)'["XFR",$P(RCHDR,U,13) Q:$D(^RCY(344.5,RCTDA,"S","B",+$P(RCHDR,U,14))) "RTN","RCDPESR4",166,0) ; "RTN","RCDPESR4",167,0) D STOREM(+$G(RCTDA),"^TMP(""RCTEXT"",$J)","^TMP(""RCRAW"",$J)",.RCE) "RTN","RCDPESR4",168,0) ; "RTN","RCDPESR4",169,0) I $D(RCE("DIERR")) D ; Extract error "RTN","RCDPESR4",170,0) . N DIE,DA,DR,X,Y "RTN","RCDPESR4",171,0) . D EXTERR^RCDPESR1(.RCERR,.RCE) "RTN","RCDPESR4",172,0) . S:$L($G(RCE)) RCERR(+$O(RCERR(""),-1)+1)=RCE "RTN","RCDPESR4",173,0) . I $D(^RCY(344.5,RCTDA,0)) S DIE="^RCY(344.5,",DR=".1////4",DA=RCTDA D ^DIE "RTN","RCDPESR4",174,0) E D ; No error - store rest of data "RTN","RCDPESR4",175,0) . N Z,RCT,RCCT,RCX,RCB ; Add bills included in ERA "RTN","RCDPESR4",176,0) . S RCT=0,RCCT=0,RCX=$J("",4) "RTN","RCDPESR4",177,0) . S Z="" F S Z=$O(RCBILL(Z)) Q:Z="" D "RTN","RCDPESR4",178,0) .. N DO,DD,DIC,DLAYGO,X,Y "RTN","RCDPESR4",179,0) .. S:RCT=4 RCCT=RCCT+1,RCB(RCCT)=RCX,RCT=0,RCX=$J("",4) S RCX=RCX_$E($S(+RCBILL(Z):"",1:"*")_Z_$J("",15),1,15),RCT=RCT+1 "RTN","RCDPESR4",180,0) .. S DIC(0)="L",DIC("DR")=".02////"_$S($G(RCBILL(Z)):1,1:0),X=Z,DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""B"",",DLAYGO=344.54 D FILE^DICN K DO,DD,DLAYGO,DIC "RTN","RCDPESR4",181,0) .. ; "RTN","RCDPESR4",182,0) . I $L(RCX)>4 S RCCT=RCCT+1,RCB(RCCT)=RCX "RTN","RCDPESR4",183,0) . ; Add list of bills to display data "RTN","RCDPESR4",184,0) . I $O(RCB(0)) D WP^DIE(344.5,RCTDA_",",1,"A","RCB") "RTN","RCDPESR4",185,0) . ; Add seq # "RTN","RCDPESR4",186,0) . S DA(1)=RCTDA,DIC="^RCY(344.5,"_DA(1)_",""S"",",DIC(0)="L",X=$P(RCHDR,U,14),DIC("DR")=".02////"_$S($P(RCHDR,U,15)="Y":1,1:0)_";.03///^S X=""NOW"";.04////"_RCMSG,X=+$P(RCHDR,U,14),DLAYGO=344.53 "RTN","RCDPESR4",187,0) . D FILE^DICN K DO,DD,DLAYGO,DIC "RTN","RCDPESR4",188,0) . ; "RTN","RCDPESR4",189,0) . I $P(RCHDR,U)["835XFR" D XFR^RCDPESR5(RCTDA,RCFROM,RCMSG,.RCD) Q "RTN","RCDPESR4",190,0) . ; "RTN","RCDPESR4",191,0) . ; Proceed only if not a transfer record "RTN","RCDPESR4",192,0) . I $P(RCDATA,U,9)'="" D ; Determine if all sequences received yet "RTN","RCDPESR4",193,0) .. N RCOK,RCLAST "RTN","RCDPESR4",194,0) .. S RCOK=1,RCLAST=0 "RTN","RCDPESR4",195,0) .. F Z=1:1 Q:'RCOK!RCLAST D "RTN","RCDPESR4",196,0) ... I 'RCLAST,'$D(^RCY(344.5,RCTDA,"S","B",Z)) S RCOK=0 Q "RTN","RCDPESR4",197,0) ... S Z0=+$O(^RCY(344.5,RCTDA,"S","B",Z,0)),Z0=$G(^RCY(344.5,RCTDA,"S",Z0,0)) "RTN","RCDPESR4",198,0) ... I Z0="" S RCOK=0 Q "RTN","RCDPESR4",199,0) ... I $P(Z0,U,2) S RCLAST=1 ; Last sequence received and all before it "RTN","RCDPESR4",200,0) .. ; "RTN","RCDPESR4",201,0) .. I RCOK D "RTN","RCDPESR4",202,0) ... N DA,DIE,DR,X,Y "RTN","RCDPESR4",203,0) ... S DA=RCTDA,DR=".08////0;.1///@",DIE="^RCY(344.5," D ^DIE "RTN","RCDPESR4",204,0) ... I '$O(^RCY(344.5,RCTDA,"B","AV",1,0)) D ; No valid bills found "RTN","RCDPESR4",205,0) .... N RCE "RTN","RCDPESR4",206,0) .... S RCE(1)="No valid bills for this site were found in this ERA" "RTN","RCDPESR4",207,0) .... S RCE(2)="Review/correct the bill #'s on this ERA in your transmission exceptions" "RTN","RCDPESR4",208,0) .... S RCE(3)="Please contact the Implementation Manager group to report this situation",RCE(4)=" " "RTN","RCDPESR4",209,0) .... D BULLERA^RCDPESR0("D"_$S($O(^RCY(344.5,RCTDA,2,0)):"F",1:""),RCTDA,$G(RCD("MSG#")),"EDI LBOX - NO VALID BILLS ON ERA "_$E($G(RCD("PAYFROM")),1,20),.RCE,0) "RTN","RCDPESR4",210,0) .... S DA=RCTDA,DR=".08////1;.1////6",DIE="^RCY(344.5," D ^DIE "RTN","RCDPESR4",211,0) ; "RTN","RCDPESR4",212,0) ; "RTN","RCDPESR4",213,0) K ^TMP("RCTEXT",$J),^TMP("RCRAW",$J) "RTN","RCDPESR4",214,0) Q "RTN","RCDPESR4",215,0) ; "RTN","RCDPESR4",216,0) STOREM(RCTDA,RCDISP,RCTEXT,RCE) ;Store msg text in file 344.5 "RTN","RCDPESR4",217,0) ;INPUT: "RTN","RCDPESR4",218,0) ; RCTDA = ien of the entry in file 344.5 "RTN","RCDPESR4",219,0) ; RCDISP = name of the array where display msg text is retrieved from "RTN","RCDPESR4",220,0) ; or "@" to delete the text from the display text field "RTN","RCDPESR4",221,0) ; RCTEXT = name of the array where raw msg text is retrieved from "RTN","RCDPESR4",222,0) ; or "@" to delete the text from the raw msg field "RTN","RCDPESR4",223,0) ;OUTPUT: "RTN","RCDPESR4",224,0) ; RCE = array of errors (RCE("DIERR")) returned, pass by REF "RTN","RCDPESR4",225,0) ; "RTN","RCDPESR4",226,0) N RCZ,X,Y,DIE "RTN","RCDPESR4",227,0) K RCE("DIERR") "RTN","RCDPESR4",228,0) ; "RTN","RCDPESR4",229,0) I $S($G(RCDISP)="@":1,1:$D(@RCDISP)'<10) D "RTN","RCDPESR4",230,0) . F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",1,"AK",""_RCDISP_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1) K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times "RTN","RCDPESR4",231,0) ; "RTN","RCDPESR4",232,0) I '$O(RCE("DIERR",0)),$S($G(RCTEXT)="@":1,1:$D(@RCTEXT)'<10) D "RTN","RCDPESR4",233,0) . F RCZ=1:1:20 D WP^DIE(344.5,RCTDA_",",2,"AK",""_RCTEXT_"","RCE") Q:$S('$D(RCE("DIERR")):1,+RCE("DIERR")=1:$G(RCE("DIERR",1))'=110,1:1) K:RCZ<20 RCE("DIERR") ; On lock error, retry up to 20 times "RTN","RCDPESR4",234,0) Q "RTN","RCDPESR6") 0^2^B43409269 "RTN","RCDPESR6",1,0) RCDPESR6 ;ALB/TMK/DWA - Server auto-update file 344.4 - EDI Lockbox ; 10/29/02 "RTN","RCDPESR6",2,0) ;;4.5;Accounts Receivable;**173,214,208,230,252,269,271**;Mar 20, 1995;Build 29 "RTN","RCDPESR6",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","RCDPESR6",4,0) ; "RTN","RCDPESR6",5,0) UPD3444(RCRTOT) ; Add EOB detail to list in 344.41 for file 344.4 entry RCRTOT "RTN","RCDPESR6",6,0) ; If passed by reference, RCRTOT is returned = "" if errors "RTN","RCDPESR6",7,0) ; "RTN","RCDPESR6",8,0) N RC,RCCOM1,RCCOM2,RCCT,RC1,RC2,RCDPNM,RCEOB,RCNPI1,RCNPI2,DA,DR,DO,DD,DLAYGO,DIC,DIK,X,Y,Z "RTN","RCDPESR6",9,0) S RC=0 F S RC=$O(^TMP($J,"RCDPEOB",RC)) Q:'RC S RC1=$G(^(RC)),RC2=$G(^(RC,"EOB")),RCEOB=+RC2 D Q:'RCRTOT "RTN","RCDPESR6",10,0) . ; Upd 344.41 with reference to this record if it doesn't already exist "RTN","RCDPESR6",11,0) . I RCEOB>0 Q:$D(^RCY(344.4,RCRTOT,1,"AC",RCEOB,RC)) "RTN","RCDPESR6",12,0) . I RCEOB'>0,$S($P(RC1,U,2)'="":$D(^RCY(344.4,RCRTOT,1,"AD",$P(RC1,U,2),RC)),1:0) Q "RTN","RCDPESR6",13,0) . ; Disregard ECME reject related EEOBs "RTN","RCDPESR6",14,0) . I RCEOB'>0,'$P(RC2,U,2),$P(RC1,U,2)?1.12N,$$REJECT^IBNCPDPU($P(RC1,U,2),$P(RC1,U,3)) Q ; esg 9/7/10 ECME# 12 digits "RTN","RCDPESR6",15,0) . S DA(1)=RCRTOT,X=RC,DIC="^RCY(344.4,"_DA(1)_",1,",DIC(0)="L",DLAYGO=344.41 "RTN","RCDPESR6",16,0) . S DIC("DR")=$S($G(RCEOB)>0:".02////"_RCEOB,1:".05////"_$P(RC1,U,2)_";.07////1") "RTN","RCDPESR6",17,0) . I $P(RC2,U,2)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".03///"_$P(RC2,U,2) ; amt "RTN","RCDPESR6",18,0) . I $P(RC2,U,3)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".04////"_$P(RC2,U,3) ; ins co "RTN","RCDPESR6",19,0) . I $P(RC2,U,4) S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".14////1" ; reversal "RTN","RCDPESR6",20,0) . I $P(RC2,U,5)'="" S DIC("DR")=DIC("DR")_$S($L(DIC("DR")):";",1:"")_".15////^S X=$E($P(RC2,U,5),1,30)" ; Patient name "RTN","RCDPESR6",21,0) . ; Process Billing Prov NPI, Rendering/Servicing NPI & name "RTN","RCDPESR6",22,0) . S (RCCOM1,RCCOM2)="" "RTN","RCDPESR6",23,0) . S RCNPI1=$P(RC2,U,10),RCNPI2=$P(RC2,U,11) "RTN","RCDPESR6",24,0) . I RCNPI1'="",'$$CHKDGT^XUSNPI(RCNPI1) S RCCOM1="The Billing Provider NPI received on the 835 ("_$E(RCNPI1,1,10)_") is not a valid format." "RTN","RCDPESR6",25,0) . I RCNPI2'="",'$$CHKDGT^XUSNPI(RCNPI2) S RCCOM2="The "_$S($P(RC2,U,12)=1:"Rendering",1:"Servicing")_" NPI received on the 835 ("_$E(RCNPI2,1,10)_") is not a valid format." "RTN","RCDPESR6",26,0) . I RCCOM1="" S DIC("DR")=DIC("DR")_";.18////^S X=$P(RC2,U,10)" ;Billing Provider NPI "RTN","RCDPESR6",27,0) . I RCCOM2="" S DIC("DR")=DIC("DR")_";.19////^S X=$P(RC2,U,11)" ;Rendering Provider NPI "RTN","RCDPESR6",28,0) . S RCDPNM=$P(RC2,U,13) I $P(RC2,U,14)]"" S RCDPNM=RCDPNM_$S(RCDPNM]"":",",1:"")_$P(RC2,U,14) "RTN","RCDPESR6",29,0) . S DIC("DR")=DIC("DR")_";.2////^S X=$P(RC2,U,12);.21////^S X=RCDPNM" ; Entity Type Qualifier ^ Last name,First Name "RTN","RCDPESR6",30,0) . S DIC("DR")=DIC("DR")_";.22////^S X=RCCOM1;.23////^S X=RCCOM2" ;Comment on Billing provider^comment on rendering/servicing provider NPI "RTN","RCDPESR6",31,0) . D FILE^DICN K DO,DD,DLAYGO,DIC,DIK "RTN","RCDPESR6",32,0) . S RCCT=+Y "RTN","RCDPESR6",33,0) . I RCCT<0 D Q "RTN","RCDPESR6",34,0) .. S DA=RCRTOT,DIK="^RCY(344.4," D ^DIK "RTN","RCDPESR6",35,0) .. S RCRTOT=0 "RTN","RCDPESR6",36,0) . ; If there is no IB EOB record, store the raw data in 344.411 "RTN","RCDPESR6",37,0) . I RC1'>0!(RCEOB'>0) D "RTN","RCDPESR6",38,0) .. N RCDATA,RCC,RCDA "RTN","RCDPESR6",39,0) .. S RCC=2,RCDATA(1)=$G(^TMP($J,"RCDPEOB","HDR")) "RTN","RCDPESR6",40,0) .. S Z=0 F S Z=$O(^TMP($J,"RCDPEOB",RCCT,Z)) Q:'Z S RCC=RCC+1,RCDATA(RCC)=$G(^TMP($J,"RCDPEOB",RCCT,Z)) "RTN","RCDPESR6",41,0) .. S RCDA(1)=RCRTOT,RCDA=RCCT "RTN","RCDPESR6",42,0) .. D WP^DIE(344.41,$$IENS^DILF(.RCDA),1,"A","RCDATA") "RTN","RCDPESR6",43,0) Q "RTN","RCDPESR6",44,0) ; "RTN","RCDPESR6",45,0) ; "RTN","RCDPESR6",46,0) ERATOT(RCTDA,RCERR) ; File ERA TOTAL rec in 344.4 from entry RCTDA in 344.5 "RTN","RCDPESR6",47,0) ; RCTDA = ien file 344.5 "RTN","RCDPESR6",48,0) ; Returns: the ien file 344.4 "RTN","RCDPESR6",49,0) ; RCERR if passed by reference, with error text "RTN","RCDPESR6",50,0) ; RCERR(1)=duplicated message "RTN","RCDPESR6",51,0) N RCTYPE,RCDA,RCMETH,RCTRACE,RCID,RCDT,RCAMT,RCDUP,RCZ,RCX,RCPAYER,DIE,DIK,DIC,DLAYGO,DD,DO,DR,DA,X,Y,Z0,Z1 "RTN","RCDPESR6",52,0) S (RCERR,RCDA)="" "RTN","RCDPESR6",53,0) S RCZ=$G(^RCY(344.5,RCTDA,2,1,0)) "RTN","RCDPESR6",54,0) S RCTYPE=$P(RCZ,U),RCTRACE=$P(RCZ,U,8),RCID=$P(RCZ,U,7),RCPAYER=$P(RCZ,U,6),RCMETH=$P(RCZ,U,17) "RTN","RCDPESR6",55,0) ; Need header record as first entry in field "RTN","RCDPESR6",56,0) I RCTYPE'["835ERA" S RCERR="No header record found in message. An EEOB exception record was created" G ERATOTQ "RTN","RCDPESR6",57,0) ; "RTN","RCDPESR6",58,0) S RCDT=$$FMDT^RCDPESR1($P(RCZ,U,9)),RCAMT=$J(($P(RCZ,U,10)/100),0,2) "RTN","RCDPESR6",59,0) ;Elec ERA's must have a trace # and an ins co id "RTN","RCDPESR6",60,0) I RCTRACE=""!(RCID="") S RCERR="Trace # or ins ID missing on ERA transaction. An EEOB exception record was created." G ERATOTQ "RTN","RCDPESR6",61,0) ; Make sure it's not already there "RTN","RCDPESR6",62,0) S (RCDUP,Z1)=0 "RTN","RCDPESR6",63,0) F S Z1=$O(^RCY(344.4,"ATRID",RCTRACE,RCID,Z1)) Q:'Z1 S Z0=$G(^RCY(344.4,Z1,0)) I $P(Z0,U,4)=RCDT,+$P(Z0,U,5)=+RCAMT S RCDUP=1 Q "RTN","RCDPESR6",64,0) ; "RTN","RCDPESR6",65,0) I RCDUP,$P(Z0,U,8) D G ERATOTQ ; Receipt already exists - no update "RTN","RCDPESR6",66,0) . S RCERR="This is a duplicate ERA and has already been posted",RCERR(1)=-2 "RTN","RCDPESR6",67,0) I RCDUP S RCERR="DUP",RCERR(1)=$S($P(Z0,U,12)'=$P($G(^RCY(344.5,RCTDA,0)),U,11):$P(Z0,U,12),1:-1) G ERATOTQ "RTN","RCDPESR6",68,0) ; "RTN","RCDPESR6",69,0) S RCX=+$O(^RCY(344.4," "),-1) "RTN","RCDPESR6",70,0) S DIC(0)="L",DIC="^RCY(344.4,",DLAYGO=344.4 "RTN","RCDPESR6",71,0) S DIC("DR")=".02////"_RCTRACE_";.03////"_RCID_";.04////"_RCDT_";.05////"_RCAMT_";.06////"_$P(RCZ,U,6)_";.09////0;.12////"_$P($G(^RCY(344.5,RCTDA,0)),U,11)_";.07////"_$$NOW^XLFDT()_";.1////1" "RTN","RCDPESR6",72,0) I RCMETH'="" S DIC("DR")=DIC("DR")_";.15////"_RCMETH "RTN","RCDPESR6",73,0) F RCX=RCX+1:1 L +^RCY(344.4,RCX,0):1 I $T,'$D(^RCY(344.4,RCX,0)) S X=RCX Q "RTN","RCDPESR6",74,0) D FILE^DICN K DO,DLAYGO,DD,DIC "RTN","RCDPESR6",75,0) L -^RCY(344.4,RCX,0) "RTN","RCDPESR6",76,0) S RCDA=$S(Y<0:"",1:+Y) "RTN","RCDPESR6",77,0) I 'RCDA D "RTN","RCDPESR6",78,0) . S RCERR="An error was encountered that prevented the adding of an ERA totals record. An EEOB exception record was created." "RTN","RCDPESR6",79,0) ; "RTN","RCDPESR6",80,0) ERATOTQ Q RCDA "RTN","RCDPESR6",81,0) ; "RTN","RCDPESR6",82,0) UPDCON(RCRTOT) ; Add contact information to file 344.4 for an ERA "RTN","RCDPESR6",83,0) N DIE,DA,DR,Z,Q,X,Y,A,TYPE "RTN","RCDPESR6",84,0) S Z=$G(^TMP($J,"RCDPEOB","CONTACT")) "RTN","RCDPESR6",85,0) Q:$TR($P(Z,U,3,9),U)="" "RTN","RCDPESR6",86,0) S DA=RCRTOT,DIE="^RCY(344.4,",DR="" "RTN","RCDPESR6",87,0) ; "RTN","RCDPESR6",88,0) ; If old format do "RTN","RCDPESR6",89,0) I +$P($G(^TMP($J,"RCDPEOB","HDR")),U,16)'>0 D "RTN","RCDPESR6",90,0) . F Q=2:1:8 S DR=DR_$S(DR'="":";3.0",1:"3.0")_(Q-1)_"///"_$S($P(Z,U,Q)="":"@",1:"/"_$P(Z,U,Q)) "RTN","RCDPESR6",91,0) ; "RTN","RCDPESR6",92,0) ; If new format (5010) do "RTN","RCDPESR6",93,0) I +$P($G(^TMP($J,"RCDPEOB","HDR")),U,16)>0 D "RTN","RCDPESR6",94,0) . N CNT S CNT=0 "RTN","RCDPESR6",95,0) . I $P(Z,U,2)'="" S DR="3.01////"_$P(Z,U,2) "RTN","RCDPESR6",96,0) .I $P(Z,U,3)'="" S DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,3)_";3.03////TE",CNT=CNT+1 "RTN","RCDPESR6",97,0) .I $P(Z,U,4)'="" D "RTN","RCDPESR6",98,0) ..S:CNT=1 DR=DR_$S(DR'="":";3.04",1:"3.04")_"////"_$P(Z,U,4)_";3.05////FX" "RTN","RCDPESR6",99,0) ..S:CNT=0 DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,4)_";3.03////FX" "RTN","RCDPESR6",100,0) ..S CNT=CNT+1 "RTN","RCDPESR6",101,0) .I $P(Z,U,5)'="" D "RTN","RCDPESR6",102,0) ..S:CNT=2 DR=DR_$S(DR'="":";3.06",1:"3.06")_"////"_$P(Z,U,5)_";3.07////EM" "RTN","RCDPESR6",103,0) ..S:CNT=1 DR=DR_$S(DR'="":";3.04",1:"3.04")_"////"_$P(Z,U,5)_";3.05////EM" "RTN","RCDPESR6",104,0) ..S:CNT=0 DR=DR_$S(DR'="":";3.02",1:"3.02")_"////"_$P(Z,U,5)_";3.03////EM" "RTN","RCDPESR6",105,0) . I $P(Z,U,6)'="" S DR=DR_$S(DR'="":";5.01",1:"5.01")_"////"_$P(Z,U,6) "RTN","RCDPESR6",106,0) D ^DIE "RTN","RCDPESR6",107,0) Q "RTN","RCDPESR6",108,0) ; "RTN","RCDPESR6",109,0) UPDADJ(RCRTOT) ; Add ERA level adj data to file 344.4 "RTN","RCDPESR6",110,0) N Z,Z0,DA,DIC,DLAYGO,DR,X,Y,DO,DD "RTN","RCDPESR6",111,0) ; Remove any already there "RTN","RCDPESR6",112,0) S Z=0 F S Z=$O(^RCY(344.4,RCRTOT,2,Z)) Q:'Z S DA(1)=RCRTOT,DA=Z D ^DIK "RTN","RCDPESR6",113,0) ; "RTN","RCDPESR6",114,0) S Z=0 F S Z=$O(^TMP($J,"RCDPEOB","ADJ",Z)) Q:'Z S Z0=$G(^(Z)) D "RTN","RCDPESR6",115,0) . S DIC(0)="L",X=$P(Z0,U,3)_" ",DA(1)=RCRTOT,DIC="^RCY(344.4,"_DA(1)_",2,",DIC("DR")=$S($P(Z0,U,2)'="":".02////"_$P(Z0,U,2),1:"") "RTN","RCDPESR6",116,0) . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_$S($P(Z0,U,4)'="":".03////"_$J(-$P(Z0,U,4)/100,"",2),1:"") "RTN","RCDPESR6",117,0) . S DIC("DR")=DIC("DR")_$S(DIC("DR")'="":";",1:"")_$S($P(Z0,U,5)'="":".04////"_$P(Z0,U,5),1:""),DLAYGO=344.42 "RTN","RCDPESR6",118,0) . S:$O(^RCY(344.4,RCRTOT,2,"B",X,0)) X=""""_X_"""" "RTN","RCDPESR6",119,0) . D FILE^DICN K DIC,DO,DD "RTN","RCDPESR6",120,0) Q "RTN","RCDPESR6",121,0) ; "RTN","RCDPESR6",122,0) DUPREC(RCET,RCCT,RCSTAR,RCFILE,RCALLDUP,RCEOB,RCBILL,RCDUPEOB) ; Overflow from RCDPESR2 "RTN","RCDPESR6",123,0) S ^TMP("RCERR1",$J,RCCT)=" ",^TMP("RCERR1",$J,RCCT,1)=RCET_RCCT_RCSTAR "RTN","RCDPESR6",124,0) S ^TMP("RCERR1",$J,RCCT,2)="(Warning): EEOB detail already filed for "_RCBILL_" - "_$S(RCALLDUP:"Duplicate not stored",1:"EEOB updated"),^TMP("RCERR1",$J,RCCT,3)=" " S:RCFILE=5 ^TMP("RCERR1",$J,RCCT,"*")=^TMP("RCERR1",$J,RCCT,2) "RTN","RCDPESR6",125,0) I RCALLDUP S RCEOB="",RCDUPEOB=-1 Q "RTN","RCDPESR6",126,0) S $P(^TMP($J,"RCDPEOB",RCCT,"EOB"),U)=RCEOB "RTN","RCDPESR6",127,0) Q "RTN","RCDPESR6",128,0) ; "RTN","RCDPURED") 0^4^B37216500 "RTN","RCDPURED",1,0) RCDPURED ;WISC/RFJ - file 344 receipt/payment dd calls ;1 Jun 99 "RTN","RCDPURED",2,0) ;;4.5;Accounts Receivable;**114,169,174,196,202,244,268,271**;Mar 20, 1995;Build 29 "RTN","RCDPURED",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified. "RTN","RCDPURED",4,0) ; "RTN","RCDPURED",5,0) ; Reference to $$REC^IBRFN supported by DBIA 2031 "RTN","RCDPURED",6,0) ; "RTN","RCDPURED",7,0) Q "RTN","RCDPURED",8,0) ; "RTN","RCDPURED",9,0) ; "RTN","RCDPURED",10,0) ; ***** dd references from file 344 (receipts) ***** "RTN","RCDPURED",11,0) ; "RTN","RCDPURED",12,0) ; "RTN","RCDPURED",13,0) DUPLCATE ; called by input transform receipt number (.01) "RTN","RCDPURED",14,0) ; make sure no duplicate receipt numbers "RTN","RCDPURED",15,0) I $O(^RCY(344,"B",X,"")) K X W !,"This is a duplicate receipt number." Q "RTN","RCDPURED",16,0) I $O(^PRCA(433,"AF",X,"")) K X W !,"This receipt number has already been used and has been purged from the system. " K X "RTN","RCDPURED",17,0) Q "RTN","RCDPURED",18,0) ; "RTN","RCDPURED",19,0) ; "RTN","RCDPURED",20,0) PAYCOUNT(RCRECTDA) ; called by computed field number of transactions (101) "RTN","RCDPURED",21,0) ; return the count of payments for the receipt "RTN","RCDPURED",22,0) N COUNT,X "RTN","RCDPURED",23,0) S COUNT=0 "RTN","RCDPURED",24,0) S X=0 F S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X S COUNT=COUNT+1 "RTN","RCDPURED",25,0) Q COUNT "RTN","RCDPURED",26,0) ; "RTN","RCDPURED",27,0) ; "RTN","RCDPURED",28,0) PAYTOTAL(RCRECTDA) ; called by computed field total amount of receipts (.15) "RTN","RCDPURED",29,0) ; return the total dollars for payments entered for the receipt "RTN","RCDPURED",30,0) N TOTAL,X "RTN","RCDPURED",31,0) S TOTAL=0 "RTN","RCDPURED",32,0) S X=0 F S X=$O(^RCY(344,+$G(RCRECTDA),1,X)) Q:'X S TOTAL=TOTAL+$P($G(^(X,0)),"^",4) "RTN","RCDPURED",33,0) Q TOTAL "RTN","RCDPURED",34,0) ; "RTN","RCDPURED",35,0) ; "RTN","RCDPURED",36,0) ; ***** dd references from sub-file 344.01 (transactions) ***** "RTN","RCDPURED",37,0) ; "RTN","RCDPURED",38,0) ; "RTN","RCDPURED",39,0) CHGAMT ; called from the input transform on the transaction amount (.04) "RTN","RCDPURED",40,0) ; field. if the amount is changed, this will create a new cancelled "RTN","RCDPURED",41,0) ; transaction showing the original amount before the change. "RTN","RCDPURED",42,0) N ORIGDATA,TRANDA "RTN","RCDPURED",43,0) S ORIGDATA=^RCY(344,DA(1),1,DA,0) "RTN","RCDPURED",44,0) ; no original payment amount "RTN","RCDPURED",45,0) I '$P(ORIGDATA,"^",4) Q "RTN","RCDPURED",46,0) ; payment amount did not change "RTN","RCDPURED",47,0) I +$P(ORIGDATA,"^",4)=+X Q "RTN","RCDPURED",48,0) ; payment amount increased "RTN","RCDPURED",49,0) I $P(ORIGDATA,"^",4)OWED,'$P($G(^RCY(344,DA(1),0)),"^",7) W " WARNING: Payment amount greater than amount of bill!" "RTN","RCDPURED",79,0) ; check for other bills "RTN","RCDPURED",80,0) S AMOUNT=$$EOB^IBCNSBL2(+ACCOUNT,+$P($G(^PRCA(430,+ACCOUNT,0)),"^",3),$$PAID^PRCAFN1(+ACCOUNT)) "RTN","RCDPURED",81,0) I AMOUNT W !!,$P(AMOUNT,"^",2)," may also be billable.",! "RTN","RCDPURED",82,0) Q "RTN","RCDPURED",83,0) ; "RTN","RCDPURED",84,0) ; "RTN","RCDPURED",85,0) PNORBILL ; called by the input transform in receipt file 344, transaction "RTN","RCDPURED",86,0) ; multiple (field 1), patient name or bill number (sub field .09) "RTN","RCDPURED",87,0) I $L(X)>20!($L(X)<1) K X Q "RTN","RCDPURED",88,0) ; "RTN","RCDPURED",89,0) N DFN,RCBILL,RCINPUT,RCOUTPUT,Y,RCTYP,DIC,RCDISP "RTN","RCDPURED",90,0) ; "RTN","RCDPURED",91,0) S RCINPUT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","RCDPURED",92,0) ; try and lookup on bill number "RTN","RCDPURED",93,0) S X=$S($O(^PRCA(430,"B",RCINPUT,0)):$O(^(0))_";PRCA(430,",$O(^PRCA(430,"D",RCINPUT,0)):$O(^(0))_";PRCA(430,",1:RCINPUT) "RTN","RCDPURED",94,0) I X[";PRCA(430," D DISPLAY(X) "RTN","RCDPURED",95,0) ; bill not found, try and lookup on patient "RTN","RCDPURED",96,0) I X=RCINPUT S DIC="^DPT(",DIC(0)="EM" D ^DIC S X=+Y_";DPT(" "RTN","RCDPURED",97,0) ; new value in variable X (output in X) "RTN","RCDPURED",98,0) ; "RTN","RCDPURED",99,0) ; patient not found, type of payment = check/mo "RTN","RCDPURED",100,0) I +$G(Y)<0,($P($G(^RCY(344,DA(1),0)),"^",4)=4) D "RTN","RCDPURED",101,0) . S (X,Y)=$$REC^IBRFN(RCINPUT,.RCTYP,.RCDISP),(RCBILL,X)=X_";PRCA(430," ; DBIA 2031 "RTN","RCDPURED",102,0) . I Y>0 D "RTN","RCDPURED",103,0) . . N DIR,DIQ2,DIRUT,DTOUT,DUOUT,RCPRM "RTN","RCDPURED",104,0) . . S RCTYP=$G(RCTYP,1) "RTN","RCDPURED",105,0) . . S RCPRM=$S(RCTYP=1:"TRICARE reference number",RCTYP=2:"ECME Rx reference number",RCTYP=3:"prescription number",1:"reference number") "RTN","RCDPURED",106,0) . . S DIR("A")="Is this "_RCPRM_" - "_$S($G(RCDISP)'="":RCDISP,1:RCINPUT) "RTN","RCDPURED",107,0) . . S DIR("B")="No",DIR("A",1)=" " "RTN","RCDPURED",108,0) . . S DIR(0)="Y^O" D ^DIR S:'Y Y=-1 "RTN","RCDPURED",109,0) . . I Y'>0 Q "RTN","RCDPURED",110,0) . . W !!,$P($G(^PRCA(430,+RCBILL,0)),"^")," " "RTN","RCDPURED",111,0) . . D DISPLAY(RCBILL) "RTN","RCDPURED",112,0) . . S X=RCBILL "RTN","RCDPURED",113,0) ; output in variable X "RTN","RCDPURED",114,0) ; "RTN","RCDPURED",115,0) I +$G(Y)<0 K X Q "RTN","RCDPURED",116,0) ; "RTN","RCDPURED",117,0) S RCOUTPUT=X "RTN","RCDPURED",118,0) ; "RTN","RCDPURED",119,0) ; patient account, show messages and quit (output still in variable X) "RTN","RCDPURED",120,0) I RCOUTPUT[";DPT(" D CHECKPAT(+RCOUTPUT) Q "RTN","RCDPURED",121,0) ; "RTN","RCDPURED",122,0) ; bill account "RTN","RCDPURED",123,0) I $$IB^IBRUTL(+RCOUTPUT) W " ... This bill appears to have other patient bills on 'hold'." "RTN","RCDPURED",124,0) S X=$P($G(^RCD(340,+$P(^PRCA(430,+RCOUTPUT,0),"^",9),0)),"^") "RTN","RCDPURED",125,0) I X[";DPT(" D CHECKPAT(+X) "RTN","RCDPURED",126,0) S X=RCOUTPUT "RTN","RCDPURED",127,0) Q "RTN","RCDPURED",128,0) ; "RTN","RCDPURED",129,0) ; "RTN","RCDPURED",130,0) CHECKPAT(DFN) ; check patient for other charges, etc., show message "RTN","RCDPURED",131,0) N X "RTN","RCDPURED",132,0) S X="IBARXEU" X ^%ZOSF("TEST") "RTN","RCDPURED",133,0) I $T S X=$$RXST^IBARXEU(DFN,DT) I X D "RTN","RCDPURED",134,0) . W !?2,"* Patient is exempt from RX Copay: ",$P(X,"^",4)," *" "RTN","RCDPURED",135,0) S X="PSOCOPAY" X ^%ZOSF("TEST") "RTN","RCDPURED",136,0) I $T S X=$$POT^PSOCOPAY(DFN) I X D "RTN","RCDPURED",137,0) . N DA,VAEL,VAERR,X1,RCX "RTN","RCDPURED",138,0) . S RCX=X "RTN","RCDPURED",139,0) . D ELIG^VADPT S DA=$O(^IBE(350.1,"B","PSO "_$S(VAEL(3):"",1:"N")_"SC RX COPAY NEW",0)) I DA D COST^IBAUTL "RTN","RCDPURED",140,0) . S X1=+$G(X1) "RTN","RCDPURED",141,0) . W !?2,"* This patient has ",RCX,"-30 day RX's totaling $",$FN(RCX*X1,",",2)," that are potentially *" "RTN","RCDPURED",142,0) . W !?2,"* billable. This represents any Window Rx's issued today. *" "RTN","RCDPURED",143,0) Q "RTN","RCDPURED",144,0) ; "RTN","RCDPURED",145,0) ; "RTN","RCDPURED",146,0) DISPLAY(RCBILLDA) ; display bill "RTN","RCDPURED",147,0) N DATA "RTN","RCDPURED",148,0) S DATA=$P(^PRCA(430,+RCBILLDA,0),"^",9) W:DATA " ",$$NAM^RCFN01(DATA) "RTN","RCDPURED",149,0) S DATA=$P(^PRCA(430,+RCBILLDA,0),"^",8) I DATA D "RTN","RCDPURED",150,0) . W " ",$P(^PRCA(430.3,DATA,0),"^") "RTN","RCDPURED",151,0) . I $P(^PRCA(430.3,DATA,0),"^",3)'=102,$P($G(^RCD(340,+$P(^PRCA(430,+RCBILLDA,0),"^",9),0)),"^")'[";DPT(" W !,"This bill is not in 'active' status." "RTN","RCDPURED",152,0) S DATA=$G(^PRCA(430,+RCBILLDA,7)) W " $",$J($P(DATA,"^")+$P(DATA,"^",2)+$P(DATA,"^",3)+$P(DATA,"^",4)+$P(DATA,"^",5),1,2) "RTN","RCDPURED",153,0) Q "RTN","RCDPURED",154,0) ; "RTN","RCDPURED",155,0) ; "RTN","RCDPURED",156,0) PAYDATE ; called by the input transform in receipt file 344, transaction "RTN","RCDPURED",157,0) ; multiple (field 1), date of payment (sub field .06) "RTN","RCDPURED",158,0) ; date of payment not in future or more than one month ago "RTN","RCDPURED",159,0) N DAYSDIFF "RTN","RCDPURED",160,0) S DAYSDIFF=$$FMDIFF^XLFDT(X,DT) "RTN","RCDPURED",161,0) I DAYSDIFF<-31!(DAYSDIFF>0) K X "RTN","RCDPURED",162,0) Q "RTN","RCDPURED",163,0) ; "RTN","RCDPURED",164,0) ; "RTN","RCDPURED",165,0) ; ***** dd references from file 344.1 (deposits) ***** "RTN","RCDPURED",166,0) ; "RTN","RCDPURED",167,0) ; "RTN","RCDPURED",168,0) RECTOTAL(RCDEPTDA) ; called from computed field TOTAL AMT OF RECEIPTS (.18) in "RTN","RCDPURED",169,0) ; deposit file (344.1) "RTN","RCDPURED",170,0) ; this returns the total dollars paid for all receipts on deposit ticket "RTN","RCDPURED",171,0) N RCRECTDA,TOTAL "RTN","RCDPURED",172,0) S TOTAL=0 "RTN","RCDPURED",173,0) S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",+RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D "RTN","RCDPURED",174,0) . S TOTAL=TOTAL+$$PAYTOTAL(RCRECTDA) "RTN","RCDPURED",175,0) Q TOTAL "RTN","RCDPURED",176,0) ; "RTN","RCDPURED",177,0) ; "RTN","RCDPURED",178,0) RECCOUNT(RCDEPTDA) ; called from computed field TOTAL RECEIPTS (100) in deposit file (344.1) "RTN","RCDPURED",179,0) ; this returns a count of the number of receipts on a deposit ticket "RTN","RCDPURED",180,0) N RCRECTDA,COUNT "RTN","RCDPURED",181,0) S COUNT=0 "RTN","RCDPURED",182,0) S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AD",+RCDEPTDA,RCRECTDA)) Q:'RCRECTDA D "RTN","RCDPURED",183,0) . S COUNT=COUNT+1 "RTN","RCDPURED",184,0) Q COUNT "UP",344,344.01,-1) 344^1 "UP",344,344.01,0) 344.01 "VER") 8.0^22.0 "^DD",344,344.01,.09,0) PATIENT NAME OR BILL NUMBER^FXO^^0;9^D PNORBILL^RCDPURED "^DD",344,344.01,.09,.1) "^DD",344,344.01,.09,1,0) ^.1 "^DD",344,344.01,.09,1,1,0) ^^TRIGGER^344.01^.03 "^DD",344,344.01,.09,1,1,1) K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^RCY(344,D0,1,D1,0)):^(0),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X=DIV S X=DIV,X=X X ^DD(344.01,.09,1,1,1.4) "^DD",344,344.01,.09,1,1,1.4) S DIH=$S($D(^RCY(344,DIV(0),1,DIV(1),0)):^(0),1:""),DIV=X S $P(^(0),U,3)=DIV,DIH=344.01,DIG=.03 D ^DICR:$O(^DD(DIH,DIG,1,0)) "^DD",344,344.01,.09,1,1,2) K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^RCY(344,D0,1,D1,0)):^(0),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(344.01,.09,1,1,2.4) "^DD",344,344.01,.09,1,1,2.4) S DIH=$S($D(^RCY(344,DIV(0),1,DIV(1),0)):^(0),1:""),DIV=X S $P(^(0),U,3)=DIV,DIH=344.01,DIG=.03 D ^DICR:$O(^DD(DIH,DIG,1,0)) "^DD",344,344.01,.09,1,1,3) Needed to set Account field "^DD",344,344.01,.09,1,1,"%D",0) ^^5^5^2930923^ "^DD",344,344.01,.09,1,1,"%D",1,0) This field allows a customized look-up to the Patient file "^DD",344,344.01,.09,1,1,"%D",2,0) and Bill number file when prompting the user for "PATIENT NAME "^DD",344,344.01,.09,1,1,"%D",3,0) OR BILL NUMBER" during payment entry. Once the user selects "^DD",344,344.01,.09,1,1,"%D",4,0) the Patient or Bill Number, this data is then moved to the "^DD",344,344.01,.09,1,1,"%D",5,0) "Account" field for VA FileMan Compatiblity for printing. "^DD",344,344.01,.09,1,1,"CREATE VALUE") INTERNAL(#.09) "^DD",344,344.01,.09,1,1,"DELETE VALUE") @ "^DD",344,344.01,.09,1,1,"DT") 2920619 "^DD",344,344.01,.09,1,1,"FIELD") ACCOUNT "^DD",344,344.01,.09,2) S Y(0)=Y S Y=$P(@("^"_$P(Y,";",2)_+Y_",0)"),"^") "^DD",344,344.01,.09,2.1) S Y=$P(@("^"_$P(Y,";",2)_+Y_",0)"),"^") "^DD",344,344.01,.09,3) Enter one of following: Patient Name, Bill No, TRICARE Authorization No, ECME Rx Reference Number or Prescription Number. "^DD",344,344.01,.09,22) "^DD",344,344.01,.09,"DT") 3030926 **END** **END**