KIDS Distribution saved on Dec 16, 2014@14:32:30 BPS IB PRCA HPID BUNDLE 2.0 **KIDS**:BPS IB PRCA HPID BUNDLE 2.0^BPS*1.0*18^IB*2.0*521^PRCA*4.5*302^ **INSTALL NAME** BPS IB PRCA HPID BUNDLE 2.0 "BLD",9350,0) BPS IB PRCA HPID BUNDLE 2.0^^1^3141216^y "BLD",9350,6.3) 10 "BLD",9350,10,0) ^9.63^3^3 "BLD",9350,10,1,0) BPS*1.0*18^1 "BLD",9350,10,2,0) IB*2.0*521^1 "BLD",9350,10,3,0) PRCA*4.5*302^1 "BLD",9350,10,"B","BPS*1.0*18",1) "BLD",9350,10,"B","IB*2.0*521",2) "BLD",9350,10,"B","PRCA*4.5*302",3) "BLD",9350,"KRN",0) ^9.67PA^779.2^20 "BLD",9350,"KRN",.4,0) .4 "BLD",9350,"KRN",.401,0) .401 "BLD",9350,"KRN",.402,0) .402 "BLD",9350,"KRN",.403,0) .403 "BLD",9350,"KRN",.5,0) .5 "BLD",9350,"KRN",.84,0) .84 "BLD",9350,"KRN",3.6,0) 3.6 "BLD",9350,"KRN",3.8,0) 3.8 "BLD",9350,"KRN",9.2,0) 9.2 "BLD",9350,"KRN",9.8,0) 9.8 "BLD",9350,"KRN",19,0) 19 "BLD",9350,"KRN",19.1,0) 19.1 "BLD",9350,"KRN",101,0) 101 "BLD",9350,"KRN",409.61,0) 409.61 "BLD",9350,"KRN",771,0) 771 "BLD",9350,"KRN",779.2,0) 779.2 "BLD",9350,"KRN",870,0) 870 "BLD",9350,"KRN",8989.51,0) 8989.51 "BLD",9350,"KRN",8989.52,0) 8989.52 "BLD",9350,"KRN",8994,0) 8994 "BLD",9350,"KRN","B",.4,.4) "BLD",9350,"KRN","B",.401,.401) "BLD",9350,"KRN","B",.402,.402) "BLD",9350,"KRN","B",.403,.403) "BLD",9350,"KRN","B",.5,.5) "BLD",9350,"KRN","B",.84,.84) "BLD",9350,"KRN","B",3.6,3.6) "BLD",9350,"KRN","B",3.8,3.8) "BLD",9350,"KRN","B",9.2,9.2) "BLD",9350,"KRN","B",9.8,9.8) "BLD",9350,"KRN","B",19,19) "BLD",9350,"KRN","B",19.1,19.1) "BLD",9350,"KRN","B",101,101) "BLD",9350,"KRN","B",409.61,409.61) "BLD",9350,"KRN","B",771,771) "BLD",9350,"KRN","B",779.2,779.2) "BLD",9350,"KRN","B",870,870) "BLD",9350,"KRN","B",8989.51,8989.51) "BLD",9350,"KRN","B",8989.52,8989.52) "BLD",9350,"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*18 "BLD",9344,0) BPS*1.0*18^E CLAIMS MGMT ENGINE^0^3141216^y "BLD",9344,4,0) ^9.64PA^9002313.03^1 "BLD",9344,4,9002313.03,0) 9002313.03 "BLD",9344,4,9002313.03,2,0) ^9.641^9002313.03^1 "BLD",9344,4,9002313.03,2,9002313.03,0) BPS RESPONSES (File-top level) "BLD",9344,4,9002313.03,2,9002313.03,1,0) ^9.6411^568^1 "BLD",9344,4,9002313.03,2,9002313.03,1,568,0) PAYER ID QUALIFIER "BLD",9344,4,9002313.03,222) y^y^p^^^^n^^n "BLD",9344,4,9002313.03,224) "BLD",9344,4,"APDD",9002313.03,9002313.03) "BLD",9344,4,"APDD",9002313.03,9002313.03,568) "BLD",9344,4,"B",9002313.03,9002313.03) "BLD",9344,6.3) 31 "BLD",9344,"ABPKG") n "BLD",9344,"KRN",0) ^9.67PA^779.2^20 "BLD",9344,"KRN",.4,0) .4 "BLD",9344,"KRN",.401,0) .401 "BLD",9344,"KRN",.402,0) .402 "BLD",9344,"KRN",.403,0) .403 "BLD",9344,"KRN",.5,0) .5 "BLD",9344,"KRN",.84,0) .84 "BLD",9344,"KRN",3.6,0) 3.6 "BLD",9344,"KRN",3.8,0) 3.8 "BLD",9344,"KRN",9.2,0) 9.2 "BLD",9344,"KRN",9.8,0) 9.8 "BLD",9344,"KRN",9.8,"NM",0) ^9.68A^5^3 "BLD",9344,"KRN",9.8,"NM",3,0) BPSSCRLG^^0^B241284581 "BLD",9344,"KRN",9.8,"NM",4,0) BPSRPT9^^0^B106079505 "BLD",9344,"KRN",9.8,"NM",5,0) BPSRPT9A^^0^B95077796 "BLD",9344,"KRN",9.8,"NM","B","BPSRPT9",4) "BLD",9344,"KRN",9.8,"NM","B","BPSRPT9A",5) "BLD",9344,"KRN",9.8,"NM","B","BPSSCRLG",3) "BLD",9344,"KRN",19,0) 19 "BLD",9344,"KRN",19.1,0) 19.1 "BLD",9344,"KRN",101,0) 101 "BLD",9344,"KRN",409.61,0) 409.61 "BLD",9344,"KRN",771,0) 771 "BLD",9344,"KRN",779.2,0) 779.2 "BLD",9344,"KRN",870,0) 870 "BLD",9344,"KRN",8989.51,0) 8989.51 "BLD",9344,"KRN",8989.52,0) 8989.52 "BLD",9344,"KRN",8994,0) 8994 "BLD",9344,"KRN","B",.4,.4) "BLD",9344,"KRN","B",.401,.401) "BLD",9344,"KRN","B",.402,.402) "BLD",9344,"KRN","B",.403,.403) "BLD",9344,"KRN","B",.5,.5) "BLD",9344,"KRN","B",.84,.84) "BLD",9344,"KRN","B",3.6,3.6) "BLD",9344,"KRN","B",3.8,3.8) "BLD",9344,"KRN","B",9.2,9.2) "BLD",9344,"KRN","B",9.8,9.8) "BLD",9344,"KRN","B",19,19) "BLD",9344,"KRN","B",19.1,19.1) "BLD",9344,"KRN","B",101,101) "BLD",9344,"KRN","B",409.61,409.61) "BLD",9344,"KRN","B",771,771) "BLD",9344,"KRN","B",779.2,779.2) "BLD",9344,"KRN","B",870,870) "BLD",9344,"KRN","B",8989.51,8989.51) "BLD",9344,"KRN","B",8989.52,8989.52) "BLD",9344,"KRN","B",8994,8994) "BLD",9344,"QUES",0) ^9.62^^ "BLD",9344,"REQB",0) ^9.611^3^3 "BLD",9344,"REQB",1,0) BPS*1.0*9^1 "BLD",9344,"REQB",2,0) BPS*1.0*15^1 "BLD",9344,"REQB",3,0) IB*2.0*519^1 "BLD",9344,"REQB","B","BPS*1.0*15",2) "BLD",9344,"REQB","B","BPS*1.0*9",1) "BLD",9344,"REQB","B","IB*2.0*519",3) "FIA",9002313.03) BPS RESPONSES "FIA",9002313.03,0) ^BPSR( "FIA",9002313.03,0,0) 9002313.03P "FIA",9002313.03,0,1) y^y^p^^^^n^^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) 1 "FIA",9002313.03,9002313.03,568) "MBREQ") 1 "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) 18^3141216 "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") 3 "RTN","BPSRPT9") 0^4^B106079505 "RTN","BPSRPT9",1,0) BPSRPT9 ;BHAM ISC/BNT - ECME REPORTS ;19-SEPT-08 "RTN","BPSRPT9",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**8,18**;01-JUN-04;Build 31 "RTN","BPSRPT9",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","BPSRPT9",4,0) ; "RTN","BPSRPT9",5,0) Q "RTN","BPSRPT9",6,0) ; Front End for Potential Secondary and Tricare Rx Claims Reports "RTN","BPSRPT9",7,0) ; Input variable: BPRTYPE -> 8 = Potential Tricare "RTN","BPSRPT9",8,0) ; 9 = Potential Secondary "RTN","BPSRPT9",9,0) ; "RTN","BPSRPT9",10,0) ; Passed variables - The following local variables are passed around the BPSRPT* routines "RTN","BPSRPT9",11,0) ; and are not passed as parameters but are assumed to be defined: "RTN","BPSRPT9",12,0) ; BPACREJ,BPAUTREV,BPBEGDT,BPBLINE,BPCCRSN,BPDRGCL,BPDRUG,BPENDDT,BPEXCEL, "RTN","BPSRPT9",13,0) ; BPINSINF,BPGRPLN,BPMWC,BPNOW,BPPAGE,BPPHARM,BPQ,BPQSTDRG, "RTN","BPSRPT9",14,0) ; BPRLNRL,BPRTBCK,BPSDATA,BPSUMDET,BPRTYPE "RTN","BPSRPT9",15,0) ; "RTN","BPSRPT9",16,0) EN(BPRTYPE) ; "RTN","BPSRPT9",17,0) N BPREJCD,BPRLNRL,BPRPTNAM,BPRTBCK,BPSCR,BPSUMDET,CODE,POS,STAT,X,Y,BPINS,BPARR "RTN","BPSRPT9",18,0) N BPSORT,BPCRON,BPSEL,BPS1,BPS2,BPS3,BPS4,BPS5,BPDT,BPPHARM,BPDIVS "RTN","BPSRPT9",19,0) ; "RTN","BPSRPT9",20,0) ;Verify that a valid report has been requested "RTN","BPSRPT9",21,0) I ",8,9,"'[(","_$G(BPRTYPE)_",") D EN^DDIOL("") H 3 Q "RTN","BPSRPT9",22,0) ; "RTN","BPSRPT9",23,0) D EN^DDIOL("SELECTION CRITERIA","","!") "RTN","BPSRPT9",24,0) ;Prompt for ECME Pharmacy Division(s) (No Default) "RTN","BPSRPT9",25,0) ;Sets up BPPHARM variable and array, BPPHARM =0 ALL or BPPHARM=1,BPPHARM(ptr) for list "RTN","BPSRPT9",26,0) S X=$$SELPHARM^BPSRPT3() I X="^" Q "RTN","BPSRPT9",27,0) ; "RTN","BPSRPT9",28,0) ;Prompt to select Date Range "RTN","BPSRPT9",29,0) ;Returns (Start Date^End Date) "RTN","BPSRPT9",30,0) S BPDT=$$SELDATE() I BPDT="^" Q "RTN","BPSRPT9",31,0) ; "RTN","BPSRPT9",32,0) ;Get sort criteria "RTN","BPSRPT9",33,0) I $$GETSORT(BPRTYPE)=-1 Q "RTN","BPSRPT9",34,0) ; "RTN","BPSRPT9",35,0) D DEV("RUN^BPSRPT9",BPRTYPE) "RTN","BPSRPT9",36,0) Q "RTN","BPSRPT9",37,0) ; "RTN","BPSRPT9",38,0) RUN ; Process Report - runs in the background or foreground "RTN","BPSRPT9",39,0) N BPRPTARR "RTN","BPSRPT9",40,0) I BPRTYPE=9 D GETSEC^BPSRPT9A(BPDT,.BPRPTARR) ; Collect Potential Secondary Rx Claims data "RTN","BPSRPT9",41,0) I BPRTYPE=8 D GETTRI^BPSRPT9A(BPDT,.BPRPTARR) ; Collect Potential Tricare Rx Claims data "RTN","BPSRPT9",42,0) ; "RTN","BPSRPT9",43,0) U IO "RTN","BPSRPT9",44,0) I BPRTYPE=8 D PRNTTRI(.BPRPTARR) "RTN","BPSRPT9",45,0) I BPRTYPE=9 D PRNTSEC(.BPRPTARR) "RTN","BPSRPT9",46,0) ; "RTN","BPSRPT9",47,0) D ^%ZISC ; close the device "RTN","BPSRPT9",48,0) S:$D(ZTQUEUED) ZTREQ="@" "RTN","BPSRPT9",49,0) Q "RTN","BPSRPT9",50,0) ; "RTN","BPSRPT9",51,0) ; Print TRICARE Report "RTN","BPSRPT9",52,0) PRNTTRI(BPARR) ; "RTN","BPSRPT9",53,0) N BPG,BPQUIT,CNT,RX,FILL,FILLDT,PATNAME,COB,ELIG,PAYER,INSC,PSRT,PSRTID,SSRT,TSRT,DATA "RTN","BPSRPT9",54,0) N SSRTTYP,TSRTTYP "RTN","BPSRPT9",55,0) S SSRTTYP=$P($P(BPSORT,U,2),":") "RTN","BPSRPT9",56,0) S TSRTTYP=$P($P(BPSORT,U,3),":") "RTN","BPSRPT9",57,0) S (BPG,BPQUIT,CNT)=0 "RTN","BPSRPT9",58,0) ; "RTN","BPSRPT9",59,0) ; if no data found, display header and message and then get out "RTN","BPSRPT9",60,0) I '$D(BPARR) D Q "RTN","BPSRPT9",61,0) . D HDR(BPRTYPE) "RTN","BPSRPT9",62,0) . W !!?5,"No potential TRICARE Rx claims available for date range" "RTN","BPSRPT9",63,0) . Q "RTN","BPSRPT9",64,0) ; "RTN","BPSRPT9",65,0) S PSRT=-DT-1 "RTN","BPSRPT9",66,0) D HDR(BPRTYPE) "RTN","BPSRPT9",67,0) F S PSRT=$O(BPARR(PSRT)) Q:PSRT="" D Q:BPQUIT "RTN","BPSRPT9",68,0) . S PSRTID=$S($P($P(BPSORT,U),":")="N":"Patient Name: ",$P($P(BPSORT,U),":")="P":"Payer: ",$P($P(BPSORT,U),":")="S":"Date of Service: ",$P($P(BPSORT,U),":")="O":"Payer Sequence: ",1:"Division: ") "RTN","BPSRPT9",69,0) . I PSRT'=0 W !!,PSRTID,$S($P($P(BPSORT,U),":")="S":$$FMTE^XLFDT($$ABS^XLFMTH(PSRT),"2D"),1:PSRT) "RTN","BPSRPT9",70,0) . S SSRT=-DT-1 F S SSRT=$O(BPARR(PSRT,SSRT)) Q:SSRT="" D Q:BPQUIT "RTN","BPSRPT9",71,0) . . I SSRTTYP="D" W !," Division: ",SSRT "RTN","BPSRPT9",72,0) . . S TSRT=-DT-1 F S TSRT=$O(BPARR(PSRT,SSRT,TSRT)) Q:TSRT="" D Q:BPQUIT "RTN","BPSRPT9",73,0) . . . I TSRTTYP="D" W !," Division: ",TSRT "RTN","BPSRPT9",74,0) . . . S CNT=0 F S CNT=$O(BPARR(PSRT,SSRT,TSRT,CNT)) Q:CNT="" D Q:BPQUIT "RTN","BPSRPT9",75,0) . . . . S DATA=BPARR(PSRT,SSRT,TSRT,CNT) "RTN","BPSRPT9",76,0) . . . . S RX=$P(DATA,U,2),FILL=$P(DATA,U,3),FILLDT=$P(DATA,U,4),PATNAME=$P(DATA,U,5) "RTN","BPSRPT9",77,0) . . . . S INSC=0 F S INSC=$O(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC)) Q:INSC="" D "RTN","BPSRPT9",78,0) . . . . . S COB=$S(INSC=1:"p",INSC=2:"s",1:"t") "RTN","BPSRPT9",79,0) . . . . . S ELIG=$P(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U) "RTN","BPSRPT9",80,0) . . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",81,0) . . . . . ;S PAYER=$E($P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U)_" - "_$P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,2),1,23) "RTN","BPSRPT9",82,0) . . . . . S PAYER=$E($P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U)_"-"_$P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,2),1,16) "RTN","BPSRPT9",83,0) . . . . . I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT "RTN","BPSRPT9",84,0) . . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",85,0) . . . . . ;W !,RX,?10,FILL,?15,FILLDT,?24,$E(PATNAME,1,15),?40,$P(DATA,U,6),?45,COB,?49,ELIG,?55,PAYER "RTN","BPSRPT9",86,0) . . . . . W !,RX,?10,FILL,?13,FILLDT,?22,$E(PATNAME,1,15),?38,$P(DATA,U,6),?44,COB,?47,ELIG,?52,PAYER,?69,$P(BPARR(PSRT,SSRT,TSRT,CNT,"INS",INSC),U,3) "RTN","BPSRPT9",87,0) . . . . . S ELIG=$S($P(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U,2)]"":$P(BPARR(PSRT,SSRT,TSRT,CNT,"ELIG"),U,2),1:"") "RTN","BPSRPT9",88,0) . . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",89,0) . . . . . ;I ELIG]"" W !,?49,ELIG "RTN","BPSRPT9",90,0) . . . . . I ELIG]"" W !,?47,ELIG "RTN","BPSRPT9",91,0) Q "RTN","BPSRPT9",92,0) ; "RTN","BPSRPT9",93,0) ; Print Secondary Report "RTN","BPSRPT9",94,0) PRNTSEC(BPARR) ; "RTN","BPSRPT9",95,0) N BPG,BPQUIT,CNT,INSC,PAYER,PSRT,PSRTID,SSRT,TSRT,DATA,INSDATA,LGFLG1,LGFLG2 "RTN","BPSRPT9",96,0) N SSRTTYP,TSRTTYP "RTN","BPSRPT9",97,0) S SSRTTYP=$P($P(BPSORT,U,2),":") "RTN","BPSRPT9",98,0) S TSRTTYP=$P($P(BPSORT,U,3),":") "RTN","BPSRPT9",99,0) S (BPG,BPQUIT)=0 "RTN","BPSRPT9",100,0) ; "RTN","BPSRPT9",101,0) ; if no data found, display header and message and then get out "RTN","BPSRPT9",102,0) I '$D(BPARR) D Q "RTN","BPSRPT9",103,0) . D HDR(BPRTYPE) "RTN","BPSRPT9",104,0) . W !!?5,"No potential secondary Rx claims available for date range" "RTN","BPSRPT9",105,0) . Q "RTN","BPSRPT9",106,0) ; "RTN","BPSRPT9",107,0) S PSRT=-DT-1 "RTN","BPSRPT9",108,0) D HDR(BPRTYPE) "RTN","BPSRPT9",109,0) F S PSRT=$O(BPARR(PSRT)) Q:PSRT="" D Q:BPQUIT "RTN","BPSRPT9",110,0) . S PSRTID=$S($P($P(BPSORT,U),":")="N":"Patient Name: ",$P($P(BPSORT,U),":")="P":"Payer: ",$P($P(BPSORT,U),":")="S":"Date of Service: ",$P($P(BPSORT,U),":")="O":"Payer Sequence: ",1:"Division: ") "RTN","BPSRPT9",111,0) . I PSRT'=0 W !!,PSRTID,$S($P($P(BPSORT,U),":")="S":$$FMTE^XLFDT($$ABS^XLFMTH(PSRT),"2D"),1:PSRT) "RTN","BPSRPT9",112,0) . S SSRT=-DT-1 F S SSRT=$O(BPARR(PSRT,SSRT)) Q:SSRT="" D Q:BPQUIT "RTN","BPSRPT9",113,0) . . I SSRTTYP="D" W !," Division: ",SSRT "RTN","BPSRPT9",114,0) . . S TSRT=-DT-1 F S TSRT=$O(BPARR(PSRT,SSRT,TSRT)) Q:TSRT="" D Q:BPQUIT "RTN","BPSRPT9",115,0) . . . I TSRTTYP="D" W !," Division: ",TSRT "RTN","BPSRPT9",116,0) . . . S CNT=0 F S CNT=$O(BPARR(PSRT,SSRT,TSRT,CNT)) Q:CNT="" D Q:BPQUIT "RTN","BPSRPT9",117,0) . . . . S DATA=$G(BPARR(PSRT,SSRT,TSRT,CNT)) "RTN","BPSRPT9",118,0) . . . . I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT "RTN","BPSRPT9",119,0) . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",120,0) . . . . ;I DATA]"" W !,$P(DATA,U,2),?11,$P(DATA,U,3),?21,$P(DATA,U,4),?26,$E($P(DATA,U,6),1,15),?42,$P(DATA,U,9),?47,$P(DATA,U,7),?51,$P(DATA,U,5),?60,$E($P(DATA,U,8),1,20) "RTN","BPSRPT9",121,0) . . . . I DATA]"" W !,$P(DATA,U,2),?11,$P(DATA,U,3),?21,$P(DATA,U,4),?26,$E($P(DATA,U,6),1,10),?37,$P(DATA,U,9),?43,$P(DATA,U,7),?46,$P(DATA,U,5),?55,$E($P(DATA,U,8),1,13),?69,$P(DATA,U,10) "RTN","BPSRPT9",122,0) . . . . ; "RTN","BPSRPT9",123,0) . . . . ; If the bill# contains "(P)" it is a primary ECME reject, flag it for the legend "RTN","BPSRPT9",124,0) . . . . I $P(DATA,U,2)["(P)" S LGFLG1=1 "RTN","BPSRPT9",125,0) . . . . S INSC=0 F S INSC=$O(BPARR(PSRT,SSRT,TSRT,CNT,INSC)) Q:INSC="" D Q:BPQUIT "RTN","BPSRPT9",126,0) . . . . . S INSDATA=BPARR(PSRT,SSRT,TSRT,CNT,INSC) "RTN","BPSRPT9",127,0) . . . . . I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT "RTN","BPSRPT9",128,0) . . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",129,0) . . . . . ;W !,?47,$P(INSDATA,U),?60,$E($P(INSDATA,U,2),1,20) "RTN","BPSRPT9",130,0) . . . . . W !,?43,$P(INSDATA,U),?55,$E($P(INSDATA,U,2),1,13),?69,$P(INSDATA,U,3) "RTN","BPSRPT9",131,0) . . . . . I $P(INSDATA,U,1)["-" S LGFLG2=1 "RTN","BPSRPT9",132,0) ; "RTN","BPSRPT9",133,0) Q:BPQUIT "RTN","BPSRPT9",134,0) I '$G(LGFLG1),'$G(LGFLG2) Q "RTN","BPSRPT9",135,0) ; display the legend at the end of the report "RTN","BPSRPT9",136,0) I $Y>(IOSL-4) D HDR(BPRTYPE) Q:BPQUIT "RTN","BPSRPT9",137,0) W ! "RTN","BPSRPT9",138,0) I $G(LGFLG1) W !,"Bill# ""(P) Rej"" indicates a rejected/closed primary ECME claim" "RTN","BPSRPT9",139,0) I $G(LGFLG2) W !,"COB ""-"" indicates a blank COB field in the pt. ins. policy" "RTN","BPSRPT9",140,0) Q "RTN","BPSRPT9",141,0) ; "RTN","BPSRPT9",142,0) ; Prompt for sort order "RTN","BPSRPT9",143,0) GETSORT(BPRTYPE) N DIR,DIRUT,DTOUT,DUOUT,X,Y,BPS1,BPS2,BPS3,BPS4,BPSEL "RTN","BPSRPT9",144,0) ; "RTN","BPSRPT9",145,0) S BPSORT="^^",BPCRON=1 "RTN","BPSRPT9",146,0) S BPS1="N:Patient Name;",BPS2="P:Payer;",BPS3="S:Date Of Service;",BPS4="D:Division;" "RTN","BPSRPT9",147,0) ; "RTN","BPSRPT9",148,0) D EN^DDIOL("SORT CRITERIA","","!") "RTN","BPSRPT9",149,0) S BPSEL=BPS1_BPS2_BPS3_BPS4 "RTN","BPSRPT9",150,0) ;Set Primary Sort "RTN","BPSRPT9",151,0) S DIR(0)="SB^"_BPSEL "RTN","BPSRPT9",152,0) S DIR("?")="Enter a code from the list to indicate the Primary sort order." "RTN","BPSRPT9",153,0) S DIR("A")="Primary Sort" "RTN","BPSRPT9",154,0) S DIR("B")="Division" "RTN","BPSRPT9",155,0) D ^DIR K DIR "RTN","BPSRPT9",156,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) Q -1 "RTN","BPSRPT9",157,0) S $P(BPSORT,U)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,1:BPS4) I Y="S" S BPCRON=$$ASKCRON() I BPCRON="^" Q -1 "RTN","BPSRPT9",158,0) ; "RTN","BPSRPT9",159,0) ;Get Secondary Sort "RTN","BPSRPT9",160,0) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPT9",161,0) S BPSEL=$$SRTORD($P($P(BPSORT,U),":")) "RTN","BPSRPT9",162,0) S DIR(0)="SOB^"_BPSEL "RTN","BPSRPT9",163,0) S DIR("?")="Enter a code from the list to indicate the Secondary sort order." "RTN","BPSRPT9",164,0) S DIR("A")="Secondary Sort" "RTN","BPSRPT9",165,0) D ^DIR K DIR "RTN","BPSRPT9",166,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) Q -1 "RTN","BPSRPT9",167,0) S $P(BPSORT,U,2)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,1:BPS4) I Y="S" S BPCRON=$$ASKCRON() I BPCRON="^" Q -1 "RTN","BPSRPT9",168,0) ; "RTN","BPSRPT9",169,0) ;Get Tertiary Sort "RTN","BPSRPT9",170,0) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPT9",171,0) S BPSEL=$$SRTORD($P($P(BPSORT,U,2),":")) "RTN","BPSRPT9",172,0) S DIR(0)="SOB^"_BPSEL "RTN","BPSRPT9",173,0) S DIR("A")="Tertiary Sort" "RTN","BPSRPT9",174,0) S DIR("?")="Enter a code from the list to indicate the Tertiary sort order." "RTN","BPSRPT9",175,0) D ^DIR K DIR "RTN","BPSRPT9",176,0) I ($G(DUOUT)=1)!($G(DTOUT)=1) Q -1 "RTN","BPSRPT9",177,0) S $P(BPSORT,U,3)=$S(Y=$P(BPS1,":"):BPS1,Y=$P(BPS2,":"):BPS2,Y=$P(BPS3,":"):BPS3,1:BPS4) I Y="S" S BPCRON=$$ASKCRON() I BPCRON="^" Q -1 "RTN","BPSRPT9",178,0) Q 0 "RTN","BPSRPT9",179,0) ; "RTN","BPSRPT9",180,0) ;Ask if Date should be displayed in chronological order "RTN","BPSRPT9",181,0) ASKCRON() ; "RTN","BPSRPT9",182,0) N DIR,DIRUT,DTOUT,DUOUT,X,Y "RTN","BPSRPT9",183,0) S DIR(0)="Y" "RTN","BPSRPT9",184,0) S DIR("A")=" Display oldest date first" "RTN","BPSRPT9",185,0) S DIR("B")="YES" "RTN","BPSRPT9",186,0) D ^DIR K DIR "RTN","BPSRPT9",187,0) I ($G(DUOUT)=1)!($G(DTOUT)=1)!($D(DIRUT)) Q "^" "RTN","BPSRPT9",188,0) Q Y "RTN","BPSRPT9",189,0) ; "RTN","BPSRPT9",190,0) ;Handle the sort order display "RTN","BPSRPT9",191,0) SRTORD(Y) ; "RTN","BPSRPT9",192,0) I Y="N" S BPS1="" "RTN","BPSRPT9",193,0) I Y="P" S BPS2="" "RTN","BPSRPT9",194,0) I Y="S" S BPS3="" "RTN","BPSRPT9",195,0) I Y="D" S BPS4="" "RTN","BPSRPT9",196,0) S BPSEL=BPS1_BPS2_BPS3_BPS4 "RTN","BPSRPT9",197,0) Q BPSEL "RTN","BPSRPT9",198,0) ; "RTN","BPSRPT9",199,0) ; Enter Date Range "RTN","BPSRPT9",200,0) ; "RTN","BPSRPT9",201,0) ; Return Value -> P1^P2 "RTN","BPSRPT9",202,0) ; "RTN","BPSRPT9",203,0) ; where P1 = Earliest Date "RTN","BPSRPT9",204,0) ; = ^ Exit "RTN","BPSRPT9",205,0) ; P2 = Latest Date "RTN","BPSRPT9",206,0) ; = blank for Exit "RTN","BPSRPT9",207,0) SELDATE() ; "RTN","BPSRPT9",208,0) N BPSIBDT,DIR,DIRUT,DTOUT,DUOUT,VAL,X,Y "RTN","BPSRPT9",209,0) S VAL="",DIR(0)="DA^:DT:EX",DIR("A")="EARLIEST DATE: " "RTN","BPSRPT9",210,0) W ! D ^DIR "RTN","BPSRPT9",211,0) ; "RTN","BPSRPT9",212,0) ;Check for "^", timeout, or blank entry "RTN","BPSRPT9",213,0) I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" "RTN","BPSRPT9",214,0) ; "RTN","BPSRPT9",215,0) I VAL="" D "RTN","BPSRPT9",216,0) .S $P(VAL,U)=Y "RTN","BPSRPT9",217,0) .S DIR(0)="DA^"_VAL_":DT:EX",DIR("A")=" LATEST DATE: ",DIR("B")="T" "RTN","BPSRPT9",218,0) .D ^DIR "RTN","BPSRPT9",219,0) .; "RTN","BPSRPT9",220,0) .;Check for "^", timeout, or blank entry "RTN","BPSRPT9",221,0) .I ($G(DUOUT)=1)!($G(DTOUT)=1)!($G(X)="") S VAL="^" Q "RTN","BPSRPT9",222,0) .; "RTN","BPSRPT9",223,0) .;Define Entry "RTN","BPSRPT9",224,0) .S $P(VAL,U,2)=Y "RTN","BPSRPT9",225,0) ; "RTN","BPSRPT9",226,0) Q VAL "RTN","BPSRPT9",227,0) ; "RTN","BPSRPT9",228,0) ; "RTN","BPSRPT9",229,0) ;Device Selection "RTN","BPSRPT9",230,0) ;Input: BPR = Routine "RTN","BPSRPT9",231,0) ; BPRTYPE = Report Type used to identify Task name "RTN","BPSRPT9",232,0) DEV(BPR,BPRTYPE) ; "RTN","BPSRPT9",233,0) N %ZIS,ZTSK,ZTSAVE,POP,ZTRTN,ZTDESC "RTN","BPSRPT9",234,0) S %ZIS="MQ" D ^%ZIS Q:POP "RTN","BPSRPT9",235,0) I $D(IO("Q")) D Q "RTN","BPSRPT9",236,0) . S ZTRTN=BPR,ZTDESC=$$RPTNAME(BPRTYPE),ZTSAVE("BP*")="" "RTN","BPSRPT9",237,0) . D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"QUEUED TASK #",ZTSK "RTN","BPSRPT9",238,0) D @BPR "RTN","BPSRPT9",239,0) Q "RTN","BPSRPT9",240,0) ; "RTN","BPSRPT9",241,0) RPTNAME(BPRTYPE) ; "RTN","BPSRPT9",242,0) ;Verify that a valid report has been requested "RTN","BPSRPT9",243,0) Q $S(BPRTYPE=8:"Potential TRICARE Rx Claims Report",BPRTYPE=9:"Potential Secondary Rx Claims Report",1:"") "RTN","BPSRPT9",244,0) ; "RTN","BPSRPT9",245,0) ;Print the report Header "RTN","BPSRPT9",246,0) ;Input: BPRTYPE = Report Type "RTN","BPSRPT9",247,0) HDR(BPRTYPE) ; "RTN","BPSRPT9",248,0) ; BPG is assumed for page # "RTN","BPSRPT9",249,0) Q:BPQUIT "RTN","BPSRPT9",250,0) N DIR,X,Y,BPDIV "RTN","BPSRPT9",251,0) I $E(IOST,1,2)="C-",BPG S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S BPQUIT=1 K DIRUT,DTOUT,DUOUT Q "RTN","BPSRPT9",252,0) S BPG=BPG+1 "RTN","BPSRPT9",253,0) W @IOF "RTN","BPSRPT9",254,0) F X=1:1:IOM W "=" "RTN","BPSRPT9",255,0) W $$RPTNAME(BPRTYPE)," ",$$FMTE^XLFDT($P(BPDT,U),"2D")," - ",$$FMTE^XLFDT($P(BPDT,U,2),"2D"),?IOM-10," Page: ",BPG "RTN","BPSRPT9",256,0) W !,"Selected Divisions: " "RTN","BPSRPT9",257,0) I 'BPPHARM W "ALL" "RTN","BPSRPT9",258,0) I BPPHARM S X=0 F S X=$O(BPPHARM(X)) Q:X="" W $P(BPPHARM(X),U,2),"; " "RTN","BPSRPT9",259,0) W !,"Sorted By: "_$P($P(BPSORT,U),":",2)_" "_$P($P(BPSORT,U,2),":",2)_" "_$P($P(BPSORT,U,3),":",2) "RTN","BPSRPT9",260,0) ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",261,0) W !,"'*' indicates the HPID/OEID failed validation checks" "RTN","BPSRPT9",262,0) ; Write header for Potential Secondary Claims Rpt "RTN","BPSRPT9",263,0) I BPRTYPE=9 D "RTN","BPSRPT9",264,0) . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",265,0) . ;W !,"Bill#",?11,"RX#",?21,"Fill",?26,"Patient",?41,"PatID",?47,"COB",?51,"Date",?60,"Payers",! "RTN","BPSRPT9",266,0) . W !,"Bill#",?11,"RX#",?21,"Fill",?26,"Patient",?36,"PatID",?42,"COB",?46,"Date",?55,"Payers",?69,"HPID/OEID",! "RTN","BPSRPT9",267,0) ; Write header for Potential Tricare Claims Rpt "RTN","BPSRPT9",268,0) I BPRTYPE=8 D "RTN","BPSRPT9",269,0) . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID "RTN","BPSRPT9",270,0) . ;W !,"RX#",?10,"Fill",?15,"Date",?24,"Patient",?39,"PatID",?45,"COB",?49,"Elig",?55,"Payers",! "RTN","BPSRPT9",271,0) . W !,"RX#",?9,"Fill",?14,"Date",?22,"Patient",?37,"PatID",?43,"COB",?47,"Elig",?53,"Payers",?69,"HPID/OEID",! "RTN","BPSRPT9",272,0) F X=1:1:IOM W "-" "RTN","BPSRPT9",273,0) Q "RTN","BPSRPT9A") 0^5^B95077796 "RTN","BPSRPT9A",1,0) BPSRPT9A ;BHAM ISC/BNT - ECME REPORTS UTILITIES ;19-SEPT-08 "RTN","BPSRPT9A",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**8,9,18**;01-JUN-04;Build 31 "RTN","BPSRPT9A",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","BPSRPT9A",4,0) ; "RTN","BPSRPT9A",5,0) ; Use of COLLECT^IBOSRX supported by IA 5361 "RTN","BPSRPT9A",6,0) ; Use of $$INSUR^IBBAPI supported by IA 4419 "RTN","BPSRPT9A",7,0) ; Use of $$RNB^IBNCPDPI supported by IA 4729 "RTN","BPSRPT9A",8,0) ; Use of $$BILINF^IBNCPUT3 supported by IA 5355 "RTN","BPSRPT9A",9,0) ; Use of $$HPD^IBCNHUT1 supported by IA #6061 "RTN","BPSRPT9A",10,0) ; "RTN","BPSRPT9A",11,0) Q "RTN","BPSRPT9A",12,0) ; "RTN","BPSRPT9A",13,0) ; Collect the Potential Secondary Rx Claims Report data "RTN","BPSRPT9A",14,0) GETSEC(BPDT,BPARR) ; "RTN","BPSRPT9A",15,0) N CNT,IBARR S CNT=0 "RTN","BPSRPT9A",16,0) N BPSX,BPSY "RTN","BPSRPT9A",17,0) N BPS56 S BPS56=0 "RTN","BPSRPT9A",18,0) I '$D(ZTQUEUED),$E(IOST,1,2)="C-" W !!,"Collecting Potential Secondary data ..." "RTN","BPSRPT9A",19,0) K ^TMP("BPSRPT9A",$J) "RTN","BPSRPT9A",20,0) D COLLECT^IBOSRX($P(BPDT,U),$P(BPDT,U,2)) ; get IB claim data (DBIA 5361) "RTN","BPSRPT9A",21,0) D GATHER($P(BPDT,U,1),$P(BPDT,U,2)) ; get ECME claim data - esg 7/6/10 "RTN","BPSRPT9A",22,0) I '$D(^TMP("BPSRPT9A",$J)) Q "RTN","BPSRPT9A",23,0) F S CNT=$O(^TMP("BPSRPT9A",$J,CNT)) Q:CNT="" D "RTN","BPSRPT9A",24,0) . N DATA,RXI,RXN,RXF,DOS,BILL,DFN,PATNAME,BPDIV,INSC,X,COB,PINS,BP59S,BP59P,IBIFN,TOTCHG,BAL,BPSRESP,BPSPAID,BPSINFO,BPSRET "RTN","BPSRPT9A",25,0) . S DATA=$G(^TMP("BPSRPT9A",$J,CNT)) "RTN","BPSRPT9A",26,0) . S RXI=$P(DATA,U,1),RXN=$P(DATA,U,2),RXF=$P(DATA,U,3),BILL=$P(DATA,U,4),DFN=$P(DATA,U,5),DOS=$P(DATA,U,6),PINS=$P(DATA,U,7) "RTN","BPSRPT9A",27,0) . S IBIFN=$P(DATA,U,8),TOTCHG=$P(DATA,U,9) "RTN","BPSRPT9A",28,0) . Q:(RXI="")!(RXN="")!(RXF="")!(BILL="")!(DFN="")!(DOS="")!(PINS="") "RTN","BPSRPT9A",29,0) . S PATNAME=$$GET1^DIQ(2,DFN,.01) "RTN","BPSRPT9A",30,0) . ; "RTN","BPSRPT9A",31,0) . ; Drop the claim off this report if the Secondary claim is closed in ECME "RTN","BPSRPT9A",32,0) . ; esg - 7/6/10 "RTN","BPSRPT9A",33,0) . S BP59S=+$$IEN59^BPSOSRX(RXI,RXF,2) ; possible ien to file 9002313.59 for the secondary claim "RTN","BPSRPT9A",34,0) . I $$CLOSED02^BPSSCR03(+$P($G(^BPST(BP59S,0)),U,4)) Q "RTN","BPSRPT9A",35,0) . ; "RTN","BPSRPT9A",36,0) . ; Drop the claim off this report if the Secondary claim is Payable "RTN","BPSRPT9A",37,0) . ; bnt - 7/14/10 "RTN","BPSRPT9A",38,0) . S BP59P=+$$IEN59^BPSOSRX(RXI,RXF,1) ; possible ien to file 9002313.59 for the primary claim "RTN","BPSRPT9A",39,0) . I $$PAYBLSEC^BPSUTIL2(BP59P) Q "RTN","BPSRPT9A",40,0) . ; "RTN","BPSRPT9A",41,0) . ; Drop the claim off this report if the primary payer paid the full amount "RTN","BPSRPT9A",42,0) . ; esg - 8/3/10 "RTN","BPSRPT9A",43,0) . I IBIFN,TOTCHG D I BAL'>0 Q ; check balance due on entries with payable primary claims "RTN","BPSRPT9A",44,0) .. S BPSRESP=+$P($G(^BPST(BP59P,0)),U,5) ; response file ien "RTN","BPSRPT9A",45,0) .. S BPSPAID=0 "RTN","BPSRPT9A",46,0) .. I BPSRESP S BPSPAID=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,9)) ; paid amt "RTN","BPSRPT9A",47,0) .. S BAL=TOTCHG-BPSPAID ; balance due: total charges - primary payer paid amt "RTN","BPSRPT9A",48,0) .. Q "RTN","BPSRPT9A",49,0) . ; "RTN","BPSRPT9A",50,0) . S BPDIV=$$GETDIV^BPSOSQC(RXI,RXF) Q:'BPDIV ;Outpatient Site #59 ien "RTN","BPSRPT9A",51,0) . S BPS56=+$O(^BPS(9002313.56,"C",BPDIV,0)) Q:'BPS56 ;BPS PHARMACIES #9002313.56 ien "RTN","BPSRPT9A",52,0) . ;filter divisions "RTN","BPSRPT9A",53,0) . I BPPHARM=1,'$D(BPPHARM(BPS56)) Q "RTN","BPSRPT9A",54,0) . S BPDIV(BPDIV)=$$DIVNAME^BPSSCRDS(BPS56) "RTN","BPSRPT9A",55,0) . ; "RTN","BPSRPT9A",56,0) . S PSRT=$S($P($P(BPSORT,U,1),":")="N":PATNAME,$P($P(BPSORT,U,1),":")="P":PINS,$P($P(BPSORT,U,1),":")="S":$S('BPCRON:-DOS,1:DOS),1:BPDIV(BPDIV)) "RTN","BPSRPT9A",57,0) . S SSRT=$S($P($P(BPSORT,U,2),":")="N":PATNAME,$P($P(BPSORT,U,2),":")="P":PINS,$P($P(BPSORT,U,2),":")="S":$S('BPCRON:-DOS,1:DOS),$P($P(BPSORT,U,2),":")="D":BPDIV(BPDIV),1:0) "RTN","BPSRPT9A",58,0) . S TSRT=$S($P($P(BPSORT,U,3),":")="N":PATNAME,$P($P(BPSORT,U,3),":")="P":PINS,$P($P(BPSORT,U,3),":")="S":$S('BPCRON:-DOS,1:DOS),$P($P(BPSORT,U,3),":")="D":BPDIV(BPDIV),1:0) "RTN","BPSRPT9A",59,0) . Q:((SSRT="")!(PSRT="")!(TSRT="")) "RTN","BPSRPT9A",60,0) . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID - IB ICR #6061 (get ins ien using IB ICR#5355) "RTN","BPSRPT9A",61,0) . ;S BPARR(PSRT,SSRT,TSRT,CNT)=BPDIV(BPDIV)_U_BILL_U_RXN_U_RXF_U_$$FMTE^XLFDT(DOS,"2D")_U_PATNAME_U_"p"_U_PINS_U_$$SSN4^BPSRPT6(DFN) "RTN","BPSRPT9A",62,0) . S BPSRET=$$BILINF^IBNCPUT3(IBIFN,.BPSINFO) "RTN","BPSRPT9A",63,0) . S BPARR(PSRT,SSRT,TSRT,CNT)=BPDIV(BPDIV)_U_BILL_U_RXN_U_RXF_U_$$FMTE^XLFDT(DOS,"2D")_U_PATNAME_U_"p"_U_PINS_U_$$SSN4^BPSRPT6(DFN)_U_$$HPD^IBCNHUT1($G(BPSINFO("INS IEN")),1) "RTN","BPSRPT9A",64,0) . S (X,INSC)=0 "RTN","BPSRPT9A",65,0) . F S X=$O(^TMP("BPSRPT9A",$J,CNT,X)) Q:X="" D "RTN","BPSRPT9A",66,0) . . S BPSX=$G(^TMP("BPSRPT9A",$J,CNT,X,7)) "RTN","BPSRPT9A",67,0) . . S COB=$S($P(BPSX,U)=1:"p",$P(BPSX,U)=2:"s",$P(BPSX,U)=3:"t",1:"-") "RTN","BPSRPT9A",68,0) . . S BPSY=$P($G(^TMP("BPSRPT9A",$J,CNT,X,1)),U,2) "RTN","BPSRPT9A",69,0) . . Q:BPSY[PINS "RTN","BPSRPT9A",70,0) . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID - IB ICR #6061 "RTN","BPSRPT9A",71,0) . . ;S BPARR(PSRT,SSRT,TSRT,CNT,X)=COB_U_BPSY "RTN","BPSRPT9A",72,0) . . S BPARR(PSRT,SSRT,TSRT,CNT,X)=COB_U_BPSY_U_$$HPD^IBCNHUT1($P($G(^TMP("BPSRPT9A",$J,CNT,X,1)),U),1) "RTN","BPSRPT9A",73,0) K ^TMP("BPSRPT9A",$J) "RTN","BPSRPT9A",74,0) Q "RTN","BPSRPT9A",75,0) ; "RTN","BPSRPT9A",76,0) ; Collect the Potential Tricare Rx Claims Report data "RTN","BPSRPT9A",77,0) ; Build array with report data "RTN","BPSRPT9A",78,0) ; BPARR(n)=DIVISION NAME^RX#^FILL^FILL DATE^PATIENT NAME "RTN","BPSRPT9A",79,0) ; BPARR(n,"INS",1)=PRIMARY INS NAME^PRIMARY INS ADDRESS "RTN","BPSRPT9A",80,0) ; BPARR(n,"INS",2)=SECONDARY INS NAME^SECONDARY INS ADDRESS "RTN","BPSRPT9A",81,0) ; BPARR(n,"ELIG")=ELIG 1^ELIG 2^... "RTN","BPSRPT9A",82,0) GETTRI(BPDT,BPARR) ; "RTN","BPSRPT9A",83,0) N RXI,RXN,RXF,RXFDT,LIST,RXLIST,BPQUIT,CNT,BPSFLDN,BPHPD "RTN","BPSRPT9A",84,0) S REF=$NA(^TMP($J,"BPSRPT9","AD")) "RTN","BPSRPT9A",85,0) S BPSFLDN=".01;2;6" "RTN","BPSRPT9A",86,0) K @REF "RTN","BPSRPT9A",87,0) S (RXFDT,BPDRUG,CNT)=0,LIST="BPSRPT9" "RTN","BPSRPT9A",88,0) I '$D(ZTQUEUED),$E(IOST,1,2)="C-" W !!,"Collecting TRICARE data ..." "RTN","BPSRPT9A",89,0) D REF^PSO52EX($P(BPDT,U),$P(BPDT,U,2),LIST) "RTN","BPSRPT9A",90,0) I '$D(@REF) Q "RTN","BPSRPT9A",91,0) F S RXFDT=$O(@REF@(RXFDT)) Q:RXFDT="" D "RTN","BPSRPT9A",92,0) . S RXI=0 F S RXI=$O(@REF@(RXFDT,RXI)) Q:RXI="" D "RTN","BPSRPT9A",93,0) . . S RXF=-1 F S RXF=$O(@REF@(RXFDT,RXI,RXF)) Q:RXF="" D "RTN","BPSRPT9A",94,0) . . . N BPELIG,VAEL,BPDRUG,BPDEA,BPIE,DFN,ARR,BPDIV,PSRT,SSRT,TSRT,BPS56 "RTN","BPSRPT9A",95,0) . . . S (BPQUIT,BPDIV,BPS56)=0 "RTN","BPSRPT9A",96,0) . . . ; Check Pharmacy Division against selected Divisions "RTN","BPSRPT9A",97,0) . . . S BPDIV=$$GETDIV^BPSOSQC(RXI,RXF) Q:'BPDIV ;Outpatient Site #59 ien "RTN","BPSRPT9A",98,0) . . . S BPS56=+$O(^BPS(9002313.56,"C",BPDIV,0)) Q:'BPS56 ;BPS PHARMACIES #9002313.56 ien "RTN","BPSRPT9A",99,0) . . . ;filter divisions "RTN","BPSRPT9A",100,0) . . . I BPPHARM=1,'$D(BPPHARM(BPS56)) Q "RTN","BPSRPT9A",101,0) . . . D RXAPI^BPSUTIL1(RXI,BPSFLDN,"ARR","IE") "RTN","BPSRPT9A",102,0) . . . S DFN=ARR(52,RXI,2,"I") Q:'DFN "RTN","BPSRPT9A",103,0) . . . D ELIG^VADPT "RTN","BPSRPT9A",104,0) . . . ; Check for TRICARE or SHARING AGREEMENT "RTN","BPSRPT9A",105,0) . . . S BPELIG=$P(VAEL(1),U,2) "RTN","BPSRPT9A",106,0) . . . S BPQUIT=$S(BPELIG="TRICARE":0,BPELIG="SHARING AGREEMENT":0,1:1) "RTN","BPSRPT9A",107,0) . . . S BPELIG(1)=$E(BPELIG,1,4) "RTN","BPSRPT9A",108,0) . . . S X=-1 F S X=$O(VAEL(1,X)) Q:X="" D "RTN","BPSRPT9A",109,0) . . . . S BPELIG=$P(VAEL(1,X),U,2) "RTN","BPSRPT9A",110,0) . . . . S BPQUIT=$S(BPELIG="TRICARE":0,BPELIG="SHARING AGREEMENT":0,1:1) "RTN","BPSRPT9A",111,0) . . . . S BPELIG(1)=BPELIG(1)_U_$E(BPELIG,1,4) "RTN","BPSRPT9A",112,0) . . . Q:$S(BPELIG(1)["TRIC":0,BPELIG(1)["SHAR":0,1:1) "RTN","BPSRPT9A",113,0) . . . S BPDRUG=ARR(52,RXI,6,"I") Q:'BPDRUG "RTN","BPSRPT9A",114,0) . . . K ^TMP($J,"BPDRUG") D DATA^PSS50(BPDRUG,,,,,"BPDRUG") "RTN","BPSRPT9A",115,0) . . . S BPDEA=^TMP($J,"BPDRUG",BPDRUG,3) "RTN","BPSRPT9A",116,0) . . . ; Exclude drugs that are exempt from billing "RTN","BPSRPT9A",117,0) . . . I (BPDEA["I")!(BPDEA["S")!(BPDEA["N")&(BPDEA'["E") Q "RTN","BPSRPT9A",118,0) . . . ; "RTN","BPSRPT9A",119,0) . . . ; exclude Rx if it is non-billable - esg 8/4/10 "RTN","BPSRPT9A",120,0) . . . I +$$RNB^IBNCPDPI(RXI,RXF) Q "RTN","BPSRPT9A",121,0) . . . ; "RTN","BPSRPT9A",122,0) . . . ; exclude Rx if it is not released - esg 8/5/10 "RTN","BPSRPT9A",123,0) . . . I '$$RELDATE^BPSBCKJ(RXI,RXF) Q "RTN","BPSRPT9A",124,0) . . . ; "RTN","BPSRPT9A",125,0) . . . ; exclude Rx if Inpatient and non-billable at time of Release "RTN","BPSRPT9A",126,0) . . . I $$INP(RXI,RXF) Q "RTN","BPSRPT9A",127,0) . . . ; "RTN","BPSRPT9A",128,0) . . . ; Make sure not already ECME billed "RTN","BPSRPT9A",129,0) . . . Q:$$STATUS^BPSOSRX(RXI,RXF)'="" "RTN","BPSRPT9A",130,0) . . . ; Check for TRICARE type insurance group "RTN","BPSRPT9A",131,0) . . . N BPIBA,X,BPOK,BPINS,I "RTN","BPSRPT9A",132,0) . . . I '$$INSUR^IBBAPI(DFN,RXFDT,"P",.BPIBA,"*") Q "RTN","BPSRPT9A",133,0) . . . S (X,BPOK)=0 F I=1:1 S X=$O(BPIBA("IBBAPI","INSUR",X)) Q:X="" D "RTN","BPSRPT9A",134,0) . . . . I $P(BPIBA("IBBAPI","INSUR",X,21),U,2)="TRICARE" S BPOK=1 "RTN","BPSRPT9A",135,0) . . . . N BPCOB S BPCOB=$P(BPIBA("IBBAPI","INSUR",X,7),U) S:BPCOB="" BPCOB=1 "RTN","BPSRPT9A",136,0) . . . . ; BPS*1*18: Modify ePharmacy Screens/Reports to Include the Validated HPID/OEID - IB ICR #6061 "RTN","BPSRPT9A",137,0) . . . . ;S BPINS(DFN,BPCOB)=$P(BPIBA("IBBAPI","INSUR",X,1),U,2)_U_BPIBA("IBBAPI","INSUR",X,2) "RTN","BPSRPT9A",138,0) . . . . S BPINS(DFN,BPCOB)=$P(BPIBA("IBBAPI","INSUR",X,1),U,2)_U_BPIBA("IBBAPI","INSUR",X,2)_U_$$HPD^IBCNHUT1($P(BPIBA("IBBAPI","INSUR",X,1),U),1) "RTN","BPSRPT9A",139,0) . . . Q:'BPOK "RTN","BPSRPT9A",140,0) . . . ; Build the return array since all filters have passed "RTN","BPSRPT9A",141,0) . . . S CNT=CNT+1,BPDIV(BPDIV)=$$DIVNAME^BPSSCRDS(BPS56) "RTN","BPSRPT9A",142,0) . . . S PSRT=$S($P($P(BPSORT,U),":")="N":$E(ARR(52,RXI,2,"E"),1,20),$P($P(BPSORT,U),":")="P":$P($G(BPINS(DFN,+$O(BPINS(DFN,0)))),U),$P($P(BPSORT,U),":")="S":$S('BPCRON:-RXFDT,1:RXFDT),1:BPDIV(BPDIV)) "RTN","BPSRPT9A",143,0) . . . S SSRT=$S($P($P(BPSORT,U,2),":")="N":$E(ARR(52,RXI,2,"E"),1,20),$P($P(BPSORT,U,2),":")="P":$P($G(BPINS(DFN,+$O(BPINS(DFN,0)))),U),$P($P(BPSORT,U,2),":")="S":$S('BPCRON:-RXFDT,1:RXFDT),$P($P(BPSORT,U,2),":")="D":BPDIV(BPDIV),1:0) "RTN","BPSRPT9A",144,0) . . . S TSRT=$S($P($P(BPSORT,U,3),":")="N":$E(ARR(52,RXI,2,"E"),1,20),$P($P(BPSORT,U,3),":")="P":$P($G(BPINS(DFN,+$O(BPINS(DFN,0)))),U),$P($P(BPSORT,U,3),":")="S":$S('BPCRON:-RXFDT,1:RXFDT),$P($P(BPSORT,U,3),":")="D":BPDIV(BPDIV),1:0) "RTN","BPSRPT9A",145,0) . . . Q:((SSRT="")!(PSRT="")!(TSRT="")) "RTN","BPSRPT9A",146,0) . . . S BPARR(PSRT,SSRT,TSRT,CNT)=BPDIV(BPDIV)_U_ARR(52,RXI,.01,"E")_U_RXF_U_$$FMTE^XLFDT(RXFDT,"2D")_U_$E(ARR(52,RXI,2,"E"),1,20)_U_$$SSN4^BPSRPT6(DFN) "RTN","BPSRPT9A",147,0) . . . I $D(BPINS(DFN,1)) S BPARR(PSRT,SSRT,TSRT,CNT,"INS",1)=BPINS(DFN,1) "RTN","BPSRPT9A",148,0) . . . I $D(BPINS(DFN,2)) S BPARR(PSRT,SSRT,TSRT,CNT,"INS",2)=BPINS(DFN,2) "RTN","BPSRPT9A",149,0) . . . S BPARR(PSRT,SSRT,TSRT,CNT,"ELIG")=BPELIG(1) "RTN","BPSRPT9A",150,0) K @REF,REF "RTN","BPSRPT9A",151,0) I $D(BPARR) S BPARR(0)=CNT "RTN","BPSRPT9A",152,0) Q "RTN","BPSRPT9A",153,0) ; "RTN","BPSRPT9A",154,0) GATHER(SDT,EDT) ; Gather cases where we have closed ECME primary claims and available secondary insurance "RTN","BPSRPT9A",155,0) ; Input: SDT - FileMan start date "RTN","BPSRPT9A",156,0) ; EDT - FileMan end date "RTN","BPSRPT9A",157,0) ; "RTN","BPSRPT9A",158,0) N SDTYMD,EDTYMD,BPDOS,BP02,BP59,BPST0,BPST1,DFN,BPDTFD,RXIEN,RXFIL,IBINS,IBRET,BPRX,BPSPINS,CNT "RTN","BPSRPT9A",159,0) S SDTYMD=$$FM2YMD^BPSSCR04(SDT) I 'SDTYMD S SDTYMD=0 ; start date in YMD format "RTN","BPSRPT9A",160,0) S EDTYMD=$$FM2YMD^BPSSCR04(EDT) I 'EDTYMD S EDTYMD=99999999 ; end date in YMD format "RTN","BPSRPT9A",161,0) S BPDOS=$O(^BPSC("AF",SDTYMD),-1) F S BPDOS=$O(^BPSC("AF",BPDOS)) Q:'BPDOS!(BPDOS>EDTYMD) D "RTN","BPSRPT9A",162,0) . S BP02=0 F S BP02=$O(^BPSC("AF",BPDOS,BP02)) Q:'BP02 D "RTN","BPSRPT9A",163,0) .. S BP59=+$O(^BPST("AE",BP02,0)) Q:'BP59 "RTN","BPSRPT9A",164,0) .. S BPST0=$G(^BPST(BP59,0)) "RTN","BPSRPT9A",165,0) .. S BPST1=$G(^BPST(BP59,1)) "RTN","BPSRPT9A",166,0) .. I $P(BPST0,U,14)'=1 Q ; looking for primary claims "RTN","BPSRPT9A",167,0) .. I '$$CLOSED02^BPSSCR03(BP02) Q ; looking for closed claims "RTN","BPSRPT9A",168,0) .. S DFN=+$P(BPST0,U,6) "RTN","BPSRPT9A",169,0) .. S BPDTFD=$$YMD2FM^BPSSCR04(BPDOS) ; FM date of service "RTN","BPSRPT9A",170,0) .. ; "RTN","BPSRPT9A",171,0) .. ; make sure the Rx is released "RTN","BPSRPT9A",172,0) .. S RXIEN=+$P(BPST1,U,11) "RTN","BPSRPT9A",173,0) .. S RXFIL=+$P(BPST1,U,1) "RTN","BPSRPT9A",174,0) .. I '$$RELDATE^BPSBCKJ(RXIEN,RXFIL) Q "RTN","BPSRPT9A",175,0) .. ; "RTN","BPSRPT9A",176,0) .. ; check insurances for this patient on this date "RTN","BPSRPT9A",177,0) .. K IBINS "RTN","BPSRPT9A",178,0) .. S IBRET=$$INSUR^IBBAPI(DFN,BPDTFD,"P",.IBINS,"1,2,7") "RTN","BPSRPT9A",179,0) .. I '$D(IBINS("IBBAPI","INSUR",2)) Q ; do not have at least 2 Rx policies so get out "RTN","BPSRPT9A",180,0) .. ; "RTN","BPSRPT9A",181,0) .. ; save this entry in the scratch global "RTN","BPSRPT9A",182,0) .. S BPRX=$$RXAPI1^BPSUTIL1(RXIEN,.01,"I") ; ext Rx# "RTN","BPSRPT9A",183,0) .. S BPSPINS=$$INSNAME^BPSSCRU6(BP59) ; ins co name "RTN","BPSRPT9A",184,0) .. S CNT=$O(^TMP("BPSRPT9A",$J,""),-1)+1 "RTN","BPSRPT9A",185,0) .. S ^TMP("BPSRPT9A",$J,CNT)=RXIEN_U_BPRX_U_RXFIL_U_"(P) Rej"_U_DFN_U_BPDTFD_U_BPSPINS_U_0_U_0 "RTN","BPSRPT9A",186,0) .. M ^TMP("BPSRPT9A",$J,CNT)=IBINS("IBBAPI","INSUR") "RTN","BPSRPT9A",187,0) .. Q "RTN","BPSRPT9A",188,0) . Q "RTN","BPSRPT9A",189,0) GATHERX ; "RTN","BPSRPT9A",190,0) Q "RTN","BPSRPT9A",191,0) ; "RTN","BPSRPT9A",192,0) INP(BPRXN,BPRFL) ; Is this an inpatient, NON-BILLABLE Rx as of the Release Date? "RTN","BPSRPT9A",193,0) N INP,VAHOW,VAROOT,BPRXIN,VAIP,BPRXREL,BPMW "RTN","BPSRPT9A",194,0) S INP=0 "RTN","BPSRPT9A",195,0) ; "RTN","BPSRPT9A",196,0) S VAROOT="BPRXIN" "RTN","BPSRPT9A",197,0) S BPRXREL=$$RELDATE^BPSBCKJ(BPRXN,BPRFL)\1 ; release date "RTN","BPSRPT9A",198,0) I 'BPRXREL S BPRXREL=DT "RTN","BPSRPT9A",199,0) S VAIP("D")=BPRXREL ; if pt was an inpatient at any time during this day "RTN","BPSRPT9A",200,0) D IN5^VADPT ; DBIA 10061 - inpatient episode API "RTN","BPSRPT9A",201,0) I '$G(BPRXIN(1)) G INPX ; not an inpatient on this day "RTN","BPSRPT9A",202,0) ; "RTN","BPSRPT9A",203,0) ; check Rx release date = discharge date. This is billable so get out (esg 9/13/10) "RTN","BPSRPT9A",204,0) I BPRXREL=(+$G(BPRXIN(17,1))\1) G INPX "RTN","BPSRPT9A",205,0) ; "RTN","BPSRPT9A",206,0) ; if Rx/fill is MAIL, then this is billable so get out (esg 9/13/10) "RTN","BPSRPT9A",207,0) I BPRFL S BPMW=$$REFAPI1^BPSUTIL1(BPRXN,BPRFL,2,"I") ; 52.1,2 MAIL/WINDOW field "RTN","BPSRPT9A",208,0) I 'BPRFL S BPMW=$$RXAPI1^BPSUTIL1(BPRXN,11,"I") ; 52,11 MAIL/WINDOW field "RTN","BPSRPT9A",209,0) I BPMW="M" G INPX "RTN","BPSRPT9A",210,0) ; "RTN","BPSRPT9A",211,0) ; inpatient and non-billable "RTN","BPSRPT9A",212,0) S INP=1 "RTN","BPSRPT9A",213,0) INPX ; "RTN","BPSRPT9A",214,0) Q INP "RTN","BPSRPT9A",215,0) ; "RTN","BPSSCRLG") 0^3^B241284581 "RTN","BPSSCRLG",1,0) BPSSCRLG ;BHAM ISC/SS - ECME LOGINFO ;05-APR-05 "RTN","BPSSCRLG",2,0) ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10,11,15,18**;JUN 2004;Build 31 "RTN","BPSSCRLG",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","BPSSCRLG",4,0) ; "RTN","BPSSCRLG",5,0) Q "RTN","BPSSCRLG",6,0) ; "RTN","BPSSCRLG",7,0) EN ; -- main entry point for BPS LSTMN LOG "RTN","BPSSCRLG",8,0) D EN^VALM("BPS LSTMN LOG") "RTN","BPSSCRLG",9,0) Q "RTN","BPSSCRLG",10,0) ; "RTN","BPSSCRLG",11,0) HDR ; -- header code "RTN","BPSSCRLG",12,0) S VALMHDR(1)="Claim Log information" "RTN","BPSSCRLG",13,0) S VALMHDR(2)="" "RTN","BPSSCRLG",14,0) Q "RTN","BPSSCRLG",15,0) ; "RTN","BPSSCRLG",16,0) INIT ; -- init variables and list array "RTN","BPSSCRLG",17,0) N BPSELCLM,LINE "RTN","BPSSCRLG",18,0) S BPSELCLM=$G(@VALMAR@("SELLN")) "RTN","BPSSCRLG",19,0) ; piece 2: patient ien #2 "RTN","BPSSCRLG",20,0) ; piece 3: insurance ien #36 "RTN","BPSSCRLG",21,0) ; piece 4: ptr to #9002313.59 "RTN","BPSSCRLG",22,0) S LINE=1 "RTN","BPSSCRLG",23,0) S VALMCNT=$$PREPINFO(.LINE,$P(BPSELCLM,U,2),$P(BPSELCLM,U,3),$P(BPSELCLM,U,4)) "RTN","BPSSCRLG",24,0) S:VALMCNT>1 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,BPNFLDT "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,"Created on: "_$$CREATEDT(BPIEN02,BPSDTALT)) "RTN","BPSSCRLG",145,0) D SETLINE(.BPLN,"VA Claim ID: "_$P($G(^BPSC(+BPIEN02,0)),U,1)) "RTN","BPSSCRLG",146,0) D SETLINE(.BPLN,"Submitted By: "_$$SUBMTBY(BP57)) "RTN","BPSSCRLG",147,0) D SETLINE(.BPLN,"Transaction Type: "_$$TRTYPE^BPSSCRU5($$TRCODE(BPIEN02))) "RTN","BPSSCRLG",148,0) D SETLINE(.BPLN,"Date of Service: "_$$DOSCLM(BPIEN02)) "RTN","BPSSCRLG",149,0) ;Display Next Available Fill Date - BPS*1.0*15 "RTN","BPSSCRLG",150,0) S BPNFLDT=$$NFLDT^BPSBUTL(BPRXIEN,BPREF,$$RXCOB57(BP57)) "RTN","BPSSCRLG",151,0) D:BPNFLDT SETLINE(.BPLN,"Next Available Fill Date: "_$$FMTE^XLFDT(BPNFLDT,"2ZM")) "RTN","BPSSCRLG",152,0) D SETLINE(.BPLN,"NDC Code: "_$$LNDC^BPSSCRU5(BPIEN02)) "RTN","BPSSCRLG",153,0) D SETLINE(.BPLN,"NCPDP Qty: "_$$QTY(BPIEN02)_" "_$$UNITS(BPIEN02)) "RTN","BPSSCRLG",154,0) D SETLINE(.BPLN,"Days Supply: "_$$DAYSSUPL(BPIEN02)) "RTN","BPSSCRLG",155,0) D SETLINE(.BPLN,"Division: "_$$DIV(BP57)) "RTN","BPSSCRLG",156,0) D SETLINE(.BPLN,"NPI#: "_$$NPI(BPIEN02)) "RTN","BPSSCRLG",157,0) D SETLINE(.BPLN,"ECME Pharmacy: "_$$DIVNAME^BPSSCRDS($$LDIV(BP57))) "RTN","BPSSCRLG",158,0) S BPX="Billed Qty: "_$$BILLQTY(BP57)_" "_$$BILLUNT(BP57) "RTN","BPSSCRLG",159,0) S BPX=BPX_" Unit Cost: "_$$UNTPRICE(BP57) "RTN","BPSSCRLG",160,0) S BPX=BPX_" Gross Amt Due: "_$$TOTPRICE(BPIEN02) "RTN","BPSSCRLG",161,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",162,0) S BPX="Ingredient Cost: "_$$INGRCST(BPIEN02) "RTN","BPSSCRLG",163,0) S BPX=BPX_" Dispensing Fee: "_$$DISPFEE(BPIEN02) "RTN","BPSSCRLG",164,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",165,0) S BPX="U&C Charge: "_$$UCCHRG(BPIEN02) "RTN","BPSSCRLG",166,0) S BPX=BPX_" Admin Fee: "_$$ADMNFEE(BPIEN02) "RTN","BPSSCRLG",167,0) D SETLINE(.BPLN,BPX) "RTN","BPSSCRLG",168,0) D SETLINE(.BPLN,"") "RTN","BPSSCRLG",169,0) D SETLINE(.BPLN,"Insurance Name: "_$$INSUR57(BP57)) "RTN","BPSSCRLG",170,0) D SETLINE(.BPLN,"Group Name: "_$$GRPNM(BPIEN02)) "RTN","BPSSCRLG",171,0) D SETLINE(.BPLN,"Rx Coordination of Benefits: "_$$RXCOB57(BP57)) "RTN","BPSSCRLG",172,0) D SETLINE(.BPLN,"Pharmacy Plan ID: "_$$PHPLANID(BP57)) "RTN","BPSSCRLG",173,0) D SETLINE(.BPLN,"BIN: "_$$BIN(BPIEN02)) "RTN","BPSSCRLG",174,0) D SETLINE(.BPLN,"PCN: "_$$PCN(BPIEN02)) "RTN","BPSSCRLG",175,0) D SETLINE(.BPLN,"NCPDP Version: "_$$GETVER(BPIEN02)) "RTN","BPSSCRLG",176,0) D SETLINE(.BPLN,"Group ID: "_$$GRPID(BPIEN02)) "RTN","BPSSCRLG",177,0) D SETLINE(.BPLN,"Cardholder ID: "_$$CRDHLDID(BPIEN02)) "RTN","BPSSCRLG",178,0) D SETLINE(.BPLN,"Patient Relationship Code: "_$$PATRELSH(BPIEN02)) "RTN","BPSSCRLG",179,0) D SETLINE(.BPLN,"Cardholder First Name: "_$$CRDHLDFN(BPIEN02,BP57)) "RTN","BPSSCRLG",180,0) D SETLINE(.BPLN,"Cardholder Last Name: "_$$CRDHLDLN(BPIEN02,BP57)) "RTN","BPSSCRLG",181,0) F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"") "RTN","BPSSCRLG",182,0) S BPLN0=BPLN "RTN","BPSSCRLG",183,0) D SETLINE(.BPLN,"Billing Request Payer Sheet: "_$$B1PYRIEN^BPSSCRU5(BP57)) "RTN","BPSSCRLG",184,0) D SETLINE(.BPLN,"Reversal Payer Sheet: "_$$B2PYRIEN^BPSSCRU5(BP57)) "RTN","BPSSCRLG",185,0) D SETLINE(.BPLN,"") "RTN","BPSSCRLG",186,0) Q "RTN","BPSSCRLG",187,0) ;Submitted By User "RTN","BPSSCRLG",188,0) SUBMTBY(BP57) ; "RTN","BPSSCRLG",189,0) N BPIEN,BPUSR "RTN","BPSSCRLG",190,0) S BPIEN=$P($G(^BPSTL(BP57,0)),U,10) "RTN","BPSSCRLG",191,0) S BPUSR=$$GETUSRNM^BPSSCRU1(BPIEN) "RTN","BPSSCRLG",192,0) Q $S(BPUSR']"":"UNKNOWN",1:BPUSR) "RTN","BPSSCRLG",193,0) ;Date of service "RTN","BPSSCRLG",194,0) DOSCLM(BPIEN02) ; "RTN","BPSSCRLG",195,0) N BPDT "RTN","BPSSCRLG",196,0) S BPDT=$P($G(^BPSC(BPIEN02,401)),U,1)\1 "RTN","BPSSCRLG",197,0) Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4) "RTN","BPSSCRLG",198,0) ;Create date "RTN","BPSSCRLG",199,0) CREATEDT(BPIEN02,BPSDTALT) ; "RTN","BPSSCRLG",200,0) N BPSDT "RTN","BPSSCRLG",201,0) S BPSDT=+$P($G(^BPSC(BPIEN02,0)),U,6) "RTN","BPSSCRLG",202,0) Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT)) "RTN","BPSSCRLG",203,0) ;Plan ID "RTN","BPSSCRLG",204,0) PLANID(BP57) ; "RTN","BPSSCRLG",205,0) Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,1) "RTN","BPSSCRLG",206,0) CERTMOD(BP57) ; "RTN","BPSSCRLG",207,0) Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,5) "RTN","BPSSCRLG",208,0) ;Software Vendor/Cert ID "RTN","BPSSCRLG",209,0) CERTIEN(BP57) ; "RTN","BPSSCRLG",210,0) Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,6) "RTN","BPSSCRLG",211,0) ;Division "RTN","BPSSCRLG",212,0) DIV(BP57) ; "RTN","BPSSCRLG",213,0) Q $$GET1^DIQ(9002313.57,BP57_",",11) "RTN","BPSSCRLG",214,0) ;NPI "RTN","BPSSCRLG",215,0) NPI(BPIEN02) ; "RTN","BPSSCRLG",216,0) Q $$GET1^DIQ(9002313.02,BPIEN02_",",201) "RTN","BPSSCRLG",217,0) ;group ID "RTN","BPSSCRLG",218,0) GRPID(BPIEN02) ; "RTN","BPSSCRLG",219,0) Q $E($P($G(^BPSC(BPIEN02,300)),U,1),3,99) "RTN","BPSSCRLG",220,0) ;Group Name "RTN","BPSSCRLG",221,0) GRPNM(BPSIEN02) ; "RTN","BPSSCRLG",222,0) N BPSGPN "RTN","BPSSCRLG",223,0) S BPSGPN=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),3)),U,1) "RTN","BPSSCRLG",224,0) Q BPSGPN "RTN","BPSSCRLG",225,0) ;Cardholder ID "RTN","BPSSCRLG",226,0) CRDHLDID(BPIEN02) ; "RTN","BPSSCRLG",227,0) Q $E($P($G(^BPSC(BPIEN02,300)),U,2),3,99) "RTN","BPSSCRLG",228,0) ;Cardholder First name "RTN","BPSSCRLG",229,0) CRDHLDFN(BPIEN02,BP57) ; "RTN","BPSSCRLG",230,0) N Y "RTN","BPSSCRLG",231,0) S Y=$E($P($G(^BPSC(BPIEN02,300)),U,12),3,99) "RTN","BPSSCRLG",232,0) I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,6) "RTN","BPSSCRLG",233,0) Q Y "RTN","BPSSCRLG",234,0) ;Cardholder Last Name "RTN","BPSSCRLG",235,0) CRDHLDLN(BPIEN02,BP57) ; "RTN","BPSSCRLG",236,0) N Y "RTN","BPSSCRLG",237,0) S Y=$E($P($G(^BPSC(BPIEN02,300)),U,13),3,99) "RTN","BPSSCRLG",238,0) I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,7) "RTN","BPSSCRLG",239,0) Q Y "RTN","BPSSCRLG",240,0) ;Patient Relationship Code "RTN","BPSSCRLG",241,0) PATRELSH(BPIEN02) ; "RTN","BPSSCRLG",242,0) N Y "RTN","BPSSCRLG",243,0) S Y=$E($P($G(^BPSC(BPIEN02,300)),U,6),3,99) "RTN","BPSSCRLG",244,0) Q $S(Y=0:"NOT SPECIFIED",Y=1:"CARDHOLDER",Y=2:"SPOUSE",Y=3:"CHILD",Y=4:"OTHER",1:Y) "RTN","BPSSCRLG",245,0) PCN(BPIEN02) ; "RTN","BPSSCRLG",246,0) Q $P($G(^BPSC(BPIEN02,100)),U,4) "RTN","BPSSCRLG",247,0) ; Get the Payer Sheet Version Number. "RTN","BPSSCRLG",248,0) GETVER(BPIEN02) ; "RTN","BPSSCRLG",249,0) N BPSVER "RTN","BPSSCRLG",250,0) S BPSVER=$P($G(^BPSC(BPIEN02,100)),U,2) "RTN","BPSSCRLG",251,0) I $G(BPSVER)]"" S BPSVER=$E(BPSVER,1)_"."_$E(BPSVER,2,99) "RTN","BPSSCRLG",252,0) Q BPSVER "RTN","BPSSCRLG",253,0) BIN(BPIEN02) ; "RTN","BPSSCRLG",254,0) Q $P($G(^BPSC(BPIEN02,100)),U,1) "RTN","BPSSCRLG",255,0) ;insurance name by 9002313.57 pointer "RTN","BPSSCRLG",256,0) INSUR57(BPIEN57) ; "RTN","BPSSCRLG",257,0) N BPINSN "RTN","BPSSCRLG",258,0) S BPINSN=+$G(^BPSTL(BPIEN57,9)) "RTN","BPSSCRLG",259,0) Q $P($G(^BPSTL(BPIEN57,10,BPINSN,0)),U,7) "RTN","BPSSCRLG",260,0) ; "RTN","BPSSCRLG",261,0) PHPLANID(BPIEN57) ; Get the Pharmacy Plan ID from the BPS Log of Transactions file "RTN","BPSSCRLG",262,0) ; Input - BPSIEN57: IEN from the BPS Log of Transactions file. "RTN","BPSSCRLG",263,0) I '$G(BPIEN57) Q "" "RTN","BPSSCRLG",264,0) N BPINSN "RTN","BPSSCRLG",265,0) S BPINSN=+$G(^BPSTL(BPIEN57,9)) "RTN","BPSSCRLG",266,0) Q $P($G(^BPSTL(BPIEN57,10,BPINSN,3)),U,3) "RTN","BPSSCRLG",267,0) ; "RTN","BPSSCRLG",268,0) QTY(BPIEN02) ; "RTN","BPSSCRLG",269,0) Q $E($P($G(^BPSC(BPIEN02,400,1,440)),U,2),3,99)/1000 "RTN","BPSSCRLG",270,0) ;NCPDP Units "RTN","BPSSCRLG",271,0) UNITS(BPIEN02) ; "RTN","BPSSCRLG",272,0) I $G(BPIEN02)="" Q "( )" "RTN","BPSSCRLG",273,0) N X "RTN","BPSSCRLG",274,0) S X=$E($P($G(^BPSC(BPIEN02,400,1,600)),U,1),3,99) "RTN","BPSSCRLG",275,0) Q $S(X="":"( )",1:"("_X_")") "RTN","BPSSCRLG",276,0) UNTPRICE(BPIEN57) ; "RTN","BPSSCRLG",277,0) I $G(BPIEN57)="" Q "" "RTN","BPSSCRLG",278,0) Q +$P($G(^BPSTL(BPIEN57,5)),U,2) "RTN","BPSSCRLG",279,0) TOTPRICE(BPIEN02) ; "RTN","BPSSCRLG",280,0) I $G(BPIEN02)="" Q "" "RTN","BPSSCRLG",281,0) N X "RTN","BPSSCRLG",282,0) S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,30),3,99) "RTN","BPSSCRLG",283,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",284,0) BILLQTY(BPIEN57) ; "RTN","BPSSCRLG",285,0) Q $P($G(^BPSTL(BPIEN57,5)),U,9) "RTN","BPSSCRLG",286,0) BILLUNT(BPIEN57) ; "RTN","BPSSCRLG",287,0) I $G(BPIEN57)="" Q "( )" "RTN","BPSSCRLG",288,0) N X "RTN","BPSSCRLG",289,0) S X=$P($G(^BPSTL(BPIEN57,5)),U,10) "RTN","BPSSCRLG",290,0) Q $S(X="":"( )",1:"("_X_")") "RTN","BPSSCRLG",291,0) ;Ingredient Cost "RTN","BPSSCRLG",292,0) INGRCST(BPIEN02) ; "RTN","BPSSCRLG",293,0) I $G(BPIEN02)="" Q "" "RTN","BPSSCRLG",294,0) N X "RTN","BPSSCRLG",295,0) S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,9),3,99) "RTN","BPSSCRLG",296,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",297,0) ;Dispensing Fee Submitted "RTN","BPSSCRLG",298,0) DISPFEE(BPIEN02) ; "RTN","BPSSCRLG",299,0) I $G(BPIEN02)="" Q "" "RTN","BPSSCRLG",300,0) N X "RTN","BPSSCRLG",301,0) S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,12),3,99) "RTN","BPSSCRLG",302,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",303,0) ;U&C Charge "RTN","BPSSCRLG",304,0) UCCHRG(BPIEN02) ; "RTN","BPSSCRLG",305,0) I $G(BPIEN02)="" Q "" "RTN","BPSSCRLG",306,0) N X "RTN","BPSSCRLG",307,0) S X=$E($P($G(^BPSC(BPIEN02,400,1,400)),U,26),3,99) "RTN","BPSSCRLG",308,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",309,0) ;Admin Fee "RTN","BPSSCRLG",310,0) ADMNFEE(BPIEN02) ; "RTN","BPSSCRLG",311,0) I $G(BPIEN02)="" Q "" "RTN","BPSSCRLG",312,0) N CNT,X,AF "RTN","BPSSCRLG",313,0) S AF="",CNT=0 F S CNT=$O(^BPSC(BPIEN02,400,1,478.01,CNT)) Q:'CNT D "RTN","BPSSCRLG",314,0) . S X=$G(^BPSC(BPIEN02,400,1,478.01,CNT,0)) "RTN","BPSSCRLG",315,0) . I +$E($P(X,U,2),3,4)=4 S AF=AF+$$DFF2EXT^BPSECFM($E($P(X,U,3),3,10)) "RTN","BPSSCRLG",316,0) Q $S(AF="":AF,1:$J(AF,0,2)) "RTN","BPSSCRLG",317,0) ;get ECME pharmacy division ptr for LOG "RTN","BPSSCRLG",318,0) LDIV(BPIEN57) ; "RTN","BPSSCRLG",319,0) Q +$P($G(^BPSTL(BPIEN57,1)),U,7) "RTN","BPSSCRLG",320,0) ;transaction code "RTN","BPSSCRLG",321,0) TRCODE(BPIEN02) ; "RTN","BPSSCRLG",322,0) Q $P($G(^BPSC(BPIEN02,100)),U,3) "RTN","BPSSCRLG",323,0) ;days supply "RTN","BPSSCRLG",324,0) DAYSSUPL(BPIEN02) ; "RTN","BPSSCRLG",325,0) ;format D5NNN -> NNN "RTN","BPSSCRLG",326,0) Q +$E($P($G(^BPSC(BPIEN02,400,1,400)),U,5),3,99) "RTN","BPSSCRLG",327,0) ; "RTN","BPSSCRLG",328,0) ;display response record "RTN","BPSSCRLG",329,0) DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ; "RTN","BPSSCRLG",330,0) N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17) "RTN","BPSSCRLG",331,0) N BPX,BPLN0,BPCNT,BPRJCDS,BPRJ,BPSTR1,BPSTYP2,BDUR,BMSG,PTRESP "RTN","BPSSCRLG",332,0) S BPLN0=BPLN "RTN","BPSSCRLG",333,0) S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"") "RTN","BPSSCRLG",334,0) S BPSTR1="Response Information ("_BPSTYP2_")(#"_BPIEN03_")" "RTN","BPSSCRLG",335,0) D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-")) "RTN","BPSSCRLG",336,0) D SETLINE(.BPLN,"Response Received: "_$$RESPREC(BPIEN03,BPSDTALT)) "RTN","BPSSCRLG",337,0) D SETLINE(.BPLN,"Date of Service: "_$$DOSRSP(BPIEN03)) "RTN","BPSSCRLG",338,0) D SETLINE(.BPLN,"Transaction Response Status: "_$$RESPSTAT^BPSSCRU5(BPIEN03)) "RTN","BPSSCRLG",339,0) D SETLINE(.BPLN,"Total Amount Paid: $"_$$TOTAMNT(BPIEN03)) "RTN","BPSSCRLG",340,0) D SETLINE(.BPLN,"Ingredient Cost Paid: $"_$$ICPAID(BPIEN03)_" Dispensing Fee Paid: $"_$$DFPAID(BPIEN03)) "RTN","BPSSCRLG",341,0) S PTRESP=$$PTRESP(BPIEN03) S PTRESP=$S(PTRESP="":"$",PTRESP="0.00":"$0",1:"($"_PTRESP_")") "RTN","BPSSCRLG",342,0) D SETLINE(.BPLN,"Patient Resp (INS): "_PTRESP) "RTN","BPSSCRLG",343,0) D SETLINE(.BPLN,"Reject code(s): ") "RTN","BPSSCRLG",344,0) D REJCODES^BPSSCRU5(BPIEN03,.BPRJCDS) "RTN","BPSSCRLG",345,0) S BPRJ="" "RTN","BPSSCRLG",346,0) F S BPRJ=$O(BPRJCDS(BPRJ)) Q:BPRJ="" D "RTN","BPSSCRLG",347,0) . D SETLINE(.BPLN," "_$$GETRJNAM^BPSSCRU3(BPRJ)) "RTN","BPSSCRLG",348,0) D WRAPLN^BPSSCRU5(.BPLN,$$MESSAGE(BPIEN03),76,"Payer Message: ",5) "RTN","BPSSCRLG",349,0) D ADDMESS(BPIEN03,1,.BPADDMSG) "RTN","BPSSCRLG",350,0) S BMSG="" F S BMSG=$O(BPADDMSG(BMSG)) Q:BMSG="" D "RTN","BPSSCRLG",351,0) . D WRAPLN^BPSSCRU5(.BPLN,BPADDMSG(BMSG),76,$S(BMSG=1:"Payer Additional Message: ",1:" "),5) "RTN","BPSSCRLG",352,0) D SETLINE(.BPLN,"Reason for Service Code: "_$$DURREAS(BPIEN03)) "RTN","BPSSCRLG",353,0) D SETLINE(.BPLN,"DUR Text: "_$$DURTEXT(BPIEN03)) "RTN","BPSSCRLG",354,0) D WRAPLN^BPSSCRU5(.BPLN,$$DURADD(BPIEN03),76,"DUR Additional Text: ",5) "RTN","BPSSCRLG",355,0) ; BPS*1*18: Print Claim Log [BPS PRTCL USRSCR CLAIM LOG] (when included in the incoming response) "RTN","BPSSCRLG",356,0) D SETLINE(.BPLN,"HPID/OEID: "_$$HPID(BPIEN03,BP57)) "RTN","BPSSCRLG",357,0) F BPCNT=1:1:2 D SETLINE(.BPLN,"") "RTN","BPSSCRLG",358,0) Q "RTN","BPSSCRLG",359,0) ; "RTN","BPSSCRLG",360,0) RESPREC(BPIEN03,BPSDTALT) ; "RTN","BPSSCRLG",361,0) N BPSDT "RTN","BPSSCRLG",362,0) S BPSDT=+$P($G(^BPSR(BPIEN03,0)),U,2) "RTN","BPSSCRLG",363,0) Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT)) "RTN","BPSSCRLG",364,0) ; "RTN","BPSSCRLG",365,0) DOSRSP(BPIEN03) ; "RTN","BPSSCRLG",366,0) N BPDT "RTN","BPSSCRLG",367,0) S BPDT=$P($G(^BPSR(BPIEN03,400)),U,1)\1 "RTN","BPSSCRLG",368,0) Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4) "RTN","BPSSCRLG",369,0) ; "RTN","BPSSCRLG",370,0) TOTAMNT(BPIEN03) ; "RTN","BPSSCRLG",371,0) I $G(BPIEN03)="" Q "" "RTN","BPSSCRLG",372,0) N X "RTN","BPSSCRLG",373,0) S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,9) "RTN","BPSSCRLG",374,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",375,0) ; "RTN","BPSSCRLG",376,0) ICPAID(BPIEN03) ;Ingredient Cost Paid "RTN","BPSSCRLG",377,0) I $G(BPIEN03)="" Q "" "RTN","BPSSCRLG",378,0) N X "RTN","BPSSCRLG",379,0) S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,6) "RTN","BPSSCRLG",380,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",381,0) ; "RTN","BPSSCRLG",382,0) DFPAID(BPIEN03) ;Dispensing Fee Paid "RTN","BPSSCRLG",383,0) I $G(BPIEN03)="" Q "" "RTN","BPSSCRLG",384,0) N X "RTN","BPSSCRLG",385,0) S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,7) "RTN","BPSSCRLG",386,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",387,0) ; "RTN","BPSSCRLG",388,0) PTRESP(BPIEN03) ;Patient Responsibility "RTN","BPSSCRLG",389,0) I $G(BPIEN03)="" Q "" "RTN","BPSSCRLG",390,0) N X "RTN","BPSSCRLG",391,0) S X=$P($G(^BPSR(BPIEN03,1000,1,500)),U,5) "RTN","BPSSCRLG",392,0) Q $S(X="":X,1:$$DFF2EXT^BPSECFM(X)) "RTN","BPSSCRLG",393,0) ; "RTN","BPSSCRLG",394,0) MESSAGE(BPIEN03) ; "RTN","BPSSCRLG",395,0) Q $P($G(^BPSR(BPIEN03,504)),U) "RTN","BPSSCRLG",396,0) ; "RTN","BPSSCRLG",397,0) ADDMESS(BPIEN03,POS,BPADDMSG) ; "RTN","BPSSCRLG",398,0) N ADM,X,QUA,TXT,CON,BPMTMP,L,NEXT "RTN","BPSSCRLG",399,0) K BPMTMP,BPADDMSG "RTN","BPSSCRLG",400,0) I '$G(BPIEN03) Q "RTN","BPSSCRLG",401,0) I '$G(POS) S POS=1 "RTN","BPSSCRLG",402,0) S (ADM,L)=0 F S ADM=$O(^BPSR(BPIEN03,1000,POS,130.01,ADM)) Q:'ADM D "RTN","BPSSCRLG",403,0) . S X=$G(^BPSR(BPIEN03,1000,POS,130.01,ADM,0)) "RTN","BPSSCRLG",404,0) . S TXT=$P($G(^BPSR(BPIEN03,1000,POS,130.01,ADM,1)),U,1) "RTN","BPSSCRLG",405,0) . S QUA=$P(X,U,3),CON=$P(X,U,2) "RTN","BPSSCRLG",406,0) . ; This should not happen, but if the qualifier is null, set it "RTN","BPSSCRLG",407,0) . ; to "Z"_concatenated with a unique number so that it follows the "RTN","BPSSCRLG",408,0) . ; other qualifiers. Per the D0 standard, qualifiers can be 1-9 and "RTN","BPSSCRLG",409,0) . ; A-Z. ECL limits this to 1-9 but an future ECL may extend this. "RTN","BPSSCRLG",410,0) . I QUA="" S L=L+1,QUA="Z"_L "RTN","BPSSCRLG",411,0) . S BPMTMP(QUA)=CON_U_TXT "RTN","BPSSCRLG",412,0) I '$D(BPMTMP) Q "RTN","BPSSCRLG",413,0) S L=0,(QUA,NEXT)="" F S QUA=$O(BPMTMP(QUA)) Q:QUA="" D "RTN","BPSSCRLG",414,0) . S CON=$P(BPMTMP(QUA),U,1),TXT=$P(BPMTMP(QUA),U,2) "RTN","BPSSCRLG",415,0) . I NEXT="+" S BPADDMSG(L)=BPADDMSG(L)_TXT,NEXT=CON Q "RTN","BPSSCRLG",416,0) . S L=L+1,BPADDMSG(L)=TXT,NEXT=CON "RTN","BPSSCRLG",417,0) Q "RTN","BPSSCRLG",418,0) ; "RTN","BPSSCRLG",419,0) DURTEXT(BPIEN03) ; "RTN","BPSSCRLG",420,0) ; DUR FREE TEXT MESSAGE from first instance of DUR PPS RESPONSE "RTN","BPSSCRLG",421,0) Q $P($G(^BPSR(BPIEN03,1000,1,567.01,1,0)),U,9) "RTN","BPSSCRLG",422,0) ; "RTN","BPSSCRLG",423,0) DURREAS(BPIEN03) ; "RTN","BPSSCRLG",424,0) ; REASON FOR SERVICE CODE from first instance of DUR PPS RESPONSE "RTN","BPSSCRLG",425,0) Q $$GET1^DIQ(9002313.1101,"1,1,"_BPIEN03_",",439) "RTN","BPSSCRLG",426,0) ; "RTN","BPSSCRLG",427,0) DURADD(BPIEN03) ; "RTN","BPSSCRLG",428,0) ; DUR ADDITIONAL TEXT from first instance of DUR PPS RESPONSE "RTN","BPSSCRLG",429,0) Q $P($G(^BPSR(BPIEN03,1000,1,567.01,1,1)),U) "RTN","BPSSCRLG",430,0) ; "RTN","BPSSCRLG",431,0) ;Payer HPID from response ***BPS*1*18 IB ICR #6061 "RTN","BPSSCRLG",432,0) HPID(BPIEN03,BP57) ; "RTN","BPSSCRLG",433,0) N BPHPD "RTN","BPSSCRLG",434,0) Q:$P($G(^BPSR(BPIEN03,560)),U,8)'="01" "" "RTN","BPSSCRLG",435,0) S BPHPD=$P($G(^BPSR(BPIEN03,560)),U,9) "RTN","BPSSCRLG",436,0) ; 6/25/14 no validation of HPID for this screen "RTN","BPSSCRLG",437,0) ;S:BPHPD'="" BPHPD=BPHPD_$P($$HOD^IBCNHUT1(BPHPD,BP57),U,3) "RTN","BPSSCRLG",438,0) Q BPHPD "RTN","BPSSCRLG",439,0) ; "RTN","BPSSCRLG",440,0) RXCOB57(BPIEN57) ; "RTN","BPSSCRLG",441,0) N BPCOB "RTN","BPSSCRLG",442,0) S BPCOB=+$P($G(^BPSTL(BPIEN57,0)),U,14) "RTN","BPSSCRLG",443,0) Q $S(BPCOB=2:"SECONDARY",BPCOB=3:"TERTIARY",1:"PRIMARY") "RTN","BPSSCRLG",444,0) ; "RTN","BPSSCRLG",445,0) ;Display other payer(s) "RTN","BPSSCRLG",446,0) DISPPYR(BPLN,BPIEN03) ; "RTN","BPSSCRLG",447,0) N PYR,PYRDATA,BPSTR1 "RTN","BPSSCRLG",448,0) S PYR=0 F S PYR=$O(^BPSR(BPIEN03,1000,1,355.01,PYR)) Q:'PYR D "RTN","BPSSCRLG",449,0) . S PYRDATA=^BPSR(BPIEN03,1000,1,355.01,PYR,1) "RTN","BPSSCRLG",450,0) . S BPSTR1="Other Payer Information ("_PYR_")(#"_BPIEN03_")" "RTN","BPSSCRLG",451,0) . D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-")) "RTN","BPSSCRLG",452,0) . D SETLINE(.BPLN,"Other Payer ID Count: "_$$PYRIDCNT(BPIEN03,PYR)) "RTN","BPSSCRLG",453,0) . D SETLINE(.BPLN,"Other Payer ID: "_$P(PYRDATA,U,3)) "RTN","BPSSCRLG",454,0) . D SETLINE(.BPLN,"Other Payer Coverage Type: "_$P(PYRDATA,U,1)) "RTN","BPSSCRLG",455,0) . D SETLINE(.BPLN,"Other Payer ID Qualifier: "_$P(PYRDATA,U,2)) "RTN","BPSSCRLG",456,0) . D SETLINE(.BPLN,"Other Payer Help Desk Phone Number: "_$P(PYRDATA,U,8)) "RTN","BPSSCRLG",457,0) . D SETLINE(.BPLN,"Other Payer Processor Control Number: "_$P(PYRDATA,U,4)) "RTN","BPSSCRLG",458,0) . D SETLINE(.BPLN,"Other Payer Effective Date: "_$P(PYRDATA,U,10)) "RTN","BPSSCRLG",459,0) . D SETLINE(.BPLN,"Other Payer Termination Date: "_$P(PYRDATA,U,11)) "RTN","BPSSCRLG",460,0) . D SETLINE(.BPLN,"Other Payer Person Code: "_$P(PYRDATA,U,7)) "RTN","BPSSCRLG",461,0) . D SETLINE(.BPLN,"Other Payer Patient Relationship Code: "_$P(PYRDATA,U,9)) "RTN","BPSSCRLG",462,0) . D SETLINE(.BPLN,"Other Payer Cardholder ID: "_$P(PYRDATA,U,5)) "RTN","BPSSCRLG",463,0) . D SETLINE(.BPLN,"Other Payer Group ID: "_$P(PYRDATA,U,6)) "RTN","BPSSCRLG",464,0) Q "RTN","BPSSCRLG",465,0) ; "RTN","BPSSCRLG",466,0) PYRIDCNT(BPIEN03,PYR) ; "RTN","BPSSCRLG",467,0) Q $P($G(^BPSR(BPIEN03,1000,1,355.01,PYR,0)),U) "VER") 8.0^22.0 "^DD",9002313.03,9002313.03,568,0) PAYER ID QUALIFIER^S^01:Standard Unique Health Plan Identifier;02:HIN;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) ^.001^1^1^3140610^^^ "^DD",9002313.03,9002313.03,568,21,1,0) Code indicating the type of payer ID. "^DD",9002313.03,9002313.03,568,23,0) ^.001^1^1^3140610^^^ "^DD",9002313.03,9002313.03,568,23,1,0) NCPDP field 568-J7. "^DD",9002313.03,9002313.03,568,"DT") 3140728 **INSTALL NAME** IB*2.0*521 "BLD",9342,0) IB*2.0*521^INTEGRATED BILLING^0^3141216^y "BLD",9342,4,0) ^9.64PA^36^2 "BLD",9342,4,36,0) 36 "BLD",9342,4,36,2,0) ^9.641^36^1 "BLD",9342,4,36,2,36,0) INSURANCE COMPANY (File-top level) "BLD",9342,4,36,2,36,1,0) ^9.6411^8.04^2 "BLD",9342,4,36,2,36,1,8.01,0) HPID/OEID "BLD",9342,4,36,2,36,1,8.04,0) NIF ID "BLD",9342,4,36,222) y^y^p^^^^n^^n "BLD",9342,4,36,224) "BLD",9342,4,361.1,0) 361.1 "BLD",9342,4,361.1,2,0) ^9.641^361.1^1 "BLD",9342,4,361.1,2,361.1,0) EXPLANATION OF BENEFITS (File-top level) "BLD",9342,4,361.1,2,361.1,1,0) ^9.6411^2.06^1 "BLD",9342,4,361.1,2,361.1,1,2.06,0) HPID/OEID "BLD",9342,4,361.1,222) y^y^p^^^^n^^n "BLD",9342,4,361.1,224) "BLD",9342,4,"APDD",36,36) "BLD",9342,4,"APDD",36,36,8.01) "BLD",9342,4,"APDD",36,36,8.04) "BLD",9342,4,"APDD",361.1,361.1) "BLD",9342,4,"APDD",361.1,361.1,2.06) "BLD",9342,4,"B",36,36) "BLD",9342,4,"B",361.1,361.1) "BLD",9342,6.3) 33 "BLD",9342,"ABPKG") n "BLD",9342,"INI") IBY521PR "BLD",9342,"INIT") IBY521PO "BLD",9342,"KRN",0) ^9.67PA^779.2^20 "BLD",9342,"KRN",.4,0) .4 "BLD",9342,"KRN",.401,0) .401 "BLD",9342,"KRN",.402,0) .402 "BLD",9342,"KRN",.403,0) .403 "BLD",9342,"KRN",.5,0) .5 "BLD",9342,"KRN",.84,0) .84 "BLD",9342,"KRN",3.6,0) 3.6 "BLD",9342,"KRN",3.8,0) 3.8 "BLD",9342,"KRN",9.2,0) 9.2 "BLD",9342,"KRN",9.8,0) 9.8 "BLD",9342,"KRN",9.8,"NM",0) ^9.68A^9^9 "BLD",9342,"KRN",9.8,"NM",1,0) IBCEOB00^^0^B90317109 "BLD",9342,"KRN",9.8,"NM",2,0) IBNCPEV^^0^B97561964 "BLD",9342,"KRN",9.8,"NM",3,0) IBJTCA1^^0^B54215341 "BLD",9342,"KRN",9.8,"NM",4,0) IBJTRX^^0^B86052927 "BLD",9342,"KRN",9.8,"NM",5,0) IBCNSGE^^0^B103633903 "BLD",9342,"KRN",9.8,"NM",6,0) IBCNERPD^^0^B67426555 "BLD",9342,"KRN",9.8,"NM",7,0) IBCNHUT1^^0^B19687028 "BLD",9342,"KRN",9.8,"NM",8,0) IBCNHHLO^^0^B11459482 "BLD",9342,"KRN",9.8,"NM",9,0) IBCNERPE^^0^B71200892 "BLD",9342,"KRN",9.8,"NM","B","IBCEOB00",1) "BLD",9342,"KRN",9.8,"NM","B","IBCNERPD",6) "BLD",9342,"KRN",9.8,"NM","B","IBCNERPE",9) "BLD",9342,"KRN",9.8,"NM","B","IBCNHHLO",8) "BLD",9342,"KRN",9.8,"NM","B","IBCNHUT1",7) "BLD",9342,"KRN",9.8,"NM","B","IBCNSGE",5) "BLD",9342,"KRN",9.8,"NM","B","IBJTCA1",3) "BLD",9342,"KRN",9.8,"NM","B","IBJTRX",4) "BLD",9342,"KRN",9.8,"NM","B","IBNCPEV",2) "BLD",9342,"KRN",19,0) 19 "BLD",9342,"KRN",19.1,0) 19.1 "BLD",9342,"KRN",101,0) 101 "BLD",9342,"KRN",409.61,0) 409.61 "BLD",9342,"KRN",771,0) 771 "BLD",9342,"KRN",779.2,0) 779.2 "BLD",9342,"KRN",870,0) 870 "BLD",9342,"KRN",8989.51,0) 8989.51 "BLD",9342,"KRN",8989.52,0) 8989.52 "BLD",9342,"KRN",8994,0) 8994 "BLD",9342,"KRN","B",.4,.4) "BLD",9342,"KRN","B",.401,.401) "BLD",9342,"KRN","B",.402,.402) "BLD",9342,"KRN","B",.403,.403) "BLD",9342,"KRN","B",.5,.5) "BLD",9342,"KRN","B",.84,.84) "BLD",9342,"KRN","B",3.6,3.6) "BLD",9342,"KRN","B",3.8,3.8) "BLD",9342,"KRN","B",9.2,9.2) "BLD",9342,"KRN","B",9.8,9.8) "BLD",9342,"KRN","B",19,19) "BLD",9342,"KRN","B",19.1,19.1) "BLD",9342,"KRN","B",101,101) "BLD",9342,"KRN","B",409.61,409.61) "BLD",9342,"KRN","B",771,771) "BLD",9342,"KRN","B",779.2,779.2) "BLD",9342,"KRN","B",870,870) "BLD",9342,"KRN","B",8989.51,8989.51) "BLD",9342,"KRN","B",8989.52,8989.52) "BLD",9342,"KRN","B",8994,8994) "BLD",9342,"QUES",0) ^9.62^^ "BLD",9342,"REQB",0) ^9.611^7^7 "BLD",9342,"REQB",1,0) IB*2.0*400^1 "BLD",9342,"REQB",2,0) IB*2.0*416^1 "BLD",9342,"REQB",3,0) IB*2.0*431^1 "BLD",9342,"REQB",4,0) IB*2.0*494^1 "BLD",9342,"REQB",5,0) IB*2.0*497^1 "BLD",9342,"REQB",6,0) IB*2.0*519^1 "BLD",9342,"REQB",7,0) IB*2.0*488^1 "BLD",9342,"REQB","B","IB*2.0*400",1) "BLD",9342,"REQB","B","IB*2.0*416",2) "BLD",9342,"REQB","B","IB*2.0*431",3) "BLD",9342,"REQB","B","IB*2.0*488",7) "BLD",9342,"REQB","B","IB*2.0*494",4) "BLD",9342,"REQB","B","IB*2.0*497",5) "BLD",9342,"REQB","B","IB*2.0*519",6) "FIA",36) INSURANCE COMPANY "FIA",36,0) ^DIC(36, "FIA",36,0,0) 36I "FIA",36,0,1) y^y^p^^^^n^^n "FIA",36,0,10) "FIA",36,0,11) "FIA",36,0,"RLRO") "FIA",36,0,"VR") 2.0^IB "FIA",36,36) 1 "FIA",36,36,8.01) "FIA",36,36,8.04) "FIA",361.1) EXPLANATION OF BENEFITS "FIA",361.1,0) ^IBM(361.1, "FIA",361.1,0,0) 361.1PI "FIA",361.1,0,1) y^y^p^^^^n^^n "FIA",361.1,0,10) "FIA",361.1,0,11) "FIA",361.1,0,"RLRO") "FIA",361.1,0,"VR") 2.0^IB "FIA",361.1,361.1) 1 "FIA",361.1,361.1,2.06) "INI") IBY521PR "INIT") IBY521PO "MBREQ") 1 "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) 521^3141216 "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") 11 "RTN","IBCEOB00") 0^1^B90317109 "RTN","IBCEOB00",1,0) IBCEOB00 ;ALB/ESG/PJH - 835 EDI EOB MSG PROCESSING CONT ;30-JUN-2003 "RTN","IBCEOB00",2,0) ;;2.0;INTEGRATED BILLING;**155,349,377,431,488,521**;21-MAR-94;Build 33 "RTN","IBCEOB00",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCEOB00",4,0) Q "RTN","IBCEOB00",5,0) ; "RTN","IBCEOB00",6,0) RCRU(IBZDATA,IB0,IBLN) ; Revenue Code Roll-up procedure check - "RTN","IBCEOB00",7,0) ; Total up outbound line items by revenue code and compare with "RTN","IBCEOB00",8,0) ; incoming EOB 40 record to see if it has been rolled up "RTN","IBCEOB00",9,0) ; "RTN","IBCEOB00",10,0) ; IBZDATA - UB output formatter array, passed by reference "RTN","IBCEOB00",11,0) ; IB0 - 40 record data "RTN","IBCEOB00",12,0) ; IBLN - output parameter, passed by reference "RTN","IBCEOB00",13,0) ; "RTN","IBCEOB00",14,0) NEW Z,LN,REV,UN,CH,RUD,RUD2,UCH,MRAUCH "RTN","IBCEOB00",15,0) I $P(IB0,U,4)="" G RCRUX "RTN","IBCEOB00",16,0) S IBLN="",Z=0 "RTN","IBCEOB00",17,0) F S Z=$O(IBZDATA(Z)) Q:'Z S LN=IBZDATA(Z) D "RTN","IBCEOB00",18,0) . S REV=$P(LN,U,1),UN=$P(LN,U,4),CH=$P(LN,U,5),UCH=+$P(LN,U,3) "RTN","IBCEOB00",19,0) . I REV="" Q "RTN","IBCEOB00",20,0) . ; "RTN","IBCEOB00",21,0) . S RUD=$G(RUD(REV)) ; roll up data array for rev code "RTN","IBCEOB00",22,0) . S $P(RUD,U,1)=$P(RUD,U,1)+CH ; total charges "RTN","IBCEOB00",23,0) . S $P(RUD,U,2)=$P(RUD,U,2)+UN ; total units "RTN","IBCEOB00",24,0) . S $P(RUD,U,3)=$P(RUD,U,3)+1 ; total line items "RTN","IBCEOB00",25,0) . S RUD(REV)=RUD "RTN","IBCEOB00",26,0) . S RUD(REV,Z)="" "RTN","IBCEOB00",27,0) . ; "RTN","IBCEOB00",28,0) . S RUD2=$G(RUD2(REV,UCH)) ; roll up data array for rev code "RTN","IBCEOB00",29,0) . S $P(RUD2,U,1)=$P(RUD2,U,1)+CH ; total charges "RTN","IBCEOB00",30,0) . S $P(RUD2,U,2)=$P(RUD2,U,2)+UN ; total units "RTN","IBCEOB00",31,0) . S $P(RUD2,U,3)=$P(RUD2,U,3)+1 ; total line items "RTN","IBCEOB00",32,0) . S RUD2(REV,UCH)=RUD2 "RTN","IBCEOB00",33,0) . S RUD2(REV,UCH,Z)="" "RTN","IBCEOB00",34,0) . ; "RTN","IBCEOB00",35,0) . Q "RTN","IBCEOB00",36,0) ; "RTN","IBCEOB00",37,0) I '$D(RUD),'$D(RUD2) G RCRUX "RTN","IBCEOB00",38,0) ; "RTN","IBCEOB00",39,0) ; delete the revenue code roll-up, if only 1 line item. "RTN","IBCEOB00",40,0) S REV="" ; this is not a roll up situation "RTN","IBCEOB00",41,0) F S REV=$O(RUD(REV)) Q:REV="" I $P(RUD(REV),U,3)=1 KILL RUD(REV) "RTN","IBCEOB00",42,0) ; "RTN","IBCEOB00",43,0) S (REV,UCH)="" "RTN","IBCEOB00",44,0) F S REV=$O(RUD2(REV)) Q:REV="" F S UCH=$O(RUD2(REV,UCH)) Q:UCH="" I $P(RUD2(REV,UCH),U,3)=1 KILL RUD2(REV,UCH) "RTN","IBCEOB00",45,0) ; "RTN","IBCEOB00",46,0) I '$D(RUD),'$D(RUD2) G RCRUX "RTN","IBCEOB00",47,0) ; "RTN","IBCEOB00",48,0) S RUD=$G(RUD($P(IB0,U,4))) ; compare with 40 record data "RTN","IBCEOB00",49,0) I RUD="" G RCRU2 ; make sure it exists "RTN","IBCEOB00",50,0) I $P(RUD,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRU2 ; charges "RTN","IBCEOB00",51,0) I $P(RUD,U,2)'=$P(IB0,U,16) G RCRU2 ; units "RTN","IBCEOB00",52,0) S IBLN=$O(RUD($P(IB0,U,4),"")) ; use the first line# found "RTN","IBCEOB00",53,0) G RCRUX "RTN","IBCEOB00",54,0) ; "RTN","IBCEOB00",55,0) RCRU2 ; check roll-up data by rev code and unit charge "RTN","IBCEOB00",56,0) S MRAUCH=0 "RTN","IBCEOB00",57,0) I $P(IB0,U,16) S MRAUCH=+$$DOLLAR^IBCEOB($P(IB0,U,15))/$P(IB0,U,16) "RTN","IBCEOB00",58,0) S RUD2=$G(RUD2($P(IB0,U,4),MRAUCH)) ; compare with 40 record data "RTN","IBCEOB00",59,0) I RUD2="" G RCRUX ; make sure it exists "RTN","IBCEOB00",60,0) I $P(RUD2,U,1)'=+$$DOLLAR^IBCEOB($P(IB0,U,15)) G RCRUX ; charges "RTN","IBCEOB00",61,0) I $P(RUD2,U,2)'=$P(IB0,U,16) G RCRUX ; units "RTN","IBCEOB00",62,0) S IBLN=$O(RUD2($P(IB0,U,4),MRAUCH,"")) ; use the first line# found "RTN","IBCEOB00",63,0) ; "RTN","IBCEOB00",64,0) RCRUX ; "RTN","IBCEOB00",65,0) Q "RTN","IBCEOB00",66,0) ; "RTN","IBCEOB00",67,0) ICN(IBEOB,ICN,COBN,IBOK) ; File the 835 ICN into the Bill "RTN","IBCEOB00",68,0) ; "RTN","IBCEOB00",69,0) ; Input parameters "RTN","IBCEOB00",70,0) ; IBEOB - ien to file 361.1 "RTN","IBCEOB00",71,0) ; ICN - the ICN# from the 835 transmission "RTN","IBCEOB00",72,0) ; COBN - the insurance sequence# "RTN","IBCEOB00",73,0) ; "RTN","IBCEOB00",74,0) ; Output parameter "RTN","IBCEOB00",75,0) ; IBOK - returns as 0 if we get a filing error here "RTN","IBCEOB00",76,0) ; "RTN","IBCEOB00",77,0) ; The field in file 399 depends on the current payer sequence "RTN","IBCEOB00",78,0) ; 399,453 - primary ICN "RTN","IBCEOB00",79,0) ; 399,454 - secondary ICN "RTN","IBCEOB00",80,0) ; 399,455 - tertiary ICN "RTN","IBCEOB00",81,0) ; "RTN","IBCEOB00",82,0) NEW IBIFN,FIELD,D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y "RTN","IBCEOB00",83,0) S IBEOB=+$G(IBEOB),COBN=+$G(COBN) "RTN","IBCEOB00",84,0) I 'IBEOB!'COBN G ICNX "RTN","IBCEOB00",85,0) S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1) "RTN","IBCEOB00",86,0) I '$D(^DGCR(399,IBIFN)) G ICNX "RTN","IBCEOB00",87,0) I $G(ICN)="" G ICNX "RTN","IBCEOB00",88,0) I '$F(".1.2.3.","."_COBN_".") G ICNX "RTN","IBCEOB00",89,0) ; "RTN","IBCEOB00",90,0) S FIELD=452+COBN "RTN","IBCEOB00",91,0) S DIE=399,DA=IBIFN,DR=FIELD_"////"_ICN D ^DIE "RTN","IBCEOB00",92,0) S IBOK=($D(Y)=0) "RTN","IBCEOB00",93,0) I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Error in filing the ICN into the Bill/Claims file" "RTN","IBCEOB00",94,0) ICNX ; "RTN","IBCEOB00",95,0) Q "RTN","IBCEOB00",96,0) ; "RTN","IBCEOB00",97,0) 15(IB0,IBEGBL,IBEOB) ; Record '15' "RTN","IBCEOB00",98,0) ; "RTN","IBCEOB00",99,0) N A,IBOK "RTN","IBCEOB00",100,0) ; "RTN","IBCEOB00",101,0) ;IB*2.0*521/ZEB Added piece 11/field 2.06 for HPID "RTN","IBCEOB00",102,0) S A="3;1.03;1;0;0^4;1.04;1;0;0^5;1.05;1;0;0^6;1.07;1;0;0^7;1.08;1;0;0^8;1.09;1;0;0^9;1.02;1;0;0^10;2.05;1;0;0^11;2.06;0;0;0" "RTN","IBCEOB00",103,0) ; "RTN","IBCEOB00",104,0) S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) "RTN","IBCEOB00",105,0) I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad record 15 data" G Q15 "RTN","IBCEOB00",106,0) ; "RTN","IBCEOB00",107,0) ; For Medicare MRA's only: "RTN","IBCEOB00",108,0) ; If the Covered Amount is present (15 record, piece 3), then file "RTN","IBCEOB00",109,0) ; a claim level adjustment with Group code=OA, Reason code=AB3. "RTN","IBCEOB00",110,0) ; "RTN","IBCEOB00",111,0) I $P($G(^IBM(361.1,IBEOB,0)),U,4)=1,+$P(IB0,U,3) D "RTN","IBCEOB00",112,0) . N IB20 "RTN","IBCEOB00",113,0) . S IB20=20_U_$P(IB0,U,2)_U_"OA"_U_"AB3"_U_$P(IB0,U,3)_U_"0000000000" "RTN","IBCEOB00",114,0) . S IB20=IB20_U_"Covered Amount" "RTN","IBCEOB00",115,0) . S IBOK=$$20(IB20,IBEGBL,IBEOB) "RTN","IBCEOB00",116,0) . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Could not file the OA-AB3 claim level adjustment for the Covered Amount" "RTN","IBCEOB00",117,0) . K ^TMP($J,20) "RTN","IBCEOB00",118,0) . Q "RTN","IBCEOB00",119,0) ; "RTN","IBCEOB00",120,0) Q15 Q IBOK "RTN","IBCEOB00",121,0) ; "RTN","IBCEOB00",122,0) 20(IB0,IBEGBL,IBEOB) ; Record '20' "RTN","IBCEOB00",123,0) ; "RTN","IBCEOB00",124,0) N A,LEVEL,IBGRP,IBDA,IBOK "RTN","IBCEOB00",125,0) ; "RTN","IBCEOB00",126,0) S IBGRP=$P(IB0,U,3) "RTN","IBCEOB00",127,0) I IBGRP'="" S ^TMP($J,20)=IBGRP "RTN","IBCEOB00",128,0) I IBGRP="" S IBGRP=$G(^TMP($J,20)) "RTN","IBCEOB00",129,0) I IBGRP="" S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Missing claim level adjustment group code" G Q20 "RTN","IBCEOB00",130,0) ; "RTN","IBCEOB00",131,0) S IBDA(1)=$O(^IBM(361.1,IBEOB,10,"B",IBGRP,0)) "RTN","IBCEOB00",132,0) ; "RTN","IBCEOB00",133,0) I 'IBDA(1) D ;Needs a new entry at group level "RTN","IBCEOB00",134,0) . N X,Y,DA,DD,DO,DIC,DLAYGO "RTN","IBCEOB00",135,0) . S DIC="^IBM(361.1,"_IBEOB_",10,",DIC(0)="L",DLAYGO=361.11,DA(1)=IBEOB "RTN","IBCEOB00",136,0) . S DIC("P")=$$GETSPEC^IBEFUNC(361.1,10) "RTN","IBCEOB00",137,0) . S X=IBGRP "RTN","IBCEOB00",138,0) . D FILE^DICN K DIC,DO,DD,DLAYGO "RTN","IBCEOB00",139,0) . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment group code could not be added" Q "RTN","IBCEOB00",140,0) . S IBDA(1)=+Y "RTN","IBCEOB00",141,0) ; "RTN","IBCEOB00",142,0) I $G(IBDA(1)) D ;Add a new entry at the reason code level "RTN","IBCEOB00",143,0) . S DIC="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1,",DIC(0)="L",DLAYGO=361.111,DA(2)=IBEOB,DA(1)=IBDA(1) "RTN","IBCEOB00",144,0) . S DIC("P")=$$GETSPEC^IBEFUNC(361.11,1) "RTN","IBCEOB00",145,0) . S X=$P(IB0,U,4) "RTN","IBCEOB00",146,0) . D FILE^DICN K DIC,DO,DD,DLAYGO "RTN","IBCEOB00",147,0) . I Y<0 K IBDA S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Adjustment reason code could not be added" Q "RTN","IBCEOB00",148,0) . S IBDA=+Y "RTN","IBCEOB00",149,0) ; "RTN","IBCEOB00",150,0) I $G(IBDA) D "RTN","IBCEOB00",151,0) . S LEVEL=10,LEVEL("DIE")="^IBM(361.1,"_IBEOB_",10,"_IBDA(1)_",1," "RTN","IBCEOB00",152,0) . S LEVEL(0)=IBDA,LEVEL(1)=IBDA(1),LEVEL(2)=IBEOB "RTN","IBCEOB00",153,0) . S A="5;.02;1;0;0^6;.03;0;1;1^7;.04;0;1;0" "RTN","IBCEOB00",154,0) . S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB,.LEVEL) "RTN","IBCEOB00",155,0) . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad adjustment reason code ("_$P(IB0,U,4)_") data" Q "RTN","IBCEOB00",156,0) Q20 Q $G(IBOK) "RTN","IBCEOB00",157,0) ; "RTN","IBCEOB00",158,0) 35(IB0,IBEGBL,IBEOB) ; Record '35' "RTN","IBCEOB00",159,0) ; "RTN","IBCEOB00",160,0) N A,IBOK "RTN","IBCEOB00",161,0) ; "RTN","IBCEOB00",162,0) S A="3;4.12;1;0;0^4;4.13;1;0;0^5;4.14;0;1;1^6;4.15;1;0;0^7;4.16;1;0;0^8;4.17;1;0;0^9;4.18;1;0;0^10;4.04;1;0;0^11;3.01;0;1;1^12;3.02;1;0;0^13;3.08;1;0;0^14;3.09;1;0;0" "RTN","IBCEOB00",163,0) ; "RTN","IBCEOB00",164,0) S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) "RTN","IBCEOB00",165,0) I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad MEDICARE Inpt Adjudication data" "RTN","IBCEOB00",166,0) Q35 Q $G(IBOK) "RTN","IBCEOB00",167,0) ; "RTN","IBCEOB00",168,0) 37(IB0,IBEGBL,IBEOB) ; Record '37' "RTN","IBCEOB00",169,0) ; "RTN","IBCEOB00",170,0) N IBOK,IBCT "RTN","IBCEOB00",171,0) S IBCT=$G(^TMP($J,37))+1 "RTN","IBCEOB00",172,0) I IBCT>5 S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Too many Medicare Claim Level Adjudication Remarks" G Q37 ; Max 5 allowed "RTN","IBCEOB00",173,0) S A="4;"_$S($P(IB0,U,3)="O":"3.0"_(IBCT+2),1:"5.0"_IBCT)_";0;0;0^5;5.0"_IBCT_"1;0;0;0" "RTN","IBCEOB00",174,0) S IBOK=$$STORE^IBCEOB1(A,IB0,IBEOB) "RTN","IBCEOB00",175,0) I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Bad Medicare Claim Level Adjudication Remarks data" "RTN","IBCEOB00",176,0) ; "RTN","IBCEOB00",177,0) ; 4/22/03 - esg - If claim level remark code MA15 is reported, then "RTN","IBCEOB00",178,0) ; this is a split EOB and we need to change the REVIEW STATUS "RTN","IBCEOB00",179,0) ; of this EOB to be ACCEPTED-INTERIM EOB. "RTN","IBCEOB00",180,0) ; "RTN","IBCEOB00",181,0) I $P(IB0,U,4)["MA15" D "RTN","IBCEOB00",182,0) . N DA,DIE,DR,DIC "RTN","IBCEOB00",183,0) . S DA=IBEOB,DIE=361.1,DR=".16////2" D ^DIE S IBOK=($D(Y)=0) "RTN","IBCEOB00",184,0) . I 'IBOK S ^TMP(IBEGBL,$J,+$O(^TMP(IBEGBL,$J,""),-1)+1)="Split EOB, but review status was not updated correctly" "RTN","IBCEOB00",185,0) . Q "RTN","IBCEOB00",186,0) ; "RTN","IBCEOB00",187,0) Q37 S ^TMP($J,37)=$G(^TMP($J,37))+1 ; Saves the # of entries for 37 records "RTN","IBCEOB00",188,0) Q $G(IBOK) "RTN","IBCEOB00",189,0) ; "RTN","IBCEOB00",190,0) ; "RTN","IBCEOB00",191,0) DET40(IB0,ARRAY,ERRCOD) ; Format important details of record 40 for error "RTN","IBCEOB00",192,0) ; IB0 = data on 40 record (some pieces pre-formatted) "RTN","IBCEOB00",193,0) ; ARRAY(n)=formatted line is returned if passed by ref "RTN","IBCEOB00",194,0) N Q,IBBNDL "RTN","IBCEOB00",195,0) S IBBNDL=$S($P(IB0,U,10)'="":1,1:0) ; Determine if Bundled or Not Bundled. "RTN","IBCEOB00",196,0) ; "RTN","IBCEOB00",197,0) S ARRAY(1)="Payer reported the following was billed to them via the Claim (837):" "RTN","IBCEOB00",198,0) S ARRAY(2)="Proc/Rev CD: " "RTN","IBCEOB00",199,0) ; If this is a Procedure Code mismatch and there is nothing in piece 10 show "UNK" otherwise show the mismatched Procedure Code. "RTN","IBCEOB00",200,0) S ARRAY(2)=ARRAY(2)_$S(+ERRCOD=2:$S($P(IB0,U,10)'="":$P(IB0,U,10),1:"UNK "),1:$S($P(IB0,U,10)'="":$P(IB0,U,10),1:$P(IB0,U,3))) "RTN","IBCEOB00",201,0) S ARRAY(2)=ARRAY(2)_" Mods:" "RTN","IBCEOB00",202,0) I $P(IB0,U,11)="" D "RTN","IBCEOB00",203,0) . ; If there is nothing in piece 11 and this is a modified mismatch, show the value from the comparison checking that occurred. "RTN","IBCEOB00",204,0) . I +ERRCOD=5 S ARRAY(2)=ARRAY(2)_$P(ERRCOD,U,2) Q "RTN","IBCEOB00",205,0) . ; If there is nothing in piece 11 and this is not a modifier mismatch, show what is in piece 5-8 "RTN","IBCEOB00",206,0) . F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(2)=ARRAY(2)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"") "RTN","IBCEOB00",207,0) I $P(IB0,U,11)'="" D "RTN","IBCEOB00",208,0) . F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(2)=ARRAY(2)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"") "RTN","IBCEOB00",209,0) S $E(ARRAY(2),37)="Chg: "_$J($P(IB0,U,15)/100,"",2) "RTN","IBCEOB00",210,0) S $E(ARRAY(2),64)="Units:"_$S($P(IB0,U,16):$P(IB0,U,16),1:"") "RTN","IBCEOB00",211,0) S ARRAY(3)="Payer reported the following was used for adjudication via the EEOB (835):" "RTN","IBCEOB00",212,0) S ARRAY(4)="Proc/Rev CD: "_$P(IB0,U,3)_" Mods:" "RTN","IBCEOB00",213,0) I 'IBBNDL D ; If not bundled. "RTN","IBCEOB00",214,0) . I $P(IB0,U,5)="" S ARRAY(4)=ARRAY(4)_"UNK" Q ; If no modifiers found, show "UNK" for Unknown. "RTN","IBCEOB00",215,0) . F Q=5:1:8 I $P(IB0,U,Q)'="" S ARRAY(4)=ARRAY(4)_$P(IB0,U,Q)_$S(Q=8:"",$P(IB0,U,Q+1)'="":",",1:"") "RTN","IBCEOB00",216,0) I IBBNDL D ; If bundled. "RTN","IBCEOB00",217,0) . I $P(IB0,U,11)="" S ARRAY(4)=ARRAY(4)_"UNK" Q ; If no modifiers found, show "UNK" for Unknown. "RTN","IBCEOB00",218,0) . F Q=11:1:14 I $P(IB0,U,Q)'="" S ARRAY(4)=ARRAY(4)_$P(IB0,U,Q)_$S(Q=14:"",$P(IB0,U,Q+1)'="":",",1:"") "RTN","IBCEOB00",219,0) S $E(ARRAY(4),37)="Amt Pd: "_$J($P(IB0,U,17)/100,"",2) "RTN","IBCEOB00",220,0) S $E(ARRAY(4),64)="Cov Units:"_$S($P(IB0,U,18):$P(IB0,U,18)/100,1:1) "RTN","IBCEOB00",221,0) S ARRAY(5)=" " "RTN","IBCEOB00",222,0) Q "RTN","IBCEOB00",223,0) ; "RTN","IBCEOB00",224,0) DET4X(RECID,IB0,ARRAY) ; Format important details of record 41-46 for error "RTN","IBCEOB00",225,0) ; RECID = 41,42,45,46 "RTN","IBCEOB00",226,0) ; IB0 = data on RECID record "RTN","IBCEOB00",227,0) ; ARRAY(n)=formatted line is returned if passed by ref "RTN","IBCEOB00",228,0) N CT,Q "RTN","IBCEOB00",229,0) I RECID=41 D Q "RTN","IBCEOB00",230,0) . S ARRAY(1)=" Allowed Amt: "_$J($P(IB0,U,3)/100,"",2)_" Per Diem Amt: "_$J($P(IB0,U,4)/100,"",2) "RTN","IBCEOB00",231,0) ; "RTN","IBCEOB00",232,0) I RECID=42 D Q "RTN","IBCEOB00",233,0) . S ARRAY(1)=" Line Item Remark Code: "_$P(IB0,U,3) "RTN","IBCEOB00",234,0) . I $P(IB0,U,4)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,4),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,4),Q+1,Q+80) "RTN","IBCEOB00",235,0) ; "RTN","IBCEOB00",236,0) I RECID=45 D "RTN","IBCEOB00",237,0) . S ARRAY(1)=" Adj Group Cd: "_$P(IB0,U,3)_" Reason Cd: "_$P(IB0,U,4)_" Amt: "_$J($P(IB0,U,5)/100,"",2)_" Quantity: "_+$P(IB0,U,6) "RTN","IBCEOB00",238,0) . I $P(IB0,U,7)'="" S CT=1 F Q=0:80:190 I $E($P(IB0,U,7),Q+1,Q+80)'="" S CT=CT+1,ARRAY(CT)=$E($P(IB0,U,7),Q+1,Q+80) "RTN","IBCEOB00",239,0) ; "RTN","IBCEOB00",240,0) I RECID=46 D "RTN","IBCEOB00",241,0) . S ARRAY(1)=" Payer Policy Reference: "_$P(IB0,U,3) "RTN","IBCEOB00",242,0) Q "RTN","IBCEOB00",243,0) ; "RTN","IBCEOB00",244,0) FDT(X) ; Format date in X (YYYYMMDD) to MM/DD/YYYY "RTN","IBCEOB00",245,0) S:X'="" X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4) "RTN","IBCEOB00",246,0) Q X "RTN","IBCEOB00",247,0) ; "RTN","IBCNERPD") 0^6^B67426555 "RTN","IBCNERPD",1,0) IBCNERPD ;DAOU/RO - eIV PAYER LINK REPORT PRINT;AUG-2003 "RTN","IBCNERPD",2,0) ;;2.0;INTEGRATED BILLING;**184,252,416,521**;21-MAR-94;Build 33 "RTN","IBCNERPD",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCNERPD",4,0) ; "RTN","IBCNERPD",5,0) ; eIV - Insurance Verification "RTN","IBCNERPD",6,0) ; "RTN","IBCNERPD",7,0) ; Called by IBCNERPB "RTN","IBCNERPD",8,0) ; Input from IBCNERPB/C: "RTN","IBCNERPD",9,0) ; "RTN","IBCNERPD",10,0) ; ^TMP($J,IBCNERTN,S1,S2,CT,0) "RTN","IBCNERPD",11,0) ; IBCNERTN="IBCNERPB", "RTN","IBCNERPD",12,0) ; CT=Seq ct "RTN","IBCNERPD",13,0) ; ^TMP($J,IBCNERTN,S1,S2,CT,1) "RTN","IBCNERPD",14,0) ; "RTN","IBCNERPD",15,0) EN3(IBCNERTN,IBCNESPC) ; Entry pt. "RTN","IBCNERPD",16,0) N IBTYP,IBSRT,CRT,MAXCNT,IBPXT "RTN","IBCNERPD",17,0) N IBPGC,X,Y,DIR,DTOUT,DUOUT,LIN,IBTRC,IBMAT,IBREP,IBDET,IBPPYR,ZZ "RTN","IBCNERPD",18,0) S IBREP=$G(IBCNESPC("REP")) "RTN","IBCNERPD",19,0) S IBDET=$G(IBCNESPC("PDET")) "RTN","IBCNERPD",20,0) S IBTYP=$G(IBCNESPC("PTYPE")) "RTN","IBCNERPD",21,0) S IBSRT=$G(IBCNESPC("PSORT")) "RTN","IBCNERPD",22,0) S IBPPYR=$G(IBCNESPC("PPYR")) "RTN","IBCNERPD",23,0) ; Ins Report "RTN","IBCNERPD",24,0) I IBREP=2 D "RTN","IBCNERPD",25,0) . S IBTYP=$G(IBCNESPC("ITYPE")) "RTN","IBCNERPD",26,0) . S IBSRT=$G(IBCNESPC("ISORT")) "RTN","IBCNERPD",27,0) . S IBMAT=$G(IBCNESPC("IMAT")) "RTN","IBCNERPD",28,0) S (IBPXT,IBPGC)=0 "RTN","IBCNERPD",29,0) ; Determine IO params "RTN","IBCNERPD",30,0) I IOST["C-" S MAXCNT=IOSL-3,CRT=1 "RTN","IBCNERPD",31,0) E S MAXCNT=IOSL-6,CRT=0 "RTN","IBCNERPD",32,0) D PRINT(IBCNERTN,IBREP,IBDET,IBTYP,IBSRT,.IBPGC,.IBPXT,MAXCNT,CRT) "RTN","IBCNERPD",33,0) I $G(ZTSTOP)!IBPXT G EXIT3 "RTN","IBCNERPD",34,0) I CRT,IBPGC>0,'$D(ZTQUEUED) D "RTN","IBCNERPD",35,0) . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W ! "RTN","IBCNERPD",36,0) . S DIR(0)="E" D ^DIR K DIR "RTN","IBCNERPD",37,0) EXIT3 ; Exit pt "RTN","IBCNERPD",38,0) Q "RTN","IBCNERPD",39,0) ; "RTN","IBCNERPD",40,0) PRINT(RTN,REP,DET,TYP,SRT,PGC,PXT,MAX,CRT) ; Print data "RTN","IBCNERPD",41,0) ; Input: RTN="IBCENRPB" "RTN","IBCNERPD",42,0) ; PGC=page ct, PXT=exit flg, "RTN","IBCNERPD",43,0) ; MAX=max line ct/pg, CRT=1/0 "RTN","IBCNERPD",44,0) N EORMSG,NONEMSG,SORT1,SORT2,CNT,DASH "RTN","IBCNERPD",45,0) S EORMSG="*** END OF REPORT ***" "RTN","IBCNERPD",46,0) S NONEMSG="* * * N O D A T A F O U N D * * *" "RTN","IBCNERPD",47,0) S (SORT1,SORT2)="",$P(DASH,"-",133)="" "RTN","IBCNERPD",48,0) I '$D(^TMP($J,RTN)) D HEADER W !,?(80-$L(NONEMSG)\2),NONEMSG,!! "RTN","IBCNERPD",49,0) F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:PXT!$G(ZTSTOP) "RTN","IBCNERPD",50,0) . S SORT2="" F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:PXT!$G(ZTSTOP) "RTN","IBCNERPD",51,0) . . S CNT="" F S CNT=$O(^TMP($J,RTN,SORT1,SORT2,CNT)) Q:CNT="" D Q:PXT!$G(ZTSTOP) "RTN","IBCNERPD",52,0) . . . K DISPDATA ; Init disp "RTN","IBCNERPD",53,0) . . . D DATA(.DISPDATA),LINE(.DISPDATA) ; build/display data "RTN","IBCNERPD",54,0) ; "RTN","IBCNERPD",55,0) I $G(ZTSTOP)!PXT G PRINTX "RTN","IBCNERPD",56,0) I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX "RTN","IBCNERPD",57,0) W !,?(80-$L(EORMSG)\2),EORMSG "RTN","IBCNERPD",58,0) PRINTX ; "RTN","IBCNERPD",59,0) Q "RTN","IBCNERPD",60,0) ; "RTN","IBCNERPD",61,0) HEADER ; Print hdr info "RTN","IBCNERPD",62,0) N X,Y,DIR,DTOUT,DUOUT,OFFSET,HDR,LIN,HDR "RTN","IBCNERPD",63,0) I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX "RTN","IBCNERPD",64,0) . I MAX<51 F LIN=1:1:(MAX-$Y) W ! "RTN","IBCNERPD",65,0) . S DIR(0)="E" D ^DIR K DIR "RTN","IBCNERPD",66,0) . I $D(DTOUT)!($D(DUOUT)) S PXT=1 Q "RTN","IBCNERPD",67,0) I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX "RTN","IBCNERPD",68,0) S PGC=PGC+1 "RTN","IBCNERPD",69,0) W @IOF,!,?1,"eIV Payer Link Report" "RTN","IBCNERPD",70,0) S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC,OFFSET=131-$L(HDR) "RTN","IBCNERPD",71,0) W ?OFFSET,HDR "RTN","IBCNERPD",72,0) W !,?1,"Report Option: "_$S(REP=1:"Payer List",1:"Insurance Company List") "RTN","IBCNERPD",73,0) I REP=1 D "RTN","IBCNERPD",74,0) . S HDR=$S(TYP=1:"Unlinked Payers Only",TYP=2:"Linked Payers Only",1:"All Payers") "RTN","IBCNERPD",75,0) . I TYP=3 S HDR=HDR_", "_$S(DET=1:"With Ins. Co. Detail",1:"Without Ins. Co. Detail") "RTN","IBCNERPD",76,0) I REP=2 D "RTN","IBCNERPD",77,0) . S HDR=$S(TYP=1:"Unlinked Insurance Companies Only",TYP=2:"Linked Insurance Companies Only",1:"All Insurance Companies") "RTN","IBCNERPD",78,0) S OFFSET=79-$L(HDR) "RTN","IBCNERPD",79,0) W ?OFFSET,HDR "RTN","IBCNERPD",80,0) ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",81,0) I REP=2 W !,"'*' indicates the Insurance Company HPID/OEID failed validation checks" "RTN","IBCNERPD",82,0) I REP=1,DET=1 W !,"'*' indicates the Linked Insurance Company HPID/OEID failed validation checks" "RTN","IBCNERPD",83,0) W ! "RTN","IBCNERPD",84,0) I REP=1 D "RTN","IBCNERPD",85,0) . I IBPPYR'="" W ?1,"For Single Payer: ",$P(IBPPYR,"^",2) "RTN","IBCNERPD",86,0) . ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",87,0) . ;W !?39,"National",?54,"# Linked",?67,"Nationally",?82,"Locally",?94,"Prof.",?115,"Inst." "RTN","IBCNERPD",88,0) . ;W !,"Payer Name:",?39,"Payer ID",?54,"Ins. Co.",?67,"Active?",?82,"Active?",?94,"EDI#",?115,"EDI#" "RTN","IBCNERPD",89,0) . W !?39,"National",?54,"# Linked",?64,"Nationally",?77,"Locally",?87,"Prof.",?104,"Inst." W:DET=1 ?121,"HPID/" "RTN","IBCNERPD",90,0) . W !,"Payer Name:",?39,"Payer ID",?54,"Ins. Co.",?65,"Active?",?77,"Active?",?87,"EDI#",?104,"EDI#" W:DET=1 ?121,"OEID" "RTN","IBCNERPD",91,0) I REP=2 D "RTN","IBCNERPD",92,0) . I IBMAT'="" W ?1,"Only Insurance Companies that match: ",IBMAT "RTN","IBCNERPD",93,0) . ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",94,0) . ;W !?56,"Nat.",?71,"Loc.",?83,"Prof.",?104,"Inst." "RTN","IBCNERPD",95,0) . ;W !,"Insurance Company:",?56,"Act?",?71,"Act?",?83,"EDI#",?104,"EDI#" "RTN","IBCNERPD",96,0) . W !?56,"Nat.",?71,"Loc.",?83,"Prof.",?104,"Inst.",?121,"HPID/" "RTN","IBCNERPD",97,0) . W !,"Insurance Company:",?56,"Act?",?71,"Act?",?83,"EDI#",?104,"EDI#",?121,"OEID" "RTN","IBCNERPD",98,0) . I TYP'=1 W !," Payer:",?41,"VA ID" "RTN","IBCNERPD",99,0) W !,DASH "RTN","IBCNERPD",100,0) HEADERX ; "RTN","IBCNERPD",101,0) Q "RTN","IBCNERPD",102,0) ; "RTN","IBCNERPD",103,0) LINE(DISPDATA) ; Print data "RTN","IBCNERPD",104,0) N LNCT,LNTOT,NWPG "RTN","IBCNERPD",105,0) S LNTOT=+$O(DISPDATA(""),-1) "RTN","IBCNERPD",106,0) S NWPG=0 "RTN","IBCNERPD",107,0) F LNCT=1:1:LNTOT D Q:$G(ZTSTOP)!PXT "RTN","IBCNERPD",108,0) . I $Y+1>MAX!('PGC) D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q "RTN","IBCNERPD",109,0) . W !,?1,DISPDATA(LNCT) Q "RTN","IBCNERPD",110,0) . I 'NWPG!(NWPG&(DISPDATA(LNCT)'="")) W !,?1,DISPDATA(LNCT) "RTN","IBCNERPD",111,0) . I NWPG S NWPG=0 "RTN","IBCNERPD",112,0) . Q "RTN","IBCNERPD",113,0) LINEX Q "RTN","IBCNERPD",114,0) ; "RTN","IBCNERPD",115,0) DATA(DISPDATA) ; Build disp lines "RTN","IBCNERPD",116,0) N LCT,CT,CT2,RPTDATA,XX,YY,ZZ,IBHPD "RTN","IBCNERPD",117,0) ; Merge into local array "RTN","IBCNERPD",118,0) M RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT) "RTN","IBCNERPD",119,0) ; Build "RTN","IBCNERPD",120,0) ; "RTN","IBCNERPD",121,0) ; PAYER REPORT "RTN","IBCNERPD",122,0) I REP=1 D "RTN","IBCNERPD",123,0) . ; 1st line is payer "RTN","IBCNERPD",124,0) . ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",125,0) . ;S LCT=1,DISPDATA(1)=$$FO^IBCNEUT1(SORT2,35,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,1),10,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,6),5,"R")_" "_$$FO^IBCNEUT1($S($P(RPTDATA,U,4)=1:"YES",1:"NO"),15,"L") "RTN","IBCNERPD",126,0) . ;S DISPDATA(1)=DISPDATA(1)_$$FO^IBCNEUT1($S($P(RPTDATA,U,5)=1:"YES",1:"NO"),12,"L")_$$FO^IBCNEUT1($P(RPTDATA,U,2),16,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,3),16,"L") "RTN","IBCNERPD",127,0) . S LCT=1,DISPDATA(1)=$$FO^IBCNEUT1(SORT2,35,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,1),10,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,6),5,"R")_" "_$$FO^IBCNEUT1($S($P(RPTDATA,U,4)=1:"YES",1:"NO"),12,"L") "RTN","IBCNERPD",128,0) . S DISPDATA(1)=DISPDATA(1)_$$FO^IBCNEUT1($S($P(RPTDATA,U,5)=1:"YES",1:"NO"),8,"L")_$$FO^IBCNEUT1($P(RPTDATA,U,2),16,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,3),16,"L") "RTN","IBCNERPD",129,0) . ; See if detail is required "RTN","IBCNERPD",130,0) . I DET=1 D "RTN","IBCNERPD",131,0) . . I $O(RPTDATA(""))'="" S LCT=LCT+1,DISPDATA(LCT)=" Linked Insurance Companies:" "RTN","IBCNERPD",132,0) . . S (XX,YY,ZZ)="" F S XX=$O(RPTDATA(XX)) Q:XX="" F S YY=$O(RPTDATA(XX,YY)) Q:YY="" D "RTN","IBCNERPD",133,0) . . . S ZZ=RPTDATA(XX,YY) "RTN","IBCNERPD",134,0) . . . S LCT=LCT+1,DISPDATA(LCT)=" "_$$FO^IBCNEUT1(XX,35,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,1),20,"L")_" "_$E($P(ZZ,U,4),1,15) "RTN","IBCNERPD",135,0) . . . ; don't display ','s if no address/state on file "RTN","IBCNERPD",136,0) . . . I $P(ZZ,U,5)'="" S DISPDATA(LCT)=DISPDATA(LCT)_", "_$P($G(^DIC(5,$P(ZZ,U,5)+0,0)),U,2) "RTN","IBCNERPD",137,0) . . . ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",138,0) . . . S IBHPD=$$HPD^IBCNHUT1(YY,1) "RTN","IBCNERPD",139,0) . . . ;S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1(" ",93-$L(DISPDATA(LCT)),"L") "RTN","IBCNERPD",140,0) . . . S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1(" ",86-$L(DISPDATA(LCT)),"L") "RTN","IBCNERPD",141,0) . . . ; display EDI#'s "RTN","IBCNERPD",142,0) . . . ;S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($P(ZZ,U,7),16,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,8),16,"L") "RTN","IBCNERPD",143,0) . . . S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($P(ZZ,U,7),16,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,8),16,"L")_" "_IBHPD "RTN","IBCNERPD",144,0) ; "RTN","IBCNERPD",145,0) ; Insurance Company Report "RTN","IBCNERPD",146,0) I REP=2 D "RTN","IBCNERPD",147,0) . ; Ins carrier "RTN","IBCNERPD",148,0) . S DISPDATA(1)=$$FO^IBCNEUT1(SORT2,82,"L") "RTN","IBCNERPD",149,0) . ; Ins address "RTN","IBCNERPD",150,0) . ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",151,0) . S IBHPD=$$HPD^IBCNHUT1(CNT,1) "RTN","IBCNERPD",152,0) . ;S ZZ=$P(RPTDATA,"~",2),DISPDATA(1)=DISPDATA(1)_$$FO^IBCNEUT1($P(ZZ,U,2),16,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,4),16,"L") "RTN","IBCNERPD",153,0) . S ZZ=$P(RPTDATA,"~",2),DISPDATA(1)=DISPDATA(1)_$$FO^IBCNEUT1($P(ZZ,U,2),16,"L")_" "_$$FO^IBCNEUT1($P(ZZ,U,4),16,"L")_" "_IBHPD "RTN","IBCNERPD",154,0) . S DISPDATA(2)=" "_$P(RPTDATA,U,8)_" "_$P(RPTDATA,U,11) "RTN","IBCNERPD",155,0) . ; Add state/zip if defined "RTN","IBCNERPD",156,0) . I $P(RPTDATA,U,12)'="" S DISPDATA(2)=DISPDATA(2)_", "_$P($G(^DIC(5,$P(RPTDATA,U,12)+0,0)),U,2)_" "_$$FO^IBCNEUT1($P(RPTDATA,U,13),5,"L") "RTN","IBCNERPD",157,0) . ; if no payer is linked AND displaying payers "RTN","IBCNERPD",158,0) . I $P(RPTDATA,U)="",TYP'=1 S DISPDATA(3)=" ** NOT CURRENTLY LINKED **",LCT=4,DISPDATA(4)=" " Q "RTN","IBCNERPD",159,0) . ; if no payer and not displaying then quit "RTN","IBCNERPD",160,0) . I $P(RPTDATA,U)="" S LCT=3,DISPDATA(3)=" " Q "RTN","IBCNERPD",161,0) . ; Display Payer Info Line "RTN","IBCNERPD",162,0) . S DISPDATA(3)=" "_$$FO^IBCNEUT1($P(RPTDATA,U,1),35,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,2),15,"L")_$$FO^IBCNEUT1($S($P(RPTDATA,U,5)=1:"YES",1:"NO"),15,"L") "RTN","IBCNERPD",163,0) . ; IB*2.0*521 add validated HPID to report "RTN","IBCNERPD",164,0) . ;S DISPDATA(3)=DISPDATA(3)_$$FO^IBCNEUT1($S($P(RPTDATA,U,6)=1:"YES",1:"NO"),12,"L")_$$FO^IBCNEUT1($P(RPTDATA,U,4),16,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,4),16,"L") "RTN","IBCNERPD",165,0) . S DISPDATA(3)=DISPDATA(3)_$$FO^IBCNEUT1($S($P(RPTDATA,U,6)=1:"YES",1:"NO"),12,"L")_$$FO^IBCNEUT1($P(RPTDATA,U,4),16,"L")_" "_$$FO^IBCNEUT1($P(RPTDATA,U,4),16,"L") "RTN","IBCNERPD",166,0) . S LCT=4,DISPDATA(4)=" " "RTN","IBCNERPD",167,0) S LCT=LCT+1 "RTN","IBCNERPD",168,0) Q "RTN","IBCNERPE") 0^9^B71200892 "RTN","IBCNERPE",1,0) IBCNERPE ;DAOU/BHS - IBCNE eIV RESPONSE REPORT (cont'd);03-JUN-2002 "RTN","IBCNERPE",2,0) ;;2.0;INTEGRATED BILLING;**271,300,416,438,497,506,519,521**;21-MAR-94;Build 33 "RTN","IBCNERPE",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCNERPE",4,0) ; "RTN","IBCNERPE",5,0) ; Must call at tag "RTN","IBCNERPE",6,0) Q "RTN","IBCNERPE",7,0) ; "RTN","IBCNERPE",8,0) ; This tag is only called from IBCNERP2 "RTN","IBCNERPE",9,0) ; "RTN","IBCNERPE",10,0) GETDATA(IEN,RPTDATA) ; Retrieve response data "RTN","IBCNERPE",11,0) ; Init "RTN","IBCNERPE",12,0) N %,CNPTR,CT,DIW,DIWI,DIWT,DIWTC,DIWX,DN,EACT,ELOC,ESRC,ETXT,DQUAL,DTYPE,FUTDT,IENS,II,LOOP,NODE0,PC,TQIEN,Z "RTN","IBCNERPE",13,0) ; "RTN","IBCNERPE",14,0) ; Insured Info from eIV Response #365 "RTN","IBCNERPE",15,0) S RPTDATA(0)=$G(^IBCN(365,IEN,0)),TQIEN=$P(RPTDATA(0),U,5) "RTN","IBCNERPE",16,0) ; Trans dates to ext format "RTN","IBCNERPE",17,0) S $P(RPTDATA(0),U,7)=$$FMTE^XLFDT($P(RPTDATA(0),U,7)\1,"5Z") "RTN","IBCNERPE",18,0) S RPTDATA(1)=$G(^IBCN(365,IEN,1)) "RTN","IBCNERPE",19,0) ; Trans ext values for SET of CODES values "RTN","IBCNERPE",20,0) S IENS=IEN_"," "RTN","IBCNERPE",21,0) S $P(RPTDATA(1),U,8)=$$GET1^DIQ(365,IENS,1.08,"E") ; Whose Ins "RTN","IBCNERPE",22,0) S $P(RPTDATA(1),U,13)=$$GET1^DIQ(365,IENS,1.13,"E") ; COB "RTN","IBCNERPE",23,0) S RPTDATA(8)=$$GET1^DIQ(365,IENS,8.01,"E") ; Pt Rel to Sub "RTN","IBCNERPE",24,0) ; if pt. rel is empty, try to get value from the old field 365/1.09 "RTN","IBCNERPE",25,0) I RPTDATA(8)="" S RPTDATA(8)=$$GET1^DIQ(365,IENS,1.09,"E") "RTN","IBCNERPE",26,0) ; Trans err actions/codes to ext "RTN","IBCNERPE",27,0) S $P(RPTDATA(1),U,14)=$$X12^IBCNERP2(365.017,$P(RPTDATA(1),U,14)) "RTN","IBCNERPE",28,0) S $P(RPTDATA(1),U,15)=$$X12^IBCNERP2(365.018,$P(RPTDATA(1),U,15)) "RTN","IBCNERPE",29,0) ; Trans dates to ext format - check format "RTN","IBCNERPE",30,0) F PC=2,9:1:12,16,17,19 S $P(RPTDATA(1),U,PC)=$$FMTE^XLFDT($P(RPTDATA(1),U,PC),"5Z") "RTN","IBCNERPE",31,0) ; "RTN","IBCNERPE",32,0) ; Loop thru mult Contact segs "RTN","IBCNERPE",33,0) S CT=0 "RTN","IBCNERPE",34,0) F S CT=$O(^IBCN(365,IEN,3,CT)) Q:'CT D "RTN","IBCNERPE",35,0) .S RPTDATA(3,CT)=$G(^IBCN(365,IEN,3,CT,0)) "RTN","IBCNERPE",36,0) .; Obtain the various Communication Text fields "RTN","IBCNERPE",37,0) .F II=1:1:3 S RPTDATA(3,CT,II)=$G(^IBCN(365,IEN,3,CT,II)) "RTN","IBCNERPE",38,0) .; Disp. blank if NOT SPECIFIED "RTN","IBCNERPE",39,0) . I $P(RPTDATA(3,CT),U)="NOT SPECIFIED" S $P(RPTDATA(3,CT),U)="" "RTN","IBCNERPE",40,0) .; Comm Qual #1-3 "RTN","IBCNERPE",41,0) .F II=1:1:3 D "RTN","IBCNERPE",42,0) ..S CNPTR=$$X12^IBCNERP2(365.021,$P(RPTDATA(3,CT),U,II*2)) "RTN","IBCNERPE",43,0) ..;;;I CNPTR'="" S $P(RPTDATA(3,CT),U,II*2)=CNPTR_": "_$P(RPTDATA(3,CT),U,II*2+1),$P(RPTDATA(3,CT),U,II*2+1)="" "RTN","IBCNERPE",44,0) ..I CNPTR'="" S RPTDATA(3,CT,II)=CNPTR_": "_$G(RPTDATA(3,CT,II)) "RTN","IBCNERPE",45,0) ; "RTN","IBCNERPE",46,0) ; Subscriber level dates (ZTP segments) "RTN","IBCNERPE",47,0) S CT=0 F S CT=$O(^IBCN(365,IEN,7,CT)) Q:'CT D "RTN","IBCNERPE",48,0) .S NODE0=$G(^IBCN(365,IEN,7,CT,0)) "RTN","IBCNERPE",49,0) .S DQUAL=$P(NODE0,U,3) I 'DQUAL Q "RTN","IBCNERPE",50,0) .S LOOP=$$GET1^DIQ(365.027,$P(NODE0,U,4)_",",.01) "RTN","IBCNERPE",51,0) .S DTYPE=$S(LOOP["C":"S",LOOP["D":"P",1:"O") "RTN","IBCNERPE",52,0) .S RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL)_U_$P(NODE0,U,2) "RTN","IBCNERPE",53,0) .Q "RTN","IBCNERPE",54,0) ; "RTN","IBCNERPE",55,0) ; Reject reasons "RTN","IBCNERPE",56,0) S CT=0 F S CT=$O(^IBCN(365,IEN,6,CT)) Q:'CT D "RTN","IBCNERPE",57,0) .S NODE0=$G(^IBCN(365,IEN,6,CT,0)) I '$P(NODE0,U,3) Q "RTN","IBCNERPE",58,0) .S ETXT=$$X12^IBCNERP2(365.017,$P(NODE0,U,3)) "RTN","IBCNERPE",59,0) .S ELOC=$P(NODE0,U,2) S:ELOC="" ELOC="N/A" "RTN","IBCNERPE",60,0) .S EACT=$$X12^IBCNERP2(365.018,$P(NODE0,U,4)) S:EACT="" EACT="N/A" "RTN","IBCNERPE",61,0) .S LOOP=$$X12^IBCNERP2(365.027,$P(NODE0,U,5)) S:LOOP="" LOOP="N/A" "RTN","IBCNERPE",62,0) .S ESRC=$P(NODE0,U,6) S:ESRC="" ESRC="N/A" "RTN","IBCNERPE",63,0) .;IB*2*497 modify existing line below to retrieve external value of ERROR CODE and ACTION CODE "RTN","IBCNERPE",64,0) . ;and build as part of the composite string at RPTDATA(6,CT). "RTN","IBCNERPE",65,0) .S RPTDATA(6,CT)=ELOC_U_$$GET1^DIQ(365.017,$P(NODE0,U,3)_",",.01)_U_ETXT_U_$$GET1^DIQ(365.018,$P(NODE0,U,4)_",",.01)_U_EACT_U_LOOP_U_ESRC "RTN","IBCNERPE",66,0) .; IB*2*497 retrieve additional messages "RTN","IBCNERPE",67,0) .S Z=0 F S Z=$O(^IBCN(365,IEN,6,CT,1,Z)) Q:'Z S RPTDATA(6,CT,"AMSG",Z)=$P($G(^IBCN(365,IEN,6,CT,1,Z,0)),U) "RTN","IBCNERPE",68,0) .Q "RTN","IBCNERPE",69,0) ; "RTN","IBCNERPE",70,0) ; Subscriber Data "RTN","IBCNERPE",71,0) S RPTDATA(13)=$G(^IBCN(365,IEN,13)) "RTN","IBCNERPE",72,0) ; "RTN","IBCNERPE",73,0) ; Group Data "RTN","IBCNERPE",74,0) S RPTDATA(14)=$G(^IBCN(365,IEN,14)) "RTN","IBCNERPE",75,0) ; "RTN","IBCNERPE",76,0) FUTDT I TQIEN D ; If there is a future date, display it "RTN","IBCNERPE",77,0) . S FUTDT=$P($G(^IBCN(365.1,TQIEN,0)),U,9) Q:FUTDT="" "RTN","IBCNERPE",78,0) . S II=$O(RPTDATA(5,""),-1)+1 "RTN","IBCNERPE",79,0) . S RPTDATA(5,II)=" ",II=II+1 "RTN","IBCNERPE",80,0) . S RPTDATA(5,II)="Inquiry will be automatically resubmitted on "_$$FMTE^XLFDT(FUTDT,"5Z")_"." "RTN","IBCNERPE",81,0) ; "RTN","IBCNERPE",82,0) GETDATX ; GETDATA exit point "RTN","IBCNERPE",83,0) Q "RTN","IBCNERPE",84,0) ; "RTN","IBCNERPE",85,0) ; This tag is only called from IBCNERP3 "RTN","IBCNERPE",86,0) ; "RTN","IBCNERPE",87,0) DATA(DISPDATA) ; Build disp lines "RTN","IBCNERPE",88,0) N LCT,CT,SEGCT,ITEM,CT2,NTCT,CNCT,ERCT,RPTDATA,DCT,DTYPE "RTN","IBCNERPE",89,0) ; Merge into local array "RTN","IBCNERPE",90,0) M RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT) "RTN","IBCNERPE",91,0) ; Build "RTN","IBCNERPE",92,0) S LCT=1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,13.01),17,"R")_$P(RPTDATA(13),U,1) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) "RTN","IBCNERPE",93,0) S LCT=LCT+1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,13.02),17,"R")_$P(RPTDATA(13),U,2) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) "RTN","IBCNERPE",94,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.02),17,"R")_$P(RPTDATA(1),U,2) "RTN","IBCNERPE",95,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.03),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,3),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.04),22,"R")_$P(RPTDATA(1),U,4) "RTN","IBCNERPE",96,0) S LCT=LCT+1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,14.01),17,"R")_$P(RPTDATA(14),U,1) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) "RTN","IBCNERPE",97,0) S LCT=LCT+1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,14.02),17,"R")_$P(RPTDATA(14),U,2) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) "RTN","IBCNERPE",98,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.08),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,8),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,8.01),22,"R")_RPTDATA(8) "RTN","IBCNERPE",99,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.18),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,18),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.13),22,"R")_$P(RPTDATA(1),U,13) "RTN","IBCNERPE",100,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.1),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,10),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.16),22,"R")_$P(RPTDATA(1),U,16) "RTN","IBCNERPE",101,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.11),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,11),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.17),22,"R")_$P(RPTDATA(1),U,17) "RTN","IBCNERPE",102,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.12),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,12),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.19),22,"R")_$P(RPTDATA(1),U,19) "RTN","IBCNERPE",103,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.07),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(0),U,7),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.09),22,"R")_$P(RPTDATA(0),U,9) "RTN","IBCNERPE",104,0) S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.2),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,20),20) "RTN","IBCNERPE",105,0) ; "RTN","IBCNERPE",106,0) ; Dates "RTN","IBCNERPE",107,0) F DTYPE="S","P","O" D "RTN","IBCNERPE",108,0) .I '$D(RPTDATA(7,DTYPE)) Q "RTN","IBCNERPE",109,0) .S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",110,0) .S LCT=LCT+1,DISPDATA(LCT)=$S(DTYPE="S":"Subscriber",DTYPE="P":"Patient",1:"Other")_" Dates:" "RTN","IBCNERPE",111,0) .S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",112,0) .S DCT="" F S DCT=$O(RPTDATA(7,DTYPE,DCT)) Q:DCT="" D "RTN","IBCNERPE",113,0) ..S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($P(RPTDATA(7,DTYPE,DCT),U)_": ",40)_$P(RPTDATA(7,DTYPE,DCT),U,2) "RTN","IBCNERPE",114,0) ..Q "RTN","IBCNERPE",115,0) .Q "RTN","IBCNERPE",116,0) ; "RTN","IBCNERPE",117,0) ; Contacts "RTN","IBCNERPE",118,0) CONT ; "RTN","IBCNERPE",119,0) N TEXT "RTN","IBCNERPE",120,0) S CNCT=+$O(RPTDATA(3,""),-1) I 'CNCT G ERR "RTN","IBCNERPE",121,0) S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",122,0) S LCT=LCT+1,DISPDATA(LCT)="CONTACT INFORMATION:" "RTN","IBCNERPE",123,0) ; Build "RTN","IBCNERPE",124,0) F CT=1:1:CNCT D "RTN","IBCNERPE",125,0) . S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",126,0) . S LCT=LCT+1,DISPDATA(LCT)=" " "RTN","IBCNERPE",127,0) . S SEGCT=$O(RPTDATA(3,CT,""),-1) "RTN","IBCNERPE",128,0) . S TEXT="" "RTN","IBCNERPE",129,0) . I $L($P(RPTDATA(3,CT),U,1)) S TEXT=$P(RPTDATA(3,CT),U,1) "RTN","IBCNERPE",130,0) . F CT2=1:1:SEGCT S ITEM=$G(RPTDATA(3,CT,CT2)) D "RTN","IBCNERPE",131,0) . . Q:'$L(ITEM) "RTN","IBCNERPE",132,0) . . S TEXT=$S($L(TEXT):" "_TEXT_", ",1:" ")_ITEM "RTN","IBCNERPE",133,0) . . F D Q:'$L(TEXT) "RTN","IBCNERPE",134,0) . . . S LCT=LCT+1,DISPDATA(LCT)=$E(TEXT,1,74) "RTN","IBCNERPE",135,0) . . . I $L(TEXT)>74 S TEXT=$E(TEXT,75,$L(TEXT)) Q "RTN","IBCNERPE",136,0) . . . S TEXT="" "RTN","IBCNERPE",137,0) . . . Q "RTN","IBCNERPE",138,0) . . Q "RTN","IBCNERPE",139,0) ; Err Info "RTN","IBCNERPE",140,0) ERR S ERCT=+$O(RPTDATA(6,""),-1) I 'ERCT G DATAX "RTN","IBCNERPE",141,0) S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",142,0) S LCT=LCT+1,DISPDATA(LCT)="ERROR INFORMATION:" "RTN","IBCNERPE",143,0) S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",144,0) F CT=1:1:ERCT D "RTN","IBCNERPE",145,0) .S LCT=LCT+1,DISPDATA(LCT)="Reject Reason Code: "_$P(RPTDATA(6,CT),U,2) ; ib*2*497 "RTN","IBCNERPE",146,0) .S LCT=LCT+1,DISPDATA(LCT)="Reject Reason Text: "_$P(RPTDATA(6,CT),U,3) ; ib*2*497 "RTN","IBCNERPE",147,0) .S LCT=LCT+1,DISPDATA(LCT)="Action Code: "_$P(RPTDATA(6,CT),U,4) ; ib*2*497 "RTN","IBCNERPE",148,0) .S LCT=LCT+1,DISPDATA(LCT)="Action Code Text: "_$P(RPTDATA(6,CT),U,5) ;IB*2*497 "RTN","IBCNERPE",149,0) .S LCT=LCT+1,DISPDATA(LCT)="HIPAA Loop: "_$P(RPTDATA(6,CT),U,6) ; ib*2*497 "RTN","IBCNERPE",150,0) .S LCT=LCT+1,DISPDATA(LCT)="HL7 Location: "_$P(RPTDATA(6,CT),U) "RTN","IBCNERPE",151,0) .S LCT=LCT+1,DISPDATA(LCT)="Error Source: "_$P(RPTDATA(6,CT),U,7) ; ib*2*497 "RTN","IBCNERPE",152,0) .I $D(RPTDATA(6,CT,"AMSG")) D "RTN","IBCNERPE",153,0) ..I ERCT>0 S LCT=LCT+1,DISPDATA(LCT)="" ; IB*506 "RTN","IBCNERPE",154,0) ..S LCT=LCT+1,DISPDATA(LCT)="Additional Messages:" "RTN","IBCNERPE",155,0) ..S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",156,0) ..S Z=0 F S Z=$O(RPTDATA(6,CT,"AMSG",Z)) Q:'Z S LCT=LCT+1,DISPDATA(LCT)=RPTDATA(6,CT,"AMSG",Z) "RTN","IBCNERPE",157,0) ..Q "RTN","IBCNERPE",158,0) .S LCT=LCT+1,DISPDATA(LCT)="" "RTN","IBCNERPE",159,0) .Q "RTN","IBCNERPE",160,0) ; "RTN","IBCNERPE",161,0) DATAX ; "RTN","IBCNERPE",162,0) N RIBVDA,RSPIENS "RTN","IBCNERPE",163,0) S RIBVDA=$P(RPTDATA(0),U,4) "RTN","IBCNERPE",164,0) S RSPIENS=$O(^IBCN(365,"AF",+$G(RIBVDA),""),-1) "RTN","IBCNERPE",165,0) ; Disp Future Date and Misc. Comments "RTN","IBCNERPE",166,0) I $O(RPTDATA(5,0))'="" D "RTN","IBCNERPE",167,0) . F CT=1:1:+$O(RPTDATA(5,""),-1) D "RTN","IBCNERPE",168,0) .. S LCT=LCT+1,DISPDATA(LCT)=" "_$$FO^IBCNEUT1("",7,"R")_$G(RPTDATA(5,CT)) "RTN","IBCNERPE",169,0) ; "RTN","IBCNERPE",170,0) ; /IB*2.0*506 Beginning "RTN","IBCNERPE",171,0) ; Added the Elig. Ben. info to print at the end of the patient's display on the e-IV Response Report. "RTN","IBCNERPE",172,0) S LCT=LCT+1,DISPDATA(LCT)=" " "RTN","IBCNERPE",173,0) K ^TMP("EIV RESP. EB DATA",$J) "RTN","IBCNERPE",174,0) N VALMEVL ; Important as the INIT^IBCNES kills an array we need to keep if VALMEVL is defined (IB*519) "RTN","IBCNERPE",175,0) ; save off certain VALM variables because call to IBCNES changes them and throws off page counter when returning to EE screen (IB*519) "RTN","IBCNERPE",176,0) ; IB*2.0*521/ZEB use $G to prevent crash when report is run from outside of a ListMan context "RTN","IBCNERPE",177,0) I $G(VALMCNT) N IBVLSV S IBVLSV=VALMCNT_U_$G(VALM("LINES"))_U_$G(^TMP("IBCNBLE",$J,VALMCNT,0)) "RTN","IBCNERPE",178,0) D INIT^IBCNES(365.02,RSPIENS_",","A",1,"EIV RESP. EB DATA") "RTN","IBCNERPE",179,0) N TCTR "RTN","IBCNERPE",180,0) S TCTR="" "RTN","IBCNERPE",181,0) F S TCTR=$O(^TMP("EIV RESP. EB DATA",$J,"DISP",TCTR)) Q:TCTR="" D "RTN","IBCNERPE",182,0) . S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($G(^TMP("EIV RESP. EB DATA",$J,"DISP",TCTR,0)),76) "RTN","IBCNERPE",183,0) ; restore VALM page-counter values to pre-IBCNES values (IB*519) "RTN","IBCNERPE",184,0) ; IB*2.0*521/ZEB use $G to prevent crash when report is run from outside of a ListMan context "RTN","IBCNERPE",185,0) I $G(IBVLSV) S VALM("LINES")=$P(IBVLSV,U,2),VALMCNT=$P(IBVLSV,U),^TMP("IBCNBLE",$J,VALMCNT,0)=$P(IBVLSV,U,3) K IBVLSV "RTN","IBCNERPE",186,0) ; /IB*2.0*506 End "RTN","IBCNERPE",187,0) ; "RTN","IBCNERPE",188,0) Q "RTN","IBCNERPE",189,0) ; "RTN","IBCNERPE",190,0) WRAPIT(ITEM,RCTR,DARRAY,MAX,INDENT) ; Module to wrap text into a display array. "RTN","IBCNERPE",191,0) ; ITEM = Text to be wrapped. "RTN","IBCNERPE",192,0) ; RCTR = Current Record counter. "RTN","IBCNERPE",193,0) ; DARRAY = Current Display Array. "RTN","IBCNERPE",194,0) ; MAX = Maximum number of characters for one line before wrapping. "RTN","IBCNERPE",195,0) ; INDENT = Character position to indent extra text when wrapping. "RTN","IBCNERPE",196,0) ; "RTN","IBCNERPE",197,0) N TXT,I,SPACE "RTN","IBCNERPE",198,0) S TXT=ITEM,$P(SPACE," ",INDENT)=" " "RTN","IBCNERPE",199,0) F D Q:'$L(TXT) "RTN","IBCNERPE",200,0) .S DARRAY(RCTR)=$E(TXT,1,MAX) "RTN","IBCNERPE",201,0) .S TXT=$E(TXT,MAX+1,$L(TXT)) Q:'$L(TXT) "RTN","IBCNERPE",202,0) .S RCTR=RCTR+1 "RTN","IBCNERPE",203,0) .S TXT=SPACE_TXT "RTN","IBCNERPE",204,0) Q "RTN","IBCNHHLO") 0^8^B11459482 "RTN","IBCNHHLO",1,0) IBCNHHLO ;ALB/ZEB - HL7 Sender for NIF transmissions ;25-FEB-14 "RTN","IBCNHHLO",2,0) ;;2.0;INTEGRATED BILLING;**519,521**;21-MAR-94;Build 33 "RTN","IBCNHHLO",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCNHHLO",4,0) ;**Program Description** "RTN","IBCNHHLO",5,0) ; This program will process outgoing NIF query messages. "RTN","IBCNHHLO",6,0) ; Call at tags only "RTN","IBCNHHLO",7,0) Q "RTN","IBCNHHLO",8,0) ;IB*2.0*521/ZEB: Used new $$CLEAN function to remove HL7 delimiters from free-text fields "RTN","IBCNHHLO",9,0) SEND(INSCO) ;INSCO: IEN of Insurance Company record to send "RTN","IBCNHHLO",10,0) Q:+$P($G(^IBE(350.9,1,70)),U,1)'=1 ;abort if secret HL7 flag isn't set "RTN","IBCNHHLO",11,0) K HLA,HLEVN "RTN","IBCNHHLO",12,0) N CNT,HL,HLFS,HLCS,HLRS,LN,INS,HLRSLT,HLCS11,HLCSCNT,TOC,PHN,HLCS4 "RTN","IBCNHHLO",13,0) S CNT=0 "RTN","IBCNHHLO",14,0) ;set up environment for message "RTN","IBCNHHLO",15,0) D INIT^HLFNC2("IB NIF QUERY DRIVER",.HL) "RTN","IBCNHHLO",16,0) S HLFS=$G(HL("FS")) I HLFS="" S HLFS="|" "RTN","IBCNHHLO",17,0) S HLCS=$E(HL("ECH"),1) "RTN","IBCNHHLO",18,0) S HLCS4=HLCS "RTN","IBCNHHLO",19,0) F HLCSCNT=1:1:3 S HLCS4=HLCS4_HLCS "RTN","IBCNHHLO",20,0) S HLCS11=HLCS4 "RTN","IBCNHHLO",21,0) F HLCSCNT=1:1:7 S HLCS11=HLCS11_HLCS "RTN","IBCNHHLO",22,0) S HLRS=$E(HL("ECH"),2) "RTN","IBCNHHLO",23,0) D R36^IBCNHUT2(INSCO,.INS) ;get info from ins. co. record "RTN","IBCNHHLO",24,0) ;Add message txt to HLA array "RTN","IBCNHHLO",25,0) ; add QPD segment "RTN","IBCNHHLO",26,0) S CNT=CNT+1,HLA("HLS",CNT)="QPD"_HLFS_"ZHPID01"_HLCS_"HPID Insurance Inquiry" "RTN","IBCNHHLO",27,0) ; add an empty RCP segment "RTN","IBCNHHLO",28,0) S CNT=CNT+1,HLA("HLS",CNT)="RCP"_HLFS_"I" "RTN","IBCNHHLO",29,0) ; add IN1 segment "RTN","IBCNHHLO",30,0) S LN=0 "RTN","IBCNHHLO",31,0) S CNT=CNT+1,HLA("HLS",CNT)="IN1"_HLFS "RTN","IBCNHHLO",32,0) S LN=LN+1,HLA("HLS",CNT,LN)="0001"_HLFS_"VA"_HLCS_"Department of Veterans Affairs"_HLFS "RTN","IBCNHHLO",33,0) S LN=LN+1,HLA("HLS",CNT,LN)=$P($$SITE^VASITE,U,3)_"."_INSCO_HLCS4_"INS" "RTN","IBCNHHLO",34,0) I $P(INS(2),U,1)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,1))_HLCS4_"PROF" "RTN","IBCNHHLO",35,0) I $P(INS(2),U,2)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,2))_HLCS4_"INST" "RTN","IBCNHHLO",36,0) I $P(INS(2),U,3)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,3))_HLCS4_$P(INS(3),U,3)_"P" "RTN","IBCNHHLO",37,0) I $P(INS(2),U,4)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,4))_HLCS4_$P(INS(3),U,4)_"P" "RTN","IBCNHHLO",38,0) I $P(INS(2),U,5)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,5))_HLCS4_$P(INS(3),U,5)_"I" "RTN","IBCNHHLO",39,0) I $P(INS(2),U,6)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$$CLEAN($P(INS(2),U,6))_HLCS4_$P(INS(3),U,6)_"I" "RTN","IBCNHHLO",40,0) I $P(INS(2),U,7)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(2),U,7)_HLCS4_"VA" "RTN","IBCNHHLO",41,0) I $P(INS(0),U,5)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(0),U,5)_HLCS4_"NIF" "RTN","IBCNHHLO",42,0) I $P(INS(0),U,6)]"" S LN=LN+1,HLA("HLS",CNT,LN)=HLRS_$P(INS(0),U,6)_HLCS4_"HPID" "RTN","IBCNHHLO",43,0) S HLA("HLS",CNT,LN)=HLA("HLS",CNT,LN)_HLFS "RTN","IBCNHHLO",44,0) S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(0),U,2))_HLFS "RTN","IBCNHHLO",45,0) S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,1))_HLCS_$$CLEAN($P(INS(1),U,2))_HLCS "RTN","IBCNHHLO",46,0) S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,3))_HLCS_$P($G(^DIC(5,+$P(INS(1),U,4),0)),U,1)_HLCS "RTN","IBCNHHLO",47,0) S LN=LN+1,HLA("HLS",CNT,LN)=$$CLEAN($P(INS(1),U,5))_HLCS_HLCS_HLFS_HLFS "RTN","IBCNHHLO",48,0) S PHN=$$CLEAN($P(INS(1),U,8)) "RTN","IBCNHHLO",49,0) S:PHN]"" PHN=HLCS11_PHN "RTN","IBCNHHLO",50,0) S LN=LN+1,HLA("HLS",CNT,LN)=PHN_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS_HLFS "RTN","IBCNHHLO",51,0) S TOC=$P(INS(1),U,7) "RTN","IBCNHHLO",52,0) S:TOC="" TOC=1 "RTN","IBCNHHLO",53,0) S LN=LN+1,HLA("HLS",CNT,LN)=$P($G(^IBE(355.2,TOC,0)),U,1) "RTN","IBCNHHLO",54,0) ; "RTN","IBCNHHLO",55,0) ;CALL HL7 TO TRANSMIT SINGLE MESSAGE "RTN","IBCNHHLO",56,0) D GENERATE^HLMA("IB NIF QUERY DRIVER","LM",1,.HLRSLT) "RTN","IBCNHHLO",57,0) S %=$$FM71^IBCNHUT2(INSCO,$P(HLRSLT,U,1)) ;update transmission queue in #367.1 "RTN","IBCNHHLO",58,0) Q "RTN","IBCNHHLO",59,0) ; "RTN","IBCNHHLO",60,0) ;IB*2.0*521/ZEB: added CLEAN tag to remove delimiters from fields for HL7 "RTN","IBCNHHLO",61,0) ;CLEAN removes HL7 separators of pipe | and tilde ~ from a string "RTN","IBCNHHLO",62,0) CLEAN(STR) ;STR: the string to clean up "RTN","IBCNHHLO",63,0) Q $TR(STR,"|~","") "RTN","IBCNHUT1") 0^7^B19687028 "RTN","IBCNHUT1",1,0) IBCNHUT1 ;ALB/GEF - HPID/OEID UTILITIES ;11-MAR-14 "RTN","IBCNHUT1",2,0) ;;2.0;INTEGRATED BILLING;**519,521**;21-MAR-94;Build 33 "RTN","IBCNHUT1",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCNHUT1",4,0) ; "RTN","IBCNHUT1",5,0) ; this routine contains various utilities for the HPID project. "RTN","IBCNHUT1",6,0) Q "RTN","IBCNHUT1",7,0) ; "RTN","IBCNHUT1",8,0) HOD(ID,INS,IBHD) ; function to determine if the data is an HPID, an OEID, or an invalid ID "RTN","IBCNHUT1",9,0) ; HPID/OEID is a 10 character string with the 1st digit being 7 for HPID & 6 for OEID "RTN","IBCNHUT1",10,0) ; and the 10th digit being a LUHN Check digit. If the optional INS value is passed, an "RTN","IBCNHUT1",11,0) ; additional validation check will be done, comparing the ID to what is currently on file "RTN","IBCNHUT1",12,0) ; for that insurance company ien. "RTN","IBCNHUT1",13,0) ; "RTN","IBCNHUT1",14,0) ; returns data string: H for HPID, O for OEID, -1 for Invalid ID "RTN","IBCNHUT1",15,0) ; to call: W $$HOD^IBCNHUT1(X,INS) or I $$HOD^IBCNHUT1(X,INS) it is not a valid ID "RTN","IBCNHUT1",16,0) ; "RTN","IBCNHUT1",17,0) ; ID = data string to validate (required) "RTN","IBCNHUT1",18,0) ; INS = insurance co. ien (optional) "RTN","IBCNHUT1",19,0) ; IBHD = Insurance co HPID in file 36 (optional) "RTN","IBCNHUT1",20,0) ; "RTN","IBCNHUT1",21,0) Q:ID'?10N "-1^HPID/OEID^*" "RTN","IBCNHUT1",22,0) ; verify the 10th digit is the Luhn check-digit "RTN","IBCNHUT1",23,0) Q:$E(ID,10)'=$$CKDGT($E(ID,1,9)) "-1^HPID/OEID^*" "RTN","IBCNHUT1",24,0) ; verify the ID matches what is in the insurance file "RTN","IBCNHUT1",25,0) I $G(INS)'="",$G(IBHD)="" S IBHD=$$HPD(INS) "RTN","IBCNHUT1",26,0) I $G(IBHD)>0,IBHD'=ID Q "-1^HPID/OEID^*" "RTN","IBCNHUT1",27,0) Q:$E(ID)=7 "H^ HPID^" "RTN","IBCNHUT1",28,0) Q:$E(ID)=6 "O^ OEID^" "RTN","IBCNHUT1",29,0) Q "-1^HPID/OEID^*" "RTN","IBCNHUT1",30,0) ; "RTN","IBCNHUT1",31,0) HPD(INS,V) ; this function returns the HPID/OEID for an insurance company "RTN","IBCNHUT1",32,0) ; The user must pass INS = Insurance Company ien in file 36 "RTN","IBCNHUT1",33,0) ; V = 1 means run validation checks (not required). Will append an '*' to the HPID if it does NOT pass validation checks "RTN","IBCNHUT1",34,0) ; "RTN","IBCNHUT1",35,0) N IBHPD "RTN","IBCNHUT1",36,0) Q:$G(INS)="" "" "RTN","IBCNHUT1",37,0) S IBHPD=$P($G(^DIC(36,INS,8)),U) Q:IBHPD="" "" "RTN","IBCNHUT1",38,0) Q $S($G(V)=1:IBHPD_$P($$HOD(IBHPD,INS,IBHPD),U,3),1:IBHPD) "RTN","IBCNHUT1",39,0) Q "" "RTN","IBCNHUT1",40,0) ; "RTN","IBCNHUT1",41,0) INS(ID,TYP,IBID) ; this function finds the ien of the insurance company entry in file 36 using the NIF ID or the HPID/OEID "RTN","IBCNHUT1",42,0) ; TYPE=N for NIF or H for HPID/OEID "RTN","IBCNHUT1",43,0) ; returns data array: IBID(0)=number of entries with this ID, IBID(n)=IEN^ID^Insurance Company name "RTN","IBCNHUT1",44,0) ; TO CALL: $$INS^IBCNHUT1(ID,TYP,.ARRAY NAME) "RTN","IBCNHUT1",45,0) ; 11/7/14 - cross-reference format changed with HPID Build 2, now AHOD & ANIF "RTN","IBCNHUT1",46,0) N C,IEN "RTN","IBCNHUT1",47,0) S IBID(0)=0,IBID="" "RTN","IBCNHUT1",48,0) Q:$G(ID)<1 IBID "RTN","IBCNHUT1",49,0) I $E(TYP)="N" D "RTN","IBCNHUT1",50,0) .S IEN=0,C=0 F S IEN=$O(^DIC(36,"ANIF",ID,IEN)) Q:'IEN D "RTN","IBCNHUT1",51,0) ..S C=C+1,IBID(0)=C,IBID(C)=IEN_U_ID_U_$P($G(^DIC(36,IEN,0)),U) "RTN","IBCNHUT1",52,0) I $E(TYP)="H" D "RTN","IBCNHUT1",53,0) .S IEN=0,C=0 F S IEN=$O(^DIC(36,"AHOD",ID,IEN)) Q:'IEN D "RTN","IBCNHUT1",54,0) ..S C=C+1,IBID(0)=C,IBID(C)=IEN_U_ID_U_$P($G(^DIC(36,IEN,0)),U) "RTN","IBCNHUT1",55,0) Q IBID "RTN","IBCNHUT1",56,0) ; "RTN","IBCNHUT1",57,0) NIF(INS) ; this function finds the NIF ID for an insurance company using the ien "RTN","IBCNHUT1",58,0) ; INS=Insurance Company ien in file 36 "RTN","IBCNHUT1",59,0) ; "RTN","IBCNHUT1",60,0) Q:$G(INS)="" "" "RTN","IBCNHUT1",61,0) Q $P($G(^DIC(36,INS,8)),U,4) "RTN","IBCNHUT1",62,0) Q "" "RTN","IBCNHUT1",63,0) ; "RTN","IBCNHUT1",64,0) SHP(INS) ; this function determines if the entry is a CHP or SHP "RTN","IBCNHUT1",65,0) ; INS = insurance company ien in file 36. Returns C for CHP (Controlling Health Plan) and S for SHP (Sub-Health Plan) "RTN","IBCNHUT1",66,0) ; "RTN","IBCNHUT1",67,0) Q:$G(INS)="" "" "RTN","IBCNHUT1",68,0) Q $P($G(^DIC(36,INS,8)),U,2) "RTN","IBCNHUT1",69,0) Q "" "RTN","IBCNHUT1",70,0) ; "RTN","IBCNHUT1",71,0) PHP(INS) ; this function returns the parent HPID insurance company if applicable "RTN","IBCNHUT1",72,0) ; "RTN","IBCNHUT1",73,0) Q:$G(INS)="" "" "RTN","IBCNHUT1",74,0) Q $P($G(^DIC(36,INS,8)),U,3) "RTN","IBCNHUT1",75,0) Q "" "RTN","IBCNHUT1",76,0) ; "RTN","IBCNHUT1",77,0) VID(INS) ; this function gets the VA National ID for the insurance company/payer "RTN","IBCNHUT1",78,0) ; "RTN","IBCNHUT1",79,0) N IBAPP,IBPYR,IBPY0 "RTN","IBCNHUT1",80,0) ; get the ien of the IIV payer application "RTN","IBCNHUT1",81,0) S IBAPP=$O(^IBE(365.13,"B","IIV","")) Q:IBAPP="" "" "RTN","IBCNHUT1",82,0) ; find the payer "RTN","IBCNHUT1",83,0) S IBPYR=$P($G(^DIC(36,INS,3)),U,10) Q:IBPYR="" "" "RTN","IBCNHUT1",84,0) S IBPY0=$G(^IBE(365.12,IBPYR,1,IBAPP,0)) I $P(IBPY0,U,2)=1,$P(IBPY0,U,3)=1 Q $P($G(^IBE(365.12,IBPYR,0)),U,2) "RTN","IBCNHUT1",85,0) Q "" "RTN","IBCNHUT1",86,0) ; "RTN","IBCNHUT1",87,0) UID(INS) ; this function creates the Vista Unique Site ID to send to the NIF "RTN","IBCNHUT1",88,0) ; returns station#_"."_insurance company ien "RTN","IBCNHUT1",89,0) Q:INS="" "" "RTN","IBCNHUT1",90,0) Q $P($$SITE^VASITE(),U,3)_"."_INS "RTN","IBCNHUT1",91,0) ; "RTN","IBCNHUT1",92,0) TRG1(IEN,ST) ; this function sets the trigger for the DATE OF FUTURE PURGE (.1) field in file #367.1 "RTN","IBCNHUT1",93,0) ;(HPID/OEID TRANSMISSION QUEUE). If the PROCESSING STATUS (.05) = R for Response Recieved or EXR "RTN","IBCNHUT1",94,0) ; for Exception Report Reject and the response included a NIF ID, set the purge date to T+14 "RTN","IBCNHUT1",95,0) ; called from field .05 (PROCESSING STATUS ) of file 367 (HPID/OEID RESPONSE). "RTN","IBCNHUT1",96,0) ; IEN = entry number in file 367, ST=Transmission status being set "RTN","IBCNHUT1",97,0) ; "RTN","IBCNHUT1",98,0) N RSP,ID "RTN","IBCNHUT1",99,0) ; as of 6/23/14, no longer purging EXR "RTN","IBCNHUT1",100,0) ;I $E(ST)'="R"&(ST'="EXR") Q "" "RTN","IBCNHUT1",101,0) Q:$E(ST)'="R" "" "RTN","IBCNHUT1",102,0) ; if response type is UNSOLICITED, set purge date (don't care about NIF ID for these) "RTN","IBCNHUT1",103,0) Q:$P($G(^IBCNH(367,IEN,0)),U,3)="U" $$FMADD^XLFDT($$NOW^XLFDT,+14) "RTN","IBCNHUT1",104,0) ; also don't care about NIF ID if EXR "RTN","IBCNHUT1",105,0) ; as of 6/23/14, don't set purge data for EXR "RTN","IBCNHUT1",106,0) ;Q:ST="EXR" $$FMADD^XLFDT($$NOW^XLFDT,+14) "RTN","IBCNHUT1",107,0) ; check response in file 367 for NIF ID, if response contains NIF ID, set future purge date "RTN","IBCNHUT1",108,0) ; format of D xref: ^IBCNH(367,"D",8 (for NIF ID),ien in file 367,ID multiple ien)="" "RTN","IBCNHUT1",109,0) Q:'$D(^IBCNH(367,"D",8,IEN)) "" "RTN","IBCNHUT1",110,0) S ID=$O(^IBCNH(367,"D",8,IEN,"")) Q:$P($G(^IBCNH(367,IEN,1,ID,0)),U,2)="" "" "RTN","IBCNHUT1",111,0) Q $$FMADD^XLFDT($$NOW^XLFDT,+14) "RTN","IBCNHUT1",112,0) ; "RTN","IBCNHUT1",113,0) UNSOL(HLID,RTY,ID,DATA) ; this code handles unsolicited responses which only have the NIF ID, no insurance ien "RTN","IBCNHUT1",114,0) ; If there are multiple entries in file 36 with the same NIF ID, this code will update all of them. "RTN","IBCNHUT1",115,0) ; "RTN","IBCNHUT1",116,0) N DIC,X,Y,DIE,DA,DR,I,C,INS,PS,ARRAY,DLAYGO "RTN","IBCNHUT1",117,0) Q:RTY'="U" "-1^ED^Error: Not an unsolicited response!" "RTN","IBCNHUT1",118,0) ; create new entry in 367 for unsolicited responses "RTN","IBCNHUT1",119,0) S DIC="^IBCNH(367,",DIC(0)="LS",X=HLID,DLAYGO=367 D ^DIC S IEN=+Y Q:Y=-1 "-1^ED^DATABASE Error: HPID RESPONSE entry NOT added!" "RTN","IBCNHUT1",120,0) S DIE=DIC,DA=IEN,DR=".01///"_HLID_";.03///"_RTY K DIC D ^DIE "RTN","IBCNHUT1",121,0) ; Now find every entry in file 36 that has this NIF ID and update it "RTN","IBCNHUT1",122,0) S X=$$INS($P(ID,U,8),"N",.ARRAY) "RTN","IBCNHUT1",123,0) ; loop through each entry and update file 36 "RTN","IBCNHUT1",124,0) S C=$G(ARRAY(0)) S:C<1 PS=IEN_"^ED^DATABASE Error: NIF ID does not exist at this site!" "RTN","IBCNHUT1",125,0) F I=1:1:C S INS=$P($G(ARRAY(I)),U),PS=$$FM36^IBCNHUT2(INS,$P(ID,U,9)_U_$P(DATA,U,9)_U_$P(DATA,U,8)_U_$P(ID,U,8)) "RTN","IBCNHUT1",126,0) ; update field .05 in file 367 (PROCESSING STATUS) "RTN","IBCNHUT1",127,0) Q $$STAT(IEN,$P(PS,U,2)) "RTN","IBCNHUT1",128,0) ; "RTN","IBCNHUT1",129,0) STAT(IEN,STAT) ; updates field .05 in file 367 (PROCESSING STATUS) "RTN","IBCNHUT1",130,0) N DIC,DA,DR "RTN","IBCNHUT1",131,0) S DIE="^IBCNH(367,",DA=IEN,DR=".05///"_STAT D ^DIE "RTN","IBCNHUT1",132,0) K DIC,DA,DR "RTN","IBCNHUT1",133,0) Q IEN "RTN","IBCNHUT1",134,0) ; "RTN","IBCNHUT1",135,0) CKDGT(ID) ; Function to calculate and return the check digit of an HPID "RTN","IBCNHUT1",136,0) ; The check digit is calculated using the Luhn Formula for "RTN","IBCNHUT1",137,0) ; Modulus 10 "double-add-double" Check Digit. A value of 24 is "RTN","IBCNHUT1",138,0) ; added to the total to account for the implied USA (80840) prefix. "RTN","IBCNHUT1",139,0) ; "RTN","IBCNHUT1",140,0) N IBCTOT,IBCN,IBCDIG,IBI "RTN","IBCNHUT1",141,0) S IBCTOT=24 "RTN","IBCNHUT1",142,0) F IBI=9:-2:1 S IBCN=2*$E(ID,IBI),IBCTOT=IBCTOT+$E(IBCN)+$E(IBCN,2)+$E(ID,IBI-1) "RTN","IBCNHUT1",143,0) S IBCDIG=150-IBCTOT "RTN","IBCNHUT1",144,0) Q $E(IBCDIG,$L(IBCDIG)) "RTN","IBCNHUT1",145,0) ; "RTN","IBCNHUT1",146,0) EXR(INS) ; Purge EXR records if the EDI numbers get updated. "RTN","IBCNHUT1",147,0) ; if the insurance company has an EXR response (Exception Report Reject), and the EDI#'s "RTN","IBCNHUT1",148,0) ; get updated, purge the EXR response. "RTN","IBCNHUT1",149,0) Q:INS="" "RTN","IBCNHUT1",150,0) N DA,TQIEN,RSIEN,DIK "RTN","IBCNHUT1",151,0) S TQIEN="" F S TQIEN=$O(^IBCNH(367.1,"INS",INS,TQIEN)) Q:'TQIEN D "RTN","IBCNHUT1",152,0) .S RSIEN=$P($G(^IBCNH(367.1,TQIEN,0)),U,7) Q:RSIEN="" "RTN","IBCNHUT1",153,0) .Q:$P($G(^IBCNH(367,RSIEN,0)),U,5)'="EXR" "RTN","IBCNHUT1",154,0) .S DA=TQIEN,DIK="^IBCNH(367.1," D ^DIK "RTN","IBCNHUT1",155,0) .S DA=RSIEN,DIK="^IBCNH(367," D ^DIK "RTN","IBCNHUT1",156,0) K DA,TQIEN,RSIEN,DIK "RTN","IBCNHUT1",157,0) Q "RTN","IBCNSGE") 0^5^B103633903 "RTN","IBCNSGE",1,0) IBCNSGE ;ALB/ESG - Insurance Company EDI Parameter Report ;07-JAN-2005 "RTN","IBCNSGE",2,0) ;;2.0;INTEGRATED BILLING;**296,400,521**;21-MAR-94;Build 33 "RTN","IBCNSGE",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBCNSGE",4,0) ; "RTN","IBCNSGE",5,0) ; eClaims Plus "RTN","IBCNSGE",6,0) ; Identify insurance companies and display EDI parameter information. "RTN","IBCNSGE",7,0) ; "RTN","IBCNSGE",8,0) ; "RTN","IBCNSGE",9,0) EN ; Entry Point "RTN","IBCNSGE",10,0) NEW IBRINS,IBRBID,IBRINS1,IBRINS2,IBRSORT,STOP "RTN","IBCNSGE",11,0) D SELECT I STOP G EXIT "RTN","IBCNSGE",12,0) D SORT I STOP G EXIT "RTN","IBCNSGE",13,0) D DEVICE "RTN","IBCNSGE",14,0) EXIT ; "RTN","IBCNSGE",15,0) Q "RTN","IBCNSGE",16,0) ; "RTN","IBCNSGE",17,0) SELECT ; Select insurance companies to include on the report "RTN","IBCNSGE",18,0) NEW DIR,DIC,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,IBQ "RTN","IBCNSGE",19,0) SEL1 ; "RTN","IBCNSGE",20,0) S STOP=0,IBQ=0 "RTN","IBCNSGE",21,0) W @IOF "RTN","IBCNSGE",22,0) W !!?21,"Insurance Company EDI Parameter Report" "RTN","IBCNSGE",23,0) W !!?5,"This report will display the EDI parameter information for selected" "RTN","IBCNSGE",24,0) W !?5,"insurance companies. You can specify one company, multiple companies," "RTN","IBCNSGE",25,0) W !?5,"a range of company names, or all companies on file." "RTN","IBCNSGE",26,0) ; "RTN","IBCNSGE",27,0) S DIR(0)="SO^A:Include All Insurance Companies;S:Select Specific Insurance Companies;R:Specify a Range of Insurance Company Names" "RTN","IBCNSGE",28,0) S DIR("A")=" Method for selecting insurance companies" "RTN","IBCNSGE",29,0) S DIR("B")="A" "RTN","IBCNSGE",30,0) S DIR("?",1)="Enter a code from the list. This defines how you want to select insurance" "RTN","IBCNSGE",31,0) S DIR("?",2)="companies for this report." "RTN","IBCNSGE",32,0) S DIR("?",3)="" "RTN","IBCNSGE",33,0) S DIR("?",4)="If you choose 'A', then all active companies will be included." "RTN","IBCNSGE",34,0) S DIR("?",5)="If you choose 'S', then one or more specific companies can be selected." "RTN","IBCNSGE",35,0) S DIR("?")="If you choose 'R', then you can enter a range of company names." "RTN","IBCNSGE",36,0) D ^DIR K DIR "RTN","IBCNSGE",37,0) I $D(DIRUT) S STOP=1 G SELX "RTN","IBCNSGE",38,0) S IBRINS=Y "RTN","IBCNSGE",39,0) I '$F(".A.S.R.","."_IBRINS_".") S STOP=1 G SELX "RTN","IBCNSGE",40,0) I IBRINS="S" D MULT I IBQ G SEL1 ; choose one or many "RTN","IBCNSGE",41,0) I IBRINS="R" D RANGE I IBQ G SEL1 ; choose a range "RTN","IBCNSGE",42,0) ; "RTN","IBCNSGE",43,0) W ! "RTN","IBCNSGE",44,0) S DIR(0)="YO" "RTN","IBCNSGE",45,0) S DIR("A",1)="Only include Insurance Companies with Electronic" "RTN","IBCNSGE",46,0) S DIR("A")=" Bill ID's that are blank or contain ""PRNT""" "RTN","IBCNSGE",47,0) S DIR("B")="NO" "RTN","IBCNSGE",48,0) S DIR("?",1)="Enter either 'Y' or 'N'. If you choose 'Y', then this will limit the selection" "RTN","IBCNSGE",49,0) S DIR("?",2)="of insurance companies. Only those companies in which the Inst ID or the Prof" "RTN","IBCNSGE",50,0) S DIR("?",3)="ID is either blank or contains ""PRNT"" (uppercase or lowercase)" "RTN","IBCNSGE",51,0) S DIR("?")="will be included." "RTN","IBCNSGE",52,0) D ^DIR K DIR "RTN","IBCNSGE",53,0) I $D(DIRUT) S STOP=1 G SELX "RTN","IBCNSGE",54,0) S IBRBID=Y "RTN","IBCNSGE",55,0) SELX ; "RTN","IBCNSGE",56,0) Q "RTN","IBCNSGE",57,0) ; "RTN","IBCNSGE",58,0) MULT ; select one or many insurance companies "RTN","IBCNSGE",59,0) NEW DIC,X,Y "RTN","IBCNSGE",60,0) K IBRINS S IBRINS="S" "RTN","IBCNSGE",61,0) F D Q:Y'>0 "RTN","IBCNSGE",62,0) . W ! S DIC("A")="Insurance Company: " "RTN","IBCNSGE",63,0) . S DIC("S")="I $$ACTIVE^IBCNEUT4(Y)" ; screen out Inactives "RTN","IBCNSGE",64,0) . S DIC=36,DIC(0)="AEQM" D ^DIC "RTN","IBCNSGE",65,0) . Q:Y'>0 "RTN","IBCNSGE",66,0) . S IBRINS(+Y)=$P($G(^DIC(36,+Y,0)),U,1) "RTN","IBCNSGE",67,0) . Q "RTN","IBCNSGE",68,0) I $O(IBRINS(""))="" S IBQ=1 G MULTX ; none selected "RTN","IBCNSGE",69,0) MULTX ; "RTN","IBCNSGE",70,0) Q "RTN","IBCNSGE",71,0) ; "RTN","IBCNSGE",72,0) RANGE ; select a range of insurance company names "RTN","IBCNSGE",73,0) K IBRINS1,IBRINS2 "RTN","IBCNSGE",74,0) W ! "RTN","IBCNSGE",75,0) S DIR(0)="FO",DIR("A")="Start with Insurance Company" "RTN","IBCNSGE",76,0) S DIR("?",1)="This response can be free text." "RTN","IBCNSGE",77,0) S DIR("?",2)="Responses are case sensitive." "RTN","IBCNSGE",78,0) S DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna." "RTN","IBCNSGE",79,0) S DIR("B")="First" D ^DIR K DIR "RTN","IBCNSGE",80,0) I $D(DIRUT) S IBQ=1 G RANGEX "RTN","IBCNSGE",81,0) S IBRINS1=Y "RTN","IBCNSGE",82,0) I IBRINS1="First" S IBRINS1=" " "RTN","IBCNSGE",83,0) ; "RTN","IBCNSGE",84,0) W ! "RTN","IBCNSGE",85,0) S DIR(0)="FO",DIR("A")="Go to Insurance Company" "RTN","IBCNSGE",86,0) S DIR("?",1)="This response can be free text." "RTN","IBCNSGE",87,0) S DIR("?",2)="Responses are case sensitive." "RTN","IBCNSGE",88,0) S DIR("?")="Example: To find CIGNA, type CIGNA not cigna or Cigna." "RTN","IBCNSGE",89,0) S DIR("B")="Last" D ^DIR K DIR "RTN","IBCNSGE",90,0) I $D(DIRUT) S IBQ=1 G RANGEX "RTN","IBCNSGE",91,0) S IBRINS2=Y "RTN","IBCNSGE",92,0) I IBRINS2="Last" S IBRINS2="~~~~~" "RTN","IBCNSGE",93,0) ; "RTN","IBCNSGE",94,0) I IBRINS1=" ",IBRINS2="~~~~~" D G RANGEX "RTN","IBCNSGE",95,0) . K IBRINS,IBRINS1,IBRINS2 "RTN","IBCNSGE",96,0) . S IBRINS="A" "RTN","IBCNSGE",97,0) . Q "RTN","IBCNSGE",98,0) ; "RTN","IBCNSGE",99,0) I IBRINS1]IBRINS2 D G RANGE "RTN","IBCNSGE",100,0) . W !!?5,"Sorry ..... Ending name must come after Starting name" "RTN","IBCNSGE",101,0) . W !!?5,"Please try again",*7 "RTN","IBCNSGE",102,0) . Q "RTN","IBCNSGE",103,0) ; "RTN","IBCNSGE",104,0) RANGEX ; "RTN","IBCNSGE",105,0) Q "RTN","IBCNSGE",106,0) ; "RTN","IBCNSGE",107,0) SORT ; Choose the sorting method "RTN","IBCNSGE",108,0) NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT "RTN","IBCNSGE",109,0) W !!?5,"*** Sort Criteria ***" "RTN","IBCNSGE",110,0) S DIR(0)="SO^1:Insurance Company Name;2:Prof Electronic Bill ID;3:Inst Electronic Bill ID;4:Electronic Type;5:Type Of Coverage;6:Use VAMC as Billing Provider" "RTN","IBCNSGE",111,0) S DIR("A")="Sort By",DIR("B")=1 "RTN","IBCNSGE",112,0) D ^DIR K DIR "RTN","IBCNSGE",113,0) I $D(DIRUT) S STOP=1 G SORTX "RTN","IBCNSGE",114,0) S IBRSORT=Y "RTN","IBCNSGE",115,0) SORTX ; "RTN","IBCNSGE",116,0) Q "RTN","IBCNSGE",117,0) ; "RTN","IBCNSGE",118,0) COMPILE ; Entry point for task; compile scratch global, print, clean-up "RTN","IBCNSGE",119,0) ; "RTN","IBCNSGE",120,0) NEW RTN,INSIEN,INSNM,DATA,ADDR,EDI,PROFID,INSTID,NAME,STREET,CITY "RTN","IBCNSGE",121,0) NEW STATE,TYPCOV,TRANS,INSTYP,SORT,TMP,FLG,FLGP,FLGI,SWBCK,IBHPD "RTN","IBCNSGE",122,0) ; "RTN","IBCNSGE",123,0) S RTN="IBCNSGE" "RTN","IBCNSGE",124,0) KILL ^TMP($J,RTN) ; init "RTN","IBCNSGE",125,0) ; "RTN","IBCNSGE",126,0) ; all insurances "RTN","IBCNSGE",127,0) I IBRINS="A" D "RTN","IBCNSGE",128,0) . S INSIEN=0 "RTN","IBCNSGE",129,0) . F S INSIEN=$O(^DIC(36,INSIEN)) Q:'INSIEN D CALC(INSIEN) "RTN","IBCNSGE",130,0) . Q "RTN","IBCNSGE",131,0) ; "RTN","IBCNSGE",132,0) ; specific insurances "RTN","IBCNSGE",133,0) I IBRINS="S" D "RTN","IBCNSGE",134,0) . S INSIEN=0 "RTN","IBCNSGE",135,0) . F S INSIEN=$O(IBRINS(INSIEN)) Q:'INSIEN D CALC(INSIEN) "RTN","IBCNSGE",136,0) . Q "RTN","IBCNSGE",137,0) ; "RTN","IBCNSGE",138,0) ; a range of insurances "RTN","IBCNSGE",139,0) I IBRINS="R" D "RTN","IBCNSGE",140,0) . S INSNM=$O(^DIC(36,"B",IBRINS1),-1) "RTN","IBCNSGE",141,0) . F S INSNM=$O(^DIC(36,"B",INSNM)) Q:INSNM="" Q:INSNM]IBRINS2 D "RTN","IBCNSGE",142,0) .. S INSIEN=0 "RTN","IBCNSGE",143,0) .. F S INSIEN=$O(^DIC(36,"B",INSNM,INSIEN)) Q:'INSIEN D CALC(INSIEN) "RTN","IBCNSGE",144,0) .. Q "RTN","IBCNSGE",145,0) . Q "RTN","IBCNSGE",146,0) ; "RTN","IBCNSGE",147,0) D PRINT ; print the report "RTN","IBCNSGE",148,0) D ^%ZISC ; close the device "RTN","IBCNSGE",149,0) KILL ^TMP($J,RTN) ; kill scratch global "RTN","IBCNSGE",150,0) I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record "RTN","IBCNSGE",151,0) COMPX ; "RTN","IBCNSGE",152,0) Q "RTN","IBCNSGE",153,0) ; "RTN","IBCNSGE",154,0) CALC(INS) ; extract insurance data for company ien=INS "RTN","IBCNSGE",155,0) ; "RTN","IBCNSGE",156,0) I '$$ACTIVE^IBCNEUT4(INS) G CALCX ; not active "RTN","IBCNSGE",157,0) S DATA=$G(^DIC(36,INS,0)) "RTN","IBCNSGE",158,0) S ADDR=$G(^DIC(36,INS,.11)) "RTN","IBCNSGE",159,0) S EDI=$G(^DIC(36,INS,3)) "RTN","IBCNSGE",160,0) S FLG=$G(^DIC(36,INS,4)) "RTN","IBCNSGE",161,0) S FLGP=+$P(FLG,U,11) ; prof switchback flag "RTN","IBCNSGE",162,0) S FLGI=+$P(FLG,U,12) ; inst switchback flag "RTN","IBCNSGE",163,0) S PROFID=$P(EDI,U,2) "RTN","IBCNSGE",164,0) S INSTID=$P(EDI,U,4) "RTN","IBCNSGE",165,0) ; "RTN","IBCNSGE",166,0) I IBRBID,PROFID'="",INSTID'="",$$UP^XLFSTR(PROFID)'["PRNT",$$UP^XLFSTR(INSTID)'["PRNT" G CALCX "RTN","IBCNSGE",167,0) ; "RTN","IBCNSGE",168,0) S NAME=$P(DATA,U,1) S:NAME="" NAME="~UNK" "RTN","IBCNSGE",169,0) S STREET=$P(ADDR,U,1) "RTN","IBCNSGE",170,0) S CITY=$P(ADDR,U,4) "RTN","IBCNSGE",171,0) S STATE=+$P(ADDR,U,5) "RTN","IBCNSGE",172,0) S STATE=$S(STATE:$P($G(^DIC(5,STATE,0)),U,2),1:"") "RTN","IBCNSGE",173,0) S TYPCOV=$$EXTERNAL^DILFD(36,.13,,$P(DATA,U,13)) "RTN","IBCNSGE",174,0) S TRANS=$$EXTERNAL^DILFD(36,3.01,,$P(EDI,U,1)) "RTN","IBCNSGE",175,0) S INSTYP=$$EXTERNAL^DILFD(36,3.09,,$P(EDI,U,9)) "RTN","IBCNSGE",176,0) S SWBCK="~" ; default no switchback flags set; sort these at the end "RTN","IBCNSGE",177,0) I FLGP,FLGI S SWBCK="BOTH" "RTN","IBCNSGE",178,0) I FLGP,'FLGI S SWBCK="PROF" "RTN","IBCNSGE",179,0) I 'FLGP,FLGI S SWBCK="INST" "RTN","IBCNSGE",180,0) ; "RTN","IBCNSGE",181,0) S SORT=" " "RTN","IBCNSGE",182,0) I IBRSORT=1,NAME'="" S SORT=" "_NAME "RTN","IBCNSGE",183,0) I IBRSORT=2,PROFID'="" S SORT=" "_PROFID "RTN","IBCNSGE",184,0) I IBRSORT=3,INSTID'="" S SORT=" "_INSTID "RTN","IBCNSGE",185,0) I IBRSORT=4,INSTYP'="" S SORT=" "_INSTYP "RTN","IBCNSGE",186,0) I IBRSORT=5,TYPCOV'="" S SORT=" "_TYPCOV "RTN","IBCNSGE",187,0) I IBRSORT=6,SWBCK'="" S SORT=" "_SWBCK "RTN","IBCNSGE",188,0) S TMP=NAME_U_STREET_U_CITY_U_STATE_U_INSTYP_U_TYPCOV_U_TRANS_U_INSTID_U_PROFID_U_SWBCK "RTN","IBCNSGE",189,0) S ^TMP($J,RTN,SORT,NAME,INS)=TMP "RTN","IBCNSGE",190,0) CALCX ; "RTN","IBCNSGE",191,0) Q "RTN","IBCNSGE",192,0) ; "RTN","IBCNSGE",193,0) PRINT ; print the report to the specified device "RTN","IBCNSGE",194,0) NEW MAXCNT,CRT,PAGECNT,STOP,SORT,NAME,INS,DATA,DIR,X,Y,DIRUT,DUOUT,DTOUT,DIROUT "RTN","IBCNSGE",195,0) I IOST["C-" S MAXCNT=IOSL-3,CRT=1 "RTN","IBCNSGE",196,0) E S MAXCNT=IOSL-6,CRT=0 "RTN","IBCNSGE",197,0) S PAGECNT=0,STOP=0 "RTN","IBCNSGE",198,0) ; "RTN","IBCNSGE",199,0) I '$D(^TMP($J,RTN)) D HEADER W !!!?5,"No Data Found" "RTN","IBCNSGE",200,0) ; "RTN","IBCNSGE",201,0) S SORT="" "RTN","IBCNSGE",202,0) F S SORT=$O(^TMP($J,RTN,SORT)) Q:SORT="" D Q:STOP "RTN","IBCNSGE",203,0) . S NAME="" "RTN","IBCNSGE",204,0) . F S NAME=$O(^TMP($J,RTN,SORT,NAME)) Q:NAME="" D Q:STOP "RTN","IBCNSGE",205,0) .. S INS=0 "RTN","IBCNSGE",206,0) .. F S INS=$O(^TMP($J,RTN,SORT,NAME,INS)) Q:'INS D Q:STOP "RTN","IBCNSGE",207,0) ... S DATA=$G(^TMP($J,RTN,SORT,NAME,INS)) "RTN","IBCNSGE",208,0) ... I $P(DATA,U,10)["~" S $P(DATA,U,10)="" "RTN","IBCNSGE",209,0) ... I $Y+1>MAXCNT!'PAGECNT D HEADER Q:STOP "RTN","IBCNSGE",210,0) ... W !,$E($P(DATA,U,1),1,25) ; name "RTN","IBCNSGE",211,0) ... W ?27,$E($P(DATA,U,2),1,19) ; address1 "RTN","IBCNSGE",212,0) ... W ?47,$E($P(DATA,U,3),1,13) ; city, st "RTN","IBCNSGE",213,0) ... I $P(DATA,U,3)'="",$P(DATA,U,4)'="" W "," "RTN","IBCNSGE",214,0) ... W $E($P(DATA,U,4),1,2) "RTN","IBCNSGE",215,0) ... W ?65,$E($P(DATA,U,7),1,8) ; transmit elec "RTN","IBCNSGE",216,0) ... W ?75,$E($P(DATA,U,8),1,8) ; inst payer id "RTN","IBCNSGE",217,0) ... W ?84,$E($P(DATA,U,9),1,8) ; prof payer id "RTN","IBCNSGE",218,0) ... ; IB*2.0*521 add validated HPID to report and adjust Electronic type display "RTN","IBCNSGE",219,0) ... S IBHPD=$$HPD^IBCNHUT1(INS,1) "RTN","IBCNSGE",220,0) ... W ?93,IBHPD "RTN","IBCNSGE",221,0) ... ;W ?94,$E($P(DATA,U,5),1,12) ; ins type "RTN","IBCNSGE",222,0) ... ;W ?108,$E($P(DATA,U,6),1,18) ; type of cov "RTN","IBCNSGE",223,0) ... W ?105,$S($E($P(DATA,U,5))="G":"GP PLAN",1:$E($P(DATA,U,5),1,7)) ; ins type "RTN","IBCNSGE",224,0) ... W ?113,$E($P(DATA,U,6),1,14) ; type of cov "RTN","IBCNSGE",225,0) ... W ?128,$E($P(DATA,U,10),1,4) ; switchback flag "RTN","IBCNSGE",226,0) ... Q "RTN","IBCNSGE",227,0) .. Q "RTN","IBCNSGE",228,0) . Q "RTN","IBCNSGE",229,0) ; "RTN","IBCNSGE",230,0) I STOP G PRINTX "RTN","IBCNSGE",231,0) W !!?5,"*** End of Report ***" "RTN","IBCNSGE",232,0) I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR "RTN","IBCNSGE",233,0) PRINTX ; "RTN","IBCNSGE",234,0) Q "RTN","IBCNSGE",235,0) ; "RTN","IBCNSGE",236,0) HEADER ; page break and report header information "RTN","IBCNSGE",237,0) NEW LIN,HDR,TAB,C1,C2 "RTN","IBCNSGE",238,0) S STOP=0 "RTN","IBCNSGE",239,0) I CRT,PAGECNT>0,'$D(ZTQUEUED) D I STOP G HEADX "RTN","IBCNSGE",240,0) . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W ! "RTN","IBCNSGE",241,0) . S DIR(0)="E" D ^DIR K DIR "RTN","IBCNSGE",242,0) . I 'Y S STOP=1 Q "RTN","IBCNSGE",243,0) . Q "RTN","IBCNSGE",244,0) ; "RTN","IBCNSGE",245,0) S PAGECNT=PAGECNT+1 "RTN","IBCNSGE",246,0) W @IOF,! "RTN","IBCNSGE",247,0) ; "RTN","IBCNSGE",248,0) I IBRINS="A" W "All Companies" "RTN","IBCNSGE",249,0) I IBRINS="S" W "Selected Companies" "RTN","IBCNSGE",250,0) I IBRINS="R" D ; range description "RTN","IBCNSGE",251,0) . S C1=IBRINS1 I C1=" " S C1="First" "RTN","IBCNSGE",252,0) . S C2=IBRINS2 I C2="~~~~~" S C2="Last" "RTN","IBCNSGE",253,0) . W "Companies [",C1,"] through [",C2,"]" "RTN","IBCNSGE",254,0) . Q "RTN","IBCNSGE",255,0) ; "RTN","IBCNSGE",256,0) W ?45," Insurance Company EDI Parameter Report" "RTN","IBCNSGE",257,0) S HDR="Page: "_PAGECNT,TAB=132-$L(HDR)-1 "RTN","IBCNSGE",258,0) W ?TAB,HDR "RTN","IBCNSGE",259,0) ; "RTN","IBCNSGE",260,0) W !,"Sorted By " "RTN","IBCNSGE",261,0) I IBRSORT=1 W "Ins Company Name" "RTN","IBCNSGE",262,0) I IBRSORT=2 W "Prof ID" "RTN","IBCNSGE",263,0) I IBRSORT=3 W "Inst ID" "RTN","IBCNSGE",264,0) I IBRSORT=4 W "Electronic Type" "RTN","IBCNSGE",265,0) I IBRSORT=5 W "Type of Coverage" "RTN","IBCNSGE",266,0) I IBRSORT=6 W "Use VAMC as Billing Provider" "RTN","IBCNSGE",267,0) S HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z"),TAB=132-$L(HDR)-1 "RTN","IBCNSGE",268,0) W ?TAB,HDR "RTN","IBCNSGE",269,0) ; "RTN","IBCNSGE",270,0) ; IB*2.0*521 add validated HPID to report "RTN","IBCNSGE",271,0) ;W !,"Only Blank or 'PRNT' Bill ID's = ",$S(IBRBID:"YES",1:"NO"),?128,"VAMC" "RTN","IBCNSGE",272,0) ;W !?65,"Electron",?75,"Inst",?84,"Prof",?94,"Electronic",?128,"Bill" "RTN","IBCNSGE",273,0) W !,"Only Blank or 'PRNT' Bill ID's = ",$S(IBRBID:"YES",1:"NO") "RTN","IBCNSGE",274,0) W !,"'*' indicates the HPID/OEID failed validation checks",?128,"VAMC" "RTN","IBCNSGE",275,0) W !?65,"Electron",?75,"Inst",?84,"Prof",?93,"HPID/",?102,"Electronic",?128,"Bill" "RTN","IBCNSGE",276,0) W !,"Insurance Company Name",?27,"Street Address",?47,"City" "RTN","IBCNSGE",277,0) ;W ?65,"Transmit",?76,"ID",?85,"ID",?97,"Type",?108,"Type of Coverage",?128,"Prov" "RTN","IBCNSGE",278,0) W ?65,"Transmit",?76,"ID",?85,"ID",?93,"OEID",?105,"Type",?113,"Coverage Type",?128,"Prov" "RTN","IBCNSGE",279,0) W !,$$RJ^XLFSTR("",132,"=") "RTN","IBCNSGE",280,0) ; "RTN","IBCNSGE",281,0) ; check for a stop request "RTN","IBCNSGE",282,0) I $D(ZTQUEUED),$$S^%ZTLOAD() D G HEADX "RTN","IBCNSGE",283,0) . S (ZTSTOP,STOP)=1 "RTN","IBCNSGE",284,0) . W !!!?5,"*** Report Halted by TaskManager Request ***" "RTN","IBCNSGE",285,0) . Q "RTN","IBCNSGE",286,0) HEADX ; "RTN","IBCNSGE",287,0) Q "RTN","IBCNSGE",288,0) ; "RTN","IBCNSGE",289,0) DEVICE ; Device selection before compile "RTN","IBCNSGE",290,0) NEW ZTRTN,ZTDESC,ZTSAVE,POP "RTN","IBCNSGE",291,0) W !!!,"This report is 132 columns wide. Please choose an appropriate device.",! "RTN","IBCNSGE",292,0) S ZTRTN="COMPILE^IBCNSGE" "RTN","IBCNSGE",293,0) S ZTDESC="Insurance Company EDI Parameter Report" "RTN","IBCNSGE",294,0) S ZTSAVE("IBRINS")="" "RTN","IBCNSGE",295,0) S ZTSAVE("IBRBID")="" "RTN","IBCNSGE",296,0) S ZTSAVE("IBRINS1")="" "RTN","IBCNSGE",297,0) S ZTSAVE("IBRINS2")="" "RTN","IBCNSGE",298,0) S ZTSAVE("IBRSORT")="" "RTN","IBCNSGE",299,0) D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM") "RTN","IBCNSGE",300,0) DEVX ; "RTN","IBCNSGE",301,0) Q "RTN","IBCNSGE",302,0) ; "RTN","IBJTCA1") 0^3^B54215341 "RTN","IBJTCA1",1,0) IBJTCA1 ;ALB/ARH - TPI CLAIMS INFO BUILD ;10/31/07 14:17 "RTN","IBJTCA1",2,0) ;;2.0;INTEGRATED BILLING;**39,80,106,137,223,276,363,384,432,452,473,497,521**;21-MAR-94;Build 33 "RTN","IBJTCA1",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBJTCA1",4,0) ; "RTN","IBJTCA1",5,0) BLD ; build array for Third Party Joint Inquiry Claims Info screen, IBIFN must be defined "RTN","IBJTCA1",6,0) ; "RTN","IBJTCA1",7,0) N X,IBY,IBZ,IBZ0,IBI,IBT,IBD,IBLN,IBLR,IBD0,IBDI1,IBDM,IBDM1,IBDU,IBDS,IBDU2,IBID0,IBID13,IBNC,IBTC,IBTW,IBSW,IBGRPB,IBGRPE,IBWNR,IBDTX,IBBX19,IBPRVO,IBNABP,IBLVL,IBCNT,IBPRVTYP,IBVL "RTN","IBJTCA1",8,0) N IBXSAVE ; IB*2.0*473 bi "RTN","IBJTCA1",9,0) S VALMCNT=0,X="",IBD0=$G(^DGCR(399,+$G(IBIFN),0)) I IBD0="" S VALMQUIT="" G BLDQ "RTN","IBJTCA1",10,0) F IBI="M","M1","U","S","U2","TX" S @("IBD"_IBI)=$G(^DGCR(399,+IBIFN,IBI)) "RTN","IBJTCA1",11,0) S IBDI1=$P(IBD0,U,21),IBDI1=$S(IBDI1="S":"I2",IBDI1="T":"I3",1:"I1") S IBDI1=$G(^DGCR(399,+IBIFN,IBDI1)) "RTN","IBJTCA1",12,0) S IBID0=$G(^DIC(36,+IBDI1,0)),IBID13=$G(^DIC(36,+IBDI1,.13)) "RTN","IBJTCA1",13,0) ; "RTN","IBJTCA1",14,0) S (IBLN,VALMCNT)=1 "RTN","IBJTCA1",15,0) ;IB*2.0*432/TAZ - Added IBTW(6) and IBSW(6) "RTN","IBJTCA1",16,0) S (IBNC(1),IBTC(1),IBTC(4),IBTC(6))=2,IBTC(5)=78,(IBNC(2),IBTC(2))=42,IBNC(3)=35,IBTW(1)=15,IBTW(2)=16,IBTW(4)=12,IBTW(5)=1,IBTW(6)=20,IBSW(1)=23,IBSW(2)=21,IBSW(4)=60,IBSW(5)=1,IBSW(6)=49 "RTN","IBJTCA1",17,0) ; "RTN","IBJTCA1",18,0) S IBLR=1 "RTN","IBJTCA1",19,0) ; "RTN","IBJTCA1",20,0) S IBT="Insurance Demographics" S IBLN=$$SETN(IBT,IBLN,IBLR,1) "RTN","IBJTCA1",21,0) S IBWNR=$$WNRBILL^IBEFUNC(IBIFN) "RTN","IBJTCA1",22,0) S IBNABP=$$NABP^IBNCPDPU(IBIFN) "RTN","IBJTCA1",23,0) S IBT=$S(IBWNR:" *",1:" ")_"Bill Payer: ",IBD=$P(IBID0,U,1) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",24,0) S IBT="Claim Address: " D S IBD=$P(IBDM,U,5) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",25,0) . I $P(IBID0,U,1)'=$P(IBDM,U,4) S IBD=$P(IBDM,U,4) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) S IBT="" "RTN","IBJTCA1",26,0) I $P(IBDM,U,6)'="" S IBT="",IBD=$P(IBDM,U,6) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",27,0) I $P(IBDM1,U,1)'="" S IBT="",IBD=$P(IBDM1,U,1) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",28,0) S IBT="",IBD=$P(IBDM,U,7),IBD=IBD_$S(IBD'="":", ",1:"")_$P($G(^DIC(5,+$P(IBDM,U,8),0)),U,2)_" "_$P(IBDM,U,9),IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",29,0) S IBT="Claim Phone: ",IBD=$P($$BADD^IBJTU3(+IBIFN),U,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",30,0) S IBLN=$$SET("","",IBLN,5) "RTN","IBJTCA1",31,0) ; "RTN","IBJTCA1",32,0) S IBT="Subscriber Demographics" S IBLN=$$SETN(IBT,IBLN,IBLR,1) "RTN","IBJTCA1",33,0) S IBT="Group Number: ",IBD=$P(IBDI1,U,3) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",34,0) S IBT="Group Name: ",IBD=$P(IBDI1,U,15) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",35,0) S IBT="Subscriber ID: ",IBD=$P(IBDI1,U,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",36,0) S IBT="Employer: ",IBD=$$EMPL(+DFN) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",37,0) S IBT="Insured's Name: ",IBD=$P(IBDI1,U,17) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",38,0) S IBT="Relationship: ",IBD=$$EXSET^IBJU1($P(IBDI1,U,16),2.312,16) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",39,0) ; "RTN","IBJTCA1",40,0) S (IBNC(1),IBTC(1))=2,(IBNC(2),IBTC(2))=42,IBNC(3)=29,IBTW(1)=12,IBTW(2)=16,IBSW(1)=26,IBSW(2)=22 "RTN","IBJTCA1",41,0) S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",42,0) ; "RTN","IBJTCA1",43,0) I $$FT^IBCEF(IBIFN)=2 D "RTN","IBJTCA1",44,0) . N IBXDATA,IBXSAVE K ^TMP("IBXSAVE",$J) "RTN","IBJTCA1",45,0) . D F^IBCEF("N-HCFA 1500 BOX 19",,,IBIFN) "RTN","IBJTCA1",46,0) . I IBXDATA'="" S IBBX19(1)=$E(IBXDATA,1,40) S:$E(IBXDATA,41,$L(IBXDATA))'="" IBBX19(2)=$E(IBXDATA,41,$L(IBXDATA)) "RTN","IBJTCA1",47,0) ; "RTN","IBJTCA1",48,0) S IBGRPB=IBLN,IBLR=1 "RTN","IBJTCA1",49,0) S IBT="Claim Information" S IBLN=$$SETN(IBT,IBLN,3,1) "RTN","IBJTCA1",50,0) S IBT="Bill Type: ",IBD=$$EXSET^IBJU1($P(IBD0,U,5),399,.05) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",51,0) S IBT="Time Frame: ",IBD=$$EXSET^IBJU1($P(IBD0,U,6),399,.06) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",52,0) S IBT="Rate Type: ",IBD=$P($G(^DGCR(399.3,+$P(IBD0,U,7),0)),U,1) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",53,0) S IBT="AR Status: ",IBD=$P($$ARSTATA^IBJTU4(IBIFN),U,1) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",54,0) S IBT=" Sequence: ",IBD=$P($$EXSET^IBJU1($P(IBD0,U,21),399,.21)," ",1) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",55,0) S IBT="Purch Svc: ",IBD=$S($P(IBDU2,U,11)="":"NO",1:$$EXPAND^IBTRE(399,233,$P(IBDU2,U,11))),IBLN=$$SET(IBT,IBD,IBLN,4) "RTN","IBJTCA1",56,0) I $P(IBDM1,"^",8) S IBT=" ECME No: ",IBD=$P($P(IBDM1,"^",8),";",1),IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",57,0) I $L($P(IBDM1,"^",9)) S IBT="ECME Ap No: ",IBD=$P(IBDM1,"^",9),IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",58,0) I IBNABP'="" S IBT=$S(($L($TR(IBNABP," ",""))=7):" NCPDP No: ",1:" NPI: "),IBD=IBNABP,IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",59,0) ; IB*2.0*521 add Claim HPID to display "RTN","IBJTCA1",60,0) S IBD=$S($P(IBD0,U,21)="P":$P(IBDM1,U,13),$P(IBD0,U,21)="S":$P(IBDM1,U,14),$P(IBD0,U,21)="T":$P(IBDM1,U,15),1:"") "RTN","IBJTCA1",61,0) S:IBD="" IBD=$$HPD^IBCNHUT1(+IBDI1) S IBVL=$$HOD^IBCNHUT1(IBD,+IBDI1,IBD) S IBT=$P(IBVL,U,2)_": ",IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",62,0) I IBWNR S IBT="MRA Status: ",IBD=$S($P(IBDTX,U,5):$P(IBDTX,U,5),1:"NOT RECEIVED"),IBLN=$$SET(IBT,$S(IBD:$$EXPAND^IBTRE(399,24,IBD),1:IBD),IBLN,IBLR) "RTN","IBJTCA1",63,0) I $G(IBBX19(1))'="" D "RTN","IBJTCA1",64,0) . S IBT=" Box 19: ",IBD=IBBX19(1),IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",65,0) . I $G(IBBX19(2))'="" S IBT=$J("",11),IBD=IBBX19(2),IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",66,0) ; "RTN","IBJTCA1",67,0) S IBLR=6,IBPRVO="" "RTN","IBJTCA1",68,0) S IBT="Providers: ",IBD="NONE" "RTN","IBJTCA1",69,0) ;IB*2.0*432/TAZ - Changed how providers are displayed to take line-level providers into account. "RTN","IBJTCA1",70,0) ;D F^IBCEF("N-ALL PROVIDERS","IBZ",,IBIFN) "RTN","IBJTCA1",71,0) D F^IBCEF("N-ALL PROVIDERS 1","IBZ",,IBIFN) "RTN","IBJTCA1",72,0) S IBZ0=0 "RTN","IBJTCA1",73,0) S IBLVL=0 "RTN","IBJTCA1",74,0) ;F S Z=$O(IBZ(Z)) Q:'Z D "RTN","IBJTCA1",75,0) ;. I $G(IBZ(Z)),$G(IBZ(Z,1))'="" S IBLN=$$SET(IBT,"(OLD PROV DATA) "_IBZ(Z,1),IBLN,IBLR),IBZ0=1 Q "RTN","IBJTCA1",76,0) ;. I $P($G(IBZ(Z,1)),U)'="" S IBD=$E($$EXPAND^IBTRE(399.0222,.01,Z)_":"_$J("",15),1,15)_$P(IBZ(Z,1),U)_$S($P(IBZ(Z,1),U,4)'="":" ("_$P(IBZ(Z,1),U,4)_")",1:"") S IBLN=$$SET(IBT,IBD,IBLN,IBLR) S IBT=$J("",11),IBZ0=1 "RTN","IBJTCA1",77,0) ;I 'IBZ0 S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",78,0) S IBLVL=0 "RTN","IBJTCA1",79,0) F S IBLVL=$O(IBZ(IBLVL)) Q:'IBLVL D "RTN","IBJTCA1",80,0) . S IBT=IBT_$S(IBLVL=1:"Claim: ",1:"Line: ") "RTN","IBJTCA1",81,0) . S IBPRVTYP="",IBCNT=0 "RTN","IBJTCA1",82,0) . F S IBCNT=$O(IBZ(IBLVL,IBCNT)) Q:'IBCNT D "RTN","IBJTCA1",83,0) .. I IBLVL=1 S IBD=$J("",5) "RTN","IBJTCA1",84,0) .. I IBLVL=2 S IBD=$E("("_IBCNT_")"_$J("",5),1,5) "RTN","IBJTCA1",85,0) .. F S IBPRVTYP=$O(IBZ(IBLVL,IBCNT,IBPRVTYP)) Q:'IBPRVTYP D "RTN","IBJTCA1",86,0) ... S IBD=IBD_$E($$EXPAND^IBTRE(399.0222,.01,IBPRVTYP)_":"_$J("",15),1,15) "RTN","IBJTCA1",87,0) ... S IBD=IBD_$P(IBZ(IBLVL,IBCNT,IBPRVTYP),U) "RTN","IBJTCA1",88,0) ... I $L($P(IBZ(IBLVL,IBCNT,IBPRVTYP),U,4)) S IBD=IBD_" ("_$P(IBZ(IBLVL,IBCNT,IBPRVTYP),U,4)_")" "RTN","IBJTCA1",89,0) ... S IBLN=$$SET(IBT,IBD,IBLN,IBLR),IBT="",IBD=$J("",5) "RTN","IBJTCA1",90,0) ; "RTN","IBJTCA1",91,0) S IBGRPE=IBLN,IBLN=IBGRPB+1,IBLR=2 "RTN","IBJTCA1",92,0) ; "RTN","IBJTCA1",93,0) S IBT="Charge Type: ",IBD=$$EXSET^IBJU1($P(IBD0,U,27),399,.27) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",94,0) S IBT="Service Dates: ",IBD=$$DATE^IBJU1($P(IBDU,U,1))_" - "_$$DATE^IBJU1($P(IBDU,U,2)) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",95,0) S IBT="Orig Claim: ",IBD=$$BILL^RCJIBFN2(+IBIFN) S IBLN=$$SET(IBT,$J($P(IBD,U,1),9,2),IBLN,IBLR) "RTN","IBJTCA1",96,0) S IBT="Balance Due: ",IBD=$J($P(IBD,U,3),9,2) S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",97,0) I +$P(IBDM,U,2) S IBX=$S($P(IBD0,U,21)="P":2,1:1) D S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",98,0) . S IBT=$S(IBX=2:"Secondary",1:"Primary")_": ",IBD=$P($G(^DIC(36,+$P(IBDM,U,IBX),0)),U,1) "RTN","IBJTCA1",99,0) . S IBX=$P(IBDU2,U,(IBX+3)) I +IBX S IBX="("_$J(IBX,0,2)_")" S IBD=$E(IBD,1,(IBSW(IBLR)-$L(IBX)-2))_" "_IBX "RTN","IBJTCA1",100,0) I +$P(IBDM,U,3) S IBX=$S($P(IBD0,U,21)="T":2,1:3) D S IBLN=$$SET(IBT,IBD,IBLN,IBLR) "RTN","IBJTCA1",101,0) . S IBT=$S(IBX=2:"Secondary",1:"Tertiary")_": ",IBD=$P($G(^DIC(36,+$P(IBDM,U,IBX),0)),U,1) "RTN","IBJTCA1",102,0) . S IBX=$P(IBDU2,U,(IBX+3)) I +IBX S IBX="("_$J(IBX,0,2)_")" S IBD=$E(IBD,1,(IBSW(IBLR)-$L(IBX)-2))_" "_IBX "RTN","IBJTCA1",103,0) S IBLN=$$SET("","",IBLN,5) "RTN","IBJTCA1",104,0) I IBWNR S IBT="MRA Rec Date: " D S IBLN=$$SET(IBT,IBD,IBLN,2) "RTN","IBJTCA1",105,0) . N Z "RTN","IBJTCA1",106,0) . ; find last MRA for receipt date "RTN","IBJTCA1",107,0) . S (IBD,Z)="" F S Z=$O(^IBM(361.1,"B",IBIFN,Z),-1) Q:'Z I $P($G(^IBM(361.1,Z,0)),U,4)=1 S IBD=$$DATE^IBJU1($P($P(^IBM(361.1,Z,0),U,6),".")) Q "RTN","IBJTCA1",108,0) F Z=IBLN:1:IBGRPE S IBLN=$$SET("","",IBLN,5) "RTN","IBJTCA1",109,0) ; "RTN","IBJTCA1",110,0) S (IBLN,VALMCNT)=$S(IBLN>IBGRPE:IBLN,1:IBGRPE) "RTN","IBJTCA1",111,0) ; "RTN","IBJTCA1",112,0) S IBGRPB=IBLN,IBLR=1 "RTN","IBJTCA1",113,0) D CONT^IBJTCA2 "RTN","IBJTCA1",114,0) ; "RTN","IBJTCA1",115,0) COPAY I $O(^IBA(362.4,"C",IBIFN,0)) D "RTN","IBJTCA1",116,0) . S (IBT,IBD)="" S IBLN=$$SET(IBT,IBD,IBLN,IBLR) ; blank line "RTN","IBJTCA1",117,0) . S IBT="Related Prescription Copay Information" S IBLN=$$SETN(IBT,IBLN,1,1) "RTN","IBJTCA1",118,0) . N IBZ,IBX,IBC,IBCAP "RTN","IBJTCA1",119,0) . S IBZ=0 F S IBZ=$O(^IBA(362.4,"C",IBIFN,IBZ)) Q:'IBZ D "RTN","IBJTCA1",120,0) .. K ^TMP("IBTPJI",$J) "RTN","IBJTCA1",121,0) .. S IBC=$G(^IBA(362.4,IBZ,0)) "RTN","IBJTCA1",122,0) .. D:$P(IBC,"^",5) RX^PSO52API($P(IBD0,"^",2),"IBTPJI",$P(IBC,"^",5),"","I^") "RTN","IBJTCA1",123,0) .. ; original fill "RTN","IBJTCA1",124,0) .. I $P(IBC,"^",10)=0 D "RTN","IBJTCA1",125,0) ... S IBX=+$G(^TMP($J,"IBTPJI",$P(IBD0,"^",2),+$P(IBC,"^",5),106)),IBCAP=+$G(^(106.6)) "RTN","IBJTCA1",126,0) .. ; refills "RTN","IBJTCA1",127,0) .. E D "RTN","IBJTCA1",128,0) ... S IBX=+$G(^TMP($J,"IBTPJI",$P(IBD0,"^",2),+$P(IBC,"^",5),"IB",+$P(IBC,"^",10),9)),IBCAP=+$G(^(9.1)) "RTN","IBJTCA1",129,0) .. I '$G(IBX),$G(IBCAP) S IBT=" ",IBLN=$$SET(IBT,"",IBLN,4) Q "RTN","IBJTCA1",130,0) .. I '$G(IBX) S IBT=" ",IBLN=$$SET(IBT,"",IBLN,4) Q "RTN","IBJTCA1",131,0) .. S IBX=$G(^IB(IBX,0)) "RTN","IBJTCA1",132,0) .. S IBT="Rx: "_$P(IBC,"^")_" Chg: $"_$FN($P(IBX,"^",7),",",2)_" Status: "_$$TITLE^XLFSTR($$EXTERNAL^DILFD(350,.05,"",$P(IBX,"^",5)))_" Bill: "_$P(IBX,"^",11) "RTN","IBJTCA1",133,0) .. S IBLN=$$SET(IBT,"",IBLN,4) "RTN","IBJTCA1",134,0) K ^TMP("IBTPJI",$J) "RTN","IBJTCA1",135,0) ; "RTN","IBJTCA1",136,0) S (IBLN,VALMCNT)=IBLN-1 "RTN","IBJTCA1",137,0) ; "RTN","IBJTCA1",138,0) BLDQ Q "RTN","IBJTCA1",139,0) ; "RTN","IBJTCA1",140,0) EMPL(DFN) ; returns employer name "RTN","IBJTCA1",141,0) Q $P($G(^DPT(+DFN,.311)),U,1) "RTN","IBJTCA1",142,0) ; "RTN","IBJTCA1",143,0) SET(TTL,DATA,LN,LR) ; "RTN","IBJTCA1",144,0) N IBY "RTN","IBJTCA1",145,0) S IBY=$J(TTL,IBTW(LR))_DATA D SET1(IBY,LN,IBTC(LR),(IBTW(LR)+IBSW(LR))) "RTN","IBJTCA1",146,0) S LN=LN+1 "RTN","IBJTCA1",147,0) Q LN "RTN","IBJTCA1",148,0) ; "RTN","IBJTCA1",149,0) SETN(TTL,LN,LR,RV) ; "RTN","IBJTCA1",150,0) N IBY "RTN","IBJTCA1",151,0) S IBY=" "_TTL_" " D SET1(IBY,LN,IBNC(LR),$L(IBY),$G(RV)) "RTN","IBJTCA1",152,0) S LN=LN+1 "RTN","IBJTCA1",153,0) Q LN "RTN","IBJTCA1",154,0) ; "RTN","IBJTCA1",155,0) SET1(STR,LN,COL,WD,RV) ; set up TMP array with screen data "RTN","IBJTCA1",156,0) N IBX S IBX=$G(^TMP("IBJTCA",$J,LN,0)) "RTN","IBJTCA1",157,0) S IBX=$$SETSTR^VALM1(STR,IBX,COL,WD) "RTN","IBJTCA1",158,0) D SET^VALM10(LN,IBX) I $G(RV)'="" D CNTRL^VALM10(LN,COL,WD,IORVON,IORVOFF) "RTN","IBJTCA1",159,0) Q "RTN","IBJTRX") 0^4^B86052927 "RTN","IBJTRX",1,0) IBJTRX ;ALB/ESG - TPJI ePharmacy ECME claim information ;22-Oct-2010 "RTN","IBJTRX",2,0) ;;2.0;INTEGRATED BILLING;**435,452,494,521**;21-MAR-94;Build 33 "RTN","IBJTRX",3,0) ;;Per VA Directive 6402, 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) ; Reference to ^BPSVRX supported by IA# 5723 "RTN","IBJTRX",9,0) ; "RTN","IBJTRX",10,0) Q "RTN","IBJTRX",11,0) ; "RTN","IBJTRX",12,0) EN ; -- main entry point for IBJT ECME RESP INFO "RTN","IBJTRX",13,0) N IBZ,IBRXDATA,IBRXIEN,X,Y "RTN","IBJTRX",14,0) D FULL^VALM1 "RTN","IBJTRX",15,0) I '$G(IBIFN) W !!,"No Claim Defined!" D PAUSE^VALM1 G EX "RTN","IBJTRX",16,0) I '$$ISRX^IBCEF1(IBIFN) W !!,"Not available. This is not a Pharmacy Claim." D PAUSE^VALM1 G EX "RTN","IBJTRX",17,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",18,0) ; "RTN","IBJTRX",19,0) S IBZ=+$O(^IBA(362.4,"C",IBIFN,0)) "RTN","IBJTRX",20,0) I 'IBZ W !!,"Rx data not found for this claim." D PAUSE^VALM1 G EX "RTN","IBJTRX",21,0) S IBRXDATA=$G(^IBA(362.4,IBZ,0)) "RTN","IBJTRX",22,0) S IBRXIEN=+$P(IBRXDATA,U,5) ; RX ien ptr file 52 "RTN","IBJTRX",23,0) I 'IBRXIEN W !!,"Rx IEN cannot be determined." D PAUSE^VALM1 G EX "RTN","IBJTRX",24,0) ; "RTN","IBJTRX",25,0) D EN^VALM("IBJT ECME RESP INFO") "RTN","IBJTRX",26,0) EX ; "RTN","IBJTRX",27,0) S VALMBCK="R" "RTN","IBJTRX",28,0) Q "RTN","IBJTRX",29,0) ; "RTN","IBJTRX",30,0) HDR ; -- header code "RTN","IBJTRX",31,0) D HDR^IBJTU1(+IBIFN,+DFN,13) "RTN","IBJTRX",32,0) Q "RTN","IBJTRX",33,0) ; "RTN","IBJTRX",34,0) INIT ; -- init variables and list array "RTN","IBJTRX",35,0) N IBM1,ECME,ECMEAP,RXORG,DOCIEN,PHARMNPI,DOCNPI,RESPIEN,ZR,RSPSUB,ZM,BPSM,BPSMCOB,IBLINE,ZC,ZCTOT,ZCN "RTN","IBJTRX",36,0) N IBZ,IBRXDATA,IBRXIEN,IBRXFILL,IBCOBN,IBBPS,IB0,IBS,IBHPD,IBVL,IBCPY,IBM0 "RTN","IBJTRX",37,0) K ^TMP("IBJTRX",$J) "RTN","IBJTRX",38,0) S VALMCNT=0 "RTN","IBJTRX",39,0) ; "RTN","IBJTRX",40,0) S IBZ=+$O(^IBA(362.4,"C",IBIFN,0)) "RTN","IBJTRX",41,0) S IBRXDATA=$G(^IBA(362.4,IBZ,0)) "RTN","IBJTRX",42,0) S IBRXIEN=+$P(IBRXDATA,U,5) ; RX ien ptr file 52 "RTN","IBJTRX",43,0) S IBRXFILL=+$P(IBRXDATA,U,10) ; rx fill# "RTN","IBJTRX",44,0) S IBCOBN=+$$COBN^IBCEF(IBIFN) ; current payer sequence # "RTN","IBJTRX",45,0) S IBBPS=$$CLAIM^BPSBUTL(IBRXIEN,IBRXFILL,IBCOBN) ; DBIA 4719 "RTN","IBJTRX",46,0) ; "RTN","IBJTRX",47,0) S IBM1=$G(^DGCR(399,IBIFN,"M1")) "RTN","IBJTRX",48,0) S IB0=$G(^DGCR(399,IBIFN,0)) "RTN","IBJTRX",49,0) S IBS=$G(^DGCR(399,IBIFN,"S")) "RTN","IBJTRX",50,0) S ECME=$P($P(IBM1,U,8),";",1) ; ECME# "RTN","IBJTRX",51,0) S ECMEAP=$P(IBM1,U,9) ; ECME approval number "RTN","IBJTRX",52,0) S RXORG=$$RXSITE^IBCEF73A(IBIFN) ; pharmacy file 4 ien "RTN","IBJTRX",53,0) S DOCIEN=$$RXAPI1^IBNCPUT1(IBRXIEN,4,"I") ; ien of doctor who wrote the Rx (52,4) "RTN","IBJTRX",54,0) S (PHARMNPI,DOCNPI)="" "RTN","IBJTRX",55,0) I RXORG S PHARMNPI=$P($$NPI^XUSNPI("Organization_ID",RXORG),U,1) ; pharmacy NPI "RTN","IBJTRX",56,0) I DOCIEN S DOCNPI=$P($$NPI^XUSNPI("Individual_ID",DOCIEN),U,1) ; doctor NPI "RTN","IBJTRX",57,0) I PHARMNPI'>0 S PHARMNPI="No NPI on file" "RTN","IBJTRX",58,0) I DOCNPI'>0 S DOCNPI="No NPI on file" "RTN","IBJTRX",59,0) ; "RTN","IBJTRX",60,0) S RESPIEN=+$P(IBBPS,U,3) ; BPS response file ien "RTN","IBJTRX",61,0) I RESPIEN D "RTN","IBJTRX",62,0) . ; IB*2.0*521 - add HPID from response to TPJI screen "RTN","IBJTRX",63,0) . S IBM0=$G(^DGCR(399,IBIFN,"M")),IBCPY=$S($P(IB0,U,21)="P":$P(IBM0,U),$P(IB0,U,21)="S":$P(IBM0,U,2),1:$P(IBM0,"^",3)) "RTN","IBJTRX",64,0) . I $P($G(^BPSR(RESPIEN,560)),U,8)="01" S IBHPD=$P($G(^BPSR(RESPIEN,560)),U,9) S IBVL=$$HOD^IBCNHUT1(IBHPD,IBCPY) "RTN","IBJTRX",65,0) . S ZR=RESPIEN_"," "RTN","IBJTRX",66,0) . S RSPSUB=+$O(^BPSR(RESPIEN,1000,0)) "RTN","IBJTRX",67,0) . I RSPSUB D "RTN","IBJTRX",68,0) .. S ZM=RSPSUB_","_RESPIEN_"," "RTN","IBJTRX",69,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",70,0) .. D GETS^DIQ(9002313.0301,ZM,"355.01*","IEN","BPSMCOB") ; get cob/other payer data fields "RTN","IBJTRX",71,0) .. Q "RTN","IBJTRX",72,0) . Q "RTN","IBJTRX",73,0) ; "RTN","IBJTRX",74,0) S IBLINE=$$SETL("",ECME,"ECME No",25,11,1) "RTN","IBJTRX",75,0) S IBLINE=$$SETL(IBLINE,PHARMNPI,"Pharmacy NPI",14,15,40) "RTN","IBJTRX",76,0) D SET(IBLINE) "RTN","IBJTRX",77,0) ; "RTN","IBJTRX",78,0) S IBLINE=$$SETL("",ECMEAP,"ECME Ap No",25,11,1) "RTN","IBJTRX",79,0) S IBLINE=$$SETL(IBLINE,DOCNPI,"Provider NPI",14,15,40) "RTN","IBJTRX",80,0) D SET(IBLINE) "RTN","IBJTRX",81,0) ; IB*2.0*521 - add validated HPID from response to TPJI screen "RTN","IBJTRX",82,0) S:$G(IBVL)="" IBVL="^HPID/OEID" S IBLINE=$$SETL("",$G(IBHPD),$P(IBVL,U,2),25,11,1) "RTN","IBJTRX",83,0) D SET(IBLINE) "RTN","IBJTRX",84,0) ; "RTN","IBJTRX",85,0) D SET(" ") "RTN","IBJTRX",86,0) S IBLINE=$$SETL("",$P(IBRXDATA,U,1)_" / "_IBRXFILL,"Rx No",31,11,1) "RTN","IBJTRX",87,0) S IBLINE=$$SETL(IBLINE,$$FMTE^XLFDT($P(IBRXDATA,U,3),"2Z"),"Date of Svc",8,15,40) "RTN","IBJTRX",88,0) D SET(IBLINE) "RTN","IBJTRX",89,0) ; "RTN","IBJTRX",90,0) S IBLINE=$$SETL("",$$RXAPI1^IBNCPUT1(IBRXIEN,6,"E"),"Drug Name",36,11,1) "RTN","IBJTRX",91,0) S IBLINE=$$SETL(IBLINE,$P(IBRXDATA,U,8),"NDC #",24,15,40) "RTN","IBJTRX",92,0) D SET(IBLINE) "RTN","IBJTRX",93,0) ; "RTN","IBJTRX",94,0) S IBLINE=$$SETL("",$$AMT(+$P($G(^DGCR(399,IBIFN,"U1")),U,1)),"Billed Amt",36,11,1) "RTN","IBJTRX",95,0) S IBLINE=$$SETL(IBLINE,$S(IBCOBN=2:"Secondary",IBCOBN=3:"Tertiary",1:"Primary"),"COB",15,15,40) "RTN","IBJTRX",96,0) D SET(IBLINE) "RTN","IBJTRX",97,0) ; "RTN","IBJTRX",98,0) D SET(" ") "RTN","IBJTRX",99,0) ; "RTN","IBJTRX",100,0) ; For cancelled bills only, display the IB cancel status, date, and reason (IB*2*494) "RTN","IBJTRX",101,0) I $P(IB0,U,13)=7 D "RTN","IBJTRX",102,0) . S IBLINE=$$SETL("","CANCELLED ("_$$FMTE^XLFDT($P(IBS,U,17),"2DZ")_")","IB Status",20,11,1) "RTN","IBJTRX",103,0) . S IBLINE=$$SETL(IBLINE,$P(IBS,U,19),"Reason",100,6,36) "RTN","IBJTRX",104,0) . D SET(IBLINE),SET(" ") "RTN","IBJTRX",105,0) . Q "RTN","IBJTRX",106,0) ; "RTN","IBJTRX",107,0) ; if response data is not available, get out here "RTN","IBJTRX",108,0) ; "RTN","IBJTRX",109,0) I 'RESPIEN D G INITX "RTN","IBJTRX",110,0) . D SET(" ECME Response Information is not on file.") "RTN","IBJTRX",111,0) . D SET(" No further information available for display.") "RTN","IBJTRX",112,0) . Q "RTN","IBJTRX",113,0) ; "RTN","IBJTRX",114,0) S IBLINE=$$SETL("",,"Payment Information",,20,1) "RTN","IBJTRX",115,0) D SET(IBLINE,"3;2;19") "RTN","IBJTRX",116,0) ; "RTN","IBJTRX",117,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,506,"E"))),"Ingredient Cost Paid",15,26,1) D SET(IBLINE) "RTN","IBJTRX",118,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,507,"E"))),"Dispensing Fee Paid",15,26,1) D SET(IBLINE) "RTN","IBJTRX",119,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,505,"E")),,1),"Patient Resp (Ins)",15,26,1) D SET(IBLINE) "RTN","IBJTRX",120,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,509,"E"))),"Expected Payment Amount",15,26,1) D SET(IBLINE) "RTN","IBJTRX",121,0) ; "RTN","IBJTRX",122,0) D SET(" ") "RTN","IBJTRX",123,0) S IBLINE=$$SETL("",,"Patient Responsibility Amounts",,31,1) "RTN","IBJTRX",124,0) D SET(IBLINE,"3;2;30") "RTN","IBJTRX",125,0) ; "RTN","IBJTRX",126,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,517,"E"))),"Deductible",10,13,1) "RTN","IBJTRX",127,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,572,"E"))),"Coinsurance",10,13,27) "RTN","IBJTRX",128,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,518,"E"))),"Amount of Copay",9,18,52) "RTN","IBJTRX",129,0) D SET(IBLINE) "RTN","IBJTRX",130,0) ; "RTN","IBJTRX",131,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,137,"E"))),"Coverage Gap",10,13,1) "RTN","IBJTRX",132,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,571,"E"))),"Processor Fee",10,13,27) "RTN","IBJTRX",133,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,520,"E"))),"Exceed Benefit Max",9,18,52) "RTN","IBJTRX",134,0) D SET(IBLINE) "RTN","IBJTRX",135,0) ; "RTN","IBJTRX",136,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,129,"E"))),"Health Plan-funded Assistance Amount",15,39,1) "RTN","IBJTRX",137,0) D SET(IBLINE) "RTN","IBJTRX",138,0) ; "RTN","IBJTRX",139,0) D SET(" ") "RTN","IBJTRX",140,0) S IBLINE=$$SETL("",,"Product Selection Amounts",,26,1) "RTN","IBJTRX",141,0) D SET(IBLINE,"3;2;25") "RTN","IBJTRX",142,0) ; "RTN","IBJTRX",143,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,519,"E"))),"Prod Sel Amt",12,21,1) "RTN","IBJTRX",144,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,135,"E"))),"Prod Sel /Non-Pref Formulary",9,33,37) "RTN","IBJTRX",145,0) D SET(IBLINE) "RTN","IBJTRX",146,0) ; "RTN","IBJTRX",147,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,134,"E"))),"Prod Sel/Brand Drug",12,21,1) "RTN","IBJTRX",148,0) S IBLINE=$$SETL(IBLINE,$$AMT($G(BPSM(9002313.0301,ZM,136,"E"))),"Prod Sel/Brand Non-Pref Formulary",9,33,37) "RTN","IBJTRX",149,0) D SET(IBLINE) "RTN","IBJTRX",150,0) ; "RTN","IBJTRX",151,0) S IBLINE=$$SETL("",$$AMT($G(BPSM(9002313.0301,ZM,133,"E"))),"Provider Network Adj",12,21,1) "RTN","IBJTRX",152,0) D SET(IBLINE) "RTN","IBJTRX",153,0) ; "RTN","IBJTRX",154,0) ; Display COB/Other Payer data "RTN","IBJTRX",155,0) I '$D(BPSMCOB(9002313.035501)) D G INITX "RTN","IBJTRX",156,0) . D SET(" ") "RTN","IBJTRX",157,0) . D SET(" No COB/Other Payer Data on file in the ECME Response.") "RTN","IBJTRX",158,0) . Q "RTN","IBJTRX",159,0) ; "RTN","IBJTRX",160,0) S ZC="" F ZCTOT=0:1 S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" ; count how many entries exist "RTN","IBJTRX",161,0) S ZC="",ZCN=0 F S ZC=$O(BPSMCOB(9002313.035501,ZC)) Q:ZC="" D "RTN","IBJTRX",162,0) . S ZCN=ZCN+1 "RTN","IBJTRX",163,0) . D SET(" ") "RTN","IBJTRX",164,0) . S IBLINE="COB/Other Payer ("_ZCN_" of "_ZCTOT_") (from other payer response message)" "RTN","IBJTRX",165,0) . D SET(" "_IBLINE,"3;2;"_$L(IBLINE)) "RTN","IBJTRX",166,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,356,"E")),"Other Payer Cardholder ID",40,27,1) "RTN","IBJTRX",167,0) . D SET(IBLINE) "RTN","IBJTRX",168,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,144,"E")),"Other Payer Effective Date",10,27,1) "RTN","IBJTRX",169,0) . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,145,"E")),"Other Payer Termination Date",10,32,38) "RTN","IBJTRX",170,0) . D SET(IBLINE) "RTN","IBJTRX",171,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,142,"E")),"Other Payer Person Code",6,27,1) "RTN","IBJTRX",172,0) . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,143,"E")),"Other Payer Pt Relationship Code",9,32,38) "RTN","IBJTRX",173,0) . D SET(IBLINE) "RTN","IBJTRX",174,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,340,"E")),"Other Payer ID (BIN)",24,27,1) "RTN","IBJTRX",175,0) . S IBLINE=$$SETL(IBLINE,$G(BPSMCOB(9002313.035501,ZC,991,"E")),"Other Payer PCN",9,32,38) "RTN","IBJTRX",176,0) . D SET(IBLINE) "RTN","IBJTRX",177,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,992,"E")),"Other Payer Group ID",40,27,1) "RTN","IBJTRX",178,0) . D SET(IBLINE) "RTN","IBJTRX",179,0) . S IBLINE=$$SETL("",$G(BPSMCOB(9002313.035501,ZC,127,"E")),"Other Payer Help Desk",40,27,1) "RTN","IBJTRX",180,0) . D SET(IBLINE) "RTN","IBJTRX",181,0) . Q "RTN","IBJTRX",182,0) ; "RTN","IBJTRX",183,0) INITX ; "RTN","IBJTRX",184,0) D SET(" "),SET(" ") "RTN","IBJTRX",185,0) Q "RTN","IBJTRX",186,0) ; "RTN","IBJTRX",187,0) VER ; Action to launch the View ePharmacy Rx report "RTN","IBJTRX",188,0) N BPSVRX "RTN","IBJTRX",189,0) K ^TMP("BPSVRX-TPJI",$J) "RTN","IBJTRX",190,0) D FULL^VALM1 "RTN","IBJTRX",191,0) I $G(IBRXDATA)="" W !!,"System error. IBRXDATA missing." D PAUSE^VALM1 G VERX "RTN","IBJTRX",192,0) ; "RTN","IBJTRX",193,0) ; save the current TPJI display array data "RTN","IBJTRX",194,0) M ^TMP("BPSVRX-TPJI",$J,"IBJTCA")=^TMP("IBJTCA",$J) "RTN","IBJTRX",195,0) M ^TMP("BPSVRX-TPJI",$J,"IBJTRX")=^TMP("IBJTRX",$J) "RTN","IBJTRX",196,0) M ^TMP("BPSVRX-TPJI",$J,"IBTPJI")=^TMP($J,"IBTPJI") "RTN","IBJTRX",197,0) ; "RTN","IBJTRX",198,0) S BPSVRX("RXIEN")=+$P(IBRXDATA,U,5) ; RX ien ptr file 52 "RTN","IBJTRX",199,0) S BPSVRX("FILL#")=+$P(IBRXDATA,U,10) ; rx fill# "RTN","IBJTRX",200,0) D ^BPSVRX ; DBIA #5723 "RTN","IBJTRX",201,0) ; "RTN","IBJTRX",202,0) ; After returning from this List Manager report, we need to rebuild "RTN","IBJTRX",203,0) ; the display array for the TPJI screens because they are killed by the report. "RTN","IBJTRX",204,0) I '$D(^TMP("IBJTCA",$J)) M ^TMP("IBJTCA",$J)=^TMP("BPSVRX-TPJI",$J,"IBJTCA") "RTN","IBJTRX",205,0) I '$D(^TMP("IBJTRX",$J)) M ^TMP("IBJTRX",$J)=^TMP("BPSVRX-TPJI",$J,"IBJTRX") "RTN","IBJTRX",206,0) I '$D(^TMP($J,"IBTPJI")) M ^TMP($J,"IBTPJI")=^TMP("BPSVRX-TPJI",$J,"IBTPJI") "RTN","IBJTRX",207,0) ; "RTN","IBJTRX",208,0) VERX ; "RTN","IBJTRX",209,0) S VALMBCK="R" "RTN","IBJTRX",210,0) K ^TMP("BPSVRX-TPJI",$J) "RTN","IBJTRX",211,0) Q "RTN","IBJTRX",212,0) ; "RTN","IBJTRX",213,0) HELP ; -- help code "RTN","IBJTRX",214,0) S X="?" D DISP^XQORM1 W !! "RTN","IBJTRX",215,0) Q "RTN","IBJTRX",216,0) ; "RTN","IBJTRX",217,0) EXIT ; -- exit code "RTN","IBJTRX",218,0) K ^TMP("IBJTRX",$J) "RTN","IBJTRX",219,0) I $D(VALMEVL) D CLEAN^VALM10,KILL^VALM10() "RTN","IBJTRX",220,0) Q "RTN","IBJTRX",221,0) ; "RTN","IBJTRX",222,0) SETL(TEXT,DATA,LABEL,LEND,LENL,COL) ; build line of text "RTN","IBJTRX",223,0) ; TEXT - existing line of text data "RTN","IBJTRX",224,0) ; DATA - field data "RTN","IBJTRX",225,0) ; LABEL - field label "RTN","IBJTRX",226,0) ; LEND - max length of data "RTN","IBJTRX",227,0) ; LENL - length of label (label will be right justified so the colons line up) "RTN","IBJTRX",228,0) ; COL - starting column for insert "RTN","IBJTRX",229,0) ; "RTN","IBJTRX",230,0) N D1,STR S D1="",COL=$G(COL,1) "RTN","IBJTRX",231,0) I $G(LABEL)'="" S D1=$J(LABEL,+$G(LENL)) "RTN","IBJTRX",232,0) I $D(DATA) S D1=D1_": "_$$FO^IBCNEUT1(DATA,+$G(LEND)) "RTN","IBJTRX",233,0) S STR=$$SETSTR^VALM1(D1,$G(TEXT),COL,$L(D1)) "RTN","IBJTRX",234,0) ; "RTN","IBJTRX",235,0) Q $E(STR,1,80) "RTN","IBJTRX",236,0) ; "RTN","IBJTRX",237,0) SET(TEXT,VID) ; set data in variable TEXT into ListMan display "RTN","IBJTRX",238,0) ; VID is video attribute data of line if any "RTN","IBJTRX",239,0) ; Format: type;start column;width "RTN","IBJTRX",240,0) ; type=1 (reverse video) "RTN","IBJTRX",241,0) ; type=2 (bold) "RTN","IBJTRX",242,0) ; type=3 (underline) "RTN","IBJTRX",243,0) ; "RTN","IBJTRX",244,0) S VALMCNT=VALMCNT+1 "RTN","IBJTRX",245,0) S ^TMP("IBJTRX",$J,VALMCNT,0)=$G(TEXT) ; set text line into display array "RTN","IBJTRX",246,0) I $G(VID)="" G SETX "RTN","IBJTRX",247,0) ; "RTN","IBJTRX",248,0) ; video attributes "RTN","IBJTRX",249,0) N ON,OFF "RTN","IBJTRX",250,0) S ON=$S(+VID=1:IORVON,+VID=2:IOINHI,1:IOUON) "RTN","IBJTRX",251,0) S OFF=$S(+VID=1:IORVOFF,+VID=2:IOINORM,1:IOUOFF) "RTN","IBJTRX",252,0) D CNTRL^VALM10(VALMCNT,+$P(VID,";",2),+$P(VID,";",3),ON,OFF) "RTN","IBJTRX",253,0) ; "RTN","IBJTRX",254,0) SETX ; "RTN","IBJTRX",255,0) Q "RTN","IBJTRX",256,0) ; "RTN","IBJTRX",257,0) AMT(VAL,L,P) ; convert dollar amount to external display "RTN","IBJTRX",258,0) ; VAL can be a number or the Fileman external version of the number "RTN","IBJTRX",259,0) ; L is the $J field length (default 8) "RTN","IBJTRX",260,0) ; P is a flag indicating the number should be enclosed within parentheses "RTN","IBJTRX",261,0) ; strip $ and spaces "RTN","IBJTRX",262,0) S VAL=+$TR($G(VAL),"$ ") "RTN","IBJTRX",263,0) I '$G(L) S L=8 "RTN","IBJTRX",264,0) I $G(P) Q $J($FN(-VAL,"P",2),L+1) "RTN","IBJTRX",265,0) Q $J(VAL,L,2) "RTN","IBJTRX",266,0) ; "RTN","IBNCPEV") 0^2^B97561964 "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,452,521**;21-MAR-94;Build 33 "RTN","IBNCPEV",3,0) ;;Per VA Directive 6402, 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) ; "RTN","IBNCPEV",57,0) PRINT ; scratch global exists and has data "RTN","IBNCPEV",58,0) ; begin the report printing. Entry point into this routine from BPSVRX. "RTN","IBNCPEV",59,0) ; DBIA #5712 defines this entry point for ECME. "RTN","IBNCPEV",60,0) ; "RTN","IBNCPEV",61,0) ;print "RTN","IBNCPEV",62,0) S IBNUM=0 "RTN","IBNCPEV",63,0) U IO D HDR "RTN","IBNCPEV",64,0) S IBRX1="" F S IBRX1=$O(@REF@(IBRX1)) Q:IBRX1="" D Q:IBQ "RTN","IBNCPEV",65,0) .S IBFN="" F S IBFN=$O(@REF@(IBRX1,IBFN)) Q:IBFN="" D Q:IBQ "RTN","IBNCPEV",66,0) ..S IB1ST=1 "RTN","IBNCPEV",67,0) ..S IBI="" F S IBI=$O(@REF@(IBRX1,IBFN,IBI)) Q:IBI="" D Q:IBQ "RTN","IBNCPEV",68,0) ...S IBN="" F S IBN=$O(@REF@(IBRX1,IBFN,IBI,IBN)) Q:IBN="" D Q:IBQ "RTN","IBNCPEV",69,0) ....N IBZ,IBD1,IBD2,IBD3,IBD4,IBD7,IBINS,IBY "RTN","IBNCPEV",70,0) ....;load main "RTN","IBNCPEV",71,0) ....S IBZ=$G(^IBCNR(366.14,IBI,1,IBN,0)) "RTN","IBNCPEV",72,0) ....;load IBD array "RTN","IBNCPEV",73,0) ....S IBD1=$G(^IBCNR(366.14,IBI,1,IBN,1)) "RTN","IBNCPEV",74,0) ....S IBD2=$G(^IBCNR(366.14,IBI,1,IBN,2)) "RTN","IBNCPEV",75,0) ....S IBD3=$G(^IBCNR(366.14,IBI,1,IBN,3)) "RTN","IBNCPEV",76,0) ....S IBD4=$G(^IBCNR(366.14,IBI,1,IBN,4)) "RTN","IBNCPEV",77,0) ....S IBD7=$G(^IBCNR(366.14,IBI,1,IBN,7)) "RTN","IBNCPEV",78,0) ....S IBY=0 "RTN","IBNCPEV",79,0) ....;load insurance multiple "RTN","IBNCPEV",80,0) ....F S IBY=$O(^IBCNR(366.14,IBI,1,IBN,5,IBY)) Q:+IBY=0 D "RTN","IBNCPEV",81,0) .....S IBINS(IBY,0)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,0)) "RTN","IBNCPEV",82,0) .....S IBINS(IBY,1)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,1)) "RTN","IBNCPEV",83,0) .....S IBINS(IBY,2)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,2)) "RTN","IBNCPEV",84,0) .....S IBINS(IBY,3)=$G(^IBCNR(366.14,IBI,1,IBN,5,IBY,3)) "RTN","IBNCPEV",85,0) ....; "RTN","IBNCPEV",86,0) ....I IB1ST D Q:IBQ "RTN","IBNCPEV",87,0) .....S IBNUM=IBNUM+1 I IBNUM>1 D ULINE("-") Q:IBQ "RTN","IBNCPEV",88,0) .....D CHKP Q:IBQ "RTN","IBNCPEV",89,0) .....W !,IBNUM," ",?4,$$RXNUM(IBRX1)," ",?12,IBFN," ",?16,$$DAT(+$P(IBD2,U,6)) ;RX# Fill# Date of Service "RTN","IBNCPEV",90,0) .....W " ",?28,$E($$PAT(+$P(IBZ,U,3)),1,21)," ",?50,$E($$DRUG(+$P(IBZ,U,3),IBRX1),1,30) "RTN","IBNCPEV",91,0) .....S IB1ST=0 "RTN","IBNCPEV",92,0) ....N IND S IND=6 "RTN","IBNCPEV",93,0) ....D CHKP Q:IBQ "RTN","IBNCPEV",94,0) ....S IBEVNT=$$GET1^DIQ(366.141,IBN_","_IBI_",",.01) "RTN","IBNCPEV",95,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",96,0) ....Q:'IBDTL ; no details "RTN","IBNCPEV",97,0) ....I IBEVNT="BILL" D DBILL Q "RTN","IBNCPEV",98,0) ....I IBEVNT="REJECT" D DREJ Q "RTN","IBNCPEV",99,0) ....I IBEVNT["REVERSE" D DREV Q "RTN","IBNCPEV",100,0) ....I IBEVNT["SUBMIT" D DSUB Q "RTN","IBNCPEV",101,0) ....I IBEVNT["CLOSE" D DCLO Q "RTN","IBNCPEV",102,0) ....I IBEVNT["REOPEN" D REOPEN^IBNCPEV1 Q "RTN","IBNCPEV",103,0) ....I IBEVNT["RELEASE" D DREL Q "RTN","IBNCPEV",104,0) ....I IBEVNT[IBSC D DSTAT^IBNCPEV1(.IBD2,.IBD3,.IBD4,.IBINS,.IBD7) Q "RTN","IBNCPEV",105,0) ....I IBEVNT["BILL CANCELLED" D BCANC Q "RTN","IBNCPEV",106,0) I IBSCR,'IBQ W !,"End of report, press RETURN to continue." R X:DTIME "RTN","IBNCPEV",107,0) K @REF "RTN","IBNCPEV",108,0) Q "RTN","IBNCPEV",109,0) ; "RTN","IBNCPEV",110,0) STAT(X,RES,CR,IBIFN) ;provides STATUS information "RTN","IBNCPEV",111,0) N IBNL,IBSC "RTN","IBNCPEV",112,0) S IBNL="Plan not linked to the Payer",IBSC="STATUS CHECK" "RTN","IBNCPEV",113,0) I X[IBSC,RES[IBNB S RES="0^"_$P(RES,IBNB,2) "RTN","IBNCPEV",114,0) I X[IBSC,RES[IBNL S RES="0^Plan not linked" ; shorten too long line "RTN","IBNCPEV",115,0) I X[IBSC,'RES,RES["Non-Billable in CT" Q $P(RES,U,2) "RTN","IBNCPEV",116,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",117,0) I X="BILL",'RES,IBIFN Q "Bill "_$$BILL(IBIFN)_" created with ERRORs" "RTN","IBNCPEV",118,0) I X="BILL",'RES Q "Error: "_$P(RES,U,2) "RTN","IBNCPEV",119,0) I X="BILL",'IBIFN Q $P(RES,U,2) "RTN","IBNCPEV",120,0) I X="BILL" Q "Bill# "_$$BILL(+IBIFN)_" created" "RTN","IBNCPEV",121,0) I X["REVERSE",$G(CR)=7,+RES=1 Q "set N/B Reason: Rx deleted, no Bill to cancel." "RTN","IBNCPEV",122,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",123,0) I 'RES Q $P(RES,U,2) "RTN","IBNCPEV",124,0) Q "OK" "RTN","IBNCPEV",125,0) ; "RTN","IBNCPEV",126,0) DBILL ; BILL section "RTN","IBNCPEV",127,0) ; input params IBD*, IBZ, IBINS* "RTN","IBNCPEV",128,0) ; "RTN","IBNCPEV",129,0) I '$P(IBZ,U,7),$L($P(IBZ,U,8)),$P(IBD3,U,1) D CHKP Q:IBQ W !?10,"ERROR: ",$P(IBZ,U,8) "RTN","IBNCPEV",130,0) D CHKP Q:IBQ "RTN","IBNCPEV",131,0) D SUBHDR "RTN","IBNCPEV",132,0) I $P(IBD2,U,4) D CHKP Q:IBQ W !?10,"DRUG:",$$DRUGAPI^IBNCPEV1(+$P(IBD2,U,4),.01) "RTN","IBNCPEV",133,0) ; "RTN","IBNCPEV",134,0) D CHKP Q:IBQ "RTN","IBNCPEV",135,0) W !?10,"NDC:",$S($P(IBD2,U,5):$P(IBD2,U,5),1:"No") "RTN","IBNCPEV",136,0) W ", NCPDP QTY:",$S($P(IBD2,U,14):$P(IBD2,U,14),1:"No") "RTN","IBNCPEV",137,0) W $$UNITDISP^IBNCPEV1($P(IBD2,U,14),$P(IBD2,U,15)) ; display NCPDP unit type "RTN","IBNCPEV",138,0) ; "RTN","IBNCPEV",139,0) D CHKP Q:IBQ "RTN","IBNCPEV",140,0) W !?10,"BILLED QTY:",$S($P(IBD2,U,8):$P(IBD2,U,8),1:"No") "RTN","IBNCPEV",141,0) W $$UNITDISP^IBNCPEV1($P(IBD2,U,8),$P(IBD2,U,13)) ; display billing unit type "RTN","IBNCPEV",142,0) W ", DAYS SUPPLY:",$S($P(IBD2,U,9):$P(IBD2,U,9),1:"No") "RTN","IBNCPEV",143,0) ; "RTN","IBNCPEV",144,0) W !,?10,"GROSS AMT DUE:",$J($P(IBD3,U,2),0,2),", " "RTN","IBNCPEV",145,0) W "TOTAL AMT PAID:",$J($P(IBD3,U,5),0,2) "RTN","IBNCPEV",146,0) D CHKP Q:IBQ "RTN","IBNCPEV",147,0) ; "RTN","IBNCPEV",148,0) ; display payer reported paid amounts "RTN","IBNCPEV",149,0) W !?10,"INGREDIENT COST PAID:",$S($L($P(IBD3,U,12)):$J($P(IBD3,U,12),0,2),1:"No") "RTN","IBNCPEV",150,0) W ", DISPENSING FEE PAID:",$S($L($P(IBD3,U,13)):$J($P(IBD3,U,13),0,2),1:"No") "RTN","IBNCPEV",151,0) D CHKP Q:IBQ "RTN","IBNCPEV",152,0) W !?10,"PATIENT RESP (INS):",$S($L($P(IBD3,U,14)):$FN(-$P(IBD3,U,14),"P",2),1:"No") "RTN","IBNCPEV",153,0) D CHKP Q:IBQ "RTN","IBNCPEV",154,0) ; "RTN","IBNCPEV",155,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",156,0) D CHKP Q:IBQ "RTN","IBNCPEV",157,0) D DISPUSR "RTN","IBNCPEV",158,0) Q "RTN","IBNCPEV",159,0) ; "RTN","IBNCPEV",160,0) DREJ ; reject section "RTN","IBNCPEV",161,0) D CHKP Q:IBQ "RTN","IBNCPEV",162,0) D SUBHDR "RTN","IBNCPEV",163,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",164,0) D CLRS Q:IBQ "RTN","IBNCPEV",165,0) D CHKP Q:IBQ "RTN","IBNCPEV",166,0) D DISPUSR "RTN","IBNCPEV",167,0) Q "RTN","IBNCPEV",168,0) ; "RTN","IBNCPEV",169,0) DCLO ; close "RTN","IBNCPEV",170,0) D DREJ "RTN","IBNCPEV",171,0) Q "RTN","IBNCPEV",172,0) ; "RTN","IBNCPEV",173,0) DSUB ; submit "RTN","IBNCPEV",174,0) N IBIN,IBHP "RTN","IBNCPEV",175,0) D CHKP Q:IBQ "RTN","IBNCPEV",176,0) D SUBHDR "RTN","IBNCPEV",177,0) I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6) "RTN","IBNCPEV",178,0) ; IB*2.0*521 Display HPID but do not add '*' if it does not pass validation checks "RTN","IBNCPEV",179,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",180,0) I $L($P(IBD3,U,3)) D CHKP Q:IBQ D "RTN","IBNCPEV",181,0) .S IBIN=+$G(^IBA(355.3,+$P(IBD3,U,3),0)),IBHP=$$HPD^IBCNHUT1(IBIN) "RTN","IBNCPEV",182,0) .W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,IBIN,0)),U),!?10,"HPID/OEID:",IBHP "RTN","IBNCPEV",183,0) D CHKP Q:IBQ "RTN","IBNCPEV",184,0) D DISPUSR "RTN","IBNCPEV",185,0) Q "RTN","IBNCPEV",186,0) ; "RTN","IBNCPEV",187,0) DREL ; release "RTN","IBNCPEV",188,0) D DREJ "RTN","IBNCPEV",189,0) Q "RTN","IBNCPEV",190,0) ; "RTN","IBNCPEV",191,0) DREV ; reverse "RTN","IBNCPEV",192,0) N IBIN,IBHP "RTN","IBNCPEV",193,0) D CHKP Q:IBQ "RTN","IBNCPEV",194,0) D SUBHDR "RTN","IBNCPEV",195,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",196,0) I $L($P(IBD1,U,6)) D CHKP W !?10,"PAYER RESPONSE: ",$P(IBD1,U,6) "RTN","IBNCPEV",197,0) ; IB*2.0*521 Display HPID and do not add '*' if it does not pass validation checks "RTN","IBNCPEV",198,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",199,0) I $L($P(IBD3,U,3)) D CHKP Q:IBQ D "RTN","IBNCPEV",200,0) .S IBIN=+$G(^IBA(355.3,+$P(IBD3,U,3),0)),IBHP=$$HPD^IBCNHUT1(IBIN) "RTN","IBNCPEV",201,0) .W !?10,"PLAN:",$P($G(^IBA(355.3,+$P(IBD3,U,3),0)),U,3),", INSURANCE: ",$P($G(^DIC(36,IBIN,0)),U),!?10,"HPID/OEID:",IBHP "RTN","IBNCPEV",202,0) D CLRS Q:IBQ "RTN","IBNCPEV",203,0) D CHKP Q:IBQ "RTN","IBNCPEV",204,0) D DISPUSR "RTN","IBNCPEV",205,0) W !?10,"REVERSAL REASON:",$P(IBD1,U,7) "RTN","IBNCPEV",206,0) Q "RTN","IBNCPEV",207,0) ; "RTN","IBNCPEV",208,0) BCANC ; bill cancellation generated by auto-reversal (duplicate bill) "RTN","IBNCPEV",209,0) D CHKP Q:IBQ "RTN","IBNCPEV",210,0) W !?10,"SYSTEM FOUND DUPLICATE BILL WHILE PROCESSING CLAIM" "RTN","IBNCPEV",211,0) D CHKP Q:IBQ "RTN","IBNCPEV",212,0) D DISPUSR "RTN","IBNCPEV",213,0) Q "RTN","IBNCPEV",214,0) ; "RTN","IBNCPEV",215,0) CLRS ; "RTN","IBNCPEV",216,0) N TX,PP,RC "RTN","IBNCPEV",217,0) S TX="CLOSE REASON" "RTN","IBNCPEV",218,0) S PP="DROP TO PAPER" "RTN","IBNCPEV",219,0) S RC="RELEASE COPAY" "RTN","IBNCPEV",220,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",221,0) S TX="CLOSE COMMENT" "RTN","IBNCPEV",222,0) I $L($P(IBD3,U,6))>2 D CHKP Q:IBQ W !?10,"COMMENT:",$P(IBD3,U,6) "RTN","IBNCPEV",223,0) Q "RTN","IBNCPEV",224,0) ; "RTN","IBNCPEV",225,0) HDR ;header "RTN","IBNCPEV",226,0) W @IOF S IBPAGE=IBPAGE+1 W ?72,"PAGE ",IBPAGE "RTN","IBNCPEV",227,0) W !,$$DISPTITL^IBNCPEV1(IBBDT,IBEDT,IBDTL,.IBDIVS) "RTN","IBNCPEV",228,0) W:IBDIVS'=0 !,$$DISPLDIV^IBNCPEV1(.IBDIVS) "RTN","IBNCPEV",229,0) W !?15 "RTN","IBNCPEV",230,0) I IBM1="R" W "SINGLE PRESCRIPTION - ",$$RXNUM(IBRX)," " "RTN","IBNCPEV",231,0) I IBM1="P" W "SINGLE PATIENT - ",$P($G(^DPT(IBPAT,0)),U)," " "RTN","IBNCPEV",232,0) I IBM1="E" W "SINGLE ECME # - ",IBECME "RTN","IBNCPEV",233,0) I IBM2="E" W "ECME BILLABLE RX " "RTN","IBNCPEV",234,0) I IBM2="N" W "NON ECME BILLABLE RX " "RTN","IBNCPEV",235,0) I IBM3'="A",IBM1'="R" W $S(IBM3="M":"MAIL",IBM3="C":"CMOP",1:"WINDOW")_" PRESCRIPTIONS ONLY" "RTN","IBNCPEV",236,0) W !,?4," RX# FILL DATE PATIENT NAME",?55,"DRUG" "RTN","IBNCPEV",237,0) N I W ! F I=1:1:80 W "=" "RTN","IBNCPEV",238,0) Q "RTN","IBNCPEV",239,0) ; "RTN","IBNCPEV",240,0) ULINE(X) ;line "RTN","IBNCPEV",241,0) D CHKP Q:IBQ "RTN","IBNCPEV",242,0) N I W ! F I=1:1:80 W $G(X,"-") "RTN","IBNCPEV",243,0) Q "RTN","IBNCPEV",244,0) CHKP ;Check for EOP "RTN","IBNCPEV",245,0) N Y "RTN","IBNCPEV",246,0) I $Y>(IOSL-4) D:IBSCR PAUSE Q:IBQ D HDR "RTN","IBNCPEV",247,0) Q "RTN","IBNCPEV",248,0) DAT(X,Y) Q $$DAT1^IBOUTL(X,.Y) "RTN","IBNCPEV",249,0) TIM(X) N IBT ;time "RTN","IBNCPEV",250,0) S IBT=$$DAT1^IBOUTL(X,1) I $L(IBT," ")<3 Q IBT "RTN","IBNCPEV",251,0) I $P(IBT," ",3)="pm" S IBT=$P(IBT," ",1,2)_"p" Q IBT "RTN","IBNCPEV",252,0) I $P(IBT," ",3)="am" S IBT=$P(IBT," ",1,2)_"a" Q IBT "RTN","IBNCPEV",253,0) Q IBT "RTN","IBNCPEV",254,0) ; "RTN","IBNCPEV",255,0) USR(X) ; "RTN","IBNCPEV",256,0) I $D(^VA(200,+X,0)) Q $P(^(0),U) "RTN","IBNCPEV",257,0) Q X "RTN","IBNCPEV",258,0) ; "RTN","IBNCPEV",259,0) PAT(DFN) ; "RTN","IBNCPEV",260,0) Q $P($G(^DPT(DFN,0),"?"),"^") "RTN","IBNCPEV",261,0) BILL(BN) ; "RTN","IBNCPEV",262,0) Q $P($G(^DGCR(399,BN,0),"?"),"^") "RTN","IBNCPEV",263,0) ARBILL(BN) ; "RTN","IBNCPEV",264,0) Q $P($G(^PRCA(430,BN,0),"?"),"^") "RTN","IBNCPEV",265,0) ; "RTN","IBNCPEV",266,0) ;Returns DRUG name (#50,.01) "RTN","IBNCPEV",267,0) ;IBDFN = IEN in PATIENT file #2 "RTN","IBNCPEV",268,0) ;IBRX = IEN in PRESCRIPTION file #52 "RTN","IBNCPEV",269,0) DRUG(IBDFN,IBRX) ; "RTN","IBNCPEV",270,0) I +$G(IBDFN)=0 Q "" "RTN","IBNCPEV",271,0) N X1 "RTN","IBNCPEV",272,0) K ^TMP($J,"IBNCPDP52") "RTN","IBNCPEV",273,0) D RX^PSO52API(IBDFN,"IBNCPDP52",IBRX,"",0) "RTN","IBNCPEV",274,0) S X1=+$G(^TMP($J,"IBNCPDP52",IBDFN,IBRX,6)) "RTN","IBNCPEV",275,0) K ^TMP($J,"IBNCPDP52") "RTN","IBNCPEV",276,0) I X1=0 Q "" "RTN","IBNCPEV",277,0) Q $$DRUGNAM^IBNCPEV1(X1) "RTN","IBNCPEV",278,0) ; "RTN","IBNCPEV",279,0) EVNT(X) ;Translate codes "RTN","IBNCPEV",280,0) I X="BILL" Q "BILLING" "RTN","IBNCPEV",281,0) I X="REVERSE" Q "REVERSAL" "RTN","IBNCPEV",282,0) I X="AUTO REVERSE" Q "REVERSAL(A)" "RTN","IBNCPEV",283,0) I X["RELEASE" Q "RELEASE" "RTN","IBNCPEV",284,0) I X["SUBMIT" Q "SUBMIT" "RTN","IBNCPEV",285,0) I X["CLOSE" Q "CLOSE" "RTN","IBNCPEV",286,0) I X[IBSC Q "FINISH" ;IBSC = "STATUS CHECK" "RTN","IBNCPEV",287,0) Q X "RTN","IBNCPEV",288,0) ; "RTN","IBNCPEV",289,0) BOCD(X) ;Basis of Cost Determination "RTN","IBNCPEV",290,0) I +X=7 Q "USUAL & CUSTOMARY" "RTN","IBNCPEV",291,0) I +X=1 Q "AWP" "RTN","IBNCPEV",292,0) I +X=5 Q "COST CALCULATIONS" "RTN","IBNCPEV",293,0) Q X "RTN","IBNCPEV",294,0) ; "RTN","IBNCPEV",295,0) PAUSE ; "RTN","IBNCPEV",296,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",297,0) U IO "RTN","IBNCPEV",298,0) Q "RTN","IBNCPEV",299,0) ; "RTN","IBNCPEV",300,0) SUBHDR ; display ECME#, Date of Service, and Release Date/Time (if it exists) "RTN","IBNCPEV",301,0) ; used by many event displays "RTN","IBNCPEV",302,0) W !?10,"ECME#:",$P(IBD1,U,3),", DOS:",$$DAT($P(IBD2,U,6)) "RTN","IBNCPEV",303,0) I $P(IBD2,U,7) W ", RELEASE DATE:",$$TIM($P(IBD2,U,7)) "RTN","IBNCPEV",304,0) Q "RTN","IBNCPEV",305,0) ; "RTN","IBNCPEV",306,0) DISPUSR ; "RTN","IBNCPEV",307,0) W !?10,"USER:",$$USR(+$P(IBD3,U,10)) "RTN","IBNCPEV",308,0) Q "RTN","IBNCPEV",309,0) ; "RTN","IBNCPEV",310,0) ;Returns RX number (external value: #52,.01) "RTN","IBNCPEV",311,0) ;IBRX = IEN in PRESCRIPTION file #52 "RTN","IBNCPEV",312,0) RXNUM(IBRX) ; "RTN","IBNCPEV",313,0) Q $$RXAPI1^IBNCPUT1(IBRX,.01,"E") "RTN","IBNCPEV",314,0) ; "RTN","IBY521PO") 0^^B792423 "RTN","IBY521PO",1,0) IBY521PO ;ALB/GEF - Post install routine for patch 521 ; 7-NOV-14 "RTN","IBY521PO",2,0) ;;2.0;INTEGRATED BILLING;**521**;21-MAR-94;Build 33 "RTN","IBY521PO",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBY521PO",4,0) ; "RTN","IBY521PO",5,0) ; XPDUTL calls are DBIA#10141 "RTN","IBY521PO",6,0) ; "RTN","IBY521PO",7,0) DOC ; "RTN","IBY521PO",8,0) ; HPID Build 1 created 4 new fields in file 36. "RTN","IBY521PO",9,0) ; 2 had cross-references which were set up to allow as look-ups. "RTN","IBY521PO",10,0) ; Build 2 changes those cross-references to be non-lookup. "RTN","IBY521PO",11,0) ; This change requires they now start with "A": "RTN","IBY521PO",12,0) ; 8.01 - HPID/OEID - was "HOD", now will be "AHOD" "RTN","IBY521PO",13,0) ; 8.04 - NID IF - was "NIF", now will be "ANIF" "RTN","IBY521PO",14,0) ; "RTN","IBY521PO",15,0) ; PRINDX^IBY521PR will run in the pre-install to delete old x-refs "RTN","IBY521PO",16,0) ; POINDX^IBY521PO will run post-install to set in new format "RTN","IBY521PO",17,0) ; "RTN","IBY521PO",18,0) POINDX ; POST-INSTALL comes here "RTN","IBY521PO",19,0) ; run triggers on new cross-refs for fields 8.01 & 8.04 (AHOD & ANIF) "RTN","IBY521PO",20,0) D MES^XPDUTL("Re-index of HPID & NIF ID cross-references in INSURANCE COMPANY file ") "RTN","IBY521PO",21,0) N DIK,FLD "RTN","IBY521PO",22,0) ; file 36, top level "RTN","IBY521PO",23,0) S DIK="^DIC(36," "RTN","IBY521PO",24,0) F FLD=8.01,8.04 S DIK(1)=FLD D ENALL^DIK "RTN","IBY521PO",25,0) Q "RTN","IBY521PR") 0^^B793833 "RTN","IBY521PR",1,0) IBY521PR ;ALB/GEF - Pre install routine for patch 521 ; 10-NOV-14 "RTN","IBY521PR",2,0) ;;2.0;INTEGRATED BILLING;**521**;21-MAR-94;Build 33 "RTN","IBY521PR",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","IBY521PR",4,0) ; "RTN","IBY521PR",5,0) ; XPDUTL calls are DBIA#10141 "RTN","IBY521PR",6,0) ; "RTN","IBY521PR",7,0) DOC ; "RTN","IBY521PR",8,0) ; HPID Build 1 created 4 new fields in file 36. "RTN","IBY521PR",9,0) ; 2 had cross-references which were set up to allow as look-ups. "RTN","IBY521PR",10,0) ; Build 2 changes those cross-references to be non-lookup. "RTN","IBY521PR",11,0) ; This change requires they now start with "A": "RTN","IBY521PR",12,0) ; 8.01 - HPID/OEID - was "HOD", now will be "AHOD" "RTN","IBY521PR",13,0) ; 8.04 - NID IF - was "NIF", now will be "ANIF" "RTN","IBY521PR",14,0) ; "RTN","IBY521PR",15,0) ; INDXDD^IBY521PR will run in the pre-install to delete old x-refs "RTN","IBY521PR",16,0) ; POINDX^IBY521PO will run post-install to set in new format "RTN","IBY521PR",17,0) ; "RTN","IBY521PR",18,0) INDXDD ; PRE-INSTALL comes here "RTN","IBY521PR",19,0) ; DELETE old cross-references for fields 8.01 & 8.04 (HOD & NIF) from DD and file "RTN","IBY521PR",20,0) D MES^XPDUTL("Removing old HPID & NIF ID cross-references in INSURANCE COMPANY file ") "RTN","IBY521PR",21,0) N IBFLD "RTN","IBY521PR",22,0) F IBFLD=8.01,8.04 D DELIX^DDMOD(36,IBFLD,1,"KW") "RTN","IBY521PR",23,0) Q "VER") 8.0^22.0 "^DD",36,36,8.01,0) HPID/OEID^F^^8;1^K:$L(X)>10!($L(X)<1) X "^DD",36,36,8.01,.1) Health Plan/Other Entity Identifier "^DD",36,36,8.01,1,0) ^.1 "^DD",36,36,8.01,1,1,0) 36^AHOD "^DD",36,36,8.01,1,1,1) S ^DIC(36,"AHOD",$E(X,1,30),DA)="" "^DD",36,36,8.01,1,1,2) K ^DIC(36,"AHOD",$E(X,1,30),DA) "^DD",36,36,8.01,1,1,"%D",0) ^^4^4^3141110^ "^DD",36,36,8.01,1,1,"%D",1,0) This non look-up cross-reference will be used by "^DD",36,36,8.01,1,1,"%D",2,0) routine IBCNHUT1 to internally locate an Insurance "^DD",36,36,8.01,1,1,"%D",3,0) Company using the HPID/OEID (Health Plan or Other "^DD",36,36,8.01,1,1,"%D",4,0) Entity Identifier). "^DD",36,36,8.01,1,1,"DT") 3141110 "^DD",36,36,8.01,3) Answer must be 1-10 digits in length. "^DD",36,36,8.01,21,0) ^.001^10^10^3140619^^ "^DD",36,36,8.01,21,1,0) The HPID/OEID is a 10-digit, all-numeric identifier following the ISO "^DD",36,36,8.01,21,2,0) Standard 7812 format with a Luhn check-digit as the tenth digit. The "^DD",36,36,8.01,21,3,0) start digit of the HPID/OEID signals whether the identifier has been "^DD",36,36,8.01,21,4,0) provided to a health plan and not to an "other entity". If the start "^DD",36,36,8.01,21,5,0) digit is a seven (7) then it is an HPID and identifies a health plan, "^DD",36,36,8.01,21,6,0) a six (6) indicates an "other entity" (OEID). The OEID serves as the "^DD",36,36,8.01,21,7,0) identifier for entities that are not health plans, healthcare "^DD",36,36,8.01,21,8,0) providers, or individuals (persons) who are not eligible for the HPID "^DD",36,36,8.01,21,9,0) or National Provider Identifier (NPI),yet they need to be identified "^DD",36,36,8.01,21,10,0) in standard transactions and for other lawful purposes. "^DD",36,36,8.01,"DT") 3141110 "^DD",36,36,8.04,0) NIF ID^F^^8;4^K:$L(X)>20!($L(X)<1) X "^DD",36,36,8.04,1,0) ^.1 "^DD",36,36,8.04,1,1,0) 36^ANIF "^DD",36,36,8.04,1,1,1) S ^DIC(36,"ANIF",$E(X,1,30),DA)="" "^DD",36,36,8.04,1,1,2) K ^DIC(36,"ANIF",$E(X,1,30),DA) "^DD",36,36,8.04,1,1,"%D",0) ^^4^4^3141110^ "^DD",36,36,8.04,1,1,"%D",1,0) This non look-up cross-reference will be used by "^DD",36,36,8.04,1,1,"%D",2,0) routine IBCNHUT1 to internally locate an Insurance "^DD",36,36,8.04,1,1,"%D",3,0) Company using the NIF ID (National Insurance File "^DD",36,36,8.04,1,1,"%D",4,0) Identifier). "^DD",36,36,8.04,1,1,"DT") 3141110 "^DD",36,36,8.04,3) Answer must be 1-20 characters in length. "^DD",36,36,8.04,21,0) ^^4^4^3140619^ "^DD",36,36,8.04,21,1,0) This is the internal identifier of the correlated entry in the FSC NIF. "^DD",36,36,8.04,21,2,0) The NIF ID associates the new HPID/OEID data element with their "^DD",36,36,8.04,21,3,0) correlated entry in the NIF (National Insurance File) so that there will "^DD",36,36,8.04,21,4,0) be a linkage between VA/VistA and the FSC's NIF. "^DD",36,36,8.04,"DT") 3141110 "^DD",361.1,361.1,2.06,0) HPID/OEID^FXI^^2;6^K:$L(X)>10 X "^DD",361.1,361.1,2.06,.1) Health Plan/Other Entity Identifier "^DD",361.1,361.1,2.06,3) Answer must be 10 characters in length. "^DD",361.1,361.1,2.06,21,0) ^.001^10^10^3140508^^ "^DD",361.1,361.1,2.06,21,1,0) The HPID/OEID is a 10-digit, all-numeric identifier following the ISO "^DD",361.1,361.1,2.06,21,2,0) Standard 7812 format with a Luhn check-digit as the tenth digit. The "^DD",361.1,361.1,2.06,21,3,0) start digit of the HPID/OEID signals whether the identifier has been "^DD",361.1,361.1,2.06,21,4,0) provided to a health plan and not to an "other entity". If the start "^DD",361.1,361.1,2.06,21,5,0) digit is a seven (7) then it is an HPID and identifies a health plan, a "^DD",361.1,361.1,2.06,21,6,0) six (6) indicates an "other entity" (OEID). The OEID serves as the "^DD",361.1,361.1,2.06,21,7,0) identifier for entities that are not health plans, healthcare providers, "^DD",361.1,361.1,2.06,21,8,0) or individuals (persons) who are not eligible for the HPID or National "^DD",361.1,361.1,2.06,21,9,0) Provider Identifier (NPI), yet they need to be identified in standard "^DD",361.1,361.1,2.06,21,10,0) transactions and for other lawful purposes. "^DD",361.1,361.1,2.06,"DT") 3140508 **INSTALL NAME** PRCA*4.5*302 "BLD",9343,0) PRCA*4.5*302^ACCOUNTS RECEIVABLE^0^3141216^y "BLD",9343,4,0) ^9.64PA^^ "BLD",9343,6.3) 28 "BLD",9343,"KRN",0) ^9.67PA^779.2^20 "BLD",9343,"KRN",.4,0) .4 "BLD",9343,"KRN",.401,0) .401 "BLD",9343,"KRN",.402,0) .402 "BLD",9343,"KRN",.403,0) .403 "BLD",9343,"KRN",.5,0) .5 "BLD",9343,"KRN",.84,0) .84 "BLD",9343,"KRN",3.6,0) 3.6 "BLD",9343,"KRN",3.8,0) 3.8 "BLD",9343,"KRN",9.2,0) 9.2 "BLD",9343,"KRN",9.8,0) 9.8 "BLD",9343,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",9343,"KRN",9.8,"NM",1,0) RCDPESR9^^0^B71991491 "BLD",9343,"KRN",9.8,"NM",2,0) RCDPES10^^0^B86556768 "BLD",9343,"KRN",9.8,"NM","B","RCDPES10",2) "BLD",9343,"KRN",9.8,"NM","B","RCDPESR9",1) "BLD",9343,"KRN",19,0) 19 "BLD",9343,"KRN",19.1,0) 19.1 "BLD",9343,"KRN",101,0) 101 "BLD",9343,"KRN",409.61,0) 409.61 "BLD",9343,"KRN",771,0) 771 "BLD",9343,"KRN",779.2,0) 779.2 "BLD",9343,"KRN",870,0) 870 "BLD",9343,"KRN",8989.51,0) 8989.51 "BLD",9343,"KRN",8989.52,0) 8989.52 "BLD",9343,"KRN",8994,0) 8994 "BLD",9343,"KRN","B",.4,.4) "BLD",9343,"KRN","B",.401,.401) "BLD",9343,"KRN","B",.402,.402) "BLD",9343,"KRN","B",.403,.403) "BLD",9343,"KRN","B",.5,.5) "BLD",9343,"KRN","B",.84,.84) "BLD",9343,"KRN","B",3.6,3.6) "BLD",9343,"KRN","B",3.8,3.8) "BLD",9343,"KRN","B",9.2,9.2) "BLD",9343,"KRN","B",9.8,9.8) "BLD",9343,"KRN","B",19,19) "BLD",9343,"KRN","B",19.1,19.1) "BLD",9343,"KRN","B",101,101) "BLD",9343,"KRN","B",409.61,409.61) "BLD",9343,"KRN","B",771,771) "BLD",9343,"KRN","B",779.2,779.2) "BLD",9343,"KRN","B",870,870) "BLD",9343,"KRN","B",8989.51,8989.51) "BLD",9343,"KRN","B",8989.52,8989.52) "BLD",9343,"KRN","B",8994,8994) "BLD",9343,"QUES",0) ^9.62^^ "BLD",9343,"REQB",0) ^9.611^2^2 "BLD",9343,"REQB",1,0) PRCA*4.5*269^1 "BLD",9343,"REQB",2,0) IB*2.0*519^1 "BLD",9343,"REQB","B","IB*2.0*519",2) "BLD",9343,"REQB","B","PRCA*4.5*269",1) "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) 302^3141216 "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") 2 "RTN","RCDPES10") 0^2^B86556768 "RTN","RCDPES10",1,0) RCDPES10 ;ALB/DWA/PJH - ERA return file field captions ;08/19/2010 "RTN","RCDPES10",2,0) ;;4.5;Accounts Receivable;**269,302**;Mar 20, 1995;Build 28 "RTN","RCDPES10",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPES10",4,0) ; "RTN","RCDPES10",5,0) ; Note: if the 835 flat file changes, make the corresponding changes "RTN","RCDPES10",6,0) ; in this routine. "RTN","RCDPES10",7,0) 835 ;;HEADER DATA "RTN","RCDPES10",8,0) ;;835^^Return Message ID^S Y=X_" (ERA HEADER DATA)" "RTN","RCDPES10",9,0) ;;835^^X12/Proprietary flag^S Y=$S(X="X":"X12",1:X) "RTN","RCDPES10",10,0) ;;835^^File Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",11,0) ;;835^^File Time^S Y=$E(X,1,2)-$S($E(X,1,2)>12:12,1:0)_":"_$E(X,3,4)_$S($E(X,1,2)=24:" AM",$E(X,1,2)>11:" PM",1:" AM") "RTN","RCDPES10",12,0) ;;835^1^MRA^S Y="" "RTN","RCDPES10",13,0) ;;835^^Payer Name "RTN","RCDPES10",14,0) ;;835^^Payer ID "RTN","RCDPES10",15,0) ;;835^^Trace Number "RTN","RCDPES10",16,0) ;;835^^Date Claims Paid^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",17,0) ;;835^^Total ERA Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",18,0) ;;835^^Erroneous Provider Tax ID "RTN","RCDPES10",19,0) ;;835^^Tax ID correction Flag^S Y=$S(X="E":"CHANGED BY EPHRA",X="C":"DETERMINED FROM CLAIM DATA",X="":"NO CHANGE MADE",1:X) "RTN","RCDPES10",20,0) ;;835^^Sequence Control # "RTN","RCDPES10",21,0) ;;835^^Sequence # "RTN","RCDPES10",22,0) ;;835^^Last Sequence # "RTN","RCDPES10",23,0) ;;835^^HIPAA Version Code "RTN","RCDPES10",24,0) ;;835^^Payment Method Code "RTN","RCDPES10",25,0) ;;835^^Billing Provider NPI "RTN","RCDPES10",26,0) ;;835^^Contact Information "RTN","RCDPES10",27,0) ; "RTN","RCDPES10",28,0) 01 ;;PAYER CONTACT INFORMATION "RTN","RCDPES10",29,0) ;;01^^Line Type^S Y=X_" (ERA LEVEL CONTACT DATA)" "RTN","RCDPES10",30,0) ;;01^^ERA Contact Name "RTN","RCDPES10",31,0) ;;01^^ERA Contact Phone "RTN","RCDPES10",32,0) ;;01^^ERA Contact Fax "RTN","RCDPES10",33,0) ;;01^^ERA Contact Email "RTN","RCDPES10",34,0) ;;01^^ERA Payer Website URL "RTN","RCDPES10",35,0) ; "RTN","RCDPES10",36,0) 02 ;;PAYER ADJUSTMENT RECORD "RTN","RCDPES10",37,0) ;;02^^Line Type^S Y=X_" (ERA LEVEL PAYER ADJUSTMENT RECORD)" "RTN","RCDPES10",38,0) ;;02^^X12 Adjustment Reason Code "RTN","RCDPES10",39,0) ;;02^^Provider Adjustment Identifier "RTN","RCDPES10",40,0) ;;02^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",41,0) ; "RTN","RCDPES10",42,0) 03 ;;PAYER ADJUSTMENT RECORD (2) "RTN","RCDPES10",43,0) ;;03^^Line Type^S Y=X_" (ERA LEVEL PAYER ADJUSTMENT RECORD (2))" "RTN","RCDPES10",44,0) ;;03^^X12 Reason Text "RTN","RCDPES10",45,0) ; "RTN","RCDPES10",46,0) 05 ;;CLAIM PATIENT ID "RTN","RCDPES10",47,0) ;;05^^Line Type^S Y=X_" (CLAIM LEVEL PATIENT ID DATA)" "RTN","RCDPES10",48,0) ;;05^^Bill # "RTN","RCDPES10",49,0) ;;05^^Patient Last Name "RTN","RCDPES10",50,0) ;;05^^Patient First Name "RTN","RCDPES10",51,0) ;;05^^Patient Middle Name "RTN","RCDPES10",52,0) ;;05^^Patient ID # "RTN","RCDPES10",53,0) ;;05^1^Record Contains Patient Name Change^S Y="" "RTN","RCDPES10",54,0) ;;05^1^Record Contains Patient ID Change^S Y="" "RTN","RCDPES10",55,0) ;;05^^Statement Start Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",56,0) ;;05^^Statement End Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",57,0) ;;05^^Claim Received Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",58,0) ; "RTN","RCDPES10",59,0) 06 ;;CORRECT PATIENT DATA "RTN","RCDPES10",60,0) ;;06^^Line Type^S Y=X_" (CLAIM LEVEL CORRECT PATIENT DATA)" "RTN","RCDPES10",61,0) ;;06^^Bill # "RTN","RCDPES10",62,0) ;;06^^Corrected Patient Last Name "RTN","RCDPES10",63,0) ;;06^^Corrected Patient First Name "RTN","RCDPES10",64,0) ;;06^^Corrected Patient Middle Name "RTN","RCDPES10",65,0) ;;06^^Corrected Patient ID # "RTN","RCDPES10",66,0) ; "RTN","RCDPES10",67,0) 10 ;;CLAIM STATUS DATA "RTN","RCDPES10",68,0) ;;10^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA)" "RTN","RCDPES10",69,0) ;;10^^Bill # "RTN","RCDPES10",70,0) ;;10^^Claim Processed^S Y=$$YN^RCDPESR9(X) "RTN","RCDPES10",71,0) ;;10^^Claim Denied^S Y=$$YN^RCDPESR9(X) "RTN","RCDPES10",72,0) ;;10^^Claim Pended^S Y=$$YN^RCDPESR9(X) "RTN","RCDPES10",73,0) ;;10^^Claim Reversal^S Y=$$YN^RCDPESR9(X) "RTN","RCDPES10",74,0) ;;10^^Claim Status Code "RTN","RCDPES10",75,0) ;;10^1^Crossed Over Name^S Y="" "RTN","RCDPES10",76,0) ;;10^1^Crossed Over ID^S Y="" "RTN","RCDPES10",77,0) ;;10^^Submitted Charge^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",78,0) ;;10^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",79,0) ;;10^^ICN "RTN","RCDPES10",80,0) ;;10^^DRG Code Used "RTN","RCDPES10",81,0) ;;10^^DRG Weight Used^S Y=$J($$ZERO^RCDPESR9(X,1)/100,4) "RTN","RCDPES10",82,0) ;;10^^Discharge Fraction^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",83,0) ;;10^^Coverage Expiration Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",84,0) ; "RTN","RCDPES10",85,0) 11 ;;CLAIM STATUS RENDERING PROVIDER INFORMATION "RTN","RCDPES10",86,0) ;;11^^Line Type^S Y=X_" (CLAIM STATUS RENDERING PROVIDER INFORMATION)" "RTN","RCDPES10",87,0) ;;11^^Bill # "RTN","RCDPES10",88,0) ;;11^^Rendering NPI "RTN","RCDPES10",89,0) ;;11^^Entity Type Qualifier "RTN","RCDPES10",90,0) ;;11^^Last Name "RTN","RCDPES10",91,0) ;;11^^First Name "RTN","RCDPES10",92,0) ; "RTN","RCDPES10",93,0) 12 ;;CLAIM STATUS CORRECTED PRIORITY PAYER "RTN","RCDPES10",94,0) ;;12^^Line Type^S Y=X_" (CLAIM STATUS CORRECTED PRIORITY PAYER)" "RTN","RCDPES10",95,0) ;;12^^Bill # "RTN","RCDPES10",96,0) ;;12^^Corrected Priority Payer Name "RTN","RCDPES10",97,0) ;;12^^Corrected Priority Payer ID Code Type "RTN","RCDPES10",98,0) ;;12^^Corrected Priority Payer ID Code "RTN","RCDPES10",99,0) ; "RTN","RCDPES10",100,0) 13 ;;CLAIM STATUS OTHER SUBSCRIBER "RTN","RCDPES10",101,0) ;;13^^Line Type^S Y=X_" (CLAIM STATUS OTHER SUBSCRIBER)" "RTN","RCDPES10",102,0) ;;13^^Bill # "RTN","RCDPES10",103,0) ;;13^^Other Subscriber Last Name "RTN","RCDPES10",104,0) ;;13^^Other Subscriber First Name "RTN","RCDPES10",105,0) ;;13^^Other Subscriber Middle Name "RTN","RCDPES10",106,0) ; "RTN","RCDPES10",107,0) 15 ;;CLAIM STATUS DATA "RTN","RCDPES10",108,0) ;;15^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA (CONTINUED))" "RTN","RCDPES10",109,0) ;;15^^Bill # "RTN","RCDPES10",110,0) ;;15^^Covered Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",111,0) ;;15^1^Discount Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",112,0) ;;15^1^Day Limit Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",113,0) ;;15^1^Interest Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",114,0) ;;15^1^Tax Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",115,0) ;;15^1^Total Before Taxes Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",116,0) ;;15^^Patient Responsibility Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",117,0) ;;15^1^Negative Reimbursement^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",118,0) ;;15^^Health Plan Identifer "RTN","RCDPES10",119,0) ; "RTN","RCDPES10",120,0) 17 ;;CLAIM LEVEL PAYER CONTACT INFORMATION "RTN","RCDPES10",121,0) ;;17^^Line Type^S Y=X_" (CLAIM LEVEL PAYER CONTACT INFO)" "RTN","RCDPES10",122,0) ;;17^^Bill # "RTN","RCDPES10",123,0) ;;17^^Contact Name "RTN","RCDPES10",124,0) ;;17^^ERA Contact Phone "RTN","RCDPES10",125,0) ;;17^^ERA Contact Fax "RTN","RCDPES10",126,0) ;;17^^ERA Contact Email "RTN","RCDPES10",127,0) ;;17^^Contact Website "RTN","RCDPES10",128,0) ; "RTN","RCDPES10",129,0) 20 ;;CLAIM LEVEL ADJUSTMENT DATA "RTN","RCDPES10",130,0) ;;20^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM ADJUSTMENT DATA)" "RTN","RCDPES10",131,0) ;;20^^Bill # "RTN","RCDPES10",132,0) ;;20^^Adjustment Group Code "RTN","RCDPES10",133,0) ;;20^^Adjustment Reason Code "RTN","RCDPES10",134,0) ;;20^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",135,0) ;;20^^Quantity^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPES10",136,0) ;;20^^Reason Code Text "RTN","RCDPES10",137,0) ; "RTN","RCDPES10",138,0) 30 ;;CLAIM LEVEL MEDICARE INPT ADJUDICATION DATA "RTN","RCDPES10",139,0) ;;30^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE INPATIENT ADJUDICATION DATA)" "RTN","RCDPES10",140,0) ;;30^^Bill # "RTN","RCDPES10",141,0) ;;30^^Covered Days/Visits^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPES10",142,0) ;;30^1^Lifetime Reserve Days Count^S Y=$$ZERO^RCDPESR9(X,,1) "RTN","RCDPES10",143,0) ;;30^1^Lifetime Psych Days Count^S Y=$$ZERO^RCDPESR9(X,,1) "RTN","RCDPES10",144,0) ;;30^^Claim DRG Amt^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",145,0) ;;30^1^Claim Disproportionate Share Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",146,0) ;;30^1^Claim MSP Pass thru Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",147,0) ;;30^1^Claim PPS Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",148,0) ;;30^1^PPS-Capital FSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",149,0) ;;30^1^PPS-Capital HSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",150,0) ;;30^1^PPS-Capital DSH DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",151,0) ;;30^1^Old Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",152,0) ;;30^^Non-Covered Days^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPES10",153,0) ; "RTN","RCDPES10",154,0) 35 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA "RTN","RCDPES10",155,0) ;;35^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA)" "RTN","RCDPES10",156,0) ;;35^^Bill # "RTN","RCDPES10",157,0) ;;35^1^PPS-Capital IME Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",158,0) ;;35^1^PPS-Operating Hosp Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",159,0) ;;35^1^Cost Report Day Count^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPES10",160,0) ;;35^1^PPS-Operating Fed Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",161,0) ;;35^1^Claim PPS Capital Outlier Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",162,0) ;;35^1^Claim Indirect Teaching Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",163,0) ;;35^1^Non-payable Professional Component Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",164,0) ;;35^1^PPS-Capital Exception Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",165,0) ;;35^1^Outpatient Reimbursement %^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPES10",166,0) ;;35^1^HCPCS Payable Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",167,0) ;;35^1^ESRD Paid Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",168,0) ;;35^1^Non-payable Professional Component^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",169,0) ; "RTN","RCDPES10",170,0) 37 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS "RTN","RCDPES10",171,0) ;;37^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS)" "RTN","RCDPES10",172,0) ;;37^^Bill # "RTN","RCDPES10",173,0) ;;37^^Type^S Y=$S(X="O":"MOA",X="I":"MIA",1:X) "RTN","RCDPES10",174,0) ;;37^^Claim Payment Remark Code "RTN","RCDPES10",175,0) ;;37^^Claim Payment Remark Code Message Text "RTN","RCDPES10",176,0) ; "RTN","RCDPES10",177,0) 40 ;;SERVICE LINE DATA "RTN","RCDPES10",178,0) ;;40^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA)" "RTN","RCDPES10",179,0) ;;40^^Bill # "RTN","RCDPES10",180,0) ;;40^^Procedure "RTN","RCDPES10",181,0) ;;40^^Revenue Code "RTN","RCDPES10",182,0) ;;40^^Modifier 1 "RTN","RCDPES10",183,0) ;;40^^Modifier 2 "RTN","RCDPES10",184,0) ;;40^^Modifier 3 "RTN","RCDPES10",185,0) ;;40^^Modifier 4 "RTN","RCDPES10",186,0) ;;40^^Description "RTN","RCDPES10",187,0) ;;40^^Original Procedure "RTN","RCDPES10",188,0) ;;40^^Original Modifier 1 "RTN","RCDPES10",189,0) ;;40^^Original Modifier 2 "RTN","RCDPES10",190,0) ;;40^^Original Modifier 3 "RTN","RCDPES10",191,0) ;;40^^Original Modifier 4 "RTN","RCDPES10",192,0) ;;40^^Original Charge^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",193,0) ;;40^^Original Units^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",194,0) ;;40^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",195,0) ;;40^^Covered Units^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",196,0) ;;40^^Service From Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",197,0) ;;40^^Service To Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPES10",198,0) ;;40^^Procedure Type "RTN","RCDPES10",199,0) ; "RTN","RCDPES10",200,0) 41 ;;SERVICE LINE DATA "RTN","RCDPES10",201,0) ;;41^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))" "RTN","RCDPES10",202,0) ;;41^^Bill # "RTN","RCDPES10",203,0) ;;41^^Allowed Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",204,0) ;;41^1^Per Diem Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPES10",205,0) ; "RTN","RCDPES10",206,0) 42 ;;SERVICE LINE DATA "RTN","RCDPES10",207,0) ;;42^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))" "RTN","RCDPES10",208,0) ;;42^^Bill # "RTN","RCDPES10",209,0) ;;42^^Line Item Remark Code "RTN","RCDPES10",210,0) ;;42^^Line Item Remark Code Text "RTN","RCDPES10",211,0) ;;42^^Provider Line Reference "RTN","RCDPES10",212,0) ; "RTN","RCDPES10",213,0) 45 ;;SERVICE LINE ADJUSTMENT DATA "RTN","RCDPES10",214,0) ;;45^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE ADJUSTMENT DATA)" "RTN","RCDPES10",215,0) ;;45^^Bill # "RTN","RCDPES10",216,0) ;;45^^Adjustment Group Code "RTN","RCDPES10",217,0) ;;45^^Adjustment Reason Code "RTN","RCDPES10",218,0) ;;45^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPES10",219,0) ;;45^^Quantity^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPES10",220,0) ;;45^^Reason Code Text "RTN","RCDPES10",221,0) ; "RTN","RCDPES10",222,0) 46 ;;ADJUSTMENT POLICY REFERENCE "RTN","RCDPES10",223,0) ;;46^^Line Type^S Y=X_" (ADJUSTMENT POLICY REFERENCE)" "RTN","RCDPES10",224,0) ;;46^^Bill # "RTN","RCDPES10",225,0) ;;46^^Payer Policy Preference "RTN","RCDPES10",226,0) ; "RTN","RCDPES10",227,0) FDT(X) ; returns MM/DD/YYYY or MM/DD/YY from YYYYMMDD or YYMMDD in X "RTN","RCDPES10",228,0) I $L(X)=8,X?8N S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4) "RTN","RCDPES10",229,0) I $L(X)=6,X?6N S X=$E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2) "RTN","RCDPES10",230,0) Q X "RTN","RCDPES10",231,0) ; "RTN","RCDPES10",232,0) ZERO(X,D,NULL) ; Returns numeric value of X without leading 0's "RTN","RCDPES10",233,0) ; or null if no value wanted for 0 amount "RTN","RCDPES10",234,0) ; D = 1 if dollar amt "RTN","RCDPES10",235,0) N Z "RTN","RCDPES10",236,0) I X["." S Z=$P(X,"."),X=+Z_"."_$P(X,".",2) "RTN","RCDPES10",237,0) I X'["." D "RTN","RCDPES10",238,0) . I $G(D) S X=+$E(X,1,$L(X)-2)_"."_$E(X,$L(X)-1,$L(X)) "RTN","RCDPES10",239,0) . S X=$S('$G(D):+X,1:$J(X,"",2)) "RTN","RCDPES10",240,0) Q $S(X:X,$G(NULL):"",1:X) "RTN","RCDPES10",241,0) ; "RTN","RCDPES10",242,0) YN(X) ; Returns YES for X="Y" and NO for X="N" "RTN","RCDPES10",243,0) S X=$S(X="Y":"YES",X="N":"NO",1:X) "RTN","RCDPES10",244,0) Q X "RTN","RCDPES10",245,0) ; "RTN","RCDPESR9") 0^1^B71991491 "RTN","RCDPESR9",1,0) RCDPESR9 ;ALB/TMK,DWA - ERA return file field captions ;09-SEP-2003 "RTN","RCDPESR9",2,0) ;;4.5;Accounts Receivable;**173,252,269,302**;Mar 20, 1995;Build 28 "RTN","RCDPESR9",3,0) ;;Per VA Directive 6402, this routine should not be modified. "RTN","RCDPESR9",4,0) ; "RTN","RCDPESR9",5,0) ; Note: if the 835 flat file changes, make the corresponding changes "RTN","RCDPESR9",6,0) ; in this routine. "RTN","RCDPESR9",7,0) 835 ;;HEADER DATA "RTN","RCDPESR9",8,0) ;;835^^Return Message ID^S Y=X_" (ERA HEADER DATA)" "RTN","RCDPESR9",9,0) ;;835^^X12/Proprietary flag^S Y=$S(X="X":"X12",1:X) "RTN","RCDPESR9",10,0) ;;835^^File Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPESR9",11,0) ;;835^^File Time^S Y=$E(X,1,2)-$S($E(X,1,2)>12:12,1:0)_":"_$E(X,3,4)_$S($E(X,1,2)=24:" AM",$E(X,1,2)>11:" PM",1:" AM") "RTN","RCDPESR9",12,0) ;;835^1^MRA^S Y="" "RTN","RCDPESR9",13,0) ;;835^^Payer Name "RTN","RCDPESR9",14,0) ;;835^^Payer ID "RTN","RCDPESR9",15,0) ;;835^^Trace Number "RTN","RCDPESR9",16,0) ;;835^^Date Claims Paid^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPESR9",17,0) ;;835^^Total ERA Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",18,0) ;;835^^Erroneous Provider Tax ID "RTN","RCDPESR9",19,0) ;;835^^Tax ID correction Flag^S Y=$S(X="E":"CHANGED BY EPHRA",X="C":"DETERMINED FROM CLAIM DATA",X="":"NO CHANGE MADE",1:X) "RTN","RCDPESR9",20,0) ;;835^^Sequence Control # "RTN","RCDPESR9",21,0) ;;835^^Sequence # "RTN","RCDPESR9",22,0) ;;835^^Last Sequence # "RTN","RCDPESR9",23,0) ;;835^^Contact Information "RTN","RCDPESR9",24,0) ;;835^^Payment Method Code "RTN","RCDPESR9",25,0) ;;835^^Billing Provider NPI "RTN","RCDPESR9",26,0) ; "RTN","RCDPESR9",27,0) 01 ;;PAYER CONTACT INFORMATION "RTN","RCDPESR9",28,0) ;;01^^Line Type^S Y=X_" (ERA LEVEL CONTACT DATA)" "RTN","RCDPESR9",29,0) ;;01^^ERA Contact Name "RTN","RCDPESR9",30,0) ;;01^^ERA Contact #1 "RTN","RCDPESR9",31,0) ;;01^^ERA Contact #1 Type^S Y=$$EXTERNAL^DILFD(344.4,3.03,,X) "RTN","RCDPESR9",32,0) ;;01^^ERA Contact #2 "RTN","RCDPESR9",33,0) ;;01^^ERA Contact #2 Type^S Y=$$EXTERNAL^DILFD(344.4,3.05,,X) "RTN","RCDPESR9",34,0) ;;01^^ERA Contact #3 "RTN","RCDPESR9",35,0) ;;01^^ERA Contact #3 Type^S Y=$$EXTERNAL^DILFD(344.4,3.07,,X) "RTN","RCDPESR9",36,0) ; "RTN","RCDPESR9",37,0) 02 ;;PAYER ADJUSTMENT RECORD "RTN","RCDPESR9",38,0) ;;02^^Line Type^S Y=X_" (ERA LEVEL PAYER ADJUSTMENT RECORD)" "RTN","RCDPESR9",39,0) ;;02^^X12 Adjustment Reason Code "RTN","RCDPESR9",40,0) ;;02^^Provider Adjustment Identifier "RTN","RCDPESR9",41,0) ;;02^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",42,0) ;;02^^X12 Reason Text "RTN","RCDPESR9",43,0) ; "RTN","RCDPESR9",44,0) 05 ;;CLAIM PATIENT ID "RTN","RCDPESR9",45,0) ;;05^^Line Type^S Y=X_" (CLAIM LEVEL PATIENT ID DATA)" "RTN","RCDPESR9",46,0) ;;05^^Bill # "RTN","RCDPESR9",47,0) ;;05^^Patient Last Name "RTN","RCDPESR9",48,0) ;;05^^Patient First Name "RTN","RCDPESR9",49,0) ;;05^^Patient Middle Name "RTN","RCDPESR9",50,0) ;;05^^Patient ID # "RTN","RCDPESR9",51,0) ;;05^1^Record Contains Patient Name Change^S Y="" "RTN","RCDPESR9",52,0) ;;05^1^Record Contains Patient ID Change^S Y="" "RTN","RCDPESR9",53,0) ;;05^^Statement Start Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPESR9",54,0) ;;05^^Statement End Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPESR9",55,0) ; "RTN","RCDPESR9",56,0) 06 ;;CORECT PATIENT DATA "RTN","RCDPESR9",57,0) ;;06^^Line Type^S Y=X_" (CLAIM LEVEL CORRECT PATIENT DATA)" "RTN","RCDPESR9",58,0) ;;06^^Bill # "RTN","RCDPESR9",59,0) ;;06^^Corrected Patient Last Name "RTN","RCDPESR9",60,0) ;;06^^Corrected Patient First Name "RTN","RCDPESR9",61,0) ;;06^^Corrected Patient Middle Name "RTN","RCDPESR9",62,0) ;;06^^Corrected Patient ID # "RTN","RCDPESR9",63,0) ; "RTN","RCDPESR9",64,0) 10 ;;CLAIM STATUS DATA "RTN","RCDPESR9",65,0) ;;10^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA)" "RTN","RCDPESR9",66,0) ;;10^^Bill # "RTN","RCDPESR9",67,0) ;;10^^Claim Processed^S Y=$$YN^RCDPESR9(X) "RTN","RCDPESR9",68,0) ;;10^^Claim Denied^S Y=$$YN^RCDPESR9(X) "RTN","RCDPESR9",69,0) ;;10^^Claim Pended^S Y=$$YN^RCDPESR9(X) "RTN","RCDPESR9",70,0) ;;10^^Claim Reversal^S Y=$$YN^RCDPESR9(X) "RTN","RCDPESR9",71,0) ;;10^^Claim Status Code "RTN","RCDPESR9",72,0) ;;10^1^Crossed Over Name^S Y="" "RTN","RCDPESR9",73,0) ;;10^1^Crossed Over ID^S Y="" "RTN","RCDPESR9",74,0) ;;10^^Submitted Charge^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",75,0) ;;10^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",76,0) ;;10^^ICN "RTN","RCDPESR9",77,0) ;;10^^DRG Code Used "RTN","RCDPESR9",78,0) ;;10^^DRG Weight Used^S Y=$J($$ZERO^RCDPESR9(X,1)/100,4) "RTN","RCDPESR9",79,0) ;;10^^Discharge Fraction^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",80,0) ;;10^^Rendering NPI "RTN","RCDPESR9",81,0) ;;10^^Entity Type Qualifier "RTN","RCDPESR9",82,0) ;;10^^Last Name "RTN","RCDPESR9",83,0) ;;10^^First Name "RTN","RCDPESR9",84,0) ; "RTN","RCDPESR9",85,0) 15 ;;CLAIM STATUS DATA "RTN","RCDPESR9",86,0) ;;15^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM STATUS DATA (CONTINUED))" "RTN","RCDPESR9",87,0) ;;15^^Bill # "RTN","RCDPESR9",88,0) ;;15^^Covered Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",89,0) ;;15^1^Discount Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",90,0) ;;15^1^Day Limit Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",91,0) ;;15^1^Interest Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",92,0) ;;15^1^Tax Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",93,0) ;;15^1^Total Before Taxes Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",94,0) ;;15^^Patient Responsibility Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",95,0) ;;15^1^Negative Reimbursement^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",96,0) ;;15^^Health Plan Identifier "RTN","RCDPESR9",97,0) ; "RTN","RCDPESR9",98,0) 17 ;;CLAIM LEVEL PAYER CONTACT INFORMATION "RTN","RCDPESR9",99,0) ;;17^^Line Type^S Y=X_" (CLAIM LEVEL PAYER CONTACT INFO)" "RTN","RCDPESR9",100,0) ;;17^^Bill # "RTN","RCDPESR9",101,0) ;;17^^Contact Name "RTN","RCDPESR9",102,0) ;;17^^Contact #1 "RTN","RCDPESR9",103,0) ;;17^^Contact #1 Type^S Y=$$EXTERNAL^DILFD(361.1,25.03,,X) "RTN","RCDPESR9",104,0) ;;17^^Contact #2 "RTN","RCDPESR9",105,0) ;;17^^Contact #2 Type^S Y=$$EXTERNAL^DILFD(361.1,25.05,,X) "RTN","RCDPESR9",106,0) ;;17^^Contact #3 "RTN","RCDPESR9",107,0) ;;17^^Contact #3 Type^S Y=$$EXTERNAL^DILFD(361.1,25.07,,X) "RTN","RCDPESR9",108,0) ; "RTN","RCDPESR9",109,0) 20 ;;CLAIM LEVEL ADJUSTMENT DATA "RTN","RCDPESR9",110,0) ;;20^^Line Type^S Y=X_" (CLAIM LEVEL CLAIM ADJUSTMENT DATA)" "RTN","RCDPESR9",111,0) ;;20^^Bill # "RTN","RCDPESR9",112,0) ;;20^^Adjustment Group Code "RTN","RCDPESR9",113,0) ;;20^^Adjustment Reason Code "RTN","RCDPESR9",114,0) ;;20^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",115,0) ;;20^^Quantity^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPESR9",116,0) ;;20^^Reason Code Text "RTN","RCDPESR9",117,0) ; "RTN","RCDPESR9",118,0) 30 ;;CLAIM LEVEL MEDICARE INPT ADJUDICATION DATA "RTN","RCDPESR9",119,0) ;;30^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE INPATIENT ADJUDICATION DATA)" "RTN","RCDPESR9",120,0) ;;30^^Bill # "RTN","RCDPESR9",121,0) ;;30^^Covered Days/Visits^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPESR9",122,0) ;;30^1^Lifetime Reserve Days Count^S Y=$$ZERO^RCDPESR9(X,,1) "RTN","RCDPESR9",123,0) ;;30^1^Lifetime Psych Days Count^S Y=$$ZERO^RCDPESR9(X,,1) "RTN","RCDPESR9",124,0) ;;30^^Claim DRG Amt^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",125,0) ;;30^1^Claim Disproportionate Share Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",126,0) ;;30^1^Claim MSP Pass thru Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",127,0) ;;30^1^Claim PPS Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",128,0) ;;30^1^PPS-Capital FSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",129,0) ;;30^1^PPS-Capital HSP DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",130,0) ;;30^1^PPS-Capital DSH DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",131,0) ;;30^1^Old Capital Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",132,0) ;;30^^Non-Covered Days^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPESR9",133,0) ; "RTN","RCDPESR9",134,0) 35 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA "RTN","RCDPESR9",135,0) ;;35^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA)" "RTN","RCDPESR9",136,0) ;;35^^Bill # "RTN","RCDPESR9",137,0) ;;35^1^PPS-Capital IME Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",138,0) ;;35^1^PPS-Operating Hosp Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",139,0) ;;35^1^Cost Report Day Count^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPESR9",140,0) ;;35^1^PPS-Operating Fed Specific DRG Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",141,0) ;;35^1^Claim PPS Capital Outlier Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",142,0) ;;35^1^Claim Indirect Teaching Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",143,0) ;;35^1^Non-payable Professional Component Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",144,0) ;;35^1^PPS-Capital Exception Amt^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",145,0) ;;35^1^Outpatient Reimbursement %^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPESR9",146,0) ;;35^1^HCPCS Payable Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",147,0) ;;35^1^ESRD Paid Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",148,0) ;;35^1^Non-payable Professional Component^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",149,0) ; "RTN","RCDPESR9",150,0) 37 ;;CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS "RTN","RCDPESR9",151,0) ;;37^^Line Type^S Y=X_" (CLAIM LEVEL MEDICARE ADJUDICATION DATA REMARKS)" "RTN","RCDPESR9",152,0) ;;37^^Bill # "RTN","RCDPESR9",153,0) ;;37^^Type^S Y=$S(X="O":"MOA",X="I":"MIA",1:X) "RTN","RCDPESR9",154,0) ;;37^^Claim Payment Remark Code "RTN","RCDPESR9",155,0) ;;37^^Claim Payment Remark Code Message Text "RTN","RCDPESR9",156,0) ; "RTN","RCDPESR9",157,0) 40 ;;SERVICE LINE DATA "RTN","RCDPESR9",158,0) ;;40^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA)" "RTN","RCDPESR9",159,0) ;;40^^Bill # "RTN","RCDPESR9",160,0) ;;40^^Procedure "RTN","RCDPESR9",161,0) ;;40^^Revenue Code "RTN","RCDPESR9",162,0) ;;40^^Modifier 1 "RTN","RCDPESR9",163,0) ;;40^^Modifier 2 "RTN","RCDPESR9",164,0) ;;40^^Modifier 3 "RTN","RCDPESR9",165,0) ;;40^^Modifier 4 "RTN","RCDPESR9",166,0) ;;40^^Description "RTN","RCDPESR9",167,0) ;;40^^Original Procedure "RTN","RCDPESR9",168,0) ;;40^^Original Modifier 1 "RTN","RCDPESR9",169,0) ;;40^^Original Modifier 2 "RTN","RCDPESR9",170,0) ;;40^^Original Modifier 3 "RTN","RCDPESR9",171,0) ;;40^^Original Modifier 4 "RTN","RCDPESR9",172,0) ;;40^^Original Charge^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",173,0) ;;40^^Original Units^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",174,0) ;;40^^Amount Paid^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",175,0) ;;40^^Covered Units^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",176,0) ;;40^^Service From Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPESR9",177,0) ;;40^^Service To Date^S Y=$$FDT^RCDPESR9(X) "RTN","RCDPESR9",178,0) ;;40^^Procedure Type "RTN","RCDPESR9",179,0) ;;40^^Applies to Billing Line "RTN","RCDPESR9",180,0) ; "RTN","RCDPESR9",181,0) 41 ;;SERVICE LINE DATA "RTN","RCDPESR9",182,0) ;;41^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))" "RTN","RCDPESR9",183,0) ;;41^^Bill # "RTN","RCDPESR9",184,0) ;;41^^Allowed Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",185,0) ;;41^1^Per Diem Amount^S Y=$$ZERO^RCDPESR9(X,1,1) "RTN","RCDPESR9",186,0) ; "RTN","RCDPESR9",187,0) 42 ;;SERVICE LINE DATA "RTN","RCDPESR9",188,0) ;;42^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE DATA (CONTINUED))" "RTN","RCDPESR9",189,0) ;;42^^Bill # "RTN","RCDPESR9",190,0) ;;42^^Line Item Remark Code "RTN","RCDPESR9",191,0) ;;42^^Line Item Remark Code Text "RTN","RCDPESR9",192,0) ; "RTN","RCDPESR9",193,0) 45 ;;SERVICE LINE ADJUSTMENT DATA "RTN","RCDPESR9",194,0) ;;45^^Line Type^S Y=X_" (CLAIM LEVEL SERVICE LINE ADJUSTMENT DATA)" "RTN","RCDPESR9",195,0) ;;45^^Bill # "RTN","RCDPESR9",196,0) ;;45^^Adjustment Group Code "RTN","RCDPESR9",197,0) ;;45^^Adjustment Reason Code "RTN","RCDPESR9",198,0) ;;45^^Adjustment Amount^S Y=$$ZERO^RCDPESR9(X,1) "RTN","RCDPESR9",199,0) ;;45^^Quantity^S Y=$$ZERO^RCDPESR9(X) "RTN","RCDPESR9",200,0) ;;45^^Reason Code Text "RTN","RCDPESR9",201,0) ; "RTN","RCDPESR9",202,0) FDT(X) ; returns MM/DD/YYYY or MM/DD/YY from YYYYMMDD or YYMMDD in X "RTN","RCDPESR9",203,0) I $L(X)=8,X?8N S X=$E(X,5,6)_"/"_$E(X,7,8)_"/"_$E(X,1,4) "RTN","RCDPESR9",204,0) I $L(X)=6,X?6N S X=$E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2) "RTN","RCDPESR9",205,0) Q X "RTN","RCDPESR9",206,0) ; "RTN","RCDPESR9",207,0) ZERO(X,D,NULL) ; Returns numeric value of X without leading 0's "RTN","RCDPESR9",208,0) ; or null if no value wanted for 0 amount "RTN","RCDPESR9",209,0) ; D = 1 if dollar amt "RTN","RCDPESR9",210,0) N Z "RTN","RCDPESR9",211,0) I X["." S Z=$P(X,"."),X=+Z_"."_$P(X,".",2) "RTN","RCDPESR9",212,0) I X'["." D "RTN","RCDPESR9",213,0) . I $G(D) S X=+$E(X,1,$L(X)-2)_"."_$E(X,$L(X)-1,$L(X)) "RTN","RCDPESR9",214,0) . S X=$S('$G(D):+X,1:$J(X,"",2)) "RTN","RCDPESR9",215,0) Q $S(X:X,$G(NULL):"",1:X) "RTN","RCDPESR9",216,0) ; "RTN","RCDPESR9",217,0) YN(X) ; Returns YES for X="Y" and NO for X="N" "RTN","RCDPESR9",218,0) S X=$S(X="Y":"YES",X="N":"NO",1:X) "RTN","RCDPESR9",219,0) Q X "RTN","RCDPESR9",220,0) ; "VER") 8.0^22.0 **END** **END**